diff options
666 files changed, 23188 insertions, 12656 deletions
diff --git a/.gitignore b/.gitignore index 0e9d07757f..fee8cba0c7 100644 --- a/.gitignore +++ b/.gitignore @@ -171,9 +171,10 @@ JAVADOC-GENERATED /lib/*/doc/pdf/*.pdf /lib/*/doc/xml/*.xml -/lib/configure /lib/config.log /lib/config.status +/make/config.log +/make/config.status # # Files generated by configure. @@ -186,10 +187,12 @@ JAVADOC-GENERATED # Files generated by "./otp_build autoconf" # +/lib/configure /lib/*/configure /lib/common_test/test_server/configure /lib/configure.in -/aclocal.m4 +/make/aclocal.m4 +/make/configure /lib/common_test/priv/auxdir/config.guess /lib/common_test/priv/auxdir/config.sub /lib/common_test/priv/auxdir/install-sh @@ -207,6 +210,7 @@ JAVADOC-GENERATED /lib/wx/autoconf/config.guess /lib/wx/autoconf/config.sub /lib/wx/autoconf/install-sh +/lib/crypto/aclocal.m4 # # Files generated when building/running tests (especially if diff --git a/.travis.yml b/.travis.yml index ee724f8947..0fc0a66c5c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -43,8 +43,8 @@ matrix: - ./scripts/build-docker-otp 32 sh -c "scripts/build-otp release && ./otp_build tests && scripts/run-smoke-tests && bin/dialyzer --build_plt --apps erts kernel stdlib" - env: Linux64SmokeTest script: - - ./scripts/build-otp - - ./otp_build tests + - ERL_COMPILER_OPTIONS=ssalint ./scripts/build-otp + - ERL_COMPILER_OPTIONS=ssalint ./otp_build tests - ./scripts/run-smoke-tests - env: Linux64Docbuild script: diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 96db464b52..8814e506f9 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -3,6 +3,7 @@ ## License By making a contribution to this project, I certify that: + (a) The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index 2597794496..674454bc8e 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -77,8 +77,6 @@ also find the utilities needed for building the documentation. Download from <http://www.oracle.com/technetwork/java/javase/downloads>. We have also tested with IBM's JDK 1.6.0. -* X Windows -- Development headers and libraries are needed - to build the Erlang/OTP application `gs` on Unix/Linux. * `flex` -- Headers and libraries are needed to build the flex scanner for the `megaco` application on Unix/Linux. * wxWidgets -- Toolkit for GUI applications. @@ -340,6 +338,8 @@ use the `--prefix` argument like this: `./configure --prefix=<Dir>`. Some of the available `configure` options are: * `--prefix=PATH` - Specify installation prefix. +* `--disable-parallel-configure` - Disable parallel execution of + `configure` scripts (parallel execution is enabled by default) * `--{enable,disable}-kernel-poll` - Kernel poll support (enabled by default if possible) * `--{enable,disable}-hipe` - HiPE support (enabled by default on supported diff --git a/bootstrap/bin/no_dot_erlang.boot b/bootstrap/bin/no_dot_erlang.boot Binary files differindex 127072b3ed..fce26e98fc 100644 --- a/bootstrap/bin/no_dot_erlang.boot +++ b/bootstrap/bin/no_dot_erlang.boot diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 127072b3ed..fce26e98fc 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex 127072b3ed..fce26e98fc 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differindex 248c6dc0e4..9e92da0cdd 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 c0db0d1ac4..18084eae32 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 dc941da6ae..4156be8787 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_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam Binary files differindex 1fc68940ac..d1e97c9e59 100644 --- a/bootstrap/lib/compiler/ebin/beam_bs.beam +++ b/bootstrap/lib/compiler/ebin/beam_bs.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex 6bf3b576b2..ac14a44c9d 100644 --- a/bootstrap/lib/compiler/ebin/beam_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex bc49326e74..3cc1461090 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_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam Binary files differindex 534eb65372..d9e57bab40 100644 --- a/bootstrap/lib/compiler/ebin/beam_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam Binary files differindex 1e2068b5cb..3a97f98bd5 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 2d9bc49992..81d3ee616e 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 differindex 6eed82587a..955220778d 100644 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ b/bootstrap/lib/compiler/ebin/beam_except.beam diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex e039f3c12b..917c18a100 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 6af8a015c0..a36817a0d6 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 differnew file mode 100644 index 0000000000..b100389e7f --- /dev/null +++ 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 87a8791bc4..46d76f72ce 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 98b2c19b48..05c71c92b6 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 5f33584fe4..46139f48c3 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_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam Binary files differdeleted file mode 100644 index 909e5403d1..0000000000 --- a/bootstrap/lib/compiler/ebin/beam_receive.beam +++ /dev/null diff --git a/bootstrap/lib/compiler/ebin/beam_record.beam b/bootstrap/lib/compiler/ebin/beam_record.beam Binary files differdeleted file mode 100644 index 188bd82412..0000000000 --- a/bootstrap/lib/compiler/ebin/beam_record.beam +++ /dev/null diff --git a/bootstrap/lib/compiler/ebin/beam_reorder.beam b/bootstrap/lib/compiler/ebin/beam_reorder.beam Binary files differdeleted file mode 100644 index 05562e19ea..0000000000 --- a/bootstrap/lib/compiler/ebin/beam_reorder.beam +++ /dev/null diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex 476dd53ee6..99b8f63262 100644 --- a/bootstrap/lib/compiler/ebin/beam_split.beam +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa.beam b/bootstrap/lib/compiler/ebin/beam_ssa.beam Binary files differnew file mode 100644 index 0000000000..b747696efa --- /dev/null +++ b/bootstrap/lib/compiler/ebin/beam_ssa.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam Binary files differnew file mode 100644 index 0000000000..d39c205d2a --- /dev/null +++ b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam Binary files differnew file mode 100644 index 0000000000..ad5f7ba2f0 --- /dev/null +++ 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 differnew file mode 100644 index 0000000000..a295b245e0 --- /dev/null +++ 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 differnew file mode 100644 index 0000000000..85bcccd1cb --- /dev/null +++ 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 differnew file mode 100644 index 0000000000..a1eb96e7db --- /dev/null +++ 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 differnew file mode 100644 index 0000000000..0811232fd9 --- /dev/null +++ b/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam Binary files differnew file mode 100644 index 0000000000..aefca8fbb9 --- /dev/null +++ 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 32cc6efe88..acadf70f39 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_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam Binary files differdeleted file mode 100644 index 266c04acfd..0000000000 --- a/bootstrap/lib/compiler/ebin/beam_type.beam +++ /dev/null diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex 5648719621..04b1988393 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 2bcec9ca3c..d41c5f7dd7 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 57698dbb3b..786aae46da 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 4f8ae7ca43..b9d876453e 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 fdd67aebde..ba92f93751 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 f0d6063f19..e69d1366ba 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 6905c648c2..4ab7584977 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 4304437799..64d017cee1 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 d1a9058417..6eb38cfc64 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 1506292674..d66ffe29b6 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -19,7 +19,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "7.1.5"}, + {vsn, "7.2.3"}, {modules, [ beam_a, beam_asm, @@ -33,15 +33,20 @@ beam_except, beam_flatten, beam_jump, + beam_kernel_to_ssa, beam_listing, beam_opcodes, beam_peep, - beam_receive, - beam_reorder, - beam_record, + beam_ssa, + beam_ssa_codegen, + beam_ssa_lint, + beam_ssa_opt, + beam_ssa_pp, + beam_ssa_pre_codegen, + beam_ssa_recv, + beam_ssa_type, beam_split, beam_trim, - beam_type, beam_utils, beam_validator, beam_z, @@ -65,7 +70,6 @@ sys_core_fold_lists, sys_core_inline, sys_pre_attributes, - v3_codegen, v3_core, v3_kernel, v3_kernel_pp diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam Binary files differindex f3737ecc26..e8dae016cd 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 567e381ee8..fdbdd9bcfc 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 618668e92e..dde063341d 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 6518f3a4ce..a6671337b9 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 bc0190fdb1..59ae0c0754 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 37bd743796..bbf38b0153 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 b0ef249e15..1f37c6dccd 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 52e46da7ad..609cd5e71b 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 d14579410c..d386168dc7 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_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam Binary files differindex c189549b16..4e34aec6b1 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 073bb041d4..b2f8a9bc0d 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 0ad7ab7f9c..02e2d081ed 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 ebe35883b5..f05a3f5cb3 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 d96bc1913a..695d69276b 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_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differdeleted file mode 100644 index c537f1e550..0000000000 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ /dev/null diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 162105c0bf..93be7a60c6 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 7a155ec05c..6f6203cb6a 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 4aef1389be..b363cd93e3 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 58f1681fba..c4c2511632 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 4f52e506c2..e03a44a808 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 55adf9849c..dec8d01cd6 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 ca7b77abcb..549515bfb1 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 200a996f96..676c46c01c 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 669efdc50f..5dc1c3bbc1 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 93c354bf40..1f2b6ac850 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 4f0eae4984..7efd785398 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 10c7275240..11507078b8 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 0f0418a911..911467d38b 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/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam Binary files differindex 517fa7dfdb..89e81d3698 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 3956e595f8..9de3831161 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 6559fc04c1..d4812bf6a0 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 de9b1cb638..9229ce42ff 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 8c8cba9068..082b63bbc4 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 449fd8dff1..cee63495b2 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 25b4b6c55e..011e19150a 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 1a1d9d28ee..384d5cf690 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 1ce96ca432..24b9ba4a9b 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 8dd3c07f71..2b54c327d0 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 82641f173a..50a3a21ee5 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 07a4f410e1..d3c8b7d97c 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 d9ca62a82b..d946cf31f3 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 4f1d53cb39..41b2618ea0 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 dcd81b1c6f..08d07963d2 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 0e492978d5..c661468df5 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 323b6cd4bb..64ac806d7c 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 e138217d25..b417fee3ca 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 b072f96e5d..724b1b6bf9 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 653d2a8699..907abbc3ab 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 03abd10d20..af8711daf3 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 97f98ebe2f..70f42c4b4e 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 0c3caaf969..9ebbe2ed01 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 989fceaa2c..9ea40e3d27 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 7df45ea492..4c6d182f43 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 bea47a3591..7a98863920 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 db0ead9cdd..0d614e4098 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_udp.beam b/bootstrap/lib/kernel/ebin/inet6_udp.beam Binary files differindex abc4b650ae..e580be53a6 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 5b50b553d7..ace0a62901 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 513a7dc03d..0ffc771f71 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 f483acd96c..4f07ece7db 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 610d9a2205..2d6c35e45c 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 63fadee640..0d38089d35 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 175649cd81..4c01f59045 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 463f90fae8..edfdd89e55 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 5107eb63b8..a7fbc642d6 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 304272a20d..1e377b091b 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 c33a9e7f3a..624600da13 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 d358ee15dc..2a47344012 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.app b/bootstrap/lib/kernel/ebin/kernel.app index 340ed8653f..4bc7cf56f0 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-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. @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "5.4.3"}, + {vsn, "6.0"}, {modules, [application, application_controller, application_master, @@ -67,6 +67,7 @@ logger_filters, logger_formatter, logger_h_common, + logger_handler_watcher, logger_server, logger_simple_h, logger_std_h, @@ -129,6 +130,7 @@ kernel_refc, kernel_sup, logger, + logger_handler_watcher, logger_sup, net_kernel, net_sup, diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex b3f0783d25..429a942c90 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 85b517fe0f..fdd3431f84 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 2fca33154c..999adb8bd8 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 02c5848f11..023769d6a5 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 400c9ca23b..ae7a9dd029 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 e6d8f5b2c6..b92ec655f0 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 be448bd75c..fdb087887a 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 52f7847561..cc94f93932 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 cc1b649eb7..9ef562adf2 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 57197e137c..56489cc160 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 7f7d77ab28..cde8151ecf 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 7d96f2d69e..273a51d90d 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 differnew file mode 100644 index 0000000000..91e088c8b9 --- /dev/null +++ b/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam diff --git a/bootstrap/lib/kernel/ebin/logger_server.beam b/bootstrap/lib/kernel/ebin/logger_server.beam Binary files differindex 4885c0992a..def2f5e30f 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 890de624b9..ca88d0b9ec 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 e8c3bb83d0..9a21e5d44e 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 9bef3c861c..32eb526a09 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 29c8bc5dde..3e971eb0e1 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 05aa46dcb8..3cd97ea91e 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 0a565d542d..f67541c6c7 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 f2a003d44f..d27da119c5 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 a106700e44..cbb3e96d45 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 c2f265ede4..613a5bafb5 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 734a051882..ca03dee5df 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 6f07a3c5c3..f3d6221ff1 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 222817d912..0310690034 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 2c20a06fd1..c17c96eada 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 228a8f28a5..15ae6c3230 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 4c69c890cd..8f13c65cd6 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/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam Binary files differindex 7a1c9e0b31..59ed54d229 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 1d1e277bf3..3ab4a7360e 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 c01106ef11..25a9b9c150 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 4cbf2174a2..c56303e2a6 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 c5a3330ee1..a569446fb9 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 6aa34138c8..96864f4456 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 a0f24625b4..92ce6c3271 100644 --- a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam +++ b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam diff --git a/bootstrap/lib/kernel/include/dist.hrl b/bootstrap/lib/kernel/include/dist.hrl index 6baaa35d72..003852f1b0 100644 --- a/bootstrap/lib/kernel/include/dist.hrl +++ b/bootstrap/lib/kernel/include/dist.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/kernel/include/dist_util.hrl b/bootstrap/lib/kernel/include/dist_util.hrl index eeb0f8dd43..56f775f060 100644 --- a/bootstrap/lib/kernel/include/dist_util.hrl +++ b/bootstrap/lib/kernel/include/dist_util.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/kernel/include/logger.hrl b/bootstrap/lib/kernel/include/logger.hrl index 2143ccd297..b09977e0f2 100644 --- a/bootstrap/lib/kernel/include/logger.hrl +++ b/bootstrap/lib/kernel/include/logger.hrl @@ -32,6 +32,10 @@ -define(LOG_DEBUG(A,B),?DO_LOG(debug,[A,B])). -define(LOG_DEBUG(A,B,C),?DO_LOG(debug,[A,B,C])). +-define(LOG(L,A),?DO_LOG(L,[A])). +-define(LOG(L,A,B),?DO_LOG(L,[A,B])). +-define(LOG(L,A,B,C),?DO_LOG(L,[A,B,C])). + -define(LOCATION,#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY}, line=>?LINE, file=>?FILE}). diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex e352b65951..ab8a6721dc 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 902d8edc6c..abbf3a9dca 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 b17a9b1947..d2a3d8bc8c 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 e712319947..2ba8310eda 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 6c8d14bac1..a72b4818af 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 099ded411d..3780b76e8c 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 05b575cd05..d379fc99f9 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 31f0f2701a..b8cbc51e95 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_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex 2b56a46eb1..bf2feb5926 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 2fda3ba53f..798dc3a4fe 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 345df4c87f..b2c81270ea 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 1faf374588..9ac947cadf 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 fa41a7af26..f4e4134bed 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 c8d4cac351..4f5958e043 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 62e209dcc7..760fca952b 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 c87665ff86..83329ae3d6 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 e6042b9715..3a9a74bf4d 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 7a0a4c08d8..68809d69cd 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 b9b75ecaef..1d0a526e4e 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 a317ae28a1..81bdd8b8c4 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 dc9d0a8d39..3470493604 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 eea70718c8..d4657d494d 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 9a3daef51e..ccc4d6c08a 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 c571d9f6f3..827cbc4acb 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 3fa4a49c24..0b32ca50c3 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 86876cda96..df1e061f86 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 a5d30afed2..5f6c03bcae 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 f645aea910..df3415e73f 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 a7a2910e1b..aac45c66c8 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 b72e4ebf6a..348b064eac 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 2f2e54de1a..6515da5411 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 a6e46e72b4..117f096ebb 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 781484fe0b..ee410f3d01 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 ab4996ef4e..c2c8beefe3 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 0a3c0b47fb..820db3becc 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 9fb87f4a68..0c91adb5b6 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 d1ec5357fc..fd6842f28d 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 85d568a8e1..62986a1af7 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 43ba8674b7..bbd7eaf63e 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 4476889671..b04874d269 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 b0e38024c5..57f6de465e 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 ef8d0cd929..e9b3df8f3e 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 3a4df3499c..c70989905f 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 1752276cc8..02fe60432d 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 1c1b93a036..5bb4b27e03 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 197d9b7f9c..215cfbc131 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 a6403bb708..9a64b00de3 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 a1acea2cee..0c3bbe4135 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 b33a6bbd72..4a7cd7e4e0 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 dc91c318c5..75434ed111 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 a711637e0c..8b31c38ab6 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 b27db50f62..8f3f145399 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 ec0ebce58a..1cc37072b6 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex e465ca8d5d..17e910bed2 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 57a23fbe98..66454c60ae 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 eac57f960a..9e49566404 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 c42b18f6cf..5c46c6fdde 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 b056cf44ec..41fb279bcb 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 ce36bcf6fc..0b65575cd7 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 cb2e3ddb11..99884551f6 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 c1cd50f143..30db434bd6 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 4153598cc7..868e027b9d 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 8c6b611247..c8636d83c0 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 55f8db7445..6aa7b99ad3 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 37f12f8a36..c3041437d5 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 4334fa8dc4..17dc72c040 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 c1b7414741..2301e4b999 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 65ffc775ad..a4ec7785b9 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 b2b955de04..afd0c65921 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 e832637c7c..5f51b0fcf6 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 0acc6b92ba..96c27e075b 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 20c978670e..b0ead5cd91 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "3.4.5"}, + {vsn, "3.5.1"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam Binary files differindex 57142f539a..0ac544efeb 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 939f385c93..45511a0815 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 6cfaa984df..eaf1965280 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 599cc20df4..32c2adfea4 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 7baece7eb2..962d6f7cc4 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 bdd4374aef..10e4299c03 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 7ff215178f..12b9c7312a 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 36aec511d8..995c1ea5aa 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 3194d09463..da98e9bb0e 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 ef7ea86791..d85893bd41 100644 --- a/bootstrap/lib/stdlib/ebin/zip.beam +++ b/bootstrap/lib/stdlib/ebin/zip.beam diff --git a/bootstrap/lib/stdlib/include/assert.hrl b/bootstrap/lib/stdlib/include/assert.hrl index 2ec89e7d8a..28d25c6589 100644 --- a/bootstrap/lib/stdlib/include/assert.hrl +++ b/bootstrap/lib/stdlib/include/assert.hrl @@ -140,7 +140,7 @@ -endif. %% This is mostly a convenience which gives more detailed reports. -%% Note: Guard is a guarded pattern, and can not be used for value. +%% Note: Guard is a guarded pattern, and cannot be used for value. -ifdef(NOASSERT). -define(assertMatch(Guard, Expr), ok). -define(assertMatch(Guard, Expr, Comment), ok). @@ -289,7 +289,7 @@ end). -endif. -%% Note: Class and Term are patterns, and can not be used for value. +%% Note: Class and Term are patterns, and cannot be used for value. %% Term can be a guarded pattern, but Class cannot. -ifdef(NOASSERT). -define(assertException(Class, Term, Expr), ok). @@ -364,7 +364,7 @@ ?assertException(throw, Term, Expr, Comment)). %% This is the inverse case of assertException, for convenience. -%% Note: Class and Term are patterns, and can not be used for value. +%% Note: Class and Term are patterns, and cannot be used for value. %% Both Class and Term can be guarded patterns. -ifdef(NOASSERT). -define(assertNotException(Class, Term, Expr), ok). diff --git a/configure.src b/configure.src new file mode 100644 index 0000000000..3849908388 --- /dev/null +++ b/configure.src @@ -0,0 +1,435 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2018. All Rights Reserved. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +# %CopyrightEnd% +# +# +# This is a handcrafted wrapper script which runs the actual (autoconf) +# 'configure' scripts in different parts of OTP. +# +# The true (autoconf) configure scripts are run in parallel unless +# --disable-parallel-configure is passed as argument to this script. +# +# The config cache feature is disabled since it mostly causes problems +# and especially when executing multiple configure scripts in parallel. +# On windows a static cache for each configure is used since it +# otherwise takes forever to run configure... +# + +OTP_VERSION=@OTP_VERSION@ + +unset CDPATH + +default_cflags="-g -O2" + +mXY_build= +static_cache= + +bootstrap_only=no +parallel_otp_configure=yes +help=no +user_srcdir= +config_arguments= +while test $# != 0; do + case $1 in + -srcdir=* | --srcdir=*) + user_srcdir=`expr "$1" : '[^=]*=\(.*\)'` + if test "$ERL_TOP" != ""; then + echo "WARNING: Overriding ERL_TOP with $user_srcdir" 1>&2 + echo "" 1>&2 + fi + ERL_TOP="$user_srcdir" + ;; + -srcdir | --srcdir) + shift + test $# != 0 || { + echo "ERROR: Missing source dir" 1>&2 + exit 1 + } + user_srcdir="$1" + if test "$ERL_TOP" != ""; then + echo "WARNING: Overriding ERL_TOP with $user_srcdir" 1>&2 + echo "" 1>&2 + fi + ERL_TOP="$user_srcdir" + ;; + --enable-bootstrap-only) + bootstrap_only=yes;; + --disable-bootstrap-only) + bootstrap_only=no;; + --enable-option-checking) + echo "ERROR: Cannot enable option checking" 1>&2 + exit 1;; + --disable-option-checking) + # Got it... + ;; + --disable-parallel-configure) + parallel_otp_configure=no + ;; + --config-cache | -C) + echo "WARNING: Ignoring config cache file since it will mess up the configuration" 1>&2 + echo "" 1>&2 + ;; + -cache-file=* | --cache-file=* ) + static_cache=`expr "$1" : '[^=]*=\(.*\)'` + if test "$static_cache" != "/dev/null"; then + echo "WARNING: Only using config cache file '$static_cache' as static cache" 1>&2 + echo "" 1>&2 + else + static_cache= + fi + ;; + -cache-file | --cache-file) + shift + test $# != 0 || { + echo "ERROR: Missing cache file" 1>&2 + exit 1 + } + static_cache=$1 + if test "$static_cache" != "/dev/null"; then + echo "WARNING: Only using config cache file '$static_cache' as static cache" 1>&2 + echo "" 1>&2 + else + static_cache= + fi + ;; + --enable-m64-build) + mXY_build="-m64" + ;; + --enable-m32-build) + mXY_build="-m32" + ;; + --disable-m64-build) + if test "$mXY_build" = "-m64"; then + mXY_build= + fi;; + --disable-m32-build) + if test "$mXY_build" = "-m32"; then + mXY_build= + fi;; + CFLAGS=* | LDFLAGS=*) + flgs_var=`expr "$1" : '\([^=]*\)=.*'` + flgs_val=`expr "$1" : '[^=]*=\(.*\)'` + eval $flgs_var=\$flgs_val + ;; + --help=r* | -help=r*) + help=all;; + --help* | -help* | -h) + help=$1;; + *) + case $1 in + --without-*) + skip_app=`expr "$1" : '--without-\(.*\)'` + if test -d "lib/$skip_app"; then + echo "$skip_app" >> "$ERL_TOP/lib/SKIP-APPLICATIONS" + fi;; + *) + ;; + esac + case $1 in + *\'*) + 1=`echo "$1" | sed "s/'/'\\\\\\\\''/g"` ;; + *) + ;; + esac + config_arguments="$config_arguments '$1'";; + esac + shift +done + +if test $parallel_otp_configure = yes; then + case `uname -s` in + MSYS* | msys* | CYGWIN* | cygwin ) + ;; + *) + trap 'kill -KILL -$$' 1 2 3 6 15 + ;; + esac +fi + +# +# Figure ERL_TOP out... +# + +root_dir= +dir_chk_data="$OTP_VERSION" + +if root_dir=`dirname "$0" 2>/dev/null` \ + && test "$root_dir" != "" \ + && cd "$root_dir" 2>/dev/null; then + root_dir=`pwd 2>/dev/null` + if test $? -ne 0; then + root_dir= + else + case "$root_dir" in + /*) + echo $dir_chk_data > "$root_dir"/config.dir.check.$$ 2>/dev/null + ;; + *) + root_dir= + esac + fi +else + root_dir= +fi + +if test "$root_dir" = ""; then + case X"$ERL_TOP" in + X) + echo "ERROR: Cannot figure out the root directory of" 1>&2 + echo " the OTP source. Please set the ERL_TOP" 1>&2 + echo " environment variable." 1>&2 + exit 1 + ;; + X/*) + cd "$ERL_TOP" 2>/dev/null || { + echo "ERROR: Cannot change directory to ERL_TOP " 1>&2 + echo " '$ERL_TOP'" 1>&2 + exit 1 + } + ;; + X*) + echo "ERROR: ERL_TOP '$ERL_TOP' is not an absolute path" 1>&2 + exit 1 + ;; + esac +else + case X"$ERL_TOP" in + X) + ERL_TOP="$root_dir" + rm -f "$root_dir"/config.dir.check.$$ + ;; + X/*) + cd "$ERL_TOP" 2>/dev/null || { + rm -f "$root_dir"/config.dir.check.$$ + echo "ERROR: Cannot change directory into ERL_TOP " 1>&2 + echo " '$ERL_TOP'" 1>&2 + exit 1 + } + dir_chk=`cat ./config.dir.check.$$ 2>/dev/null` || dir_chk=error + rm -f "$root_dir"/config.dir.check.$$ + test "$dir_chk" = "$dir_chk_data" || { + echo "ERROR: ERL_TOP '$ERL_TOP' is not the same" 1>&2 + echo " as 'configure' location '$root_dir'" 1>&2 + exit 1 + } + ;; + X*) + rm -f "$root_dir"/config.dir.check.$$ + echo "ERROR: ERL_TOP '$ERL_TOP' is not an absolute path" 1>&2 + exit 1 + ;; + esac +fi + +export ERL_TOP + +rm -f "$ERL_TOP/lib/SKIP-APPLICATIONS" + +case "$help" in + no) + ;; + all) + (cd "$ERL_TOP/make" && ./configure --help) + app_dirs= + for app_dir in erts lib/*; do + if test -f "$app_dir/configure"; then + echo "" + echo "=== $app_dir ===" + (cd "$ERL_TOP/$app_dir" && ./configure --help=short) + fi + done + exit 0;; + *) + (cd "$ERL_TOP/make" && ./configure "$help") + exit 0;; +esac + +if test "$mXY_build" = ""; then + if test "$CFLAGS" != ""; then + config_arguments="$config_arguments CFLAGS='$CFLAGS'" + unset CFLAGS + fi + + if test "$LDFLAGS" != ""; then + config_arguments="$config_arguments LDFLAGS='$LDFLAGS'" + unset LDFLAGS + fi +else + if test "$CFLAGS" = ""; then + CFLAGS=$default_cflags + fi + config_arguments="$config_arguments CFLAGS='$mXY_build $CFLAGS'" + unset CFLAGS + config_arguments="$config_arguments LDFLAGS='$mXY_build $LDFLAGS'" + unset LDFLAGS + case $mXY_build in + -m32) + config_arguments="$config_arguments --enable-m32-build" + ;; + -m64) + config_arguments="$config_arguments --enable-m64-build" + ;; + esac +fi + +config_arguments="$config_arguments --disable-option-checking" + +if test $bootstrap_only = no; then + check_conf_dirs=`echo lib/*` +else + check_conf_dirs="@BOOTSTRAP_LIB_APP_DIRS@" +fi + +# 'erts' *needs* to be last in app_dirs! Any apps +# after it wont be able to run in parallel with +# erts... + +app_dirs= +for app_dir in make $check_conf_dirs erts; do + if test -f "$app_dir/configure"; then + if test "$static_cache" != ""; then + cp -f "$static_cache" "$ERL_TOP/$app_dir/local.static.config.cache" + fi + rm -f $app_dir/configure.result.failed + rm -f $app_dir/configure.result.command + rm -f $app_dir/configure.result.stdout + rm -f $app_dir/configure.result.stderr + app_dirs="$app_dirs $app_dir" + fi +done + +if test "$static_cache" = ""; then + local_cache_file=/dev/null +else + local_cache_file=./local.static.config.cache +fi + +for app_dir in $app_dirs; do + cd "$ERL_TOP/$app_dir" + cmd_str="./configure $config_arguments --cache-file=$local_cache_file --srcdir=\"$ERL_TOP/$app_dir\"" + if test $parallel_otp_configure = no; then + echo "=== Running configure in $ERL_TOP/$app_dir ===" + eval $cmd_str + echo "" + elif test $app_dir != erts; then + echo $cmd_str >./configure.result.command + eval $cmd_str 1>./configure.result.stdout 2>./configure.result.stderr || echo "fatal" > "./configure.result.failed" & + else + # ERTS configure gets to use stdout/stderr; the others are printed when done... + echo "=== Running configure in $ERL_TOP/erts ===" + echo $cmd_str + eval $cmd_str || { + rm -f erts/configure.result.* lib/*/configure.result.* + echo "ERROR: $ERL_TOP/$app_dir/configure failed!" 1>&2 + kill -KILL -$$ + exit 1 + } + fi +done + +cd "$ERL_TOP" + +if test $parallel_otp_configure = yes; then + # Wait for all sub-configures to finish... + wait + + for app_dir in $app_dirs; do + if test -f "$app_dir/configure.result.command"; then + echo "" + echo "=== Running configure in $ERL_TOP/$app_dir ===" + cat "$app_dir/configure.result.command" + rm -f "$app_dir/configure.result.command" + fi + if test -f "$app_dir/configure.result.stdout"; then + cat "$app_dir/configure.result.stdout" + rm -f "$app_dir/configure.result.stdout" + fi + if test -f "$app_dir/configure.result.stderr"; then + cat "$app_dir/configure.result.stderr" 1>&2 + rm -f "$app_dir/configure.result.stderr" + fi + if test -f "$app_dir/configure.result.failed"; then + rm -f erts/configure.result.* lib/*/configure.result.* + echo "ERROR: $ERL_TOP/$app_dir/configure failed!" 1>&2 + exit 1 + fi + done +fi + + +echo "" + +pattern="lib/*/SKIP" +files=`echo $pattern` +if test "$files" != "$pattern" || test -f "$ERL_TOP/lib/SKIP-APPLICATIONS"; then + echo '*********************************************************************' + echo '********************** APPLICATIONS DISABLED **********************' + echo '*********************************************************************' + echo + if test "$files" != "$pattern"; then + for skipfile in $files; do + app=`dirname $skipfile`; app=`basename $app` + printf "%-15s: " $app; cat $skipfile + done + fi + if test -f "$ERL_TOP/lib/SKIP-APPLICATIONS"; then + for skipapp in `cat "$ERL_TOP/lib/SKIP-APPLICATIONS"`; do + printf "%-15s: User gave --without-%s option\n" $skipapp $skipapp + done + fi + echo + echo '*********************************************************************' +fi +pattern="lib/*/CONF_INFO" +files=`echo $pattern` +if test "$files" != "$pattern" || test -f erts/CONF_INFO; then + echo '*********************************************************************' + echo '********************** APPLICATIONS INFORMATION *******************' + echo '*********************************************************************' + echo + test "$files" != "$pattern" || files="" + test ! -f erts/CONF_INFO || files="$files erts/CONF_INFO" + for infofile in $files; do + app=`dirname $infofile`; app=`basename $app` + printf "%-15s: " $app; cat $infofile + done + echo + echo '*********************************************************************' +fi +if test -f "erts/doc/CONF_INFO"; then + echo '*********************************************************************' + echo '********************** DOCUMENTATION INFORMATION ******************' + echo '*********************************************************************' + echo + printf "%-15s: \n" documentation; + havexsltproc="yes" + for cmd in `cat erts/doc/CONF_INFO`; do + echo " $cmd is missing." + if test $cmd = "xsltproc"; then + havexsltproc="no" + fi + done + if test $havexsltproc = "no"; then + echo ' The documentation cannot be built.' + else + echo ' Using fakefop to generate placeholder PDF files.' + fi + echo + echo '*********************************************************************' +fi diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 3d227e462c..0ca2755802 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -122,6 +122,9 @@ dnl AC_DEFUN(LM_WINDOWS_ENVIRONMENT, [ + +if test "X$windows_environment_" != "Xchecked"; then +windows_environment_=checked MIXED_CYGWIN=no MIXED_MSYS=no @@ -197,6 +200,8 @@ else fi AC_SUBST(MIXED_MSYS) + +fi ]) dnl ---------------------------------------------------------------------- @@ -2856,3 +2861,248 @@ AC_DEFUN([LM_HARDWARE_ARCH], [ AC_SUBST(ARCH) ]) + +dnl +dnl-------------------------------------------------------------------- +dnl Dynamic Erlang Drivers +dnl +dnl Linking to produce dynamic Erlang drivers to be loaded by Erlang's +dnl Dynamic Driver Loader and Linker (DDLL). Below the prefix DED is an +dnl abbreviation for `Dynamic Erlang Driver'. +dnl +dnl For DED we need something quite sloppy, which allows undefined references +dnl (notably driver functions) in the resulting shared library. +dnl Example of Makefile rule (and settings of macros): +dnl +dnl LIBS = @LIBS@ +dnl LD = @DED_LD@ +dnl LDFLAGS = @DED_LDFLAGS@ +dnl soname = @ldsoname@ +dnl +dnl my_drv.so: my_drv.o my_utils.o +dnl $(LD) $(LDFLAGS) $(soname) $@ -o $@ $^ -lc $(LIBS) +dnl +dnl-------------------------------------------------------------------- +dnl + +AC_DEFUN(ERL_DED, + [ + +USER_LD=$LD +USER_LDFLAGS="$LDFLAGS" + +LM_CHECK_THR_LIB + +DED_CC=$CC +DED_GCC=$GCC + +DED_CFLAGS= +DED_OSTYPE=unix +case $host_os in + linux*) + DED_CFLAGS="-D_GNU_SOURCE" ;; + win32) + DED_CFLAGS="-D_WIN32_WINNT=0x0600 -DWINVER=0x0600" + DED_OSTYPE=win32 ;; + *) + ;; +esac + + +DED_WARN_FLAGS="-Wall -Wstrict-prototypes" +case "$host_cpu" in + tile*) + # tile-gcc is a bit stricter with -Wmissing-prototypes than other gccs, + # and too strict for our taste. + ;; + *) + DED_WARN_FLAGS="$DED_WARN_FLAGS -Wmissing-prototypes";; +esac + +LM_TRY_ENABLE_CFLAG([-Wdeclaration-after-statement], [DED_WARN_FLAGS]) + +LM_TRY_ENABLE_CFLAG([-Werror=return-type], [DED_WERRORFLAGS]) +LM_TRY_ENABLE_CFLAG([-Werror=implicit], [DED_WERRORFLAGS]) +LM_TRY_ENABLE_CFLAG([-Werror=undef], [DED_WERRORFLAGS]) + +DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$DED_OSTYPE -I${ERL_TOP}/erts/emulator/sys/common" +DED_INCLUDE=$DED_SYS_INCLUDE + +if test "$THR_DEFS" = ""; then + DED_THR_DEFS="-D_THREAD_SAFE -D_REENTRANT" +else + DED_THR_DEFS="$THR_DEFS" +fi +# DED_EMU_THR_DEFS=$EMU_THR_DEFS +DED_CFLAGS="$CFLAGS $CPPFLAGS $DED_CFLAGS" +if test "x$GCC" = xyes; then + DED_STATIC_CFLAGS="$DED_CFLAGS" + DED_CFLAGS="$DED_CFLAGS -fPIC" +fi + +DED_EXT=so +case $host_os in + win32) DED_EXT=dll;; + darwin*) + DED_CFLAGS="$DED_CFLAGS -fno-common" + DED_STATIC_CFLAGS="$DED_STATIC_CFLAGS -fno-common";; + *) + ;; +esac + +DED_STATIC_CFLAGS="$DED_STATIC_CFLAGS -DSTATIC_ERLANG_NIF -DSTATIC_ERLANG_DRIVER" + +if test "$CFLAG_RUNTIME_LIBRARY_PATH" = ""; then + + CFLAG_RUNTIME_LIBRARY_PATH="-Wl,-R" + case $host_os in + darwin*) + CFLAG_RUNTIME_LIBRARY_PATH= + ;; + win32) + CFLAG_RUNTIME_LIBRARY_PATH= + ;; + osf*) + CFLAG_RUNTIME_LIBRARY_PATH="-Wl,-rpath," + ;; + *) + ;; + esac + +fi + +# If DED_LD is set in environment, we expect all DED_LD* variables +# to be specified (cross compiling) +if test "x$DED_LD" = "x"; then + +DED_LD_FLAG_RUNTIME_LIBRARY_PATH="-R" +case $host_os in + win32) + DED_LD="ld.sh" + DED_LDFLAGS="-dll" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + ;; + solaris2*|sysv4*) + DED_LDFLAGS="-G" + if test X${enable_m64_build} = Xyes; then + DED_LDFLAGS="-64 $DED_LDFLAGS" + fi + ;; + aix4*) + DED_LDFLAGS="-G -bnoentry -bexpall" + ;; + freebsd2*) + # Non-ELF GNU linker + DED_LDFLAGS="-Bshareable" + ;; + darwin*) + # Mach-O linker: a shared lib and a loadable + # object file is not the same thing. + DED_LDFLAGS="-bundle -bundle_loader ${ERL_TOP}/bin/$host/beam.smp" + if test X${enable_m64_build} = Xyes; then + DED_LDFLAGS="-m64 $DED_LDFLAGS" + else + if test X${enable_m32_build} = Xyes; then + DED_LDFLAGS="-m32 $DED_LDFLAGS" + else + AC_CHECK_SIZEOF(void *) + case "$ac_cv_sizeof_void_p" in + 8) + DED_LDFLAGS="-m64 $DED_LDFLAGS";; + *) + ;; + esac + fi + fi + DED_LD="$CC" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" + ;; + linux*) + DED_LD="$CC" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" + DED_LDFLAGS="-shared -Wl,-Bsymbolic" + if test X${enable_m64_build} = Xyes; then + DED_LDFLAGS="-m64 $DED_LDFLAGS" + fi; + if test X${enable_m32_build} = Xyes; then + DED_LDFLAGS="-m32 $DED_LDFLAGS" + fi + ;; + freebsd*) + DED_LD="$CC" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" + DED_LDFLAGS="-shared" + if test X${enable_m64_build} = Xyes; then + DED_LDFLAGS="-m64 $DED_LDFLAGS" + fi; + if test X${enable_m32_build} = Xyes; then + DED_LDFLAGS="-m32 $DED_LDFLAGS" + fi + ;; + openbsd*) + DED_LD="$CC" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" + DED_LDFLAGS="-shared" + ;; + osf*) + # NOTE! Whitespace after -rpath is important. + DED_LD_FLAG_RUNTIME_LIBRARY_PATH="-rpath " + DED_LDFLAGS="-shared -expect_unresolved '*'" + ;; + *) + # assume GNU linker and ELF + DED_LDFLAGS="-shared" + # GNU linker has no option for 64bit build, should not propagate -m64 + ;; +esac + +if test "$DED_LD" = "" && test "$USER_LD" != ""; then + DED_LD="$USER_LD" + DED_LDFLAGS="$USER_LDFLAGS $DED_LDFLAGS" +fi + +DED_LIBS=$LIBS + +fi # "x$DED_LD" = "x" + +AC_CHECK_TOOL(DED_LD, ld, false) +test "$DED_LD" != "false" || AC_MSG_ERROR([No linker found]) + +AC_MSG_CHECKING(for static compiler flags) +DED_STATIC_CFLAGS="$DED_WERRORFLAGS $DED_WFLAGS $DED_THR_DEFS $DED_STATIC_CFLAGS" +AC_MSG_RESULT([$DED_STATIC_CFLAGS]) +AC_MSG_CHECKING(for basic compiler flags for loadable drivers) +DED_BASIC_CFLAGS=$DED_CFLAGS +AC_MSG_RESULT([$DED_CFLAGS]) +AC_MSG_CHECKING(for compiler flags for loadable drivers) +DED_CFLAGS="$DED_WERRORFLAGS $DED_WARN_FLAGS $DED_THR_DEFS $DED_CFLAGS" +AC_MSG_RESULT([$DED_CFLAGS]) +AC_MSG_CHECKING(for linker for loadable drivers) +AC_MSG_RESULT([$DED_LD]) +AC_MSG_CHECKING(for linker flags for loadable drivers) +AC_MSG_RESULT([$DED_LDFLAGS]) +AC_MSG_CHECKING(for 'runtime library path' linker flag) +if test "x$DED_LD_FLAG_RUNTIME_LIBRARY_PATH" != "x"; then + AC_MSG_RESULT([$DED_LD_FLAG_RUNTIME_LIBRARY_PATH]) +else + AC_MSG_RESULT([not found]) +fi + +AC_SUBST(DED_CC) +AC_SUBST(DED_GCC) +AC_SUBST(DED_EXT) +AC_SUBST(DED_SYS_INCLUDE) +AC_SUBST(DED_INCLUDE) +AC_SUBST(DED_BASIC_CFLAGS) +AC_SUBST(DED_CFLAGS) +AC_SUBST(DED_STATIC_CFLAGS) +AC_SUBST(DED_WARN_FLAGS) +AC_SUBST(DED_WERRORFLAGS) +AC_SUBST(DED_LD) +AC_SUBST(DED_LDFLAGS) +AC_SUBST(DED_LD_FLAG_RUNTIME_LIBRARY_PATH) +AC_SUBST(DED_LIBS) +AC_SUBST(DED_THR_DEFS) +AC_SUBST(DED_OSTYPE) + +]) diff --git a/erts/configure.in b/erts/configure.in index 2b3d97cfdd..01b7c1bfd7 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -26,11 +26,6 @@ AC_PREREQ(2.59) LM_PRECIOUS_VARS -if test "x$no_recursion" != "xyes" -a "x$OVERRIDE_CONFIG_CACHE" = "x"; then - # We do not want to use a common cache! - cache_file=/dev/null -fi - dnl How to set srcdir absolute is taken from the GNU Emacs distribution #### Make srcdir absolute, if it isn't already. It's important to #### avoid running the path through pwd unnecessary, since pwd can @@ -420,7 +415,10 @@ dnl dnl Make sure we find config.h dnl -extra_flags="-I${ERL_TOP}/erts/$host $OTP_EXTRA_FLAGS" +ERTS_CONFIG_H_IDIR="-I${ERL_TOP}/erts/$host" +AC_SUBST(ERTS_CONFIG_H_IDIR) + +extra_flags="$ERTS_CONFIG_H_IDIR $OTP_EXTRA_FLAGS" CFLAGS="$CFLAGS $extra_flags" DEBUG_CFLAGS="-g $CPPFLAGS $extra_flags $DEBUG_CFLAGS" DEBUG_FLAGS=-g @@ -452,23 +450,6 @@ case $CFLAGS in ;; esac - - -CFLAG_RUNTIME_LIBRARY_PATH="-Wl,-R" -case $host_os in - darwin*) - CFLAG_RUNTIME_LIBRARY_PATH= - ;; - win32) - CFLAG_RUNTIME_LIBRARY_PATH= - ;; - osf*) - CFLAG_RUNTIME_LIBRARY_PATH="-Wl,-rpath," - ;; - *) - ;; -esac - lfs_conf=ok lfs_source=none if test "${LFS_CFLAGS+set}" = "set" || \ @@ -544,7 +525,6 @@ AC_SUBST(DEBUG_FLAGS) AC_SUBST(DEBUG_CFLAGS) AC_SUBST(WFLAGS) AC_SUBST(WERRORFLAGS) -AC_SUBST(CFLAG_RUNTIME_LIBRARY_PATH) ## Check if we can do profile guided optimization of beam_emu LM_CHECK_ENABLE_CFLAG([-fprofile-generate -Werror],[PROFILE_GENERATE]) @@ -581,7 +561,8 @@ if test "X$PROFILE_INSTR_GENERATE" = "Xtrue"; then PROFILE_INSTR_USE=false]) rm -f default.profdata fi], - []) + [], + [AC_MSG_NOTICE([Disabling PGO when cross-compiling])]) rm -f *.profraw CFLAGS=$saved_CFLAGS; fi @@ -887,9 +868,6 @@ esac AC_SUBST(LD) -LDFLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" -AC_SUBST(LDFLAG_RUNTIME_LIBRARY_PATH) - dnl Check for cygwin and object/exe files extension dnl AC_CYGWIN is deprecated AC_EXEEXT @@ -2948,165 +2926,6 @@ dnl ---------------------------------------------------------------------- dnl Stuff that should be moved into their respective application dnl ---------------------------------------------------------------------- -dnl crypto -#-------------------------------------------------------------------- -# Dynamic Erlang Drivers -# -# Linking to produce dynamic Erlang drivers to be loaded by Erlang's -# Dynamic Driver Loader and Linker (DDLL). Below the prefix DED is an -# abbreviation for `Dynamic Erlang Driver'. -# -# For DED we need something quite sloppy, which allows undefined references -# (notably driver functions) in the resulting shared library. -# Example of Makefile rule (and settings of macros): -# -# LIBS = @LIBS@ -# LD = @DED_LD@ -# LDFLAGS = @DED_LDFLAGS@ -# soname = @ldsoname@ -# -# my_drv.so: my_drv.o my_utils.o -# $(LD) $(LDFLAGS) $(soname) $@ -o $@ $^ -lc $(LIBS) -# -#-------------------------------------------------------------------- - -DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE -I${ERL_TOP}/erts/emulator/sys/common" - -if test "X$ETHR_DEFS" = "X"; then - DED_THR_DEFS="-D_THREAD_SAFE -D_REENTRANT" -else - DED_THR_DEFS="$ETHR_DEFS" -fi -DED_EMU_THR_DEFS=$EMU_THR_DEFS -DED_CFLAGS="$CFLAGS $CPPFLAGS" -if test "x$GCC" = xyes; then - DED_STATIC_CFLAGS="$DED_CFLAGS" - DED_CFLAGS="$DED_CFLAGS -fPIC" -fi - -DED_EXT=so -case $host_os in - win32) DED_EXT=dll;; - darwin*) - DED_CFLAGS="$DED_CFLAGS -fno-common" - DED_STATIC_CFLAGS="$DED_STATIC_CFLAGS -fno-common";; - *) - ;; -esac - -DED_STATIC_CFLAGS="$DED_STATIC_CFLAGS -DSTATIC_ERLANG_NIF -DSTATIC_ERLANG_DRIVER" - -# If DED_LD is set in environment, we expect all DED_LD* variables -# to be specified (cross compiling) -if test "x$DED_LD" = "x"; then - -DED_LD_FLAG_RUNTIME_LIBRARY_PATH="-R" -case $host_os in - win32) - DED_LD="ld.sh" - DED_LDFLAGS="-dll" - DED_LD_FLAG_RUNTIME_LIBRARY_PATH= - ;; - solaris2*|sysv4*) - DED_LDFLAGS="-G" - if test X${enable_m64_build} = Xyes; then - DED_LDFLAGS="-64 $DED_LDFLAGS" - fi - ;; - aix4*) - DED_LDFLAGS="-G -bnoentry -bexpall" - ;; - freebsd2*) - # Non-ELF GNU linker - DED_LDFLAGS="-Bshareable" - ;; - darwin*) - # Mach-O linker: a shared lib and a loadable - # object file is not the same thing. - DED_LDFLAGS="-bundle -bundle_loader ${ERL_TOP}/bin/$host/beam.smp" - case $ARCH in - amd64) - DED_LDFLAGS="-m64 $DED_LDFLAGS" - ;; - *) - ;; - esac - DED_LD="$CC" - DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" - ;; - linux*) - DED_LD="$CC" - DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" - DED_LDFLAGS="-shared -Wl,-Bsymbolic" - if test X${enable_m64_build} = Xyes; then - DED_LDFLAGS="-m64 $DED_LDFLAGS" - fi; - if test X${enable_m32_build} = Xyes; then - DED_LDFLAGS="-m32 $DED_LDFLAGS" - fi - ;; - freebsd*) - DED_LD="$CC" - DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" - DED_LDFLAGS="-shared" - if test X${enable_m64_build} = Xyes; then - DED_LDFLAGS="-m64 $DED_LDFLAGS" - fi; - if test X${enable_m32_build} = Xyes; then - DED_LDFLAGS="-m32 $DED_LDFLAGS" - fi - ;; - openbsd*) - DED_LD="$CC" - DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" - DED_LDFLAGS="-shared" - ;; - osf*) - # NOTE! Whitespace after -rpath is important. - DED_LD_FLAG_RUNTIME_LIBRARY_PATH="-rpath " - DED_LDFLAGS="-shared -expect_unresolved '*'" - ;; - *) - # assume GNU linker and ELF - DED_LDFLAGS="-shared" - # GNU linker has no option for 64bit build, should not propagate -m64 - ;; -esac - -if test "$DED_LD" = "" && test "$USER_LD" != ""; then - DED_LD="$USER_LD" - DED_LDFLAGS="$USER_LDFLAGS $DED_LDFLAGS" -fi - -fi # "x$DED_LD" = "x" - -AC_CHECK_TOOL(DED_LD, ld, false) -test "$DED_LD" != "false" || AC_MSG_ERROR([No linker found]) - -AC_MSG_CHECKING(for compiler flags for loadable drivers) -AC_MSG_RESULT([$DED_CFLAGS]) -AC_MSG_CHECKING(for linker for loadable drivers) -AC_MSG_RESULT([$DED_LD]) -AC_MSG_CHECKING(for linker flags for loadable drivers) -AC_MSG_RESULT([$DED_LDFLAGS]) -AC_MSG_CHECKING(for 'runtime library path' linker flag) -if test "x$DED_LD_FLAG_RUNTIME_LIBRARY_PATH" != "x"; then - AC_MSG_RESULT([$DED_LD_FLAG_RUNTIME_LIBRARY_PATH]) -else - AC_MSG_RESULT([not found]) -fi - -AC_SUBST(DED_EXT) -AC_SUBST(DED_SYS_INCLUDE) -AC_SUBST(DED_CFLAGS) -AC_SUBST(DED_STATIC_CFLAGS) -AC_SUBST(DED_LD) -AC_SUBST(DED_LDFLAGS) -AC_SUBST(DED_LD_FLAG_RUNTIME_LIBRARY_PATH) -AC_SUBST(DED_THR_DEFS) -AC_SUBST(DED_EMU_THR_DEFS) -AC_SUBST(STATIC_CFLAGS) - dnl dnl We should look for a compiler that handles jump tables, for beam_emu dnl to be optimized @@ -3259,733 +3078,6 @@ if test "$enable_lttng_test" = "yes" ; then fi -dnl -dnl SSL, SSH and CRYPTO need the OpenSSL libraries -dnl -dnl Check flags --with-ssl, --without-ssl --with-ssl=PATH. -dnl If no option is given or --with-ssl is set without a path then we -dnl search for OpenSSL libraries and header files in the standard locations. -dnl If set to --without-ssl we disable the use of SSL, SSH and CRYPTO. -dnl If set to --with-ssl=PATH we use that path as the prefix, i.e. we -dnl use "PATH/include" and "PATH/lib". - -AC_SUBST(SSL_INCLUDE) -AC_SUBST(SSL_INCDIR) -AC_SUBST(SSL_LIBDIR) -AC_SUBST(SSL_FLAGS) -AC_SUBST(SSL_CRYPTO_LIBNAME) -AC_SUBST(SSL_SSL_LIBNAME) -AC_SUBST(SSL_CC_RUNTIME_LIBRARY_PATH) -AC_SUBST(SSL_LD_RUNTIME_LIBRARY_PATH) -AC_SUBST(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -AC_SUBST(SSL_DYNAMIC_ONLY) -AC_SUBST(SSL_LINK_WITH_KERBEROS) -AC_SUBST(STATIC_KERBEROS_LIBS) -AC_SUBST(SSL_LINK_WITH_ZLIB) -AC_SUBST(STATIC_ZLIB_LIBS) - -std_ssl_locations="/usr/local /usr/sfw /usr /opt/local /usr/pkg /usr/local/openssl /usr/lib/openssl /usr/openssl /usr/local/ssl /usr/lib/ssl /usr/ssl /" - -AC_ARG_WITH(ssl-zlib, -AS_HELP_STRING([--with-ssl-zlib=PATH], - [specify location of ZLib to be used by OpenSSL]) -AS_HELP_STRING([--with-ssl-zlib], - [link SSL with Zlib (default if found)]) -AS_HELP_STRING([--without-ssl-zlib], - [don't link SSL with ZLib])) - - -if test "x$with_ssl_zlib" = "xno"; then - SSL_LINK_WITH_ZLIB=no - STATIC_ZLIB_LIBS= -elif test "x$with_ssl_zlib" = "xyes" || test "x$with_ssl_zlib" = "x"; then - if test $erl_xcomp_without_sysroot = yes; then - AC_MSG_WARN([Cannot search for zlib; missing cross system root (erl_xcomp_sysroot).]) - SSL_LINK_WITH_ZLIB=no - STATIC_ZLIB_LIBS= - elif test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then - SSL_LINK_WITH_ZLIB=no - STATIC_ZLIB_LIBS= - else - SSL_LINK_WITH_ZLIB=no - STATIC_ZLIB_LIBS= - AC_MSG_CHECKING(for static ZLib to be used by SSL in standard locations) - for rdir in $std_ssl_locations; do - dir="$erl_xcomp_sysroot$rdir" - if test "x$ac_cv_sizeof_void_p" = "x8"; then - if test -f "$dir/lib64/libz.a"; then - SSL_LINK_WITH_ZLIB=yes - STATIC_ZLIB_LIBS="$dir/lib64/libz.a" - break - elif test -f "$dir/lib/64/libz.a"; then - SSL_LINK_WITH_ZLIB=yes - STATIC_ZLIB_LIBS="$dir/lib/64/libz.a" - break - fi - fi - if test -f "$dir/lib/libz.a"; then - SSL_LINK_WITH_ZLIB=yes - STATIC_ZLIB_LIBS="$dir/lib/libz.a" - break - fi - done - if test "x$SSL_LINK_WITH_ZLIB" = "xno"; then - AC_MSG_RESULT([no]) - else - AC_MSG_RESULT([$STATIC_ZLIB_LIBS]) - fi - fi -else - SSL_LINK_WITH_ZLIB=no - STATIC_ZLIB_LIBS= - if test -f "$with_ssl_zlib/libz.a"; then - SSL_LINK_WITH_ZLIB=yes - STATIC_ZLIB_LIBS=$with_ssl_zlib/libz.a - elif test -f "$with_ssl_zlib/lib/libz.a"; then - SSL_LINK_WITH_ZLIB=yes - STATIC_ZLIB_LIBS=$with_ssl_zlib/lib/libz.a - fi - if test "x$ac_cv_sizeof_void_p" = "x8"; then - if test -f "$with_ssl_zlib/lib64/libz.a"; then - SSL_LINK_WITH_ZLIB=yes - STATIC_ZLIB_LIBS=$with_ssl_zlib/lib64/libz.a - elif test -f "$with_ssl_zlib/lib/64/libz.a"; then - SSL_LINK_WITH_ZLIB=yes - STATIC_ZLIB_LIBS=$with_ssl_zlib/lib/64/libz.a - fi - fi - if test "x$SSL_LINK_WITH_ZLIB" = "xno"; then - AC_MSG_ERROR(Invalid path to option --with-ssl-zlib=PATH) - fi -fi - - -AC_ARG_WITH(ssl, -AS_HELP_STRING([--with-ssl=PATH], [specify location of OpenSSL include and lib]) -AS_HELP_STRING([--with-ssl], [use SSL (default)]) -AS_HELP_STRING([--without-ssl], [don't use SSL])) - -AC_ARG_WITH(ssl-incl, -AS_HELP_STRING([--with-ssl-incl=PATH], [location of OpenSSL include dir, if different than specified by --with-ssl=PATH]), -[ -case X$with_ssl in - X | Xyes | Xno) AC_MSG_ERROR([--with-ssl-incl=PATH set without --with-ssl=PATH]);; -esac -], -[with_ssl_incl=$with_ssl]) #default - -AC_ARG_WITH(ssl-rpath, -AS_HELP_STRING([--with-ssl-rpath=yes|no|PATHS], - [runtime library path for OpenSSL. Default is "yes", which equates to a - number of standard locations. If "no", then no runtime - library paths will be used. Anything else should be a - comma separated list of paths.]), -[ -case X$with_ssl in - Xno) AC_MSG_ERROR([--with-ssl-rpath set without --with-ssl]);; -esac -], -[with_ssl_rpath=yes]) #default - - -AC_ARG_ENABLE(dynamic-ssl-lib, -AS_HELP_STRING([--disable-dynamic-ssl-lib], - [disable using dynamic openssl libraries]), -[ case "$enableval" in - no) enable_dynamic_ssl=no ;; - *) enable_dynamic_ssl=yes ;; - esac ], enable_dynamic_ssl=yes) - -#---------------------------------------------------------------------- -# We actually might do the SSL tests twice due to late discovery of -# kerberos problems with static linking, in case we redo it all trying -# dynamic SSL libraries instead. -#---------------------------------------------------------------------- - -ssl_done=no - -while test "x$ssl_done" != "xyes"; do - -ssl_done=yes # Default only one run - -# Remove all SKIP files from previous runs -for a in ssl crypto ssh; do - $RM -f $ERL_TOP/lib/$a/SKIP -done - -SSL_DYNAMIC_ONLY=$enable_dynamic_ssl -SSL_STATIC_ONLY=no - -case "$erl_xcomp_without_sysroot-$with_ssl" in - yes-* | no-no) - SSL_APP= - CRYPTO_APP= - SSH_APP= - if test "$with_ssl" = "no"; then - skip="User gave --without-ssl option" - else - skip="Cannot search for ssl; missing cross system root (erl_xcomp_sysroot)." - fi - for a in ssl crypto ssh; do - echo "$skip" > $ERL_TOP/lib/$a/SKIP - done - ;; - no-yes | no- ) - # On windows, we could try to find the installation - # of Shining Light OpenSSL, which can be found by poking in - # the uninstall section in the registry, it's worth a try... - extra_dir="" - if test "x$MIXED_CYGWIN" = "xyes"; then - AC_CHECK_PROG(REGTOOL, regtool, regtool, false) - if test "$ac_cv_prog_REGTOOL" != false; then - wrp="/machine/software/microsoft/windows/currentversion/" - if test "x$ARCH" = "xamd64"; then - urp="uninstall/openssl (64-bit)_is1/inno setup: app path" - regtool_subsystem=-w - else - urp="uninstall/openssl (32-bit)_is1/inno setup: app path" - regtool_subsystem=-W - fi - rp="$wrp$urp" - if regtool -q $regtool_subsystem get "$rp" > /dev/null; then - true - else - # Fallback to unspecified wordlength - urp="uninstall/openssl_is1/inno setup: app path" - rp="$wrp$urp" - fi - if regtool -q $regtool_subsystem get "$rp" > /dev/null; then - ssl_install_dir=`regtool -q $regtool_subsystem get "$rp"` - # Try hard to get rid of spaces... - if cygpath -d "$ssl_install_dir" > /dev/null 2>&1; then - ssl_install_dir=`cygpath -d "$ssl_install_dir"` - fi - extra_dir=`cygpath $ssl_install_dir` - fi - fi - elif test "x$MIXED_MSYS" = "xyes"; then - AC_CHECK_PROG(REGTOOL, reg_query.sh, reg_query.sh, false) - if test "$ac_cv_prog_REGTOOL" != false; then - if test "x$ARCH" = "xamd64"; then - rp="HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/OpenSSL (64-bit)_is1" - else - rp="HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/OpenSSL_is1" - fi - key="Inno Setup: App Path" - if "$ac_cv_prog_REGTOOL" "$rp" "$key" > /dev/null; then - ssl_install_dir=`"$ac_cv_prog_REGTOOL" "$rp" "$key"` - extra_dir=`win2msys_path.sh "$ssl_install_dir"` - fi - fi - fi - # We search for OpenSSL in the common OS standard locations. - SSL_APP=ssl - CRYPTO_APP=crypto - SSH_APP=ssh - - SSL_CRYPTO_LIBNAME=crypto - SSL_SSL_LIBNAME=ssl - - if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then - if test "x$ARCH" = "xamd64"; then - std_win_ssl_locations="/cygdrive/c/OpenSSL-Win64 /c/OpenSSL-Win64 /opt/local64/pgm/OpenSSL" - else - std_win_ssl_locations="/cygdrive/c/OpenSSL-Win32 /c/OpenSSL-Win32 /cygdrive/c/OpenSSL /c/OpenSSL /opt/local/pgm/OpenSSL" - fi - else - std_win_ssl_locations="" - fi - - - AC_MSG_CHECKING(for OpenSSL >= 0.9.8c in standard locations) - for rdir in $extra_dir $std_win_ssl_locations $std_ssl_locations; do - dir="$erl_xcomp_sysroot$rdir" - if test -f "$erl_xcomp_isysroot$rdir/include/openssl/opensslv.h"; then - is_real_ssl=yes - SSL_INCDIR="$dir" - if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then - if test -f "$dir/lib/VC/libeay32.lib"; then - SSL_RUNTIME_LIBDIR="$rdir/lib/VC" - SSL_LIBDIR="$dir/lib/VC" - SSL_CRYPTO_LIBNAME=libeay32 - SSL_SSL_LIBNAME=ssleay32 - elif test -f "$dir/lib/VC/openssl.lib"; then - SSL_RUNTIME_LIBDIR="$rdir/lib/VC" - SSL_LIBDIR="$dir/lib/VC" - elif test -f $dir/lib/VC/libeay32MD.lib; then - SSL_CRYPTO_LIBNAME=libeay32MD - SSL_SSL_LIBNAME=ssleay32MD - if test "x$enable_dynamic_ssl" = "xno" && \ - test -f $dir/lib/VC/static/libeay32MD.lib; then - SSL_RUNTIME_LIBDIR="$rdir/lib/VC/static" - SSL_LIBDIR="$dir/lib/VC/static" - else - SSL_RUNTIME_LIBDIR="$rdir/lib/VC" - SSL_LIBDIR="$dir/lib/VC" - fi - elif test -f "$dir/lib/libeay32.lib"; then - SSL_RUNTIME_LIBDIR="$rdir/lib" - SSL_LIBDIR="$dir/lib" - SSL_CRYPTO_LIBNAME=libeay32 - SSL_SSL_LIBNAME=ssleay32 - elif test -f "$dir/lib/openssl.lib"; then - SSL_RUNTIME_LIBDIR="$rdir/lib" - SSL_LIBDIR="$dir/lib" - else - is_real_ssl=no - fi - elif test -f "$dir/lib/powerpc/libsslcrypto.a"; then - SSL_CRYPTO_LIBNAME=sslcrypto - SSL_LIBDIR="$dir/lib/powerpc/" - SSL_RUNTIME_LIBDIR="$rdir/lib/powerpc/" - else - if test "x$ac_cv_sizeof_void_p" = "x8"; then - if test -f "$dir/lib64/libcrypto.a"; then - SSL_RUNTIME_LIBDIR="$rdir/lib64" - SSL_LIBDIR="$dir/lib64" - elif test -f "$dir/lib/64/libcrypto.a"; then - SSL_RUNTIME_LIBDIR="$rdir/lib/64" - SSL_LIBDIR="$dir/lib/64" - elif test -f "$dir/lib64/libcrypto.so"; then - SSL_RUNTIME_LIBDIR="$rdir/lib64" - SSL_LIBDIR="$dir/lib64" - elif test -f "$dir/lib/64/libcrypto.so"; then - SSL_RUNTIME_LIBDIR="$rdir/lib/64" - SSL_LIBDIR="$dir/lib/64" - else - SSL_RUNTIME_LIBDIR="$rdir/lib" - SSL_LIBDIR="$dir/lib" - fi - else - SSL_RUNTIME_LIBDIR="$rdir/lib" - SSL_LIBDIR="$dir/lib" - fi - fi - if test '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.a"; then - SSL_DYNAMIC_ONLY=yes - elif test '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.so" -a '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.dylib"; then - SSL_STATIC_ONLY=yes - fi - SSL_BINDIR="$rdir/bin" - if test "x$is_real_ssl" = "xyes" ; then - SSL_INCLUDE="-I$dir/include" - old_CPPFLAGS=$CPPFLAGS - CPPFLAGS=$SSL_INCLUDE - AC_EGREP_CPP(^yes$,[ -#include <openssl/opensslv.h> -#if OPENSSL_VERSION_NUMBER >= 0x0090803fL -yes -#endif - ],[ - ssl_found=yes - ],[ - SSL_APP= - ssl_found=no - ]) - CPPFLAGS=$old_CPPFLAGS - if test "x$ssl_found" = "xyes"; then - if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then - ssl_linkable=yes - elif test "x${SSL_CRYPTO_LIBNAME}" = "xsslcrypto"; then - # This should only be triggered seen OSE - ssl_linkable=yes - else - saveCFLAGS="$CFLAGS" - saveLDFLAGS="$LDFLAGS" - saveLIBS="$LIBS" - CFLAGS="$CFLAGS $SSL_INCLUDE" - if test "x$SSL_STATIC_ONLY" = "xyes"; then - LIBS="${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.a" - else - LDFLAGS="$LDFLAGS -L$SSL_LIBDIR" - LIBS="$LIBS -l${SSL_CRYPTO_LIBNAME}" - fi - AC_TRY_LINK([ - #include <stdio.h> - #include <openssl/hmac.h>], - [ - HMAC(0, 0, 0, 0, 0, 0, 0); - ], - [ssl_linkable=yes], - [ssl_linkable=no]) - CFLAGS="$saveCFLAGS" - LDFLAGS="$saveLDFLAGS" - LIBS="$saveLIBS" - fi - fi - if test "x$ssl_found" = "xyes" && test "x$ssl_linkable" = "xyes"; then - AC_MSG_RESULT([$dir]) - break; - fi - fi - fi - done - - if test "x$ssl_found" != "xyes" ; then - dnl - dnl If no SSL found above, check whether we are running on OpenBSD. - dnl - case $host_os in - openbsd*) - if test -f "$erl_xcomp_isysroot/usr/include/openssl/opensslv.h"; then - # Trust OpenBSD to have everything the in the correct locations. - ssl_found=yes - ssl_linkable=yes - SSL_INCDIR="$erl_xcomp_sysroot/usr" - AC_MSG_RESULT([$SSL_INCDIR]) - SSL_RUNTIME_LIB="/usr/lib" - SSL_LIB="$erl_xcomp_sysroot/usr/lib" - SSL_BINDIR="/usr/sbin" - dnl OpenBSD requires us to link with -L and -l - SSL_DYNAMIC_ONLY="yes" - fi - ;; - esac - fi -dnl Now, certain linuxes have a 64bit libcrypto -dnl that cannot build shared libraries (i.e. not PIC) -dnl One could argue that this is wrong, but -dnl so it is - be adoptable - if test "$ssl_found" = "yes" && test "$ssl_linkable" = "yes" && test "$SSL_DYNAMIC_ONLY" != "yes"; then - case $host_os in - linux*) - saveCFLAGS="$CFLAGS" - saveLDFLAGS="$LDFLAGS" - saveLIBS="$LIBS" - CFLAGS="$DED_CFLAGS $SSL_INCLUDE" - LDFLAGS="$DED_LDFLAGS" - LIBS="$SSL_LIBDIR/libcrypto.a $STATIC_ZLIB_LIBS" - AC_TRY_LINK([ - #include <stdio.h> - #include <openssl/hmac.h>], - [ - HMAC(0, 0, 0, 0, 0, 0, 0); - ], - [ssl_dyn_linkable=yes], - [ssl_dyn_linkable=no]) - CFLAGS="$saveCFLAGS" - LDFLAGS="$saveLDFLAGS" - LIBS="$saveLIBS" - if test "x$ssl_dyn_linkable" != "xyes"; then - SSL_DYNAMIC_ONLY=yes - AC_MSG_WARN([SSL will be linked against dynamic lib as static lib is not purely relocatable]) - fi - ;; - esac - fi - - - - - if test "x$ssl_found" != "xyes" || test "x$ssl_linkable" != "xyes"; then - if test "x$ssl_found" = "xyes"; then - AC_MSG_RESULT([found; but not usable]) - else - AC_MSG_RESULT([no]) - fi - SSL_APP= - CRYPTO_APP= - SSH_APP= - AC_MSG_WARN([No (usable) OpenSSL found, skipping ssl, ssh and crypto applications]) - - for a in ssl crypto ssh; do - echo "No usable OpenSSL found" > $ERL_TOP/lib/$a/SKIP - done - fi - ;; - *) - # Option given with PATH to package - if test ! -d "$with_ssl" ; then - AC_MSG_ERROR(Invalid path to option --with-ssl=PATH) - fi - if test ! -d "$with_ssl_incl" ; then - AC_MSG_ERROR(Invalid path to option --with-ssl-incl=PATH) - fi - SSL_INCDIR="$with_ssl_incl" - SSL_CRYPTO_LIBNAME=crypto - SSL_SSL_LIBNAME=ssl - if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes" && test -d "$with_ssl/lib/VC"; then - if test -f "$with_ssl/lib/VC/libeay32.lib"; then - SSL_LIBDIR="$with_ssl/lib/VC" - SSL_CRYPTO_LIBNAME=libeay32 - SSL_SSL_LIBNAME=ssleay32 - elif test -f "$with_ssl/lib/VC/openssl.lib"; then - SSL_LIBDIR="$with_ssl/lib/VC" - elif test -f $with_ssl/lib/VC/libeay32MD.lib; then - SSL_CRYPTO_LIBNAME=libeay32MD - SSL_SSL_LIBNAME=ssleay32MD - if test "x$enable_dynamic_ssl" = "xno" && \ - test -f $with_ssl/lib/VC/static/libeay32MD.lib; then - SSL_LIBDIR="$with_ssl/lib/VC/static" - else - SSL_LIBDIR="$with_ssl/lib/VC" - fi - elif test -f "$with_ssl/lib/libeay32.lib"; then - SSL_LIBDIR="$with_ssl/lib" - SSL_CRYPTO_LIBNAME=libeay32 - SSL_SSL_LIBNAME=ssleay32 - else - # This probably wont work, but that's what the user said, so... - SSL_LIBDIR="$with_ssl/lib" - fi - elif test -f "$dir/lib/powerpc/libsslcrypto.a"; then - SSL_CRYPTO_LIBNAME=sslcrypto - SSL_LIBDIR="$with_ssl/lib/powerpc/" - elif test "x$ac_cv_sizeof_void_p" = "x8"; then - if test -f "$with_ssl/lib64/libcrypto.a"; then - SSL_LIBDIR="$with_ssl/lib64" - elif test -f "$with_ssl/lib/64/libcrypto.a"; then - SSL_LIBDIR="$with_ssl/lib/64" - elif test -f "$with_ssl/lib64/libcrypto.so"; then - SSL_LIBDIR="$with_ssl/lib64" - elif test -f "$with_ssl/lib/64/libcrypto.so"; then - SSL_LIBDIR="$with_ssl/lib/64" - else - SSL_LIBDIR="$with_ssl/lib" - fi - else - SSL_LIBDIR="$with_ssl/lib" - fi - if test '!' -f "${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.a"; then - SSL_DYNAMIC_ONLY=yes - elif test '!' -f ${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.so -a '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.dylib"; then - SSL_STATIC_ONLY=yes - fi - SSL_INCLUDE="-I$with_ssl_incl/include" - SSL_APP=ssl - CRYPTO_APP=crypto - SSH_APP=ssh - if test "$cross_compiling" = "yes"; then - SSL_RUNTIME_LIBDIR=`echo "$SSL_LIBDIR" | sed -n "s|^$erl_xcomp_sysroot\(/*\)\(.*\)\$|/\2|p"` - else - SSL_RUNTIME_LIBDIR="$SSL_LIBDIR" - fi -esac - -if test "x$SSL_APP" != "x" ; then - dnl We found openssl, now check if we use kerberos 5 support - dnl FIXME: Do we still support platforms that have Kerberos? - AC_MSG_CHECKING(for OpenSSL kerberos 5 support) - old_CPPFLAGS=$CPPFLAGS - CPPFLAGS=$SSL_INCLUDE - AC_EGREP_CPP(^yes$,[ -#include <openssl/opensslv.h> -#include <openssl/opensslconf.h> -#if OPENSSL_VERSION_NUMBER < 0x1010000fL && !defined(OPENSSL_NO_KRB5) -yes -#endif - ],[ - AC_MSG_RESULT([yes]) - ssl_krb5_enabled=yes - if test "x$SSL_DYNAMIC_ONLY" != "xyes"; then - if test -f "$SSL_LIBDIR/libkrb5.a"; then - SSL_LINK_WITH_KERBEROS=yes - STATIC_KERBEROS_LIBS="$SSL_LIBDIR/libkrb5.a" - if test -f "$SSL_LIBDIR/libkrb5support.a"; then - STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libkrb5support.a" - fi - if test -f "$SSL_LIBDIR/libk5crypto.a"; then - STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libk5crypto.a" - fi - if test -f "$SSL_LIBDIR/libresolv.a"; then - STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libresolv.a" - fi - if test -f "$SSL_LIBDIR/libcom_err.a"; then - STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libcom_err.a" - fi - else - AC_MSG_WARN([Kerberos needed but no kerberos static libraries found]) - AC_MSG_WARN([Rescanning for dynamic SSL libraries]) - enable_dynamic_ssl=yes - ssl_done=no - SSL_LINK_WITH_KERBEROS=no - STATIC_KERBEROS_LIBS="" - ssl_krb5_enabled=no - SSL_WITH_KERBEROS=no - fi - else - SSL_LINK_WITH_KERBEROS=no - STATIC_KERBEROS_LIBS="" - fi - ],[ - AC_MSG_RESULT([no]) - ssl_krb5_enabled=no - SSL_WITH_KERBEROS=no - ]) - CPPFLAGS=$old_CPPFLAGS - SSL_KRB5_INCLUDE= - if test "x$ssl_krb5_enabled" = "xyes" ; then - AC_MSG_CHECKING(for krb5.h in standard locations) - for dir in $extra_dir "$SSL_INCDIR/include" "$SSL_INCDIR/include/openssl" \ - "$SSL_INCDIR/include/kerberos" \ - "$erl_xcomp_isysroot/cygdrive/c/kerberos/include" \ - "$erl_xcomp_isysroot/usr/local/kerberos/include" \ - "$erl_xcomp_isysroot/usr/kerberos/include" \ - "$erl_xcomp_isysroot/usr/include" - do - if test -f "$dir/krb5.h" ; then - SSL_KRB5_INCLUDE="$dir" - break - fi - done - if test "x$SSL_KRB5_INCLUDE" = "x" ; then - AC_MSG_RESULT([not found]) - SSL_APP= - CRYPTO_APP= - SSH_APP= - AC_MSG_WARN([OpenSSL is configured for kerberos but no krb5.h found]) - for a in ssl crypto ssh ; do - echo "OpenSSL is configured for kerberos but no krb5.h found" > $ERL_TOP/lib/$a/SKIP - done - else - AC_MSG_RESULT([found in $SSL_KRB5_INCLUDE]) - SSL_INCLUDE="$SSL_INCLUDE -I$SSL_KRB5_INCLUDE" - fi - fi -fi - -done # while test ssl_done != yes - -SSL_CC_RUNTIME_LIBRARY_PATH= -SSL_LD_RUNTIME_LIBRARY_PATH= -SSL_DED_LD_RUNTIME_LIBRARY_PATH= -cc_rflg="$CFLAG_RUNTIME_LIBRARY_PATH" -ld_rflg="$LDFLAG_RUNTIME_LIBRARY_PATH" -ded_ld_rflg="$DED_LD_FLAG_RUNTIME_LIBRARY_PATH" - - -case "$with_ssl_rpath" in - -yes) # Use standard lib locations for ssl runtime library path - - if test "$SSL_APP" != "" && test "$SSL_DYNAMIC_ONLY" = "yes" && \ - { test "$cc_rflg" != "" || test "$ld_rflg" != "" || test "$ded_ld_rflg" != ""; } ; then - - AC_MSG_CHECKING(for ssl runtime library path to use) - - libdirs="/lib" - - if test "$ac_cv_sizeof_void_p" = "8"; then - dir_lib64=no - dir_lib_64=no - - case "$SSL_RUNTIME_LIBDIR" in - */lib/64 | */lib/64/ ) dir_lib_64=yes;; - */lib64 | */lib64/ ) dir_lib64=yes;; - *) ;; - esac - - for dir in $std_ssl_locations; do - test $dir_lib_64 = no && - test -d "$erl_xcomp_sysroot$dir/lib/64" && - dir_lib_64=yes - test $dir_lib64 = no && - test -d "$erl_xcomp_sysroot$dir/lib64" && - dir_lib64=yes - done - - test $dir_lib_64 = yes && libdirs="/lib/64 $libdirs" - test $dir_lib64 = yes && libdirs="/lib64 $libdirs" - fi - - for type in std x_std curr; do - - cc_rpath="$cc_rflg$SSL_RUNTIME_LIBDIR" - ld_rpath="$ld_rflg$SSL_RUNTIME_LIBDIR" - ded_ld_rpath="$ded_ld_rflg$SSL_RUNTIME_LIBDIR" - rpath="$SSL_RUNTIME_LIBDIR" - - if test $type != curr; then - for ldir in $libdirs; do - for dir in $std_ssl_locations; do - test "$SSL_LIBDIR" != "$dir$ldir" || continue - test $type != x_std || test -d "$dir$ldir" || continue - test "$cc_rflg" = "" || - cc_rpath="$cc_rpath $cc_rflg$dir$ldir" - test "$ld_rflg" = "" || - ld_rpath="$ld_rpath $ld_rflg$dir$ldir" - test "$ded_ld_rflg" = "" || - ded_ld_rpath="$ded_ld_rpath $ded_ld_rflg$dir$ldir" - rpath="$rpath:$dir$ldir" - done - done - fi - - saveCFLAGS="$CFLAGS" - saveLDFLAGS="$LDFLAGS" - saveLIBS="$LIBS" - CFLAGS="$CFLAGS $SSL_INCLUDE" - LDFLAGS="$LDFLAGS $ld_rpath -L$SSL_LIBDIR" - LIBS="-lcrypto" - AC_TRY_LINK([ - #include <stdio.h> - #include <openssl/hmac.h> - ], - [ - HMAC(0, 0, 0, 0, 0, 0, 0); - ], - [rpath_success=yes], - [rpath_success=no]) - CFLAGS="$saveCFLAGS" - LDFLAGS="$saveLDFLAGS" - LIBS="$saveLIBS" - - test "$rpath_success" = "yes" && break - done - - test "$rpath_success" = "yes" || { cc_rpath=; ld_rpath=; ded_ld_rpath=; rpath=; } - - SSL_CC_RUNTIME_LIBRARY_PATH="$cc_rpath" - SSL_LD_RUNTIME_LIBRARY_PATH="$ld_rpath" - SSL_DED_LD_RUNTIME_LIBRARY_PATH="$ded_ld_rpath" - - AC_MSG_RESULT([$rpath]) - test "$rpath" != "" || AC_MSG_WARN([Cannot set run path during linking]) - fi - ;; - -no) # Use no ssl runtime library path - SSL_DED_LD_RUNTIME_LIBRARY_PATH= - ;; - -*) # Use ssl runtime library paths set by --with-ssl-rpath (without any check) - ded_ld_rpath= - delimit= - for dir in `echo $with_ssl_rpath | sed "s/,/ /g"`; do - ded_ld_rpath="$ded_ld_rpath$delimit$ded_ld_rflg$dir" - delimit=" " - done - SSL_DED_LD_RUNTIME_LIBRARY_PATH="$ded_ld_rpath" - ;; - -esac - - -AC_ARG_ENABLE(fips, -AS_HELP_STRING([--enable-fips], [enable OpenSSL FIPS mode support]) -AS_HELP_STRING([--disable-fips], [disable OpenSSL FIPS mode support (default)]), -[ case "$enableval" in - yes) enable_fips_support=yes ;; - *) enable_fips_support=no ;; - esac ], enable_fips_support=no) - -if test "x$enable_fips_support" = "xyes" && test "$CRYPTO_APP" != ""; then - saveCFLAGS="$CFLAGS" - saveLDFLAGS="$LDFLAGS" - saveLIBS="$LIBS" - CFLAGS="$CFLAGS $SSL_INCLUDE" - LDFLAGS="$LDFLAGS $SSL_LD_RUNTIME_LIBRARY_PATH -L$SSL_LIBDIR" - LIBS="-lcrypto" - AC_CHECK_FUNC([FIPS_mode_set], - [SSL_FLAGS="-DFIPS_SUPPORT"], - [SSL_FLAGS=]) - CFLAGS="$saveCFLAGS" - LDFLAGS="$saveLDFLAGS" - LIBS="$saveLIBS" -else - SSL_FLAGS= -fi - #-------------------------------------------------------------------- # Os mon stuff. #-------------------------------------------------------------------- @@ -4126,6 +3218,8 @@ AC_DEFINE_UNQUOTED(ERTS_EMU_CMDLINE_FLAGS, "$STATIC_CFLAGS $CFLAGS $DEBUG_CFLAGS $EMU_THR_DEFS $DEFS $WERRORFLAGS $WFLAGS", [The only reason ERTS_EMU_CMDLINE_FLAGS exists is to force modification of config.h when the emulator command line flags are modified by configure]) +AC_SUBST(STATIC_CFLAGS) + dnl ---------------------------------------------------------------------- dnl Directories needed for the build dnl ---------------------------------------------------------------------- @@ -4228,7 +3322,6 @@ AC_CONFIG_FILES([ include/internal/$host/erts_internal.mk:include/internal/erts_internal.mk.in lib_src/$host/Makefile:lib_src/Makefile.in ../make/$host/otp.mk:../make/otp.mk.in - ../make/$host/otp_ded.mk:../make/otp_ded.mk.in ]) AC_CONFIG_FILES([../make/make_emakefile:../make/make_emakefile.in], @@ -4240,7 +3333,6 @@ dnl dnl ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in AC_CONFIG_FILES([ ../lib/os_mon/c_src/$host/Makefile:../lib/os_mon/c_src/Makefile.in - ../lib/crypto/c_src/$host/Makefile:../lib/crypto/c_src/Makefile.in ../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in ../lib/tools/c_src/$host/Makefile:../lib/tools/c_src/Makefile.in ]) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 8e014c3010..bd33e35603 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1751,6 +1751,10 @@ true</pre> <item> <p><c>Pid</c> is the process identifier of the process that originally created the fun.</p> + <p>It might point to the <c>init</c> process if the + <c>Fun</c> was statically allocated when module was + loaded (this optimisation is performed for local + functions that do not capture the enviornment).</p> </item> <tag><c>{index, Index}</c></tag> <item> diff --git a/erts/doc/src/escript.xml b/erts/doc/src/escript.xml index 9b0d42185e..be1664b39f 100644 --- a/erts/doc/src/escript.xml +++ b/erts/doc/src/escript.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>2007</year><year>2017</year> + <year>2007</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -155,9 +155,12 @@ io:setopts([{encoding, unicode}])</code> for example:</p> <pre> halt(1).</pre> - <p>To retrieve the pathname of the script, call - <seealso marker="#script_name_0"> - <c>escript:script_name()</c></seealso> from your script + <p> + To retrieve the pathname of the script, call + <seealso marker="#script_name-0"> + <c>escript:script_name()</c> + </seealso> + from your script (the pathname is usually, but not always, absolute).</p> <p>If the file contains source code (as in the example above), it is processed by the @@ -229,6 +232,7 @@ $ <input>escript factorial.beam 5</input> factorial 5 = 120 $ <input>escript factorial.zip 5</input> factorial 5 = 120</pre> + <marker id="create-2"/> </desc> </func> @@ -259,7 +263,7 @@ factorial 5 = 120</pre> zip:create_option()</seealso>]</v> </type> <desc> - <p><marker id="create_2"></marker> + <p> Creates an escript from a list of sections. The sections can be specified in any order. An escript begins with an optional <c>Header</c> followed by a mandatory <c>Body</c>. If @@ -344,6 +348,7 @@ ok {{2010,3,2},{0,59,22}}, 54,1,0,0,0,0,0}, <<"%% demo.erl\n-module(demo).\n-export([main/1]).\n\n%% Demo\nmain(_Arg"...>>}]}</pre> + <marker id="extract-2"/> </desc> </func> @@ -368,9 +373,11 @@ ok <v>SourceCode = BeamCode = ZipArchive = binary()</v> </type> <desc> - <p><marker id="extract_2"></marker> - Parses an escript and extracts its sections. This is the reverse - of <seealso marker="#create_2"><c>create/2</c></seealso>.</p> + <p> + Parses an escript and extracts its sections. + This is the reverse of + <seealso marker="#create-2"><c>create/2</c></seealso>. + </p> <p>All sections are returned even if they do not exist in the escript. If a particular section happens to have the same value as the default value, the extracted value is set to the @@ -393,6 +400,7 @@ ok {ok,[{{archive,<<80,75,3,4,20,0,0,0,8,0,118,7,98,60,105, 152,61,93,107,0,0,0,118,0,...>>} {emu_args,undefined}]}</pre> + <marker id="script_name-0"/> </desc> </func> @@ -403,7 +411,7 @@ ok <v>File = filename()</v> </type> <desc> - <p><marker id="script_name_0"></marker> + <p> Returns the name of the escript that is executed. If the function is invoked outside the context of an escript, the behavior is undefined.</p> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 5866ee704a..42d883f269 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,123 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 10.0.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A process could get stuck in an infinite rescheduling + loop between normal and dirty schedulers. This bug was + introduced in ERTS version 10.0.</p> + <p> + Thanks to Maxim Fedorov for finding and fixing this + issue.</p> + <p> + Own Id: OTP-15275 Aux Id: PR-1943 </p> + </item> + <item> + <p> + Garbage collection of a distribution entry could cause an + emulator crash if <c>net_kernel</c> had not brought + previous connection attempts on it down properly.</p> + <p> + Own Id: OTP-15279 Aux Id: ERIERL-226 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.0.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A race between termination of a process and resume of the + same process via <c>erlang:resume_process/1</c> could + cause the VM to crash. This bug was introduced in erts + version 10.0 (OTP 21.0).</p> + <p> + Own Id: OTP-15237</p> + </item> + <item> + <p> + When tracing on <c>running</c>, <c>in</c> trace events + could be lost when a process was rescheduled between a + dirty and a normal scheduler.</p> + <p> + Own Id: OTP-15269 Aux Id: ERL-713 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.0.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a bug which caused an emulator crash when + <c>enif_send()</c> was called by a NIF that executed on a + dirty scheduler. The bug was either triggered when the + NIF called <c>enif_send()</c> without a message + environment, or when the process executing the NIF was + <c>send</c> traced.</p> + <p> + Own Id: OTP-15223</p> + </item> + <item> + <p> + Fixed a bug causing some Erlang references to be + inconsistently ordered. This could for example cause + failure to look up certain elements with references as + keys in search data structures. This bug was introduced + in R13B02.</p> + <p> + Thanks to Simon Cornish for finding the bug and supplying + a fix.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-15225</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a bug that prevented the <c>noshell</c> option + from working correctly on Mac OS X and BSD.</p> + <p> + Own Id: OTP-15169</p> + </item> + <item> + <p>Fixed a crash when matching directly against a literal + map using a single key that had been saved on the + stack.</p> + <p> + Own Id: OTP-15184</p> + </item> + <item> + <p>Fix node crash when passing a bad time option to + <c>file:read_file_info/2</c>.</p> + <p> + Own Id: OTP-15196</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 10.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1027,6 +1144,66 @@ </section> +<section><title>Erts 9.3.3.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a bug which caused an emulator crash when + <c>enif_send()</c> was called by a NIF that executed on a + dirty scheduler. The bug was either triggered when the + NIF called <c>enif_send()</c> without a message + environment, or when the process executing the NIF was + <c>send</c> traced.</p> + <p> + Own Id: OTP-15223</p> + </item> + <item> + <p> + Fixed a bug causing some Erlang references to be + inconsistently ordered. This could for example cause + failure to look up certain elements with references as + keys in search data structures. This bug was introduced + in R13B02.</p> + <p> + Thanks to Simon Cornish for finding the bug and supplying + a fix.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-15225</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 9.3.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a race condition in the inet driver that could + cause receive to hang when the emulator was compiled with + gcc 8.</p> + <p> + Own Id: OTP-15158 Aux Id: ERL-654 </p> + </item> + <item> + <p> + Fix bug in generation of erl_crash.dump, which could + cause VM to crash.</p> + <p> + Bug exist since erts-9.2 (OTP-20.2).</p> + <p> + Own Id: OTP-15181</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 9.3.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -2469,6 +2646,63 @@ </section> +<section><title>Erts 8.3.5.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a race condition in the inet driver that could + cause receive to hang when the emulator was compiled with + gcc 8.</p> + <p> + Own Id: OTP-15158 Aux Id: ERL-654 </p> + </item> + <item> + <p> + Fixed a bug causing some Erlang references to be + inconsistently ordered. This could for example cause + failure to look up certain elements with references as + keys in search data structures. This bug was introduced + in R13B02.</p> + <p> + Thanks to Simon Cornish for finding the bug and supplying + a fix.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-15225</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 8.3.5.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a bug in file closure on Unix; close(2) was + retried on EINTR which could cause a different (recently + opened) file to be closed as well.</p> + <p> + Own Id: OTP-14775</p> + </item> + <item> + <p> + A race-condition when tearing down a connection with + active node monitors could cause the runtime system to + crash.</p> + <p> + This bug was introduced in ERTS version 8.0 (OTP 19.0).</p> + <p> + Own Id: OTP-14781 Aux Id: OTP-13047 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 8.3.5.3</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -9879,7 +10113,7 @@ you use erlang:halt/2 with an integer first argument and an option list containing {flush,false} as the second argument. Note that now is flushing not dependant of the - exit code, and you can not only flush async threads + exit code, and you cannot only flush async threads operations which we deemed as a strange behaviour anyway. </p> <p>Also, erlang:halt/1,2 has gotten a new feature: If the diff --git a/erts/doc/src/time_correction.xml b/erts/doc/src/time_correction.xml index 77e7a40529..53b555387c 100644 --- a/erts/doc/src/time_correction.xml +++ b/erts/doc/src/time_correction.xml @@ -940,7 +940,7 @@ EventTag = {Time, UMI}</code> </item> <item> <seealso marker="erlang#system_info_os_system_time_source"> - <c>erlang:system_info(os_system_time_source)</c></seealso>) + <c>erlang:system_info(os_system_time_source)</c></seealso> </item> </list> diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index a0dbd9ec7b..d221e6aea6 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1753,6 +1753,7 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2) if (literals) { ErtsLiteralAreaRef *ref; + ErtsMessage *mp; ref = erts_alloc(ERTS_ALC_T_LITERAL_REF, sizeof(ErtsLiteralAreaRef)); ref->literal_area = literals; @@ -1767,10 +1768,12 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2) release_literal_areas.last = ref; } erts_mtx_unlock(&release_literal_areas.mtx); + mp = erts_alloc_message(0, NULL); + ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_proc_message(BIF_P, erts_literal_area_collector, 0, - erts_alloc_message(0, NULL), + mp, am_copy_literals); } diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 10d20c8f3f..b33aab7eee 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -786,8 +786,8 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_put_tuple_xI: - case op_i_put_tuple_yI: + case op_put_tuple2_xI: + case op_put_tuple2_yI: case op_new_map_dtI: case op_update_map_assoc_sdtI: case op_update_map_exact_jsdtI: @@ -1191,6 +1191,7 @@ dirty_send_message(Process *c_p, Eterm to, Eterm tag) mp = erts_alloc_message_heap(rp, &rp_locks, 3, &hp, &ohp); msg = TUPLE2(hp, tag, c_p->common.id); + ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_proc_message(c_p, rp, rp_locks, mp, msg); if (rp == real_c_p) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index ab5920a67e..aa61a2d7f9 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3061,12 +3061,14 @@ erts_gc_update_map_exact(Process* p, Eterm* reg, Uint live, Uint n, Eterm* new_p Uint need; flatmap_t *old_mp, *mp; Eterm res; + Eterm* old_hp; Eterm* hp; Eterm* E; Eterm* old_keys; Eterm* old_vals; Eterm new_key; Eterm map; + int changed = 0; n /= 2; /* Number of values to be updated */ ASSERT(n > 0); @@ -3133,6 +3135,7 @@ erts_gc_update_map_exact(Process* p, Eterm* reg, Uint live, Uint n, Eterm* new_p * Update map, keeping the old key tuple. */ + old_hp = p->htop; hp = p->htop; E = p->stop; @@ -3155,20 +3158,26 @@ erts_gc_update_map_exact(Process* p, Eterm* reg, Uint live, Uint n, Eterm* new_p /* Not same keys */ *hp++ = *old_vals; } else { - GET_TERM(new_p[1], *hp); - hp++; - n--; + GET_TERM(new_p[1], *hp); + if(*hp != *old_vals) changed = 1; + hp++; + n--; if (n == 0) { - /* - * All updates done. Copy remaining values - * and return the result. - */ - for (i++, old_vals++; i < num_old; i++) { - *hp++ = *old_vals++; - } - ASSERT(hp == p->htop + need); - p->htop = hp; - return res; + /* + * All updates done. Copy remaining values + * if any changed or return the original one. + */ + if(changed) { + for (i++, old_vals++; i < num_old; i++) { + *hp++ = *old_vals++; + } + ASSERT(hp == p->htop + need); + p->htop = hp; + return res; + } else { + p->htop = old_hp; + return map; + } } else { new_p += 2; GET_TERM(*new_p, new_key); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index e61199a8fd..50cbb37f3e 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4245,21 +4245,55 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx) { ErlFunEntry* fe; GenOp* op; + Uint arity, num_free; if (idx.val >= stp->num_lambdas) { - stp->lambda_error = "missing or short chunk 'FunT'"; - fe = 0; + stp->lambda_error = "missing or short chunk 'FunT'"; + fe = 0; + num_free = 0; + arity = 0; } else { - fe = stp->lambdas[idx.val].fe; + fe = stp->lambdas[idx.val].fe; + num_free = stp->lambdas[idx.val].num_free; + arity = fe->arity; } NEW_GENOP(stp, op); - op->op = genop_i_make_fun_2; - op->arity = 2; - op->a[0].type = TAG_u; - op->a[0].val = (BeamInstr) fe; - op->a[1].type = TAG_u; - op->a[1].val = stp->lambdas[idx.val].num_free; + + /* + * It's possible this is called before init process is started, + * skip the optimisation in such case. + */ + if (num_free == 0 && erts_init_process_id != ERTS_INVALID_PID) { + Uint lit; + Eterm* hp; + ErlFunThing* funp; + + lit = new_literal(stp, &hp, ERL_FUN_SIZE); + funp = (ErlFunThing *) hp; + erts_refc_inc(&fe->refc, 2); + funp->thing_word = HEADER_FUN; + funp->next = NULL; + funp->fe = fe; + funp->num_free = 0; + funp->creator = erts_init_process_id; + funp->arity = arity; + + op->op = genop_move_2; + op->arity = 2; + op->a[0].type = TAG_q; + op->a[0].val = lit; + op->a[1].type = TAG_x; + op->a[1].val = 0; + } else { + op->op = genop_i_make_fun_2; + op->arity = 2; + op->a[0].type = TAG_u; + op->a[0].val = (BeamInstr) fe; + op->a[1].type = TAG_u; + op->a[1].val = num_free; + } + op->next = NULL; return op; } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 97e1ee1286..56ac072449 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1803,6 +1803,7 @@ ebif_bang_2(BIF_ALIST_2) #define SEND_INTERNAL_ERROR (-6) #define SEND_AWAIT_RESULT (-7) #define SEND_YIELD_CONTINUE (-8) +#define SEND_SYSTEM_LIMIT (-9) static Sint remote_send(Process *p, DistEntry *dep, @@ -1842,6 +1843,8 @@ static Sint remote_send(Process *p, DistEntry *dep, res = SEND_YIELD_RETURN; else if (code == ERTS_DSIG_SEND_CONTINUE) res = SEND_YIELD_CONTINUE; + else if (code == ERTS_DSIG_SEND_TOO_LRG) + res = SEND_SYSTEM_LIMIT; else res = 0; break; @@ -2063,7 +2066,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) if (p == rp) rp_locks |= ERTS_PROC_LOCK_MAIN; /* send to local process */ - erts_send_message(p, rp, &rp_locks, msg, 0); + erts_send_message(p, rp, &rp_locks, msg); erts_proc_unlock(rp, p == rp ? (rp_locks & ~ERTS_PROC_LOCK_MAIN) @@ -2162,6 +2165,9 @@ BIF_RETTYPE send_3(BIF_ALIST_3) case SEND_BADARG: ERTS_BIF_PREP_ERROR(retval, p, BADARG); break; + case SEND_SYSTEM_LIMIT: + ERTS_BIF_PREP_ERROR(retval, p, SYSTEM_LIMIT); + break; case SEND_USER_ERROR: ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR); break; @@ -2218,6 +2224,10 @@ static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1) BUMP_ALL_REDS(BIF_P); BIF_TRAP1(&dsend_continue_trap_export, BIF_P, BIF_ARG_1); } + case ERTS_DSIG_SEND_TOO_LRG: { /*SEND_SYSTEM_LIMIT*/ + erts_set_gc_state(BIF_P, 1); + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } default: erts_exit(ERTS_ABORT_EXIT, "dsend_continue_trap invalid result %d\n", (int)result); break; @@ -2275,6 +2285,9 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) case SEND_BADARG: ERTS_BIF_PREP_ERROR(retval, p, BADARG); break; + case SEND_SYSTEM_LIMIT: + ERTS_BIF_PREP_ERROR(retval, p, SYSTEM_LIMIT); + break; case SEND_USER_ERROR: ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR); break; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 7548924178..a770524221 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -629,7 +629,6 @@ bif maps:from_list/1 bif maps:is_key/2 bif maps:keys/1 bif maps:merge/2 -bif maps:new/0 bif maps:put/3 bif maps:remove/2 bif maps:update/3 diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 7556205063..a1ad75708c 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -42,7 +42,7 @@ typedef Uint16 ErtsHalfDigit; #undef BIG_HAVE_DOUBLE_DIGIT typedef Uint32 ErtsHalfDigit; #else -#error "can not determine machine size" +#error "cannot determine machine size" #endif typedef Uint dsize_t; /* Vector size type */ diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 9ff52c92b8..81531f6cc8 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -108,6 +108,7 @@ process_killer(void) erts_exit(0, ""); switch(j) { case 'k': + ASSERT(erts_init_process_id != ERTS_INVALID_PID); /* Send a 'kill' exit signal from init process */ erts_proc_sig_send_exit(NULL, erts_init_process_id, rp->common.id, am_kill, NIL, diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 70474898b2..e7c0ee65dc 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1200,21 +1200,8 @@ erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote) #include <valgrind/valgrind.h> #include <valgrind/memcheck.h> -#ifndef HAVE_VALGRIND_PRINTF_XML -#define VALGRIND_PRINTF_XML VALGRIND_PRINTF -#endif - # define PURIFY_MSG(msg) \ - do { \ - char buf__[1]; size_t bufsz__ = sizeof(buf__); \ - if (erts_sys_explicit_8bit_getenv("VALGRIND_LOG_XML", buf__, &bufsz__) >= 0) { \ - VALGRIND_PRINTF_XML("<erlang_error_log>" \ - "%s, line %d: %s</erlang_error_log>\n", \ - __FILE__, __LINE__, msg); \ - } else { \ - VALGRIND_PRINTF("%s, line %d: %s", __FILE__, __LINE__, msg); \ - } \ - } while (0) + VALGRIND_PRINTF("%s, line %d: %s", __FILE__, __LINE__, msg) #else # define PURIFY_MSG(msg) #endif @@ -1937,6 +1924,12 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) ASSERT(ctx->obuf->ext_endp <= &ctx->obuf->data[0] + ctx->data_size); ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp; + if (ctx->data_size > (Uint) INT_MAX) { + free_dist_obuf(ctx->obuf); + ctx->obuf = NULL; + retval = ERTS_DSIG_SEND_TOO_LRG; + goto done; + } ctx->obuf->hopefull_flags = ctx->u.ec.hopefull_flags; /* @@ -3628,6 +3621,12 @@ static Sint abort_connection(DistEntry* dep, Uint32 conn_id) return 0; } +Sint +erts_abort_connection(DistEntry *dep, Uint32 conn_id) +{ + return abort_connection(dep, conn_id); +} + BIF_RETTYPE erts_internal_abort_connection_2(BIF_ALIST_2) { DistEntry* dep; @@ -3685,6 +3684,7 @@ int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks) dhandle = erts_build_dhandle(&hp, ohp, dep); msg = TUPLE4(hp, am_auto_connect, dep->sysname, make_small(conn_id), dhandle); + ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_proc_message(proc, net_kernel, nk_locks, mp, msg); erts_proc_unlock(net_kernel, nk_locks); } diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index dda2029a4c..c8d0407456 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -376,6 +376,7 @@ typedef struct { #define ERTS_DSIG_SEND_OK 0 #define ERTS_DSIG_SEND_YIELD 1 #define ERTS_DSIG_SEND_CONTINUE 2 +#define ERTS_DSIG_SEND_TOO_LRG 3 extern int erts_dsig_send_link(ErtsDSigData *, Eterm, Eterm); extern int erts_dsig_send_msg(Eterm, Eterm, ErtsSendContext*); @@ -399,5 +400,7 @@ extern void erts_kill_dist_connection(DistEntry *dep, Uint32); extern Uint erts_dist_cache_size(void); +extern Sint erts_abort_connection(DistEntry *dep, Uint32 conn_id); + #endif diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 166d5c48a5..36c46fd7aa 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -111,7 +111,7 @@ typedef union { char align_afa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(AFAllctr_t))]; AOFFAllctr_t aoffa; char align_aoffa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(AOFFAllctr_t))]; -} ErtsAllocatorState_t; +} ErtsAllocatorState_t erts_align_attribute(ERTS_CACHE_LINE_SIZE); static ErtsAllocatorState_t std_alloc_state; static ErtsAllocatorState_t ll_alloc_state; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 5409b89bab..f1e99820af 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -30,10 +30,10 @@ # name space). # * Types, allocators, classes, and descriptions have different name # spaces. -# * The type, allocator, and class names INVALID are reserved and can -# not be used. +# * The type, allocator, and class names INVALID are reserved and +# cannot be used. # * The descriptions invalid_allocator, invalid_class, and invalid_type -# are reserved and can not be used. +# are reserved and cannot be used. # * Declarations can be done conditionally by use of a # +if <boolean_variable> # diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index a2610bf2e1..ff919082c3 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -208,8 +208,8 @@ typedef struct _ac_trie { typedef struct _bm_data { byte *x; Sint len; + Sint *badshift; Sint *goodshift; - Sint badshift[ALPHABET_SIZE]; } BMData; typedef struct _ac_find_all_state { @@ -319,16 +319,104 @@ static void dump_ac_node(ACNode *node, int indent, int ch); * The needed size of binary data for a search structure - given the * accumulated string lengths. */ -#define BM_SIZE(StrLen) /* StrLen: length of searchstring */ \ -((MYALIGN(sizeof(Sint) * (StrLen))) + /* goodshift array */ \ - MYALIGN(StrLen) + /* searchstring saved */ \ - (MYALIGN(sizeof(BMData)))) /* Structure */ +#define BM_SIZE_SINGLE() /* Single byte search string */ \ +(MYALIGN(1) + /* searchstring saved */ \ + (MYALIGN(sizeof(BMData)))) /* Structure */ + +#define BM_SIZE_MULTI(StrLen) /* StrLen: length of searchstring */ \ +((MYALIGN(sizeof(Uint) * (StrLen))) + /* goodshift array */ \ + (MYALIGN(sizeof(Uint) * ALPHABET_SIZE)) + /* badshift array */ \ + MYALIGN(StrLen) + /* searchstring saved */ \ + (MYALIGN(sizeof(BMData)))) /* Structure */ #define AC_SIZE(StrLens) /* StrLens: sum of all searchstring lengths */ \ ((MYALIGN(sizeof(ACNode)) * \ ((StrLens)+1)) + /* The actual nodes (including rootnode) */ \ MYALIGN(sizeof(ACTrie))) /* Structure */ +/* + * Boyer Moore - most obviously implemented more or less exactly as + * Christian Charras and Thierry Lecroq describe it in "Handbook of + * Exact String-Matching Algorithms" + * http://www-igm.univ-mlv.fr/~lecroq/string/ + */ + +/* + * Call this to compute badshifts array + */ +static void compute_badshifts(BMData *bmd) +{ + Sint i; + Sint m = bmd->len; + + for (i = 0; i < ALPHABET_SIZE; ++i) { + bmd->badshift[i] = m; + } + for (i = 0; i < m - 1; ++i) { + bmd->badshift[bmd->x[i]] = m - i - 1; + } +} + +/* Helper for "compute_goodshifts" */ +static void compute_suffixes(byte *x, Sint m, Sint *suffixes) +{ + int f,g,i; + + suffixes[m - 1] = m; + + f = 0; /* To avoid use before set warning */ + + g = m - 1; + + for (i = m - 2; i >= 0; --i) { + if (i > g && suffixes[i + m - 1 - f] < i - g) { + suffixes[i] = suffixes[i + m - 1 - f]; + } else { + if (i < g) { + g = i; + } + f = i; + while ( g >= 0 && x[g] == x[g + m - 1 - f] ) { + --g; + } + suffixes[i] = f - g; + } + } +} + +/* + * Call this to compute goodshift array + */ +static void compute_goodshifts(BMData *bmd) +{ + Sint m = bmd->len; + byte *x = bmd->x; + Sint i, j; + Sint *suffixes = erts_alloc(ERTS_ALC_T_TMP, m * sizeof(Sint)); + + compute_suffixes(x, m, suffixes); + + for (i = 0; i < m; ++i) { + bmd->goodshift[i] = m; + } + + j = 0; + + for (i = m - 1; i >= -1; --i) { + if (i == -1 || suffixes[i] == i + 1) { + while (j < m - 1 - i) { + if (bmd->goodshift[j] == m) { + bmd->goodshift[j] = m - 1 - i; + } + ++j; + } + } + } + for (i = 0; i <= m - 2; ++i) { + bmd->goodshift[m - 1 - suffixes[i]] = m - 1 - i; + } + erts_free(ERTS_ALC_T_TMP, suffixes); +} /* * Callback for the magic binary @@ -377,11 +465,19 @@ static ACTrie *create_acdata(MyAllocator *my, Uint len, /* * The same initialization of allocator and basic data for Boyer-Moore. + * For single byte, we don't use goodshift and badshift, only memchr. */ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len, Binary **the_bin /* out */) { - Uint datasize = BM_SIZE(len); + Uint datasize; + + if(len > 1) { + datasize = BM_SIZE_MULTI(len); + } else { + datasize = BM_SIZE_SINGLE(); + } + BMData *bmd; Binary *mb = erts_create_magic_binary(datasize,cleanup_my_data_bm); byte *data = ERTS_MAGIC_BIN_DATA(mb); @@ -390,7 +486,14 @@ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len, bmd->x = my_alloc(my,len); sys_memcpy(bmd->x,x,len); bmd->len = len; - bmd->goodshift = my_alloc(my,sizeof(Uint) * len); + + if(len > 1) { + bmd->goodshift = my_alloc(my, sizeof(Uint) * len); + bmd->badshift = my_alloc(my, sizeof(Uint) * ALPHABET_SIZE); + compute_badshifts(bmd); + compute_goodshifts(bmd); + } + *the_bin = mb; return bmd; } @@ -711,91 +814,8 @@ static BFReturn ac_find_all_non_overlapping(BinaryFindContext *ctx, byte *haysta return (m == 0) ? BF_NOT_FOUND : BF_OK; } -/* - * Boyer Moore - most obviously implemented more or less exactly as - * Christian Charras and Thierry Lecroq describe it in "Handbook of - * Exact String-Matching Algorithms" - * http://www-igm.univ-mlv.fr/~lecroq/string/ - */ - -/* - * Call this to compute badshifts array - */ -static void compute_badshifts(BMData *bmd) -{ - Sint i; - Sint m = bmd->len; - - for (i = 0; i < ALPHABET_SIZE; ++i) { - bmd->badshift[i] = m; - } - for (i = 0; i < m - 1; ++i) { - bmd->badshift[bmd->x[i]] = m - i - 1; - } -} - -/* Helper for "compute_goodshifts" */ -static void compute_suffixes(byte *x, Sint m, Sint *suffixes) -{ - int f,g,i; - - suffixes[m - 1] = m; - - f = 0; /* To avoid use before set warning */ - - g = m - 1; - - for (i = m - 2; i >= 0; --i) { - if (i > g && suffixes[i + m - 1 - f] < i - g) { - suffixes[i] = suffixes[i + m - 1 - f]; - } else { - if (i < g) { - g = i; - } - f = i; - while ( g >= 0 && x[g] == x[g + m - 1 - f] ) { - --g; - } - suffixes[i] = f - g; - } - } -} - -/* - * Call this to compute goodshift array - */ -static void compute_goodshifts(BMData *bmd) -{ - Sint m = bmd->len; - byte *x = bmd->x; - Sint i, j; - Sint *suffixes = erts_alloc(ERTS_ALC_T_TMP, m * sizeof(Sint)); - - compute_suffixes(x, m, suffixes); - - for (i = 0; i < m; ++i) { - bmd->goodshift[i] = m; - } - - j = 0; - - for (i = m - 1; i >= -1; --i) { - if (i == -1 || suffixes[i] == i + 1) { - while (j < m - 1 - i) { - if (bmd->goodshift[j] == m) { - bmd->goodshift[j] = m - 1 - i; - } - ++j; - } - } - } - for (i = 0; i <= m - 2; ++i) { - bmd->goodshift[m - 1 - suffixes[i]] = m - 1 - i; - } - erts_free(ERTS_ALC_T_TMP, suffixes); -} - #define BM_LOOP_FACTOR 10 /* Should we have a higher value? */ +#define MC_LOOP_FACTOR 8 static void bm_init_find_first_match(BinaryFindContext *ctx) { @@ -819,13 +839,38 @@ static BFReturn bm_find_first_match(BinaryFindContext *ctx, byte *haystack) Sint i; Sint j = state->pos; register Uint reds = *reductions; + byte *pos_pointer; + Sint needle_last = blen - 1; + Sint mem_read = len - needle_last - j; - while (j <= len - blen) { + if (mem_read <= 0) { + return BF_NOT_FOUND; + } + mem_read = MIN(mem_read, reds * MC_LOOP_FACTOR); + ASSERT(mem_read > 0); + + pos_pointer = memchr(&haystack[j + needle_last], needle[needle_last], mem_read); + if (pos_pointer == NULL) { + reds -= mem_read / MC_LOOP_FACTOR; + j += mem_read; + } else { + reds -= (pos_pointer - &haystack[j]) / MC_LOOP_FACTOR; + j = pos_pointer - haystack - needle_last; + } + + // Ensure we have at least one reduction before entering the loop + ++reds; + + for(;;) { + if (j > len - blen) { + *reductions = reds; + return BF_NOT_FOUND; + } if (--reds == 0) { state->pos = j; return BF_RESTART; } - for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i) + for (i = needle_last; i >= 0 && needle[i] == haystack[i + j]; --i) ; if (i < 0) { /* found */ *reductions = reds; @@ -835,8 +880,6 @@ static BFReturn bm_find_first_match(BinaryFindContext *ctx, byte *haystack) } j += MAX(gs[i],bs[haystack[i+j]] - blen + 1 + i); } - *reductions = reds; - return BF_NOT_FOUND; } static void bm_init_find_all(BinaryFindContext *ctx) @@ -875,14 +918,38 @@ static BFReturn bm_find_all_non_overlapping(BinaryFindContext *ctx, byte *haysta Sint *gs = bmd->goodshift; Sint *bs = bmd->badshift; byte *needle = bmd->x; - Sint i; + Sint i = -1; /* Use memchr on start and on every match */ Sint j = state->pos; Uint m = state->m; Uint allocated = state->allocated; FindallData *out = state->out; register Uint reds = *reductions; + byte *pos_pointer; + Sint needle_last = blen - 1; + Sint mem_read; - while (j <= len - blen) { + for(;;) { + if (i < 0) { + mem_read = len - needle_last - j; + if(mem_read <= 0) { + goto done; + } + mem_read = MIN(mem_read, reds * MC_LOOP_FACTOR); + ASSERT(mem_read > 0); + pos_pointer = memchr(&haystack[j + needle_last], needle[needle_last], mem_read); + if (pos_pointer == NULL) { + reds -= mem_read / MC_LOOP_FACTOR; + j += mem_read; + } else { + reds -= (pos_pointer - &haystack[j]) / MC_LOOP_FACTOR; + j = pos_pointer - haystack - needle_last; + } + // Ensure we have at least one reduction when resuming the loop + ++reds; + } + if (j > len - blen) { + goto done; + } if (--reds == 0) { state->pos = j; state->m = m; @@ -890,7 +957,7 @@ static BFReturn bm_find_all_non_overlapping(BinaryFindContext *ctx, byte *haysta state->out = out; return BF_RESTART; } - for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i) + for (i = needle_last; i >= 0 && needle[i] == haystack[i + j]; --i) ; if (i < 0) { /* found */ if (m >= allocated) { @@ -912,6 +979,7 @@ static BFReturn bm_find_all_non_overlapping(BinaryFindContext *ctx, byte *haysta j += MAX(gs[i],bs[haystack[i+j]] - blen + 1 + i); } } + done: state->m = m; state->out = out; *reductions = reds; @@ -931,6 +999,7 @@ static int do_binary_match_compile(Eterm argument, Eterm *tag, Binary **binp) Eterm t, b, comp_term = NIL; Uint characters; Uint words; + Uint size; characters = 0; words = 0; @@ -946,11 +1015,12 @@ static int do_binary_match_compile(Eterm argument, Eterm *tag, Binary **binp) if (binary_bitsize(b) != 0) { goto badarg; } - if (binary_size(b) == 0) { + size = binary_size(b); + if (size == 0) { goto badarg; } ++words; - characters += binary_size(b); + characters += size; } if (is_not_nil(t)) { goto badarg; @@ -987,8 +1057,6 @@ static int do_binary_match_compile(Eterm argument, Eterm *tag, Binary **binp) bytes = erts_get_aligned_binary_bytes(comp_term, &temp_alloc); } bmd = create_bmdata(&my, bytes, characters, &bin); - compute_badshifts(bmd); - compute_goodshifts(bmd); erts_free_aligned_binary_bytes(temp_alloc); CHECK_ALLOCATOR(my); *tag = am_bm; @@ -3012,17 +3080,19 @@ static void dump_bm_data(BMData *bm) } } erts_printf(">>\n"); - erts_printf("GoodShift array:\n"); - for (i = 0; i < bm->len; ++i) { - erts_printf("GoodShift[%d]: %ld\n", i, bm->goodshift[i]); - } - erts_printf("BadShift array:\n"); - j = 0; - for (i = 0; i < ALPHABET_SIZE; i += j) { - for (j = 0; i + j < ALPHABET_SIZE && j < 6; ++j) { - erts_printf("BS[%03d]:%02ld, ", i+j, bm->badshift[i+j]); + if(bm->len > 1) { + erts_printf("GoodShift array:\n"); + for (i = 0; i < bm->len; ++i) { + erts_printf("GoodShift[%d]: %ld\n", i, bm->goodshift[i]); + } + erts_printf("BadShift array:\n"); + j = 0; + for (i = 0; i < ALPHABET_SIZE; i += j) { + for (j = 0; i + j < ALPHABET_SIZE && j < 6; ++j) { + erts_printf("BS[%03d]:%02ld, ", i+j, bm->badshift[i+j]); + } + erts_printf("\n"); } - erts_printf("\n"); } } diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 4cda0948a0..639aee29dc 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -829,7 +829,7 @@ BIF_RETTYPE erl_ddll_format_error_int_1(BIF_ALIST_1) "cannot be loaded/unloaded"; break; case am_permanent: - errstring = "DDLL driver is permanent an can not be unloaded/loaded"; + errstring = "DDLL driver is permanent an cannot be unloaded/loaded"; break; case am_not_loaded: errstring = "DDLL driver is not loaded"; diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 5789fa8e71..7fada0d548 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2093,17 +2093,6 @@ current_stacktrace(ErtsHeapFactory *hfact, Process* rp, return res; } -#if defined(VALGRIND) -static int check_if_xml(void) -{ - char buf[1]; - size_t bufsz = sizeof(buf); - return erts_sys_explicit_8bit_getenv("VALGRIND_LOG_XML", buf, &bufsz) >= 0; -} -#else -#define check_if_xml() 0 -#endif - /* * This function takes care of calls to erlang:system_info/1 when the argument * is a tuple. @@ -2200,15 +2189,9 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ #endif } else if (is_list(*tp)) { #if defined(PURIFY) -#define ERTS_ERROR_CHECKER_PRINTF purify_printf -#define ERTS_ERROR_CHECKER_PRINTF_XML purify_printf +# define ERTS_ERROR_CHECKER_PRINTF purify_printf #elif defined(VALGRIND) -#define ERTS_ERROR_CHECKER_PRINTF VALGRIND_PRINTF -# ifndef HAVE_VALGRIND_PRINTF_XML -# define ERTS_ERROR_CHECKER_PRINTF_XML VALGRIND_PRINTF -# else -# define ERTS_ERROR_CHECKER_PRINTF_XML VALGRIND_PRINTF_XML -# endif +# define ERTS_ERROR_CHECKER_PRINTF VALGRIND_PRINTF #endif ErlDrvSizeT buf_size = 8*1024; /* Try with 8KB first */ char *buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); @@ -2224,12 +2207,7 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ ASSERT(r == buf_size - 1); } buf[buf_size - 1 - r] = '\0'; - if (check_if_xml()) { - ERTS_ERROR_CHECKER_PRINTF_XML("<erlang_info_log>" - "%s</erlang_info_log>\n", buf); - } else { - ERTS_ERROR_CHECKER_PRINTF("%s\n", buf); - } + ERTS_ERROR_CHECKER_PRINTF("%s\n", buf); erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(am_true); #undef ERTS_ERROR_CHECKER_PRINTF diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 36d83d93f4..c009a3bde8 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -3647,6 +3647,7 @@ send_ets_transfer_message(Process *c_p, Process *proc, hd_copy = copy_struct(heir_data, hd_sz, &hp, ohp); sender = c_p->common.id; msg = TUPLE4(hp, am_ETS_TRANSFER, tid, sender, hd_copy); + ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_proc_message(c_p, proc, *locks, mp, msg); } diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index b988a19cf4..752d3ae3a8 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -150,6 +150,22 @@ static ERTS_INLINE Uint hash_to_ix(DbTableHash* tb, HashValue hval) } +static ERTS_INLINE FixedDeletion* alloc_fixdel(DbTableHash* tb) +{ + FixedDeletion* fixd = (FixedDeletion*) erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL, + (DbTable *) tb, + sizeof(FixedDeletion)); + ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion)); + return fixd; +} + +static ERTS_INLINE void free_fixdel(DbTableHash* tb, FixedDeletion* fixd) +{ + erts_db_free(ERTS_ALC_T_DB_FIX_DEL, (DbTable*)tb, + fixd, sizeof(FixedDeletion)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion)); +} + static ERTS_INLINE int link_fixdel(DbTableHash* tb, FixedDeletion* fixd, erts_aint_t fixated_by_me) @@ -160,8 +176,7 @@ static ERTS_INLINE int link_fixdel(DbTableHash* tb, was_next = erts_atomic_read_acqb(&tb->fixdel); do { /* Lockless atomic insertion in linked list: */ if (NFIXED(tb) <= fixated_by_me) { - erts_db_free(ERTS_ALC_T_DB_FIX_DEL, (DbTable*)tb, - fixd, sizeof(FixedDeletion)); + free_fixdel(tb, fixd); return 0; /* raced by unfixer */ } exp_next = was_next; @@ -180,10 +195,7 @@ static ERTS_INLINE int link_fixdel(DbTableHash* tb, static int add_fixed_deletion(DbTableHash* tb, int ix, erts_aint_t fixated_by_me) { - FixedDeletion* fixd = (FixedDeletion*) erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL, - (DbTable *) tb, - sizeof(FixedDeletion)); - ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion)); + FixedDeletion* fixd = alloc_fixdel(tb); fixd->slot = ix; fixd->all = 0; return link_fixdel(tb, fixd, fixated_by_me); @@ -637,11 +649,7 @@ restart: free_me = fixdel; fixdel = fixdel->next; - erts_db_free(ERTS_ALC_T_DB_FIX_DEL, - (DbTable *) tb, - (void *) free_me, - sizeof(FixedDeletion)); - ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion)); + free_fixdel(tb, free_me); work++; } @@ -2338,11 +2346,10 @@ static SWord db_mark_all_deleted_hash(DbTable *tbl, SWord reds) } else { /* First call */ - fixdel = erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL, - (DbTable *) tb, - sizeof(FixedDeletion)); - ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion)); - link_fixdel(tb, fixdel, 0); + int ok; + fixdel = alloc_fixdel(tb); + ok = link_fixdel(tb, fixdel, 0); + ASSERT(ok); (void)ok; i = 0; } @@ -2444,11 +2451,7 @@ static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds) FixedDeletion *fx = fixdel; fixdel = fx->next; - erts_db_free(ERTS_ALC_T_DB_FIX_DEL, - (DbTable *) tb, - (void *) fx, - sizeof(FixedDeletion)); - ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion)); + free_fixdel(tb, fx); if (--reds < 0) { erts_atomic_set_relb(&tb->fixdel, (erts_aint_t)fixdel); return reds; /* Not done */ diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 788718ab09..2eb874b005 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -3126,7 +3126,7 @@ static int partly_bound_can_match_lesser(Eterm partly_bound_1, if (ret) erts_fprintf(stderr," can match lesser than "); else - erts_fprintf(stderr," can not match lesser than "); + erts_fprintf(stderr," cannot match lesser than "); erts_fprintf(stderr,"%T\n",partly_bound_2); #endif return ret; @@ -3144,7 +3144,7 @@ static int partly_bound_can_match_greater(Eterm partly_bound_1, if (ret) erts_fprintf(stderr," can match greater than "); else - erts_fprintf(stderr," can not match greater than "); + erts_fprintf(stderr," cannot match greater than "); erts_fprintf(stderr,"%T\n",partly_bound_2); #endif return ret; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 57c6c10c7f..5da7b43b9e 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -128,7 +128,7 @@ const Eterm etp_hole_marker = 0; static int modified_sched_thread_suggested_stack_size = 0; -Eterm erts_init_process_id; +Eterm erts_init_process_id = ERTS_INVALID_PID; /* * Note about VxWorks: All variables must be initialized by executable code, @@ -2258,6 +2258,7 @@ erl_start(int argc, char **argv) erts_init_process_id = erl_first_process_otp("otp_ring0", NULL, 0, boot_argc, boot_argv); + ASSERT(erts_init_process_id != ERTS_INVALID_PID); { /* diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h index 89d95a73cf..0d47b16e0b 100644 --- a/erts/emulator/beam/erl_lock_count.h +++ b/erts/emulator/beam/erl_lock_count.h @@ -532,7 +532,7 @@ ERTS_GLB_INLINE void lcnt_dec_lock_state__(ethr_atomic_t *l_state) { ethr_sint_t state = ethr_atomic_dec_read_acqb(l_state); - /* We can not assume that state is >= -1 here; unlock and unacquire might + /* We cannot assume that state is >= -1 here; unlock and unacquire might * bring it below -1 and race to increment it back. */ if(state < 0) { diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index cba17d3e6a..3d6c9eb43f 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -1505,25 +1505,6 @@ int hashmap_key_hash_cmp(Eterm* ap, Eterm* bp) return ap ? -1 : 1; } -/* maps:new/0 */ - -BIF_RETTYPE maps_new_0(BIF_ALIST_0) { - Eterm* hp; - Eterm tup; - flatmap_t *mp; - - hp = HAlloc(BIF_P, (MAP_HEADER_FLATMAP_SZ + 1)); - tup = make_tuple(hp); - *hp++ = make_arityval(0); - - mp = (flatmap_t*)hp; - mp->thing_word = MAP_HEADER_FLATMAP; - mp->size = 0; - mp->keys = tup; - - BIF_RET(make_flatmap(mp)); -} - /* maps:put/3 */ BIF_RETTYPE maps_put_3(BIF_ALIST_3) { @@ -1707,11 +1688,16 @@ int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res) return 0; found_key: - *hp++ = value; - vs++; - if (++i < n) - sys_memcpy(hp, vs, (n - i)*sizeof(Eterm)); - *res = make_flatmap(shp); + if(*vs == value) { + HRelease(p, shp + MAP_HEADER_FLATMAP_SZ + n, shp); + *res = map; + } else { + *hp++ = value; + vs++; + if (++i < n) + sys_memcpy(hp, vs, (n - i)*sizeof(Eterm)); + *res = make_flatmap(shp); + } return 1; } @@ -1767,9 +1753,7 @@ Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map) { if (is_immed(key)) { for( i = 0; i < n; i ++) { if (ks[i] == key) { - *hp++ = value; - vs++; - c = 1; + goto found_key; } else { *hp++ = *vs++; } @@ -1777,18 +1761,13 @@ Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map) { } else { for( i = 0; i < n; i ++) { if (EQ(ks[i], key)) { - *hp++ = value; - vs++; - c = 1; + goto found_key; } else { *hp++ = *vs++; } } } - if (c) - return res; - /* the map will grow */ if (n >= MAP_SMALL_MAP_LIMIT) { @@ -1843,6 +1822,18 @@ Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map) { */ *shp = make_pos_bignum_header(0); return res; + +found_key: + if(*vs == value) { + HRelease(p, shp + MAP_HEADER_FLATMAP_SZ + n, shp); + return map; + } else { + *hp++ = value; + vs++; + if (++i < n) + sys_memcpy(hp, vs, (n - i)*sizeof(Eterm)); + return res; + } } ASSERT(is_hashmap(map)); diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 507cc989d2..a3274d7443 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -409,6 +409,11 @@ ErtsMessage* prepend_pending_sig_maybe(Process* sender, Process* receiver, * * @brief Send one message from *NOT* a local process. * + * seq_trace does not work with this type of messages + * to it is set to am_undefined which means that the + * receiving process will not remove the seq_trace token + * when it gets this message. + * */ void erts_queue_message(Process* receiver, ErtsProcLocks receiver_locks, @@ -417,11 +422,19 @@ erts_queue_message(Process* receiver, ErtsProcLocks receiver_locks, ASSERT(is_not_internal_pid(from)); ERL_MESSAGE_TERM(mp) = msg; ERL_MESSAGE_FROM(mp) = from; + ERL_MESSAGE_TOKEN(mp) = am_undefined; queue_messages(receiver, receiver_locks, mp, &mp->next, 1); } /** * @brief Send one message from a local process. + * + * It is up to the caller of this function to set the + * correct seq_trace. The general rule of thumb is that + * it should be set to am_undefined if the message + * cannot be traced using seq_trace, if it can be + * traced it should be set to the trace token. It should + * very rarely be explicitly set to NIL! */ void erts_queue_proc_message(Process* sender, @@ -584,8 +597,7 @@ void erts_send_message(Process* sender, Process* receiver, ErtsProcLocks *receiver_locks, - Eterm message, - unsigned flags) + Eterm message) { Uint msize; ErtsMessage* mp; @@ -619,7 +631,7 @@ erts_send_message(Process* sender, receiver_state = erts_atomic32_read_nob(&receiver->state); - if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) { + if (SEQ_TRACE_TOKEN(sender) != NIL) { Eterm* hp; Eterm stoken = SEQ_TRACE_TOKEN(sender); Uint seq_trace_size = 0; diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index d120111634..b2550814fd 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -405,8 +405,6 @@ typedef struct erl_trace_message_queue__ { #define SAVE_MESSAGE(p) \ (p)->sig_qs.save = &(*(p)->sig_qs.save)->next -#define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0) - #define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \ (sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm)) @@ -429,7 +427,7 @@ typedef struct erl_trace_message_queue__ { do { \ (MP)->next = NULL; \ ERL_MESSAGE_TERM(MP) = THE_NON_VALUE; \ - ERL_MESSAGE_TOKEN(MP) = NIL; \ + ERL_MESSAGE_TOKEN(MP) = THE_NON_VALUE; \ ERL_MESSAGE_FROM(MP) = NIL; \ ERL_MESSAGE_DT_UTAG_INIT(MP); \ MP->data.attached = NULL; \ @@ -446,7 +444,7 @@ void erts_queue_proc_message(Process* from,Process* to, ErtsProcLocks,ErtsMessag void erts_queue_proc_messages(Process* from, Process* to, ErtsProcLocks, ErtsMessage*, ErtsMessage**, Uint); void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm); -void erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned); +void erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm); void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp); Uint erts_msg_attached_data_size_aux(ErtsMessage *msg); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 0fbf0eb03a..7339aa8874 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -453,8 +453,18 @@ static void full_flush_env(ErlNifEnv* env) static void full_cache_env(ErlNifEnv* env) { - if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) + if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) { erts_cache_dirty_shadow_proc(env->proc); + /* + * If shadow proc had heap fragments when flushed + * those have now been moved to the real proc. + * Ensure heap pointers do not point into a heap + * fragment on real proc... + */ + ASSERT(!env->proc->mbuf); + env->hp_end = HEAP_LIMIT(env->proc); + env->hp = HEAP_TOP(env->proc); + } cache_env(env); } @@ -744,8 +754,58 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, rp_locks = ERTS_PROC_LOCK_MAIN; if (menv) { + Eterm token = c_p ? SEQ_TRACE_TOKEN(c_p) : am_undefined; + if (token != NIL && token != am_undefined) { + /* This code is copied from erts_send_message */ + Eterm stoken = SEQ_TRACE_TOKEN(c_p); +#ifdef USE_VM_PROBES + DTRACE_CHARBUF(sender_name, 64); + DTRACE_CHARBUF(receiver_name, 64); + Sint tok_label = 0; + Sint tok_lastcnt = 0; + Sint tok_serial = 0; + Eterm utag = NIL; + *sender_name = *receiver_name = '\0'; + if (DTRACE_ENABLED(message_send)) { + erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), + "%T", c_p->common.id); + erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), + "%T", rp->common.id); + } +#endif + if (have_seqtrace(stoken)) { + seq_trace_update_send(c_p); + seq_trace_output(stoken, msg, SEQ_TRACE_SEND, + rp->common.id, c_p); + } +#ifdef USE_VM_PROBES + if (!(DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING)) { + stoken = NIL; + } +#endif + token = enif_make_copy(msg_env, stoken); + +#ifdef USE_VM_PROBES + if (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING) { + if (is_immed(DT_UTAG(c_p))) + utag = DT_UTAG(c_p); + else + utag = enif_make_copy(msg_env, DT_UTAG(c_p)); + } + if (DTRACE_ENABLED(message_send)) { + if (have_seqtrace(stoken)) { + tok_label = SEQ_TRACE_T_DTRACE_LABEL(stoken); + tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(stoken)); + tok_serial = signed_val(SEQ_TRACE_T_SERIAL(stoken)); + } + DTRACE6(message_send, sender_name, receiver_name, + size_object(msg), tok_label, tok_lastcnt, tok_serial); + } +#endif + } flush_env(msg_env); mp = erts_alloc_message(0, NULL); + ERL_MESSAGE_TOKEN(mp) = token; mp->data.heap_frag = menv->env.heap_frag; ASSERT(mp->data.heap_frag == MBUF(&menv->phony_proc)); if (mp->data.heap_frag != NULL) { @@ -783,6 +843,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, ohp = &bp->off_heap; } } + ERL_MESSAGE_TOKEN(mp) = am_undefined; msg = copy_struct_litopt(msg, sz, &hp, ohp, &litarea); } @@ -826,6 +887,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, ERL_MESSAGE_TERM(mp) = msg; ERL_MESSAGE_FROM(mp) = from; + ERL_MESSAGE_TOKEN(mp) = am_undefined; if (!msgq) { msgq = erts_alloc(ERTS_ALC_T_TRACE_MSG_QUEUE, @@ -978,7 +1040,7 @@ ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term) Eterm* hp; /* * No preserved sharing allowed as long as literals are also preserved. - * Process independent environment can not be reached by purge. + * Process independent environment cannot be reached by purge. */ sz = size_object(src_term); hp = alloc_heap(dst_env, sz); diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 1f147011a8..9b34af1480 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -412,6 +412,44 @@ static void schedule_delete_dist_entry(DistEntry* dep) static void start_timer_delete_dist_entry(void *vdep) { + DistEntry *dep = vdep; + Eterm sysname; + enum dist_entry_state state; + Uint32 connection_id; + + erts_de_rlock(dep); + state = dep->state; + connection_id = dep->connection_id; + sysname = dep->sysname; + erts_de_runlock(dep); + + if (state != ERTS_DE_STATE_IDLE) { + char *state_str; + erts_dsprintf_buf_t *dsbuf = erts_create_logger_dsbuf(); + switch (state) { + case ERTS_DE_STATE_CONNECTED: + state_str = "connected"; + break; + case ERTS_DE_STATE_PENDING: + state_str = "pending connect"; + break; + case ERTS_DE_STATE_EXITING: + state_str = "exiting"; + break; + case ERTS_DE_STATE_IDLE: + state_str = "idle"; + break; + default: + state_str = "unknown"; + break; + } + erts_dsprintf(dsbuf, "Garbage collecting distribution " + "entry for node %T in state: %s", + sysname, state_str); + erts_send_error_to_logger_nogl(dsbuf); + erts_abort_connection(dep, connection_id); + } + if (node_tab_delete_delay == 0) { prepare_try_delete_dist_entry(vdep); } diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index d6d22677e7..f343e984f7 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -52,8 +52,8 @@ #define ERTS_SIG_Q_OP_MAX 13 -#define ERTS_SIG_Q_OP_EXIT 0 -#define ERTS_SIG_Q_OP_EXIT_LINKED 1 +#define ERTS_SIG_Q_OP_EXIT 0 /* Exit signal due to bif call */ +#define ERTS_SIG_Q_OP_EXIT_LINKED 1 /* Exit signal due to link break*/ #define ERTS_SIG_Q_OP_MONITOR_DOWN 2 #define ERTS_SIG_Q_OP_MONITOR 3 #define ERTS_SIG_Q_OP_DEMONITOR 4 @@ -1167,10 +1167,7 @@ erts_proc_sig_send_persistent_monitor_msg(Uint16 type, Eterm key, ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_PERSISTENT_MON_MSG, type, 0); ERL_MESSAGE_FROM(mp) = from; - ERL_MESSAGE_TOKEN(mp) = NIL; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; -#endif + ERL_MESSAGE_TOKEN(mp) = am_undefined; if (!proc_queue_signal(NULL, to, (ErtsSignal *) mp, ERTS_SIG_Q_OP_PERSISTENT_MON_MSG)) { @@ -1564,11 +1561,6 @@ erts_proc_sig_send_is_alive_request(Process *c_p, Eterm to, Eterm ref) ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_IS_ALIVE, ERTS_SIG_Q_TYPE_UNDEFINED, 0); - ERL_MESSAGE_TOKEN(mp) = NIL; - ERL_MESSAGE_FROM(mp) = am_system; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; -#endif if (proc_queue_signal(c_p, to, (ErtsSignal *) mp, ERTS_SIG_Q_OP_IS_ALIVE)) (void) maybe_elevate_sig_handling_prio(c_p, to); @@ -1672,11 +1664,6 @@ erts_proc_sig_send_sync_suspend(Process *c_p, Eterm to, Eterm tag, Eterm reply) ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_SYNC_SUSPEND, ERTS_SIG_Q_TYPE_UNDEFINED, 0); - ERL_MESSAGE_TOKEN(mp) = NIL; - ERL_MESSAGE_FROM(mp) = am_system; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; -#endif if (proc_queue_signal(c_p, to, (ErtsSignal *) mp, ERTS_SIG_Q_OP_SYNC_SUSPEND)) (void) maybe_elevate_sig_handling_prio(c_p, to); @@ -1790,7 +1777,7 @@ handle_rpc(Process *c_p, ErtsProcSigRPC *rpc, int cnt, int limit, int *yieldp) msg = TUPLE2(hp, ref, res); mp->hfrag.next = bp; - + ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_proc_message(c_p, rp, 0, mp, msg); } @@ -2155,10 +2142,7 @@ handle_exit_signal(Process *c_p, ErtsSigRecvTracing *tracing, pid = STORE_NC(&hp, ohp, from); ERL_MESSAGE_TERM(mp) = TUPLE3(hp, am_EXIT, pid, reason); - ERL_MESSAGE_TOKEN(mp) = NIL; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; -#endif + ERL_MESSAGE_TOKEN(mp) = am_undefined; if (is_immed(pid)) ERL_MESSAGE_FROM(mp) = pid; else { @@ -2346,10 +2330,7 @@ convert_to_down_message(Process *c_p, type, from, reason); hp += 6; - ERL_MESSAGE_TOKEN(mp) = NIL; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; -#endif + ERL_MESSAGE_TOKEN(mp) = am_undefined; /* Replace original signal with the exit message... */ convert_to_msg(c_p, sig, mp, next_nm_sig); @@ -2397,10 +2378,7 @@ convert_to_nodedown_messages(Process *c_p, ERL_MESSAGE_TERM(mp) = TUPLE2(hp, am_nodedown, node); ERL_MESSAGE_FROM(mp) = am_system; - ERL_MESSAGE_TOKEN(mp) = NIL; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; -#endif + ERL_MESSAGE_TOKEN(mp) = am_undefined; mp->next = nd_first; nd_first = mp; if (!nd_last) @@ -2830,6 +2808,7 @@ handle_process_info(Process *c_p, ErtsSigRecvTracing *tracing, if (is_alive) erts_factory_trim_and_close(&hfact, &msg, 1); + ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_proc_message(c_p, rp, locks, mp, msg); if (!is_alive && locks) @@ -2931,6 +2910,7 @@ sync_suspend_reply(Process *c_p, ErtsMessage *mp, erts_aint32_t state) tp[2] = ssusp->async ? am_not_suspended : am_internal_error; } } + ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_proc_message(c_p, rp, 0, mp, ssusp->message); } } @@ -3146,8 +3126,8 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), &mdp->origin); omon = &mdp->origin; + remove_nm_sig(c_p, sig, next_nm_sig); } - remove_nm_sig(c_p, sig, next_nm_sig); break; default: ERTS_INTERNAL_ERROR("invalid monitor type"); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 8784eb5a63..0f7f1598fd 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -9079,6 +9079,9 @@ unlock_lock_rq(int pre_free, void *vrq) } +static void trace_schedule_in(Process *p, erts_aint32_t state); +static void trace_schedule_out(Process *p, erts_aint32_t state); + /* * schedule() is called from BEAM (process_main()) or HiPE * (hipe_mode_switch()) when the current process is to be @@ -9184,22 +9187,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) state = erts_atomic32_read_nob(&p->state); - if (IS_TRACED(p)) { - if (IS_TRACED_FL(p, F_TRACE_CALLS) && !(state & ERTS_PSFLG_FREE)) - erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_OUT); - if ((state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) { - if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) - trace_sched(p, ERTS_PROC_LOCK_MAIN, - ((state & ERTS_PSFLG_FREE) - ? am_out_exited - : am_out_exiting)); - } - else { - if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || - ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) - trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out); - } - } + if (IS_TRACED(p)) + trace_schedule_out(p, state); erts_proc_lock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); @@ -9610,6 +9599,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) /* Migrate to dirty scheduler... */ sunlock_sched_out_proc: erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (IS_TRACED(p)) + trace_schedule_in(p, state); goto sched_out_proc; } } @@ -9643,29 +9634,14 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - /* Clear tracer if it has been removed */ - if (IS_TRACED(p) && erts_is_tracer_proc_enabled( - p, ERTS_PROC_LOCK_MAIN, &p->common)) { - - if (state & ERTS_PSFLG_EXITING) { - if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) - trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in_exiting); - } - else { - if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || - ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) - trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in); - } - if (IS_TRACED_FL(p, F_TRACE_CALLS)) { - erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_IN); - } - } + if (IS_TRACED(p)) + trace_schedule_in(p, state); if (is_normal_sched) { if (state & ERTS_PSFLG_RUNNING_SYS) { if (state & (ERTS_PSFLG_SIG_Q|ERTS_PSFLG_SIG_IN_Q)) { int local_only = (!!(p->flags & F_LOCAL_SIGS_ONLY) - & !(state & ERTS_PSFLG_SUSPENDED)); + & !(state & (ERTS_PSFLG_SUSPENDED|ERTS_PSFLGS_DIRTY_WORK))); if (!local_only | !!(state & ERTS_PSFLG_SIG_Q)) { int sig_reds; /* @@ -9823,6 +9799,53 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) } } +static void +trace_schedule_in(Process *p, erts_aint32_t state) +{ + ASSERT(IS_TRACED(p)); + ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCK_MAIN); + + /* Clear tracer if it has been removed */ + if (erts_is_tracer_proc_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common)) { + + if (state & ERTS_PSFLG_EXITING) { + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in_exiting); + } + else { + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || + ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in); + } + if (IS_TRACED_FL(p, F_TRACE_CALLS)) + erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_IN); + } + +} + +static void +trace_schedule_out(Process *p, erts_aint32_t state) +{ + ASSERT(IS_TRACED(p)); + ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCK_MAIN); + + if (IS_TRACED_FL(p, F_TRACE_CALLS) && !(state & ERTS_PSFLG_FREE)) + erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_OUT); + + if ((state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) { + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) + trace_sched(p, ERTS_PROC_LOCK_MAIN, + ((state & ERTS_PSFLG_FREE) + ? am_out_exited + : am_out_exiting)); + } + else { + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || + ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out); + } +} + static int notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result, int normal_sched) @@ -9874,6 +9897,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, ASSERT(hp_start + hsz == hp); #endif + ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_proc_message(c_p, rp, rp_locks, mp, msg); if (c_p == rp) diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 243db4c734..706530023b 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -963,12 +963,16 @@ dump_module_literals(fmtfn_t to, void *to_arg, ErtsLiteralArea* lit_area) } erts_putc(to, to_arg, '\n'); } - } else if (is_export_header(w)) { + } else if (is_export_header(w) || is_fun_header(w)) { dump_externally(to, to_arg, term); erts_putc(to, to_arg, '\n'); } size = 1 + header_arity(w); switch (w & _HEADER_SUBTAG_MASK) { + case FUN_SUBTAG: + ASSERT(((ErlFunThing*)(htop))->num_free == 0); + size += 1; + break; case MAP_SUBTAG: if (is_flatmap_header(w)) { size += 1 + flatmap_get_size(htop); diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index 42c1168f85..da1dd3dc45 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -559,17 +559,19 @@ update_list(Hd, Dst) { HTOP += 2; } -i_put_tuple := i_put_tuple.make.fill; - -i_put_tuple.make(Dst) { - $Dst = make_tuple(HTOP); -} - -i_put_tuple.fill(Arity) { +put_tuple2(Dst, Arity) { Eterm* hp = HTOP; Eterm arity = $Arity; + /* + * If operands are not packed (in the 32-bit VM), + * is is not safe to use $Dst directly after I + * has been updated. + */ + Eterm* dst_ptr = &($Dst); + //| -no_next + ASSERT(arity != 0); *hp++ = make_arityval(arity); I = $NEXT_INSTRUCTION; do { @@ -586,6 +588,7 @@ i_put_tuple.fill(Arity) { break; } } while (--arity != 0); + *dst_ptr = make_tuple(HTOP); HTOP = hp; ASSERT(VALID_INSTR(* (Eterm *)I)); Goto(*I); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 2446b3c074..133ab485d9 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -3287,7 +3287,6 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, if (trace_send) trace_port_send(prt, to, tuple, 1); - ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id); if (rp_locks) erts_proc_unlock(rp, rp_locks); @@ -3459,7 +3458,6 @@ deliver_vec_message(Port* prt, /* Port */ if (IS_TRACED_FL(prt, F_TRACE_SEND)) trace_port_send(prt, to, tuple, 1); - ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id); erts_proc_unlock(rp, rp_locks); if (!scheduler) @@ -5382,7 +5380,6 @@ void driver_report_exit(ErlDrvPort ix, int status) if (IS_TRACED_FL(prt, F_TRACE_SEND)) trace_port_send(prt, pid, tuple, 1); - ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id); erts_proc_unlock(rp, rp_locks); @@ -5988,8 +5985,6 @@ driver_deliver_term(Port *prt, Eterm to, ErlDrvTermData* data, int len) from = prt->common.id; } - /* send message */ - ERL_MESSAGE_TOKEN(factory.message) = am_undefined; erts_queue_message(rp, rp_locks, factory.message, mess, from); } else if (res == -2) { diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 88ede3bb60..d859c4bb24 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -244,7 +244,7 @@ if_end # Optimize for that case. raise x==2 x==1 => i_raise raise Trace=y Value=y => move Trace x=2 | move Value x=1 | i_raise -raise Trace Value => move Trace x=3 | move Value x=1 | move x=3 x=2 | i_raise +raise Trace Value => move Trace x | move Value x=1 | move x x=2 | i_raise i_raise @@ -483,9 +483,16 @@ is_eq f? s s is_ne f? s s # -# Putting things. +# Putting tuples. +# +# Code compiled with OTP 22 and later uses put_tuple2 to +# to construct a tuple. +# +# Code compiled before OTP 22 uses put_tuple + one put instruction +# per element. Translate to put_tuple2. # +i_put_tuple/2 put_tuple Arity Dst => i_put_tuple Dst u i_put_tuple Dst Arity Puts=* | put S1 | put S2 | \ @@ -495,11 +502,13 @@ i_put_tuple Dst Arity Puts=* | put S1 | put S2 | \ i_put_tuple Dst Arity Puts=* | put S => \ tuple_append_put(Arity, Dst, Puts, S) -i_put_tuple/2 +i_put_tuple Dst Arity Puts=* => put_tuple2 Dst Arity Puts -i_put_tuple xy I +put_tuple2 xy I # +# Putting lists. +# # The instruction "put_list Const [] Dst" were generated in rare # circumstances up to and including OTP 18. Starting with OTP 19, # AFAIK, it should never be generated. @@ -1097,23 +1106,29 @@ i_bs_match_string x f W W bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) +i_bs_get_integer_small_imm Ms Bits Fail Flags Y=y => \ + i_bs_get_integer_small_imm Ms Bits Fail Flags x | move x Y + +i_bs_get_integer_imm Ms Bits Live Fail Flags Y=y => \ + i_bs_get_integer_imm Ms Bits Live Fail Flags x | move x Y + i_bs_get_integer_small_imm x W f? t x i_bs_get_integer_imm x W t f? t x -i_bs_get_integer f? t t x s x -i_bs_get_integer_8 x f? x -i_bs_get_integer_16 x f? x +i_bs_get_integer f? t t x s xy +i_bs_get_integer_8 x f? xy +i_bs_get_integer_16 x f? xy %if ARCH_64 -i_bs_get_integer_32 x f? x +i_bs_get_integer_32 x f? xy %endif # Fetching binaries from binaries. bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -i_bs_get_binary_imm2 f? x t W t x -i_bs_get_binary2 f x t? s t x -i_bs_get_binary_all2 f? x t t x +i_bs_get_binary_imm2 f? x t W t xy +i_bs_get_binary2 f x t? s t xy +i_bs_get_binary_all2 f? x t t xy i_bs_get_binary_all_reuse x f? t # Fetching float from binaries. @@ -1122,7 +1137,7 @@ bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail -i_bs_get_float2 f? x t s t x +i_bs_get_float2 f? x t s t xy # Miscellanous @@ -1156,14 +1171,14 @@ bs_context_to_binary x # Utf8/utf16/utf32 support. (R12B-5) # bs_get_utf8 Fail=f Ms=x u u Dst=d => i_bs_get_utf8 Ms Fail Dst -i_bs_get_utf8 x f? x +i_bs_get_utf8 x f? xy bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail x bs_get_utf16 Fail=f Ms=x u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst bs_skip_utf16 Fail=f Ms=x u Flags=u => i_bs_get_utf16 Ms Fail Flags x -i_bs_get_utf16 x f? t x +i_bs_get_utf16 x f? t xy bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \ @@ -1182,6 +1197,9 @@ i_bs_validate_unicode_retract j s S bs_init2 Fail Sz Words Regs Flags Dst | binary_too_big(Sz) => system_limit Fail +bs_init2 Fail Sz Words Regs Flags Dst=y => \ + bs_init2 Fail Sz Words Regs Flags x | move x Dst + bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst => i_bs_init Sz Regs Dst bs_init2 Fail Sz=u Words Regs Flags Dst => \ @@ -1202,6 +1220,8 @@ i_bs_init_heap W I t? x bs_init_bits Fail Sz=o Words Regs Flags Dst => system_limit Fail +bs_init_bits Fail Sz Words Regs Flags Dst=y => \ + bs_init_bits Fail Sz Words Regs Flags x | move x Dst bs_init_bits Fail Sz=u Words=u==0 Regs Flags Dst => i_bs_init_bits Sz Regs Dst bs_init_bits Fail Sz=u Words Regs Flags Dst => i_bs_init_bits_heap Sz Words Regs Dst @@ -1230,7 +1250,7 @@ bs_private_append Fail Size Unit Bin Flags Dst => \ bs_init_writable -i_bs_append j? I t? t s x +i_bs_append j? I t? t s xy i_bs_private_append j? t s S x # @@ -1421,16 +1441,13 @@ get_map_elements Fail Src Size Rest=* | map_key_sort(Size, Rest) => \ i_get_map_elements f? s I -i_get_map_element Fail Src=xy Key=y Dst => \ - move Key x | i_get_map_element Fail Src x Dst - i_get_map_element_hash Fail Src=c Key Hash Dst => \ move Src x | i_get_map_element_hash Fail x Key Hash Dst i_get_map_element_hash f? xy c I xy i_get_map_element Fail Src=c Key Dst => \ move Src x | i_get_map_element Fail x Key Dst -i_get_map_element f? xy x xy +i_get_map_element f? xy xy xy # # Convert the plus operations to a generic plus instruction. diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 19b1312ee3..996757ef43 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1569,7 +1569,7 @@ make_hash2(Eterm term) * MUST BE USED AS INPUT FOR THE HASH. Two different terms must always have a * chance of hashing different when salted: hash([Salt|A]) vs hash([Salt|B]). * - * This is why we can not use cached hash values for atoms for example. + * This is why we cannot use cached hash values for atoms for example. * */ @@ -3122,7 +3122,7 @@ tailrecur_ne: ASSERT(alen == blen); for (i = (Sint) alen - 1; i >= 0; i--) if (anum[i] != bnum[i]) - RETURN_NEQ((Sint32) (anum[i] - bnum[i])); + RETURN_NEQ(anum[i] < bnum[i] ? -1 : 1); goto pop_next; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): if (is_internal_ref(b)) { diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 5e9afdc5ca..91381bd60d 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -1549,6 +1549,8 @@ static void *realloc_wrapper(void *current, ErlDrvSizeT size){ # define LOAD_ASSOC_ID LOAD_UINT # define LOAD_ASSOC_ID_CNT LOAD_UINT_CNT # define SCTP_ANC_BUFF_SIZE INET_DEF_BUFFER/2 /* XXX: not very good... */ +#else +# define IS_SCTP(desc) 0 #endif #ifdef HAVE_UDP @@ -1785,6 +1787,7 @@ static void release_buffer(ErlDrvBinary* buf) #ifdef HAVE_UDP static ErlDrvBinary* realloc_buffer(ErlDrvBinary* buf, ErlDrvSizeT newsz) { + DEBUGF(("realloc_buffer: %ld -> %ld\r\n", (buf==NULL) ? 0 : buf->orig_size, newsz)); return driver_realloc_binary(buf, newsz); } #endif @@ -4390,7 +4393,7 @@ static void desc_close_read(inet_descriptor* desc) { if (desc->s != INVALID_SOCKET) { #ifdef __WIN32__ - /* This call can not be right??? + /* This call cannot be right??? * We want to turn off read events but keep any write events. * But on windows driver_select(...,READ,1) is only used as a * way to hook into the pollset. sock_select is used to control @@ -6435,7 +6438,12 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) (long)desc->port, desc->s, res)); if (type == SO_RCVBUF) { /* make sure we have desc->bufsz >= SO_RCVBUF */ - if (ival > desc->bufsz) + if (ival > (1 << 16) && desc->stype == SOCK_DGRAM && !IS_SCTP(desc)) + /* For UDP we don't want to automatically + set the buffer size to be larger than + the theoretical max MTU */ + desc->bufsz = 1 << 16; + else if (ival > desc->bufsz) desc->bufsz = ival; } } @@ -12042,15 +12050,11 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event) sys_memzero((char *) &other, sizeof(other)); /* udesc->i_buf is only kept between SCTP fragments */ - if (udesc->i_buf == NULL) { - udesc->i_bufsz = desc->bufsz + len; - if ((udesc->i_buf = alloc_buffer(udesc->i_bufsz)) == NULL) - return packet_error(udesc, ENOMEM); - /* pointer to message start */ - udesc->i_ptr = udesc->i_buf->orig_bytes + len; - } else { - ErlDrvBinary* tmp; +#ifdef HAVE_SCTP + if (udesc->i_buf != NULL) { + ErlDrvBinary* tmp; int bufsz; + ASSERT(IS_SCTP(desc)); bufsz = desc->bufsz + (udesc->i_ptr - udesc->i_buf->orig_bytes); if ((tmp = realloc_buffer(udesc->i_buf, bufsz)) == NULL) { release_buffer(udesc->i_buf); @@ -12062,6 +12066,15 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event) udesc->i_buf = tmp; udesc->i_bufsz = bufsz; } + } else +#endif + { + ASSERT(udesc->i_buf == NULL); + udesc->i_bufsz = desc->bufsz + len; + if ((udesc->i_buf = alloc_buffer(udesc->i_bufsz)) == NULL) + return packet_error(udesc, ENOMEM); + /* pointer to message start */ + udesc->i_ptr = udesc->i_buf->orig_bytes + len; } /* Note: On Windows NT, recvfrom() fails if the socket is connected. */ @@ -12120,6 +12133,14 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event) ) { sock_select(desc,FD_READ,1); } +#ifdef HAVE_SCTP + if (!short_recv) { +#endif + release_buffer(udesc->i_buf); + udesc->i_buf = NULL; +#ifdef HAVE_SCTP + } +#endif return count; /* strange, not ready */ } diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 28c6cc0f94..11bb4373d8 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -31,7 +31,7 @@ static int ttysl_init(void); static ErlDrvData ttysl_start(ErlDrvPort, char*); -#ifdef HAVE_TERMCAP /* else make an empty driver that can not be opened */ +#ifdef HAVE_TERMCAP /* else make an empty driver that cannot be opened */ #ifndef WANT_NONBLOCKING #define WANT_NONBLOCKING diff --git a/erts/emulator/internal_doc/CarrierMigration.md b/erts/emulator/internal_doc/CarrierMigration.md index 6c79bd731c..bb3d8aac28 100644 --- a/erts/emulator/internal_doc/CarrierMigration.md +++ b/erts/emulator/internal_doc/CarrierMigration.md @@ -203,8 +203,8 @@ limited. We only inspect a limited number of carriers. If none of those carriers had a free block large enough to satisfy the allocation request, the search will fail. A carrier in the pool can also be BUSY if another thread is currently doing block deallocation work on the -carrier. A BUSY carrier will also be skipped by the search as it can -not satisfy the request. The pool is lock-free and we do not want to +carrier. A BUSY carrier will also be skipped by the search as it cannot +satisfy the request. The pool is lock-free and we do not want to block, waiting for the other thread to finish. ### The bad cluster problem ### diff --git a/erts/emulator/pcre/LICENCE b/erts/emulator/pcre/LICENCE new file mode 100644 index 0000000000..f6ef7fd766 --- /dev/null +++ b/erts/emulator/pcre/LICENCE @@ -0,0 +1,93 @@ +PCRE LICENCE +------------ + +PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + +Release 8 of PCRE is distributed under the terms of the "BSD" licence, as +specified below. The documentation for PCRE, supplied in the "doc" +directory, is distributed under the same terms as the software itself. The data +in the testdata directory is not copyrighted and is in the public domain. + +The basic library functions are written in C and are freestanding. Also +included in the distribution is a set of C++ wrapper functions, and a +just-in-time compiler that can be used to optimize pattern matching. These +are both optional features that can be omitted when the library is built. + + +THE BASIC LIBRARY FUNCTIONS +--------------------------- + +Written by: Philip Hazel +Email local part: ph10 +Email domain: cam.ac.uk + +University of Cambridge Computing Service, +Cambridge, England. + +Copyright (c) 1997-2018 University of Cambridge +All rights reserved. + + +PCRE JUST-IN-TIME COMPILATION SUPPORT +------------------------------------- + +Written by: Zoltan Herczeg +Email local part: hzmester +Emain domain: freemail.hu + +Copyright(c) 2010-2018 Zoltan Herczeg +All rights reserved. + + +STACK-LESS JUST-IN-TIME COMPILER +-------------------------------- + +Written by: Zoltan Herczeg +Email local part: hzmester +Emain domain: freemail.hu + +Copyright(c) 2009-2018 Zoltan Herczeg +All rights reserved. + + +THE C++ WRAPPER FUNCTIONS +------------------------- + +Contributed by: Google Inc. + +Copyright (c) 2007-2012, Google Inc. +All rights reserved. + + +THE "BSD" LICENCE +----------------- + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the name of Google + Inc. nor the names of their contributors may be used to endorse or + promote products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. + +End diff --git a/erts/emulator/pcre/README.pcre_update.md b/erts/emulator/pcre/README.pcre_update.md index 599e3d0d12..5df1e15bde 100644 --- a/erts/emulator/pcre/README.pcre_update.md +++ b/erts/emulator/pcre/README.pcre_update.md @@ -723,6 +723,12 @@ requires thorough reading of all new text. For the upgrade from 7.6 to 8.33, the update of the pcrepattern part of our manual page took about eight hours. +## Update Licence + +Copy the LICENCE file to `erts/emulator/pcre/LICENCE` and update +the `[PCRE]` section in `system/COPYRIGHT` with the content of +the `LICENCE` file. + ## Add new relevant options to re Then, when all this is done, you should add any new relevant options diff --git a/erts/emulator/pcre/local_config.h b/erts/emulator/pcre/local_config.h index c6af423d72..c3b4dab586 100644 --- a/erts/emulator/pcre/local_config.h +++ b/erts/emulator/pcre/local_config.h @@ -86,4 +86,4 @@ #define SUPPORT_UTF /* Version number of package */ -#define VERSION "8.41" +#define VERSION "8.42" diff --git a/erts/emulator/pcre/pcre-8.41.tar.bz2 b/erts/emulator/pcre/pcre-8.41.tar.bz2 Binary files differdeleted file mode 100644 index 1798432dc9..0000000000 --- a/erts/emulator/pcre/pcre-8.41.tar.bz2 +++ /dev/null diff --git a/erts/emulator/pcre/pcre-8.42.tar.bz2 b/erts/emulator/pcre/pcre-8.42.tar.bz2 Binary files differnew file mode 100644 index 0000000000..61bfa38970 --- /dev/null +++ b/erts/emulator/pcre/pcre-8.42.tar.bz2 diff --git a/erts/emulator/pcre/pcre.h b/erts/emulator/pcre/pcre.h index ab8f40cfc1..3563791223 100644 --- a/erts/emulator/pcre/pcre.h +++ b/erts/emulator/pcre/pcre.h @@ -43,9 +43,9 @@ POSSIBILITY OF SUCH DAMAGE. /* The current PCRE version information. */ #define PCRE_MAJOR 8 -#define PCRE_MINOR 41 +#define PCRE_MINOR 42 #define PCRE_PRERELEASE -#define PCRE_DATE 2017-07-05 +#define PCRE_DATE 2018-03-20 /* When an application links to a PCRE DLL in Windows, the symbols that are imported have to be identified as such. When building PCRE, the appropriate @@ -328,11 +328,11 @@ these bits, just add new ones on the end, in order to remain compatible. */ /* Types */ -struct real_pcre; /* declaration; the definition is private */ -typedef struct real_pcre pcre; +struct real_pcre8_or_16; /* declaration; the definition is private */ +typedef struct real_pcre8_or_16 pcre; -struct real_pcre16; /* declaration; the definition is private */ -typedef struct real_pcre16 pcre16; +struct real_pcre8_or_16; /* declaration; the definition is private */ +typedef struct real_pcre8_or_16 pcre16; struct real_pcre32; /* declaration; the definition is private */ typedef struct real_pcre32 pcre32; diff --git a/erts/emulator/pcre/pcre_chartables.c b/erts/emulator/pcre/pcre_chartables.c index b3d9020f25..06482c08d2 100644 --- a/erts/emulator/pcre/pcre_chartables.c +++ b/erts/emulator/pcre/pcre_chartables.c @@ -19,7 +19,9 @@ array definition from the final binary if PCRE is built into a static library and dead code stripping is activated. This leads to link errors. Pulling in the header ensures that the array gets flagged as "someone outside this compilation unit might reference this" and so it will always be supplied to the linker. */ + /* %ExternalCopyright% */ + #ifdef HAVE_CONFIG_H #include "config.h" #endif diff --git a/erts/emulator/pcre/pcre_compile.c b/erts/emulator/pcre/pcre_compile.c index e79284ab79..ae7f6e2a2a 100644 --- a/erts/emulator/pcre/pcre_compile.c +++ b/erts/emulator/pcre/pcre_compile.c @@ -8061,7 +8061,7 @@ for (;; ptr++) single group (i.e. not to a duplicated name. */ HANDLE_REFERENCE: - if (firstcharflags == REQ_UNSET) firstcharflags = REQ_NONE; + if (firstcharflags == REQ_UNSET) zerofirstcharflags = firstcharflags = REQ_NONE; previous = code; item_hwm_offset = cd->hwm - cd->start_workspace; *code++ = ((options & PCRE_CASELESS) != 0)? OP_REFI : OP_REF; diff --git a/erts/emulator/pcre/pcre_dfa_exec.c b/erts/emulator/pcre/pcre_dfa_exec.c index c859d67fc7..c101656fd7 100644 --- a/erts/emulator/pcre/pcre_dfa_exec.c +++ b/erts/emulator/pcre/pcre_dfa_exec.c @@ -2288,12 +2288,14 @@ for (;;) case OP_NOTI: if (clen > 0) { - unsigned int otherd; + pcre_uint32 otherd; #ifdef SUPPORT_UTF if (utf && d >= 128) { #ifdef SUPPORT_UCP otherd = UCD_OTHERCASE(d); +#else + otherd = d; #endif /* SUPPORT_UCP */ } else diff --git a/erts/emulator/pcre/pcre_exec.c b/erts/emulator/pcre/pcre_exec.c index 6708ba92a6..1946e97a72 100644 --- a/erts/emulator/pcre/pcre_exec.c +++ b/erts/emulator/pcre/pcre_exec.c @@ -6,7 +6,7 @@ and semantics are as close as possible to those of the Perl 5 language. Written by Philip Hazel - Copyright (c) 1997-2014 University of Cambridge + Copyright (c) 1997-2018 University of Cambridge ----------------------------------------------------------------------------- Redistribution and use in source and binary forms, with or without @@ -2407,7 +2407,7 @@ for (;;) case OP_ANY: if (IS_NEWLINE(eptr)) RRETURN(MATCH_NOMATCH); if (md->partial != 0 && - eptr + 1 >= md->end_subject && + eptr == md->end_subject - 1 && NLBLOCK->nltype == NLTYPE_FIXED && NLBLOCK->nllen == 2 && UCHAR21TEST(eptr) == NLBLOCK->nl[0]) @@ -3167,7 +3167,7 @@ for (;;) { RMATCH(eptr, ecode, offset_top, md, eptrb, RM18); if (rrc != MATCH_NOMATCH) RRETURN(rrc); - if (eptr-- == pp) break; /* Stop if tried at original pos */ + if (eptr-- <= pp) break; /* Stop if tried at original pos */ BACKCHAR(eptr); } } @@ -3326,7 +3326,7 @@ for (;;) { RMATCH(eptr, ecode, offset_top, md, eptrb, RM21); if (rrc != MATCH_NOMATCH) RRETURN(rrc); - if (eptr-- == pp) break; /* Stop if tried at original pos */ + if (eptr-- <= pp) break; /* Stop if tried at original pos */ #ifdef SUPPORT_UTF if (utf) BACKCHAR(eptr); #endif diff --git a/erts/emulator/pcre/pcre_jit_compile.c b/erts/emulator/pcre/pcre_jit_compile.c index 932ca2c389..926e40f6d3 100644 --- a/erts/emulator/pcre/pcre_jit_compile.c +++ b/erts/emulator/pcre/pcre_jit_compile.c @@ -164,7 +164,6 @@ typedef struct jit_arguments { const pcre_uchar *begin; const pcre_uchar *end; int *offsets; - pcre_uchar *uchar_ptr; pcre_uchar *mark_ptr; void *callout_data; /* Everything else after. */ @@ -214,7 +213,7 @@ enum control_types { type_then_trap = 1 }; -typedef int (SLJIT_CALL *jit_function)(jit_arguments *args); +typedef int (SLJIT_FUNC *jit_function)(jit_arguments *args); /* The following structure is the key data type for the recursive code generator. It is allocated by compile_matchingpath, and contains @@ -489,9 +488,24 @@ typedef struct compare_context { /* Used for accessing the elements of the stack. */ #define STACK(i) ((i) * (int)sizeof(sljit_sw)) +#ifdef SLJIT_PREF_SHIFT_REG +#if SLJIT_PREF_SHIFT_REG == SLJIT_R2 +/* Nothing. */ +#elif SLJIT_PREF_SHIFT_REG == SLJIT_R3 +#define SHIFT_REG_IS_R3 +#else +#error "Unsupported shift register" +#endif +#endif + #define TMP1 SLJIT_R0 +#ifdef SHIFT_REG_IS_R3 +#define TMP2 SLJIT_R3 +#define TMP3 SLJIT_R2 +#else #define TMP2 SLJIT_R2 #define TMP3 SLJIT_R3 +#endif #define STR_PTR SLJIT_S0 #define STR_END SLJIT_S1 #define STACK_TOP SLJIT_R1 @@ -520,13 +534,10 @@ the start pointers when the end of the capturing group has not yet reached. */ #if defined COMPILE_PCRE8 #define MOV_UCHAR SLJIT_MOV_U8 -#define MOVU_UCHAR SLJIT_MOVU_U8 #elif defined COMPILE_PCRE16 #define MOV_UCHAR SLJIT_MOV_U16 -#define MOVU_UCHAR SLJIT_MOVU_U16 #elif defined COMPILE_PCRE32 #define MOV_UCHAR SLJIT_MOV_U32 -#define MOVU_UCHAR SLJIT_MOVU_U32 #else #error Unsupported compiling mode #endif @@ -2383,12 +2394,25 @@ if (length < 8) } else { - GET_LOCAL_BASE(SLJIT_R1, 0, OVECTOR_START); - OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_IMM, length - 1); - loop = LABEL(); - OP1(SLJIT_MOVU, SLJIT_MEM1(SLJIT_R1), sizeof(sljit_sw), SLJIT_R0, 0); - OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, 1); - JUMPTO(SLJIT_NOT_ZERO, loop); + if (sljit_emit_mem(compiler, SLJIT_MOV | SLJIT_MEM_SUPP | SLJIT_MEM_STORE | SLJIT_MEM_PRE, SLJIT_R0, SLJIT_MEM1(SLJIT_R1), sizeof(sljit_sw)) == SLJIT_SUCCESS) + { + GET_LOCAL_BASE(SLJIT_R1, 0, OVECTOR_START); + OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_IMM, length - 1); + loop = LABEL(); + sljit_emit_mem(compiler, SLJIT_MOV | SLJIT_MEM_STORE | SLJIT_MEM_PRE, SLJIT_R0, SLJIT_MEM1(SLJIT_R1), sizeof(sljit_sw)); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, 1); + JUMPTO(SLJIT_NOT_ZERO, loop); + } + else + { + GET_LOCAL_BASE(SLJIT_R1, 0, OVECTOR_START + sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_IMM, length - 1); + loop = LABEL(); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_R1), 0, SLJIT_R0, 0); + OP2(SLJIT_ADD, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, sizeof(sljit_sw)); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, 1); + JUMPTO(SLJIT_NOT_ZERO, loop); + } } } @@ -2421,12 +2445,25 @@ if (length < 8) } else { - GET_LOCAL_BASE(TMP2, 0, OVECTOR_START + sizeof(sljit_sw)); - OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_IMM, length - 2); - loop = LABEL(); - OP1(SLJIT_MOVU, SLJIT_MEM1(TMP2), sizeof(sljit_sw), TMP1, 0); - OP2(SLJIT_SUB | SLJIT_SET_Z, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 1); - JUMPTO(SLJIT_NOT_ZERO, loop); + if (sljit_emit_mem(compiler, SLJIT_MOV | SLJIT_MEM_SUPP | SLJIT_MEM_STORE | SLJIT_MEM_PRE, TMP1, SLJIT_MEM1(TMP2), sizeof(sljit_sw)) == SLJIT_SUCCESS) + { + GET_LOCAL_BASE(TMP2, 0, OVECTOR_START + sizeof(sljit_sw)); + OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_IMM, length - 2); + loop = LABEL(); + sljit_emit_mem(compiler, SLJIT_MOV | SLJIT_MEM_STORE | SLJIT_MEM_PRE, TMP1, SLJIT_MEM1(TMP2), sizeof(sljit_sw)); + OP2(SLJIT_SUB | SLJIT_SET_Z, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 1); + JUMPTO(SLJIT_NOT_ZERO, loop); + } + else + { + GET_LOCAL_BASE(TMP2, 0, OVECTOR_START + 2 * sizeof(sljit_sw)); + OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_IMM, length - 2); + loop = LABEL(); + OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, TMP1, 0); + OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, SLJIT_IMM, sizeof(sljit_sw)); + OP2(SLJIT_SUB | SLJIT_SET_Z, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 1); + JUMPTO(SLJIT_NOT_ZERO, loop); + } } OP1(SLJIT_MOV, STACK_TOP, 0, ARGUMENTS, 0); @@ -2436,10 +2473,10 @@ if (common->control_head_ptr != 0) OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_IMM, 0); OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), SLJIT_OFFSETOF(jit_arguments, stack)); OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->start_ptr); -OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), SLJIT_OFFSETOF(struct sljit_stack, base)); +OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), SLJIT_OFFSETOF(struct sljit_stack, end)); } -static sljit_sw SLJIT_CALL do_search_mark(sljit_sw *current, const pcre_uchar *skip_arg) +static sljit_sw SLJIT_FUNC do_search_mark(sljit_sw *current, const pcre_uchar *skip_arg) { while (current != NULL) { @@ -2460,7 +2497,7 @@ while (current != NULL) SLJIT_ASSERT(current[0] == 0 || current < (sljit_sw*)current[0]); current = (sljit_sw*)current[0]; } -return -1; +return 0; } static SLJIT_INLINE void copy_ovector(compiler_common *common, int topbracket) @@ -2468,6 +2505,7 @@ static SLJIT_INLINE void copy_ovector(compiler_common *common, int topbracket) DEFINE_COMPILER; struct sljit_label *loop; struct sljit_jump *early_quit; +BOOL has_pre; /* At this point we can freely use all registers. */ OP1(SLJIT_MOV, SLJIT_S2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1)); @@ -2481,17 +2519,30 @@ if (common->mark_ptr != 0) OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_R0), SLJIT_OFFSETOF(jit_arguments, mark_ptr), SLJIT_R2, 0); OP2(SLJIT_SUB, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_R0), SLJIT_OFFSETOF(jit_arguments, offsets), SLJIT_IMM, sizeof(int)); OP1(SLJIT_MOV, SLJIT_R0, 0, SLJIT_MEM1(SLJIT_R0), SLJIT_OFFSETOF(jit_arguments, begin)); -GET_LOCAL_BASE(SLJIT_S0, 0, OVECTOR_START); + +has_pre = sljit_emit_mem(compiler, SLJIT_MOV | SLJIT_MEM_SUPP | SLJIT_MEM_PRE, SLJIT_S1, SLJIT_MEM1(SLJIT_S0), sizeof(sljit_sw)) == SLJIT_SUCCESS; +GET_LOCAL_BASE(SLJIT_S0, 0, OVECTOR_START - (has_pre ? sizeof(sljit_sw) : 0)); + /* Unlikely, but possible */ early_quit = CMP(SLJIT_EQUAL, SLJIT_R1, 0, SLJIT_IMM, 0); loop = LABEL(); -OP2(SLJIT_SUB, SLJIT_S1, 0, SLJIT_MEM1(SLJIT_S0), 0, SLJIT_R0, 0); -OP2(SLJIT_ADD, SLJIT_S0, 0, SLJIT_S0, 0, SLJIT_IMM, sizeof(sljit_sw)); + +if (has_pre) + sljit_emit_mem(compiler, SLJIT_MOV | SLJIT_MEM_PRE, SLJIT_S1, SLJIT_MEM1(SLJIT_S0), sizeof(sljit_sw)); +else + { + OP1(SLJIT_MOV, SLJIT_S1, 0, SLJIT_MEM1(SLJIT_S0), 0); + OP2(SLJIT_ADD, SLJIT_S0, 0, SLJIT_S0, 0, SLJIT_IMM, sizeof(sljit_sw)); + } + +OP2(SLJIT_ADD, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, sizeof(int)); +OP2(SLJIT_SUB, SLJIT_S1, 0, SLJIT_S1, 0, SLJIT_R0, 0); /* Copy the integer value to the output buffer */ #if defined COMPILE_PCRE16 || defined COMPILE_PCRE32 OP2(SLJIT_ASHR, SLJIT_S1, 0, SLJIT_S1, 0, SLJIT_IMM, UCHAR_SHIFT); #endif -OP1(SLJIT_MOVU_S32, SLJIT_MEM1(SLJIT_R2), sizeof(int), SLJIT_S1, 0); + +OP1(SLJIT_MOV_S32, SLJIT_MEM1(SLJIT_R2), 0, SLJIT_S1, 0); OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, loop); JUMPHERE(early_quit); @@ -2499,14 +2550,29 @@ JUMPHERE(early_quit); /* Calculate the return value, which is the maximum ovector value. */ if (topbracket > 1) { - GET_LOCAL_BASE(SLJIT_R0, 0, OVECTOR_START + topbracket * 2 * sizeof(sljit_sw)); - OP1(SLJIT_MOV, SLJIT_R1, 0, SLJIT_IMM, topbracket + 1); + if (sljit_emit_mem(compiler, SLJIT_MOV | SLJIT_MEM_SUPP | SLJIT_MEM_PRE, SLJIT_R2, SLJIT_MEM1(SLJIT_R0), -(2 * (sljit_sw)sizeof(sljit_sw))) == SLJIT_SUCCESS) + { + GET_LOCAL_BASE(SLJIT_R0, 0, OVECTOR_START + topbracket * 2 * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_R1, 0, SLJIT_IMM, topbracket + 1); - /* OVECTOR(0) is never equal to SLJIT_S2. */ - loop = LABEL(); - OP1(SLJIT_MOVU, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_R0), -(2 * (sljit_sw)sizeof(sljit_sw))); - OP2(SLJIT_SUB, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, 1); - CMPTO(SLJIT_EQUAL, SLJIT_R2, 0, SLJIT_S2, 0, loop); + /* OVECTOR(0) is never equal to SLJIT_S2. */ + loop = LABEL(); + sljit_emit_mem(compiler, SLJIT_MOV | SLJIT_MEM_PRE, SLJIT_R2, SLJIT_MEM1(SLJIT_R0), -(2 * (sljit_sw)sizeof(sljit_sw))); + OP2(SLJIT_SUB, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, 1); + CMPTO(SLJIT_EQUAL, SLJIT_R2, 0, SLJIT_S2, 0, loop); + } + else + { + GET_LOCAL_BASE(SLJIT_R0, 0, OVECTOR_START + (topbracket - 1) * 2 * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_R1, 0, SLJIT_IMM, topbracket + 1); + + /* OVECTOR(0) is never equal to SLJIT_S2. */ + loop = LABEL(); + OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_R0), 0); + OP2(SLJIT_SUB, SLJIT_R0, 0, SLJIT_R0, 0, SLJIT_IMM, 2 * (sljit_sw)sizeof(sljit_sw)); + OP2(SLJIT_SUB, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, 1); + CMPTO(SLJIT_EQUAL, SLJIT_R2, 0, SLJIT_S2, 0, loop); + } OP1(SLJIT_MOV, SLJIT_RETURN_REG, 0, SLJIT_R1, 0); } else @@ -5167,93 +5233,190 @@ OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL); sljit_emit_fast_return(compiler, RETURN_ADDR, 0); } -#define CHAR1 STR_END -#define CHAR2 STACK_TOP - static void do_casefulcmp(compiler_common *common) { DEFINE_COMPILER; struct sljit_jump *jump; struct sljit_label *label; +int char1_reg; +int char2_reg; -sljit_emit_fast_enter(compiler, RETURN_ADDR, 0); +if (sljit_get_register_index(TMP3) < 0) + { + char1_reg = STR_END; + char2_reg = STACK_TOP; + } +else + { + char1_reg = TMP3; + char2_reg = RETURN_ADDR; + } + +sljit_emit_fast_enter(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0); OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, TMP2, 0); -OP1(SLJIT_MOV, TMP3, 0, CHAR1, 0); -OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, CHAR2, 0); -OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1)); -OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); -label = LABEL(); -OP1(MOVU_UCHAR, CHAR1, 0, SLJIT_MEM1(TMP1), IN_UCHARS(1)); -OP1(MOVU_UCHAR, CHAR2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); -jump = CMP(SLJIT_NOT_EQUAL, CHAR1, 0, CHAR2, 0); -OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); -JUMPTO(SLJIT_NOT_ZERO, label); +if (char1_reg == STR_END) + { + OP1(SLJIT_MOV, TMP3, 0, char1_reg, 0); + OP1(SLJIT_MOV, RETURN_ADDR, 0, char2_reg, 0); + } -JUMPHERE(jump); -OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); -OP1(SLJIT_MOV, CHAR1, 0, TMP3, 0); -OP1(SLJIT_MOV, CHAR2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); -sljit_emit_fast_return(compiler, RETURN_ADDR, 0); -} +if (sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_SUPP | SLJIT_MEM_POST, char1_reg, SLJIT_MEM1(TMP1), IN_UCHARS(1)) == SLJIT_SUCCESS) + { + label = LABEL(); + sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_POST, char1_reg, SLJIT_MEM1(TMP1), IN_UCHARS(1)); + sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_POST, char2_reg, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); + jump = CMP(SLJIT_NOT_EQUAL, char1_reg, 0, char2_reg, 0); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); + JUMPTO(SLJIT_NOT_ZERO, label); + + JUMPHERE(jump); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); + } +else if (sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_SUPP | SLJIT_MEM_PRE, char1_reg, SLJIT_MEM1(TMP1), IN_UCHARS(1)) == SLJIT_SUCCESS) + { + OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1)); + OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); + + label = LABEL(); + sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_PRE, char1_reg, SLJIT_MEM1(TMP1), IN_UCHARS(1)); + sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_PRE, char2_reg, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); + jump = CMP(SLJIT_NOT_EQUAL, char1_reg, 0, char2_reg, 0); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); + JUMPTO(SLJIT_NOT_ZERO, label); -#define LCC_TABLE STACK_LIMIT + JUMPHERE(jump); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); + OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); + } +else + { + label = LABEL(); + OP1(MOV_UCHAR, char1_reg, 0, SLJIT_MEM1(TMP1), 0); + OP1(MOV_UCHAR, char2_reg, 0, SLJIT_MEM1(STR_PTR), 0); + OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1)); + OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); + jump = CMP(SLJIT_NOT_EQUAL, char1_reg, 0, char2_reg, 0); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); + JUMPTO(SLJIT_NOT_ZERO, label); + + JUMPHERE(jump); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); + } + +if (char1_reg == STR_END) + { + OP1(SLJIT_MOV, char1_reg, 0, TMP3, 0); + OP1(SLJIT_MOV, char2_reg, 0, RETURN_ADDR, 0); + } + +sljit_emit_fast_return(compiler, TMP1, 0); +} static void do_caselesscmp(compiler_common *common) { DEFINE_COMPILER; struct sljit_jump *jump; struct sljit_label *label; +int char1_reg = STR_END; +int char2_reg; +int lcc_table; +int opt_type = 0; -sljit_emit_fast_enter(compiler, RETURN_ADDR, 0); +if (sljit_get_register_index(TMP3) < 0) + { + char2_reg = STACK_TOP; + lcc_table = STACK_LIMIT; + } +else + { + char2_reg = RETURN_ADDR; + lcc_table = TMP3; + } + +if (sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_SUPP | SLJIT_MEM_POST, char1_reg, SLJIT_MEM1(TMP1), IN_UCHARS(1)) == SLJIT_SUCCESS) + opt_type = 1; +else if (sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_SUPP | SLJIT_MEM_PRE, char1_reg, SLJIT_MEM1(TMP1), IN_UCHARS(1)) == SLJIT_SUCCESS) + opt_type = 2; + +sljit_emit_fast_enter(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0); OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, TMP2, 0); -OP1(SLJIT_MOV, TMP3, 0, LCC_TABLE, 0); -OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, CHAR1, 0); -OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, CHAR2, 0); -OP1(SLJIT_MOV, LCC_TABLE, 0, SLJIT_IMM, common->lcc); -OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1)); -OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); +OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, char1_reg, 0); + +if (char2_reg == STACK_TOP) + { + OP1(SLJIT_MOV, TMP3, 0, char2_reg, 0); + OP1(SLJIT_MOV, RETURN_ADDR, 0, lcc_table, 0); + } + +OP1(SLJIT_MOV, lcc_table, 0, SLJIT_IMM, common->lcc); + +if (opt_type == 1) + { + label = LABEL(); + sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_POST, char1_reg, SLJIT_MEM1(TMP1), IN_UCHARS(1)); + sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_POST, char2_reg, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); + } +else if (opt_type == 2) + { + OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1)); + OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); + + label = LABEL(); + sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_PRE, char1_reg, SLJIT_MEM1(TMP1), IN_UCHARS(1)); + sljit_emit_mem(compiler, MOV_UCHAR | SLJIT_MEM_PRE, char2_reg, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); + } +else + { + label = LABEL(); + OP1(MOV_UCHAR, char1_reg, 0, SLJIT_MEM1(TMP1), 0); + OP1(MOV_UCHAR, char2_reg, 0, SLJIT_MEM1(STR_PTR), 0); + OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(1)); + } -label = LABEL(); -OP1(MOVU_UCHAR, CHAR1, 0, SLJIT_MEM1(TMP1), IN_UCHARS(1)); -OP1(MOVU_UCHAR, CHAR2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); #ifndef COMPILE_PCRE8 -jump = CMP(SLJIT_GREATER, CHAR1, 0, SLJIT_IMM, 255); +jump = CMP(SLJIT_GREATER, char1_reg, 0, SLJIT_IMM, 255); #endif -OP1(SLJIT_MOV_U8, CHAR1, 0, SLJIT_MEM2(LCC_TABLE, CHAR1), 0); +OP1(SLJIT_MOV_U8, char1_reg, 0, SLJIT_MEM2(lcc_table, char1_reg), 0); #ifndef COMPILE_PCRE8 JUMPHERE(jump); -jump = CMP(SLJIT_GREATER, CHAR2, 0, SLJIT_IMM, 255); +jump = CMP(SLJIT_GREATER, char2_reg, 0, SLJIT_IMM, 255); #endif -OP1(SLJIT_MOV_U8, CHAR2, 0, SLJIT_MEM2(LCC_TABLE, CHAR2), 0); +OP1(SLJIT_MOV_U8, char2_reg, 0, SLJIT_MEM2(lcc_table, char2_reg), 0); #ifndef COMPILE_PCRE8 JUMPHERE(jump); #endif -jump = CMP(SLJIT_NOT_EQUAL, CHAR1, 0, CHAR2, 0); + +if (opt_type == 0) + OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); + +jump = CMP(SLJIT_NOT_EQUAL, char1_reg, 0, char2_reg, 0); OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); JUMPTO(SLJIT_NOT_ZERO, label); JUMPHERE(jump); -OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); -OP1(SLJIT_MOV, LCC_TABLE, 0, TMP3, 0); -OP1(SLJIT_MOV, CHAR1, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); -OP1(SLJIT_MOV, CHAR2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1); -sljit_emit_fast_return(compiler, RETURN_ADDR, 0); -} +OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); + +if (opt_type == 2) + OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); -#undef LCC_TABLE -#undef CHAR1 -#undef CHAR2 +if (char2_reg == STACK_TOP) + { + OP1(SLJIT_MOV, char2_reg, 0, TMP3, 0); + OP1(SLJIT_MOV, lcc_table, 0, RETURN_ADDR, 0); + } + +OP1(SLJIT_MOV, char1_reg, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1); +sljit_emit_fast_return(compiler, TMP1, 0); +} #if defined SUPPORT_UTF && defined SUPPORT_UCP -static const pcre_uchar * SLJIT_CALL do_utf_caselesscmp(pcre_uchar *src1, jit_arguments *args, pcre_uchar *end1) +static const pcre_uchar * SLJIT_FUNC do_utf_caselesscmp(pcre_uchar *src1, pcre_uchar *src2, pcre_uchar *end1, pcre_uchar *end2) { /* This function would be ineffective to do in JIT level. */ sljit_u32 c1, c2; -const pcre_uchar *src2 = args->uchar_ptr; -const pcre_uchar *end2 = args->end; const ucd_record *ur; const sljit_u32 *pp; @@ -6776,32 +6939,37 @@ else #if defined SUPPORT_UTF && defined SUPPORT_UCP if (common->utf && *cc == OP_REFI) { - SLJIT_ASSERT(TMP1 == SLJIT_R0 && STACK_TOP == SLJIT_R1 && TMP2 == SLJIT_R2); + SLJIT_ASSERT(TMP1 == SLJIT_R0 && STACK_TOP == SLJIT_R1); if (ref) - OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1)); + OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1)); else - OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw)); if (withchecks) - jump = CMP(SLJIT_EQUAL, TMP1, 0, TMP2, 0); + jump = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_R2, 0); - /* Needed to save important temporary registers. */ + /* No free saved registers so save data on stack. */ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, STACK_TOP, 0); - OP1(SLJIT_MOV, SLJIT_R1, 0, ARGUMENTS, 0); - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_R1), SLJIT_OFFSETOF(jit_arguments, uchar_ptr), STR_PTR, 0); - sljit_emit_ijump(compiler, SLJIT_CALL3, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_utf_caselesscmp)); + OP1(SLJIT_MOV, SLJIT_R1, 0, STR_PTR, 0); + OP1(SLJIT_MOV, SLJIT_R3, 0, STR_END, 0); + sljit_emit_icall(compiler, SLJIT_CALL, SLJIT_RET(SW) | SLJIT_ARG1(SW) | SLJIT_ARG2(SW) | SLJIT_ARG3(SW) | SLJIT_ARG4(SW), SLJIT_IMM, SLJIT_FUNC_OFFSET(do_utf_caselesscmp)); OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); + OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_RETURN_REG, 0); + if (common->mode == JIT_COMPILE) add_jump(compiler, backtracks, CMP(SLJIT_LESS_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 1)); else { - add_jump(compiler, backtracks, CMP(SLJIT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0)); - nopartial = CMP(SLJIT_NOT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z | SLJIT_SET_LESS, SLJIT_UNUSED, 0, SLJIT_RETURN_REG, 0, SLJIT_IMM, 1); + + add_jump(compiler, backtracks, JUMP(SLJIT_LESS)); + + nopartial = JUMP(SLJIT_NOT_EQUAL); + OP1(SLJIT_MOV, STR_PTR, 0, STR_END, 0); check_partial(common, FALSE); add_jump(compiler, backtracks, JUMP(SLJIT_JUMP)); JUMPHERE(nopartial); } - OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_RETURN_REG, 0); } else #endif /* SUPPORT_UTF && SUPPORT_UCP */ @@ -7125,7 +7293,7 @@ add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IM return cc + 1 + LINK_SIZE; } -static int SLJIT_CALL do_callout(struct jit_arguments *arguments, PUBL(callout_block) *callout_block, pcre_uchar **jit_ovector) +static sljit_s32 SLJIT_FUNC do_callout(struct jit_arguments *arguments, PUBL(callout_block) *callout_block, pcre_uchar **jit_ovector) { const pcre_uchar *begin = arguments->begin; int *offset_vector = arguments->offsets; @@ -7207,18 +7375,17 @@ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, STACK_TOP, 0); /* SLJIT_R0 = arguments */ OP1(SLJIT_MOV, SLJIT_R1, 0, STACK_TOP, 0); GET_LOCAL_BASE(SLJIT_R2, 0, OVECTOR_START); -sljit_emit_ijump(compiler, SLJIT_CALL3, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_callout)); -OP1(SLJIT_MOV_S32, SLJIT_RETURN_REG, 0, SLJIT_RETURN_REG, 0); +sljit_emit_icall(compiler, SLJIT_CALL, SLJIT_RET(S32) | SLJIT_ARG1(SW) | SLJIT_ARG2(SW) | SLJIT_ARG3(SW), SLJIT_IMM, SLJIT_FUNC_OFFSET(do_callout)); OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); free_stack(common, CALLOUT_ARG_SIZE / sizeof(sljit_sw)); /* Check return value. */ -OP2(SLJIT_SUB | SLJIT_SET_Z | SLJIT_SET_SIG_GREATER, SLJIT_UNUSED, 0, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0); -add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_SIG_GREATER)); +OP2(SLJIT_SUB32 | SLJIT_SET_Z | SLJIT_SET_SIG_GREATER, SLJIT_UNUSED, 0, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0); +add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_SIG_GREATER32)); if (common->forced_quit_label == NULL) - add_jump(compiler, &common->forced_quit, JUMP(SLJIT_NOT_EQUAL) /* SIG_LESS */); + add_jump(compiler, &common->forced_quit, JUMP(SLJIT_NOT_EQUAL32) /* SIG_LESS */); else - JUMPTO(SLJIT_NOT_EQUAL /* SIG_LESS */, common->forced_quit_label); + JUMPTO(SLJIT_NOT_EQUAL32 /* SIG_LESS */, common->forced_quit_label); return cc + 2 + 2 * LINK_SIZE; } @@ -10439,11 +10606,11 @@ if (opcode == OP_SKIP_ARG) OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, STACK_TOP, 0); OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_IMM, (sljit_sw)(current->cc + 2)); - sljit_emit_ijump(compiler, SLJIT_CALL2, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_search_mark)); + sljit_emit_icall(compiler, SLJIT_CALL, SLJIT_RET(SW) | SLJIT_ARG1(SW) | SLJIT_ARG2(SW), SLJIT_IMM, SLJIT_FUNC_OFFSET(do_search_mark)); OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); OP1(SLJIT_MOV, STR_PTR, 0, TMP1, 0); - add_jump(compiler, &common->reset_match, CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, -1)); + add_jump(compiler, &common->reset_match, CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_IMM, 0)); return; } @@ -11031,7 +11198,7 @@ if (!compiler) common->compiler = compiler; /* Main pcre_jit_exec entry. */ -sljit_emit_enter(compiler, 0, 1, 5, 5, 0, 0, private_data_size); +sljit_emit_enter(compiler, 0, SLJIT_ARG1(SW), 5, 5, 0, 0, private_data_size); /* Register init. */ reset_ovector(common, (re->top_bracket + 1) * 2); @@ -11044,8 +11211,8 @@ OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, str)) OP1(SLJIT_MOV, STR_END, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, end)); OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, stack)); OP1(SLJIT_MOV_U32, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, limit_match)); -OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(struct sljit_stack, base)); -OP1(SLJIT_MOV, STACK_LIMIT, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(struct sljit_stack, limit)); +OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(struct sljit_stack, end)); +OP1(SLJIT_MOV, STACK_LIMIT, 0, SLJIT_MEM1(TMP2), SLJIT_OFFSETOF(struct sljit_stack, start)); OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LIMIT_MATCH, TMP1, 0); @@ -11251,20 +11418,22 @@ common->quit_label = quit_label; set_jumps(common->stackalloc, LABEL()); /* RETURN_ADDR is not a saved register. */ sljit_emit_fast_enter(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0); -OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, TMP2, 0); -OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0); -OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, stack)); -OP1(SLJIT_MOV, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, top), STACK_TOP, 0); -OP2(SLJIT_SUB, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, limit), SLJIT_IMM, STACK_GROWTH_RATE); -sljit_emit_ijump(compiler, SLJIT_CALL2, SLJIT_IMM, SLJIT_FUNC_OFFSET(sljit_stack_resize)); -jump = CMP(SLJIT_NOT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0); -OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0); -OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, stack)); -OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, top)); -OP1(SLJIT_MOV, STACK_LIMIT, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, limit)); -OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1); -sljit_emit_fast_return(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0); +SLJIT_ASSERT(TMP1 == SLJIT_R0 && STACK_TOP == SLJIT_R1); + +OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, STACK_TOP, 0); +OP1(SLJIT_MOV, SLJIT_R0, 0, ARGUMENTS, 0); +OP2(SLJIT_SUB, SLJIT_R1, 0, STACK_LIMIT, 0, SLJIT_IMM, STACK_GROWTH_RATE); +OP1(SLJIT_MOV, SLJIT_R0, 0, SLJIT_MEM1(SLJIT_R0), SLJIT_OFFSETOF(jit_arguments, stack)); +OP1(SLJIT_MOV, STACK_LIMIT, 0, TMP2, 0); + +sljit_emit_icall(compiler, SLJIT_CALL, SLJIT_RET(SW) | SLJIT_ARG1(SW) | SLJIT_ARG2(SW), SLJIT_IMM, SLJIT_FUNC_OFFSET(sljit_stack_resize)); +jump = CMP(SLJIT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0); +OP1(SLJIT_MOV, TMP2, 0, STACK_LIMIT, 0); +OP1(SLJIT_MOV, STACK_LIMIT, 0, SLJIT_RETURN_REG, 0); +OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); +OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1); +sljit_emit_fast_return(compiler, TMP1, 0); /* Allocation failed. */ JUMPHERE(jump); @@ -11409,9 +11578,9 @@ union { sljit_u8 local_space[MACHINE_STACK_SIZE]; struct sljit_stack local_stack; -local_stack.max_limit = local_space; -local_stack.limit = local_space; -local_stack.base = local_space + MACHINE_STACK_SIZE; +local_stack.min_start = local_space; +local_stack.start = local_space; +local_stack.end = local_space + MACHINE_STACK_SIZE; local_stack.top = local_space + MACHINE_STACK_SIZE; arguments->stack = &local_stack; convert_executable_func.executable_func = executable_func; @@ -11536,7 +11705,7 @@ if ((options & PCRE_PARTIAL_HARD) != 0) else if ((options & PCRE_PARTIAL_SOFT) != 0) mode = JIT_PARTIAL_SOFT_COMPILE; -if (functions->executable_funcs[mode] == NULL) +if (functions == NULL || functions->executable_funcs[mode] == NULL) return PCRE_ERROR_JIT_BADOPTION; /* Sanity checks should be handled by pcre_exec. */ diff --git a/erts/emulator/pcre/pcre_latin_1_table.c b/erts/emulator/pcre/pcre_latin_1_table.c index aa29275a94..d6cf38fa3b 100644 --- a/erts/emulator/pcre/pcre_latin_1_table.c +++ b/erts/emulator/pcre/pcre_latin_1_table.c @@ -14,6 +14,7 @@ Pulling in the header ensures that the array gets flagged as "someone outside this compilation unit might reference this" and so it will always be supplied to the linker. */ /* %ExternalCopyright% */ + #ifdef HAVE_CONFIG_H #include "config.h" #endif @@ -120,7 +121,7 @@ print, punct, and cntrl. Other classes are built from combinations. */ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0x07, - 0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x00, + 0x00,0x00,0x00,0x00,0x00,0x04,0x20,0x04, 0x00,0x00,0x00,0x80,0xff,0xff,0x7f,0xff, 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x03, diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index b03e19ee71..f421794f91 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -1507,7 +1507,6 @@ send_event_tuple(struct erts_nif_select_event* e, ErtsResource* resource, } tuple = TUPLE4(hp, am_select, resource_term, ref_term, event_atom); - ERL_MESSAGE_TOKEN(mp) = am_undefined; erts_queue_message(rp, rp_locks, mp, tuple, am_system); if (rp_locks) diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 70b5532af9..b4d1575ee5 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -803,6 +803,23 @@ update_pollset(ErtsPollSet *ps, int fd, ErtsPollOp op, ErtsPollEvents events) struct kevent evts[2]; struct timespec ts = {0, 0}; + if (op == ERTS_POLL_OP_ADD) { + /* This is a hack to make the "noshell" option work; kqueue can poll + * these fds but will not report EV_EOF, so we return NVAL to use the + * fallback instead. + * + * This may be common to all pipes but we have no way to tell whether + * an fd is a pipe or not. */ + switch (fd) { + case STDIN_FILENO: + case STDOUT_FILENO: + case STDERR_FILENO: + return ERTS_POLL_EV_NVAL; + default: + break; + } + } + #if defined(EV_DISPATCH) && !defined(__OpenBSD__) /* If we have EV_DISPATCH we use it, unless we are on OpenBSD as the behavior of EV_EOF seems to be edge triggered there and we need it diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index 2541ab5d31..d34e1a9ec0 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -176,6 +176,7 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, double af; Uint64 int_part, frac_part; int neg; + int has_decimals = decimals != 0; char *p = buffer; if (decimals < 0) @@ -257,7 +258,7 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, } /* Delete trailing zeroes */ - if (compact) + if (compact && has_decimals) p = find_first_trailing_zero(p); *p = '\0'; return p - buffer; diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 189ca083d7..36579ffdb4 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -452,9 +452,9 @@ prepare_crash_dump(int secs) envsz = sizeof(env); i = erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP_NICE", env, &envsz); - if (i >= 0) { + if (i != 0) { int nice_val; - nice_val = i != 1 ? 0 : atoi(env); + nice_val = (i != 1) ? 0 : atoi(env); if (nice_val > 39) { nice_val = 39; } diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index 872c3a80b1..816bdea9c5 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -685,7 +685,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, /* we send the request to do the fork */ if ((res = writev(ofd[1], io_vector, iov_len > MAXIOV ? MAXIOV : iov_len)) < 0) { - if (errno == ERRNO_BLOCK) { + if (errno == ERRNO_BLOCK || errno == EINTR) { res = 0; } else { int err = errno; @@ -1000,7 +1000,7 @@ static void clear_fd_data(ErtsSysFdData *fdd) static void nbio_stop_fd(ErlDrvPort prt, ErtsSysFdData *fdd) { - driver_select(prt, abs(fdd->fd), DO_READ|DO_WRITE, 0); + driver_select(prt, abs(fdd->fd), ERL_DRV_USE_NO_CALLBACK|DO_READ|DO_WRITE, 0); clear_fd_data(fdd); SET_BLOCKING(abs(fdd->fd)); @@ -1257,6 +1257,8 @@ static int port_inp_failure(ErtsSysDriverData *dd, int res) } driver_failure_eof(dd->port_num); } else if (dd->ifd) { + if (dd->alive == -1) + errno = dd->status; erl_drv_init_ack(dd->port_num, ERL_DRV_ERROR_ERRNO); } else { driver_failure_posix(dd->port_num, err); @@ -1287,10 +1289,10 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) int res; if((res = read(ready_fd, &proto, sizeof(proto))) <= 0) { + if (res < 0 && (errno == ERRNO_BLOCK || errno == EINTR)) + return; /* hmm, child setup seems to have closed the pipe too early... we close the port as there is not much else we can do */ - if (res < 0 && errno == ERRNO_BLOCK) - return; driver_select(port_num, ready_fd, ERL_DRV_READ, 0); if (res == 0) errno = EPIPE; @@ -1424,7 +1426,7 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) continue; } else { /* The last message we got was split */ - char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); + char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); if (!buf) { errno = ENOMEM; port_inp_failure(dd, -1); @@ -1670,15 +1672,37 @@ static void forker_stop(ErlDrvData e) the port has been closed by the user. */ } +static ErlDrvSizeT forker_deq(ErlDrvPort port_num, ErtsSysForkerProto *proto) +{ + close(proto->u.start.fds[0]); + close(proto->u.start.fds[1]); + if (proto->u.start.fds[1] != proto->u.start.fds[2]) + close(proto->u.start.fds[2]); + + return driver_deq(port_num, sizeof(*proto)); +} + +static void forker_sigchld(Eterm port_id, int error) +{ + ErtsSysForkerProto *proto = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(*proto)); + proto->action = ErtsSysForkerProtoAction_SigChld; + proto->u.sigchld.error_number = error; + proto->u.sigchld.port_id = port_id; + + /* ideally this would be a port_command call, but as command is + already used by the spawn_driver, we use control instead. + Note that when using erl_drv_port_control it is an asynchronous + control. */ + erl_drv_port_control(port_id, 'S', (char*)proto, sizeof(*proto)); +} + static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) { int res; - ErtsSysForkerProto *proto; + ErtsSysForkerProto proto; - proto = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(*proto)); - - if ((res = read(fd, proto, sizeof(*proto))) < 0) { - if (errno == ERRNO_BLOCK) + if ((res = read(fd, &proto, sizeof(proto))) < 0) { + if (errno == ERRNO_BLOCK || errno == EINTR) return; erts_exit(ERTS_DUMP_EXIT, "Failed to read from erl_child_setup: %d\n", errno); } @@ -1686,10 +1710,10 @@ static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) if (res == 0) erts_exit(ERTS_DUMP_EXIT, "erl_child_setup closed\n"); - ASSERT(res == sizeof(*proto)); + ASSERT(res == sizeof(proto)); #ifdef FORKER_PROTO_START_ACK - if (proto->action == ErtsSysForkerProtoAction_StartAck) { + if (proto.action == ErtsSysForkerProtoAction_StartAck) { /* Ideally we would like to not have to ack each Start command being sent over the uds, but it would seem that some operating systems (only observed on FreeBSD) @@ -1699,28 +1723,15 @@ static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) ErlDrvPort port_num = (ErlDrvPort)e; int vlen; SysIOVec *iov = driver_peekq(port_num, &vlen); - ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base; - - close(proto->u.start.fds[0]); - close(proto->u.start.fds[1]); - if (proto->u.start.fds[1] != proto->u.start.fds[2]) - close(proto->u.start.fds[2]); + ErtsSysForkerProto *qproto = (ErtsSysForkerProto *)iov[0].iov_base; - driver_deq(port_num, sizeof(*proto)); - - if (driver_sizeq(port_num) > 0) + if (forker_deq(port_num, qproto)) driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); } else #endif { - ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); - - /* ideally this would be a port_command call, but as command is - already used by the spawn_driver, we use control instead. - Note that when using erl_drv_port_control it is an asynchronous - control. */ - erl_drv_port_control(proto->u.sigchld.port_id, 'S', - (char*)proto, sizeof(*proto)); + ASSERT(proto.action == ErtsSysForkerProtoAction_SigChld); + forker_sigchld(proto.u.sigchld.port_id, proto.u.sigchld.error_number); } } @@ -1730,7 +1741,8 @@ static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) ErlDrvPort port_num = (ErlDrvPort)e; #ifndef FORKER_PROTO_START_ACK - while (driver_sizeq(port_num) > 0) { + int loops = 10; + while (driver_sizeq(port_num) > 0 && --loops) { #endif int vlen; SysIOVec *iov = driver_peekq(port_num, &vlen); @@ -1738,20 +1750,24 @@ static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) ASSERT(iov[0].iov_len >= (sizeof(*proto))); if (sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), proto->u.start.fds, 3, 0) < 0) { - if (errno == ERRNO_BLOCK) + if (errno == ERRNO_BLOCK || errno == EINTR) { return; - erts_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); + } else if (errno == EMFILE) { + forker_sigchld(proto->u.start.port_id, errno); + if (forker_deq(port_num, proto) == 0) + driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0); + return; + } else { + erts_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); + } } #ifndef FORKER_PROTO_START_ACK - close(proto->u.start.fds[0]); - close(proto->u.start.fds[1]); - if (proto->u.start.fds[1] != proto->u.start.fds[2]) - close(proto->u.start.fds[2]); - driver_deq(port_num, sizeof(*proto)); + if (forker_deq(port_num, proto) == 0) + driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0); } -#endif - +#else driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0); +#endif } static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, @@ -1777,20 +1793,21 @@ static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, if ((res = sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), proto->u.start.fds, 3, 0)) < 0) { - if (errno == ERRNO_BLOCK) { + if (errno == ERRNO_BLOCK || errno == EINTR) { driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); return 0; + } else if (errno == EMFILE) { + forker_sigchld(proto->u.start.port_id, errno); + forker_deq(port_num, proto); + return 0; + } else { + erts_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); } - erts_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); } #ifndef FORKER_PROTO_START_ACK ASSERT(res == sizeof(*proto)); - close(proto->u.start.fds[0]); - close(proto->u.start.fds[1]); - if (proto->u.start.fds[1] != proto->u.start.fds[2]) - close(proto->u.start.fds[2]); - driver_deq(port_num, sizeof(*proto)); + forker_deq(port_num, proto); #endif return 0; diff --git a/erts/emulator/sys/unix/sys_uds.c b/erts/emulator/sys/unix/sys_uds.c index c328fd00bb..39a4866065 100644 --- a/erts/emulator/sys/unix/sys_uds.c +++ b/erts/emulator/sys/unix/sys_uds.c @@ -132,7 +132,7 @@ sys_uds_writev(int fd, struct iovec *iov, size_t iov_len, struct msghdr msg; struct cmsghdr *cmsg = NULL; - int res, i; + int res, i, error; /* initialize socket message */ memset(&msg, 0, sizeof(struct msghdr)); @@ -173,11 +173,22 @@ sys_uds_writev(int fd, struct iovec *iov, size_t iov_len, res = sendmsg(fd, &msg, flags); +#ifdef ETOOMANYREFS + /* Linux may give ETOOMANYREFS when there are too many fds in transit. + We map this to EMFILE as bsd and other use this error code and we want + the behaviour to be the same on all OSs */ + if (errno == ETOOMANYREFS) + errno = EMFILE; +#endif + error = errno; + if (iov_len > MAXIOV) free(iov[0].iov_base); free(msg.msg_control); + errno = error; + return res; } diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index fd4c745c3b..fcf5a0d533 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -362,11 +362,11 @@ is_io_ready(ErtsPollSet *ps) } static ERTS_INLINE void -woke_up(ErtsPollSet *ps) +woke_up(ErtsPollSet *ps, int waketype) { if (erts_atomic32_read_nob(&ps->wakeup_state) == ERTS_POLL_NOT_WOKEN) erts_atomic32_cmpxchg_nob(&ps->wakeup_state, - ERTS_POLL_WOKEN_TIMEDOUT, + waketype, ERTS_POLL_NOT_WOKEN); #ifdef DEBUG { @@ -960,12 +960,12 @@ static int cancel_driver_select(ErtsPollSet *ps, HANDLE event) void erts_poll_interrupt(ErtsPollSet *ps, int set /* bool */) { - HARDTRACEF(("In erts_poll_interrupt(%d)",set)); + HARDTRACEF(("In erts_poll_interrupt(%p, %d)",ps,set)); if (!set) reset_interrupt(ps); else set_interrupt(ps); - HARDTRACEF(("Out erts_poll_interrupt(%d)",set)); + HARDTRACEF(("Out erts_poll_interrupt(%p, %d)",ps,set)); } @@ -1051,19 +1051,20 @@ int erts_poll_wait(ErtsPollSet *ps, if (!erts_atomic32_read_nob(&break_waiter_state)) { HANDLE harr[2] = {ps->event_io_ready, break_happened_event}; - int num_h = 2; + int num_h = 2, handle; ERTS_MSACC_PUSH_STATE(); HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout)); ERTS_POLLSET_UNLOCK(ps); erts_thr_progress_prepare_wait(NULL); ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_SLEEP); - WaitForMultipleObjects(num_h, harr, FALSE, timeout); + handle = WaitForMultipleObjects(num_h, harr, FALSE, timeout); erts_thr_progress_finalize_wait(NULL); ERTS_MSACC_POP_STATE(); ERTS_POLLSET_LOCK(ps); HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout)); - woke_up(ps); + if (handle == WAIT_OBJECT_0) + woke_up(ps, ERTS_POLL_WOKEN_TIMEDOUT); } ERTS_UNSET_BREAK_REQUESTED; @@ -1075,7 +1076,10 @@ int erts_poll_wait(ErtsPollSet *ps, erts_mtx_unlock(&break_waiter_lock); switch (break_state) { case BREAK_WAITER_GOT_BREAK: + woke_up(ps, ERTS_POLL_WOKEN_INTR); ERTS_SET_BREAK_REQUESTED; + /* Wake aux thread to get handle break */ + erts_aux_thread_poke(); break; case BREAK_WAITER_GOT_HALT: erts_exit(0,""); diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index d19f7f81ad..742592f88e 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -1395,7 +1395,7 @@ seq(M, N, R) when M =< N -> seq(M, N-1, [N|R]); seq(_, _, R) -> R. -%% lists:reverse can not be called since it is traced +%% lists:reverse cannot be called since it is traced reverse(L) -> reverse(L, []). %% diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 9c6dc3ff83..7e690fd870 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -332,6 +332,7 @@ constant_pools(Config) when is_list(Config) -> A = literals:a(), B = literals:b(), C = literals:huge_bignum(), + D = literals:funs(), process_flag(trap_exit, true), Self = self(), @@ -345,7 +346,7 @@ constant_pools(Config) when is_list(Config) -> true = erlang:purge_module(literals), NoOldHeap ! done, receive - {'EXIT',NoOldHeap,{A,B,C}} -> + {'EXIT',NoOldHeap,{A,B,C,D}} -> ok; Other -> ct:fail({unexpected,Other}) @@ -362,7 +363,7 @@ constant_pools(Config) when is_list(Config) -> erlang:purge_module(literals), OldHeap ! done, receive - {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> + {'EXIT',OldHeap,{A,B,C,D,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> ok end, @@ -390,7 +391,7 @@ constant_pools(Config) when is_list(Config) -> {'DOWN', Mon, process, Hib, Reason} -> {undef, [{no_module, no_function, - [{A,B,C,[1,2,3|_]=Seq}], _}]} = Reason, + [{A,B,C,D,[1,2,3|_]=Seq}], _}]} = Reason, 16 = length(Seq) end, HeapSz = TotHeapSz, %% Ensure restored to hibernated state... @@ -400,7 +401,9 @@ constant_pools(Config) when is_list(Config) -> no_old_heap(Parent) -> A = literals:a(), B = literals:b(), - Res = {A,B,literals:huge_bignum()}, + C = literals:huge_bignum(), + D = literals:funs(), + Res = {A,B,C,D}, Parent ! go, receive done -> @@ -410,7 +413,9 @@ no_old_heap(Parent) -> old_heap(Parent) -> A = literals:a(), B = literals:b(), - Res = {A,B,literals:huge_bignum(),lists:seq(1, 16)}, + C = literals:huge_bignum(), + D = literals:funs(), + Res = {A,B,C,D,lists:seq(1, 16)}, create_old_heap(), Parent ! go, receive @@ -421,7 +426,9 @@ old_heap(Parent) -> hibernated(Parent) -> A = literals:a(), B = literals:b(), - Res = {A,B,literals:huge_bignum(),lists:seq(1, 16)}, + C = literals:huge_bignum(), + D = literals:funs(), + Res = {A,B,C,D,lists:seq(1, 16)}, Parent ! go, erlang:hibernate(no_module, no_function, [Res]). @@ -755,7 +762,8 @@ t_copy_literals_frags(Config) when is_list(Config) -> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, 0, 1, 2, 3, 4, 5, 6, 7, - 8, 9,10,11,12,13,14,15>>}]), + 8, 9,10,11,12,13,14,15>>}, + {f, fun ?MODULE:all/0}]), {module, ?mod} = erlang:load_module(?mod, Bin), N = 6000, @@ -796,6 +804,7 @@ literal_receiver() -> C = ?mod:c(), D = ?mod:d(), E = ?mod:e(), + F = ?mod:f(), literal_receiver(); {Pid, sender_confirm} -> io:format("sender confirm ~w~n", [Pid]), @@ -811,7 +820,8 @@ literal_sender(N, Recv) -> ?mod:b(), ?mod:c(), ?mod:d(), - ?mod:e()]}, + ?mod:e(), + ?mod:f()]}, literal_sender(N - 1, Recv). literal_switcher() -> diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl index 7c3b0ebe73..13c8b412b0 100644 --- a/erts/emulator/test/code_SUITE_data/literals.erl +++ b/erts/emulator/test/code_SUITE_data/literals.erl @@ -19,7 +19,8 @@ %% -module(literals). --export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]). +-export([a/0,b/0,huge_bignum/0,funs/0, + binary/0,unused_binaries/0,bits/0]). -export([msg1/0,msg2/0,msg3/0,msg4/0,msg5/0]). a() -> @@ -108,3 +109,8 @@ msg2() -> {"hello","world"}. msg3() -> <<"halloj">>. msg4() -> #{ 1=> "hello", b => "world"}. msg5() -> {1,2,3,4,5,6}. + +funs() -> + %% Literal funs (in a non-literal list). + [fun ?MODULE:a/0, + fun() -> ok end]. %No environment. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index bb76e6f24b..9ffb484eb4 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -81,6 +81,7 @@ thr_msg_blast/1, consume_timeslice/1, env/1, + poll_pipe/1, z_test/1]). -export([bin_prefix/2]). @@ -168,6 +169,7 @@ all() -> %% Keep a_test first and z_test last... thr_msg_blast, consume_timeslice, env, + poll_pipe, z_test]. groups() -> @@ -2676,3 +2678,25 @@ rpc(Config, Fun) -> ct:fail(Other) end end. + +poll_pipe(Config) when is_list(Config) -> + %% ERL-647; we wouldn't see any events on EOF when polling a pipe using + %% kqueue(2). + case os:type() of + {unix, _} -> + Command = "erl -noshell -eval " + "'\"DATA\n\" = io:get_line(\"\")," + "eof = io:get_line(\"\")," + "halt()' <<< 'DATA'", + Ref = make_ref(), + Self = self(), + Pid = spawn(fun() -> os:cmd(Command), Self ! Ref end), + receive + Ref -> ok + after 5000 -> + exit(Pid, kill), + ct:fail("Stuck reading from stdin.") + end; + _ -> + {skipped, "Unix-only test"} + end. diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index 73fe9b0d8f..f8a879182e 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -576,7 +576,7 @@ refc_dist(Config) when is_list(Config) -> process_flag(trap_exit, true), Pid = spawn_link(Node, fun() -> receive Fun when is_function(Fun) -> - 2 = fun_refc(Fun), + 3 = fun_refc(Fun), exit({normal,Fun}) end end), F = fun() -> 42 end, @@ -598,7 +598,7 @@ refc_dist_send(Node, F) -> Pid = spawn_link(Node, fun() -> receive {To,Fun} when is_function(Fun) -> wait_until(fun () -> - 2 =:= fun_refc(Fun) + 3 =:= fun_refc(Fun) end), To ! Fun end @@ -626,7 +626,7 @@ refc_dist_reg_send(Node, F) -> Me ! Ref, receive {Me,Fun} when is_function(Fun) -> - 2 = fun_refc(Fun), + 3 = fun_refc(Fun), Me ! Fun end end), @@ -806,11 +806,13 @@ verify_not_undef(Fun, Tag) -> ct:fail("tag ~w not defined in fun_info", [Tag]); {Tag,_} -> ok end. - + id(X) -> X. spawn_call(Node, AFun) -> + Parent = self(), + Init = erlang:whereis(init), Pid = spawn_link(Node, fun() -> receive @@ -821,8 +823,10 @@ spawn_call(Node, AFun) -> _ -> lists:seq(0, Arity-1) end, Res = apply(Fun, Args), - {pid,Creator} = erlang:fun_info(Fun, pid), - Creator ! {result,Res} + case erlang:fun_info(Fun, pid) of + {pid,Init} -> Parent ! {result,Res}; + {pid,Creator} -> Creator ! {result,Res} + end end end), Pid ! {AFun,AFun,AFun}, diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index f93c637650..d0a6763fe5 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -3080,8 +3080,19 @@ y_regs(Config) when is_list(Config) -> true = is_map(Map2) andalso is_map(Map4), + gurka = y_regs_literal(0), + gaffel = y_regs_literal(1), + ok. +y_regs_literal(Key) when is_integer(Key) -> + %% Forces the key to be placed in a Y register. + lists:seq(1, 2), + case is_map_key(Key, #{ 0 => 0 }) of + true -> gurka; + false -> gaffel + end. + y_regs_update(Map0, Val0) -> Val1 = {t,Val0}, K1 = id({key,1}), diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 87cf7bf81d..edad62a9fb 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -45,8 +45,9 @@ api_macros/1, from_array/1, iolist_as_binary/1, resource/1, resource_binary/1, resource_takeover/1, - threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, - is_checks/1, + threading/1, send/1, send2/1, send3/1, send_threaded/1, + send_trace/1, send_seq_trace/1, + neg/1, is_checks/1, get_length/1, make_atom/1, make_string/1, reverse_list_test/1, otp_9828/1, otp_9668/1, consume_timeslice/1, nif_schedule/1, @@ -1809,6 +1810,59 @@ send(Config) when is_list(Config) -> {ok,0} = send_list_seq(7, DeadPid), ok. + +%% Test tracing of enif_send +send_trace(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + Papa = self(), + N = 1500, + List = lists:seq(1,N), + + Tracer = spawn_link(fun F() -> receive get -> Papa ! receive_any(), F() end end), + + erlang:trace(self(), true, [send,'receive',{tracer,Tracer}]), + {ok,1} = send_list_seq(N, self()), + List = receive_any(), + timeout = receive_any(0), + Tracer ! get, + {trace,Papa,send,List,Papa} = receive_any(), + Tracer ! get, + {trace,Papa,'receive',List} = receive_any(). + +%% Test that seq_trace works with nif trace +send_seq_trace(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + Papa = self(), + N = 1500, + List = lists:seq(1,N), + Label = make_ref(), + + Tracer = spawn_link(fun F() -> receive get -> Papa ! receive_any(), F() end end), + + seq_trace:set_system_tracer(Tracer), + seq_trace:set_token(label,Label), + seq_trace:set_token(send,true), + seq_trace:set_token('receive',true), + + {ok,1} = send_list_seq(N, self()), + List = receive_any(), + timeout = receive_any(0), + {ok,1} = send_list_seq(N, self()), + List = receive_any(), + timeout = receive_any(0), + + Tracer ! get, + {seq_trace,Label,{send,{0,1},Papa,Papa,List}} = receive_any(), + Tracer ! get, + {seq_trace,Label,{'receive',{0,1},Papa,Papa,List}} = receive_any(), + Tracer ! get, + {seq_trace,Label,{send,{1,2},Papa,Papa,List}} = receive_any(), + Tracer ! get, + {seq_trace,Label,{'receive',{1,2},Papa,Papa,List}} = receive_any(). + + %% More NIF message sending send2(Config) when is_list(Config) -> ensure_lib_loaded(Config), diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index 7df001fec5..55135fbcbc 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -50,7 +50,8 @@ bad_nc/1, unique_pid/1, iter_max_procs/1, - magic_ref/1]). + magic_ref/1, + dist_entry_gc/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -58,7 +59,7 @@ suite() -> all() -> - [term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq, + [dist_entry_gc, term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq, node_table_gc, dist_link_refc, dist_monitor_refc, node_controller_refc, ets_refc, match_spec_refc, timer_refc, pid_wrap, port_wrap, bad_nc, @@ -894,6 +895,29 @@ magic_ref(Config) when is_list(Config) -> true = is_reference(MRef2), true = erts_debug:get_internal_state({magic_ref,MRef2}), ok. + + +lost_pending_connection(Node) -> + _ = (catch erts_internal:new_connection(Node)), + ok. + +dist_entry_gc(Config) when is_list(Config) -> + Me = self(), + {ok, Node} = start_node(get_nodefirstname(), "+zdntgc 0"), + P = spawn_link(Node, + fun () -> + LostNode = list_to_atom("lost_pending_connection@" ++ hostname()), + lost_pending_connection(LostNode), + garbage_collect(), %% Could crash... + Me ! {self(), ok} + end), + receive + {P, ok} -> ok + end, + unlink(P), + stop_node(Node), + ok. + %% %% -- Internal utils --------------------------------------------------------- %% diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 700734cd0b..f15217814a 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -161,6 +161,7 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.000",1.0, [{decimals, 3}]), test_fts("1.0",1.0, [{decimals, 1}]), test_fts("1.0",1.0, [{decimals, 3}, compact]), + test_fts("10",10.0, [{decimals, 0}, compact]), test_fts("1.12",1.123, [{decimals, 2}]), test_fts("1.123",1.123, [{decimals, 3}]), test_fts("1.123",1.123, [{decimals, 3}, compact]), diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl index 5f519d522e..74df857c65 100644 --- a/erts/emulator/test/ref_SUITE.erl +++ b/erts/emulator/test/ref_SUITE.erl @@ -22,6 +22,7 @@ -export([all/0, suite/0]). -export([wrap_1/1]). +-export([compare_list/1, compare_ets/1]). -export([loop_ref/1]). @@ -32,7 +33,7 @@ suite() -> {timetrap, {minutes, 2}}]. all() -> - [wrap_1]. + [wrap_1, compare_list, compare_ets]. %% Check that refs don't wrap around easily. wrap_1(Config) when is_list(Config) -> @@ -53,3 +54,28 @@ loop_ref(Parent) -> loop_ref(R, R, _) -> ok; loop_ref(R0, _, N) -> loop_ref(R0, make_ref(), N+1). + +%% Check that ref ordering works +compare_list(Config) when is_list(Config) -> + %% Although this test uses external refs, it would apply the same to plain refs + ExtRef1 = <<131,114,0,3,100,0,3,110,64,98,3, 0,0,173,156, 0,216,0,4, 0,0,0,0>>, + ExtRef2 = <<131,114,0,3,100,0,3,110,64,98,3, 0,1,31,27, 129,4,0,1, 0,0,0,0>>, + + Ref1 = binary_to_term(ExtRef1), %% #Ref<[email protected]> + Ref2 = binary_to_term(ExtRef2), %% #Ref<[email protected]> + OrderedList = [Ref1, Ref2], + OrderedList = lists:sort(OrderedList), + ok. + +%% This is the scarier case since it makes terms "invisible" in ets or Mnesia +%% (the underlying fault cause is the same as compare_list/1) +compare_ets(Config) when is_list(Config) -> + W2s = [610350147,899574699,2994196869,686384822,2397690439, 923302211], + ExtRefBase = <<131,114,0,3,100,0,3,110,64,98,3>>, + ExtRefs = [<<ExtRefBase/binary, 1:32, W2:32, 0:32>> || W2 <- W2s], + Refs = [binary_to_term(Bin) || Bin <- ExtRefs], + + Ets = ets:new(refbug, [ordered_set]), + ets:insert(Ets, [{Ref,Ref} || Ref <- Refs]), + 0 = length([R || R <- ets:tab2list(Ets), ets:lookup(Ets, element(1,R)) == []]), + ok. diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index fc11a04a31..15fe13c8c0 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -361,7 +361,7 @@ evil_timers(Config) when is_list(Config) -> %% %% 1. A timer started with erlang:start_timer(Time, Receiver, Msg), %% where Msg is a composite term, expires, and the receivers main - %% lock *can not* be acquired immediately (typically when the + %% lock *cannot* be acquired immediately (typically when the %% receiver *is* running). %% %% The wrap tuple ({timeout, TRef, Msg}) will in this case @@ -372,7 +372,7 @@ evil_timers(Config) when is_list(Config) -> RecvTimeOutMsgs0 = evil_recv_timeouts(200), %% 2. A timer started with erlang:start_timer(Time, Receiver, Msg), %% where Msg is an immediate term, expires, and the receivers main - %% lock *can not* be acquired immediately (typically when the + %% lock *cannot* be acquired immediately (typically when the %% receiver *is* running). %% %% The wrap tuple will in this case be allocated in a new diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 979b3185a5..c2d5cd7023 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -39,7 +39,7 @@ system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, system_monitor_long_schedule/1, bad_flag/1, trace_delivered/1, trap_exit_self_receive/1, - trace_info_badarg/1]). + trace_info_badarg/1, erl_704/1]). -include_lib("common_test/include/ct.hrl"). @@ -63,7 +63,7 @@ all() -> system_monitor_long_gc_2, system_monitor_large_heap_1, system_monitor_long_schedule, system_monitor_large_heap_2, bad_flag, trace_delivered, - trap_exit_self_receive, trace_info_badarg]. + trap_exit_self_receive, trace_info_badarg, erl_704]. init_per_testcase(_Case, Config) -> [{receiver,spawn(fun receiver/0)}|Config]. @@ -1739,6 +1739,21 @@ trace_info_badarg(Config) when is_list(Config) -> catch erlang:trace_info({a,b,c},d), ok. +%% An incoming suspend monitor down wasn't handled +%% correct when the local monitor half had been +%% removed with an emulator crash as result. +erl_704(Config) -> + erl_704_test(100). + +erl_704_test(0) -> + ok; +erl_704_test(N) -> + P = spawn(fun () -> receive infinity -> ok end end), + erlang:suspend_process(P), + exit(P, kill), + (catch erlang:resume_process(P)), + erl_704_test(N-1). + drop_trace_until_down(Proc, Mon) -> drop_trace_until_down(Proc, Mon, false, 0, 0). diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 896e4c8e45..2e034513b0 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -264,13 +264,14 @@ if [ "x$GDB" = "x" ]; then valversion=`valgrind --version` valmajor=`echo $valversion | sed 's,[a-z]*\-\([0-9]*\).*,\1,'` valminor=`echo $valversion | sed 's,[a-z]*\-[0-9]*.\([0-9]*\).*,\1,'` + valint=`echo "$valmajor * 1000 + $valminor" | bc` if [ "x$VALGRIND_LOG_XML" = "x" ]; then valgrind_xml= log_file_prefix="--log-file=" else export VALGRIND_LOG_XML valgrind_xml="--xml=yes" - if [ $valmajor -gt 2 -a $valminor -gt 4 ]; then + if [ $valint -gt 3004 ]; then log_file_prefix="--xml-file=" else log_file_prefix="--log-file=" @@ -279,7 +280,7 @@ if [ "x$GDB" = "x" ]; then if [ "x$VALGRIND_LOG_DIR" = "x" ]; then valgrind_log= else - if [ $valmajor -gt 2 -a $valminor -gt 4 ]; then + if [ $valint -gt 3004 ]; then valgrind_log="$log_file_prefix$VALGRIND_LOG_DIR/$VALGRIND_LOGFILE_PREFIX$VALGRIND_LOGFILE_INFIX$EMU_NAME.log.$$" else valgrind_log="$log_file_prefix$VALGRIND_LOG_DIR/$VALGRIND_LOGFILE_PREFIX$VALGRIND_LOGFILE_INFIX$EMU_NAME.log" diff --git a/erts/include/internal/gcc/ethr_membar.h b/erts/include/internal/gcc/ethr_membar.h index 07960ce040..5cbda5582d 100644 --- a/erts/include/internal/gcc/ethr_membar.h +++ b/erts/include/internal/gcc/ethr_membar.h @@ -96,7 +96,7 @@ * issue an aquire memory barrier and an __atomic * builtin memory acess with the __ATOMIC_RELEASE * memory model must at least issue a release memory - * barrier. Otherwise the two can not be paired. + * barrier. Otherwise the two cannot be paired. * 4. All __atomic builtins accessing memory using the * __ATOMIC_CONSUME builtin can be used for the same * reason __ATOMIC_ACQUIRE can be used. The ethread diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex f375c05c99..3316e4348c 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 41ff38359c..517ca74301 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -580,15 +580,20 @@ read_link_info(Name, Opts) -> read_info_1(Name, 0, proplist_get_value(time, Opts, local)). read_info_1(Name, FollowLinks, TimeType) -> - try 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 }} + 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 }} + end catch - error:badarg -> {error, badarg} + error:_ -> {error, badarg} end. write_file_info(Filename, Info) -> diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index 2a3605260d..bcb54cca42 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -1557,7 +1557,7 @@ type_opt_1(O) when is_atom(O) -> undefined. %% Get. No supplied value. type_value(get, undefined) -> false; % Undefined type -%% These two clauses can not happen since they are only used +%% These two clauses cannot happen since they are only used %% in record fields - from record fields they must have a %% value though it might be 'undefined', so record fields %% calls type_value/3, not type_value/2. @@ -1723,7 +1723,7 @@ type_value_2(_, _) -> false. %% Get. No supplied value. %% -%% These two clauses can not happen since they are only used +%% These two clauses cannot happen since they are only used %% in record fields - from record fields they must have a %% value though it might be 'undefined', so record fields %% calls enc_value/3, not enc_value/2. diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl index c32dbabe8d..f92c25bdb4 100644 --- a/erts/test/upgrade_SUITE.erl +++ b/erts/test/upgrade_SUITE.erl @@ -25,7 +25,7 @@ -define(upgr_sname,otp_upgrade). -%% Applications that are excluded from this test because they can not +%% Applications that are excluded from this test because they cannot %% just be started in a new node with out specific configuration. -define(start_exclude, [cosEvent,cosEventDomain,cosFileTransfer,cosNotification, diff --git a/erts/vsn.mk b/erts/vsn.mk index 0abb06bdc1..293b555b18 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 10.0.3 +VSN = 10.0.7 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/c_src/asn1_erl_nif.c b/lib/asn1/c_src/asn1_erl_nif.c index d5aaadb89b..797be6d4f8 100644 --- a/lib/asn1/c_src/asn1_erl_nif.c +++ b/lib/asn1/c_src/asn1_erl_nif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2017. All Rights Reserved. + * Copyright Ericsson AB 2002-2018. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -949,6 +949,12 @@ static int ber_decode_value(ErlNifEnv* env, ERL_NIF_TERM *value, unsigned char * unsigned char *tmp_out_buff; ERL_NIF_TERM term = 0, curr_head = 0; + /* Recursion depth limitation, borrow a signed int: maybe_ret */ + maybe_ret = (int) (ErlNifSInt) ((char *)value - (char *)ib_index); + maybe_ret = maybe_ret < 0 ? -maybe_ret : maybe_ret; + if (maybe_ret >= sizeof(void *) * 8192) /* 8 k pointer words */ + return ASN1_ERROR; + if (((in_buf[*ib_index]) & 0x80) == ASN1_SHORT_DEFINITE_LENGTH) { len = in_buf[*ib_index]; } else if (in_buf[*ib_index] == ASN1_INDEFINITE_LENGTH) { @@ -993,7 +999,7 @@ static int ber_decode_value(ErlNifEnv* env, ERL_NIF_TERM *value, unsigned char * while (*ib_index < end_index) { if ((maybe_ret = ber_decode(env, &term, in_buf, ib_index, - in_buf_len)) <= ASN1_ERROR + *ib_index + len)) <= ASN1_ERROR ) return maybe_ret; curr_head = enif_make_list_cell(env, term, curr_head); diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index 860cf4d22d..c86fa79c2c 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -47,6 +47,28 @@ </section> +<section><title>Asn1 5.0.5.1</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p>A bug in ASN.1 BER decoding has been fixed. When + decoding a recursively enclosed term the length was not + propagated to that term decoding, so if the length of the + enclosed term was longer than the enclosing that error + was not dectected</p> <p>A hard coded C stack limitation + for decoding recursive ASN.1 terms has been introduced. + This is currently set to 8 kWords giving a nesting depth + of about 1000 levels. Deeper terms can not be decoded, + which should not be much of a real world limitation.</p> + <p> + Own Id: OTP-14440 Aux Id: ERIERL-220 </p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 5.0.5</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 321980e5e4..9ec0d93e93 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -5770,7 +5770,7 @@ format_error({missing_ocft,Component}) -> format_error(multiple_uniqs) -> "implementation limitation: only one UNIQUE field is allowed in CLASS"; format_error({namelist_redefinition,Name}) -> - io_lib:format("the name '~s' can not be redefined", [Name]); + io_lib:format("the name '~s' cannot be redefined", [Name]); format_error({param_bad_type, Ref}) -> io_lib:format("'~p' is not a parameterized type", [Ref]); format_error(param_wrong_number_of_arguments) -> diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 7b669c1c2c..5506923341 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -132,7 +132,8 @@ groups() -> testSeq2738, % Uses 'Constructed' {group, [], [constructed, - ber_decode_error]}, + ber_decode_error, + otp_14440]}, testSeqSetIndefinite, testChoiceIndefinite, per_open_type, @@ -736,6 +737,36 @@ ber_decode_error(Config, Rule, Opts) -> asn1_test_lib:compile("Constructed", Config, [Rule|Opts]), ber_decode_error:run(Opts). +otp_14440(_Config) -> + Args = " -pa \"" ++ filename:dirname(code:which(?MODULE)) ++ "\"", + {ok,N} = slave:start(hostname(), otp_14440, Args), + Result = rpc:call(N, ?MODULE, otp_14440_decode, []), + io:format("Decode result = ~p~n", [Result]), + case Result of + {exit,{error,{asn1,{invalid_value,5}}}} -> + ok = slave:stop(N); + %% We get this if stack depth limit kicks in: + {exit,{error,{asn1,{unknown,_}}}} -> + ok = slave:stop(N); + _ -> + _ = slave:stop(N), + ?t:fail(Result) + end. +%% +otp_14440_decode() -> + Data = + iolist_to_binary( + lists:duplicate( + 32, list_to_binary(lists:duplicate(1024, 16#7f)))), + try asn1rt_nif:decode_ber_tlv(Data) of + Result -> + {unexpected_return,Result} + catch + Class:Reason -> + {Class,Reason} + end. + + h323test(Config) -> test(Config, fun h323test/3). h323test(Config, Rule, Opts) -> Files = ["H235-SECURITY-MESSAGES", "H323-MESSAGES", @@ -1350,7 +1381,7 @@ xref_export_all(_Config) -> {ok,_} = xref:q(S, Def), {ok,Unused} = xref:q(S, "X - Called - range (closure E | Called)"), xref:stop(S), - case Unused of + case Unused -- [{?MODULE,otp_14440_decode,0}] of [] -> ok; [_|_] -> @@ -1385,3 +1416,11 @@ all_called_1([F|T]) when is_atom(F) -> L ++ all_called_1(T); all_called_1([]) -> []. + +hostname() -> + hostname(atom_to_list(node())). + +hostname([$@ | Hostname]) -> + list_to_atom(Hostname); +hostname([_C | Cs]) -> + hostname(Cs). diff --git a/lib/asn1/test/asn1_SUITE_data/IN-CS-1-Datatypes.asn b/lib/asn1/test/asn1_SUITE_data/IN-CS-1-Datatypes.asn index ff0361f5c5..fb092f3f9c 100644 --- a/lib/asn1/test/asn1_SUITE_data/IN-CS-1-Datatypes.asn +++ b/lib/asn1/test/asn1_SUITE_data/IN-CS-1-Datatypes.asn @@ -1152,7 +1152,7 @@ FilteringCriteria ::= CHOICE { -- In case calledAddressValue is specified, the numbers to be filtered are from calledAddressValue
-- up to and including calledAddressValue + maximumNumberOfCounters-1.
--- The last two digits of calledAddressvalue can not exceed 100-maximumNumberOfCounters.
+-- The last two digits of calledAddressvalue cannot exceed 100-maximumNumberOfCounters.
FilteringTimeOut ::= CHOICE {
duration [0] Duration,
stopTime [1] DateAndTime
diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml index b51dee266b..c0380c4142 100644 --- a/lib/common_test/doc/src/ct.xml +++ b/lib/common_test/doc/src/ct.xml @@ -1522,7 +1522,7 @@ <v>Hours = integer()</v> <v>Mins = integer()</v> <v>Secs = integer()</v> - <v>Millisecs = integer() | float()</v> + <v>Millisecs = integer()</v> <v>Func = {M, F, A} | function()</v> <v>M = atom()</v> <v>F = atom()</v> diff --git a/lib/common_test/doc/src/ct_hooks.xml b/lib/common_test/doc/src/ct_hooks.xml index 954be0ffba..2f853d133d 100644 --- a/lib/common_test/doc/src/ct_hooks.xml +++ b/lib/common_test/doc/src/ct_hooks.xml @@ -368,7 +368,7 @@ <seealso marker="common_test#Module:end_per_testcase-2"><c>end_per_testcase</c></seealso> instead.</p> - <p>This function can not change the result of the test case by returning skip or fail + <p>This function cannot change the result of the test case by returning skip or fail tuples, but it may insert items in <c>Config</c> that can be read in <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/5</c>.</p> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index c8005d8f79..df22896b27 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -2089,7 +2089,7 @@ ct_netconfc:close_session sometimes returned {error,closed} because the ssh connection was closed (from the server side) before the rpc-reply was received - by the client. This is normal and can not be helped. It + by the client. This is normal and cannot be helped. It has been corrected so the return will be 'ok' in this case. Other error situations will still give {error,Reason}.</p> @@ -2103,7 +2103,7 @@ {error,{process_down,Pid,normal}} because the ssh connection was closed (from the server side) before the rpc-reply was received by the client. This is normal and - can not be helped. It has been corrected so the return + cannot be helped. It has been corrected so the return will be 'ok' in this situation.</p> <p> Own Id: OTP-10570</p> @@ -2755,8 +2755,8 @@ The info function for <c>init/end_per_suite(Config)</c> is <c>init/end_per_suite()</c>, and for <c>init/end_per_group(GroupName,Config)</c> it's - <c>init/end_per_group(GroupName)</c>. Info functions can - not be used with <c>init/end_per_testcase(TestCase, + <c>init/end_per_group(GroupName)</c>. Info functions + cannot be used with <c>init/end_per_testcase(TestCase, Config)</c>, since these configuration functions execute on the test case process and will use the same properties as the test case (i.e. properties set by the test case @@ -3840,7 +3840,7 @@ If the Erlang runtime system was started without access to an erlang shell (e.g. -noshell), compilation errors would cause a crash in the Common Test application. - Without access to a shell, Common Test can not prompt the + Without access to a shell, Common Test cannot prompt the user to choose to continue or abort the test session, but must assume that the session should proceed.</p> <p> diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 134ae0e1cc..7e98e6395f 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -1168,7 +1168,7 @@ get_all(Mod, ConfTests) -> case code:which(Mod) of non_existing -> list_to_atom(atom_to_list(Mod)++ - " can not be compiled or loaded"); + " cannot be compiled or loaded"); _ -> list_to_atom(atom_to_list(Mod)++":all/0 is missing") end, diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl index 60d17f43dc..ac3dcab7c9 100644 --- a/lib/common_test/src/ct_release_test.erl +++ b/lib/common_test/src/ct_release_test.erl @@ -152,10 +152,10 @@ %% returned configuration must therefore also be returned from %% the calling `init_per_*'. %% -%% If the initialization fails, e.g. if a required release can -%% not be found, the function returns `{skip,Reason}'. In +%% If the initialization fails, e.g. if a required release +%% cannot be found, the function returns `{skip,Reason}'. In %% this case the other test support functions in this mudule -%% can not be used. +%% cannot be used. %% %% Example: %% @@ -426,7 +426,7 @@ init_upgrade_test(Level) -> case OldRel of false -> ct:log("Release ~tp is not available." - " Upgrade on '~p' level can not be tested.", + " Upgrade on '~p' level cannot be tested.", [FromVsn,Level]), undefined; _ -> @@ -528,7 +528,7 @@ target_system(Apps,CreateDir,InstallDir,{FromVsn,_,AllAppsVsns,Path}) -> {path,Path}]]), %% Unpack the tar to complete the installation - erl_tar:extract(RelName ++ ".tar.gz", [{cwd, InstallDir}, compressed]), + ok = erl_tar:extract(RelName ++ ".tar.gz", [{cwd, InstallDir}, compressed]), %% Add bin and log dirs BinDir = filename:join([InstallDir, "bin"]), @@ -554,11 +554,11 @@ target_system(Apps,CreateDir,InstallDir,{FromVsn,_,AllAppsVsns,Path}) -> %% create start_erl.data, sys.config and start.src StartErlData = filename:join([InstallDir, "releases", "start_erl.data"]), - write_file(StartErlData, io_lib:fwrite("~s ~s~n", [ErtsVsn, FromVsn])), + ok = write_file(StartErlData, io_lib:fwrite("~s ~s~n", [ErtsVsn, FromVsn])), SysConfig = filename:join([InstallDir, "releases", FromVsn, "sys.config"]), - write_file(SysConfig, "[]."), + ok = write_file(SysConfig, "[]."), StartSrc = filename:join(ErtsBinDir,"start.src"), - write_file(StartSrc,start_script()), + ok = write_file(StartSrc,start_script()), ok = file:change_mode(StartSrc,8#0755), %% Make start_erl executable @@ -620,7 +620,7 @@ upgrade_system(Apps, FromRel, CreateDir, InstallDir, {_,ToVsn,_,_}) -> [{path,[FromPath]}, {outdir,CreateDir}]]), SysConfig = filename:join([CreateDir, "sys.config"]), - write_file(SysConfig, "[]."), + ok = write_file(SysConfig, "[]."), ok = systools(make_tar,[RelName,[{erts,code:root_dir()}]]), @@ -858,7 +858,7 @@ subst_file(Src, Dest, Vars, Opts) -> {ok, Bin} = file:read_file(Src), Conts = unicode:characters_to_list(Bin), NConts = subst(Conts, Vars), - write_file(Dest, NConts), + ok = write_file(Dest, NConts), case lists:member(preserve, Opts) of true -> {ok, FileInfo} = file:read_file_info(Src), diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index f9abecfd38..58a29edace 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -1085,7 +1085,7 @@ match_line(Name,Pid,Line,[Pattern|Patterns],FoundPrompt,Term,EO,RetTag) -> end; match_line(Name,Pid,Line,[],FoundPrompt,Term,EO,match) -> match_line(Name,Pid,Line,EO#eo.haltpatterns,FoundPrompt,Term,EO,halt); -%% print any terminated line that can not be matched +%% print any terminated line that cannot be matched match_line(Name,Pid,Line,[],_FoundPrompt,true,_EO,halt) -> log(name_or_pid(Name,Pid)," ~ts",[Line]), nomatch; diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index d8fd401a64..9f489e9bfb 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -192,7 +192,10 @@ do_start(Parent, Mode, LogDir, Verbosity) -> ok end, - ct_default_gl:start_link(group_leader()), + case ct_default_gl:start_link(group_leader()) of + {ok, _} -> ok; + ignore -> ok + end, {StartTime,TestLogDir} = ct_logs:init(Mode, Verbosity), diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index 4980d1ee4b..86081369b9 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -124,7 +124,8 @@ start_log_handler() -> shutdown=>2000, type=>worker, modules=>[?MODULE]}, - {ok,_} = supervisor:start_child(logger_sup,ChildSpec); + {ok,_} = supervisor:start_child(logger_sup,ChildSpec), + ok; _Pid -> ok end, diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 8bd6cd583a..34f2feb33c 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -1393,7 +1393,7 @@ temp_nodename([Chr|Base], Acc) -> %% %% Counts the test cases that are about to run and returns that number. %% If there's a conf group in TestSpec with a repeat property, the total number -%% of cases can not be calculated and NoOfCases = unknown. +%% of cases cannot be calculated and NoOfCases = unknown. count_test_cases(TopCases, SkipCases) when is_list(TopCases) -> case collect_all_cases(TopCases, SkipCases) of {error,_Why} = Error -> @@ -4906,7 +4906,7 @@ collect_files(Dir, Pattern, St, Mode) -> fullname_to_mod(Path) when is_list(Path) -> %% If this is called with a binary, then we are probably in +fnu %% mode and have found a beam file with name encoded as latin1. We - %% will let this crash since it can not work to load such a module + %% will let this crash since it cannot work to load such a module %% anyway. It should be removed or renamed! list_to_atom(filename:rootname(filename:basename(Path))). diff --git a/lib/common_test/test/ct_auto_compile_SUITE.erl b/lib/common_test/test/ct_auto_compile_SUITE.erl index dface99b8f..f88f13c889 100644 --- a/lib/common_test/test/ct_auto_compile_SUITE.erl +++ b/lib/common_test/test/ct_auto_compile_SUITE.erl @@ -169,7 +169,7 @@ test_events(ac_flag) -> {?eh,start_info,{1,1,3}}, {?eh,tc_start,{ct_framework,error_in_suite}}, {?eh,tc_done,{ct_framework,error_in_suite, - {failed,{error,'bad_SUITE can not be compiled or loaded'}}}}, + {failed,{error,'bad_SUITE cannot be compiled or loaded'}}}}, {?eh,tc_start,{dummy_SUITE,init_per_suite}}, {?eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, {?eh,test_stats,{1,1,{1,0}}}, @@ -186,7 +186,7 @@ test_events(ac_spec) -> {?eh,start_info,{1,1,3}}, {?eh,tc_start,{ct_framework,error_in_suite}}, {?eh,tc_done,{ct_framework,error_in_suite, - {failed,{error,'bad_SUITE can not be compiled or loaded'}}}}, + {failed,{error,'bad_SUITE cannot be compiled or loaded'}}}}, {?eh,tc_start,{dummy_SUITE,init_per_suite}}, {?eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, {?eh,test_stats,{1,1,{1,0}}}, diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index a2fa099a8c..0a374d7404 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -205,7 +205,7 @@ hello_required_exists(Config) -> SshDir = ?config(ssh_dir,Config), {ok,_Client1} = open_configured_success(my_named_connection,SshDir), - %% Check that same name can not be used twice + %% Check that same name cannot be used twice {error,{connection_exists,_Client1}} = ct_netconfc:open(my_named_connection,[{user_dir,SshDir}]), @@ -385,7 +385,7 @@ timeout_get(Config) -> %% received, the timeout message might already be sent when the timer %% is cancelled. This test checks that the timeout message is flushed %% from the message queue. If it isn't, the client crashes and the -%% session can not be closed afterwards. +%% session cannot be closed afterwards. %% Note that we can only hope that the test case triggers the problem %% every now and then, as it is very timing dependent... flush_timeout_get(Config) -> diff --git a/lib/common_test/test/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE.erl index 05737cfac9..6e52f24025 100644 --- a/lib/common_test/test/test_server_SUITE.erl +++ b/lib/common_test/test/test_server_SUITE.erl @@ -260,7 +260,7 @@ translate_filename(Filename,EncodingOnTestNode) -> end. get_latest_run_dir(Dir) -> - %% For the time being, filelib:wildcard can not take a binary + %% For the time being, filelib:wildcard cannot take a binary %% argument, so we avoid using this here. case file:list_dir(Dir) of {ok,Files} -> @@ -315,7 +315,7 @@ generate_and_run_unicode_test(Config0,Encoding) -> DataDir = ?config(data_dir,Config0), Suite = create_unicode_test_suite(DataDir,Encoding), - %% We can not run this test on default node since it must be + %% We cannot run this test on default node since it must be %% started with correct file name mode (+fnu/+fnl). %% OBS: the node are stopped by end_per_testcase/2 Config1 = lists:keydelete(node,1,Config0), diff --git a/lib/common_test/test/test_server_test_lib.erl b/lib/common_test/test/test_server_test_lib.erl index 9ee946af0b..58b3aaee9b 100644 --- a/lib/common_test/test/test_server_test_lib.erl +++ b/lib/common_test/test/test_server_test_lib.erl @@ -22,7 +22,7 @@ -export([parse_suite/1]). -export([init/2, pre_init_per_testcase/3, post_end_per_testcase/4]). -%% for test_server_SUITE when node can not be started as slave +%% for test_server_SUITE when node cannot be started as slave -export([prepare_tester_node/2]). -include("test_server_test_lib.hrl"). diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 0ec7aa54c7..671126b73b 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -32,6 +32,23 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 7.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed an issue where files compiled with the + <c>+deterministic</c> option differed if they were + compiled in a different directory but were otherwise + identical.</p> + <p> + Own Id: OTP-15204 Aux Id: ERL-679 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.2.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -297,6 +314,23 @@ </section> +<section><title>Compiler 7.1.5.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed an issue where files compiled with the + <c>+deterministic</c> option differed if they were + compiled in a different directory but were otherwise + identical.</p> + <p> + Own Id: OTP-15204 Aux Id: ERL-679 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.1.5</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 2408c76b48..bd35f20442 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -61,12 +61,17 @@ MODULES = \ beam_listing \ beam_opcodes \ beam_peep \ - beam_receive \ - beam_reorder \ - beam_record \ beam_split \ + beam_ssa \ + beam_ssa_codegen \ + beam_ssa_lint \ + beam_ssa_opt \ + beam_ssa_pp \ + beam_ssa_pre_codegen \ + beam_ssa_recv \ + beam_ssa_type \ + beam_kernel_to_ssa \ beam_trim \ - beam_type \ beam_utils \ beam_validator \ beam_z \ @@ -90,7 +95,6 @@ MODULES = \ sys_core_fold_lists \ sys_core_inline \ sys_pre_attributes \ - v3_codegen \ v3_core \ v3_kernel \ v3_kernel_pp @@ -99,6 +103,7 @@ BEAM_H = $(wildcard ../priv/beam_h/*.h) HRL_FILES= \ beam_disasm.hrl \ + beam_ssa.hrl \ core_parse.hrl \ v3_kernel.hrl @@ -185,7 +190,16 @@ release_docs_spec: # ---------------------------------------------------- $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl -$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl +$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl beam_ssa.hrl +$(EBIN)/beam_kernel_to_ssa.beam: v3_kernel.hrl beam_ssa.hrl +$(EBIN)/beam_ssa.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_codegen.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_lint.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_opt.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_pp.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_pre_codegen.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_recv.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_type.beam: beam_ssa.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl $(EBIN)/core_lib.beam: core_parse.hrl @@ -197,7 +211,6 @@ $(EBIN)/sys_core_dsetel.beam: core_parse.hrl $(EBIN)/sys_core_fold.beam: core_parse.hrl $(EBIN)/sys_core_fold_lists.beam: core_parse.hrl $(EBIN)/sys_core_inline.beam: core_parse.hrl -$(EBIN)/v3_codegen.beam: v3_kernel.hrl $(EBIN)/v3_core.beam: core_parse.hrl $(EBIN)/v3_kernel.beam: core_parse.hrl v3_kernel.hrl $(EBIN)/v3_kernel_pp.beam: v3_kernel.hrl diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 6fd4ace540..266e8f46c8 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -39,8 +39,13 @@ function({function,Name,Arity,CLabel,Is0}) -> %% Remove unusued labels for cleanliness and to help %% optimization passes and HiPE. - Is = beam_jump:remove_unused_labels(Is1), - {function,Name,Arity,CLabel,Is} + Is2 = beam_jump:remove_unused_labels(Is1), + + %% Some optimization passes can't handle consecutive labels. + %% Coalesce multiple consecutive labels. + Is = coalesce_consecutive_labels(Is2, [], []), + + {function,Name,Arity,CLabel,Is} catch Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), @@ -113,6 +118,8 @@ rename_instr({put_map_exact,Fail,S,D,R,L}) -> {put_map,Fail,exact,S,D,R,L}; rename_instr({test,has_map_fields,Fail,Src,{list,List}}) -> {test,has_map_fields,Fail,[Src|List]}; +rename_instr({test,is_nil,Fail,[Src]}) -> + {test,is_eq_exact,Fail,[Src,nil]}; rename_instr({select_val=I,Reg,Fail,{list,List}}) -> {select,I,Reg,Fail,List}; rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) -> @@ -120,3 +127,11 @@ rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) -> rename_instr(send) -> {call_ext,2,send}; rename_instr(I) -> I. + +coalesce_consecutive_labels([{label,L}=Lbl,{label,Alias}|Is], Replace, Acc) -> + coalesce_consecutive_labels([Lbl|Is], [{Alias,L}|Replace], Acc); +coalesce_consecutive_labels([I|Is], Replace, Acc) -> + coalesce_consecutive_labels(Is, Replace, [I|Acc]); +coalesce_consecutive_labels([], Replace, Acc) -> + D = maps:from_list(Replace), + beam_utils:replace_labels(Acc, [], D, fun(L) -> L end). diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index fe43163455..0ed2a03a81 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -17,39 +17,24 @@ %% %% %CopyrightEnd% %% -%% Purpose : Partitions assembly instructions into basic blocks and -%% optimizes them. +%% Purpose: Partition BEAM instructions into basic blocks. -module(beam_block). -export([module/2]). --import(lists, [reverse/1,reverse/2,member/2]). +-import(lists, [reverse/1,splitwith/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. -module({Mod,Exp,Attr,Fs0,Lc}, Opts) -> - Blockify = not member(no_blockify, Opts), - Fs = [function(F, Blockify) || F <- Fs0], +module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> + Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -function({function,Name,Arity,CLabel,Is0}, Blockify) -> +function({function,Name,Arity,CLabel,Is0}) -> try - %% Collect basic blocks and optimize them. - Is1 = case Blockify of - false -> Is0; - true -> blockify(Is0) - end, - Is2 = embed_lines(Is1), - Is3 = local_cse(Is2), - Is4 = beam_utils:anno_defs(Is3), - Is5 = move_allocates(Is4), - Is6 = beam_utils:live_opt(Is5), - Is7 = opt_blocks(Is6), - Is8 = beam_utils:delete_annos(Is7), - Is = opt_allocs(Is8), - - %% Done. + Is1 = blockify(Is0), + Is = embed_lines(Is1), {function,Name,Arity,CLabel,Is} catch Class:Error:Stack -> @@ -80,12 +65,10 @@ collect_block(Is) -> collect_block(Is, []). collect_block([{allocate,N,R}|Is0], Acc) -> - {Inits,Is} = lists:splitwith(fun ({init,{y,_}}) -> true; - (_) -> false - end, Is0), + {Inits,Is} = splitwith(fun ({init,{y,_}}) -> true; + (_) -> false + end, Is0), collect_block(Is, [{set,[],[],{alloc,R,{nozero,N,0,Inits}}}|Acc]); -collect_block([{allocate_zero,Ns,R},{test_heap,Nh,R}|Is], Acc) -> - collect_block(Is, [{set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}|Acc]); collect_block([I|Is]=Is0, Acc) -> case collect(I) of error -> {reverse(Acc),Is0}; @@ -106,6 +89,7 @@ collect({move,S,D}) -> {set,[D],[S],move}; collect({put_list,S1,S2,D}) -> {set,[D],[S1,S2],put_list}; collect({put_tuple,A,D}) -> {set,[D],[],{put_tuple,A}}; collect({put,S}) -> {set,[],[S],put}; +collect({put_tuple2,D,{list,Els}}) -> {set,[D],Els,put_tuple2}; collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}}; collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}}; collect({get_hd,S,D}) -> {set,[D],[S],get_hd}; @@ -137,557 +121,6 @@ embed_lines([{block,B2},{line,_}=Line,{block,B1}|T], Acc) -> embed_lines([{block,B1},{line,_}=Line|T], Acc) -> B = {block,[{set,[],[],Line}|B1]}, embed_lines([B|T], Acc); -embed_lines([{block,B2},{block,B1}|T], Acc) -> - %% This can only happen when beam_block is run for - %% the second time. - B = {block,B1++B2}, - embed_lines([B|T], Acc); embed_lines([I|Is], Acc) -> embed_lines(Is, [I|Acc]); embed_lines([], Acc) -> Acc. - -opt_blocks([{block,Bl0}|Is]) -> - %% The live annotation at the beginning is not useful. - [{'%anno',_}|Bl] = Bl0, - [{block,opt_block(Bl)}|opt_blocks(Is)]; -opt_blocks([I|Is]) -> - [I|opt_blocks(Is)]; -opt_blocks([]) -> []. - -opt_block(Is0) -> - find_fixpoint(fun(Is) -> - opt_tuple_element(opt(Is)) - end, Is0). - -find_fixpoint(OptFun, Is0) -> - case OptFun(Is0) of - Is0 -> Is0; - Is1 -> find_fixpoint(OptFun, Is1) - end. - -%% move_allocates(Is0) -> Is -%% Move allocate instructions upwards in the instruction stream -%% (within the same block), in the hope of getting more possibilities -%% for optimizing away moves later. -%% -%% For example, we can transform the following instructions: -%% -%% get_tuple_element x(1) Element => x(2) -%% allocate_zero StackSize 3 %% x(0), x(1), x(2) are live -%% -%% to the following instructions: -%% -%% allocate_zero StackSize 2 %% x(0) and x(1) are live -%% get_tuple_element x(1) Element => x(2) -%% -%% NOTE: Since the beam_reorder pass has been run, it is no longer -%% safe to assume that if x(N) is initialized, then all lower-numbered -%% x registers are also initialized. -%% -%% For example, we must be careful when transforming the following -%% instructions: -%% -%% get_tuple_element x(0) Element => x(1) -%% allocate_zero StackSize 3 %x(0), x(1), x(2) are live -%% -%% to the following instructions: -%% -%% allocate_zero StackSize 3 -%% get_tuple_element x(0) Element => x(1) -%% -%% The transformation is safe if and only if x(1) has been -%% initialized previously. We will use the annotations added by -%% beam_utils:anno_defs/1 to determine whether x(a) has been -%% initialized. - -move_allocates([{block,Bl0}|Is]) -> - Bl = move_allocates_1(reverse(Bl0), []), - [{block,Bl}|move_allocates(Is)]; -move_allocates([I|Is]) -> - [I|move_allocates(Is)]; -move_allocates([]) -> []. - -move_allocates_1([{'%anno',_}|Is], Acc) -> - move_allocates_1(Is, Acc); -move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info0}}|Acc]=Acc0) -> - case alloc_may_pass(I) of - false -> - move_allocates_1(Is, [I|Acc0]); - true -> - case alloc_live_regs(I, Is, Live0) of - not_possible -> - move_allocates_1(Is, [I|Acc0]); - Live when is_integer(Live) -> - Info = safe_info(Info0), - A = {set,[],[],{alloc,Live,Info}}, - move_allocates_1(Is, [A,I|Acc]) - end - end; -move_allocates_1([I|Is], Acc) -> - move_allocates_1(Is, [I|Acc]); -move_allocates_1([], Acc) -> Acc. - -alloc_may_pass({set,_,[{fr,_}],fmove}) -> false; -alloc_may_pass({set,_,_,{alloc,_,_}}) -> false; -alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; -alloc_may_pass({set,_,_,put_list}) -> false; -alloc_may_pass({set,_,_,put}) -> false; -alloc_may_pass({set,_,_,_}) -> true. - -safe_info({nozero,Stack,Heap,_}) -> - %% nozero is not safe if the allocation instruction is moved - %% upwards past an instruction that may throw an exception - %% (such as element/2). - {zero,Stack,Heap,[]}; -safe_info(Info) -> Info. - -%% opt([Instruction]) -> [Instruction] -%% Optimize the instruction stream inside a basic block. - -opt([{set,[X],[X],move}|Is]) -> opt(Is); -opt([{set,[Dst],_,move},{set,[Dst],[Src],move}=I|Is]) when Dst =/= Src -> - opt([I|Is]); -opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[{x,0}],move}|Is]) -> - opt([I1,{set,[D2],[S1],move}|Is]); -opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[S2],move}|Is0]) when S1 =/= D2 -> - %% Place move S x0 at the end of move sequences so that - %% loader can merge with the following instruction - {Ds,Is} = opt_moves([D2], Is0), - [{set,Ds,[S2],move}|opt([I1|Is])]; -opt([{set,_,_,{line,_}}=Line1, - {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, - {set,_,_,{line,_}}=Line2, - {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) - when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> - opt([Line2,I2,Line1,I1|Is]); -opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,L}}}=I1, - {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,L}}}=I2|Is]) - when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> - opt([I2,I1|Is]); -opt([{set,Hd0,Cons,get_hd}=GetHd, - {set,Tl0,Cons,get_tl}=GetTl|Is0]) -> - case {opt_moves(Hd0, [GetTl|Is0]),opt_moves(Tl0, [GetHd|Is0])} of - {{Hd0,Is},{Tl0,_}} -> - [GetHd|opt(Is)]; - {{Hd,Is},{Tl0,_}} -> - [{set,Hd,Cons,get_hd}|opt(Is)]; - {{_,_},{Tl,Is}} -> - [{set,Tl,Cons,get_tl}|opt(Is)] - end; -opt([{set,Ds0,Ss,Op}|Is0]) -> - {Ds,Is} = opt_moves(Ds0, Is0), - [{set,Ds,Ss,Op}|opt(Is)]; -opt([{'%anno',_}=I|Is]) -> - [I|opt(Is)]; -opt([]) -> []. - -%% opt_moves([Dest], [Instruction]) -> {[Dest],[Instruction]} -%% For each Dest, does the optimization described in opt_move/2. - -opt_moves([], Is0) -> {[],Is0}; -opt_moves([D0]=Ds, Is0) -> - case opt_move(D0, Is0) of - not_possible -> {Ds,Is0}; - {D1,Is} -> {[D1],Is} - end. - -%% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible -%% If there is a {move,Dest,FinalDest} instruction -%% in the instruction stream, remove the move instruction -%% and let FinalDest be the destination. - -opt_move(Dest, Is) -> - opt_move_1(Dest, Is, []). - -opt_move_1(R, [{set,[D],[R],move}|Is0], Acc) -> - %% Provided that the source register is killed by instructions - %% that follow, the optimization is safe. - case eliminate_use_of_from_reg(Is0, R, D) of - {yes,Is} -> opt_move_rev(D, Acc, Is); - no -> not_possible - end; -opt_move_1(_R, [{set,_,_,{alloc,_,_}}|_], _) -> - %% The optimization is either not possible or not safe. - %% - %% If R is an X register killed by allocation, the optimization is - %% not safe. On the other hand, if the X register is killed, there - %% will not follow a 'move' instruction with this X register as - %% the source. - %% - %% If R is a Y register, the optimization is still not safe - %% because the new target register is an X register that cannot - %% safely pass the alloc instruction. - not_possible; -opt_move_1(R, [{set,_,_,_}=I|Is], Acc) -> - %% If the source register is either killed or used by this - %% instruction, the optimimization is not possible. - case is_killed_or_used(R, I) of - true -> not_possible; - false -> opt_move_1(R, Is, [I|Acc]) - end; -opt_move_1(_, _, _) -> - not_possible. - -%% opt_tuple_element([Instruction]) -> [Instruction] -%% If possible, move get_tuple_element instructions forward -%% in the instruction stream to a move instruction, eliminating -%% the move instruction. Example: -%% -%% get_tuple_element Tuple Pos Dst1 -%% ... -%% move Dst1 Dst2 -%% -%% This code may be possible to rewrite to: -%% -%% %%(Moved get_tuple_element instruction) -%% ... -%% get_tuple_element Tuple Pos Dst2 -%% - -opt_tuple_element([{set,[D],[S],{get_tuple_element,_}}=I|Is0]) -> - case opt_tuple_element_1(Is0, I, {S,D}, []) of - no -> - [I|opt_tuple_element(Is0)]; - {yes,Is} -> - opt_tuple_element(Is) - end; -opt_tuple_element([I|Is]) -> - [I|opt_tuple_element(Is)]; -opt_tuple_element([]) -> []. - -opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) -> - no; -opt_tuple_element_1([{set,_,_,{try_catch,_,_}}|_], _, _, _) -> - no; -opt_tuple_element_1([{set,[D],[S],move}|Is0], I0, {_,S}, Acc) -> - case eliminate_use_of_from_reg(Is0, S, D) of - no -> - no; - {yes,Is1} -> - {set,[S],Ss,Op} = I0, - I = {set,[D],Ss,Op}, - case opt_move_rev(S, Acc, [I|Is1]) of - not_possible -> - %% Not safe because the move of the - %% get_tuple_element instruction would cause the - %% result of a previous instruction to be ignored. - no; - {_,Is} -> - {yes,Is} - end - end; -opt_tuple_element_1([{set,Ds,Ss,_}=I|Is], MovedI, {S,D}=Regs, Acc) -> - case member(S, Ds) orelse member(D, Ss) of - true -> - no; - false -> - opt_tuple_element_1(Is, MovedI, Regs, [I|Acc]) - end; -opt_tuple_element_1(_, _, _, _) -> no. - -%% Reverse the instructions, while checking that there are no -%% instructions that would interfere with using the new destination -%% register (D). - -opt_move_rev(D, [I|Is], Acc) -> - case is_killed_or_used(D, I) of - true -> not_possible; - false -> opt_move_rev(D, Is, [I|Acc]) - end; -opt_move_rev(D, [], Acc) -> {D,Acc}. - -%% is_killed_or_used(Register, {set,_,_,_}) -> bool() -%% Test whether the register is used by the instruction. - -is_killed_or_used(R, {set,Ss,Ds,_}) -> - member(R, Ds) orelse member(R, Ss). - -%% eliminate_use_of_from_reg([Instruction], FromRegister, ToRegister, Acc) -> -%% {yes,Is} | no -%% Eliminate any use of FromRegister in the instruction sequence -%% by replacing uses of FromRegister with ToRegister. If FromRegister -%% is referenced by an allocation instruction, return 'no' to indicate -%% that FromRegister is still used and that the optimization is not -%% possible. - -eliminate_use_of_from_reg(Is, From, To) -> - try - eliminate_use_of_from_reg(Is, From, To, []) - catch - throw:not_possible -> - no - end. - -eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) -> - if - X < Live -> - no; - true -> - {yes,reverse(Acc, Is0)} - end; -eliminate_use_of_from_reg([{set,Ds,Ss0,Op}=I0|Is], From, To, Acc) -> - ensure_safe_tuple(I0, To), - I = case member(From, Ss0) of - true -> - Ss = [case S of - From -> To; - _ -> S - end || S <- Ss0], - {set,Ds,Ss,Op}; - false -> - I0 - end, - case member(From, Ds) of - true -> - {yes,reverse(Acc, [I|Is])}; - false -> - case member(To, Ds) of - true -> - case beam_utils:is_killed_block(From, Is) of - true -> - {yes,reverse(Acc, [I|Is])}; - false -> - no - end; - false -> - eliminate_use_of_from_reg(Is, From, To, [I|Acc]) - end - end; -eliminate_use_of_from_reg([I]=Is, From, _To, Acc) -> - case beam_utils:is_killed_block(From, [I]) of - true -> - {yes,reverse(Acc, Is)}; - false -> - no - end. - -ensure_safe_tuple({set,[To],[],{put_tuple,_}}, To) -> - throw(not_possible); -ensure_safe_tuple(_, _) -> ok. - -%% opt_allocs(Instructions) -> Instructions. Optimize allocate -%% instructions inside blocks. If safe, replace an allocate_zero -%% instruction with the slightly cheaper allocate instruction. - -opt_allocs(Is) -> - D = beam_utils:index_labels(Is), - opt_allocs_1(Is, D). - -opt_allocs_1([{block,Bl0}|Is], D) -> - Bl = opt_alloc(Bl0, {D,Is}), - [{block,Bl}|opt_allocs_1(Is, D)]; -opt_allocs_1([I|Is], D) -> - [I|opt_allocs_1(Is, D)]; -opt_allocs_1([], _) -> []. - -%% opt_alloc(Instructions) -> Instructions' -%% Optimises all allocate instructions. - -opt_alloc([{set,[],[],{alloc,Live0,Info0}}, - {set,[],[],{alloc,Live,Info}}|Is], D) -> - Live = Live0, %Assertion. - Alloc = combine_alloc(Info0, Info), - I = {set,[],[],{alloc,Live,Alloc}}, - opt_alloc([I|Is], D); -opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is], D) -> - [{set,[],[],opt_alloc(Is, D, Ns, Nh, R)}|Is]; -opt_alloc([I|Is], D) -> [I|opt_alloc(Is, D)]; -opt_alloc([], _) -> []. - -combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> - {zero,Ns,beam_utils:combine_heap_needs(Nh1, Nh2),Init}. - -%% opt_alloc(Instructions, FrameSize, HeapNeed, LivingRegs) -> [Instr] -%% Generates the optimal sequence of instructions for -%% allocating and initalizing the stack frame and needed heap. - -opt_alloc(_Is, _D, nostack, Nh, LivingRegs) -> - {alloc,LivingRegs,{nozero,nostack,Nh,[]}}; -opt_alloc(Bl, {D,OuterIs}, Ns, Nh, LivingRegs) -> - Is = [{block,Bl}|OuterIs], - InitRegs = init_yregs(Ns, Is, D), - case count_ones(InitRegs) of - N when N*2 > Ns -> - {alloc,LivingRegs,{nozero,Ns,Nh,gen_init(Ns, InitRegs)}}; - _ -> - {alloc,LivingRegs,{zero,Ns,Nh,[]}} - end. - -gen_init(Fs, Regs) -> gen_init(Fs, Regs, 0, []). - -gen_init(SameFs, _Regs, SameFs, Acc) -> reverse(Acc); -gen_init(Fs, Regs, Y, Acc) when Regs band 1 =:= 0 -> - gen_init(Fs, Regs bsr 1, Y+1, [{init,{y,Y}}|Acc]); -gen_init(Fs, Regs, Y, Acc) -> - gen_init(Fs, Regs bsr 1, Y+1, Acc). - -init_yregs(Y, Is, D) when Y >= 0 -> - case beam_utils:is_killed({y,Y}, Is, D) of - true -> - (1 bsl Y) bor init_yregs(Y-1, Is, D); - false -> - init_yregs(Y-1, Is, D) - end; -init_yregs(_, _, _) -> 0. - -count_ones(Bits) -> count_ones(Bits, 0). -count_ones(0, Acc) -> Acc; -count_ones(Bits, Acc) -> - count_ones(Bits bsr 1, Acc + (Bits band 1)). - -%% Calculate the new number of live registers when we move an allocate -%% instruction upwards, passing a 'set' instruction. - -alloc_live_regs({set,Ds,Ss,_}, Is, Regs0) -> - Rset = x_live(Ss, x_dead(Ds, (1 bsl Regs0)-1)), - Live = live_regs(0, Rset), - case ensure_contiguous(Rset, Live) of - not_possible -> - %% Liveness information (looking forward in the - %% instruction stream) can't prove that moving this - %% allocation instruction is safe. Now use the annotation - %% of defined registers at the beginning of the current - %% block to see whether moving would be safe. - Def0 = defined_regs(Is, 0), - Def = Def0 band ((1 bsl Live) - 1), - ensure_contiguous(Rset bor Def, Live); - Live -> - %% Safe based on liveness information. - Live - end. - -live_regs(N, 0) -> - N; -live_regs(N, Regs) -> - live_regs(N+1, Regs bsr 1). - -ensure_contiguous(Regs, Live) -> - case (1 bsl Live) - 1 of - Regs -> Live; - _ -> not_possible - end. - -x_dead([{x,N}|Rs], Regs) -> x_dead(Rs, Regs band (bnot (1 bsl N))); -x_dead([_|Rs], Regs) -> x_dead(Rs, Regs); -x_dead([], Regs) -> Regs. - -x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); -x_live([_|Rs], Regs) -> x_live(Rs, Regs); -x_live([], Regs) -> Regs. - -%% defined_regs(ReversedInstructions) -> RegBitmap. -%% Given a reversed instruction stream, determine the -%% the registers that are defined. - -defined_regs([{'%anno',{def,Def}}|_], Regs) -> - Def bor Regs; -defined_regs([{set,Ds,_,{alloc,Live,_}}|_], Regs) -> - x_live(Ds, Regs bor ((1 bsl Live) - 1)); -defined_regs([{set,Ds,_,_}|Is], Regs) -> - defined_regs(Is, x_live(Ds, Regs)). - -%%% -%%% Do local common sub expression elimination (CSE) in each block. -%%% - -local_cse([{block,Bl0}|Is]) -> - Bl = cse_block(Bl0, orddict:new(), []), - [{block,Bl}|local_cse(Is)]; -local_cse([I|Is]) -> - [I|local_cse(Is)]; -local_cse([]) -> []. - -cse_block([I|Is], Es0, Acc0) -> - Es1 = cse_clear(I, Es0), - case cse_expr(I) of - none -> - %% Instruction is not suitable for CSE. - cse_block(Is, Es1, [I|Acc0]); - {ok,D,Expr} -> - %% Suitable instruction. First update the dictionary of - %% suitable expressions for the next iteration. - Es = cse_add(D, Expr, Es1), - - %% Search for a previous identical expression. - case cse_find(Expr, Es0) of - error -> - %% Nothing found - cse_block(Is, Es, [I|Acc0]); - Src -> - %% Use the previously calculated result. - %% Also eliminate any line instruction. - Move = {set,[D],[Src],move}, - case Acc0 of - [{set,_,_,{line,_}}|Acc] -> - cse_block(Is, Es, [Move|Acc]); - [_|_] -> - cse_block(Is, Es, [Move|Acc0]) - end - end - end; -cse_block([], _, Acc) -> - reverse(Acc). - -%% cse_find(Expr, Expressions) -> error | Register. -%% Find a previously evaluated expression whose result can be reused, -%% or return 'error' if no such expression is found. - -cse_find(Expr, Es) -> - case orddict:find(Expr, Es) of - {ok,{Src,_}} -> Src; - error -> error - end. - -cse_expr({set,[D],Ss,{bif,N,_}}) -> - case D of - {fr,_} -> - %% There are too many things that can go wrong. - none; - _ -> - {ok,D,{{bif,N},Ss}} - end; -cse_expr({set,[D],Ss,{alloc,_,{gc_bif,N,_}}}) -> - {ok,D,{{gc_bif,N},Ss}}; -cse_expr({set,[D],Ss,put_list}) -> - {ok,D,{put_list,Ss}}; -cse_expr(_) -> none. - -%% cse_clear(Instr, Expressions0) -> Expressions. -%% Remove all previous expressions that will become -%% invalid when this instruction is executed. Basically, -%% an expression is no longer safe to reuse when the -%% register it has been stored to has been modified, killed, -%% or if any of the source operands have changed. - -cse_clear({set,Ds,_,{alloc,Live,_}}, Es) -> - cse_clear_1(Es, Live, Ds); -cse_clear({set,Ds,_,_}, Es) -> - cse_clear_1(Es, all, Ds). - -cse_clear_1(Es, Live, Ds0) -> - Ds = ordsets:from_list(Ds0), - [E || E <- Es, cse_is_safe(E, Live, Ds)]. - -cse_is_safe({_,{Dst,Interfering}}, Live, Ds) -> - ordsets:is_disjoint(Interfering, Ds) andalso - case Dst of - {x,X} -> - X < Live; - _ -> - true - end. - -%% cse_add(Dest, Expr, Expressions0) -> Expressions. -%% Provided that it is safe, add a new expression to the dictionary -%% of already evaluated expressions. - -cse_add(D, {_,Ss}=Expr, Es) -> - case member(D, Ss) of - false -> - Interfering = ordsets:from_list([D|Ss]), - orddict:store(Expr, {D,Interfering}, Es); - true -> - %% Unsafe because the instruction overwrites one of - %% source operands. - Es - end. diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl index 5f1b9ed488..15d8d687fc 100644 --- a/lib/compiler/src/beam_bs.erl +++ b/lib/compiler/src/beam_bs.erl @@ -17,26 +17,24 @@ %% %% %CopyrightEnd% %% -%% Purpose : Partitions assembly instructions into basic blocks and -%% optimizes them. +%% Purpose: Peephole optimization of binary syntax instructions. -module(beam_bs). -export([module/2]). --import(lists, [mapfoldl/3,reverse/1]). +-import(lists, [reverse/1]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. -module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> - {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), +module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> + Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -function({function,Name,Arity,CLabel,Is0}, Lc0) -> +function({function,Name,Arity,CLabel,Is0}) -> try - Is1 = bs_put_opt(Is0), - {Is,Lc} = bsm_opt(Is1, Lc0), - {{function,Name,Arity,CLabel,Is},Lc} + Is = bs_opt(Is0), + {function,Name,Arity,CLabel,Is} catch Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), @@ -44,16 +42,25 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> end. %%% -%%% Evaluation of constant bit fields. +%%% Evaluate construction of constant bit fields. +%%% Combine bs_skip_bits2 and bs_test_tail2 instructions. %%% -bs_put_opt([{bs_put,_,_,_}=I|Is0]) -> +bs_opt([{bs_put,_,_,_}=I|Is0]) -> {BsPuts0,Is} = collect_bs_puts(Is0, [I]), BsPuts = opt_bs_puts(BsPuts0), - BsPuts ++ bs_put_opt(Is); -bs_put_opt([I|Is]) -> - [I|bs_put_opt(Is)]; -bs_put_opt([]) -> []. + BsPuts ++ bs_opt(Is); +bs_opt([{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}, + {test,bs_test_tail2,F,[Ctx,Bits]}|Is]) -> + [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|bs_opt(Is)]; +bs_opt([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,Flags]}, + {test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,_]}|Is]) -> + I = {test,bs_skip_bits2,F, + [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}, + bs_opt([I|Is]); +bs_opt([I|Is]) -> + [I|bs_opt(Is)]; +bs_opt([]) -> []. collect_bs_puts([{bs_put,_,_,_}=I|Is], Acc) -> collect_bs_puts(Is, [I|Acc]); @@ -174,107 +181,3 @@ bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> [{integer,ByteSz},{integer,N band Mask}]}, bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); bs_split_int_1(_, _, _, _, Acc) -> Acc. - -%%% -%%% Optimization of bit syntax matching: get rid -%%% of redundant bs_restore2/2 instructions across select_val -%%% instructions, as well as a few other simple peep-hole -%%% optimizations. -%%% - -bsm_opt(Is0, Lc0) -> - {Is1,D0,Lc} = bsm_scan(Is0, [], Lc0, []), - Is2 = case D0 of - [] -> - %% No bit syntax matching in this function. - Is1; - [_|_] -> - %% Optimize the bit syntax matching. - D = gb_trees:from_orddict(orddict:from_list(D0)), - bsm_reroute(Is1, D, none, []) - end, - Is = beam_clean:bs_clean_saves(Is2), - {bsm_opt_2(Is, []),Lc}. - -bsm_scan([{label,L}=Lbl,{bs_restore2,_,Save}=R|Is], D0, Lc, Acc0) -> - D = [{{L,Save},Lc}|D0], - Acc = [{label,Lc},R,Lbl|Acc0], - bsm_scan(Is, D, Lc+1, Acc); -bsm_scan([I|Is], D, Lc, Acc) -> - bsm_scan(Is, D, Lc, [I|Acc]); -bsm_scan([], D, Lc, Acc) -> - {reverse(Acc),D,Lc}. - -bsm_reroute([{bs_save2,Reg,Save}=I|Is], D, _, Acc) -> - bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); -bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) -> - bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); -bsm_reroute([{label,_}=I|Is], D, S, Acc) -> - bsm_reroute(Is, D, S, [I|Acc]); -bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) -> - [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D), - Acc = [{select,select_val,Reg,F,Lbls}|Acc0], - bsm_reroute(Is, D, S, Acc); -bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) -> - F = bsm_subst_label(F0, Save, D), - Acc = [{test,TestOp,F,TestArgs}|Acc0], - case bsm_not_bs_test(I) of - true -> - %% The test instruction will not update the bit offset for - %% the binary being matched. Therefore the save position - %% can be kept. - bsm_reroute(Is, D, S, Acc); - false -> - %% The test instruction might update the bit offset. Kill - %% our remembered Save position. - bsm_reroute(Is, D, none, Acc) - end; -bsm_reroute([{test,TestOp,F0,Live,TestArgs,Dst}|Is], D, {_,Save}, Acc0) -> - F = bsm_subst_label(F0, Save, D), - Acc = [{test,TestOp,F,Live,TestArgs,Dst}|Acc0], - %% The test instruction will update the bit offset. Kill our - %% remembered Save position. - bsm_reroute(Is, D, none, Acc); -bsm_reroute([{block,[{set,[],[],{alloc,_,_}}]}=Bl, - {bs_context_to_binary,_}=I|Is], D, S, Acc) -> - %% To help further bit syntax optimizations. - bsm_reroute([I,Bl|Is], D, S, Acc); -bsm_reroute([I|Is], D, _, Acc) -> - bsm_reroute(Is, D, none, [I|Acc]); -bsm_reroute([], _, _, Acc) -> reverse(Acc). - -bsm_opt_2([{test,bs_test_tail2,F,[Ctx,Bits]}|Is], - [{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}|Acc]) -> - bsm_opt_2(Is, [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|Acc]); -bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is], - [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) -> - bsm_opt_2(Is, [{test,bs_skip_bits2,F, - [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]); -bsm_opt_2([I|Is], Acc) -> - bsm_opt_2(Is, [I|Acc]); -bsm_opt_2([], Acc) -> reverse(Acc). - -%% bsm_not_bs_test({test,Name,_,Operands}) -> true|false. -%% Test whether is the test is a "safe", i.e. does not move the -%% bit offset for a binary. -%% -%% 'true' means that the test is safe, 'false' that we don't know or -%% that the test moves the offset (e.g. bs_get_integer2). - -bsm_not_bs_test({test,bs_test_tail2,_,[_,_]}) -> true; -bsm_not_bs_test(Test) -> beam_utils:is_pure_test(Test). - -bsm_subst_labels(Fs, Save, D) -> - bsm_subst_labels_1(Fs, Save, D, []). - -bsm_subst_labels_1([F|Fs], Save, D, Acc) -> - bsm_subst_labels_1(Fs, Save, D, [bsm_subst_label(F, Save, D)|Acc]); -bsm_subst_labels_1([], _, _, Acc) -> - reverse(Acc). - -bsm_subst_label({f,Lbl0}=F, Save, D) -> - case gb_trees:lookup({Lbl0,Save}, D) of - {value,Lbl} -> {f,Lbl}; - none -> F - end; -bsm_subst_label(Other, _, _) -> Other. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 1c8e0e9854..abc6e96c85 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -310,7 +310,18 @@ btb_reaches_match_2([{test,bs_start_match2,{f,F},Live,[Bin,_],Ctx}|Is], end; btb_reaches_match_2([{test,_,{f,F},Ss}=I|Is], Regs, D0) -> btb_ensure_not_used(Ss, I, Regs), - D = btb_follow_branch(F, Regs, D0), + D1 = btb_follow_branch(F, Regs, D0), + D = case Is of + [{bs_context_to_binary,_}|_] -> + %% bs_context_to_binary following a test instruction + %% probably needs the current position to be saved as + %% the new start position, but we can't be sure. + %% Therefore, conservatively disable the optimization + %% (instead of forcing a saving of the position). + D1#btb{must_save=true,must_not_save=true}; + _ -> + D1 + end, btb_reaches_match_1(Is, Regs, D); btb_reaches_match_2([{test,_,{f,F},_,Ss,_}=I|Is], Regs, D0) -> btb_ensure_not_used(Ss, I, Regs), diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 207f1c4deb..f5f0ac2218 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -22,9 +22,8 @@ -module(beam_clean). -export([module/2]). --export([bs_clean_saves/1]). -export([clean_labels/1]). --import(lists, [foldl/3,reverse/1]). +-import(lists, [foldl/3]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -37,19 +36,9 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) -> Used = find_all_used(WorkList, All, sets:from_list(WorkList)), Fs1 = remove_unused(Order, Used, All), {Fs2,Lc} = clean_labels(Fs1), - Fs3 = bs_fix(Fs2), - Fs = maybe_remove_lines(Fs3, Opts), + Fs = maybe_remove_lines(Fs2, Opts), {ok,{Mod,Exp,Attr,Fs,Lc}}. -%% Remove all bs_save2/2 instructions not referenced by a bs_restore2/2. - --spec bs_clean_saves([beam_utils:instruction()]) -> - [beam_utils:instruction()]. - -bs_clean_saves(Is) -> - Needed = bs_restores(Is, []), - bs_clean_saves_1(Is, gb_sets:from_list(Needed), []). - %% Determine the rootset, i.e. exported functions and %% the on_load function (if any). @@ -97,12 +86,8 @@ add_to_work_list(F, {Fs,Used}=Sets) -> %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. -%%% This cleanup will slightly reduce file size and slightly speed up loading. -%%% -%%% We also expand is_record/3 to a sequence of instructions. It is done -%%% here merely because this module will always be called even if optimization -%%% is turned off. We don't want to do the expansion in beam_asm because we -%%% want to see the expanded code in a .S file. +%%% This cleanup will slightly reduce file size and slightly speed up +%%% loading. %%% -type label() :: beam_asm:label(). @@ -127,45 +112,6 @@ function_renumber([{function,Name,Arity,_Entry,Asm0}|Fs], St0, Acc) -> function_renumber(Fs, St, [{function,Name,Arity,St#st.entry,Asm}|Acc]); function_renumber([], St, Acc) -> {Acc,St}. -renumber_labels([{bif,is_record,{f,_}, - [Term,{atom,Tag}=TagAtom,{integer,Arity}],Dst}|Is0], Acc, St) -> - ContLabel = 900000000+2*St#st.lc, - FailLabel = ContLabel+1, - Fail = {f,FailLabel}, - Tmp = Dst, - Is = case is_record_tuple(Term, Tag, Arity) of - yes -> - [{move,{atom,true},Dst}|Is0]; - no -> - [{move,{atom,false},Dst}|Is0]; - maybe -> - [{test,is_tuple,Fail,[Term]}, - {test,test_arity,Fail,[Term,Arity]}, - {get_tuple_element,Term,0,Tmp}, - {test,is_eq_exact,Fail,[Tmp,TagAtom]}, - {move,{atom,true},Dst}, - {jump,{f,ContLabel}}, - {label,FailLabel}, - {move,{atom,false},Dst}, - {jump,{f,ContLabel}}, %Improves optimization by beam_dead. - {label,ContLabel}|Is0] - end, - renumber_labels(Is, Acc, St); -renumber_labels([{test,is_record,{f,_}=Fail, - [Term,{atom,Tag}=TagAtom,{integer,Arity}]}|Is0], Acc, St) -> - Tmp = {x,1022}, - Is = case is_record_tuple(Term, Tag, Arity) of - yes -> - Is0; - no -> - [{jump,Fail}|Is0]; - maybe -> - [{test,is_tuple,Fail,[Term]}, - {test,test_arity,Fail,[Term,Arity]}, - {get_tuple_element,Term,0,Tmp}, - {test,is_eq_exact,Fail,[Tmp,TagAtom]}|Is0] - end, - renumber_labels(Is, Acc, St); renumber_labels([{label,Old}|Is], [{label,New}|_]=Acc, #st{lmap=D0}=St) -> D = [{Old,New}|D0], renumber_labels(Is, Acc, St#st{lmap=D}); @@ -179,12 +125,6 @@ renumber_labels([I|Is], Acc, St0) -> renumber_labels(Is, [I|Acc], St0); renumber_labels([], Acc, St) -> {Acc,St}. -is_record_tuple({x,_}, _, _) -> maybe; -is_record_tuple({y,_}, _, _) -> maybe; -is_record_tuple({literal,Tuple}, Tag, Arity) - when element(1, Tuple) =:= Tag, tuple_size(Tuple) =:= Arity -> yes; -is_record_tuple(_, _, _) -> no. - function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> Asm = try Fb = fun(Old) -> throw({error,{undefined_label,Old}}) end, @@ -199,100 +139,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace([], _, Acc) -> Acc. %%% -%%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for -%%% new bit syntax matching (introduced in R11B). -%%% -%%% Pass 1: Scan the code, looking for bs_restore2/2 instructions. -%%% -%%% Pass 2: Update bs_save2/2 and bs_restore/2 instructions. Remove -%%% any bs_save2/2 instruction whose save position are never referenced -%%% by any bs_restore2/2 instruction. -%%% -%%% Note this module can be invoked several times, so we must be careful -%%% not to touch instructions that have already been fixed up. -%%% - -bs_fix(Fs) -> - bs_fix(Fs, []). - -bs_fix([{function,Name,Arity,Entry,Asm0}|Fs], Acc) -> - Asm = bs_function(Asm0), - bs_fix(Fs, [{function,Name,Arity,Entry,Asm}|Acc]); -bs_fix([], Acc) -> reverse(Acc). - -bs_function(Is) -> - Dict0 = bs_restores(Is, []), - S0 = sofs:relation(Dict0, [{context,save_point}]), - S1 = sofs:relation_to_family(S0), - S = sofs:to_external(S1), - Dict = make_save_point_dict(S, []), - bs_replace(Is, Dict, []). - -make_save_point_dict([{Ctx,Pts}|T], Acc0) -> - Acc = make_save_point_dict_1(Pts, Ctx, 0, Acc0), - make_save_point_dict(T, Acc); -make_save_point_dict([], Acc) -> - gb_trees:from_orddict(ordsets:from_list(Acc)). - -make_save_point_dict_1([H|T], Ctx, I, Acc) -> - make_save_point_dict_1(T, Ctx, I+1, [{{Ctx,H},I}|Acc]); -make_save_point_dict_1([], Ctx, I, Acc) -> - [{Ctx,I}|Acc]. - -%% Pass 1. -bs_restores([{bs_restore2,_,{Same,Same}}|Is], Dict) -> - %% This save point is special. No explicit save is needed. - bs_restores(Is, Dict); -bs_restores([{bs_restore2,_,{atom,start}}|Is], Dict) -> - %% This instruction can occur if "compilation" - %% started from a .S file. - bs_restores(Is, Dict); -bs_restores([{bs_restore2,_,{_,_}=SavePoint}|Is], Dict) -> - bs_restores(Is, [SavePoint|Dict]); -bs_restores([_|Is], Dict) -> - bs_restores(Is, Dict); -bs_restores([], Dict) -> Dict. - -%% Pass 2. -bs_replace([{test,bs_start_match2,F,Live,[Src,{context,Ctx}],CtxR}|T], Dict, Acc) -> - Slots = case gb_trees:lookup(Ctx, Dict) of - {value,Slots0} -> Slots0; - none -> 0 - end, - I = {test,bs_start_match2,F,Live,[Src,Slots],CtxR}, - bs_replace(T, Dict, [I|Acc]); -bs_replace([{bs_save2,CtxR,{_,_}=SavePoint}|T], Dict, Acc) -> - case gb_trees:lookup(SavePoint, Dict) of - {value,N} -> - bs_replace(T, Dict, [{bs_save2,CtxR,N}|Acc]); - none -> - bs_replace(T, Dict, Acc) - end; -bs_replace([{bs_restore2,_,{atom,start}}=I|T], Dict, Acc) -> - %% This instruction can occur if "compilation" - %% started from a .S file. - bs_replace(T, Dict, [I|Acc]); -bs_replace([{bs_restore2,CtxR,{Same,Same}}|T], Dict, Acc) -> - %% This save point refers to the point in the binary where the match - %% started. It has a special name. - bs_replace(T, Dict, [{bs_restore2,CtxR,{atom,start}}|Acc]); -bs_replace([{bs_restore2,CtxR,{_,_}=SavePoint}|T], Dict, Acc) -> - N = gb_trees:get(SavePoint, Dict), - bs_replace(T, Dict, [{bs_restore2,CtxR,N}|Acc]); -bs_replace([I|Is], Dict, Acc) -> - bs_replace(Is, Dict, [I|Acc]); -bs_replace([], _, Acc) -> reverse(Acc). - -bs_clean_saves_1([{bs_save2,_,{_,_}=SavePoint}=I|Is], Needed, Acc) -> - case gb_sets:is_member(SavePoint, Needed) of - false -> bs_clean_saves_1(Is, Needed, Acc); - true -> bs_clean_saves_1(Is, Needed, [I|Acc]) - end; -bs_clean_saves_1([I|Is], Needed, Acc) -> - bs_clean_saves_1(Is, Needed, [I|Acc]); -bs_clean_saves_1([], _, Acc) -> reverse(Acc). - -%%% %%% Remove line instructions if requested. %%% diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index efad082152..546f0461b9 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -85,11 +85,6 @@ move_move_into_block([], Acc) -> reverse(Acc). %%% %%% or in: %%% -%%% test is_nil SomeLabel Dst -%%% move nil Dst -%%% -%%% or in: -%%% %%% select_val Register FailLabel [... Literal => L1...] %%% . %%% . @@ -140,13 +135,8 @@ forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) -> forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> forward([I,{block,Bl}|Is], D, Lc, Acc); -forward([{test,is_nil,_,[Dst]}=I, - {block,[{set,[Dst],[nil],move}|Bl]}|Is], D, Lc, Acc) -> - forward([I,{block,Bl}|Is], D, Lc, Acc); forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) -> forward([I|Is], D, Lc, Acc); -forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) -> - forward([I|Is], D, Lc, Acc); forward([{test,_,_,_}=I|Is]=Is0, D, Lc, Acc) -> %% Help the second, backward pass to by inserting labels after %% relational operators so that they can be skipped if they are @@ -243,8 +233,7 @@ backward([{label,Lbl}=L|Is], D, Acc) -> backward(Is, beam_utils:index_label(Lbl, Acc, D), [L|Acc]); backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> List1 = shortcut_select_list(List0, Reg, D, []), - Fail1 = shortcut_label(Fail0, D), - Fail = shortcut_bs_test(Fail1, Is, D), + Fail = shortcut_label(Fail0, D), List = prune_redundant(List1, Fail), case List of [] -> @@ -314,9 +303,8 @@ backward([{test,bs_start_match2,F,Live,[Src,_]=Args,Ctxt}|Is], D, Acc0) -> backward(Is, D, [I|Acc0]) end; backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> - To1 = shortcut_bs_test(To0, Is, D), - To2 = shortcut_label(To1, D), - To3 = shortcut_rel_op(To2, Op, Ops0, D), + To1 = shortcut_label(To0, D), + To2 = shortcut_rel_op(To1, Op, Ops0, D), %% Try to shortcut a repeated test: %% @@ -324,58 +312,44 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> %% . . . ==> ... %% Fail1: test Op {f,Fail2} Operands Fail1: test Op {f,Fail2} Operands %% - To = case beam_utils:code_at(To3, D) of - [{test,Op,{f,To4},Ops}|_] -> + To = case beam_utils:code_at(To2, D) of + [{test,Op,{f,To3},Ops}|_] -> case equal_ops(Ops0, Ops) of - true -> To4; - false -> To3 + true -> To3; + false -> To2 end; _Code -> - To3 + To2 end, I = case Op of is_eq_exact -> combine_eqs(To, Ops0, D, Acc); _ -> {test,Op,{f,To},Ops0} end, - case {I,Acc} of - {{test,is_atom,Fail,Ops0},[{test,is_boolean,Fail,Ops0}|_]} -> - %% An is_atom test before an is_boolean test (with the - %% same failure label) is redundant. - backward(Is, D, Acc); - {{test,is_atom,Fail,[R]}, - [{test,is_eq_exact,Fail,[R,{atom,_}]}|_]} -> - %% An is_atom test before a comparison with an atom (with - %% the same failure label) is redundant. - backward(Is, D, Acc); - {{test,is_integer,Fail,[R]}, - [{test,is_eq_exact,Fail,[R,{integer,_}]}|_]} -> - %% An is_integer test before a comparison with an integer - %% (with the same failure label) is redundant. - backward(Is, D, Acc); - {{test,_,_,_},_} -> + case I of + {test,_,_,_} -> %% Still a test instruction. Done. backward(Is, D, [I|Acc]); - {_,_} -> + _ -> %% Rewritten to a select_val. Rescan. backward([I|Is], D, Acc) end; backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> - To1 = shortcut_bs_test(To0, Is, D), - To2 = shortcut_label(To1, D), + To1 = shortcut_label(To0, D), + %% Try to shortcut a repeated test: %% %% test Op {f,Fail1} _ Ops _ test Op {f,Fail2} _ Ops _ %% . . . ==> ... %% Fail1: test Op {f,Fail2} _ Ops _ Fail1: test Op {f,Fail2} _ Ops _ %% - To = case beam_utils:code_at(To2, D) of - [{test,Op,{f,To3},_,Ops,_}|_] -> + To = case beam_utils:code_at(To1, D) of + [{test,Op,{f,To2},_,Ops,_}|_] -> case equal_ops(Ops0, Ops) of - true -> To3; - false -> To2 + true -> To2; + false -> To1 end; _Code -> - To2 + To1 end, I = {test,Op,{f,To},Live,Ops0,Dst}, backward(Is, D, [I|Acc]); @@ -548,68 +522,6 @@ test_bs_literal_1(Ctxt, Is, D, Literal) -> false -> not_killed end. -%% shortcut_bs_test(TargetLabel, ReversedInstructions, D) -> TargetLabel' -%% Try to shortcut the failure label for bit syntax matching. - -shortcut_bs_test(To, Is, D) -> - shortcut_bs_test_1(beam_utils:code_at(To, D), Is, To, D). - -shortcut_bs_test_1([{bs_restore2,Reg,SavePoint}, - {label,_}, - {test,bs_test_tail2,{f,To},[_,TailBits]}|_], - PrevIs, To0, D) -> - case count_bits_matched(PrevIs, {Reg,SavePoint}, 0) of - Bits when Bits > TailBits -> - %% This instruction will fail. We know because a restore has been - %% done from the previous point SavePoint in the binary, and we - %% also know that the binary contains at least Bits bits from - %% SavePoint. - %% - %% Since we will skip a bs_restore2 if we shortcut to label To, - %% we must now make sure that code at To does not depend on - %% the position in the context in any way. - case shortcut_bs_pos_used(To, Reg, D) of - false -> To; - true -> To0 - end; - _Bits -> - To0 - end; -shortcut_bs_test_1([_|_], _, To, _) -> To. - -%% counts_bits_matched(ReversedInstructions, SavePoint, Bits) -> Bits' -%% Given a reversed instruction stream, determine the minimum number -%% of bits that will be matched by bit syntax instructions up to the -%% given save point. - -count_bits_matched([{test,bs_get_utf8,{f,_},_,_,_}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits+8); -count_bits_matched([{test,bs_get_utf16,{f,_},_,_,_}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits+16); -count_bits_matched([{test,bs_get_utf32,{f,_},_,_,_}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits+32); -count_bits_matched([{test,_,_,_,[_,Sz,U,{field_flags,_}],_}|Is], SavePoint, Bits) -> - case Sz of - {integer,N} -> count_bits_matched(Is, SavePoint, Bits+N*U); - _ -> count_bits_matched(Is, SavePoint, Bits) - end; -count_bits_matched([{test,bs_match_string,_,[_,Bs]}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits+bit_size(Bs)); -count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits); -count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> - %% The save point we are looking for - we are done. - Bits; -count_bits_matched([_|_], _, Bits) -> Bits. - -shortcut_bs_pos_used(To, Reg, D) -> - shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D). - -shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) -> - false; -shortcut_bs_pos_used_1(Is, Reg, D) -> - not beam_utils:is_killed(Reg, Is, D). - %% shortcut_bs_start_match(TargetLabel, Reg) -> TargetLabel %% A failing bs_start_match2 instruction means that the source (Reg) %% cannot be a binary. That means that it is safe to skip @@ -900,8 +812,6 @@ normalize_op({test,is_eq_exact,{f,Fail},Ops}) -> normalize_op_1('=:=', Ops, Fail); normalize_op({test,is_ne_exact,{f,Fail},Ops}) -> normalize_op_1('=/=', Ops, Fail); -normalize_op({test,is_nil,{f,Fail},[R]}) -> - normalize_op_1('=:=', [R,nil], Fail); normalize_op({test,Op,{f,Fail},[R]}) -> case erl_internal:new_type_test(Op, 1) of true -> {{Op,R},Fail}; diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 6cee9acae4..d0be39f520 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -373,6 +373,8 @@ disasm_instr(B, Bs, Atoms, Literals) -> disasm_map_inst(get_map_elements, Arity, Bs, Atoms, Literals); has_map_fields -> disasm_map_inst(has_map_fields, Arity, Bs, Atoms, Literals); + put_tuple2 -> + disasm_put_tuple2(Bs, Atoms, Literals); _ -> try decode_n_args(Arity, Bs, Atoms, Literals) of {Args, RestBs} -> @@ -413,6 +415,14 @@ disasm_map_inst(Inst, Arity, Bs0, Atoms, Literals) -> {List, RestBs} = decode_n_args(Len, Bs2, Atoms, Literals), {{Inst, Args ++ [{Z,U,List}]}, RestBs}. +disasm_put_tuple2(Bs, Atoms, Literals) -> + {X, Bs1} = decode_arg(Bs, Atoms, Literals), + {Z, Bs2} = decode_arg(Bs1, Atoms, Literals), + {U, Bs3} = decode_arg(Bs2, Atoms, Literals), + {u, Len} = U, + {List, RestBs} = decode_n_args(Len, Bs3, Atoms, Literals), + {{put_tuple2, [X,{Z,U,List}]}, RestBs}. + %%----------------------------------------------------------------------- %% decode_arg([Byte]) -> {Arg, [Byte]} %% @@ -1096,6 +1106,13 @@ resolve_inst({get_tl,[Src,Dst]},_,_,_) -> {get_tl,Src,Dst}; %% +%% OTP 22. +%% +resolve_inst({put_tuple2,[Dst,{{z,1},{u,_},List0}]},_,_,_) -> + List = resolve_args(List0), + {put_tuple2,Dst,{list,List}}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 05c0f4fbc7..98831d87a7 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -31,7 +31,7 @@ %%% erlang:error(function_clause, Args) => jump FuncInfoLabel %%% --import(lists, [reverse/1]). +-import(lists, [reverse/1,seq/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -113,14 +113,7 @@ dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> {yes,if_end,[]}; dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) -> translate_exception(Exc, {literal,Value}, Is, 0); -dig_out_block([{set,[{x,0}],[Tuple],move}, - {set,[],[Value],put}, - {set,[],[{atom,Exc}],put}, - {set,[Tuple],[],{put_tuple,2}}|Is]) -> - translate_exception(Exc, Value, Is, 3); -dig_out_block([{set,[],[Value],put}, - {set,[],[{atom,Exc}],put}, - {set,[{x,0}],[],{put_tuple,2}}|Is]) -> +dig_out_block([{set,[{x,0}],[{atom,Exc},Value],put_tuple2}|Is]) -> translate_exception(Exc, Value, Is, 3); dig_out_block(_) -> no. @@ -138,23 +131,46 @@ fix_block(Is, Words) -> reverse(fix_block_1(Is, Words)). fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) -> - Needed = Needed0 - Words, - true = Needed >= 0, %Assertion. - [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is]; + case Needed0 - Words of + 0 -> + Is; + Needed -> + true = Needed >= 0, %Assertion. + [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] + end; fix_block_1([I|Is], Words) -> [I|fix_block_1(Is, Words)]. dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> - case dig_out_fc(Bl, Live-1, nil) of - no -> - no; - yes -> - {yes,{function_clause,Live}} - end; + Regs = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Live-1)]), + dig_out_fc(Bl, Regs); dig_out_block_fc(_) -> no. -dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) -> - dig_out_fc(Is, Reg-1, Dst); -dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) -> - yes; -dig_out_fc(_, _, _) -> no. +dig_out_fc([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> + Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}}, + dig_out_fc(Is, Regs); +dig_out_fc([{set,[Dst],[Src],move}|Is], Regs0) -> + Regs = Regs0#{Dst=>get_reg(Src, Regs0)}, + dig_out_fc(Is, Regs); +dig_out_fc([{set,_,_,_}|_], _Regs) -> + %% Unknown instruction. It is not a function_clause error. + no; +dig_out_fc([], Regs) -> + case Regs of + #{{x,0}:={atom,function_clause},{x,1}:=Args} -> + dig_out_fc_1(Args, 0); + #{} -> + no + end. + +dig_out_fc_1({cons,{arg,I},T}, I) -> + dig_out_fc_1(T, I+1); +dig_out_fc_1(nil, I) -> + {yes,{function_clause,I}}; +dig_out_fc_1(_, _) -> no. + +get_reg(R, Regs) -> + case Regs of + #{R:=Val} -> Val; + #{} -> R + end. diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 20bd23a912..973d16a1bc 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -43,13 +43,15 @@ block([{block,Is0}|Is1], Acc) -> block(Is1, norm_block(Is0, Acc)); block([I|Is], Acc) -> block(Is, [I|Acc]); block([], Acc) -> reverse(Acc). -norm_block([{set,[],[],{alloc,R,Alloc}}|Is], Acc0) -> +norm_block([{set,[],[],{alloc,R,{_,nostack,_,_}=Alloc}}|Is], Acc0) -> case insert_alloc_in_bs_init(Acc0, Alloc) of impossible -> norm_block(Is, reverse(norm_allocate(Alloc, R), Acc0)); Acc -> norm_block(Is, Acc) end; +norm_block([{set,[],[],{alloc,R,Alloc}}|Is], Acc0) -> + norm_block(Is, reverse(norm_allocate(Alloc, R), Acc0)); norm_block([{set,[D1],[S],get_hd},{set,[D2],[S],get_tl}|Is], Acc) -> I = {get_list,S,D1,D2}, norm_block(Is, [I|Acc]); @@ -63,6 +65,7 @@ norm({set,[D],[S],move}) -> {move,S,D}; norm({set,[D],[S],fmove}) -> {fmove,S,D}; norm({set,[D],[S],fconv}) -> {fconv,S,D}; norm({set,[D],[S1,S2],put_list}) -> {put_list,S1,S2,D}; +norm({set,[D],Els,put_tuple2}) -> {put_tuple2,D,{list,Els}}; norm({set,[D],[],{put_tuple,A}}) -> {put_tuple,A,D}; norm({set,[],[S],put}) -> {put,S}; norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D}; diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 43084ad588..42b4cdaf4f 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -610,6 +610,12 @@ ulbl({put_map,Lbl,_Op,_Src,_Dst,_Live,_List}, Used) -> mark_used(Lbl, Used); ulbl({get_map_elements,Lbl,_Src,_List}, Used) -> mark_used(Lbl, Used); +ulbl({recv_mark,Lbl}, Used) -> + mark_used(Lbl, Used); +ulbl({recv_set,Lbl}, Used) -> + mark_used(Lbl, Used); +ulbl({fcheckerror,Lbl}, Used) -> + mark_used(Lbl, Used); ulbl(_, Used) -> Used. mark_used({f,0}, Used) -> Used; diff --git a/lib/compiler/src/beam_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl new file mode 100644 index 0000000000..c55a57ab32 --- /dev/null +++ b/lib/compiler/src/beam_kernel_to_ssa.erl @@ -0,0 +1,1330 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose: Convert the Kernel Erlang format to the SSA format. + +-module(beam_kernel_to_ssa). + +%% The main interface. +-export([module/2]). + +-import(lists, [append/1,duplicate/2,flatmap/2,foldl/3, + keysort/2,mapfoldl/3,map/2,member/2, + reverse/1,reverse/2,sort/1]). + +-include("v3_kernel.hrl"). +-include("beam_ssa.hrl"). + +-type label() :: beam_ssa:label(). + +%% Main codegen structure. +-record(cg, {lcount=1 :: label(), %Label counter + bfail=1 :: label(), + catch_label=none :: 'none' | label(), + vars=#{} :: map(), %Defined variables. + break=0 :: label(), %Break label + recv=0 :: label(), %Receive label + ultimate_failure=0 :: label() %Label for ultimate match failure. + }). + +%% Internal records. +-record(cg_break, {args :: [beam_ssa:value()], + phi :: label() + }). +-record(cg_phi, {vars :: [beam_ssa:b_var()] + }). +-record(cg_unreachable, {}). + +-spec module(#k_mdef{}, [compile:option()]) -> {'ok',#b_module{}}. + +module(#k_mdef{name=Mod,exports=Es,attributes=Attr,body=Forms}, _Opts) -> + Body = functions(Forms, Mod), + Module = #b_module{name=Mod,exports=Es,attributes=Attr,body=Body}, + {ok,Module}. + +functions(Forms, Mod) -> + [function(F, Mod) || F <- Forms]. + +function(#k_fdef{anno=Anno0,func=Name,arity=Arity, + vars=As0,body=Kb}, Mod) -> + try + #k_match{} = Kb, %Assertion. + + %% Generate the SSA form immediate format. + St0 = #cg{}, + {As,St1} = new_ssa_vars(As0, St0), + {Asm,St} = cg_fun(Kb, St1), + Anno1 = line_anno(Anno0), + Anno = Anno1#{func_info=>{Mod,Name,Arity}}, + #b_function{anno=Anno,args=As,bs=Asm,cnt=St#cg.lcount} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%% cg_fun([Lkexpr], [HeadVar], State) -> {[Ainstr],State} + +cg_fun(Ke, St0) -> + {UltimateFail,FailIs,St1} = make_failure(badarg, St0), + St2 = St1#cg{bfail=UltimateFail,ultimate_failure=UltimateFail}, + {B,St} = cg(Ke, St2), + Asm = [{label,0}|B++FailIs], + finalize(Asm, St). + +make_failure(Reason, St0) -> + {Lbl,St1} = new_label(St0), + {Dst,St} = new_ssa_var('@ssa_ret', St1), + Is = [{label,Lbl}, + #b_set{op=call,dst=Dst, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}, + arity=1}, + #b_literal{val=Reason}]}, + #b_ret{arg=Dst}], + {Lbl,Is,St}. + +%% cg(Lkexpr, State) -> {[Ainstr],State}. +%% Generate code for a kexpr. + +cg(#k_match{body=M,ret=Rs}, St) -> + do_match_cg(M, Rs, St); +cg(#k_guard_match{body=M,ret=Rs}, St) -> + do_match_cg(M, Rs, St); +cg(#k_seq{arg=Arg,body=Body}, St0) -> + {ArgIs,St1} = cg(Arg, St0), + {BodyIs,St} = cg(Body, St1), + {ArgIs++BodyIs,St}; +cg(#k_call{anno=Le,op=Func,args=As,ret=Rs}, St) -> + call_cg(Func, As, Rs, Le, St); +cg(#k_enter{anno=Le,op=Func,args=As}, St) -> + enter_cg(Func, As, Le, St); +cg(#k_bif{anno=Le}=Bif, St) -> + bif_cg(Bif, Le, St); +cg(#k_try{arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th,ret=Rs}, St) -> + try_cg(Ta, Vs, Tb, Evs, Th, Rs, St); +cg(#k_try_enter{arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th}, St) -> + try_enter_cg(Ta, Vs, Tb, Evs, Th, St); +cg(#k_catch{body=Cb,ret=[R]}, St) -> + do_catch_cg(Cb, R, St); +cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs}, St) -> + recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, St); +cg(#k_receive_next{}, #cg{recv=Recv}=St) -> + Is = [#b_set{op=recv_next},make_uncond_branch(Recv)], + {Is,St}; +cg(#k_receive_accept{}, St) -> + Remove = #b_set{op=remove_message}, + {[Remove],St}; +cg(#k_put{anno=Le,arg=Con,ret=Var}, St) -> + put_cg(Var, Con, Le, St); +cg(#k_return{args=[Ret0]}, St) -> + Ret = ssa_arg(Ret0, St), + {[#b_ret{arg=Ret}],St}; +cg(#k_break{args=Bs}, #cg{break=Br}=St) -> + Args = ssa_args(Bs, St), + {[#cg_break{args=Args,phi=Br}],St}; +cg(#k_guard_break{args=Bs}, St) -> + cg(#k_break{args=Bs}, St). + +%% match_cg(Matc, [Ret], State) -> {[Ainstr],State}. +%% Generate code for a match. + +do_match_cg(M, Rs, St0) -> + {B,St1} = new_label(St0), + {Mis,St2} = match_cg(M, St1#cg.bfail, St1#cg{break=B}), + {BreakVars,St} = new_ssa_vars(Rs, St2), + {Mis ++ [{label,B},#cg_phi{vars=BreakVars}], + St#cg{bfail=St0#cg.bfail,break=St1#cg.break}}. + +%% match_cg(Match, Fail, State) -> {[Ainstr],State}. +%% Generate code for a match tree. + +match_cg(#k_alt{first=F,then=S}, Fail, St0) -> + {Tf,St1} = new_label(St0), + {Fis,St2} = match_cg(F, Tf, St1), + {Sis,St3} = match_cg(S, Fail, St2), + {Fis ++ [{label,Tf}] ++ Sis,St3}; +match_cg(#k_select{var=#k_var{}=V,types=Scs}, Fail, St) -> + match_fmf(fun (S, F, Sta) -> + select_cg(S, V, F, Fail, Sta) + end, Fail, St, Scs); +match_cg(#k_guard{clauses=Gcs}, Fail, St) -> + match_fmf(fun (G, F, Sta) -> + guard_clause_cg(G, F, Sta) + end, Fail, St, Gcs); +match_cg(Ke, _Fail, St0) -> + cg(Ke, St0). + +%% select_cg(Sclause, V, TypeFail, ValueFail, State) -> {Is,State}. +%% Selecting type and value needs two failure labels, TypeFail is the +%% label to jump to of the next type test when this type fails, and +%% ValueFail is the label when this type is correct but the value is +%% wrong. These are different as in the second case there is no need +%% to try the next type, it will always fail. + +select_cg(#k_type_clause{type=k_binary,values=[S]}, Var, Tf, Vf, St) -> + select_binary(S, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=k_bin_seg,values=Vs}, Var, Tf, _Vf, St) -> + select_bin_segs(Vs, Var, Tf, St); +select_cg(#k_type_clause{type=k_bin_int,values=Vs}, Var, Tf, _Vf, St) -> + select_bin_segs(Vs, Var, Tf, St); +select_cg(#k_type_clause{type=k_bin_end,values=[S]}, Var, Tf, _Vf, St) -> + select_bin_end(S, Var, Tf, St); +select_cg(#k_type_clause{type=k_map,values=Vs}, Var, Tf, Vf, St) -> + select_map(Vs, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=k_cons,values=[S]}, Var, Tf, Vf, St) -> + select_cons(S, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=k_nil,values=[S]}, Var, Tf, Vf, St) -> + select_nil(S, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=k_literal,values=Vs}, Var, Tf, Vf, St) -> + select_literal(Vs, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=Type,values=Scs}, Var, Tf, Vf, St0) -> + {Vis,St1} = + mapfoldl(fun (S, Sta) -> + {Val,Is,Stb} = select_val(S, Var, Vf, Sta), + {{Is,[Val]},Stb} + end, St0, Scs), + OptVls = combine(lists:sort(combine(Vis))), + {Vls,Sis,St2} = select_labels(OptVls, St1, [], []), + Arg = ssa_arg(Var, St2), + {Is,St} = select_val_cg(Type, Arg, Vls, Tf, Vf, Sis, St2), + {Is,St}. + +select_val_cg(k_tuple, Tuple, Vls, Tf, Vf, Sis, St0) -> + {Is0,St1} = make_cond_branch({bif,is_tuple}, [Tuple], Tf, St0), + {Arity,St2} = new_ssa_var('@ssa_arity', St1), + GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, + {Is,St} = select_val_cg(k_int, Arity, Vls, Vf, Vf, Sis, St2), + {Is0++[GetArity]++Is,St}; +select_val_cg(Type, R, Vls, Tf, Vf, Sis, St0) -> + {TypeIs,St1} = if + Tf =:= Vf -> + %% The type and value failure labels are the same; + %% we don't need a type test. + {[],St0}; + true -> + %% Different labels for type failure and + %% label failure; we need a type test. + Test = select_type_test(Type), + make_cond_branch(Test, [R], Tf, St0) + end, + case Vls of + [{Val,Succ}] -> + {Is,St} = make_cond({bif,'=:='}, [R,Val], Vf, Succ, St1), + {TypeIs++Is++Sis,St}; + [_|_] -> + {TypeIs++[#b_switch{arg=R,fail=Vf,list=Vls}|Sis],St1} + end. + +select_type_test(k_int) -> {bif,is_integer}; +select_type_test(k_atom) -> {bif,is_atom}; +select_type_test(k_float) -> {bif,is_float}. + +combine([{Is,Vs1},{Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]); +combine([V|Vis]) -> [V|combine(Vis)]; +combine([]) -> []. + +select_labels([{Is,Vs}|Vis], St0, Vls, Sis) -> + {Lbl,St1} = new_label(St0), + select_labels(Vis, St1, add_vls(Vs, Lbl, Vls), [[{label,Lbl}|Is]|Sis]); +select_labels([], St, Vls, Sis) -> + {Vls,append(Sis),St}. + +add_vls([V|Vs], Lbl, Acc) -> + add_vls(Vs, Lbl, [{#b_literal{val=V},Lbl}|Acc]); +add_vls([], _, Acc) -> Acc. + +select_literal(S, V, Tf, Vf, St) -> + Src = ssa_arg(V, St), + F = fun(ValClause, Fail, St0) -> + {Val,ValIs,St1} = select_val(ValClause, V, Vf, St0), + Args = [Src,#b_literal{val=Val}], + {Is,St2} = make_cond_branch({bif,'=:='}, Args, Fail, St1), + {Is++ValIs,St2} + end, + match_fmf(F, Tf, St, S). + +select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B}, + V, Tf, Vf, St0) -> + Es = [Hd,Tl], + {Eis,St1} = select_extract_cons(V, Es, St0), + {Bis,St2} = match_cg(B, Vf, St1), + Src = ssa_arg(V, St2), + {Is,St} = make_cond_branch(is_nonempty_list, [Src], Tf, St2), + {Is ++ Eis ++ Bis,St}. + +select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, St0) -> + {Bis,St1} = match_cg(B, Vf, St0), + Src = ssa_arg(V, St1), + {Is,St} = make_cond_branch({bif,'=:='}, [Src,#b_literal{val=[]}], Tf, St1), + {Is ++ Bis,St}. + +select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ctx0}},body=B}, + #k_var{anno=Anno0}=Src, Tf, Vf, St0) -> + Anno = #{reuse_for_context=>member(reuse_for_context, Anno0)}, + {Ctx,St1} = new_ssa_var(Ctx0, St0), + {Bis0,St2} = match_cg(B, Vf, St1), + {TestIs,St} = make_cond_branch(succeeded, [Ctx], Tf, St2), + Bis1 = [#b_set{anno=Anno,op=bs_start_match,dst=Ctx, + args=[ssa_arg(Src, St)]}] ++ TestIs ++ Bis0, + Bis = finish_bs_matching(Bis1), + {Bis,St}. + +finish_bs_matching([#b_set{op=bs_match, + args=[#b_literal{val=string},Ctx,#b_literal{val=BinList}]}=Set|Is]) + when is_list(BinList) -> + I = Set#b_set{args=[#b_literal{val=string},Ctx, + #b_literal{val=list_to_bitstring(BinList)}]}, + finish_bs_matching([I|Is]); +finish_bs_matching([I|Is]) -> + [I|finish_bs_matching(Is)]; +finish_bs_matching([]) -> []. + +make_cond(Cond, Args, Fail, Succ, St0) -> + {Bool,St} = new_ssa_var('@ssa_bool', St0), + Bif = #b_set{op=Cond,dst=Bool,args=Args}, + Br = #b_br{bool=Bool,succ=Succ,fail=Fail}, + {[Bif,Br],St}. + +make_cond_branch(Cond, Args, Fail, St0) -> + {Bool,St1} = new_ssa_var('@ssa_bool', St0), + {Succ,St} = new_label(St1), + Bif = #b_set{op=Cond,dst=Bool,args=Args}, + Br = #b_br{bool=Bool,succ=Succ,fail=Fail}, + {[Bif,Br,{label,Succ}],St}. + +make_uncond_branch(Fail) -> + #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}. + +%% Instructions for selection of binary segments. + +select_bin_segs(Scs, Ivar, Tf, St) -> + match_fmf(fun(S, Fail, Sta) -> + select_bin_seg(S, Ivar, Fail, Sta) + end, Tf, St, Scs). + +select_bin_seg(#k_val_clause{val=#k_bin_seg{size=Size,unit=U,type=T, + seg=Seg,flags=Fs,next=Next}, + body=B,anno=Anno}, + #k_var{}=Src, Fail, St0) -> + LineAnno = line_anno(Anno), + Ctx = get_context(Src, St0), + {Mis,St1} = select_extract_bin(Next, Size, U, T, Fs, Fail, + Ctx, LineAnno, St0), + {Extracted,St2} = new_ssa_var(Seg#k_var.name, St1), + {Bis,St} = bin_match_cg(Size, B, Fail, St2), + BsGet = #b_set{op=bs_extract,dst=Extracted,args=[ssa_arg(Next, St)]}, + Is = Mis ++ [BsGet] ++ Bis, + {Is,St}; +select_bin_seg(#k_val_clause{val=#k_bin_int{size=Sz,unit=U,flags=Fs, + val=Val,next=Next}, + body=B}, + #k_var{}=Src, Fail, St0) -> + Ctx = get_context(Src, St0), + {Mis,St1} = select_extract_int(Next, Val, Sz, U, Fs, Fail, + Ctx, St0), + {Bis,St} = match_cg(B, Fail, St1), + Is = case Mis ++ Bis of + [#b_set{op=bs_match,args=[#b_literal{val=string},OtherCtx1,Bin1]}, + #b_set{op=succeeded,dst=Bool1}, + #b_br{bool=Bool1,succ=Succ,fail=Fail}, + {label,Succ}, + #b_set{op=bs_match,dst=Dst,args=[#b_literal{val=string},_OtherCtx2,Bin2]}| + [#b_set{op=succeeded,dst=Bool2}, + #b_br{bool=Bool2,fail=Fail}|_]=Is0] -> + %% We used to do this optimization later, but it + %% turns out that in huge functions with many + %% string matching instructions, it's a huge win + %% to do the combination now. To avoid copying the + %% binary data again and again, we'll combine bitstrings + %% in a list and convert all of it to a bitstring later. + {#b_literal{val=B1},#b_literal{val=B2}} = {Bin1,Bin2}, + Bin = #b_literal{val=[B1,B2]}, + Set = #b_set{op=bs_match,dst=Dst,args=[#b_literal{val=string},OtherCtx1,Bin]}, + [Set|Is0]; + Is0 -> + Is0 + end, + {Is,St}. + +bin_match_cg(#k_atom{val=all}, B0, Fail, St) -> + #k_select{types=Types} = B0, + [#k_type_clause{type=k_bin_end,values=Values}] = Types, + [#k_val_clause{val=#k_bin_end{},body=B}] = Values, + match_cg(B, Fail, St); +bin_match_cg(_, B, Fail, St) -> + match_cg(B, Fail, St). + +get_context(#k_var{}=Var, St) -> + ssa_arg(Var, St). + +select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Src, Tf, St0) -> + Ctx = get_context(Src, St0), + {Bis,St1} = match_cg(B, Tf, St0), + {TestIs,St} = make_cond_branch(bs_test_tail, [Ctx,#b_literal{val=0}], Tf, St1), + Is = TestIs++Bis, + {Is,St}. + +select_extract_bin(#k_var{name=Hd}, Size0, Unit, Type, Flags, Vf, + Ctx, Anno, St0) -> + {Dst,St1} = new_ssa_var(Hd, St0), + Size = ssa_arg(Size0, St0), + build_bs_instr(Anno, Type, Vf, Ctx, Size, Unit, Flags, Dst, St1). + +select_extract_int(#k_var{name=Tl}, 0, #k_int{val=0}, _U, _Fs, _Vf, + Ctx, St0) -> + St = set_ssa_var(Tl, Ctx, St0), + {[],St}; +select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, + Ctx, St0) -> + {Dst,St1} = new_ssa_var(Tl, St0), + Bits = U*Sz, + Bin = case member(big, Fs) of + true -> + <<Val:Bits>>; + false -> + true = member(little, Fs), %Assertion. + <<Val:Bits/little>> + end, + Bits = bit_size(Bin), %Assertion. + {TestIs,St} = make_cond_branch(succeeded, [Dst], Vf, St1), + Set = #b_set{op=bs_match,dst=Dst, + args=[#b_literal{val=string},Ctx,#b_literal{val=Bin}]}, + {[Set|TestIs],St}. + +build_bs_instr(Anno, Type, Fail, Ctx, Size, Unit0, Flags0, Dst, St0) -> + Unit = #b_literal{val=Unit0}, + Flags = #b_literal{val=Flags0}, + NeedSize = bs_need_size(Type), + TypeArg = #b_literal{val=Type}, + Get = case NeedSize of + true -> + #b_set{anno=Anno,op=bs_match,dst=Dst, + args=[TypeArg,Ctx,Flags,Size,Unit]}; + false -> + #b_set{anno=Anno,op=bs_match,dst=Dst, + args=[TypeArg,Ctx,Flags]} + end, + {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + {[Get|Is],St}. + +select_val(#k_val_clause{val=#k_tuple{es=Es},body=B}, V, Vf, St0) -> + #k{us=Used} = k_get_anno(B), + {Eis,St1} = select_extract_tuple(V, Es, Used, St0), + {Bis,St2} = match_cg(B, Vf, St1), + {length(Es),Eis ++ Bis,St2}; +select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, St0) -> + Val = case Val0 of + #k_atom{val=Lit} -> Lit; + #k_float{val=Lit} -> Lit; + #k_int{val=Lit} -> Lit; + #k_literal{val=Lit} -> Lit + end, + {Bis,St1} = match_cg(B, Vf, St0), + {Val,Bis,St1}. + +%% select_extract_tuple(Src, [V], State) -> {[E],State}. +%% Extract tuple elements, but only if they are actually used. +%% +%% Not extracting tuple elements that are not used is an +%% optimization for compile time and memory use during compilation. +%% It is probably worthwhile because it is common to extract only a +%% few elements from a huge record. + +select_extract_tuple(Src, Vs, Used, St0) -> + Tuple = ssa_arg(Src, St0), + F = fun (#k_var{name=V}, {Elem,S0}) -> + case member(V, Used) of + true -> + Args = [Tuple,#b_literal{val=Elem}], + {Dst,S} = new_ssa_var(V, S0), + Get = #b_set{op=get_tuple_element,dst=Dst,args=Args}, + {[Get],{Elem+1,S}}; + false -> + {[],{Elem+1,S0}} + end + end, + {Es,{_,St}} = flatmapfoldl(F, {0,St0}, Vs), + {Es,St}. + +select_map(Scs, V, Tf, Vf, St0) -> + MapSrc = ssa_arg(V, St0), + {Is,St1} = + match_fmf(fun(#k_val_clause{val=#k_map{op=exact,es=Es}, + body=B}, Fail, St1) -> + select_map_val(V, Es, B, Fail, St1) + end, Vf, St0, Scs), + {TestIs,St} = make_cond_branch({bif,is_map}, [MapSrc], Tf, St1), + {TestIs++Is,St}. + +select_map_val(V, Es, B, Fail, St0) -> + {Eis,St1} = select_extract_map(Es, V, Fail, St0), + {Bis,St2} = match_cg(B, Fail, St1), + {Eis++Bis,St2}. + +select_extract_map([P|Ps], Src, Fail, St0) -> + MapSrc = ssa_arg(Src, St0), + #k_map_pair{key=Key0,val=#k_var{name=Dst0}} = P, + Key = ssa_arg(Key0, St0), + {Dst,St1} = new_ssa_var(Dst0, St0), + Set = #b_set{op=get_map_element,dst=Dst,args=[MapSrc,Key]}, + {TestIs,St2} = make_cond_branch(succeeded, [Dst], Fail, St1), + {Is,St} = select_extract_map(Ps, Src, Fail, St2), + {[Set|TestIs]++Is,St}; +select_extract_map([], _, _, St) -> + {[],St}. + +select_extract_cons(Src0, [#k_var{name=Hd},#k_var{name=Tl}], St0) -> + Src = ssa_arg(Src0, St0), + {HdDst,St1} = new_ssa_var(Hd, St0), + {TlDst,St2} = new_ssa_var(Tl, St1), + GetHd = #b_set{op=get_hd,dst=HdDst,args=[Src]}, + GetTl = #b_set{op=get_tl,dst=TlDst,args=[Src]}, + {[GetHd,GetTl],St2}. + +guard_clause_cg(#k_guard_clause{guard=G,body=B}, Fail, St0) -> + {Gis,St1} = guard_cg(G, Fail, St0), + {Bis,St} = match_cg(B, Fail, St1), + {Gis ++ Bis,St}. + +%% guard_cg(Guard, Fail, State) -> {[Ainstr],State}. +%% A guard is a boolean expression of tests. Tests return true or +%% false. A fault in a test causes the test to return false. Tests +%% never return the boolean, instead we generate jump code to go to +%% the correct exit point. Primops and tests all go to the next +%% instruction on success or jump to a failure label. + +guard_cg(#k_protected{arg=Ts,ret=Rs,inner=Inner}, Fail, St) -> + protected_cg(Ts, Rs, Inner, Fail, St); +guard_cg(#k_test{op=Test0,args=As,inverted=Inverted}, Fail, St0) -> + #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0, + test_cg(Test, Inverted, As, Fail, St0); +guard_cg(#k_seq{arg=Arg,body=Body}, Fail, St0) -> + {ArgIs,St1} = guard_cg(Arg, Fail, St0), + {BodyIs,St} = guard_cg(Body, Fail, St1), + {ArgIs++BodyIs,St}; +guard_cg(G, _Fail, St) -> + cg(G, St). + +test_cg('=/=', Inverted, As, Fail, St) -> + test_cg('=:=', not Inverted, As, Fail, St); +test_cg('/=', Inverted, As, Fail, St) -> + test_cg('==', not Inverted, As, Fail, St); +test_cg(Test, Inverted, As0, Fail, St0) -> + As = ssa_args(As0, St0), + case {Test,ssa_args(As0, St0)} of + {is_record,[Tuple,#b_literal{val=Atom}=Tag,#b_literal{val=Int}=Arity]} + when is_atom(Atom), is_integer(Int) -> + test_is_record_cg(Inverted, Fail, Tuple, Tag, Arity, St0); + {_,As} -> + {Bool,St1} = new_ssa_var('@ssa_bool', St0), + {Succ,St} = new_label(St1), + Bif = #b_set{op={bif,Test},dst=Bool,args=As}, + Br = case Inverted of + false -> #b_br{bool=Bool,succ=Succ,fail=Fail}; + true -> #b_br{bool=Bool,succ=Fail,fail=Succ} + end, + {[Bif,Br,{label,Succ}],St} + end. + +test_is_record_cg(false, Fail, Tuple, TagVal, ArityVal, St0) -> + {Arity,St1} = new_ssa_var('@ssa_arity', St0), + {Tag,St2} = new_ssa_var('@ssa_tag', St1), + {Is0,St3} = make_cond_branch({bif,is_tuple}, [Tuple], Fail, St2), + GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, + {Is1,St4} = make_cond_branch({bif,'=:='}, [Arity,ArityVal], Fail, St3), + GetTag = #b_set{op=get_tuple_element,dst=Tag, + args=[Tuple,#b_literal{val=0}]}, + {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], Fail, St4), + Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2, + {Is,St}; +test_is_record_cg(true, Fail, Tuple, TagVal, ArityVal, St0) -> + {Succ,St1} = new_label(St0), + {Arity,St2} = new_ssa_var('@ssa_arity', St1), + {Tag,St3} = new_ssa_var('@ssa_tag', St2), + {Is0,St4} = make_cond_branch({bif,is_tuple}, [Tuple], Succ, St3), + GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, + {Is1,St5} = make_cond_branch({bif,'=:='}, [Arity,ArityVal], Succ, St4), + GetTag = #b_set{op=get_tuple_element,dst=Tag, + args=[Tuple,#b_literal{val=0}]}, + {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], Succ, St5), + Is3 = [make_uncond_branch(Fail),{label,Succ}], + Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2 ++ Is3, + {Is,St}. + +%% protected_cg([Kexpr], [Ret], Fail, St) -> {[Ainstr],St}. +%% Do a protected. Protecteds without return values are just done +%% for effect, the return value is not checked, success passes on to +%% the next instruction and failure jumps to Fail. If there are +%% return values then these must be set to 'false' on failure, +%% control always passes to the next instruction. + +protected_cg(Ts, [], _, Fail, St0) -> + %% Protect these calls, revert when done. + {Tis,St1} = guard_cg(Ts, Fail, St0#cg{bfail=Fail}), + {Tis,St1#cg{bfail=St0#cg.bfail}}; +protected_cg(Ts, Rs, Inner0, _Fail, St0) -> + {Pfail,St1} = new_label(St0), + {Br,St2} = new_label(St1), + Prot = duplicate(length(Rs), #b_literal{val=false}), + {Tis,St3} = guard_cg(Ts, Pfail, St2#cg{break=Pfail,bfail=Pfail}), + Inner = ssa_args(Inner0, St3), + {BreakVars,St} = new_ssa_vars(Rs, St3), + Is = Tis ++ [#cg_break{args=Inner,phi=Br}, + {label,Pfail},#cg_break{args=Prot,phi=Br}, + {label,Br},#cg_phi{vars=BreakVars}], + {Is,St#cg{break=St0#cg.break,bfail=St0#cg.bfail}}. + +%% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,State}. +%% This is a special flatmapfoldl for match code gen where we +%% generate a "failure" label for each clause. The last clause uses +%% an externally generated failure label, LastFail. N.B. We do not +%% know or care how the failure labels are used. + +match_fmf(F, LastFail, St, [H]) -> + F(H, LastFail, St); +match_fmf(F, LastFail, St0, [H|T]) -> + {Fail,St1} = new_label(St0), + {R,St2} = F(H, Fail, St1), + {Rs,St3} = match_fmf(F, LastFail, St2, T), + {R ++ [{label,Fail}] ++ Rs,St3}. + +%% fail_label(State) -> {Where,FailureLabel}. +%% Where = guard | no_catch | in_catch +%% Return an indication of which part of a function code is +%% being generated for and the appropriate failure label to +%% use. +%% +%% Where has the following meaning: +%% +%% guard - Inside a guard. +%% no_catch - In a function body, not in the scope of +%% a try/catch or catch. +%% in_catch - In the scope of a try/catch or catch. + +fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> + if + Fail =/= Ult -> + {guard,Fail}; + Catch =:= none -> + {no_catch,Fail}; + is_integer(Catch) -> + {in_catch,Catch} + end. + +%% bif_fail_label(State) -> FailureLabel. +%% Return the appropriate failure label for a guard BIF call or +%% primop that fails. + +bif_fail_label(St) -> + {_,Fail} = fail_label(St), + Fail. + +%% call_cg(Func, [Arg], [Ret], Le, State) -> +%% {[Ainstr],State}. +%% enter_cg(Func, [Arg], Le, St) -> {[Ainstr],St}. +%% Generate code for call and enter. + +call_cg(Func, As, [], Le, St) -> + call_cg(Func, As, [#k_var{name='@ssa_ignored'}], Le, St); +call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> + case fail_label(St0) of + {guard,Fail} -> + %% Inside a guard. The only allowed function call is to + %% erlang:error/1,2. We will generate a branch to the + %% failure branch. + #k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=error}} = Func0, %Assertion. + [#k_var{name=DestVar}] = Rs, + St = set_ssa_var(DestVar, #b_literal{val=unused}, St0), + {[make_uncond_branch(Fail),#cg_unreachable{}],St}; + {Catch,Fail} -> + %% Ordinary function call in a function body. + Args = ssa_args(As, St0), + {Ret,St1} = new_ssa_var(R, St0), + Func = call_target(Func0, Args, St0), + Call = #b_set{anno=line_anno(Le),op=call,dst=Ret,args=[Func|Args]}, + + %% If this is a call to erlang:error(), MoreRs could be a + %% nonempty list of variables that each need a value. + St2 = foldl(fun(#k_var{name=Dummy}, S) -> + set_ssa_var(Dummy, #b_literal{val=unused}, S) + end, St1, MoreRs), + case Catch of + no_catch -> + {[Call],St2}; + in_catch -> + {TestIs,St} = make_cond_branch(succeeded, [Ret], Fail, St2), + {[Call|TestIs],St} + end + end. + +enter_cg(Func0, As0, Le, St0) -> + Anno = line_anno(Le), + Func = call_target(Func0, As0, St0), + As = ssa_args(As0, St0), + {Ret,St} = new_ssa_var('@ssa_ret', St0), + Call = #b_set{anno=Anno,op=call,dst=Ret,args=[Func|As]}, + {[Call,#b_ret{arg=Ret}],St}. + +call_target(Func, As, St) -> + Arity = length(As), + case Func of + #k_remote{mod=Mod0,name=Name0} -> + Mod = ssa_arg(Mod0, St), + Name = ssa_arg(Name0, St), + #b_remote{mod=Mod,name=Name,arity=Arity}; + #k_local{name=Name} when is_atom(Name) -> + #b_local{name=#b_literal{val=Name},arity=Arity}; + #k_var{}=Var -> + ssa_arg(Var, St) + end. + +%% bif_cg(#k_bif{}, Le,State) -> {[Ainstr],State}. +%% Generate code for a guard BIF or primop. + +bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, St) -> + internal_cg(Name, As, Rs, Le, St); +bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, + args=As,ret=Rs}, Le, St) -> + bif_cg(Name, As, Rs, Le, St). + +%% internal_cg(Bif, [Arg], [Ret], Le, State) -> +%% {[Ainstr],State}. + +internal_cg(bs_context_to_binary, [Src0], [], _Le, St) -> + Src = ssa_arg(Src0, St), + Set = #b_set{op=context_to_binary,args=[Src]}, + {[Set],St}; +internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, _Le, St) -> + [New,Tuple,#b_literal{val=Index1}] = ssa_args([New0,Tuple0,Index0], St), + Index = #b_literal{val=Index1-1}, + Set = #b_set{op=set_tuple_element,args=[New,Tuple,Index]}, + {[Set],St}; +internal_cg(make_fun, [Name0,Arity0|As], Rs, _Le, St0) -> + #k_atom{val=Name} = Name0, + #k_int{val=Arity} = Arity0, + [#k_var{name=Dst0}] = Rs, + {Dst,St} = new_ssa_var(Dst0, St0), + Args = ssa_args(As, St), + Local = #b_local{name=#b_literal{val=Name},arity=Arity}, + MakeFun = #b_set{op=make_fun,dst=Dst,args=[Local|Args]}, + {[MakeFun],St}; +internal_cg(bs_init_writable=I, As, [#k_var{name=Dst0}], _Le, St0) -> + %% This behaves like a function call. + {Dst,St} = new_ssa_var(Dst0, St0), + Args = ssa_args(As, St), + Set = #b_set{op=I,dst=Dst,args=Args}, + {[Set],St}; +internal_cg(build_stacktrace=I, As, [#k_var{name=Dst0}], _Le, St0) -> + {Dst,St} = new_ssa_var(Dst0, St0), + Args = ssa_args(As, St), + Set = #b_set{op=I,dst=Dst,args=Args}, + {[Set],St}; +internal_cg(raise, As, [#k_var{name=Dst0}], _Le, St0) -> + Args = ssa_args(As, St0), + {Dst,St} = new_ssa_var(Dst0, St0), + Resume = #b_set{op=resume,dst=Dst,args=Args}, + case St of + #cg{catch_label=none} -> + {[Resume],St}; + #cg{catch_label=Catch} when is_integer(Catch) -> + Is = [Resume,make_uncond_branch(Catch),#cg_unreachable{}], + {Is,St} + end; +internal_cg(raw_raise=I, As, [#k_var{name=Dst0}], _Le, St0) -> + %% This behaves like a function call. + {Dst,St} = new_ssa_var(Dst0, St0), + Args = ssa_args(As, St), + Set = #b_set{op=I,dst=Dst,args=Args}, + {[Set],St}. + +bif_cg(Bif, As0, [#k_var{name=Dst0}], Le, St0) -> + {Dst,St1} = new_ssa_var(Dst0, St0), + case {Bif,ssa_args(As0, St0)} of + {is_record,[Tuple,#b_literal{val=Atom}=Tag, + #b_literal{val=Int}=Arity]} + when is_atom(Atom), is_integer(Int) -> + bif_is_record_cg(Dst, Tuple, Tag, Arity, St1); + {_,As} -> + I = #b_set{anno=line_anno(Le),op={bif,Bif},dst=Dst,args=As}, + case erl_bifs:is_safe(erlang, Bif, length(As)) of + false -> + Fail = bif_fail_label(St1), + {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {[I|Is],St}; + true-> + {[I],St1} + end + end. + +bif_is_record_cg(Dst, Tuple, TagVal, ArityVal, St0) -> + {Arity,St1} = new_ssa_var('@ssa_arity', St0), + {Tag,St2} = new_ssa_var('@ssa_tag', St1), + {Phi,St3} = new_label(St2), + {False,St4} = new_label(St3), + {Is0,St5} = make_cond_branch({bif,is_tuple}, [Tuple], False, St4), + GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, + {Is1,St6} = make_cond_branch({bif,'=:='}, [Arity,ArityVal], False, St5), + GetTag = #b_set{op=get_tuple_element,dst=Tag, + args=[Tuple,#b_literal{val=0}]}, + {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], False, St6), + Is3 = [#cg_break{args=[#b_literal{val=true}],phi=Phi}, + {label,False}, + #cg_break{args=[#b_literal{val=false}],phi=Phi}, + {label,Phi}, + #cg_phi{vars=[Dst]}], + Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2 ++ Is3, + {Is,St}. + +%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, +%% [Ret], Le, St) -> {[Ainstr],St}. + +recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, St0) -> + %% Get labels. + {Rl,St1} = new_label(St0), + {Tl,St2} = new_label(St1), + {Bl,St3} = new_label(St2), + St4 = St3#cg{break=Bl,recv=Rl}, + {Ris,St5} = cg_recv_mesg(Rvar, Rm, Tl, Le, St4), + {Wis,St6} = cg_recv_wait(Te, Tes, St5), + {BreakVars,St} = new_ssa_vars(Rs, St6), + {Ris ++ [{label,Tl}] ++ Wis ++ + [{label,Bl},#cg_phi{vars=BreakVars}], + St#cg{break=St0#cg.break,recv=St0#cg.recv}}. + +%% cg_recv_mesg( ) -> {[Ainstr],St}. + +cg_recv_mesg(#k_var{name=R}, Rm, Tl, Le, St0) -> + {Dst,St1} = new_ssa_var(R, St0), + {Mis,St2} = match_cg(Rm, none, St1), + RecvLbl = St1#cg.recv, + {TestIs,St} = make_cond_branch(succeeded, [Dst], Tl, St2), + Is = [#b_br{anno=line_anno(Le),bool=#b_literal{val=true}, + succ=RecvLbl,fail=RecvLbl}, + {label,RecvLbl}, + #b_set{op=peek_message,dst=Dst}|TestIs], + {Is++Mis,St}. + +%% cg_recv_wait(Te, Tes, St) -> {[Ainstr],St}. + +cg_recv_wait(#k_int{val=0}, Es, St0) -> + {Tis,St} = cg(Es, St0), + {[#b_set{op=timeout}|Tis],St}; +cg_recv_wait(Te, Es, St0) -> + {Tis,St1} = cg(Es, St0), + Args = [ssa_arg(Te, St1)], + {WaitDst,St2} = new_ssa_var('@ssa_wait', St1), + {WaitIs,St} = make_cond_branch(succeeded, [WaitDst], St1#cg.recv, St2), + %% Infinite timeout will be optimized later. + Is = [#b_set{op=wait_timeout,dst=WaitDst,args=Args}] ++ WaitIs ++ + [#b_set{op=timeout}] ++ Tis, + {Is,St}. + +%% try_cg(TryBlock, [BodyVar], TryBody, [ExcpVar], TryHandler, [Ret], St) -> +%% {[Ainstr],St}. + +try_cg(Ta, Vs, Tb, Evs, Th, Rs, St0) -> + {B,St1} = new_label(St0), %Body label + {H,St2} = new_label(St1), %Handler label + {E,St3} = new_label(St2), %End label + {Next,St4} = new_label(St3), + {TryTag,St5} = new_ssa_var('@ssa_catch_tag', St4), + {SsaVs,St6} = new_ssa_vars(Vs, St5), + {SsaEvs,St7} = new_ssa_vars(Evs, St6), + {Ais,St8} = cg(Ta, St7#cg{break=B,catch_label=H}), + St9 = St8#cg{break=E,catch_label=St7#cg.catch_label}, + {Bis,St10} = cg(Tb, St9), + {His,St11} = cg(Th, St10), + {BreakVars,St12} = new_ssa_vars(Rs, St11), + {CatchedAgg,St} = new_ssa_var('@ssa_agg', St12), + ExtractVs = extract_vars(SsaEvs, CatchedAgg, 0), + KillTryTag = #b_set{op=kill_try_tag,args=[TryTag]}, + Args = [#b_literal{val='try'},TryTag], + Handler = [{label,H}, + #b_set{op=landingpad,dst=CatchedAgg,args=Args}] ++ + ExtractVs ++ [KillTryTag], + {[#b_set{op=new_try_tag,dst=TryTag,args=[#b_literal{val='try'}]}, + #b_br{bool=TryTag,succ=Next,fail=H}, + {label,Next}] ++ Ais ++ + [{label,B},#cg_phi{vars=SsaVs},KillTryTag] ++ Bis ++ + Handler ++ His ++ + [{label,E},#cg_phi{vars=BreakVars}], + St#cg{break=St0#cg.break}}. + +try_enter_cg(Ta, Vs, Tb, Evs, Th, St0) -> + {B,St1} = new_label(St0), %Body label + {H,St2} = new_label(St1), %Handler label + {Next,St3} = new_label(St2), + {TryTag,St4} = new_ssa_var('@ssa_catch_tag', St3), + {SsaVs,St5} = new_ssa_vars(Vs, St4), + {SsaEvs,St6} = new_ssa_vars(Evs, St5), + {Ais,St7} = cg(Ta, St6#cg{break=B,catch_label=H}), + St8 = St7#cg{catch_label=St6#cg.catch_label}, + {Bis,St9} = cg(Tb, St8), + {His,St10} = cg(Th, St9), + {CatchedAgg,St} = new_ssa_var('@ssa_agg', St10), + ExtractVs = extract_vars(SsaEvs, CatchedAgg, 0), + KillTryTag = #b_set{op=kill_try_tag,args=[TryTag]}, + Args = [#b_literal{val='try'},TryTag], + Handler = [{label,H}, + #b_set{op=landingpad,dst=CatchedAgg,args=Args}] ++ + ExtractVs ++ [KillTryTag], + {[#b_set{op=new_try_tag,dst=TryTag,args=[#b_literal{val='try'}]}, + #b_br{bool=TryTag,succ=Next,fail=H}, + {label,Next}] ++ Ais ++ + [{label,B},#cg_phi{vars=SsaVs},KillTryTag] ++ Bis ++ + Handler ++ His, + St#cg{break=St0#cg.break}}. + +extract_vars([V|Vs], Agg, N) -> + I = #b_set{op=extract,dst=V,args=[Agg,#b_literal{val=N}]}, + [I|extract_vars(Vs, Agg, N+1)]; +extract_vars([], _, _) -> []. + +%% do_catch_cg(CatchBlock, Ret, St) -> {[Ainstr],St}. + +do_catch_cg(Block, #k_var{name=R}, St0) -> + {B,St1} = new_label(St0), + {Next,St2} = new_label(St1), + {H,St3} = new_label(St2), + {CatchReg,St4} = new_ssa_var('@ssa_catch_tag', St3), + {Dst,St5} = new_ssa_var(R, St4), + {Succ,St6} = new_label(St5), + {Cis,St7} = cg(Block, St6#cg{break=Succ,catch_label=H}), + {CatchedVal,St8} = new_ssa_var('@catched_val', St7), + {SuccVal,St9} = new_ssa_var('@success_val', St8), + {CatchedAgg,St10} = new_ssa_var('@ssa_agg', St9), + {CatchEndVal,St} = new_ssa_var('@catch_end_val', St10), + Args = [#b_literal{val='catch'},CatchReg], + {[#b_set{op=new_try_tag,dst=CatchReg,args=[#b_literal{val='catch'}]}, + #b_br{bool=CatchReg,succ=Next,fail=H}, + {label,Next}] ++ Cis ++ + [{label,H}, + #b_set{op=landingpad,dst=CatchedAgg,args=Args}, + #b_set{op=extract,dst=CatchedVal, + args=[CatchedAgg,#b_literal{val=0}]}, + #cg_break{args=[CatchedVal],phi=B}, + {label,Succ}, + #cg_phi{vars=[SuccVal]}, + #cg_break{args=[SuccVal],phi=B}, + {label,B},#cg_phi{vars=[CatchEndVal]}, + #b_set{op=catch_end,dst=Dst,args=[CatchReg,CatchEndVal]}], + St#cg{break=St1#cg.break,catch_label=St1#cg.catch_label}}. + +%% put_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],St}. +%% Generate code for constructing terms. + +put_cg([#k_var{name=R}], #k_cons{hd=Hd,tl=Tl}, _Le, St0) -> + Args = ssa_args([Hd,Tl], St0), + {Dst,St} = new_ssa_var(R, St0), + PutList = #b_set{op=put_list,dst=Dst,args=Args}, + {[PutList],St}; +put_cg([#k_var{name=R}], #k_tuple{es=Es}, _Le, St0) -> + {Ret,St} = new_ssa_var(R, St0), + Args = ssa_args(Es, St), + PutTuple = #b_set{op=put_tuple,dst=Ret,args=Args}, + {[PutTuple],St}; +put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, St0) -> + Fail = bif_fail_label(St0), + {Dst,St1} = new_ssa_var(R, St0), + cg_binary(Dst, Segs, Fail, Le, St1); +put_cg([#k_var{name=R}], #k_map{op=Op,var=Map, + es=[#k_map_pair{key=#k_var{}=K,val=V}]}, + Le, St0) -> + %% Map: single variable key. + SrcMap = ssa_arg(Map, St0), + LineAnno = line_anno(Le), + List = [ssa_arg(K, St0),ssa_arg(V, St0)], + {Dst,St1} = new_ssa_var(R, St0), + {Is,St} = put_cg_map(LineAnno, Op, SrcMap, Dst, List, St1), + {Is,St}; +put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,es=Es}, Le, St0) -> + %% Map: one or more literal keys. + [] = [Var || #k_map_pair{key=#k_var{}=Var} <- Es], %Assertion + SrcMap = ssa_arg(Map, St0), + LineAnno = line_anno(Le), + List = flatmap(fun(#k_map_pair{key=K,val=V}) -> + [ssa_arg(K, St0),ssa_arg(V, St0)] + end, Es), + {Dst,St1} = new_ssa_var(R, St0), + {Is,St} = put_cg_map(LineAnno, Op, SrcMap, Dst, List, St1), + {Is,St}; +put_cg([#k_var{name=R}], Con0, _Le, St0) -> + %% Create an alias for a variable or literal. + Con = ssa_arg(Con0, St0), + St = set_ssa_var(R, Con, St0), + {[],St}. + +put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) -> + Fail = bif_fail_label(St0), + Args = [#b_literal{val=Op},SrcMap|List], + PutMap = #b_set{anno=LineAnno,op=put_map,dst=Dst,args=Args}, + if + Op =:= assoc -> + {[PutMap],St0}; + true -> + {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + {[PutMap|Is],St} + end. + +%%% +%%% Code generation for constructing binaries. +%%% + +cg_binary(Dst, Segs0, Fail, Le, St0) -> + {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, Fail, St0), + LineAnno = line_anno(Le), + Anno = Le#k.a, + case PutCode0 of + [#b_set{op=bs_put,dst=Bool,args=[_,_,Src,#b_literal{val=all}|_]}, + #b_br{bool=Bool}, + {label,_}|_] -> + #k_bin_seg{unit=Unit0,next=Segs} = Segs0, + Unit = #b_literal{val=Unit0}, + {PutCode,SzCalc1,St2} = cg_bin_put(Segs, Fail, St1), + {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, Fail, St2), + SzCode = cg_bin_anno(SzCode0, LineAnno), + Args = case member(single_use, Anno) of + true -> + [#b_literal{val=private_append},Src,SzVar,Unit]; + false -> + [#b_literal{val=append},Src,SzVar,Unit] + end, + BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, + {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St3), + {SzCode ++ [BsInit] ++ TestIs ++ PutCode,St}; + [#b_set{op=bs_put}|_] -> + {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, Fail, St1), + SzCode = cg_bin_anno(SzCode0, LineAnno), + Args = [#b_literal{val=new},SzVar,Unit], + BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, + {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St2), + {SzCode ++ [BsInit] ++ TestIs ++ PutCode0,St} + end. + +cg_bin_anno([Set|Sets], Anno) -> + [Set#b_set{anno=Anno}|Sets]; +cg_bin_anno([], _) -> []. + +%% cg_size_calc(PreferredUnit, SzCalc, Fail, St0) -> +%% {ActualUnit,SizeVariable,SizeCode,St}. +%% Generate size calculation code. + +cg_size_calc(Unit, error, _Fail, St) -> + {#b_literal{val=Unit},#b_literal{val=badarg},[],St}; +cg_size_calc(8, [{1,_}|_]=SzCalc, Fail, St) -> + cg_size_calc(1, SzCalc, Fail, St); +cg_size_calc(8, SzCalc, Fail, St0) -> + {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), + {#b_literal{val=8},Var,Pre,St}; +cg_size_calc(1, SzCalc0, Fail, St0) -> + SzCalc = map(fun({8,#b_literal{val=Size}}) -> + {1,#b_literal{val=8*Size}}; + ({8,{{bif,byte_size},Src}}) -> + {1,{{bif,bit_size},Src}}; + ({8,{_,_}=UtfCalc}) -> + {1,{'*',#b_literal{val=8},UtfCalc}}; + ({_,_}=Pair) -> + Pair + end, SzCalc0), + {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), + {#b_literal{val=1},Var,Pre,St}. + +cg_size_calc_1(SzCalc, Fail, St0) -> + cg_size_calc_2(SzCalc, #b_literal{val=0}, Fail, St0). + +cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, Fail, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, Fail, St2), + {Sum,Pre0++Pre1++Pre2,St}; +cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, Fail, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), + {Sum,Pre0++Pre,St}; +cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, Fail, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), + {Sum,Pre0++Pre,St}; +cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, Fail, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, Fail, St2), + {Sum,Pre0++Pre1++Pre2,St}; +cg_size_calc_2([], Sum, _Fail, St) -> + {Sum,[],St}. + +cg_size_bif(#b_var{}=Var, _Fail, St) -> + {Var,[],St}; +cg_size_bif({Name,Src}, Fail, St0) -> + {Dst,St1} = new_ssa_var('@ssa_bif', St0), + Bif = #b_set{op=Name,dst=Dst,args=[Src]}, + {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {Dst,[Bif|TestIs],St}. + +cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _Fail, St) -> + {Val,[],St}; +cg_size_add(A, B, Unit, Fail, St0) -> + {Dst,St1} = new_ssa_var('@ssa_sum', St0), + {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + BsAdd = #b_set{op=bs_add,dst=Dst,args=[A,B,Unit]}, + {Dst,[BsAdd|TestIs],St}. + +cg_bin_put(Seg, Fail, St) -> + cg_bin_put_1(Seg, Fail, [], [], St). + +cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next}, + Fail, Acc, SzCalcAcc, St0) -> + [Src,Size] = ssa_args([Src0,Size0], St0), + NeedSize = bs_need_size(T), + TypeArg = #b_literal{val=T}, + Flags = #b_literal{val=Fs}, + Unit = #b_literal{val=U}, + Args = case NeedSize of + true -> [TypeArg,Flags,Src,Size,Unit]; + false -> [TypeArg,Flags,Src] + end, + {Is,St} = make_cond_branch(bs_put, Args, Fail, St0), + SzCalc = bin_size_calc(T, Src, Size, U), + cg_bin_put_1(Next, Fail, reverse(Is, Acc), [SzCalc|SzCalcAcc], St); +cg_bin_put_1(#k_bin_end{}, _, Acc, SzCalcAcc, St) -> + SzCalc = fold_size_calc(SzCalcAcc, 0, []), + {reverse(Acc),SzCalc,St}. + +bs_need_size(utf8) -> false; +bs_need_size(utf16) -> false; +bs_need_size(utf32) -> false; +bs_need_size(_) -> true. + +bin_size_calc(utf8, Src, _Size, _Unit) -> + {8,{bs_utf8_size,Src}}; +bin_size_calc(utf16, Src, _Size, _Unit) -> + {8,{bs_utf16_size,Src}}; +bin_size_calc(utf32, _Src, _Size, _Unit) -> + {8,#b_literal{val=4}}; +bin_size_calc(binary, Src, #b_literal{val=all}, Unit) -> + case Unit rem 8 of + 0 -> {8,{{bif,byte_size},Src}}; + _ -> {1,{{bif,bit_size},Src}} + end; +bin_size_calc(_Type, _Src, Size, Unit) -> + {Unit,Size}. + +fold_size_calc([{Unit,#b_literal{val=Size}}|T], Bits, Acc) -> + if + is_integer(Size) -> + fold_size_calc(T, Bits + Unit*Size, Acc); + true -> + error + end; +fold_size_calc([{U,#b_var{}}=H|T], Bits, Acc) when U =:= 1; U =:= 8 -> + fold_size_calc(T, Bits, [H|Acc]); +fold_size_calc([{U,#b_var{}=Var}|T], Bits, Acc) -> + fold_size_calc(T, Bits, [{1,{'*',#b_literal{val=U},Var}}|Acc]); +fold_size_calc([{_,_}=H|T], Bits, Acc) -> + fold_size_calc(T, Bits, [H|Acc]); +fold_size_calc([], Bits, Acc) -> + Bytes = Bits div 8, + RemBits = Bits rem 8, + Sizes = sort([{1,#b_literal{val=RemBits}},{8,#b_literal{val=Bytes}}|Acc]), + [Pair || {_,Sz}=Pair <- Sizes, Sz =/= #b_literal{val=0}]. + +%%% +%%% Utilities for creating the SSA types. +%%% + +ssa_args(As, St) -> + [ssa_arg(A, St) || A <- As]. + +ssa_arg(#k_var{name=V}, #cg{vars=Vars}) -> maps:get(V, Vars); +ssa_arg(#k_literal{val=V}, _) -> #b_literal{val=V}; +ssa_arg(#k_atom{val=V}, _) -> #b_literal{val=V}; +ssa_arg(#k_float{val=V}, _) -> #b_literal{val=V}; +ssa_arg(#k_int{val=V}, _) -> #b_literal{val=V}; +ssa_arg(#k_nil{}, _) -> #b_literal{val=[]}. + +new_ssa_vars(Vs, St) -> + mapfoldl(fun(#k_var{name=V}, S) -> + new_ssa_var(V, S) + end, St, Vs). + +new_ssa_var(VarBase, #cg{lcount=Uniq,vars=Vars}=St0) + when is_atom(VarBase); is_integer(VarBase) -> + case Vars of + #{VarBase:=_} -> + Var = #b_var{name={VarBase,Uniq}}, + St = St0#cg{lcount=Uniq+1,vars=Vars#{VarBase=>Var}}, + {Var,St}; + #{} -> + Var = #b_var{name=VarBase}, + St = St0#cg{vars=Vars#{VarBase=>Var}}, + {Var,St} + end. + +set_ssa_var(VarBase, Val, #cg{vars=Vars}=St) + when is_atom(VarBase); is_integer(VarBase) -> + St#cg{vars=Vars#{VarBase=>Val}}. + +%% new_label(St) -> {L,St}. + +new_label(#cg{lcount=Next}=St) -> + {Next,St#cg{lcount=Next+1}}. + +%% line_anno(Le) -> #{} | #{location:={File,Line}}. +%% Create a location annotation, containing information about the +%% current filename and line number. The annotation should be +%% included in any operation that could cause an exception. + +line_anno(#k{a=Anno}) -> + line_anno_1(Anno). + +line_anno_1([Line,{file,Name}]) when is_integer(Line) -> + line_anno_2(Name, Line); +line_anno_1([_|_]=A) -> + {Name,Line} = find_loc(A, no_file, 0), + line_anno_2(Name, Line); +line_anno_1([]) -> + #{}. + +line_anno_2(no_file, _) -> + #{}; +line_anno_2(_, 0) -> + %% Missing line number or line number 0. + #{}; +line_anno_2(Name, Line) -> + #{location=>{Name,Line}}. + +find_loc([Line|T], File, _) when is_integer(Line) -> + find_loc(T, File, Line); +find_loc([{file,File}|T], _, Line) -> + find_loc(T, File, Line); +find_loc([_|T], File, Line) -> + find_loc(T, File, Line); +find_loc([], File, Line) -> {File,Line}. + +flatmapfoldl(F, Accu0, [Hd|Tail]) -> + {R,Accu1} = F(Hd, Accu0), + {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), + {R++Rs,Accu2}; +flatmapfoldl(_, Accu, []) -> {[],Accu}. + +%%% +%%% Finalize the code. +%%% + +finalize(Asm0, St0) -> + Asm1 = fix_phis(Asm0), + {Asm,St} = fix_sets(Asm1, [], St0), + {build_map(Asm),St}. + +fix_phis(Is) -> + fix_phis_1(Is, none, #{}). + +fix_phis_1([{label,L},#cg_phi{vars=[]}=Phi|Is0], _Lbl, Map0) -> + case maps:is_key(L, Map0) of + false -> + %% No #cg_break{} references this label. Nothing else can + %% reference it, so it can be safely be removed. + {Is,Map} = drop_upto_label(Is0, Map0), + fix_phis_1(Is, none, Map); + true -> + %% There is a break referencing this label; probably caused + %% by a try/catch whose return value is ignored. + [{label,L}|fix_phis_1([Phi|Is0], L, Map0)] + end; +fix_phis_1([{label,L}=I|Is], _Lbl, Map) -> + [I|fix_phis_1(Is, L, Map)]; +fix_phis_1([#cg_unreachable{}|Is0], _Lbl, Map0) -> + {Is,Map} = drop_upto_label(Is0, Map0), + fix_phis_1(Is, none, Map); +fix_phis_1([#cg_break{args=Args,phi=Target}|Is], Lbl, Map) when is_integer(Lbl) -> + Pairs1 = case Map of + #{Target:=Pairs0} -> Pairs0; + #{} -> [] + end, + Pairs = [[{Arg,Lbl} || Arg <- Args]|Pairs1], + I = make_uncond_branch(Target), + [I|fix_phis_1(Is, none, Map#{Target=>Pairs})]; +fix_phis_1([#cg_phi{vars=Vars}|Is0], Lbl, Map0) -> + Pairs = maps:get(Lbl, Map0), + Map1 = maps:remove(Lbl, Map0), + case gen_phis(Vars, Pairs) of + [#b_set{op=phi,args=[]}] -> + {Is,Map} = drop_upto_label(Is0, Map1), + Ret = #b_ret{arg=#b_literal{val=unreachable}}, + [Ret|fix_phis_1(Is, none, Map)]; + Phis -> + Phis ++ fix_phis_1(Is0, Lbl, Map1) + end; +fix_phis_1([I|Is], Lbl, Map) -> + [I|fix_phis_1(Is, Lbl, Map)]; +fix_phis_1([], _, Map) -> + [] = maps:to_list(Map), %Assertion. + []. + +gen_phis([V|Vs], Preds0) -> + {Pairs,Preds} = collect_preds(Preds0, [], []), + [#b_set{op=phi,dst=V,args=Pairs}|gen_phis(Vs, Preds)]; +gen_phis([], _) -> []. + +collect_preds([[First|Rest]|T], ColAcc, RestAcc) -> + collect_preds(T, [First|ColAcc], [Rest|RestAcc]); +collect_preds([], ColAcc, RestAcc) -> + {keysort(2, ColAcc),RestAcc}. + +fix_sets([#b_set{dst=none}=Set|Is], Acc, St0) -> + {Dst,St} = new_ssa_var('@ssa_ignored', St0), + I = Set#b_set{dst=Dst}, + fix_sets(Is, [I|Acc], St); +fix_sets([I|Is], Acc, St) -> + fix_sets(Is, [I|Acc], St); +fix_sets([], Acc, St) -> + {reverse(Acc),St}. + +build_map(Is) -> + Blocks = build_graph_1(Is, [], []), + maps:from_list(Blocks). + +build_graph_1([{label,L}|Is], Lbls, []) -> + build_graph_1(Is, [L|Lbls], []); +build_graph_1([{label,L}|Is], Lbls, [_|_]=BlockAcc) -> + make_blocks(Lbls, BlockAcc) ++ build_graph_1(Is, [L], []); +build_graph_1([I|Is], Lbls, BlockAcc) -> + build_graph_1(Is, Lbls, [I|BlockAcc]); +build_graph_1([], Lbls, BlockAcc) -> + make_blocks(Lbls, BlockAcc). + +make_blocks(Lbls, [Last|Is0]) -> + Is = reverse(Is0), + Block = #b_blk{is=Is,last=Last}, + [{L,Block} || L <- Lbls]. + +drop_upto_label([{label,_}|_]=Is, Map) -> + {Is,Map}; +drop_upto_label([#cg_break{phi=Target}|Is], Map) -> + Pairs = case Map of + #{Target:=Pairs0} -> Pairs0; + #{} -> [] + end, + drop_upto_label(Is, Map#{Target=>Pairs}); +drop_upto_label([_|Is], Map) -> + drop_upto_label(Is, Map). + +k_get_anno(Thing) -> element(2, Thing). diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 518b958794..8a0ce5b50a 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -23,6 +23,7 @@ -include("core_parse.hrl"). -include("v3_kernel.hrl"). +-include("beam_ssa.hrl"). -include("beam_disasm.hrl"). -import(lists, [foreach/2]). @@ -41,6 +42,12 @@ module(File, #k_mdef{}=Kern) -> %% This is a kernel module. io:put_chars(File, v3_kernel_pp:format(Kern)); %%io:put_chars(File, io_lib:format("~p~n", [Kern])); +module(File, #b_module{name=Mod,exports=Exp,attributes=Attr,body=Fs}) -> + io:format(File, "module ~p.\n", [Mod]), + io:format(File, "exports ~p.\n", [Exp]), + io:format(File, "attributes ~p.\n\n", [Attr]), + PP = [beam_ssa_pp:format_function(F) || F <- Fs], + io:put_chars(File, lists:join($\n, PP)); module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> %% This is output from v3_codegen. io:format(Stream, "{module, ~p}. %% version = ~w\n", diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 2b8dd40e29..74da6aa704 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -101,23 +101,13 @@ peep([{select,Op,R,F,Vls0}|Is], SeenTests0, Acc0) -> I = {jump,F}, peep([I|Is], gb_sets:empty(), Acc0); [{atom,_}=Value,Lbl] when Op =:= select_val -> - %% Single value left. Convert to regular test and pop redundant tests. + %% Single value left. Convert to regular test. Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is], - case Acc0 of - [{test,is_atom,F,[R]}|Acc] -> - peep(Is1, SeenTests0, Acc); - _ -> - peep(Is1, SeenTests0, Acc0) - end; + peep(Is1, SeenTests0, Acc0); [{integer,_}=Value,Lbl] when Op =:= select_val -> - %% Single value left. Convert to regular test and pop redundant tests. + %% Single value left. Convert to regular test. Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is], - case Acc0 of - [{test,is_integer,F,[R]}|Acc] -> - peep(Is1, SeenTests0, Acc); - _ -> - peep(Is1, SeenTests0, Acc0) - end; + peep(Is1, SeenTests0, Acc0); [Arity,Lbl] when Op =:= select_tuple_arity -> %% Single value left. Convert to regular test Is1 = [{test,test_arity,F,[R,Arity]},{jump,Lbl}|Is], @@ -126,6 +116,21 @@ peep([{select,Op,R,F,Vls0}|Is], SeenTests0, Acc0) -> I = {select,Op,R,F,Vls}, peep(Is, gb_sets:empty(), [I|Acc0]) end; +peep([{get_map_elements,Fail,Src,List}=I|Is], _SeenTests, Acc0) -> + SeenTests = gb_sets:empty(), + case simplify_get_map_elements(Fail, Src, List, Acc0) of + {ok,Acc} -> + peep(Is, SeenTests, Acc); + error -> + peep(Is, SeenTests, [I|Acc0]) + end; +peep([{test,has_map_fields,Fail,Ops}=I|Is], SeenTests, Acc0) -> + case simplify_has_map_fields(Fail, Ops, Acc0) of + {ok,Acc} -> + peep(Is, SeenTests, Acc); + error -> + peep(Is, SeenTests, [I|Acc0]) + end; peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> case beam_utils:is_pure_test(I) of false -> @@ -176,3 +181,39 @@ prune_redundant_values([_Val,F|Vls], F) -> prune_redundant_values([Val,Lbl|Vls], F) -> [Val,Lbl|prune_redundant_values(Vls, F)]; prune_redundant_values([], _) -> []. + +simplify_get_map_elements(Fail, Src, {list,[Key,Dst]}, + [{get_map_elements,Fail,Src,{list,List1}}|Acc]) -> + case are_keys_literals([Key]) andalso are_keys_literals(List1) of + true -> + case member(Key, List1) of + true -> + %% The key is already in the other list. That is + %% very unusual, because there are optimizations to get + %% rid of duplicate keys. Therefore, don't try to + %% do anything smart here; just keep the + %% get_map_elements instructions separate. + error; + false -> + List = [Key,Dst|List1], + {ok,[{get_map_elements,Fail,Src,{list,List}}|Acc]} + end; + false -> + error + end; +simplify_get_map_elements(_, _, _, _) -> error. + +simplify_has_map_fields(Fail, [Src|Keys0], + [{test,has_map_fields,Fail,[Src|Keys1]}|Acc]) -> + case are_keys_literals(Keys0) andalso are_keys_literals(Keys1) of + true -> + Keys = Keys0 ++ Keys1, + {ok,[{test,has_map_fields,Fail,[Src|Keys]}|Acc]}; + false -> + error + end; +simplify_has_map_fields(_, _, _) -> error. + +are_keys_literals([{x,_}|_]) -> false; +are_keys_literals([{y,_}|_]) -> false; +are_keys_literals([_|_]) -> true. diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl deleted file mode 100644 index ddbe67605a..0000000000 --- a/lib/compiler/src/beam_receive.erl +++ /dev/null @@ -1,416 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(beam_receive). --export([module/2]). --import(lists, [foldl/3,reverse/1,reverse/2]). - -%%% -%%% In code such as: -%%% -%%% Ref = make_ref(), %Or erlang:monitor(process, Pid) -%%% . -%%% . -%%% . -%%% receive -%%% {Ref,Reply} -> Reply -%%% end. -%%% -%%% we know that none of the messages that exist in the message queue -%%% before the call to make_ref/0 can be matched out in the receive -%%% statement. Therefore we can avoid going through the entire message -%%% queue if we introduce two new instructions (here written as -%%% BIFs in pseudo-Erlang): -%%% -%%% recv_mark(SomeUniqInteger), -%%% Ref = make_ref(), -%%% . -%%% . -%%% . -%%% recv_set(SomeUniqInteger), -%%% receive -%%% {Ref,Reply} -> Reply -%%% end. -%%% -%%% The recv_mark/1 instruction will save the current position and -%%% SomeUniqInteger in the process context. The recv_set -%%% instruction will verify that SomeUniqInteger is still stored -%%% in the process context. If it is, it will set the current pointer -%%% for the message queue (the next message to be read out) to the -%%% position that was saved by recv_mark/1. -%%% -%%% The remove_message instruction must be modified to invalidate -%%% the information stored by the previous recv_mark/1, in case there -%%% is another receive executed between the calls to recv_mark/1 and -%%% recv_set/1. -%%% -%%% We use a reference to a label (i.e. a position in the loaded code) -%%% as the SomeUniqInteger. -%%% - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> - Fs = [function(F) || F <- Fs0], - Code = {Mod,Exp,Attr,Fs,Lc}, - {ok,Code}. - -%%% -%%% Local functions. -%%% - -function({function,Name,Arity,Entry,Is}) -> - try - D = beam_utils:index_labels(Is), - {function,Name,Arity,Entry,opt(Is, D, [])} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -opt([{call_ext,A,{extfunc,erlang,spawn_monitor,A}}=I0|Is0], D, Acc) - when A =:= 1; A =:= 3 -> - case ref_in_tuple(Is0) of - no -> - opt(Is0, D, [I0|Acc]); - {yes,Regs,Is1,MatchReversed} -> - %% The call creates a brand new reference. Now - %% search for a receive statement in the same - %% function that will match against the reference. - case opt_recv(Is1, Regs, D) of - no -> - opt(Is0, D, [I0|Acc]); - {yes,Is,Lbl} -> - opt(Is, D, MatchReversed++[I0,{recv_mark,{f,Lbl}}|Acc]) - end - end; -opt([{call_ext,Arity,{extfunc,erlang,Name,Arity}}=I|Is0], D, Acc) -> - case creates_new_ref(Name, Arity) of - true -> - %% The call creates a brand new reference. Now - %% search for a receive statement in the same - %% function that will match against the reference. - case opt_recv(Is0, regs_init_x0(), D) of - no -> - opt(Is0, D, [I|Acc]); - {yes,Is,Lbl} -> - opt(Is, D, [I,{recv_mark,{f,Lbl}}|Acc]) - end; - false -> - opt(Is0, D, [I|Acc]) - end; -opt([I|Is], D, Acc) -> - opt(Is, D, [I|Acc]); -opt([], _, Acc) -> - reverse(Acc). - -ref_in_tuple([{test,is_tuple,_,[{x,0}]}=I1, - {test,test_arity,_,[{x,0},2]}=I2, - {block,[{set,[_],[{x,0}],{get_tuple_element,0}}, - {set,[Dst],[{x,0}],{get_tuple_element,1}}|Bl]}=I3|Is]) -> - ref_in_tuple_1(Bl, Dst, Is, [I3,I2,I1]); -ref_in_tuple([{test,is_tuple,_,[{x,0}]}=I1, - {test,test_arity,_,[{x,0},2]}=I2, - {block,[{set,[Dst],[{x,0}],{get_tuple_element,1}}|Bl]}=I3|Is]) -> - ref_in_tuple_1(Bl, Dst, Is, [I3,I2,I1]); -ref_in_tuple(_) -> no. - -ref_in_tuple_1(Bl, Dst, Is, MatchReversed) -> - Regs0 = regs_init_singleton(Dst), - Regs = opt_update_regs_bl(Bl, Regs0), - {yes,Regs,Is,MatchReversed}. - -%% creates_new_ref(Name, Arity) -> true|false. -%% Return 'true' if the BIF Name/Arity will create a new reference. -creates_new_ref(monitor, 2) -> true; -creates_new_ref(make_ref, 0) -> true; -creates_new_ref(_, _) -> false. - -%% opt_recv([Instruction], Regs, LabelIndex) -> no|{yes,[Instruction]} -%% Search for a receive statement that will only retrieve messages -%% that contain the newly created reference (which is currently in {x,0}). -opt_recv(Is, Regs, D) -> - L = gb_sets:empty(), - opt_recv(Is, D, Regs, L, []). - -opt_recv([{label,L}=Lbl,{loop_rec,{f,Fail},_}=Loop|Is], D, R0, _, Acc) -> - R = regs_kill_not_live(0, R0), - case regs_empty(R) of - false -> - %% We now have the new reference in Y registers - %% and the current instruction is the beginning of a - %% receive statement. We must now verify that only messages - %% that contain the reference will be matched. - case opt_ref_used(Is, R, Fail, D) of - false -> - no; - true -> - RecvSet = {recv_set,{f,L}}, - {yes,reverse(Acc, [RecvSet,Lbl,Loop|Is]),L} - end; - true -> - no - end; -opt_recv([I|Is], D, R0, L0, Acc) -> - {R,L} = opt_update_regs(I, R0, L0), - case regs_empty(R) of - true -> - %% The reference is no longer alive. There is no - %% point in continuing the search. - no; - false -> - opt_recv(Is, D, R, L, [I|Acc]) - end; -opt_recv([], _, _, _, _) -> no. - -opt_update_regs({block,Bl}, R, L) -> - {opt_update_regs_bl(Bl, R),L}; -opt_update_regs({call,_,_}, R, L) -> - {regs_kill_not_live(0, R),L}; -opt_update_regs({call_ext,_,_}, R, L) -> - {regs_kill_not_live(0, R),L}; -opt_update_regs({call_fun,_}, R, L) -> - {regs_kill_not_live(0, R),L}; -opt_update_regs({kill,Y}, R, L) -> - {regs_kill([Y], R),L}; -opt_update_regs({'catch',_,{f,Lbl}}, R, L) -> - {R,gb_sets:add(Lbl, L)}; -opt_update_regs({catch_end,_}, R, L) -> - {R,L}; -opt_update_regs({label,Lbl}, R, L) -> - case gb_sets:is_member(Lbl, L) of - false -> - %% We can't allow arbitrary labels (since the receive - %% could be entered without first creating the reference). - {regs_init(),L}; - true -> - %% A catch label for a previously seen catch instruction is OK. - {R,L} - end; -opt_update_regs({'try',_,{f,Lbl}}, R, L) -> - {R,gb_sets:add(Lbl, L)}; -opt_update_regs({try_end,_}, R, L) -> - {R,L}; -opt_update_regs({line,_}, R, L) -> - {R,L}; -opt_update_regs(_I, _R, L) -> - %% Unrecognized instruction. Abort the search. - {regs_init(),L}. - -opt_update_regs_bl([{set,Ds,_,{alloc,Live,_}}|Is], Regs0) -> - Regs1 = regs_kill_not_live(Live, Regs0), - Regs = regs_kill(Ds, Regs1), - opt_update_regs_bl(Is, Regs); -opt_update_regs_bl([{set,[Dst]=Ds,[Src],move}|Is], Regs0) -> - Regs1 = regs_kill(Ds, Regs0), - Regs = case regs_is_member(Src, Regs1) of - false -> Regs1; - true -> regs_add(Dst, Regs1) - end, - opt_update_regs_bl(Is, Regs); -opt_update_regs_bl([{set,Ds,_,_}|Is], Regs0) -> - Regs = regs_kill(Ds, Regs0), - opt_update_regs_bl(Is, Regs); -opt_update_regs_bl([], Regs) -> Regs. - -%% opt_ref_used([Instruction], RefRegs, FailLabel, LabelIndex) -> true|false -%% Return 'true' if it is certain that only messages that contain the same -%% reference as in RefRegs can be matched out. Otherwise return 'false'. -%% -%% Basically, we follow all possible paths through the receive statement. -%% If all paths are safe, we return 'true'. -%% -%% A branch to FailLabel is safe, because it exits the receive statement -%% and no further message may be matched out. -%% -%% If a path hits an comparision between RefRegs and part of the message, -%% that path is safe (any messages that may be matched further down the -%% path is guaranteed to contain the reference). -%% -%% Otherwise, if we hit a 'remove_message' instruction, we give up -%% and return 'false' (the optimization is definitely unsafe). If -%% we hit an unrecognized instruction, we also give up and return -%% 'false' (the optimization may be unsafe). - -opt_ref_used(Is, RefRegs, Fail, D) -> - Done = gb_sets:singleton(Fail), - Regs = regs_init_x0(), - try - _ = opt_ref_used_1(Is, RefRegs, D, Done, Regs), - true - catch - throw:not_used -> - false - end. - -%% This functions only returns if all paths through the receive -%% statement are safe, and throws an 'not_used' term otherwise. -opt_ref_used_1([{block,Bl}|Is], RefRegs, D, Done, Regs0) -> - Regs = opt_ref_used_bl(Bl, Regs0), - opt_ref_used_1(Is, RefRegs, D, Done, Regs); -opt_ref_used_1([{test,is_eq_exact,{f,Fail},Args}|Is], - RefRegs, D, Done0, Regs) -> - Done = opt_ref_used_at(Fail, RefRegs, D, Done0, Regs), - case is_ref_msg_comparison(Args, RefRegs, Regs) of - false -> - opt_ref_used_1(Is, RefRegs, D, Done, Regs); - true -> - %% The instructions that follow (Is) can only be executed - %% if the message contains the same reference as in RefRegs. - Done - end; -opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], - RefRegs, D, Done0, Regs) -> - Done = opt_ref_used_1(Is, RefRegs, D, Done0, Regs), - case is_ref_msg_comparison(Args, RefRegs, Regs) of - false -> - opt_ref_used_at(Fail, RefRegs, D, Done, Regs); - true -> - Done - end; -opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefRegs, D, Done0, Regs) -> - Done = opt_ref_used_at(Fail, RefRegs, D, Done0, Regs), - opt_ref_used_1(Is, RefRegs, D, Done, Regs); -opt_ref_used_1([{select,_,_,{f,Fail},List}|_], RefRegs, D, Done, Regs) -> - Lbls = [F || {f,F} <- List] ++ [Fail], - opt_ref_used_in_all(Lbls, RefRegs, D, Done, Regs); -opt_ref_used_1([{label,Lbl}|Is], RefRegs, D, Done, Regs) -> - case gb_sets:is_member(Lbl, Done) of - true -> Done; - false -> opt_ref_used_1(Is, RefRegs, D, Done, Regs) - end; -opt_ref_used_1([{loop_rec_end,_}|_], _, _, Done, _) -> - Done; -opt_ref_used_1([_I|_], _RefReg, _D, _Done, _Regs) -> - %% The optimization may be unsafe. - throw(not_used). - -%% is_ref_msg_comparison(Args, RefRegs, RegisterSet) -> true|false. -%% Return 'true' if Args denotes a comparison between the -%% reference and message or part of the message. -is_ref_msg_comparison([R1,R2], RefRegs, Regs) -> - (regs_is_member(R2, RefRegs) andalso regs_is_member(R1, Regs)) orelse - (regs_is_member(R1, RefRegs) andalso regs_is_member(R2, Regs)). - -opt_ref_used_in_all([L|Ls], RefRegs, D, Done0, Regs) -> - Done = opt_ref_used_at(L, RefRegs, D, Done0, Regs), - opt_ref_used_in_all(Ls, RefRegs, D, Done, Regs); -opt_ref_used_in_all([], _, _, Done, _) -> Done. - -opt_ref_used_at(Fail, RefRegs, D, Done0, Regs) -> - case gb_sets:is_member(Fail, Done0) of - true -> - Done0; - false -> - Is = beam_utils:code_at(Fail, D), - Done = opt_ref_used_1(Is, RefRegs, D, Done0, Regs), - gb_sets:add(Fail, Done) - end. - -opt_ref_used_bl([{set,[],[],remove_message}|_], _) -> - %% We have proved that a message that does not depend on the - %% reference can be matched out. - throw(not_used); -opt_ref_used_bl([{set,Ds,Ss,_}|Is], Regs0) -> - case regs_all_members(Ss, Regs0) of - false -> - %% The destination registers may be assigned values that - %% are not dependent on the message being matched. - Regs = regs_kill(Ds, Regs0), - opt_ref_used_bl(Is, Regs); - true -> - %% All the sources depend on the message directly or - %% indirectly. - Regs = regs_add_list(Ds, Regs0), - opt_ref_used_bl(Is, Regs) - end; -opt_ref_used_bl([], Regs) -> Regs. - -%%% -%%% Functions for keeping track of a set of registers. -%%% - -%% regs_init() -> RegisterSet -%% Return an empty set of registers. - -regs_init() -> - {0,0}. - -%% regs_init_singleton(Register) -> RegisterSet -%% Return a set that only contains one register. - -regs_init_singleton(Reg) -> - regs_add(Reg, regs_init()). - -%% regs_init_x0() -> RegisterSet -%% Return a set that only contains the {x,0} register. - -regs_init_x0() -> - {1 bsl 0,0}. - -%% regs_empty(Register) -> true|false -%% Test whether the register set is empty. - -regs_empty(R) -> - R =:= {0,0}. - -%% regs_kill_not_live(Live, RegisterSet) -> RegisterSet' -%% Kill all registers indicated not live by Live. - -regs_kill_not_live(Live, {Xregs,Yregs}) -> - {Xregs band ((1 bsl Live)-1),Yregs}. - -%% regs_kill([Register], RegisterSet) -> RegisterSet' -%% Kill all registers mentioned in the list of registers. - -regs_kill([{x,N}|Rs], {Xregs,Yregs}) -> - regs_kill(Rs, {Xregs band (bnot (1 bsl N)),Yregs}); -regs_kill([{y,N}|Rs], {Xregs,Yregs}) -> - regs_kill(Rs, {Xregs,Yregs band (bnot (1 bsl N))}); -regs_kill([{fr,_}|Rs], Regs) -> - regs_kill(Rs, Regs); -regs_kill([], Regs) -> Regs. - -regs_add_list(List, Regs) -> - foldl(fun(R, A) -> regs_add(R, A) end, Regs, List). - -%% regs_add(Register, RegisterSet) -> RegisterSet' -%% Add a new register to the set of registers. - -regs_add({x,N}, {Xregs,Yregs}) -> - {Xregs bor (1 bsl N),Yregs}; -regs_add({y,N}, {Xregs,Yregs}) -> - {Xregs,Yregs bor (1 bsl N)}. - -%% regs_all_members([Register], RegisterSet) -> true|false -%% Test whether all of the registers are part of the register set. - -regs_all_members([R|Rs], Regs) -> - regs_is_member(R, Regs) andalso regs_all_members(Rs, Regs); -regs_all_members([], _) -> true. - -%% regs_is_member(Register, RegisterSet) -> true|false -%% Test whether Register is part of the register set. - -regs_is_member({x,N}, {Regs,_}) -> Regs band (1 bsl N) =/= 0; -regs_is_member({y,N}, {_,Regs}) -> Regs band (1 bsl N) =/= 0; -regs_is_member(_, _) -> false. diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl deleted file mode 100644 index 58a6de6775..0000000000 --- a/lib/compiler/src/beam_record.erl +++ /dev/null @@ -1,131 +0,0 @@ -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2014-2017. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% Rewrite the instruction stream on tagged tuple tests. -%% Tagged tuples means a tuple of any arity with an atom as its -%% first element, such as records and error tuples. -%% -%% From: -%% ... -%% {test,is_tuple,Fail,[Src]}. -%% {test,test_arity,Fail,[Src,Sz]}. -%% ... -%% {get_tuple_element,Src,0,Dst}. -%% ... -%% {test,is_eq_exact,Fail,[Dst,Atom]}. -%% ... -%% To: -%% ... -%% {test,is_tagged_tuple,Fail,[Src,Sz,Atom]}. -%% ... -%% - --module(beam_record). --export([module/2]). - --import(lists, [reverse/1,reverse/2]). - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - try - Is1 = beam_utils:anno_defs(Is0), - Idx = beam_utils:index_labels(Is1), - Is = rewrite(reverse(Is1), Idx), - {function,Name,Arity,CLabel,Is} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -rewrite(Is, Idx) -> - rewrite(Is, Idx, 0, []). - -rewrite([{test,test_arity,Fail,[Src,N]}=TA, - {test,is_tuple,Fail,[Src]}=TT|Is], Idx, Def, Acc0) -> - case is_tagged_tuple(Acc0, Def, Fail, Src, Idx) of - no -> - rewrite(Is, Idx, 0, [TT,TA|Acc0]); - {yes,Atom,Acc} -> - I = {test,is_tagged_tuple,Fail,[Src,N,Atom]}, - rewrite(Is, Idx, Def, [I|Acc]) - end; -rewrite([{block,[{'%anno',{def,Def}}|Bl]}|Is], Idx, _Def, Acc) -> - rewrite(Is, Idx, Def, [{block,Bl}|Acc]); -rewrite([{label,L}=I|Is], Idx0, Def, Acc) -> - Idx = beam_utils:index_label(L, Acc, Idx0), - rewrite(Is, Idx, Def, [I|Acc]); -rewrite([I|Is], Idx, Def, Acc) -> - rewrite(Is, Idx, Def, [I|Acc]); -rewrite([], _, _, Acc) -> Acc. - -is_tagged_tuple([{block,Bl}, - {test,is_eq_exact,Fail,[Dst,{atom,_}=Atom]}|Is], - Def, Fail, Src, Idx) -> - case is_tagged_tuple_1(Bl, Is, Fail, Src, Dst, Idx, Def, []) of - no -> - no; - {yes,[]} -> - {yes,Atom,Is}; - {yes,[_|_]=Block} -> - {yes,Atom,[{block,Block}|Is]} - end; -is_tagged_tuple(_, _, _, _, _) -> - no. - -is_tagged_tuple_1([{set,[Dst],[Src],{get_tuple_element,0}}=I|Bl], - Is, Fail, Src, Dst, Idx, Def, Acc) -> - %% Check usage of Dst to find out whether the get_tuple_element - %% is needed. - case usage(Dst, Is, Fail, Idx) of - killed -> - %% Safe to remove the get_tuple_element instruction. - {yes,reverse(Acc, Bl)}; - used -> - %% Actively used. Must keep instruction. - {yes,reverse(Acc, [I|Bl])}; - not_used -> - %% Not actually used (but must be initialized). - case is_defined(Dst, Def) of - false -> - %% Dst must be initialized, but the - %% actual value does not matter. - Kill = {set,[Dst],[nil],move}, - {yes,reverse(Acc, [Kill|Bl])}; - true -> - %% The register is previously initialized. - %% We can remove the instruction. - {yes,reverse(Acc, Bl)} - end - end; -is_tagged_tuple_1([I|Bl], Is, Fail, Src, Dst, Idx, Def, Acc) -> - is_tagged_tuple_1(Bl, Is, Fail, Src, Dst, Idx, Def, [I|Acc]); -is_tagged_tuple_1(_, _, _, _, _, _, _, _) -> - no. - -usage(Dst, Is, Fail, Idx) -> - beam_utils:usage(Dst, [{test,is_number,Fail,[nil]}|Is], Idx). - -is_defined({x,X}, Def) -> - (Def bsr X) band 1 =:= 1. diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl deleted file mode 100644 index 8d2ef5a431..0000000000 --- a/lib/compiler/src/beam_reorder.erl +++ /dev/null @@ -1,150 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(beam_reorder). - --export([module/2]). --import(lists, [member/2,reverse/1]). - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - try - Is = reorder(Is0), - {function,Name,Arity,CLabel,Is} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%% reorder(Instructions0) -> Instructions -%% Reorder instructions before the beam_block pass, because reordering -%% will be more cumbersome when the blocks are in place. -%% -%% Execution of get_tuple_element instructions can be delayed until -%% they are actually needed. Consider the sequence: -%% -%% get_tuple_element Tuple Pos Dst -%% test Test Fail Operands -%% -%% If Dst is killed at label Fail (and not referenced in Operands), -%% we can can swap the instructions: -%% -%% test Test Fail Operands -%% get_tuple_element Tuple Pos Dst -%% -%% That can be beneficial in two ways: Firstly, if the branch is taken -%% we have avoided execution of the get_tuple_element instruction. -%% Secondly, even if the branch is not taken, subsequent optimization -%% (opt_blocks/1) may be able to change Dst to the final destination -%% register and eliminate a 'move' instruction. - -reorder(Is) -> - D = beam_utils:index_labels(Is), - reorder_1(Is, D, []). - -reorder_1([{Op,_,_}=TryCatch|[I|Is]=Is0], D, Acc) - when Op =:= 'catch'; Op =:= 'try' -> - %% Don't allow 'try' or 'catch' instructions to split blocks if - %% it can be avoided. - case is_safe(I) of - false -> - reorder_1(Is0, D, [TryCatch|Acc]); - true -> - reorder_1([TryCatch|Is], D, [I|Acc]) - end; -reorder_1([{label,L}=I|_], D, Acc) -> - Is = beam_utils:code_at(L, D), - reorder_1(Is, D, [I|Acc]); -reorder_1([{test,is_nonempty_list,_,_}=I|Is], D, Acc) -> - %% The run-time system may combine the is_nonempty_list test with - %% the following get_list instruction. - reorder_1(Is, D, [I|Acc]); -reorder_1([{test,_,_,_}=I, - {select,_,_,_,_}=S|Is], D, Acc) -> - %% There is nothing to gain by inserting a get_tuple_element - %% instruction between the test instruction and the select - %% instruction. - reorder_1(Is, D, [S,I|Acc]); -reorder_1([{test,_,{f,_},[Src|_]}=I|Is], D, - [{get_tuple_element,Src,_,_}|_]=Acc) -> - %% We want to avoid code that can confuse beam_validator such as: - %% is_tuple Fail Src - %% test_arity Fail Src Arity - %% is_map Fail Src - %% get_tuple_element Src Pos Dst - %% Therefore, don't reorder the instructions in such cases. - reorder_1(Is, D, [I|Acc]); -reorder_1([{test,_,{f,L},Ss}=I|Is0], D0, - [{get_tuple_element,_,_,El}=G|Acc0]=Acc) -> - case member(El, Ss) of - true -> - reorder_1(Is0, D0, [I|Acc]); - false -> - case beam_utils:is_killed_at(El, L, D0) of - true -> - Is = [I,G|Is0], - reorder_1(Is, D0, Acc0); - false -> - case beam_utils:is_killed(El, Is0, D0) of - true -> - Code0 = beam_utils:code_at(L, D0), - Code = [G|Code0], - D = beam_utils:index_label(L, Code, D0), - Is = [I|Is0], - reorder_1(Is, D, Acc0); - false -> - reorder_1(Is0, D0, [I|Acc]) - end - end - end; -reorder_1([{allocate_zero,N,Live}=I0|Is], D, - [{get_tuple_element,{x,Tup},_,{x,Dst}}=G|Acc]=Acc0) -> - case Tup < Dst andalso Dst+1 =:= Live of - true -> - %% Move allocation instruction upwards past - %% get_tuple_element instructions to create more - %% opportunities for moving get_tuple_element - %% instructions. - I = {allocate_zero,N,Dst}, - reorder_1([I,G|Is], D, Acc); - false -> - reorder_1(Is, D, [I0|Acc0]) - end; -reorder_1([I|Is], D, Acc) -> - reorder_1(Is, D, [I|Acc]); -reorder_1([], _, Acc) -> reverse(Acc). - -%% is_safe(Instruction) -> true|false -%% Test whether an instruction is safe (cannot cause an exception). - -is_safe({kill,_}) -> true; -is_safe({move,_,_}) -> true; -is_safe({put,_}) -> true; -is_safe({put_list,_,_,_}) -> true; -is_safe({put_tuple,_,_}) -> true; -is_safe({test_heap,_,_}) -> true; -is_safe(_) -> false. diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index 809e49b3d0..7b18946ae0 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -44,10 +44,6 @@ split_blocks([I|Is], Acc) -> split_blocks(Is, [I|Acc]); split_blocks([], Acc) -> reverse(Acc). -split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) -> - %% is_record/3 must be translated by beam_clean; therefore, - %% it must be outside of any block. - split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]); split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]); split_block([{set,[],[],{line,_}=Line}, diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl new file mode 100644 index 0000000000..a2766a0501 --- /dev/null +++ b/lib/compiler/src/beam_ssa.erl @@ -0,0 +1,616 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose: Type definitions and utilities for the SSA format. + +-module(beam_ssa). +-export([add_anno/3,get_anno/2, + clobbers_xregs/1,def/2,def_used/2,dominators/1, + flatmapfold_instrs_rpo/4, + fold_po/3,fold_po/4,fold_rpo/3,fold_rpo/4, + fold_instrs_rpo/4, + linearize/1, + mapfold_instrs_rpo/4, + predecessors/1, + rename_vars/3, + rpo/1,rpo/2, + split_blocks/3, + successors/1,successors/2, + update_phi_labels/4,used/1]). + +-export_type([b_module/0,b_function/0,b_blk/0,b_set/0, + b_ret/0,b_br/0,b_switch/0,terminator/0, + b_var/0,b_literal/0,b_remote/0,b_local/0, + value/0,argument/0,label/0, + var_name/0,var_base/0,literal_value/0, + op/0,anno/0,block_map/0]). + +-include("beam_ssa.hrl"). + +-type b_module() :: #b_module{}. +-type b_function() :: #b_function{}. +-type b_blk() :: #b_blk{}. +-type b_set() :: #b_set{}. + +-type b_br() :: #b_br{}. +-type b_ret() :: #b_ret{}. +-type b_switch() :: #b_switch{}. +-type terminator() :: b_br() | b_ret() | b_switch(). + +-type b_var() :: #b_var{}. +-type b_literal() :: #b_literal{}. +-type b_remote() :: #b_remote{}. +-type b_local() :: #b_local{}. + +-type value() :: b_var() | b_literal(). +-type phi_value() :: {value(),label()}. +-type argument() :: value() | b_remote() | b_local() | phi_value(). +-type label() :: non_neg_integer(). + +-type var_name() :: var_base() | {var_base(),non_neg_integer()}. +-type var_base() :: atom() | non_neg_integer(). + +-type literal_value() :: atom() | integer() | float() | list() | + nil() | tuple() | map() | binary(). + +-type op() :: {'bif',atom()} | {'float',float_op()} | prim_op() | cg_prim_op(). +-type anno() :: #{atom() := any()}. + +-type block_map() :: #{label():=b_blk()}. + +%% Note: By default, dialyzer will collapse this type to atom(). +%% To avoid the collapsing, change the value of SET_LIMIT to 50 in the +%% file erl_types.erl in the hipe application. + +-type prim_op() :: 'bs_add' | 'bs_extract' | 'bs_init' | 'bs_init_writable' | + 'bs_match' | 'bs_put' | 'bs_start_match' | 'bs_test_tail' | + 'bs_utf16_size' | 'bs_utf8_size' | 'build_stacktrace' | + 'call' | 'catch_end' | 'context_to_binary' | + 'extract' | + 'get_hd' | 'get_map_element' | 'get_tl' | 'get_tuple_element' | + 'has_map_field' | + 'is_nonempty_list' | 'is_tagged_tuple' | + 'kill_try_tag' | + 'landingpad' | + 'make_fun' | 'new_try_tag' | + 'peek_message' | 'phi' | 'put_list' | 'put_map' | 'put_tuple' | + 'raw_raise' | 'recv_next' | 'remove_message' | 'resume' | + 'set_tuple_element' | 'succeeded' | + 'timeout' | + 'wait' | 'wait_timeout'. + +-type float_op() :: 'checkerror' | 'clearerror' | 'convert' | 'get' | 'put' | + '+' | '-' | '*' | '/'. + +%% Primops only used internally during code generation. +-type cg_prim_op() :: 'bs_get' | 'bs_match_string' | 'bs_restore' | 'bs_skip' | +'copy' | 'put_tuple_arity' | 'put_tuple_element'. + +-import(lists, [foldl/3,mapfoldl/3,reverse/1]). + +-spec add_anno(Key, Value, Construct) -> Construct when + Key :: atom(), + Value :: any(), + Construct :: b_function() | b_blk() | b_set() | terminator(). + +add_anno(Key, Val, #b_function{anno=Anno}=Bl) -> + Bl#b_function{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_blk{anno=Anno}=Bl) -> + Bl#b_blk{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_set{anno=Anno}=Bl) -> + Bl#b_set{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_br{anno=Anno}=Bl) -> + Bl#b_br{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_ret{anno=Anno}=Bl) -> + Bl#b_ret{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_switch{anno=Anno}=Bl) -> + Bl#b_switch{anno=Anno#{Key=>Val}}. + +-spec get_anno(atom(), b_blk()|b_set()|terminator()) -> any(). + +get_anno(Key, Construct) -> + maps:get(Key, get_anno(Construct)). + +get_anno(#b_blk{anno=Anno}) -> Anno; +get_anno(#b_set{anno=Anno}) -> Anno; +get_anno(#b_br{anno=Anno}) -> Anno; +get_anno(#b_ret{anno=Anno}) -> Anno; +get_anno(#b_switch{anno=Anno}) -> Anno. + +%% clobbers_xregs(#b_set{}) -> true|false. +%% Test whether the instruction invalidates all X registers. + +-spec clobbers_xregs(b_set()) -> boolean(). + +clobbers_xregs(#b_set{op=Op}) -> + case Op of + bs_init_writable -> true; + build_stacktrace -> true; + call -> true; + landingpad -> true; + make_fun -> true; + peek_message -> true; + raw_raise -> true; + _ -> false + end. + +-spec predecessors(Blocks) -> #{BlockNumber:=[Predecessor]} when + Blocks :: block_map(), + BlockNumber :: label(), + Predecessor :: label(). + +predecessors(Blocks) -> + P0 = [{S,L} || {L,Blk} <- maps:to_list(Blocks), + S <- successors(Blk)], + P1 = sofs:relation(P0), + P2 = sofs:rel2fam(P1), + P3 = sofs:to_external(P2), + P = [{0,[]}|P3], + maps:from_list(P). + +-spec successors(b_blk()) -> [label()]. + +successors(#b_blk{last=Terminator}) -> + case Terminator of + #b_br{bool=#b_literal{val=true},succ=Succ} -> + [Succ]; + #b_br{bool=#b_literal{val=false},fail=Fail} -> + [Fail]; + #b_br{succ=Succ,fail=Fail} -> + [Fail,Succ]; + #b_switch{fail=Fail,list=List} -> + [Fail|[L || {_,L} <- List]]; + #b_ret{} -> + [] + end. + +-spec successors(label(), block_map()) -> [label()]. + +successors(L, Blocks) -> + successors(maps:get(L, Blocks)). + +-spec def(Ls, Blocks) -> Def when + Ls :: [label()], + Blocks :: block_map(), + Def :: ordsets:ordset(var_name()). + +def(Ls, Blocks) -> + Top = rpo(Ls, Blocks), + Blks = [maps:get(L, Blocks) || L <- Top], + def_1(Blks, []). + +-spec def_used(Ls, Blocks) -> {Def,Used} when + Ls :: [label()], + Blocks :: block_map(), + Def :: ordsets:ordset(var_name()), + Used :: ordsets:ordset(var_name()). + +def_used(Ls, Blocks) -> + Top = rpo(Ls, Blocks), + Blks = [maps:get(L, Blocks) || L <- Top], + Preds = gb_sets:from_list(Top), + def_used_1(Blks, Preds, [], gb_sets:empty()). + +-spec dominators(Blocks) -> Result when + Blocks :: block_map(), + Result :: #{label():=ordsets:ordset(label())}. + +dominators(Blocks) -> + Preds = predecessors(Blocks), + Top0 = rpo(Blocks), + Top = [{L,maps:get(L, Preds)} || L <- Top0], + + %% The flow graph for an Erlang function is reducible, and + %% therefore one traversal in reverse postorder is sufficient. + iter_dominators(Top, #{}). + +-spec fold_instrs_rpo(Fun, From, Acc0, Blocks) -> any() when + Fun :: fun((b_blk()|terminator(), any()) -> any()), + From :: [label()], + Acc0 :: any(), + Blocks :: block_map(). + +fold_instrs_rpo(Fun, From, Acc0, Blocks) -> + Top = rpo(From, Blocks), + fold_instrs_rpo_1(Top, Fun, Blocks, Acc0). + +-spec mapfold_instrs_rpo(Fun, From, Acc0, Blocks0) -> {Blocks,Acc} when + Fun :: fun((b_blk()|terminator(), any()) -> any()), + From :: [label()], + Acc0 :: any(), + Acc :: any(), + Blocks0 :: block_map(), + Blocks :: block_map(). + +mapfold_instrs_rpo(Fun, From, Acc0, Blocks) -> + Top = rpo(From, Blocks), + mapfold_instrs_rpo_1(Top, Fun, Blocks, Acc0). + +-spec flatmapfold_instrs_rpo(Fun, From, Acc0, Blocks0) -> {Blocks,Acc} when + Fun :: fun((b_blk()|terminator(), any()) -> any()), + From :: [label()], + Acc0 :: any(), + Acc :: any(), + Blocks0 :: block_map(), + Blocks :: block_map(). + +flatmapfold_instrs_rpo(Fun, From, Acc0, Blocks) -> + Top = rpo(From, Blocks), + flatmapfold_instrs_rpo_1(Top, Fun, Blocks, Acc0). + +-type fold_fun() :: fun((label(), b_blk(), any()) -> any()). + +%% fold_rpo(Fun, [Label], Acc0, Blocks) -> Acc. +%% Fold over all blocks a reverse postorder traversal of the block +%% graph; that is, first visit a block, then visit its successors. + +-spec fold_rpo(Fun, Acc0, Blocks) -> any() when + Fun :: fold_fun(), + Acc0 :: any(), + Blocks :: #{label():=b_blk()}. + +fold_rpo(Fun, Acc0, Blocks) -> + fold_rpo(Fun, [0], Acc0, Blocks). + +%% fold_rpo(Fun, [Label], Acc0, Blocks) -> Acc. Fold over all blocks +%% reachable from a given set of labels in a reverse postorder +%% traversal of the block graph; that is, first visit a block, then +%% visit its successors. + +-spec fold_rpo(Fun, Labels, Acc0, Blocks) -> any() when + Fun :: fold_fun(), + Labels :: [label()], + Acc0 :: any(), + Blocks :: #{label():=b_blk()}. + +fold_rpo(Fun, From, Acc0, Blocks) -> + Top = rpo(From, Blocks), + fold_rpo_1(Top, Fun, Blocks, Acc0). + +%% fold_po(Fun, Acc0, Blocks) -> Acc. +%% Fold over all blocks in a postorder traversal of the block graph; +%% that is, first visit all successors of block, then the block +%% itself. + +-spec fold_po(Fun, Acc0, Blocks) -> any() when + Fun :: fold_fun(), + Acc0 :: any(), + Blocks :: #{label():=b_blk()}. + +%% fold_po(Fun, From, Acc0, Blocks) -> Acc. +%% Fold over the blocks reachable from the block numbers given +%% by From in a postorder traversal of the block graph. + +fold_po(Fun, Acc0, Blocks) -> + fold_po(Fun, [0], Acc0, Blocks). + +-spec fold_po(Fun, Labels, Acc0, Blocks) -> any() when + Fun :: fold_fun(), + Labels :: [label()], + Acc0 :: any(), + Blocks :: block_map(). + +fold_po(Fun, From, Acc0, Blocks) -> + Top = reverse(rpo(From, Blocks)), + fold_rpo_1(Top, Fun, Blocks, Acc0). + +%% linearize(Blocks) -> [{BlockLabel,#b_blk{}}]. +%% Linearize the intermediate representation of the code. + +-spec linearize(Blocks) -> Linear when + Blocks :: block_map(), + Linear :: [{label(),b_blk()}]. + +linearize(Blocks) -> + Seen = gb_sets:empty(), + {Linear,_} = linearize_1([0], Blocks, Seen, []), + Linear. + +-spec rpo(Blocks) -> [Label] when + Blocks :: block_map(), + Label :: label(). + +rpo(Blocks) -> + rpo([0], Blocks). + +-spec rpo(From, Blocks) -> Labels when + From :: [label()], + Blocks :: block_map(), + Labels :: [label()]. + +rpo(From, Blocks) -> + Seen = gb_sets:empty(), + {Ls,_} = rpo_1(From, Blocks, Seen, []), + Ls. + +-spec rename_vars(Rename, [label()], block_map()) -> block_map() when + Rename :: [{var_name(),value()}] | #{var_name():=value()}. + +rename_vars(Rename, From, Blocks) when is_list(Rename) -> + rename_vars(maps:from_list(Rename), From, Blocks); +rename_vars(Rename, From, Blocks) when is_map(Rename)-> + Top = rpo(From, Blocks), + Preds = gb_sets:from_list(Top), + F = fun(#b_set{op=phi,args=Args0}=Set) -> + Args = rename_phi_vars(Args0, Preds, Rename), + Set#b_set{args=Args}; + (#b_set{args=Args0}=Set) -> + Args = [rename_var(A, Rename) || A <- Args0], + Set#b_set{args=Args}; + (#b_switch{arg=Bool}=Sw) -> + Sw#b_switch{arg=rename_var(Bool, Rename)}; + (#b_br{bool=Bool}=Br) -> + Br#b_br{bool=rename_var(Bool, Rename)}; + (#b_ret{arg=Arg}=Ret) -> + Ret#b_ret{arg=rename_var(Arg, Rename)} + end, + map_instrs_1(Top, F, Blocks). + +%% split_blocks(Predicate, Blocks0, Count0) -> {Blocks,Count}. +%% Call Predicate(Instruction) for each instruction in all +%% blocks. If Predicate/1 returns true, split the block +%% before this instruction. + +-spec split_blocks(Pred, Blocks0, Count0) -> {Blocks,Count} when + Pred :: fun((b_set()) -> boolean()), + Blocks :: block_map(), + Count0 :: beam_ssa:label(), + Blocks0 :: block_map(), + Blocks :: block_map(), + Count :: beam_ssa:label(). + +split_blocks(P, Blocks, Count) -> + Ls = beam_ssa:rpo(Blocks), + split_blocks_1(Ls, P, Blocks, Count). + +%% update_phi_labels([BlockLabel], Old, New, Blocks0) -> Blocks. +%% In the given blocks, replace label Old in with New in all +%% phi nodes. This is useful after merging or splitting +%% blocks. + +-spec update_phi_labels(From, Old, New, Blocks0) -> Blocks when + From :: [label()], + Old :: label(), + New :: label(), + Blocks0 :: block_map(), + Blocks :: block_map(). + +update_phi_labels([L|Ls], Old, New, Blocks0) -> + case Blocks0 of + #{L:=#b_blk{is=[#b_set{op=phi}|_]=Is0}=Blk0} -> + Is = update_phi_labels_is(Is0, Old, New), + Blk = Blk0#b_blk{is=Is}, + Blocks = Blocks0#{L:=Blk}, + update_phi_labels(Ls, Old, New, Blocks); + #{L:=#b_blk{}} -> + %% No phi nodes in this block. + update_phi_labels(Ls, Old, New, Blocks0) + end; +update_phi_labels([], _, _, Blocks) -> Blocks. + +-spec used(b_blk() | b_set() | terminator()) -> [var_name()]. + +used(#b_blk{is=Is,last=Last}) -> + used_1([Last|Is], ordsets:new()); +used(#b_br{bool=#b_var{name=V}}) -> + [V]; +used(#b_ret{arg=#b_var{name=V}}) -> + [V]; +used(#b_set{op=phi,args=Args}) -> + ordsets:from_list([V || {#b_var{name=V},_} <- Args]); +used(#b_set{args=Args}) -> + ordsets:from_list(used_args(Args)); +used(#b_switch{arg=#b_var{name=V}}) -> + [V]; +used(_) -> []. + +%%% +%%% Internal functions. +%%% + +def_used_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, Used0) -> + {Def,Used1} = def_used_is(Is, Preds, Def0, Used0), + Used = gb_sets:union(gb_sets:from_list(used(Last)), Used1), + def_used_1(Bs, Preds, Def, Used); +def_used_1([], _Preds, Def, Used) -> + {ordsets:from_list(Def),gb_sets:to_list(Used)}. + +def_used_is([#b_set{op=phi,dst=#b_var{name=Dst},args=Args}|Is], + Preds, Def0, Used0) -> + Def = [Dst|Def0], + %% We must be careful to only include variables that will + %% be used when arriving from one of the predecessor blocks + %% in Preds. + Used1 = [V || {#b_var{name=V},L} <- Args, + gb_sets:is_member(L, Preds)], + Used = gb_sets:union(gb_sets:from_list(Used1), Used0), + def_used_is(Is, Preds, Def, Used); +def_used_is([#b_set{dst=#b_var{name=Dst}}=I|Is], Preds, Def0, Used0) -> + Def = [Dst|Def0], + Used = gb_sets:union(gb_sets:from_list(used(I)), Used0), + def_used_is(Is, Preds, Def, Used); +def_used_is([], _Preds, Def, Used) -> + {Def,Used}. + +def_1([#b_blk{is=Is}|Bs], Def0) -> + Def = def_is(Is, Def0), + def_1(Bs, Def); +def_1([], Def) -> + ordsets:from_list(Def). + +def_is([#b_set{dst=#b_var{name=Dst}}|Is], Def) -> + def_is(Is, [Dst|Def]); +def_is([], Def) -> Def. + +iter_dominators([{0,[]}|Ls], _Doms) -> + Dom = [0], + iter_dominators(Ls, #{0=>Dom}); +iter_dominators([{L,Preds}|Ls], Doms) -> + DomPreds = [maps:get(P, Doms) || P <- Preds, maps:is_key(P, Doms)], + Dom = ordsets:add_element(L, ordsets:intersection(DomPreds)), + iter_dominators(Ls, Doms#{L=>Dom}); +iter_dominators([], Doms) -> Doms. + +fold_rpo_1([L|Ls], Fun, Blocks, Acc0) -> + Block = maps:get(L, Blocks), + Acc = Fun(L, Block, Acc0), + fold_rpo_1(Ls, Fun, Blocks, Acc); +fold_rpo_1([], _, _, Acc) -> Acc. + +fold_instrs_rpo_1([L|Ls], Fun, Blocks, Acc0) -> + #b_blk{is=Is,last=Last} = maps:get(L, Blocks), + Acc1 = foldl(Fun, Acc0, Is), + Acc = Fun(Last, Acc1), + fold_instrs_rpo_1(Ls, Fun, Blocks, Acc); +fold_instrs_rpo_1([], _, _, Acc) -> Acc. + +mapfold_instrs_rpo_1([L|Ls], Fun, Blocks0, Acc0) -> + #b_blk{is=Is0,last=Last0} = Block0 = maps:get(L, Blocks0), + {Is,Acc1} = mapfoldl(Fun, Acc0, Is0), + {Last,Acc} = Fun(Last0, Acc1), + Block = Block0#b_blk{is=Is,last=Last}, + Blocks = maps:put(L, Block, Blocks0), + mapfold_instrs_rpo_1(Ls, Fun, Blocks, Acc); +mapfold_instrs_rpo_1([], _, Blocks, Acc) -> + {Blocks,Acc}. + +flatmapfold_instrs_rpo_1([L|Ls], Fun, Blocks0, Acc0) -> + #b_blk{is=Is0,last=Last0} = Block0 = maps:get(L, Blocks0), + {Is,Acc1} = flatmapfoldl(Fun, Acc0, Is0), + {[Last],Acc} = Fun(Last0, Acc1), + Block = Block0#b_blk{is=Is,last=Last}, + Blocks = maps:put(L, Block, Blocks0), + flatmapfold_instrs_rpo_1(Ls, Fun, Blocks, Acc); +flatmapfold_instrs_rpo_1([], _, Blocks, Acc) -> + {Blocks,Acc}. + +linearize_1([L|Ls], Blocks, Seen0, Acc0) -> + case gb_sets:is_member(L, Seen0) of + true -> + linearize_1(Ls, Blocks, Seen0, Acc0); + false -> + Seen1 = gb_sets:insert(L, Seen0), + Block = maps:get(L, Blocks), + Successors = successors(Block), + {Acc,Seen} = linearize_1(Successors, Blocks, Seen1, Acc0), + linearize_1(Ls, Blocks, Seen, [{L,Block}|Acc]) + end; +linearize_1([], _, Seen, Acc) -> + {Acc,Seen}. + +rpo_1([L|Ls], Blocks, Seen0, Acc0) -> + case gb_sets:is_member(L, Seen0) of + true -> + rpo_1(Ls, Blocks, Seen0, Acc0); + false -> + Block = maps:get(L, Blocks), + Seen1 = gb_sets:insert(L, Seen0), + Successors = successors(Block), + {Acc,Seen} = rpo_1(Successors, Blocks, Seen1, Acc0), + rpo_1(Ls, Blocks, Seen, [L|Acc]) + end; +rpo_1([], _, Seen, Acc) -> + {Acc,Seen}. + +rename_var(#b_var{name=Old}=V, Rename) -> + case Rename of + #{Old:=New} -> New; + #{} -> V + end; +rename_var(#b_remote{mod=Mod0,name=Name0}=Remote, Rename) -> + Mod = rename_var(Mod0, Rename), + Name = rename_var(Name0, Rename), + Remote#b_remote{mod=Mod,name=Name}; +rename_var(Old, _) -> Old. + +rename_phi_vars([{Var,L}|As], Preds, Ren) -> + case gb_sets:is_member(L, Preds) of + true -> + [{rename_var(Var, Ren),L}|rename_phi_vars(As, Preds, Ren)]; + false -> + [{Var,L}|rename_phi_vars(As, Preds, Ren)] + end; +rename_phi_vars([], _, _) -> []. + +map_instrs_1([L|Ls], Fun, Blocks0) -> + #b_blk{is=Is0,last=Last0} = Blk0 = maps:get(L, Blocks0), + Is = [Fun(I) || I <- Is0], + Last = Fun(Last0), + Blk = Blk0#b_blk{is=Is,last=Last}, + Blocks = maps:put(L, Blk, Blocks0), + map_instrs_1(Ls, Fun, Blocks); +map_instrs_1([], _, Blocks) -> Blocks. + +flatmapfoldl(F, Accu0, [Hd|Tail]) -> + {R,Accu1} = F(Hd, Accu0), + {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), + {R++Rs,Accu2}; +flatmapfoldl(_, Accu, []) -> {[],Accu}. + +split_blocks_1([L|Ls], P, Blocks0, Count0) -> + #b_blk{is=Is0} = Blk = maps:get(L, Blocks0), + case split_blocks_is(Is0, P, []) of + {yes,Bef,Aft} -> + NewLbl = Count0, + Count = Count0 + 1, + Br = #b_br{bool=#b_literal{val=true},succ=NewLbl,fail=NewLbl}, + BefBlk = Blk#b_blk{is=Bef,last=Br}, + NewBlk = Blk#b_blk{is=Aft}, + Blocks1 = Blocks0#{L:=BefBlk,NewLbl=>NewBlk}, + Successors = beam_ssa:successors(NewBlk), + Blocks = beam_ssa:update_phi_labels(Successors, L, NewLbl, Blocks1), + split_blocks_1([NewLbl|Ls], P, Blocks, Count); + no -> + split_blocks_1(Ls, P, Blocks0, Count0) + end; +split_blocks_1([], _, Blocks, Count) -> + {Blocks,Count}. + +split_blocks_is([I|Is], P, []) -> + split_blocks_is(Is, P, [I]); +split_blocks_is([I|Is], P, Acc) -> + case P(I) of + true -> + {yes,reverse(Acc),[I|Is]}; + false -> + split_blocks_is(Is, P, [I|Acc]) + end; +split_blocks_is([], _, _) -> no. + +update_phi_labels_is([#b_set{op=phi,args=Args0}=I0|Is], Old, New) -> + Args = [{Arg,rename_label(Lbl, Old, New)} || {Arg,Lbl} <- Args0], + I = I0#b_set{args=Args}, + [I|update_phi_labels_is(Is, Old, New)]; +update_phi_labels_is(Is, _, _) -> Is. + +rename_label(Old, Old, New) -> New; +rename_label(Lbl, _Old, _New) -> Lbl. + +used_args([#b_var{name=V}|As]) -> + [V|used_args(As)]; +used_args([#b_remote{mod=Mod,name=Name}|As]) -> + used_args([Mod,Name|As]); +used_args([_|As]) -> + used_args(As); +used_args([]) -> []. + +used_1([H|T], Used0) -> + Used = ordsets:union(used(H), Used0), + used_1(T, Used); +used_1([], Used) -> Used. diff --git a/lib/compiler/src/beam_ssa.hrl b/lib/compiler/src/beam_ssa.hrl new file mode 100644 index 0000000000..fa76b08453 --- /dev/null +++ b/lib/compiler/src/beam_ssa.hrl @@ -0,0 +1,66 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-record(b_module, {anno=#{} :: beam_ssa:anno(), + name :: module(), + exports :: [{atom(),arity()}], + attributes :: list(), + body :: [beam_ssa:b_function()]}). +-record(b_function, {anno=#{} :: beam_ssa:anno(), + args :: [beam_ssa:b_var()], + bs :: #{beam_ssa:label():=beam_ssa:b_blk()}, + cnt :: beam_ssa:label()}). + +-record(b_blk, {anno=#{} :: beam_ssa:anno(), + is :: [beam_ssa:b_set()], + last :: beam_ssa:terminator()}). +-record(b_set, {anno=#{} :: beam_ssa:anno(), + dst=none :: 'none'|beam_ssa:b_var(), + op :: beam_ssa:op(), + args=[] :: [beam_ssa:argument()]}). + +%% Terminators. +-record(b_ret, {anno=#{} :: beam_ssa:anno(), + arg :: beam_ssa:value()}). + +-record(b_br, {anno=#{}, + bool :: beam_ssa:value(), + succ :: beam_ssa:label(), + fail :: beam_ssa:label()}). + +-record(b_switch, {anno=#{} :: beam_ssa:anno(), + arg :: beam_ssa:value(), + fail :: beam_ssa:label(), + list :: [{beam_ssa:b_literal(),beam_ssa:label()}]}). + +%% Values. +-record(b_var, {name :: beam_ssa:var_name()}). + +-record(b_literal, {val :: beam_ssa:literal_value()}). + +-record(b_remote, {mod :: beam_ssa:value(), + name :: beam_ssa:value(), + arity :: non_neg_integer()}). + +-record(b_local, {name :: beam_ssa:b_literal(), + arity :: non_neg_integer()}). + +%% If this block exists, it calls erlang:error(badarg). +-define(BADARG_BLOCK, 1). diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl new file mode 100644 index 0000000000..006c41c0e0 --- /dev/null +++ b/lib/compiler/src/beam_ssa_codegen.erl @@ -0,0 +1,1831 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose: Generate BEAM assembly code from the SSA format. + +-module(beam_ssa_codegen). + +-export([module/2]). +-export([classify_heap_need/2]). %Called from beam_ssa_pre_codegen. + +-export_type([ssa_register/0]). + +-include("beam_ssa.hrl"). + +-import(lists, [foldl/3,keymember/3,keysort/2,last/1,map/2,mapfoldl/3, + reverse/1,reverse/2,sort/1,splitwith/2,takewhile/2]). + +-record(cg, {lcount=1 :: beam_label(), %Label counter + functable=#{} :: #{fa()=>beam_label()}, + labels=#{} :: #{ssa_label()=>0|beam_label()}, + used_labels=gb_sets:empty() :: gb_sets:set(ssa_label()), + regs=#{} :: #{beam_ssa:var_name()=>ssa_register()}, + ultimate_fail=1 :: beam_label(), + catches=gb_sets:empty() :: gb_sets:set(ssa_label()) + }). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_asm:module_code()}. + +module(#b_module{name=Mod,exports=Es,attributes=Attrs,body=Fs}, _Opts) -> + {Asm,St} = functions(Fs, {atom,Mod}), + {ok,{Mod,Es,Attrs,Asm,St#cg.lcount}}. + +-record(need, {h=0 :: non_neg_integer(), + f=0 :: non_neg_integer()}). + +-record(cg_blk, {anno=#{} :: anno(), + is=[] :: [instruction()], + last :: terminator()}). + +-record(cg_set, {anno=#{} :: anno(), + dst :: b_var(), + op :: beam_ssa:op(), + args :: [beam_ssa:argument() | xreg()]}). + +-record(cg_alloc, {anno=#{} :: anno(), + stack=none :: 'none' | pos_integer(), + words=#need{} :: #need{}, + live :: 'undefined' | pos_integer(), + def_yregs=[] :: [yreg()] + }). + +-record(cg_br, {bool :: beam_ssa:value(), + succ :: ssa_label(), + fail :: ssa_label() + }). +-record(cg_ret, {arg :: cg_value(), + dealloc=none :: 'none' | pos_integer() + }). +-record(cg_switch, {arg :: cg_value(), + fail :: ssa_label(), + list :: [sw_list_item()] + }). + +-type fa() :: {beam_asm:function_name(),arity()}. +-type ssa_label() :: beam_ssa:label(). +-type beam_label() :: beam_asm:label(). + +-type anno() :: beam_ssa:anno(). + +-type b_var() :: beam_ssa:b_var(). +-type b_literal() :: beam_ssa:b_literal(). + +-type cg_value() :: beam_ssa:value() | xreg(). + +-type cg_set() :: #cg_set{}. +-type cg_alloc() :: #cg_alloc{}. + +-type instruction() :: cg_set() | cg_alloc(). + +-type cg_br() :: #cg_br{}. +-type cg_ret() :: #cg_ret{}. +-type cg_switch() :: #cg_switch{}. +-type terminator() :: cg_br() | cg_ret() | cg_switch(). + +-type sw_list_item() :: {b_literal(),ssa_label()}. + +-type reg_num() :: beam_asm:reg_num(). +-type xreg() :: {'x',reg_num()}. +-type yreg() :: {'y',reg_num()}. + +-type ssa_register() :: xreg() | yreg() | {'fr',reg_num()} | {'z',reg_num()}. + +functions(Forms, AtomMod) -> + mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms). + +function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) -> + #{func_info:={_,Name,Arity}} = Anno, + try + assert_badarg_block(Blocks), %Assertion. + Regs = maps:get(registers, Anno), + St1 = St0#cg{labels=#{},used_labels=gb_sets:empty(), + regs=Regs}, + {Fi,St2} = new_label(St1), %FuncInfo label + {Entry,St3} = local_func_label(Name, Arity, St2), + {Ult,St4} = new_label(St3), %Ultimate failure + Labels = (St4#cg.labels)#{0=>Entry,?BADARG_BLOCK=>0}, + St5 = St4#cg{labels=Labels,used_labels=gb_sets:singleton(Entry), + ultimate_fail=Ult}, + {Body,St} = cg_fun(Blocks, St5), + Asm = [{label,Fi},line(Anno), + {func_info,AtomMod,{atom,Name},Arity}] ++ Body ++ + [{label,Ult},if_end], + Func = {function,Name,Arity,Entry,Asm}, + {Func,St} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +assert_badarg_block(Blocks) -> + %% Assertion: ?BADARG_BLOCK must be the call erlang:error(badarg). + case Blocks of + #{?BADARG_BLOCK:=Blk} -> + #b_blk{is=[#b_set{op=call,dst=Ret, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val=badarg}]}], + last=#b_ret{arg=Ret}} = Blk, + ok; + #{} -> + %% ?BADARG_BLOCK has been removed because it was never used. + ok + end. + +cg_fun(Blocks, St0) -> + Linear0 = linearize(Blocks), + St = collect_catch_labels(Linear0, St0), + Linear1 = need_heap(Linear0), + Linear2 = prefer_xregs(Linear1, St), + Linear3 = liveness(Linear2, St), + Linear4 = defined(Linear3, St), + Linear = opt_allocate(Linear4, St), + cg_linear(Linear, St). + +%% collect_catch_labels(Linear, St) -> St. +%% Collect all catch labels (labels for blocks that begin +%% with 'landingpad' instructions) for later use. + +collect_catch_labels(Linear, St) -> + Labels = collect_catch_labels_1(Linear), + St#cg{catches=gb_sets:from_list(Labels)}. + +collect_catch_labels_1([{L,#cg_blk{is=[#cg_set{op=landingpad}|_]}}|Bs]) -> + [L|collect_catch_labels_1(Bs)]; +collect_catch_labels_1([_|Bs]) -> + collect_catch_labels_1(Bs); +collect_catch_labels_1([]) -> []. + +%% need_heap([{BlockLabel,Block]) -> [{BlockLabel,Block}]. +%% Insert need_heap instructions in the instruction list. Try to be smart and +%% collect them together as much as possible. + +need_heap(Bs0) -> + Bs1 = need_heap_allocs(Bs0, #{}), + {Bs,#need{h=0,f=0}} = need_heap_blks(reverse(Bs1), #need{}, []), + Bs. + +need_heap_allocs([{L,#cg_blk{is=Is0,last=Terminator}=Blk0}|Bs], Counts0) -> + Next = next_block(Bs), + Successors = successors(Terminator), + Counts = foldl(fun(S, Cnts) -> + case Cnts of + #{S:=C} -> Cnts#{S:=C+1}; + #{} when S =:= Next -> Cnts#{S=>1}; + #{} -> Cnts#{S=>42} + end + end, Counts0, Successors), + case Counts of + #{L:=1} -> + [{L,Blk0}|need_heap_allocs(Bs, Counts)]; + #{L:=_} -> + %% This block has multiple predecessors. Force an allocation + %% in this block so that the predecessors don't need to do + %% an allocation on behalf of this block. + Is = case need_heap_never(Is0) of + true -> Is0; + false -> [#cg_alloc{}|Is0] + end, + Blk = Blk0#cg_blk{is=Is}, + [{L,Blk}|need_heap_allocs(Bs, Counts)]; + #{} -> + [{L,Blk0}|need_heap_allocs(Bs, Counts)] + end; +need_heap_allocs([], _) -> []. + +need_heap_never([#cg_alloc{}|_]) -> true; +need_heap_never([#cg_set{op=recv_next}|_]) -> true; +need_heap_never([#cg_set{op=wait}|_]) -> true; +need_heap_never(_) -> false. + +need_heap_blks([{L,#cg_blk{is=Is0}=Blk0}|Bs], H0, Acc) -> + {Is1,H1} = need_heap_is(reverse(Is0), H0, []), + {Ns,H} = need_heap_terminator(Bs, H1), + Is = Ns ++ Is1, + Blk = Blk0#cg_blk{is=Is}, + need_heap_blks(Bs, H, [{L,Blk}|Acc]); +need_heap_blks([], H, Acc) -> + {Acc,H}. + +need_heap_is([#cg_alloc{words=Words}=Alloc0|Is], N, Acc) -> + Alloc = Alloc0#cg_alloc{words=add_heap_words(N, Words)}, + need_heap_is(Is, #need{}, [Alloc|Acc]); +need_heap_is([#cg_set{op=Op,args=Args}=I|Is], N, Acc) -> + case classify_heap_need(Op, Args) of + {put,Words} -> + %% Pass through adding to needed heap. + need_heap_is(Is, add_heap_words(N, Words), [I|Acc]); + put_float -> + need_heap_is(Is, add_heap_float(N), [I|Acc]); + neutral -> + need_heap_is(Is, N, [I|Acc]); + gc -> + need_heap_is(Is, #need{}, [I]++need_heap_need(N)++Acc) + end; +need_heap_is([], N, Acc) -> + {Acc,N}. + +need_heap_terminator([{_,#cg_blk{last=#cg_br{succ=Same,fail=Same}}}|_], N) -> + {[],N}; +need_heap_terminator([{_,#cg_blk{}}|_], N) -> + {need_heap_need(N),#need{}}; +need_heap_terminator([], H) -> + {need_heap_need(H),#need{}}. + +need_heap_need(#need{h=0,f=0}) -> []; +need_heap_need(#need{}=N) -> [#cg_alloc{words=N}]. + +add_heap_words(#need{h=H1,f=F1}, #need{h=H2,f=F2}) -> + #need{h=H1+H2,f=F1+F2}; +add_heap_words(#need{h=Heap}=N, Words) when is_integer(Words) -> + N#need{h=Heap+Words}. + +add_heap_float(#need{f=F}=N) -> + N#need{f=F+1}. + +%% classify_heap_need(Operation, Arguments) -> +%% gc | neutral | {put,Words} | put_float. +%% Classify the heap need for this instruction. The return +%% values have the following meaning. +%% +%% {put,Words} means that the instruction will use Words words to build +%% something on the heap. +%% +%% 'put_float' means that the instruction will build one floating point +%% number on the heap. +%% +%% 'gc' means that that the instruction can potentially do a GC or throw an +%% exception. That means that an allocation instruction for any building +%% must be placed after this instruction. +%% +%% 'neutral' means that the instruction does nothing to disturb the heap. + +-spec classify_heap_need(beam_ssa:op(), [beam_ssa:value()]) -> + 'gc' | 'neutral' | + {'put',non_neg_integer()} | 'put_float'. + +classify_heap_need(put_list, _) -> + {put,2}; +classify_heap_need(put_tuple_arity, [#b_literal{val=Words}]) -> + {put,Words+1}; +classify_heap_need(put_tuple, Elements) -> + {put,length(Elements)+1}; +classify_heap_need({bif,Name}, Args) -> + case is_gc_bif(Name, Args) of + false -> neutral; + true -> gc + end; +classify_heap_need({float,Op}, _Args) -> + case Op of + get -> put_float; + _ -> neutral + end; +classify_heap_need(Name, _Args) -> + classify_heap_need(Name). + +%% classify_heap_need(Operation) -> gc | neutral. +%% Return either 'gc' or 'neutral'. +%% +%% 'gc' means that that the instruction can potentially do a GC or throw an +%% exception. That means that an allocation instruction for any building +%% must be placed after this instruction. +%% +%% 'neutral' means that the instruction does nothing to disturb the heap. +%% +%% Note: Only handle operations in this function that are not handled +%% by classify_heap_need/2. + +classify_heap_need(bs_add) -> gc; +classify_heap_need(bs_get) -> gc; +classify_heap_need(bs_init) -> gc; +classify_heap_need(bs_init_writable) -> gc; +classify_heap_need(bs_match_string) -> gc; +classify_heap_need(bs_put) -> neutral; +classify_heap_need(bs_restore) -> neutral; +classify_heap_need(bs_save) -> neutral; +classify_heap_need(bs_skip) -> gc; +classify_heap_need(bs_start_match) -> neutral; +classify_heap_need(bs_test_tail) -> neutral; +classify_heap_need(bs_utf16_size) -> neutral; +classify_heap_need(bs_utf8_size) -> neutral; +classify_heap_need(build_stacktrace) -> gc; +classify_heap_need(call) -> gc; +classify_heap_need(catch_end) -> gc; +classify_heap_need(context_to_binary) -> gc; +classify_heap_need(copy) -> neutral; +classify_heap_need(extract) -> gc; +classify_heap_need(get_hd) -> neutral; +classify_heap_need(get_map_element) -> neutral; +classify_heap_need(get_tl) -> neutral; +classify_heap_need(get_tuple_element) -> neutral; +classify_heap_need(has_map_field) -> neutral; +classify_heap_need(is_nonempty_list) -> neutral; +classify_heap_need(is_tagged_tuple) -> neutral; +classify_heap_need(kill_try_tag) -> gc; +classify_heap_need(landingpad) -> gc; +classify_heap_need(make_fun) -> gc; +classify_heap_need(new_try_tag) -> gc; +classify_heap_need(peek_message) -> gc; +classify_heap_need(put_map) -> gc; +classify_heap_need(put_tuple_elements) -> neutral; +classify_heap_need(raw_raise) -> gc; +classify_heap_need(recv_next) -> gc; +classify_heap_need(remove_message) -> neutral; +classify_heap_need(resume) -> gc; +classify_heap_need(set_tuple_element) -> gc; +classify_heap_need(succeeded) -> neutral; +classify_heap_need(timeout) -> gc; +classify_heap_need(wait) -> gc; +classify_heap_need(wait_timeout) -> gc. + +%%% +%%% Because beam_ssa_pre_codegen has inserted 'copy' instructions to copy +%%% variables that must be saved on the stack, a value can for some time +%%% be in both an X register and a Y register. +%%% +%%% Here we will keep track of variables that have the same value and +%%% rewrite instructions to use the variable that refers to the X +%%% register instead of the Y register. That could improve performance, +%%% since the BEAM interpreter have more optimized instructions +%%% operating on X registers than on Y registers. +%%% +%%% 'call' and 'make_fun' are handled somewhat specially. If a value +%%% already is in the correct X register, the X register will always +%%% be used instead of the Y register. However, if there are one or more +%%% values in the wrong X registers, the X registers variables will be +%%% used only if that does not cause more 'move' instructions to be +%%% be emitted than if the Y register variables were used. +%%% +%%% Here are some examples. The first example shows how a 'move' from +%%% an Y register is eliminated: +%%% +%%% move x0 y1 +%%% move y1 x0 %%Will be eliminated. +%%% +%%% call f/1 +%%% +%%% Here is an example when x0 and x1 must be swapped to load the argument +%%% registers. Here the 'call' instruction will use the Y registers to +%%% avoid introducing an extra 'move' insruction: +%%% +%%% move x0 y0 +%%% move x1 y1 +%%% +%%% move y0 x1 +%%% move y1 x0 +%%% +%%% call f/2 +%%% +%%% Using the X register to load the argument registers would need +%%% an extra 'move' instruction like this: +%%% +%%% move x0 y0 +%%% move x1 y1 +%%% +%%% move x1 x2 +%%% move x0 x1 +%%% move x2 x0 +%%% +%%% call f/2 +%%% + +prefer_xregs(Linear, St) -> + prefer_xregs(Linear, St, #{0=>#{}}). + +prefer_xregs([{L,#cg_blk{is=Is0,last=Last0}=Blk0}|Bs], St, Map0) -> + Copies0 = maps:get(L, Map0), + {Is,Copies} = prefer_xregs_is(Is0, St, Copies0, []), + Last = prefer_xregs_terminator(Last0, Copies, St), + Blk = Blk0#cg_blk{is=Is,last=Last}, + Successors = successors(Last), + Map = prefer_xregs_successors(Successors, Copies, Map0), + [{L,Blk}|prefer_xregs(Bs, St, Map)]; +prefer_xregs([], _St, _Map) -> []. + +prefer_xregs_successors([L|Ls], Copies0, Map0) -> + case Map0 of + #{L:=Copies1} -> + Copies = merge_copies(Copies0, Copies1), + Map = Map0#{L:=Copies}, + prefer_xregs_successors(Ls, Copies0, Map); + #{} -> + Map = Map0#{L=>Copies0}, + prefer_xregs_successors(Ls, Copies0, Map) + end; +prefer_xregs_successors([], _, Map) -> Map. + +prefer_xregs_is([#cg_alloc{}=I|Is], St, Copies0, Acc) -> + Copies = case I of + #cg_alloc{stack=none,words=#need{h=0,f=0}} -> + Copies0; + #cg_alloc{} -> + #{} + end, + prefer_xregs_is(Is, St, Copies, [I|Acc]); +prefer_xregs_is([#cg_set{op=copy,dst=Dst,args=[Src]}=I|Is], St, Copies0, Acc) -> + Copies1 = prefer_xregs_prune(I, Copies0, St), + Copies = case beam_args([Src,Dst], St) of + [Same,Same] -> Copies1; + [_,_] -> Copies1#{Dst=>Src} + end, + prefer_xregs_is(Is, St, Copies, [I|Acc]); +prefer_xregs_is([#cg_set{op=call,dst=Dst}=I0|Is], St, Copies, Acc) -> + I = prefer_xregs_call(I0, Copies, St), + prefer_xregs_is(Is, St, #{Dst=>{x,0}}, [I|Acc]); +prefer_xregs_is([#cg_set{op=make_fun,dst=Dst}=I0|Is], St, Copies, Acc) -> + I = prefer_xregs_call(I0, Copies, St), + prefer_xregs_is(Is, St, #{Dst=>{x,0}}, [I|Acc]); +prefer_xregs_is([#cg_set{op=set_tuple_element}=I|Is], St, Copies, Acc) -> + %% FIXME: HiPE translates the following code segment incorrectly: + %% {call_ext,3,{extfunc,erlang,setelement,3}}. + %% {move,{x,0},{y,3}}. + %% {set_tuple_element,{y,1},{y,3},1}. + %% Therefore, skip the translation of the arguments for set_tuple_element. + prefer_xregs_is(Is, St, Copies, [I|Acc]); +prefer_xregs_is([#cg_set{args=Args0}=I0|Is], St, Copies0, Acc) -> + Args = [do_prefer_xreg(A, Copies0, St) || A <- Args0], + I = I0#cg_set{args=Args}, + Copies = prefer_xregs_prune(I, Copies0, St), + prefer_xregs_is(Is, St, Copies, [I|Acc]); +prefer_xregs_is([], _St, Copies, Acc) -> + {reverse(Acc),Copies}. + +prefer_xregs_terminator(#cg_br{bool=Arg0}=I, Copies, St) -> + Arg = do_prefer_xreg(Arg0, Copies, St), + I#cg_br{bool=Arg}; +prefer_xregs_terminator(#cg_ret{arg=Arg0}=I, Copies, St) -> + Arg = do_prefer_xreg(Arg0, Copies, St), + I#cg_ret{arg=Arg}; +prefer_xregs_terminator(#cg_switch{arg=Arg0}=I, Copies, St) -> + Arg = do_prefer_xreg(Arg0, Copies, St), + I#cg_switch{arg=Arg}. + +prefer_xregs_prune(#cg_set{anno=#{clobbers:=true}}, _, _) -> + #{}; +prefer_xregs_prune(#cg_set{dst=Dst}, Copies, St) -> + DstReg = beam_arg(Dst, St), + F = fun(_, Alias) -> + beam_arg(Alias, St) =/= DstReg + end, + maps:filter(F, Copies). + +%% prefer_xregs_call(Instruction, Copies, St) -> Instruction. +%% Given a 'call' or 'make_fun' instruction, minimize the number +%% of 'move' instructions to set up the argument registers. +%% Prefer using X registers over Y registers, unless that will +%% result in more 'move' instructions. + +prefer_xregs_call(#cg_set{args=[_]}=I, _Copies, _St) -> + I; +prefer_xregs_call(#cg_set{args=[F|Args0]}=I, Copies, St) -> + case Args0 of + [A0] -> + %% Only one argument. Always prefer the X register + %% if available. + A = do_prefer_xreg(A0, Copies, St), + I#cg_set{args=[F,A]}; + [_|_] -> + %% Two or more arguments. Try rewriting arguments in + %% two ways and see which way produces the least + %% number of 'move' instructions. + Args1 = prefer_xregs_call_1(Args0, Copies, 0, St), + Args2 = [do_prefer_xreg(A, Copies, St) || A <- Args0], + case {count_moves(Args1, St),count_moves(Args2, St)} of + {N1,N2} when N1 < N2 -> + %% There will be fewer 'move' instructions if + %% we keep using Y registers. + I#cg_set{args=[F|Args1]}; + {_,_} -> + %% Always use the values in X registers. + I#cg_set{args=[F|Args2]} + end + end. + +count_moves(Args, St) -> + length(setup_args(beam_args(Args, St))). + +prefer_xregs_call_1([#b_var{}=A|As], Copies, X, St) -> + case {beam_arg(A, St),Copies} of + {{y,_},#{A:=Other}} -> + case beam_arg(Other, St) of + {x,X} -> + %% This value is already in the correct X register. + %% It is always benefical to use the X register variable. + [Other|prefer_xregs_call_1(As, Copies, X+1, St)]; + _ -> + %% This value is another X register. Keep using + %% the Y register variable. + [A|prefer_xregs_call_1(As, Copies, X+1, St)] + end; + {_,_} -> + %% The value is not available in an X register. + [A|prefer_xregs_call_1(As, Copies, X+1, St)] + end; +prefer_xregs_call_1([A|As], Copies, X, St) -> + [A|prefer_xregs_call_1(As, Copies, X+1, St)]; +prefer_xregs_call_1([], _, _, _) -> []. + +do_prefer_xreg(#b_var{}=A, Copies, St) -> + case {beam_arg(A, St),Copies} of + {{y,_},#{A:=Copy}} -> + Copy; + {_,_} -> + A + end; +do_prefer_xreg(A, _, _) -> A. + +merge_copies(Copies0, Copies1) when map_size(Copies0) =< map_size(Copies1) -> + maps:filter(fun(K, V) -> + case Copies1 of + #{K:=V} -> true; + #{} -> false + end + end, Copies0); +merge_copies(Copies0, Copies1) -> + merge_copies(Copies1, Copies0). + + +%%% +%%% Add annotations for the number of live registers. +%%% + +liveness(Linear, #cg{regs=Regs}) -> + liveness(reverse(Linear), #{}, Regs, []). + +liveness([{L,#cg_blk{is=Is0,last=Last0}=Blk0}|Bs], LiveMap0, Regs, Acc) -> + Successors = liveness_successors(Last0), + Live0 = ordsets:union([liveness_get(S, LiveMap0) || S <- Successors]), + Live1 = liveness_terminator(Last0, Live0), + {Is,Live} = liveness_is(reverse(Is0), Regs, Live1, []), + LiveMap = LiveMap0#{L=>Live}, + Blk = Blk0#cg_blk{is=Is}, + liveness(Bs, LiveMap, Regs, [{L,Blk}|Acc]); +liveness([], _LiveMap, _Regs, Acc) -> Acc. + +liveness_get(S, LiveMap) -> + case LiveMap of + #{S:=Live} -> Live; + #{} -> [] + end. + +liveness_successors(Terminator) -> + successors(Terminator) -- [?BADARG_BLOCK]. + +liveness_is([#cg_alloc{}=I0|Is], Regs, Live, Acc) -> + I = I0#cg_alloc{live=num_live(Live, Regs)}, + liveness_is(Is, Regs, Live, [I|Acc]); +liveness_is([#cg_set{dst=Dst0,args=Args}=I0|Is], Regs, Live0, Acc) -> + #b_var{name=Dst} = Dst0, + Live1 = liveness_clobber(I0, Live0, Regs), + I1 = liveness_yregs_anno(I0, Live1, Regs), + Live2 = liveness_args(Args, Live1), + Live = ordsets:del_element(Dst, Live2), + I = liveness_anno(I1, Live, Regs), + liveness_is(Is, Regs, Live, [I|Acc]); +liveness_is([], _, Live, Acc) -> + {Acc,Live}. + +liveness_terminator(#cg_br{bool=Arg}, Live) -> + liveness_terminator_1(Arg, Live); +liveness_terminator(#cg_switch{arg=Arg}, Live) -> + liveness_terminator_1(Arg, Live); +liveness_terminator(#cg_ret{arg=Arg}, Live) -> + liveness_terminator_1(Arg, Live). + +liveness_terminator_1(#b_var{name=V}, Live) -> + ordsets:add_element(V, Live); +liveness_terminator_1(#b_literal{}, Live) -> + Live; +liveness_terminator_1(Reg, Live) -> + _ = verify_beam_register(Reg), + ordsets:add_element(Reg, Live). + +liveness_args([#b_var{name=V}|As], Live) -> + liveness_args(As, ordsets:add_element(V, Live)); +liveness_args([#b_remote{mod=Mod,name=Name}|As], Live) -> + liveness_args([Mod,Name|As], Live); +liveness_args([A|As], Live) -> + case is_beam_register(A) of + true -> + liveness_args(As, ordsets:add_element(A, Live)); + false -> + liveness_args(As, Live) + end; +liveness_args([], Live) -> Live. + +liveness_anno(#cg_set{op=Op}=I, Live, Regs) -> + case need_live_anno(Op) of + true -> + NumLive = num_live(Live, Regs), + Anno = (I#cg_set.anno)#{live=>NumLive}, + I#cg_set{anno=Anno}; + false -> + I + end. + +liveness_yregs_anno(#cg_set{op=Op,dst=#b_var{name=Dst}}=I, Live0, Regs) -> + case need_live_anno(Op) of + true -> + Live = ordsets:del_element(Dst, Live0), + LiveYregs = [V || V <- Live, is_yreg(V, Regs)], + Anno = (I#cg_set.anno)#{live_yregs=>LiveYregs}, + I#cg_set{anno=Anno}; + false -> + I + end. + +liveness_clobber(#cg_set{anno=Anno}, Live, Regs) -> + case Anno of + #{clobbers:=true} -> + [R || R <- Live, is_yreg(R, Regs)]; + _ -> + Live + end. + +is_yreg(R, Regs) -> + case Regs of + #{R:={y,_}} -> true; + #{} -> false + end. + +num_live(Live, Regs) -> + Rs = ordsets:from_list([get_register(V, Regs) || V <- Live]), + num_live_1(Rs, 0). + +num_live_1([{x,X}|T], X) -> + num_live_1(T, X+1); +num_live_1([{x,_}|_]=T, X) -> + %% error({hole,{x,X},expected,Next}); + num_live_1(T, X+1); +num_live_1([{y,_}|_], X) -> + X; +num_live_1([{z,_}|_], X) -> + X; +num_live_1([{fr,_}|T], X) -> + num_live_1(T, X); +num_live_1([], X) -> + X. + +get_live(#cg_set{anno=#{live:=Live}}) -> + Live. + +%% need_live_anno(Operation) -> true|false. +%% Return 'true' if the instruction needs a 'live' annotation with +%% the number live X registers, or 'false' otherwise. + +need_live_anno(Op) -> + case Op of + {bif,_} -> true; + bs_get -> true; + bs_init -> true; + bs_start_match -> true; + bs_skip -> true; + call -> true; + put_map -> true; + _ -> false + end. + +%%% +%%% Add annotations for defined Y registers. +%%% + +defined(Linear, #cg{regs=Regs}) -> + def(Linear, #{}, Regs). + +def([{L,#cg_blk{is=Is0,last=Last}=Blk0}|Bs], DefMap0, Regs) -> + Def0 = def_get(L, DefMap0), + {Is,Def} = def_is(Is0, Regs, Def0, []), + Successors = successors(Last), + DefMap = def_successors(Successors, Def, DefMap0), + Blk = Blk0#cg_blk{is=Is}, + [{L,Blk}|def(Bs, DefMap, Regs)]; +def([], _, _) -> []. + +def_get(L, DefMap) -> + case DefMap of + #{L:=Def} -> Def; + #{} -> [] + end. + +def_is([#cg_alloc{anno=Anno0}=I0|Is], Regs, Def, Acc) -> + I = I0#cg_alloc{anno=Anno0#{def_yregs=>Def}}, + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{op=kill_try_tag,args=[#b_var{name=Tag}]}=I|Is], Regs, Def0, Acc) -> + Def = ordsets:del_element(Tag, Def0), + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{op=catch_end,args=[#b_var{name=Tag}|_]}=I|Is], Regs, Def0, Acc) -> + Def = ordsets:del_element(Tag, Def0), + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{anno=Anno0,op=call,dst=#b_var{name=Dst}}=I0|Is], + Regs, Def0, Acc) -> + #{live_yregs:=LiveYregVars} = Anno0, + LiveRegs = gb_sets:from_list([maps:get(V, Regs) || V <- LiveYregVars]), + Kill0 = ordsets:subtract(Def0, LiveYregVars), + + %% Kill0 is the set of variables that have just died. However, the registers + %% used for killed variables may have been reused, so we must check that the + %% registers to be killed are not used by other variables. + Kill = [K || K <- Kill0, not gb_sets:is_element(maps:get(K, Regs), LiveRegs)], + Anno = Anno0#{def_yregs=>Def0,kill_yregs=>Kill}, + I = I0#cg_set{anno=Anno}, + Def1 = ordsets:subtract(Def0, Kill), + Def = def_add_yreg(Dst, Def1, Regs), + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{anno=Anno0,op={bif,Bif},dst=#b_var{name=Dst},args=Args}=I0|Is], + Regs, Def0, Acc) -> + Arity = length(Args), + I = case is_gc_bif(Bif, Args) orelse not erl_bifs:is_safe(erlang, Bif, Arity) of + true -> + I0#cg_set{anno=Anno0#{def_yregs=>Def0}}; + false -> + I0 + end, + Def = def_add_yreg(Dst, Def0, Regs), + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{anno=Anno0,dst=#b_var{name=Dst}}=I0|Is], Regs, Def0, Acc) -> + I = case need_y_init(I0) of + true -> + I0#cg_set{anno=Anno0#{def_yregs=>Def0}}; + false -> + I0 + end, + Def = def_add_yreg(Dst, Def0, Regs), + def_is(Is, Regs, Def, [I|Acc]); +def_is([], _, Def, Acc) -> + {reverse(Acc),Def}. + +def_add_yreg(Dst, Def, Regs) -> + case is_yreg(Dst, Regs) of + true -> ordsets:add_element(Dst, Def); + false -> Def + end. + +def_successors([S|Ss], Def0, DefMap) -> + case DefMap of + #{S:=Def1} -> + Def = ordsets:intersection(Def0, Def1), + def_successors(Ss, Def0, DefMap#{S:=Def}); + #{} -> + def_successors(Ss, Def0, DefMap#{S=>Def0}) + end; +def_successors([], _, DefMap) -> DefMap. + +%% need_y_init(#cg_set{}) -> true|false. +%% Return true if this instructions needs initialized Y registers +%% (because the instruction may do a GC or cause an exception +%% so that the stack will be scanned), or false otherwise. + +need_y_init(#cg_set{anno=#{clobbers:=Clobbers}}) -> Clobbers; +need_y_init(#cg_set{op=bs_get}) -> true; +need_y_init(#cg_set{op=bs_init}) -> true; +need_y_init(#cg_set{op=bs_skip,args=[#b_literal{val=Type}|_]}) -> + case Type of + utf8 -> true; + utf16 -> true; + utf32 -> true; + _ -> false + end; +need_y_init(#cg_set{op=bs_start_match}) -> true; +need_y_init(#cg_set{op=put_map}) -> true; +need_y_init(#cg_set{}) -> false. + +%% opt_allocate([{BlockLabel,Block}], #st{}) -> [BeamInstruction]. +%% Update the def_yregs field of each #cg_alloc{} that allocates +%% a stack frame. #cg_alloc.def_yregs will list all Y registers +%% that will be initialized by the subsequent code (thus, the +%% listed Y registers don't require init/1 instructions). + +opt_allocate(Linear, #cg{regs=Regs}) -> + opt_allocate_1(Linear, Regs). + +opt_allocate_1([{L,#cg_blk{is=[#cg_alloc{stack=Stk}=I0|Is]}=Blk0}|Bs]=Bs0, Regs) + when is_integer(Stk) -> + Yregs = opt_alloc_def(Bs0, gb_sets:singleton(L), []), + I = I0#cg_alloc{def_yregs=Yregs}, + [{L,Blk0#cg_blk{is=[I|Is]}}|opt_allocate_1(Bs, Regs)]; +opt_allocate_1([B|Bs], Regs) -> + [B|opt_allocate_1(Bs, Regs)]; +opt_allocate_1([], _) -> []. + +opt_alloc_def([{L,#cg_blk{is=Is,last=Last}}|Bs], Ws0, Def0) -> + case gb_sets:is_member(L, Ws0) of + false -> + opt_alloc_def(Bs, Ws0, Def0); + true -> + case opt_allocate_is(Is) of + none -> + Succ = successors(Last), + Ws = gb_sets:union(Ws0, gb_sets:from_list(Succ)), + opt_alloc_def(Bs, Ws, Def0); + Def1 when is_list(Def1) -> + Def = [Def1|Def0], + opt_alloc_def(Bs, Ws0, Def) + end + end; +opt_alloc_def([], _, Def) -> + ordsets:intersection(Def). + +opt_allocate_is([#cg_set{anno=Anno}|Is]) -> + case Anno of + #{def_yregs:=Yregs} -> + Yregs; + #{} -> + opt_allocate_is(Is) + end; +opt_allocate_is([#cg_alloc{anno=#{def_yregs:=Yregs},stack=none}|_]) -> + Yregs; +opt_allocate_is([#cg_alloc{}|Is]) -> + opt_allocate_is(Is); +opt_allocate_is([]) -> none. + +%%% +%%% Here follows the main code generation functions. +%%% + +%% cg_linear([{BlockLabel,Block}]) -> [BeamInstruction]. +%% Generate BEAM instructions. + +cg_linear([{L,#cg_blk{anno=#{recv_set:=L}=Anno0}=B0}|Bs], St0) -> + Anno = maps:remove(recv_set, Anno0), + B = B0#cg_blk{anno=Anno}, + {Is,St1} = cg_linear([{L,B}|Bs], St0), + {Fail,St} = use_block_label(L, St1), + {[{recv_set,Fail}|Is],St}; +cg_linear([{L,#cg_blk{is=Is0,last=Last}}|Bs], St0) -> + Next = next_block(Bs), + St1 = new_block_label(L, St0), + {Is1,St2} = cg_block(Is0, Last, Next, St1), + {Is2,St} = cg_linear(Bs, St2), + {def_block_label(L, St)++Is1++Is2,St}; +cg_linear([], St) -> {[],St}. + +cg_block([#cg_set{op=recv_next}], #cg_br{succ=Lr0}, _Next, St0) -> + {Lr,St} = use_block_label(Lr0, St0), + {[{loop_rec_end,Lr}],St}; +cg_block([#cg_set{op=wait}], #cg_br{succ=Lr0}, _Next, St0) -> + {Lr,St} = use_block_label(Lr0, St0), + {[{wait,Lr}],St}; +cg_block(Is0, Last, Next, St0) -> + case Last of + #cg_br{succ=Next,fail=Next} -> + cg_block(Is0, none, St0); + #cg_br{succ=Same,fail=Same} -> + {Fail,St1} = use_block_label(Same, St0), + {Is,St} = cg_block(Is0, none, St1), + {Is++[jump(Fail)],St}; + #cg_br{bool=Bool,succ=Next,fail=Fail0} -> + {Fail,St1} = use_block_label(Fail0, St0), + {Is,St} = cg_block(Is0, {Bool,Fail}, St1), + {Is,St}; + #cg_br{bool=Bool,succ=Succ0,fail=Fail0} -> + {[Succ,Fail],St1} = use_block_labels([Succ0,Fail0], St0), + {Is,St} = cg_block(Is0, {Bool,Fail}, St1), + {Is++[jump(Succ)],St}; + #cg_ret{arg=Src0,dealloc=N} -> + Src = beam_arg(Src0, St0), + cg_block(Is0, {return,Src,N}, St0); + #cg_switch{} -> + cg_switch(Is0, Last, St0) + end. + +cg_switch(Is0, Last, St0) -> + #cg_switch{arg=Src0,fail=Fail0,list=List0} = Last, + Src = beam_arg(Src0, St0), + {Fail1,St1} = use_block_label(Fail0, St0), + Fail = ensure_label(Fail1, St1), + {List1,St2} = + flatmapfoldl(fun({V,L}, S0) -> + {Lbl,S} = use_block_label(L, S0), + {[beam_arg(V, S),Lbl],S} + end, St1, List0), + {Is1,St} = cg_block(Is0, none, St2), + case reverse(Is1) of + [{bif,tuple_size,_,[Tuple],{z,_}=Src}|More] -> + List = map(fun({integer,Arity}) -> Arity; + ({f,_}=F) -> F + end, List1), + Is = reverse(More, [{select_tuple_arity,Tuple,Fail,{list,List}}]), + {Is,St}; + _ -> + SelectVal = {select_val,Src,Fail,{list,List1}}, + {Is1 ++ [SelectVal],St} + end. + +jump({f,_}=Fail) -> + {jump,Fail}; +jump({catch_tag,Fail}) -> + {jump,Fail}. + +bif_fail({f,_}=Fail) -> Fail; +bif_fail({catch_tag,_}) -> {f,0}. + +next_block([]) -> none; +next_block([{Next,_}|_]) -> Next. + +ensure_label(Fail0, #cg{ultimate_fail=Lbl}) -> + case bif_fail(Fail0) of + {f,0} -> {f,Lbl}; + {f,_}=Fail -> Fail + end. + +cg_block([#cg_set{anno=#{recv_mark:=L}=Anno0}=I0|T], Context, St0) -> + Anno = maps:remove(recv_mark, Anno0), + I = I0#cg_set{anno=Anno}, + {Is,St1} = cg_block([I|T], Context, St0), + {Fail,St} = use_block_label(L, St1), + {[{recv_mark,Fail}|Is],St}; +cg_block([#cg_set{op=new_try_tag,dst=Tag,args=Args}], {Tag,Fail0}, St) -> + {catch_tag,Fail} = Fail0, + [Reg,{atom,Kind}] = beam_args([Tag|Args], St), + {[{Kind,Reg,Fail}],St}; +cg_block([#cg_set{anno=Anno,op={bif,Name},dst=Dst0,args=Args0}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) -> + [Dst|Args] = beam_args([Dst0|Args0], St), + Line0 = call_line(body, {extfunc,erlang,Name,length(Args)}, Anno), + Fail = bif_fail(Fail0), + Line = case Fail of + {f,0} -> Line0; + {f,_} -> [] + end, + case is_gc_bif(Name, Args) of + true -> + Live = get_live(I), + Kill = kill_yregs(Anno, St), + {Kill++Line++[{gc_bif,Name,Fail,Live,Args,Dst}],St}; + false -> + {Line++[{bif,Name,Fail,Args,Dst}],St} + end; +cg_block([#cg_set{op={bif,tuple_size},dst=Arity0,args=[Tuple0]}, + #cg_set{op={bif,'=:='},dst=Bool,args=[Arity0,#b_literal{val=Ar}]}=Eq], + {Bool,Fail}=Context, St0) -> + Tuple = beam_arg(Tuple0, St0), + case beam_arg(Arity0, St0) of + {z,_} -> + %% The size will only be used once. Combine to a test_arity instruction. + Test = {test,test_arity,ensure_label(Fail, St0),[Tuple,Ar]}, + {[Test],St0}; + Arity -> + %% The size will be used more than once. Must do an explicit + %% BIF call followed by the '==' test. + TupleSize = {bif,tuple_size,{f,0},[Tuple],Arity}, + {Is,St} = cg_block([Eq], Context, St0), + {[TupleSize|Is],St} + end; +cg_block([#cg_set{op={bif,Name},dst=Dst0,args=Args0}]=Is0, {Dst0,Fail}, St0) -> + [Dst|Args] = beam_args([Dst0|Args0], St0), + case Dst of + {z,_} -> + %% The result of the BIF call will only be used once. Convert to + %% a test instruction. + Test = bif_to_test(Name, Args, ensure_label(Fail, St0)), + {Test,St0}; + _ -> + %% Must explicitly call the BIF since the result will be used + %% more than once. + {Is1,St1} = cg_block(Is0, none, St0), + {Is2,St} = cg_block([], {Dst0,Fail}, St1), + {Is1++Is2,St} + end; +cg_block([#cg_set{anno=Anno,op={bif,Name},dst=Dst0,args=Args0}=I|T], + Context, St0) -> + [Dst|Args] = beam_args([Dst0|Args0], St0), + {Is0,St} = cg_block(T, Context, St0), + case is_gc_bif(Name, Args) of + true -> + Line = call_line(body, {extfunc,erlang,Name,length(Args)}, Anno), + Live = get_live(I), + Kill = kill_yregs(Anno, St), + Is = Kill++Line++[{gc_bif,Name,{f,0},Live,Args,Dst}|Is0], + {Is,St}; + false -> + Is = [{bif,Name,{f,0},Args,Dst}|Is0], + {Is,St} + end; +cg_block([#cg_set{op=bs_init,dst=Dst0,args=Args0,anno=Anno}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) -> + Fail = bif_fail(Fail0), + Line = line(Anno), + [#b_literal{val=Kind}|Args1] = Args0, + case Kind of + new -> + [Dst,Size,{integer,Unit}] = beam_args([Dst0|Args1], St), + Live = get_live(I), + {[Line|cg_bs_init(Dst, Size, Unit, Live, Fail)],St}; + private_append -> + [Dst,Src,Bits,{integer,Unit}] = beam_args([Dst0|Args1], St), + Flags = {field_flags,[]}, + Is = [Line,{bs_private_append,Fail,Bits,Unit,Src,Flags,Dst}], + {Is,St}; + append -> + [Dst,Src,Bits,{integer,Unit}] = beam_args([Dst0|Args1], St), + Flags = {field_flags,[]}, + Live = get_live(I), + Is = [Line,{bs_append,Fail,Bits,0,Live,Unit,Src,Flags,Dst}], + {Is,St} + end; +cg_block([#cg_set{anno=Anno,op=bs_start_match,dst=Ctx0,args=[Bin0]}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> + #{num_slots:=Slots} = Anno, + [Dst,Bin1] = beam_args([Ctx0,Bin0], St), + {Bin,Pre} = force_reg(Bin1, Dst), + Live = get_live(I), + Is = Pre ++ [{test,bs_start_match2,Fail,Live,[Bin,Slots],Dst}], + {Is,St}; +cg_block([#cg_set{op=bs_get}=Set, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> + {cg_bs_get(Fail, Set, St),St}; +cg_block([#cg_set{op=bs_match_string,args=[CtxVar,#b_literal{val=String}]}, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> + CtxReg = beam_arg(CtxVar, St), + Is = [{test,bs_match_string,Fail,[CtxReg,String]}], + {Is,St}; +cg_block([#cg_set{dst=Dst0,op=landingpad,args=Args0}|T], Context, St0) -> + [Dst,{atom,Kind},Tag] = beam_args([Dst0|Args0], St0), + case Kind of + 'catch' -> + cg_catch(Dst, T, Context, St0); + 'try' -> + cg_try(Dst, Tag, T, Context, St0) + end; +cg_block([#cg_set{op=kill_try_tag,args=Args0}|Is], Context, St0) -> + [Reg] = beam_args(Args0, St0), + {Is0,St} = cg_block(Is, Context, St0), + {[{try_end,Reg}|Is0],St}; +cg_block([#cg_set{op=catch_end,dst=Dst0,args=Args0}|Is], Context, St0) -> + [Dst,Reg,{x,0}] = beam_args([Dst0|Args0], St0), + {Is0,St} = cg_block(Is, Context, St0), + {[{catch_end,Reg}|copy({x,0}, Dst)++Is0],St}; +cg_block([#cg_set{op=call}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) -> + %% A call in try/catch block. + cg_block([I], none, St); +cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> + [Dst|Args] = beam_args([Dst0|Args0], St), + {cg_test(Op, bif_fail(Fail), Args, Dst, I),St}; +cg_block([#cg_set{op=bs_put,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + Args = beam_args(Args0, St), + {cg_bs_put(bif_fail(Fail), Args),St}; +cg_block([#cg_set{op=bs_test_tail,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + [Ctx,{integer,Bits}] = beam_args(Args0, St), + {[{test,bs_test_tail2,bif_fail(Fail),[Ctx,Bits]}],St}; +cg_block([#cg_set{op={float,checkerror},dst=Bool}], {Bool,Fail}, St) -> + {[{fcheckerror,bif_fail(Fail)}],St}; +cg_block([#cg_set{op=is_tagged_tuple,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + [Src,{integer,Arity},Tag] = beam_args(Args0, St), + {[{test,is_tagged_tuple,ensure_label(Fail, St),[Src,Arity,Tag]}],St}; +cg_block([#cg_set{op=is_nonempty_list,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + Args = beam_args(Args0, St), + {[{test,is_nonempty_list,ensure_label(Fail, St),Args}],St}; +cg_block([#cg_set{op=has_map_field,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + [Src,Key] = beam_args(Args0, St), + {[{test,has_map_fields,Fail,Src,{list,[Key]}}],St}; +cg_block([#cg_set{op=call}=Call], {_Bool,_Fail}=Context, St0) -> + {Is0,St1} = cg_call(Call, body, none, St0), + {Is1,St} = cg_block([], Context, St1), + {Is0++Is1,St}; +cg_block([#cg_set{op=call,dst=Dst0}=Call], Context, St) -> + Dst = beam_arg(Dst0, St), + case Context of + {return,Dst,_} -> + cg_call(Call, tail, Context, St); + _ -> + cg_call(Call, body, Context, St) + end; +cg_block([#cg_set{op=call}=Call|T], Context, St0) -> + {Is0,St1} = cg_call(Call, body, none, St0), + {Is1,St} = cg_block(T, Context, St1), + {Is0++Is1,St}; +cg_block([#cg_set{op=make_fun,dst=Dst0,args=[Local|Args0]}|T], + Context, St0) -> + #b_local{name=#b_literal{val=Func},arity=Arity} = Local, + [Dst|Args] = beam_args([Dst0|Args0], St0), + {FuncLbl,St1} = local_func_label(Func, Arity, St0), + Is0 = setup_args(Args) ++ + [{make_fun2,{f,FuncLbl},0,0,length(Args)}|copy({x,0}, Dst)], + {Is1,St} = cg_block(T, Context, St1), + {Is0++Is1,St}; +cg_block([#cg_set{op=copy}|_]=T0, Context, St0) -> + {Is0,T} = cg_copy(T0, St0), + {Is1,St} = cg_block(T, Context, St0), + Is = Is0 ++ Is1, + case is_call(T) of + {yes,Arity} -> + {opt_call_moves(Is, Arity),St}; + no -> + {Is,St} + end; +cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=Set], none, St) -> + [Dst|Args] = beam_args([Dst0|Args0], St), + Is = cg_instr(Op, Args, Dst, Set), + {Is,St}; +cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=Set|T], Context, St0) -> + [Dst|Args] = beam_args([Dst0|Args0], St0), + Is0 = cg_instr(Op, Args, Dst, Set), + {Is1,St} = cg_block(T, Context, St0), + {Is0++Is1,St}; +cg_block([#cg_alloc{}=Alloc|T], Context, St0) -> + Is0 = cg_alloc(Alloc, St0), + {Is1,St} = cg_block(T, Context, St0), + {Is0++Is1,St}; +cg_block([], {return,Arg,none}, St) -> + Is = copy(Arg, {x,0}) ++ [return], + {Is,St}; +cg_block([], {return,Arg,N}, St) -> + Is = copy(Arg, {x,0}) ++ [{deallocate,N},return], + {Is,St}; +cg_block([], none, St) -> + {[],St}; +cg_block([], {Bool0,Fail}, St) -> + [Bool] = beam_args([Bool0], St), + {[{test,is_eq_exact,Fail,[Bool,{atom,true}]}],St}. + +cg_copy(T0, St) -> + {Copies,T} = splitwith(fun(#cg_set{op=copy}) -> true; + (_) -> false + end, T0), + Moves0 = cg_copy_1(Copies, St), + Moves1 = [Move || {move,Src,Dst}=Move <- Moves0, Src =/= Dst], + Scratch = {x,1022}, + Moves = order_moves(Moves1, Scratch), + {Moves,T}. + +cg_copy_1([#cg_set{dst=Dst0,args=Args}|T], St) -> + [Dst,Src] = beam_args([Dst0|Args], St), + Copies = cg_copy_1(T, St), + case keymember(Dst, 3, Copies) of + true -> + %% Will be overwritten. Don't generate a move instruction. + Copies; + false -> + [{move,Src,Dst}|Copies] + end; +cg_copy_1([], _St) -> []. + +bif_to_test('not', [Var], Fail) -> + [{test,is_eq_exact,Fail,[Var,{atom,false}]}]; +bif_to_test(Name, Args, Fail) -> + [beam_utils:bif_to_test(Name, Args, Fail)]. + +opt_call_moves(Is0, Arity) -> + {Moves0,Is} = splitwith(fun({move,_,_}) -> true; + (_) -> false + end, Is0), + Moves = opt_call_moves_1(Moves0, Arity), + Moves ++ Is. + +opt_call_moves_1([{move,Src,{x,_}=Tmp}=M1,{move,Tmp,Dst}=M2|Is], Arity) -> + case is_killed(Tmp, Is, Arity) of + true -> + %% The X register Tmp is never used again. We can collapse + %% the two move instruction into one. + [{move,Src,Dst}|opt_call_moves_1(Is, Arity)]; + false -> + [M1|opt_call_moves_1([M2|Is], Arity)] + end; +opt_call_moves_1([M|Ms], Arity) -> + [M|opt_call_moves_1(Ms, Arity)]; +opt_call_moves_1([], _Arity) -> []. + +is_killed(R, [{move,R,_}|_], _) -> + false; +is_killed(R, [{move,_,R}|_], _) -> + true; +is_killed(R, [{move,_,_}|Is], Arity) -> + is_killed(R, Is, Arity); +is_killed({x,X}, [], Arity) -> + X >= Arity. + +cg_alloc(#cg_alloc{stack=none,words=#need{h=0,f=0}}, _St) -> + []; +cg_alloc(#cg_alloc{stack=none,words=Need,live=Live}, _St) -> + [{test_heap,alloc(Need),Live}]; +cg_alloc(#cg_alloc{stack=Stk,words=Need,live=Live,def_yregs=DefYregs}, + #cg{regs=Regs}) when is_integer(Stk) -> + Alloc = alloc(Need), + All = [{y,Y} || Y <- lists:seq(0, Stk-1)], + Def = ordsets:from_list([maps:get(V, Regs) || V <- DefYregs]), + NeedInit = ordsets:subtract(All, Def), + NoZero = length(Def)*2 > Stk, + I = case {NoZero,Alloc} of + {true,0} -> {allocate,Stk,Live}; + {true,_} -> {allocate_heap,Stk,Alloc,Live}; + {false,0} -> {allocate_zero,Stk,Live}; + {false,_} -> {allocate_heap_zero,Stk,Alloc,Live} + end, + [I|case NoZero of + true -> [{init,Y} || Y <- NeedInit]; + false -> [] + end]. + +alloc(#need{h=Words,f=0}) -> + Words; +alloc(#need{h=Words,f=Floats}) -> + {alloc,[{words,Words},{floats,Floats}]}. + +is_call([#cg_set{op=call,args=[#b_var{}|Args]}|_]) -> + {yes,1+length(Args)}; +is_call([#cg_set{op=call,args=[_|Args]}|_]) -> + {yes,length(Args)}; +is_call([#cg_set{op=make_fun,args=[_|Args]}|_]) -> + {yes,length(Args)}; +is_call(_) -> + no. + +cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=[#b_local{}=Func0|Args0]}, + Where, Context, St0) -> + [Dst|Args] = beam_args([Dst0|Args0], St0), + #b_local{name=Name0,arity=Arity} = Func0, + {atom,Name} = beam_arg(Name0, St0), + {FuncLbl,St} = local_func_label(Name, Arity, St0), + Line = call_line(Where, local, Anno), + Call = build_call(call, Arity, {f,FuncLbl}, Context, Dst), + Is = setup_args(Args, Anno, Context, St) ++ Line ++ Call, + {Is,St}; +cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=[#b_remote{}=Func0|Args0]}, + Where, Context, St) -> + [Dst|Args] = beam_args([Dst0|Args0], St), + #b_remote{mod=Mod0,name=Name0,arity=Arity} = Func0, + case {beam_arg(Mod0, St),beam_arg(Name0, St)} of + {{atom,Mod},{atom,Name}} -> + Func = {extfunc,Mod,Name,Arity}, + Line = call_line(Where, Func, Anno), + Call = build_call(call_ext, Arity, Func, Context, Dst), + Is = setup_args(Args, Anno, Context, St) ++ Line ++ Call, + {Is,St}; + {Mod,Name} -> + Apply = build_apply(Arity, Context, Dst), + Is = setup_args(Args++[Mod,Name], Anno, Context, St) ++ + [line(Anno)] ++ Apply, + {Is,St} + end; +cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=Args0}, + Where, Context, St) -> + [Dst,Func|Args] = beam_args([Dst0|Args0], St), + Line = call_line(Where, Func, Anno), + Arity = length(Args), + Call = build_call(call_fun, Arity, Func, Context, Dst), + Is = setup_args(Args++[Func], Anno, Context, St) ++ Line ++ Call, + {Is,St}. + +build_call(call_fun, Arity, _Func, none, Dst) -> + [{call_fun,Arity}|copy({x,0}, Dst)]; +build_call(call_fun, Arity, _Func, {return,Dst,N}, Dst) when is_integer(N) -> + [{call_fun,Arity},{deallocate,N},return]; +build_call(call_fun, Arity, _Func, {return,Val,N}, _Dst) when is_integer(N) -> + [{call_fun,Arity},{move,Val,{x,0}},{deallocate,N},return]; +build_call(call_ext, 2, {extfunc,erlang,'!',2}, none, Dst) -> + [send|copy({x,0}, Dst)]; +build_call(call_ext, 2, {extfunc,erlang,'!',2}, {return,Dst,N}, Dst) + when is_integer(N) -> + [send,{deallocate,N},return]; +build_call(Prefix, Arity, Func, {return,Dst,none}, Dst) -> + I = case Prefix of + call -> call_only; + call_ext -> call_ext_only + end, + [{I,Arity,Func}]; +build_call(call_ext, Arity, {extfunc,Mod,Name,Arity}=Func, {return,_,none}, _Dst) -> + true = erl_bifs:is_exit_bif(Mod, Name, Arity), %Assertion. + [{call_ext_only,Arity,Func}]; +build_call(Prefix, Arity, Func, {return,Dst,N}, Dst) when is_integer(N) -> + I = case Prefix of + call -> call_last; + call_ext -> call_ext_last + end, + [{I,Arity,Func,N}]; +build_call(I, Arity, Func, {return,Val,N}, _Dst) when is_integer(N) -> + [{I,Arity,Func}|copy(Val, {x,0})++[{deallocate,N},return]]; +build_call(I, Arity, Func, none, Dst) -> + [{I,Arity,Func}|copy({x,0}, Dst)]. + +build_apply(Arity, {return,Dst,N}, Dst) when is_integer(N) -> + [{apply_last,Arity,N}]; +build_apply(Arity, {return,Val,N}, _Dst) when is_integer(N) -> + [{apply,Arity}|copy(Val, {x,0})++[{deallocate,N},return]]; +build_apply(Arity, none, Dst) -> + [{apply,Arity}|copy({x,0}, Dst)]. + +cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) -> + Live = get_live(Set), + [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}]; +cg_instr(Op, Args, Dst, _Set) -> + cg_instr(Op, Args, Dst). + +cg_instr(bs_init_writable, Args, Dst) -> + setup_args(Args) ++ [bs_init_writable|copy({x,0}, Dst)]; +cg_instr(bs_restore, [Ctx,Slot], _Dst) -> + case Slot of + {integer,N} -> + [{bs_restore2,Ctx,N}]; + {atom,start} -> + [{bs_restore2,Ctx,Slot}] + end; +cg_instr(bs_save, [Ctx,Slot], _Dst) -> + {integer,N} = Slot, + [{bs_save2,Ctx,N}]; +cg_instr(build_stacktrace, Args, Dst) -> + setup_args(Args) ++ [build_stacktrace|copy({x,0}, Dst)]; +cg_instr(context_to_binary, [Src], _Dst) -> + [{bs_context_to_binary,Src}]; +cg_instr(set_tuple_element=Op, [New,Tuple,{integer,Index}], _Dst) -> + [{Op,New,Tuple,Index}]; +cg_instr({float,clearerror}, [], _Dst) -> + [fclearerror]; +cg_instr({float,get}, [Src], Dst) -> + [{fmove,Src,Dst}]; +cg_instr({float,put}, [Src], Dst) -> + [{fmove,Src,Dst}]; +cg_instr(get_hd=Op, [Src], Dst) -> + [{Op,Src,Dst}]; +cg_instr(get_tl=Op, [Src], Dst) -> + [{Op,Src,Dst}]; +cg_instr(get_tuple_element=Op, [Src,{integer,N}], Dst) -> + [{Op,Src,N,Dst}]; +cg_instr(put_list=Op, [Hd,Tl], Dst) -> + [{Op,Hd,Tl,Dst}]; +cg_instr(put_tuple, Elements, Dst) -> + [{put_tuple2,Dst,{list,Elements}}]; +cg_instr(put_tuple_arity, [{integer,Arity}], Dst) -> + [{put_tuple,Arity,Dst}]; +cg_instr(put_tuple_elements, Elements, _Dst) -> + [{put,E} || E <- Elements]; +cg_instr(raw_raise, Args, Dst) -> + setup_args(Args) ++ [raw_raise|copy({x,0}, Dst)]; +cg_instr(remove_message, [], _Dst) -> + [remove_message]; +cg_instr(resume, [A,B], _Dst) -> + [{bif,raise,{f,0},[A,B],{x,0}}]; +cg_instr(timeout, [], _Dst) -> + [timeout]. + +cg_test(bs_add=Op, Fail, [Src1,Src2,{integer,Unit}], Dst, _I) -> + [{Op,Fail,[Src1,Src2,Unit],Dst}]; +cg_test(bs_skip, Fail, Args, _Dst, I) -> + cg_bs_skip(Fail, Args, I); +cg_test(bs_utf8_size=Op, Fail, [Src], Dst, _I) -> + [{Op,Fail,Src,Dst}]; +cg_test(bs_utf16_size=Op, Fail, [Src], Dst, _I) -> + [{Op,Fail,Src,Dst}]; +cg_test({float,convert}, Fail, [Src], Dst, _I) -> + {f,0} = Fail, %Assertion. + [{fconv,Src,Dst}]; +cg_test({float,Op0}, Fail, Args, Dst, #cg_set{anno=Anno}) -> + Op = case Op0 of + '+' -> fadd; + '-' when length(Args) =:= 2 -> fsub; + '-' -> fnegate; + '*' -> fmul; + '/' -> fdiv + end, + [line(Anno),{bif,Op,Fail,Args,Dst}]; +cg_test(get_map_element, Fail, [Map,Key], Dst, _I) -> + [{get_map_elements,Fail,Map,{list,[Key,Dst]}}]; +cg_test(peek_message, Fail, [], Dst, _I) -> + [{loop_rec,Fail,{x,0}}|copy({x,0}, Dst)]; +cg_test(put_map, Fail, [{atom,exact},SrcMap|Ss], Dst, Set) -> + Live = get_live(Set), + [{put_map_exact,Fail,SrcMap,Dst,Live,{list,Ss}}]; +cg_test(wait_timeout, Fail, [Timeout], _Dst, _) -> + case Timeout of + {atom,infinity} -> + [{wait,Fail}]; + _ -> + [{wait_timeout,Fail,Timeout}] + end. + +cg_bs_get(Fail, #cg_set{dst=Dst0,args=[#b_literal{val=Type}|Ss0]}=Set, St) -> + Op = case Type of + integer -> bs_get_integer2; + float -> bs_get_float2; + binary -> bs_get_binary2; + utf8 -> bs_get_utf8; + utf16 -> bs_get_utf16; + utf32 -> bs_get_utf32 + end, + [Dst|Ss1] = beam_args([Dst0|Ss0], St), + Ss = case Ss1 of + [Ctx,{literal,Flags},Size,{integer,Unit}] -> + %% Plain integer/float/binary. + [Ctx,Size,Unit,field_flags(Flags, Set)]; + [Ctx,{literal,Flags}] -> + %% Utf8/16/32. + [Ctx,field_flags(Flags, Set)] + end, + Live = get_live(Set), + [{test,Op,Fail,Live,Ss,Dst}]. + +cg_bs_skip(Fail, [{atom,Type}|Ss0], Set) -> + Op = case Type of + utf8 -> bs_skip_utf8; + utf16 -> bs_skip_utf16; + utf32 -> bs_skip_utf32; + _ -> bs_skip_bits2 + end, + Live = get_live(Set), + Ss = case Ss0 of + [Ctx,{literal,Flags},Size,{integer,Unit}] -> + %% Plain integer/float/binary. + [Ctx,Size,Unit,field_flags(Flags, Set)]; + [Ctx,{literal,Flags}] -> + %% Utf8/16/32. + [Ctx,Live,field_flags(Flags, Set)] + end, + case {Type,Ss} of + {binary,[_,{atom,all},1,_]} -> + []; + {binary,[R,{atom,all},U,_]} -> + [{test,bs_test_unit,Fail,[R,U]}]; + {_,_} -> + [{test,Op,Fail,Ss}] + end. + +field_flags(Flags, #cg_set{anno=#{location:={File,Line}}}) -> + {field_flags,[{anno,[Line,{file,File}]}|Flags]}; +field_flags(Flags, _) -> + {field_flags,Flags}. + +cg_bs_put(Fail, [{atom,Type},{literal,Flags}|Args]) -> + Op = case Type of + integer -> bs_put_integer; + float -> bs_put_float; + binary -> bs_put_binary; + utf8 -> bs_put_utf8; + utf16 -> bs_put_utf16; + utf32 -> bs_put_utf32 + end, + case Args of + [Src,Size,{integer,Unit}] -> + [{Op,Fail,Size,Unit,{field_flags,Flags},Src}]; + [Src] -> + [{Op,Fail,{field_flags,Flags},Src}] + end. + +cg_bs_init(Dst, Size0, Unit, Live, Fail) -> + Op = case Unit of + 1 -> bs_init_bits; + 8 -> bs_init2 + end, + Size = cg_bs_init_size(Size0), + [{Op,Fail,Size,0,Live,{field_flags,[]},Dst}]. + +cg_bs_init_size({x,_}=R) -> R; +cg_bs_init_size({y,_}=R) -> R; +cg_bs_init_size({integer,Int}) -> Int. + +cg_catch(Agg, T0, Context, St0) -> + {Moves,T1} = cg_extract(T0, Agg, St0), + {T,St} = cg_block(T1, Context, St0), + {Moves++T,St}. + +cg_try(Agg, Tag, T0, Context, St0) -> + {Moves0,T1} = cg_extract(T0, Agg, St0), + Moves = order_moves(Moves0, {x,3}), + [#cg_set{op=kill_try_tag}|T2] = T1, + {T,St} = cg_block(T2, Context, St0), + {[{try_case,Tag}|Moves++T],St}. + +cg_extract([#cg_set{op=extract,dst=Dst0,args=Args0}|Is0], Agg, St) -> + [Dst,Agg,{integer,X}] = beam_args([Dst0|Args0], St), + {Ds,Is} = cg_extract(Is0, Agg, St), + case keymember(Dst, 3, Ds) of + true -> + %% This destination will be overwritten. + {Ds,Is}; + false -> + {copy({x,X}, Dst)++Ds,Is} + end; +cg_extract(Is, _, _) -> + {[],Is}. + +copy(Src, Src) -> []; +copy(Src, Dst) -> [{move,Src,Dst}]. + +force_reg({literal,_}=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg({Kind,_}=R, _) when Kind =:= x; Kind =:= y -> + {R,[]}. + +%% successors(Terminator) -> [Successor]. +%% Return an ordset of all successors for the given terminator. + +successors(#cg_br{succ=Succ,fail=Fail}) -> + ordsets:from_list([Succ,Fail]); +successors(#cg_switch{fail=Fail,list=List}) -> + ordsets:from_list([Fail|[Lbl || {_,Lbl} <- List]]); +successors(#cg_ret{}) -> []. + +%% linearize(Blocks) -> [{BlockLabel,#cg_blk{}}]. +%% Linearize the intermediate representation of the code. Also +%% translate blocks from the SSA records to internal record types +%% used only in this module. + +linearize(Blocks) -> + Linear = beam_ssa:linearize(Blocks), + linearize_1(Linear, Blocks). + +linearize_1([{?BADARG_BLOCK,_}|Ls], Blocks) -> + linearize_1(Ls, Blocks); +linearize_1([{L,Block0}|Ls], Blocks) -> + Block = translate_block(L, Block0, Blocks), + [{L,Block}|linearize_1(Ls, Blocks)]; +linearize_1([], _Blocks) -> []. + +%% translate_block(BlockLabel, #b_blk{}, Blocks) -> #cg_blk{}. +%% Translate a block to the internal records used in this module. +%% Also eliminate phi nodes, replacing them with 'copy' instructions +%% in the predecessor blocks. + +translate_block(L, #b_blk{anno=Anno,is=Is0,last=Last0}, Blocks) -> + Last = translate_terminator(Last0), + PhiCopies = translate_phis(L, Last, Blocks), + Is1 = translate_is(Is0, PhiCopies), + Is = case Anno of + #{frame_size:=Size} -> + Alloc = #cg_alloc{stack=Size}, + [Alloc|Is1]; + #{} -> Is1 + end, + #cg_blk{anno=Anno,is=Is,last=Last}. + +translate_is([#b_set{op=phi}|Is], Tail) -> + translate_is(Is, Tail); +translate_is([#b_set{anno=Anno0,op=Op,dst=Dst,args=Args}=I|Is], Tail) -> + Anno = case beam_ssa:clobbers_xregs(I) of + true -> Anno0#{clobbers=>true}; + false -> Anno0 + end, + [#cg_set{anno=Anno,op=Op,dst=Dst,args=Args}|translate_is(Is, Tail)]; +translate_is([], Tail) -> Tail. + +translate_terminator(#b_ret{anno=Anno,arg=Arg}) -> + Dealloc = case Anno of + #{deallocate:=N} -> N; + #{} -> none + end, + #cg_ret{arg=Arg,dealloc=Dealloc}; +translate_terminator(#b_br{bool=#b_literal{val=true},succ=Succ}) -> + #cg_br{bool=#b_literal{val=true},succ=Succ,fail=Succ}; +translate_terminator(#b_br{bool=#b_literal{val=false},fail=Fail}) -> + #cg_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}; +translate_terminator(#b_br{bool=Bool,succ=Succ,fail=Fail}) -> + #cg_br{bool=Bool,succ=Succ,fail=Fail}; +translate_terminator(#b_switch{arg=Bool,fail=Fail,list=List}) -> + #cg_switch{arg=Bool,fail=Fail,list=List}. + +translate_phis(L, #cg_br{succ=Target,fail=Target}, Blocks) -> + #b_blk{is=Is} = maps:get(Target, Blocks), + Phis = takewhile(fun(#b_set{op=phi}) -> true; + (#b_set{}) -> false + end, Is), + phi_copies(Phis, L); +translate_phis(_, _, _) -> []. + +phi_copies([#b_set{dst=Dst,args=PhiArgs}|Sets], L) -> + CopyArgs = [V || {V,Target} <- PhiArgs, Target =:= L], + [#cg_set{op=copy,dst=Dst,args=CopyArgs}|phi_copies(Sets, L)]; +phi_copies([], _) -> []. + +%% setup_args(Args, Anno, Context) -> [Instruction]. +%% setup_args(Args) -> [Instruction]. +%% Set up X registers for a call. + +setup_args(Args, Anno, none, St) -> + setup_args(Args) ++ kill_yregs(Anno, St); +setup_args(Args, _, _, _) -> + setup_args(Args). + +setup_args([]) -> + []; +setup_args([_|_]=Args) -> + Moves = gen_moves(Args, 0, []), + Scratch = {x,1+last(sort([length(Args)-1|[X || {x,X} <- Args]]))}, + order_moves(Moves, Scratch). + +%% kill_yregs(Anno, #cg{}) -> [{kill,{y,Y}}]. +%% Kill Y registers that will not be used again. + +kill_yregs(#{kill_yregs:=Kill}, #cg{regs=Regs}) -> + ordsets:from_list([{kill,maps:get(V, Regs)} || V <- Kill]); +kill_yregs(#{}, #cg{}) -> []. + +%% gen_moves(As, I, Acc) +%% Generate the basic move instruction to move the arguments +%% to their proper registers. The list will be sorted on +%% destinations. (I.e. the move to {x,0} will be first -- +%% see the comment to order_moves/2.) + +gen_moves([A|As], I, Acc) -> + gen_moves(As, I+1, copy(A, {x,I}) ++ Acc); +gen_moves([], _, Acc) -> + keysort(3, Acc). + +%% order_moves([Move], ScratchReg) -> [Move] +%% Orders move instruction so that source registers are not +%% destroyed before they are used. If there are cycles +%% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}), +%% the scratch register is used to break up the cycle. +%% If possible, the first move of the input list is placed +%% last in the result list (to make the move to {x,0} occur +%% just before the call to allow the Beam loader to coalesce +%% the instructions). + +order_moves(Ms, Scr) -> order_moves(Ms, Scr, []). + +order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) -> + {Chain,Ms} = collect_chain(Ms0, [M], ScrReg), + Acc = reverse(Chain, Acc0), + order_moves(Ms, ScrReg, Acc); +order_moves([], _, Acc) -> Acc. + +collect_chain(Ms, Path, ScrReg) -> + collect_chain(Ms, Path, [], ScrReg). + +collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) -> + case keymember(Src, 3, Path) of + false -> + collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg); + true -> + %% There is a cycle, which we must break up. + {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)} + end; +collect_chain([M|Ms], Path, Others, ScrReg) -> + collect_chain(Ms, Path, [M|Others], ScrReg); +collect_chain([], Path, Others, _) -> + {Path,Others}. + +break_up_cycle({move,Src,_}=M, Path, ScrReg) -> + [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)]. + +break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) -> + [{move,Src,ScrReg}|Path]; +break_up_cycle1(Dst, [M|Path], LastMove) -> + [M|break_up_cycle1(Dst, Path, LastMove)]. + +%%% +%%% General utility functions. +%%% + +verify_beam_register({x,_}=Reg) -> Reg. + +is_beam_register({x,_}) -> true; +is_beam_register(_) -> false. + +get_register(V, Regs) -> + case is_beam_register(V) of + true -> V; + false -> maps:get(V, Regs) + end. + +beam_args(As, St) -> + [beam_arg(A, St) || A <- As]. + +beam_arg(#b_var{name=Name}, #cg{regs=Regs}) -> + maps:get(Name, Regs); +beam_arg(#b_literal{val=Val}, _) -> + if + is_atom(Val) -> {atom,Val}; + is_float(Val) -> {float,Val}; + is_integer(Val) -> {integer,Val}; + Val =:= [] -> nil; + true -> {literal,Val} + end; +beam_arg(Reg, _) -> + verify_beam_register(Reg). + +new_block_label(L, St0) -> + {_Lbl,St} = label_for_block(L, St0), + St. + +def_block_label(L, #cg{labels=Labels,used_labels=Used}) -> + Lbl = maps:get(L, Labels), + case gb_sets:is_member(Lbl, Used) of + false -> []; + true -> [{label,Lbl}] + end. + +use_block_labels(Ls, St) -> + mapfoldl(fun use_block_label/2, St, Ls). + +use_block_label(L, #cg{used_labels=Used,catches=Catches}=St0) -> + {Lbl,St} = label_for_block(L, St0), + case gb_sets:is_member(L, Catches) of + true -> + {{catch_tag,{f,Lbl}}, + St#cg{used_labels=gb_sets:add(Lbl, Used)}}; + false -> + {{f,Lbl},St#cg{used_labels=gb_sets:add(Lbl, Used)}} + end. + +label_for_block(L, #cg{labels=Labels0}=St0) -> + case Labels0 of + #{L:=Lbl} -> + {Lbl,St0}; + #{} -> + {Lbl,St} = new_label(St0), + Labels = Labels0#{L=>Lbl}, + {Lbl,St#cg{labels=Labels}} + end. + +%% local_func_label(Name, Arity, State) -> {Label,State'} +%% local_func_label({Name,Arity}, State) -> {Label,State'} +%% Get the function entry label for a local function. + +local_func_label(Name, Arity, St) -> + local_func_label({Name,Arity}, St). + +local_func_label(Key, #cg{functable=Map}=St0) -> + case Map of + #{Key := Label} -> + {Label,St0}; + _ -> + {Label,St} = new_label(St0), + {Label,St#cg{functable=Map#{Key => Label}}} + end. + +%% is_gc_bif(Name, Args) -> true|false. +%% Determines whether the BIF Name/Arity might do a GC. + +-spec is_gc_bif(atom(), [beam_ssa:value()]) -> boolean(). + +is_gc_bif(hd, [_]) -> false; +is_gc_bif(tl, [_]) -> false; +is_gc_bif(self, []) -> false; +is_gc_bif(node, []) -> false; +is_gc_bif(node, [_]) -> false; +is_gc_bif(element, [_,_]) -> false; +is_gc_bif(get, [_]) -> false; +is_gc_bif(is_map_key, [_,_]) -> false; +is_gc_bif(map_get, [_,_]) -> false; +is_gc_bif(tuple_size, [_]) -> false; +is_gc_bif(Bif, Args) -> + Arity = length(Args), + not (erl_internal:bool_op(Bif, Arity) orelse + erl_internal:new_type_test(Bif, Arity) orelse + erl_internal:comp_op(Bif, Arity)). + +%% new_label(St) -> {L,St}. + +new_label(#cg{lcount=Next}=St) -> + {Next,St#cg{lcount=Next+1}}. + +%% call_line(tail|body, Func, Anno) -> [] | [{line,...}]. +%% Produce a line instruction if it will be needed by the +%% call to Func. + +call_line(_Context, {extfunc,Mod,Name,Arity}, Anno) -> + case erl_bifs:is_safe(Mod, Name, Arity) of + false -> + %% The call could be to a BIF. + %% We'll need a line instruction in case the + %% BIF call fails. + [line(Anno)]; + true -> + %% Call to a safe BIF. Since it cannot fail, + %% we don't need any line instruction here. + [] + end; +call_line(body, _, Anno) -> + [line(Anno)]; +call_line(tail, local, _) -> + %% Tail-recursive call to a local function. A line + %% instruction will not be useful. + []; +call_line(tail, _, Anno) -> + %% Call to a fun. + [line(Anno)]. + +%% line(Le) -> {line,[] | {location,File,Line}} +%% Create a line instruction, containing information about +%% the current filename and line number. A line information +%% instruction should be placed before any operation that could +%% cause an exception. + +line(#{location:={File,Line}}) -> + {line,[{location,File,Line}]}; +line(#{}) -> + {line,[]}. + +flatmapfoldl(F, Accu0, [Hd|Tail]) -> + {R,Accu1} = F(Hd, Accu0), + {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), + {R++Rs,Accu2}; +flatmapfoldl(_, Accu, []) -> {[],Accu}. diff --git a/lib/compiler/src/beam_ssa_lint.erl b/lib/compiler/src/beam_ssa_lint.erl new file mode 100644 index 0000000000..a003607dab --- /dev/null +++ b/lib/compiler/src/beam_ssa_lint.erl @@ -0,0 +1,349 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose: Internal consistency checks for the beam_ssa format. + +-module(beam_ssa_lint). + +-export([module/2, format_error/1]). + +-import(lists, [append/1, foldl/3, foreach/2]). + +-include("beam_ssa.hrl"). + +-spec module(#b_module{}, [compile:option()]) -> + {'ok',#b_module{}} | {'error',list()}. +module(#b_module{body=Fs,name=Name}=Mod0, _Options) -> + Es0 = append([validate_function(F) || F <- Fs]), + case [{?MODULE,E} || E <- Es0] of + [] -> + {ok, Mod0}; + [_|_]=Es -> + {error,[{atom_to_list(Name), Es}]} + end. + +-spec format_error(term()) -> iolist(). +format_error({{_M,F,A},{redefined_variable, Name, Old, I}}) -> + io_lib:format("~p/~p: Variable ~ts (~ts) redefined by ~ts", + [F, A, format_var(Name), format_instr(Old), format_instr(I)]); +format_error({{_M,F,A},{missing_phi_paths, Paths, I}}) -> + io_lib:format("~p/~p: Phi node ~ts doesn't define a value for these " + "branches: ~w", + [F, A, format_instr(I), Paths]); +format_error({{_M,F,A},{garbage_phi_paths, Paths, I}}) -> + io_lib:format("~p/~p: Phi node ~ts defines a value for these unreachable " + "or non-existent branches: ~w", + [F, A, format_instr(I), Paths]); +format_error({{_M,F,A},{unknown_phi_variable, Name, {From, _To}, I}}) -> + io_lib:format("~p/~p: Variable ~ts used in phi node ~ts is undefined on " + "branch ~w", + [F, A, format_var(Name), format_instr(I), From]); +format_error({{_M,F,A},{unknown_block, Label, I}}) -> + io_lib:format("~p/~p: Unknown block ~p referenced in ~ts", + [F, A, Label, I]); +format_error({{_M,F,A},{unknown_variable, Name, I}}) -> + io_lib:format("~p/~p: Unbound variable ~ts used in ~ts", + [F, A, format_var(Name), format_instr(I)]); +format_error({{_M,F,A},{phi_inside_block, Name, Id}}) -> + io_lib:format("~p/~p: Phi node defining ~ts is not at start of block ~p", + [F, A, format_var(Name), Id]); +format_error({{_M,F,A},{undefined_label_in_phi, Label, I}}) -> + io_lib:format("~p/~p: Unknown block label ~p in phi node ~ts", + [F, A, Label, format_instr(I)]). + +format_instr(I) -> + [$',beam_ssa_pp:format_instr(I),$']. + +format_var(V) -> + beam_ssa_pp:format_var(#b_var{name=V}). + +validate_function(F) -> + try + validate_variables(F), + [] + catch + throw:Reason -> + #{func_info:=MFA} = F#b_function.anno, + [{MFA,Reason}]; + Class:Error:Stack -> + io:fwrite("Function: ~p\n", [F#b_function.anno]), + erlang:raise(Class, Error, Stack) + end. + +-type defined_vars() :: gb_sets:set(beam_ssa:var_name()). + +-record(vvars, + {blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }, + branch_def_vars :: #{ + %% Describes the variable state at the time of this exact branch (phi + %% node validation). + {From :: beam_ssa:label(), To :: beam_ssa:label()} => defined_vars(), + %% Describes the variable state common to all branches leading to this + %% label (un/redefined variable validation). + beam_ssa:label() => defined_vars() }, + defined_vars :: defined_vars()}). + +-spec validate_variables(beam_ssa:b_function()) -> ok. +validate_variables(#b_function{ args = Args, bs = Blocks }) -> + %% Prefill the mapping with function arguments. + ArgNames = vvars_get_varnames(Args), + DefVars = gb_sets:from_list(ArgNames), + Entry = 0, + + State = #vvars{blocks = Blocks, + branch_def_vars = #{ Entry => DefVars }, + defined_vars = DefVars}, + ok = vvars_assert_unique(Blocks, ArgNames), + vvars_phi_nodes(vvars_block(Entry, State)). + +%% Checks the uniqueness of all variables across all blocks. +-spec vvars_assert_unique(Blocks, [beam_ssa:var_name()]) -> ok when + Blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }. +vvars_assert_unique(Blocks, Args) -> + BlockIs = [Is || #b_blk{is=Is} <- maps:values(Blocks)], + Defined0 = maps:from_list([{V,argument} || V <- Args]), + _ = foldl(fun(Is, Defined) -> + vvars_assert_unique_1(Is, Defined) + end, Defined0, BlockIs), + ok. + +-spec vvars_assert_unique_1(Is, Defined) -> ok when + Is :: list(beam_ssa:b_set()), + Defined :: #{ beam_ssa:var_name() => beam_ssa:b_set() }. +vvars_assert_unique_1([#b_set{dst=#b_var{name=DstName}}=I|Is], Defined) -> + case Defined of + #{DstName:=Old} -> throw({redefined_variable, DstName, Old, I}); + _ -> vvars_assert_unique_1(Is, Defined#{DstName=>I}) + end; +vvars_assert_unique_1([], Defined) -> + Defined. + +-spec vvars_phi_nodes(State :: #vvars{}) -> ok. +vvars_phi_nodes(#vvars{ blocks = Blocks }=State) -> + _ = [vvars_phi_nodes_1(Is, Id, State) || + {Id, #b_blk{ is = Is }} <- maps:to_list(Blocks)], + ok. + +-spec vvars_phi_nodes_1(Is, Id, State) -> ok when + Is :: list(beam_ssa:b_set()), + Id :: beam_ssa:label(), + State :: #vvars{}. +vvars_phi_nodes_1([#b_set{ op = phi, args = Phis }=I | Is], Id, State) -> + ok = vvars_assert_phi_paths(Phis, I, Id, State), + ok = vvars_assert_phi_vars(Phis, I, Id, State), + vvars_phi_nodes_1(Is, Id, State); +vvars_phi_nodes_1([_ | Is], Id, _State) -> + case [Dst || #b_set{op=phi,dst=#b_var{name=Dst}} <- Is] of + [Name|_] -> + throw({phi_inside_block, Name, Id}); + [] -> + ok + end; +vvars_phi_nodes_1([], _Id, _State) -> + ok. + +%% Checks whether all paths leading to this phi node are represented, and that +%% it doesn't reference any non-existent paths. +-spec vvars_assert_phi_paths(Phis, I, Id, State) -> ok when + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. +vvars_assert_phi_paths(Phis, I, Id, State) -> + BranchKeys = maps:keys(State#vvars.branch_def_vars), + RequiredPaths = ordsets:from_list([From || {From, To} <- BranchKeys, To =:= Id]), + ProvidedPaths = ordsets:from_list([From || {_Value, From} <- Phis]), + case ordsets:subtract(RequiredPaths, ProvidedPaths) of + [_|_]=MissingPaths -> throw({missing_phi_paths, MissingPaths, I}); + [] -> ok + end. + %% %% The following test is sometimes useful to find missing optimizations. + %% %% It is commented out, though, because it can be triggered by + %% %% by weird but legal code. + %% case ordsets:subtract(ProvidedPaths, RequiredPaths) of + %% [_|_]=GarbagePaths -> throw({garbage_phi_paths, GarbagePaths, I}); + %% [] -> ok + %% end. + +%% Checks whether all variables used in this phi node are defined in the branch +%% they arrived on. +-spec vvars_assert_phi_vars(Phis, I, Id, State) -> ok when + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. +vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks, + branch_def_vars=BranchDefVars}) -> + Vars = [{Var, From} || {#b_var{}=Var, From} <- Phis], + foreach(fun({#b_var{name=VarName}, From}) -> + BranchKey = {From, Id}, + case BranchDefVars of + #{BranchKey:=DefVars} -> + case gb_sets:is_member(VarName, DefVars) of + true -> ok; + false -> throw({unknown_variable, VarName, I}) + end; + #{} -> + throw({unknown_phi_variable, VarName, BranchKey, I}) + end + end, Vars), + Labels = [From || {#b_literal{},From} <- Phis], + foreach(fun(Label) -> + case Blocks of + #{Label:=_} -> + ok; + #{} -> + throw({undefined_label_in_phi, Label, I}) + end + end, Labels). + +-spec vvars_block(Id, State) -> #vvars{} when + Id :: beam_ssa:label(), + State :: #vvars{}. +vvars_block(Id, State0) -> + #{ Id := #b_blk{ is = Is, last = Terminator} } = State0#vvars.blocks, + #{ Id := DefVars } = State0#vvars.branch_def_vars, + State = State0#vvars{ defined_vars = DefVars }, + vvars_terminator(Terminator, Id, vvars_block_1(Is, State)). + +-spec vvars_block_1(Blocks, State) -> #vvars{} when + Blocks :: list(beam_ssa:b_blk()), + State :: #vvars{}. +vvars_block_1([], State) -> + State; +vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, op = phi } | Is], State0) -> + %% We don't check phi node arguments at this point since we may not have + %% visited their definition yet. They'll be handled later on in + %% vvars_phi_nodes/1 after all blocks are processed. + vvars_block_1(Is, vvars_save_var(DstName, State0)); +vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, args = Args }=I | Is], State0) -> + ok = vvars_assert_args(Args, I, State0), + vvars_block_1(Is, vvars_save_var(DstName, State0)). + +-spec vvars_terminator(Terminator, From, State) -> #vvars{} when + Terminator :: beam_ssa:terminator(), + From :: beam_ssa:label(), + State :: #vvars{}. +vvars_terminator(#b_ret{ arg = Arg }=I, _From, State) -> + ok = vvars_assert_args([Arg], I, State), + State; +vvars_terminator(#b_switch{arg=Arg,fail=Fail,list=Switch}=I, From, State) -> + ok = vvars_assert_args([Arg], I, State), + ok = vvars_assert_args([A || {A,_Lbl} <- Switch], I, State), + Labels = [Fail | [Lbl || {_Arg, Lbl} <- Switch]], + ok = vvars_assert_labels(Labels, I, State), + vvars_terminator_1(Labels, From, State); +vvars_terminator(#b_br{bool=#b_literal{val=true},succ=Succ}=I, From, State) -> + Labels = [Succ], + ok = vvars_assert_labels(Labels, I, State), + vvars_terminator_1(Labels, From, State); +vvars_terminator(#b_br{bool=#b_literal{val=false},fail=Fail}=I, From, State) -> + Labels = [Fail], + ok = vvars_assert_labels(Labels, I, State), + vvars_terminator_1(Labels, From, State); +vvars_terminator(#b_br{ bool = Arg, succ = Succ, fail = Fail }=I, From, State) -> + ok = vvars_assert_args([Arg], I, State), + Labels = [Fail, Succ], + ok = vvars_assert_labels(Labels, I, State), + vvars_terminator_1(Labels, From, State). + +-spec vvars_terminator_1(Labels, From, State) -> #vvars{} when + Labels :: list(beam_ssa:label()), + From :: beam_ssa:label(), + State :: #vvars{}. +vvars_terminator_1(Labels0, From, State0) -> + %% Filter out all branches that have already been taken. This should result + %% in either all of Labels0 or an empty list. + Labels = [To || To <- Labels0, + not maps:is_key({From, To}, State0#vvars.branch_def_vars)], + true = Labels =:= Labels0 orelse Labels =:= [], %Assertion + State1 = foldl(fun(To, State) -> + vvars_save_branch(From, To, State) + end, State0, Labels), + foldl(fun(To, State) -> + vvars_block(To, State) + end, State1, Labels). + +%% Gets all variable names in args, ignoring literals etc +-spec vvars_get_varnames(Args) -> list(beam_ssa:var_name()) when + Args :: list(beam_ssa:argument()). +vvars_get_varnames(Args) -> + [Name || #b_var{ name = Name } <- Args]. + +%% Checks that all variables in Args are defined in all paths leading to the +%% current State. +-spec vvars_assert_args(Args, I, State) -> ok when + Args :: list(beam_ssa:argument()), + I :: beam_ssa:terminator() | beam_ssa:b_set(), + State :: #vvars{}. +vvars_assert_args(Args, I, #vvars{defined_vars=DefVars}=State) -> + foreach(fun(#b_remote{mod=Mod,name=Name}) -> + vvars_assert_args([Mod,Name], I, State); + (#b_var{name=Name}) -> + case gb_sets:is_member(Name, DefVars) of + true -> ok; + false -> throw({unknown_variable,Name,I}) + end; + (_) -> ok + end, Args). + +%% Checks that all given labels are defined in State. +-spec vvars_assert_labels(Labels, I, State) -> ok when + Labels :: list(beam_ssa:label()), + I :: beam_ssa:terminator(), + State :: #vvars{}. +vvars_assert_labels(Labels, I, #vvars{blocks=Blocks}) -> + foreach(fun(Label) -> + case maps:is_key(Label, Blocks) of + false -> throw({unknown_block, Label, I}); + true -> ok + end + end, Labels). + +-spec vvars_save_branch(From, To, State) -> #vvars{} when + From :: beam_ssa:label(), + To :: beam_ssa:label(), + State :: #vvars{}. +vvars_save_branch(From, To, State) -> + DefVars = State#vvars.defined_vars, + Branches0 = State#vvars.branch_def_vars, + case Branches0 of + #{ To := LblDefVars } -> + MergedVars = vvars_merge_branches(DefVars, LblDefVars), + + Branches = Branches0#{ To => MergedVars, {From, To} => DefVars }, + State#vvars { branch_def_vars = Branches }; + _ -> + Branches = Branches0#{ To => DefVars, {From, To} => DefVars }, + State#vvars { branch_def_vars = Branches } + end. + +-spec vvars_merge_branches(New, Existing) -> defined_vars() when + New :: defined_vars(), + Existing :: defined_vars(). +vvars_merge_branches(New, Existing) -> + gb_sets:intersection(New, Existing). + +-spec vvars_save_var(VarName, State) -> #vvars{} when + VarName :: beam_ssa:var_name(), + State :: #vvars{}. +vvars_save_var(VarName, State0) -> + %% vvars_assert_unique guarantees that variables are never set twice. + DefVars = gb_sets:insert(VarName, State0#vvars.defined_vars), + State0#vvars{ defined_vars = DefVars }. diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl new file mode 100644 index 0000000000..da466a3316 --- /dev/null +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -0,0 +1,1307 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_ssa_opt). +-export([module/2]). + +-include("beam_ssa.hrl"). +-import(lists, [all/2,append/1,foldl/3,keyfind/3,member/2,reverse/1,reverse/2, + splitwith/2,takewhile/2,unzip/1]). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, Opts) -> + Ps = passes(Opts), + Fs = functions(Fs0, Ps), + {ok,Module#b_module{body=Fs}}. + +functions([F|Fs], Ps) -> + [function(F, Ps)|functions(Fs, Ps)]; +functions([], _Ps) -> []. + +-type b_blk() :: beam_ssa:b_blk(). +-type b_var() :: beam_ssa:b_var(). +-type label() :: beam_ssa:label(). + +-record(st, {ssa :: beam_ssa:block_map() | [{label(),b_blk()}], + args :: [b_var()], + cnt :: label()}). +-define(PASS(N), {N,fun N/1}). + +passes(Opts0) -> + Ps = [?PASS(ssa_opt_split_blocks), + ?PASS(ssa_opt_element), + ?PASS(ssa_opt_linearize), + ?PASS(ssa_opt_record), + ?PASS(ssa_opt_cse), + ?PASS(ssa_opt_type), + ?PASS(ssa_opt_float), + ?PASS(ssa_opt_live), + ?PASS(ssa_opt_bsm), + ?PASS(ssa_opt_bsm_shortcut), + ?PASS(ssa_opt_misc), + ?PASS(ssa_opt_blockify), + ?PASS(ssa_opt_sink), + ?PASS(ssa_opt_merge_blocks)], + Negations = [{list_to_atom("no_"++atom_to_list(N)),N} || + {N,_} <- Ps], + Opts = proplists:substitute_negations(Negations, Opts0), + [case proplists:get_value(Name, Opts, true) of + true -> + P; + false -> + {NoName,Name} = keyfind(Name, 2, Negations), + {NoName,fun(S) -> S end} + end || {Name,_}=P <- Ps]. + +function(#b_function{anno=Anno,bs=Blocks0,args=Args,cnt=Count0}=F, Ps) -> + try + St = #st{ssa=Blocks0,args=Args,cnt=Count0}, + #st{ssa=Blocks,cnt=Count} = compile:run_sub_passes(Ps, St), + F#b_function{bs=Blocks,cnt=Count} + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%%% +%%% Trivial sub passes. +%%% + +ssa_opt_linearize(#st{ssa=Blocks}=St) -> + St#st{ssa=beam_ssa:linearize(Blocks)}. + +ssa_opt_type(#st{ssa=Linear,args=Args}=St) -> + St#st{ssa=beam_ssa_type:opt(Linear, Args)}. + +ssa_opt_blockify(#st{ssa=Linear}=St) -> + St#st{ssa=maps:from_list(Linear)}. + +%%% +%%% Split blocks before certain instructions to enable more optimizations. +%%% +%%% Splitting before element/2 enables the optimization that swaps +%%% element/2 instructions. +%%% +%%% Splitting before call and make_fun instructions gives more opportunities +%%% for sinking get_tuple_element instructions. +%%% + +ssa_opt_split_blocks(#st{ssa=Blocks0,cnt=Count0}=St) -> + P = fun(#b_set{op={bif,element}}) -> true; + (#b_set{op=call}) -> true; + (#b_set{op=make_fun}) -> true; + (_) -> false + end, + {Blocks,Count} = beam_ssa:split_blocks(P, Blocks0, Count0), + St#st{ssa=Blocks,cnt=Count}. + +%%% +%%% Order element/2 calls. +%%% +%%% Order an unbroken chain of element/2 calls for the same tuple +%%% with the same failure label so that the highest element is +%%% retrieved first. That will allow the other element/2 calls to +%%% be replaced with get_tuple_element/3 instructions. +%%% + +ssa_opt_element(#st{ssa=Blocks}=St) -> + %% Collect the information about element instructions in this + %% function. + GetEls = collect_element_calls(beam_ssa:linearize(Blocks)), + + %% Collect the element instructions into chains. The + %% element calls in each chain are ordered in reverse + %% execution order. + Chains = collect_chains(GetEls, []), + + %% For each chain, swap the first element call with the + %% element call with the highest index. + St#st{ssa=swap_element_calls(Chains, Blocks)}. + +collect_element_calls([{L,#b_blk{is=Is0,last=Last}}|Bs]) -> + case {Is0,Last} of + {[#b_set{op={bif,element},dst=Element, + args=[#b_literal{val=N},#b_var{}=Tuple]}, + #b_set{op=succeeded,dst=Bool,args=[Element]}], + #b_br{bool=Bool,succ=Succ,fail=Fail}} -> + Info = {L,Succ,{Tuple,Fail},N}, + [Info|collect_element_calls(Bs)]; + {_,_} -> + collect_element_calls(Bs) + end; +collect_element_calls([]) -> []. + +collect_chains([{This,_,V,_}=El|Els], [{_,This,V,_}|_]=Chain) -> + %% Add to the previous chain. + collect_chains(Els, [El|Chain]); +collect_chains([El|Els], [_,_|_]=Chain) -> + %% Save the previous chain and start a new chain. + [Chain|collect_chains(Els, [El])]; +collect_chains([El|Els], _Chain) -> + %% The previous chain is too short; discard it and start a new. + collect_chains(Els, [El]); +collect_chains([], [_,_|_]=Chain) -> + %% Save the last chain. + [Chain]; +collect_chains([], _) -> []. + +swap_element_calls([[{L,_,_,N}|_]=Chain|Chains], Blocks0) -> + Blocks = swap_element_calls_1(Chain, {N,L}, Blocks0), + swap_element_calls(Chains, Blocks); +swap_element_calls([], Blocks) -> Blocks. + +swap_element_calls_1([{L1,_,_,N1}], {N2,L2}, Blocks) when N2 > N1 -> + %% We have reached the end of the chain, and the first + %% element instrution to be executed. Its index is lower + %% than the maximum index found while traversing the chain, + %% so we will need to swap the instructions. + #{L1:=Blk1,L2:=Blk2} = Blocks, + [#b_set{dst=Dst1}=GetEl1,Succ1] = Blk1#b_blk.is, + [#b_set{dst=Dst2}=GetEl2,Succ2] = Blk2#b_blk.is, + Is1 = [GetEl2,Succ1#b_set{args=[Dst2]}], + Is2 = [GetEl1,Succ2#b_set{args=[Dst1]}], + Blocks#{L1:=Blk1#b_blk{is=Is1},L2:=Blk2#b_blk{is=Is2}}; +swap_element_calls_1([{L,_,_,N1}|Els], {N2,_}, Blocks) when N1 > N2 -> + swap_element_calls_1(Els, {N2,L}, Blocks); +swap_element_calls_1([_|Els], Highest, Blocks) -> + swap_element_calls_1(Els, Highest, Blocks); +swap_element_calls_1([], _, Blocks) -> + %% Nothing to do. The element call with highest index + %% is already the first one to be executed. + Blocks. + +%%% +%%% Record optimization. +%%% +%%% Replace tuple matching with an is_tagged_tuple instruction +%%% when applicable. +%%% + +ssa_opt_record(#st{ssa=Linear}=St) -> + Blocks = maps:from_list(Linear), + St#st{ssa=record_opt(Linear, Blocks)}. + +record_opt([{L,#b_blk{is=Is0,last=Last}=Blk0}|Bs], Blocks) -> + Is = record_opt_is(Is0, Last, Blocks), + Blk = Blk0#b_blk{is=Is}, + [{L,Blk}|record_opt(Bs, Blocks)]; +record_opt([], _Blocks) -> []. + +record_opt_is([#b_set{op={bif,is_tuple},dst=#b_var{name=Bool}, + args=[Tuple]}=Set], + Last, Blocks) -> + case is_tagged_tuple(Tuple, Bool, Last, Blocks) of + {yes,Size,Tag} -> + Args = [Tuple,Size,Tag], + [Set#b_set{op=is_tagged_tuple,args=Args}]; + no -> + [Set] + end; +record_opt_is([I|Is], Last, Blocks) -> + [I|record_opt_is(Is, Last, Blocks)]; +record_opt_is([], _Last, _Blocks) -> []. + +is_tagged_tuple(#b_var{name=Tuple}, Bool, + #b_br{bool=#b_var{name=Bool},succ=Succ,fail=Fail}, + Blocks) -> + SuccBlk = maps:get(Succ, Blocks), + is_tagged_tuple_1(SuccBlk, Tuple, Fail, Blocks); +is_tagged_tuple(_, _, _, _) -> no. + +is_tagged_tuple_1(#b_blk{is=Is,last=Last}, Tuple, Fail, Blocks) -> + case Is of + [#b_set{op={bif,tuple_size},dst=#b_var{name=ArityVar}, + args=[#b_var{name=Tuple}]}, + #b_set{op={bif,'=:='}, + dst=#b_var{name=Bool}, + args=[#b_var{name=ArityVar}, + #b_literal{val=ArityVal}=Arity]}] + when is_integer(ArityVal) -> + case Last of + #b_br{bool=#b_var{name=Bool},succ=Succ,fail=Fail} -> + SuccBlk = maps:get(Succ, Blocks), + case is_tagged_tuple_2(SuccBlk, Tuple, Fail) of + no -> + no; + {yes,Tag} -> + {yes,Arity,Tag} + end; + _ -> + no + end; + _ -> + no + end. + +is_tagged_tuple_2(#b_blk{is=Is, + last=#b_br{bool=#b_var{name=Bool},fail=Fail}}, + Tuple, Fail) -> + is_tagged_tuple_3(Is, Bool, Tuple); +is_tagged_tuple_2(#b_blk{}, _, _) -> no. + +is_tagged_tuple_3([#b_set{op=get_tuple_element, + dst=#b_var{name=TagVar}, + args=[#b_var{name=Tuple},#b_literal{val=0}]}|Is], + Bool, Tuple) -> + is_tagged_tuple_4(Is, Bool, TagVar); +is_tagged_tuple_3([_|Is], Bool, Tuple) -> + is_tagged_tuple_3(Is, Bool, Tuple); +is_tagged_tuple_3([], _, _) -> no. + +is_tagged_tuple_4([#b_set{op={bif,'=:='},dst=#b_var{name=Bool}, + args=[#b_var{name=TagVar}, + #b_literal{val=TagVal}=Tag]}], + Bool, TagVar) when is_atom(TagVal) -> + {yes,Tag}; +is_tagged_tuple_4([_|Is], Bool, TagVar) -> + is_tagged_tuple_4(Is, Bool, TagVar); +is_tagged_tuple_4([], _, _) -> no. + +%%% +%%% Common subexpression elimination (CSE). +%%% +%%% Eliminate repeated evaluation of identical expressions. To avoid +%%% increasing the size of the stack frame, we don't eliminate +%%% subexpressions across instructions that clobber the X registers. +%%% + +ssa_opt_cse(#st{ssa=Linear}=St) -> + M = #{0=>#{}}, + St#st{ssa=cse(Linear, #{}, M)}. + +cse([{L,#b_blk{is=Is0,last=Last0}=Blk}|Bs], Sub0, M0) -> + Es0 = maps:get(L, M0), + {Is1,Es,Sub} = cse_is(Is0, Es0, Sub0, []), + Last = sub(Last0, Sub), + M = cse_successors(Is1, Blk, Es, M0), + Is = reverse(Is1), + [{L,Blk#b_blk{is=Is,last=Last}}|cse(Bs, Sub, M)]; +cse([], _, _) -> []. + +cse_successors([#b_set{op=succeeded,args=[Src]},Bif|_], Blk, EsSucc, M0) -> + case cse_suitable(Bif) of + true -> + %% The previous instruction only has a valid value at the success branch. + %% We must remove the substitution for Src from the failure branch. + #b_blk{last=#b_br{succ=Succ,fail=Fail}} = Blk, + M = cse_successors_1([Succ], EsSucc, M0), + EsFail = maps:filter(fun(_, Val) -> Val =/= Src end, EsSucc), + cse_successors_1([Fail], EsFail, M); + false -> + %% There can't be any replacement for Src in EsSucc. No need for + %% any special handling. + cse_successors_1(beam_ssa:successors(Blk), EsSucc, M0) + end; +cse_successors(_Is, Blk, Es, M) -> + cse_successors_1(beam_ssa:successors(Blk), Es, M). + +cse_successors_1([L|Ls], Es0, M) -> + case M of + #{L:=Es1} -> + Es = maps:filter(fun(Key, Value) -> + case Es1 of + #{Key:=Value} -> true; + #{} -> false + end + end, Es0), + cse_successors_1(Ls, Es0, M#{L:=Es}); + #{} -> + cse_successors_1(Ls, Es0, M#{L=>Es0}) + end; +cse_successors_1([], _, M) -> M. + +cse_is([#b_set{op=succeeded,dst=Bool,args=[Src]}=I0|Is], Es, Sub0, Acc) -> + I = sub(I0, Sub0), + case I of + #b_set{args=[Src]} -> + cse_is(Is, Es, Sub0, [I|Acc]); + #b_set{} -> + %% The previous instruction has been eliminated. Eliminate the + %% 'succeeded' instruction too. + Sub = Sub0#{Bool=>#b_literal{val=true}}, + cse_is(Is, Es, Sub, Acc) + end; +cse_is([#b_set{dst=Dst}=I0|Is], Es0, Sub0, Acc) -> + I = sub(I0, Sub0), + case beam_ssa:clobbers_xregs(I) of + true -> + %% Retaining the expressions map across calls and other + %% clobbering instructions would work, but it would cause + %% the common subexpressions to be saved to Y registers, + %% which would probably increase the size of the stack + %% frame. + cse_is(Is, #{}, Sub0, [I|Acc]); + false -> + case cse_expr(I) of + none -> + %% Not suitable for CSE. + cse_is(Is, Es0, Sub0, [I|Acc]); + {ok,ExprKey} -> + case Es0 of + #{ExprKey:=Src} -> + Sub = Sub0#{Dst=>Src}, + cse_is(Is, Es0, Sub, Acc); + #{} -> + Es = Es0#{ExprKey=>Dst}, + cse_is(Is, Es, Sub0, [I|Acc]) + end + end + end; +cse_is([], Es, Sub, Acc) -> + {Acc,Es,Sub}. + +cse_expr(#b_set{op=Op,args=Args}=I) -> + case cse_suitable(I) of + true -> {ok,{Op,Args}}; + false -> none + end. + +cse_suitable(#b_set{op=get_hd}) -> true; +cse_suitable(#b_set{op=get_tl}) -> true; +cse_suitable(#b_set{op=put_list}) -> true; +cse_suitable(#b_set{op=put_tuple}) -> true; +cse_suitable(#b_set{op={bif,Name},args=Args}) -> + %% Doing CSE for comparison operators would prevent + %% creation of 'test' instructions. + Arity = length(Args), + not (erl_internal:new_type_test(Name, Arity) orelse + erl_internal:comp_op(Name, Arity) orelse + erl_internal:bool_op(Name, Arity)); +cse_suitable(#b_set{}) -> false. + +%%% +%%% Using floating point instructions. +%%% +%%% Use the special floating points version of arithmetic +%%% instructions, if the operands are known to be floats or the result +%%% of the operation will be a float. +%%% +%%% The float instructions were never used in guards before, so we +%%% will take special care to keep not using them in guards. Using +%%% them in guards would require a new version of the 'fconv' +%%% instruction that would take a failure label. Since it is unlikely +%%% that using float instructions in guards would be benefical, why +%%% bother implementing a new instruction? Also, implementing float +%%% instructions in guards in HiPE could turn out to be a lot of work. +%%% + +-record(fs, + {s=undefined :: 'undefined' | 'cleared', + regs=#{} :: #{beam_ssa:b_var():=beam_ssa:b_var()}, + fail=none :: 'none' | beam_ssa:label(), + ren=#{} :: #{beam_ssa:label():=beam_ssa:label()}, + non_guards :: gb_sets:set(beam_ssa:label()) + }). + +ssa_opt_float(#st{ssa=Linear0,cnt=Count0}=St) -> + NonGuards0 = float_non_guards(Linear0), + NonGuards = gb_sets:from_list(NonGuards0), + Fs = #fs{non_guards=NonGuards}, + {Linear,Count} = float_opt(Linear0, Count0, Fs), + St#st{ssa=Linear,cnt=Count}. + +float_non_guards([{L,#b_blk{is=Is}}|Bs]) -> + case Is of + [#b_set{op=landingpad}|_] -> + [L|float_non_guards(Bs)]; + _ -> + float_non_guards(Bs) + end; +float_non_guards([]) -> [?BADARG_BLOCK]. + +float_opt([{L,Blk0}|Bs], Count, Fs) -> + Blk = float_rename_phis(Blk0, Fs), + case float_need_flush(Blk, Fs) of + true -> + float_flush(L, Blk, Bs, Count, Fs); + false -> + float_opt_1(L, Blk, Bs, Count, Fs) + end; +float_opt([], Count, _Fs) -> + {[],Count}. + +float_opt_1(L, #b_blk{last=#b_br{fail=F}}=Blk, Bs0, + Count0, #fs{non_guards=NonGuards}=Fs) -> + case gb_sets:is_member(F, NonGuards) of + true -> + %% This block is not inside a guard. + %% We can do the optimization. + float_opt_2(L, Blk, Bs0, Count0, Fs); + false -> + %% This block is inside a guard. Don't do + %% any floating point optimizations. + {Bs,Count} = float_opt(Bs0, Count0, Fs), + {[{L,Blk}|Bs],Count} + end; +float_opt_1(L, Blk, Bs, Count, Fs) -> + float_opt_2(L, Blk, Bs, Count, Fs). + +float_opt_2(L, #b_blk{is=Is0}=Blk0, Bs0, Count0, Fs0) -> + case float_opt_is(Is0, Fs0, Count0, []) of + {Is1,Fs1,Count1} -> + Fs = float_fail_label(Blk0, Fs1), + Split = float_split_conv(Is1, Blk0), + {Blks0,Count2} = float_number(Split, L, Count1), + {Blks,Count3} = float_conv(Blks0, Fs#fs.fail, Count2), + {Bs,Count} = float_opt(Bs0, Count3, Fs), + {Blks++Bs,Count}; + none -> + {Bs,Count} = float_opt(Bs0, Count0, Fs0), + {[{L,Blk0}|Bs],Count} + end. + +%% Split {float,convert} instructions into individual blocks. +float_split_conv(Is0, Blk) -> + Br = #b_br{bool=#b_literal{val=true},succ=0,fail=0}, + case splitwith(fun(#b_set{op=Op}) -> + Op =/= {float,convert} + end, Is0) of + {Is,[]} -> + [Blk#b_blk{is=Is}]; + {[_|_]=Is1,[#b_set{op={float,convert}}=Conv|Is2]} -> + [#b_blk{is=Is1,last=Br}, + #b_blk{is=[Conv],last=Br}|float_split_conv(Is2, Blk)]; + {[],[#b_set{op={float,convert}}=Conv|Is1]} -> + [#b_blk{is=[Conv],last=Br}|float_split_conv(Is1, Blk)] + end. + +%% Number the blocks that were split. +float_number([B|Bs0], FirstL, Count0) -> + {Bs,Count} = float_number(Bs0, Count0), + {[{FirstL,B}|Bs],Count}. + +float_number([B|Bs0], Count0) -> + {Bs,Count} = float_number(Bs0, Count0+1), + {[{Count0,B}|Bs],Count}; +float_number([], Count) -> + {[],Count}. + +%% Insert 'succeeded' instructions after each {float,convert} +%% instruction. +float_conv([{L,#b_blk{is=Is0}=Blk0}|Bs0], Fail, Count0) -> + case Is0 of + [#b_set{op={float,convert}}=Conv] -> + {Bool0,Count1} = new_reg('@ssa_bool', Count0), + Bool = #b_var{name=Bool0}, + Succeeded = #b_set{op=succeeded,dst=Bool, + args=[Conv#b_set.dst]}, + Is = [Conv,Succeeded], + [{NextL,_}|_] = Bs0, + Br = #b_br{bool=Bool,succ=NextL,fail=Fail}, + Blk = Blk0#b_blk{is=Is,last=Br}, + {Bs,Count} = float_conv(Bs0, Fail, Count1), + {[{L,Blk}|Bs],Count}; + [_|_] -> + case Bs0 of + [{NextL,_}|_] -> + Br = #b_br{bool=#b_literal{val=true}, + succ=NextL,fail=NextL}, + Blk = Blk0#b_blk{last=Br}, + {Bs,Count} = float_conv(Bs0, Fail, Count0), + {[{L,Blk}|Bs],Count}; + [] -> + {[{L,Blk0}],Count0} + end + end. + +float_need_flush(#b_blk{is=Is}, #fs{s=cleared}) -> + case Is of + [#b_set{anno=#{float_op:=_}}|_] -> + false; + _ -> + true + end; +float_need_flush(_, _) -> false. + +float_opt_is([#b_set{op=succeeded,args=[Src]}=I0], + #fs{regs=Rs}=Fs, Count, Acc) -> + case Rs of + #{Src:=Fr} -> + I = I0#b_set{args=[Fr]}, + {reverse(Acc, [I]),Fs,Count}; + #{} -> + {reverse(Acc, [I0]),Fs,Count} + end; +float_opt_is([#b_set{anno=Anno0}=I0|Is0], Fs0, Count0, Acc) -> + case Anno0 of + #{float_op:=FTypes} -> + Anno = maps:remove(float_op, Anno0), + I1 = I0#b_set{anno=Anno}, + {Is,Fs,Count} = float_make_op(I1, FTypes, Fs0, Count0), + float_opt_is(Is0, Fs, Count, reverse(Is, Acc)); + #{} -> + float_opt_is(Is0, Fs0#fs{regs=#{}}, Count0, [I0|Acc]) + end; +float_opt_is([], Fs, _Count, _Acc) -> + #fs{s=undefined} = Fs, %Assertion. + none. + +float_rename_phis(#b_blk{is=Is}=Blk, #fs{ren=Ren}) -> + if + map_size(Ren) =:= 0 -> + Blk; + true -> + Blk#b_blk{is=float_rename_phis_1(Is, Ren)} + end. + +float_rename_phis_1([#b_set{op=phi,args=Args0}=I|Is], Ren) -> + Args = [float_phi_arg(Arg, Ren) || Arg <- Args0], + [I#b_set{args=Args}|float_rename_phis_1(Is, Ren)]; +float_rename_phis_1(Is, _) -> Is. + +float_phi_arg({Var,OldLbl}, Ren) -> + case Ren of + #{OldLbl:=NewLbl} -> + {Var,NewLbl}; + #{} -> + {Var,OldLbl} + end. + +float_make_op(#b_set{op={bif,Op},dst=Dst,args=As0}=I0, + Ts, #fs{s=S,regs=Rs0}=Fs, Count0) -> + {As1,Rs1,Count1} = float_load(As0, Ts, Rs0, Count0, []), + {As,Is0} = unzip(As1), + {Fr,Count2} = new_reg('@fr', Count1), + FrDst = #b_var{name=Fr}, + I = I0#b_set{op={float,Op},dst=FrDst,args=As}, + Rs = Rs1#{Dst=>FrDst}, + Is = append(Is0) ++ [I], + case S of + undefined -> + {Ignore,Count} = new_reg('@ssa_ignore', Count2), + C = #b_set{op={float,clearerror},dst=#b_var{name=Ignore}}, + {[C|Is],Fs#fs{s=cleared,regs=Rs},Count}; + cleared -> + {Is,Fs#fs{regs=Rs},Count2} + end. + +float_load([A|As], [T|Ts], Rs0, Count0, Acc) -> + {Load,Rs,Count} = float_reg_arg(A, T, Rs0, Count0), + float_load(As, Ts, Rs, Count, [Load|Acc]); +float_load([], [], Rs, Count, Acc) -> + {reverse(Acc),Rs,Count}. + +float_reg_arg(A, T, Rs, Count0) -> + case Rs of + #{A:=Fr} -> + {{Fr,[]},Rs,Count0}; + #{} -> + {Fr,Count} = new_float_copy_reg(Count0), + Dst = #b_var{name=Fr}, + I = float_load_reg(T, A, Dst), + {{Dst,[I]},Rs#{A=>Dst},Count} + end. + +float_load_reg(convert, #b_var{}=Src, Dst) -> + #b_set{op={float,convert},dst=Dst,args=[Src]}; +float_load_reg(convert, #b_literal{val=Val}=Src, Dst) -> + try float(Val) of + F -> + #b_set{op={float,put},dst=Dst,args=[#b_literal{val=F}]} + catch + error:_ -> + %% Let the exception happen at runtime. + #b_set{op={float,convert},dst=Dst,args=[Src]} + end; +float_load_reg(float, Src, Dst) -> + #b_set{op={float,put},dst=Dst,args=[Src]}. + +new_float_copy_reg(Count) -> + new_reg('@fr_copy', Count). + +new_reg(Base, Count) -> + Fr = {Base,Count}, + {Fr,Count+1}. + +float_flush(L, Blk, Bs0, Count0, #fs{s=cleared,fail=Fail,ren=Ren0}=Fs0) -> + {Bool0,Count1} = new_reg('@ssa_bool', Count0), + Bool = #b_var{name=Bool0}, + + %% Insert two blocks before the current block. First allocate + %% block numbers. + FirstL = L, %For checkerror. + MiddleL = Count1, %For flushed float regs. + LastL = Count1 + 1, %For original block. + Count2 = Count1 + 2, + + %% Build the block with the checkerror instruction. + CheckIs = [#b_set{op={float,checkerror},dst=Bool}], + FirstBlk = #b_blk{is=CheckIs,last=#b_br{bool=Bool,succ=MiddleL,fail=Fail}}, + + %% Build the block that flushes all registers. Note that this must be a + %% separate block in case the original block begins with a phi instruction, + %% to avoid embedding a phi instruction in the middle of a block. + FlushIs = float_flush_regs(Fs0), + MiddleBlk = #b_blk{is=FlushIs,last=#b_br{bool=#b_literal{val=true}, + succ=LastL,fail=LastL}}, + + %% The last block is the original unmodified block. + LastBlk = Blk, + + %% Update state and blocks. + Ren = Ren0#{L=>LastL}, + Fs = Fs0#fs{s=undefined,regs=#{},fail=none,ren=Ren}, + Bs1 = [{FirstL,FirstBlk},{MiddleL,MiddleBlk},{LastL,LastBlk}|Bs0], + float_opt(Bs1, Count2, Fs). + +float_fail_label(#b_blk{last=Last}, Fs) -> + case Last of + #b_br{bool=#b_var{},fail=Fail} -> + Fs#fs{fail=Fail}; + _ -> + Fs + end. + +float_flush_regs(#fs{regs=Rs}) -> + maps:fold(fun(_, #b_var{name={'@fr_copy',_}}, Acc) -> + Acc; + (Dst, Fr, Acc) -> + [#b_set{op={float,get},dst=Dst,args=[Fr]}|Acc] + end, [], Rs). + +%%% +%%% Live optimization. +%%% +%%% Optimize instructions whose values are not used. They could be +%%% removed if they have no side effects, or in a few cases replaced +%%% with a cheaper instructions +%%% + +ssa_opt_live(#st{ssa=Linear}=St) -> + St#st{ssa=live_opt(reverse(Linear), #{}, [])}. + +live_opt([{L,Blk0}|Bs], LiveMap0, Acc) -> + Successors = beam_ssa:successors(Blk0), + Live0 = live_opt_succ(Successors, L, LiveMap0), + {Blk,Live} = live_opt_blk(Blk0, Live0), + LiveMap = live_opt_phis(Blk#b_blk.is, L, Live, LiveMap0), + live_opt(Bs, LiveMap, [{L,Blk}|Acc]); +live_opt([], _, Acc) -> Acc. + +live_opt_succ([S|Ss], L, LiveMap) -> + Live0 = live_opt_succ(Ss, L, LiveMap), + Key = {S,L}, + case LiveMap of + #{Key:=Live} -> + gb_sets:union(Live, Live0); + #{S:=Live} -> + gb_sets:union(Live, Live0); + #{} -> + Live0 + end; +live_opt_succ([], _, _) -> + gb_sets:empty(). + +live_opt_phis(Is, L, Live0, LiveMap0) -> + LiveMap = LiveMap0#{L=>Live0}, + Phis = takewhile(fun(#b_set{op=Op}) -> Op =:= phi end, Is), + case Phis of + [] -> + LiveMap; + [_|_] -> + PhiArgs = append([Args || #b_set{args=Args} <- Phis]), + PhiVars = [{P,V} || {#b_var{name=V},P} <- PhiArgs], + PhiLive0 = rel2fam(PhiVars), + PhiLive = [{{L,P},gb_sets:union(gb_sets:from_list(Vs), Live0)} || + {P,Vs} <- PhiLive0], + maps:merge(LiveMap, maps:from_list(PhiLive)) + end. + +live_opt_blk(#b_blk{is=Is0,last=Last}=Blk, Live0) -> + Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(Last))), + {Is,Live} = live_opt_is(reverse(Is0), Live1, []), + {Blk#b_blk{is=Is},Live}. + +live_opt_is([#b_set{op=phi,dst=#b_var{name=Dst}}=I|Is], Live, Acc) -> + case gb_sets:is_member(Dst, Live) of + true -> + live_opt_is(Is, Live, [I|Acc]); + false -> + live_opt_is(Is, Live, Acc) + end; +live_opt_is([#b_set{op=succeeded,dst=#b_var{name=SuccDst}=SuccDstVar, + args=[#b_var{name=Dst}]}=SuccI, + #b_set{dst=#b_var{name=Dst}}=I|Is], Live0, Acc) -> + case gb_sets:is_member(Dst, Live0) of + true -> + case gb_sets:is_member(SuccDst, 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 -> + live_opt_is([I|Is], Live0, Acc) + end; + 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_any(SuccDst, Live1), + live_opt_is([I|Is], Live, [SuccI|Acc]); + false -> + live_opt_is([I|Is], Live0, Acc) + end + end + end; +live_opt_is([#b_set{op=Op,dst=#b_var{name=Dst}}=I|Is], Live0, Acc) -> + case gb_sets:is_member(Dst, Live0) of + true -> + Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + Live = gb_sets:delete_any(Dst, Live1), + live_opt_is(Is, Live, [I|Acc]); + false -> + case is_pure(Op) of + true -> + live_opt_is(Is, Live0, Acc); + false -> + Live = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + live_opt_is(Is, Live, [I|Acc]) + end + end; +live_opt_is([], Live, Acc) -> + {Acc,Live}. + +is_pure({bif,_}) -> true; +is_pure({float,get}) -> true; +is_pure(bs_extract) -> true; +is_pure(extract) -> true; +is_pure(get_hd) -> true; +is_pure(get_tl) -> true; +is_pure(get_tuple_element) -> true; +is_pure(is_nonempty_list) -> true; +is_pure(is_tagged_tuple) -> true; +is_pure(put_list) -> true; +is_pure(put_tuple) -> true; +is_pure(_) -> false. + +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 instructions. +%%% + +ssa_opt_bsm(#st{ssa=Linear}=St) -> + Extracted0 = bsm_extracted(Linear), + Extracted = cerl_sets:from_list(Extracted0), + St#st{ssa=bsm_skip(Linear, Extracted)}. + +bsm_skip([{L,#b_blk{is=Is0}=Blk}|Bs], Extracted) -> + Is = bsm_skip_is(Is0, Extracted), + [{L,Blk#b_blk{is=Is}}|bsm_skip(Bs, Extracted)]; +bsm_skip([], _) -> []. + +bsm_skip_is([I0|Is], Extracted) -> + case I0 of + #b_set{op=bs_match,args=[#b_literal{val=string}|_]} -> + [I0|bsm_skip_is(Is, Extracted)]; + #b_set{op=bs_match,dst=Ctx,args=[Type,PrevCtx|Args0]} -> + I = case cerl_sets:is_element(Ctx, Extracted) of + true -> + I0; + false -> + %% The value is never extracted. + Args = [#b_literal{val=skip},PrevCtx,Type|Args0], + I0#b_set{args=Args} + end, + [I|Is]; + #b_set{} -> + [I0|bsm_skip_is(Is, Extracted)] + end; +bsm_skip_is([], _) -> []. + +bsm_extracted([{_,#b_blk{is=Is}}|Bs]) -> + case Is of + [#b_set{op=bs_extract,args=[Ctx]}|_] -> + [Ctx|bsm_extracted(Bs)]; + _ -> + bsm_extracted(Bs) + end; +bsm_extracted([]) -> []. + +%%% +%%% Short-cutting binary matching instructions. +%%% + +ssa_opt_bsm_shortcut(#st{ssa=Linear}=St) -> + Positions = bsm_positions(Linear, #{}), + case map_size(Positions) of + 0 -> + %% No binary matching instructions. + St; + _ -> + St#st{ssa=bsm_shortcut(Linear, Positions)} + end. + +bsm_positions([{L,#b_blk{is=Is,last=Last}}|Bs], PosMap0) -> + PosMap = bsm_positions_is(Is, PosMap0), + case {Is,Last} of + {[#b_set{op=bs_test_tail,dst=Bool,args=[Ctx,#b_literal{val=Bits0}]}], + #b_br{bool=Bool,fail=Fail}} -> + Bits = Bits0 + maps:get(Ctx, PosMap0), + bsm_positions(Bs, PosMap#{L=>{Bits,Fail}}); + {_,_} -> + bsm_positions(Bs, PosMap) + end; +bsm_positions([], PosMap) -> PosMap. + +bsm_positions_is([#b_set{op=bs_start_match,dst=New}|Is], PosMap0) -> + PosMap = PosMap0#{New=>0}, + bsm_positions_is(Is, PosMap); +bsm_positions_is([#b_set{op=bs_match,dst=New,args=Args}|Is], PosMap0) -> + [_,Old|_] = Args, + #{Old:=Bits0} = PosMap0, + Bits = bsm_update_bits(Args, Bits0), + PosMap = PosMap0#{New=>Bits}, + bsm_positions_is(Is, PosMap); +bsm_positions_is([_|Is], PosMap) -> + bsm_positions_is(Is, PosMap); +bsm_positions_is([], PosMap) -> PosMap. + +bsm_update_bits([#b_literal{val=string},_,#b_literal{val=String}], Bits) -> + Bits + bit_size(String); +bsm_update_bits([#b_literal{val=utf8}|_], Bits) -> + Bits + 8; +bsm_update_bits([#b_literal{val=utf16}|_], Bits) -> + Bits + 16; +bsm_update_bits([#b_literal{val=utf32}|_], Bits) -> + Bits + 32; +bsm_update_bits([_,_,_,#b_literal{val=Sz},#b_literal{val=U}], Bits) + when is_integer(Sz) -> + Bits + Sz*U; +bsm_update_bits(_, Bits) -> Bits. + +bsm_shortcut([{L,#b_blk{is=Is,last=Last0}=Blk}|Bs], PosMap) -> + case {Is,Last0} of + {[#b_set{op=bs_match,dst=New,args=[_,Old|_]}, + #b_set{op=succeeded,dst=Bool,args=[New]}], + #b_br{bool=Bool,fail=Fail}} -> + case PosMap of + #{Old:=Bits,Fail:={TailBits,NextFail}} when Bits > TailBits -> + Last = Last0#b_br{fail=NextFail}, + [{L,Blk#b_blk{last=Last}}|bsm_shortcut(Bs, PosMap)]; + #{} -> + [{L,Blk}|bsm_shortcut(Bs, PosMap)] + end; + {_,_} -> + [{L,Blk}|bsm_shortcut(Bs, PosMap)] + end; +bsm_shortcut([], _PosMap) -> []. + +%%% +%%% Miscellanous optimizations in execution order. +%%% + +ssa_opt_misc(#st{ssa=Linear}=St) -> + St#st{ssa=misc_opt(Linear, #{})}. + +misc_opt([{L,#b_blk{is=Is0,last=Last0}=Blk0}|Bs], Sub0) -> + {Is,Sub} = misc_opt_is(Is0, Sub0, []), + Last = sub(Last0, Sub), + Blk = Blk0#b_blk{is=Is,last=Last}, + [{L,Blk}|misc_opt(Bs, Sub)]; +misc_opt([], _) -> []. + +misc_opt_is([#b_set{op=phi}=I0|Is], Sub0, Acc) -> + #b_set{dst=Dst,args=Args} = I = sub(I0, Sub0), + case all_same(Args) of + true -> + %% Eliminate the phi node if there is just one source + %% value or if the values are identical. + [{Val,_}|_] = Args, + Sub = Sub0#{Dst=>Val}, + misc_opt_is(Is, Sub, Acc); + false -> + misc_opt_is(Is, Sub0, [I|Acc]) + end; +misc_opt_is([#b_set{}=I0|Is], Sub, Acc) -> + #b_set{op=Op,dst=Dst,args=Args} = I = sub(I0, Sub), + case make_literal(Op, Args) of + #b_literal{}=Literal -> + misc_opt_is(Is, Sub#{Dst=>Literal}, Acc); + error -> + misc_opt_is(Is, Sub, [I|Acc]) + end; +misc_opt_is([], Sub, Acc) -> + {reverse(Acc),Sub}. + +all_same([{H,_}|T]) -> + all(fun({E,_}) -> E =:= H end, T). + +make_literal(put_tuple, Args) -> + case make_literal_list(Args, []) of + error -> + error; + List -> + #b_literal{val=list_to_tuple(List)} + end; +make_literal(put_list, [#b_literal{val=H},#b_literal{val=T}]) -> + #b_literal{val=[H|T]}; +make_literal(_, _) -> error. + +make_literal_list([#b_literal{val=H}|T], Acc) -> + make_literal_list(T, [H|Acc]); +make_literal_list([_|_], _) -> + error; +make_literal_list([], Acc) -> + reverse(Acc). + +%%% +%%% Merge blocks. +%%% + +ssa_opt_merge_blocks(#st{ssa=Blocks}=St) -> + Preds = beam_ssa:predecessors(Blocks), + St#st{ssa=merge_blocks_1(beam_ssa:rpo(Blocks), Preds, Blocks)}. + +merge_blocks_1([L|Ls], Preds0, Blocks0) -> + case Preds0 of + #{L:=[P]} -> + #{P:=Blk0,L:=Blk1} = Blocks0, + case is_merge_allowed(L, Blk0, Blk1) of + true -> + #b_blk{is=Is0} = Blk0, + #b_blk{is=Is1} = Blk1, + Is = Is0 ++ Is1, + Blk = Blk1#b_blk{is=Is}, + Blocks1 = maps:remove(L, Blocks0), + Blocks2 = maps:put(P, Blk, Blocks1), + Successors = beam_ssa:successors(Blk), + Blocks = beam_ssa:update_phi_labels(Successors, L, P, Blocks2), + Preds = merge_update_preds(Successors, L, P, Preds0), + merge_blocks_1(Ls, Preds, Blocks); + false -> + merge_blocks_1(Ls, Preds0, Blocks0) + end; + #{} -> + merge_blocks_1(Ls, Preds0, Blocks0) + end; +merge_blocks_1([], _Preds, Blocks) -> Blocks. + +merge_update_preds([L|Ls], From, To, Preds0) -> + Ps = [rename_label(P, From, To) || P <- maps:get(L, Preds0)], + Preds = maps:put(L, Ps, Preds0), + merge_update_preds(Ls, From, To, Preds); +merge_update_preds([], _, _, Preds) -> Preds. + +rename_label(From, From, To) -> To; +rename_label(Lbl, _, _) -> Lbl. + +is_merge_allowed(_, _, #b_blk{is=[#b_set{op=peek_message}|_]}) -> + false; +is_merge_allowed(L, Blk0, #b_blk{}) -> + case beam_ssa:successors(Blk0) of + [L] -> true; + [_|_] -> false + end. + +%%% +%%% When a tuple is matched, the pattern matching compiler generates a +%%% get_tuple_element instruction for every tuple element that will +%%% ever be used in the rest of the function. That often forces the +%%% extracted tuple elements to be stored in Y registers until it's +%%% time to use them. It could also mean that there could be execution +%%% paths that will never use the extracted elements. +%%% +%%% This optimization will sink get_tuple_element instructions, that +%%% is, move them forward in the execution stream to the last possible +%%% block there they will still dominate all uses. That may reduce the +%%% size of stack frames, reduce register shuffling, and avoid +%%% extracting tuple elements on execution paths that never use the +%%% extracted values. +%%% + +ssa_opt_sink(#st{ssa=Blocks0}=St) -> + Linear = beam_ssa:linearize(Blocks0), + + %% Create a map with all variables that define get_tuple_element + %% instructions. The variable name map to the block it is defined in. + Defs = maps:from_list(def_blocks(Linear)), + + %% Now find all the blocks that use variables defined by get_tuple_element + %% instructions. + Used = used_blocks(Linear, Defs, []), + + %% Calculate dominators. + Dom0 = beam_ssa:dominators(Blocks0), + + %% It is not safe to move get_tuple_element instructions to blocks + %% that begin with certain instructions. It is also unsafe to move + %% the instructions into any part of a receive. To avoid such + %% unsafe moves, pretend that the unsuitable blocks are not + %% dominators. + Unsuitable = unsuitable(Linear, Blocks0), + Dom = case gb_sets:is_empty(Unsuitable) of + true -> + Dom0; + false -> + F = fun(_, DomBy) -> + [L || L <- DomBy, + not gb_sets:is_element(L, Unsuitable)] + end, + maps:map(F, Dom0) + end, + + %% Calculate new positions for get_tuple_element instructions. The new + %% position is a block that dominates all uses of the variable. + DefLoc = new_def_locations(Used, Defs, Dom), + + %% Now move all suitable get_tuple_element instructions to their + %% new blocks. + Blocks = foldl(fun({V,To}, A) -> + From = maps:get(V, Defs), + move_defs(V, From, To, A) + end, Blocks0, DefLoc), + St#st{ssa=Blocks}. + +def_blocks([{L,#b_blk{is=Is}}|Bs]) -> + def_blocks_is(Is, L, def_blocks(Bs)); +def_blocks([]) -> []. + +def_blocks_is([#b_set{op=get_tuple_element,dst=#b_var{name=Dst}}|Is], L, Acc) -> + def_blocks_is(Is, L, [{Dst,L}|Acc]); +def_blocks_is([_|Is], L, Acc) -> + def_blocks_is(Is, L, Acc); +def_blocks_is([], _, Acc) -> Acc. + +used_blocks([{L,Blk}|Bs], Def, Acc0) -> + Used = beam_ssa:used(Blk), + Acc = [{V,L} || V <- Used, maps:is_key(V, Def)] ++ Acc0, + used_blocks(Bs, Def, Acc); +used_blocks([], _Def, Acc) -> + rel2fam(Acc). + +%% unsuitable(Linear, Blocks) -> Unsuitable. +%% Return an ordset of block labels for the blocks that are not +%% suitable for sinking of get_tuple_element instructions. + +unsuitable(Linear, Blocks) -> + Predecessors = beam_ssa:predecessors(Blocks), + Unsuitable0 = unsuitable_1(Linear), + Unsuitable1 = unsuitable_recv(Linear, Blocks, Predecessors), + gb_sets:from_list(Unsuitable0 ++ Unsuitable1). + +unsuitable_1([{L,#b_blk{is=[#b_set{op=Op}|_]}}|Bs]) -> + Unsuitable = case Op of + bs_extract -> true; + bs_put -> true; + {float,_} -> true; + landingpad -> true; + peek_message -> true; + wait_timeout -> true; + _ -> false + end, + case Unsuitable of + true -> + [L|unsuitable_1(Bs)]; + false -> + unsuitable_1(Bs) + end; +unsuitable_1([{_,#b_blk{}}|Bs]) -> + unsuitable_1(Bs); +unsuitable_1([]) -> []. + +unsuitable_recv([{L,#b_blk{is=[#b_set{op=Op}|_]}}|Bs], Blocks, Predecessors) -> + Ls = case Op of + remove_message -> + unsuitable_loop(L, Blocks, Predecessors); + recv_next -> + unsuitable_loop(L, Blocks, Predecessors); + _ -> + [] + end, + Ls ++ unsuitable_recv(Bs, Blocks, Predecessors); +unsuitable_recv([_|Bs], Blocks, Predecessors) -> + unsuitable_recv(Bs, Blocks, Predecessors); +unsuitable_recv([], _, _) -> []. + +unsuitable_loop(L, Blocks, Predecessors) -> + unsuitable_loop(L, Blocks, Predecessors, []). + +unsuitable_loop(L, Blocks, Predecessors, Acc) -> + Ps = maps:get(L, Predecessors), + unsuitable_loop_1(Ps, Blocks, Predecessors, Acc). + +unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) -> + case maps:get(P, Blocks) of + #b_blk{is=[#b_set{op=peek_message}|_]} -> + unsuitable_loop_1(Ps, Blocks, Predecessors, Acc0); + #b_blk{} -> + case ordsets:is_element(P, Acc0) of + false -> + Acc1 = ordsets:add_element(P, Acc0), + Acc = unsuitable_loop(P, Blocks, Predecessors, Acc1), + unsuitable_loop_1(Ps, Blocks, Predecessors, Acc); + true -> + unsuitable_loop_1(Ps, Blocks, Predecessors, Acc0) + end + end; +unsuitable_loop_1([], _, _, Acc) -> Acc. + +%% new_def_locations([{Variable,[UsedInBlock]}|Vs], Defs, Dominators) -> +%% [{Variable,NewDefinitionBlock}] +%% Calculate new locations for get_tuple_element instructions. For each +%% variable, the new location is a block that dominates all uses of +%% variable and as near to the uses of as possible. If no such block +%% distinct from the block where the instruction currently is, the +%% variable will not be included in the result list. + +new_def_locations([{V,UsedIn}|Vs], Defs, Dom) -> + DefIn = maps:get(V, Defs), + case common_dom(UsedIn, DefIn, Dom) of + [] -> + new_def_locations(Vs, Defs, Dom); + [_|_]=BetterDef -> + L = most_dominated(BetterDef, Dom), + [{V,L}|new_def_locations(Vs, Defs, Dom)] + end; +new_def_locations([], _, _) -> []. + +common_dom([L|Ls], DefIn, Dom) -> + DomBy0 = maps:get(L, Dom), + DomBy = ordsets:subtract(DomBy0, maps:get(DefIn, Dom)), + common_dom_1(Ls, Dom, DomBy). + +common_dom_1(_, _, []) -> + []; +common_dom_1([L|Ls], Dom, [_|_]=DomBy0) -> + DomBy1 = maps:get(L, Dom), + DomBy = ordsets:intersection(DomBy0, DomBy1), + common_dom_1(Ls, Dom, DomBy); +common_dom_1([], _, DomBy) -> DomBy. + +most_dominated([L|Ls], Dom) -> + most_dominated(Ls, L, maps:get(L, Dom), Dom). + +most_dominated([L|Ls], L0, DomBy, Dom) -> + case member(L, DomBy) of + true -> + most_dominated(Ls, L0, DomBy, Dom); + false -> + most_dominated(Ls, L, maps:get(L, Dom), Dom) + end; +most_dominated([], L, _, _) -> L. + + +%% Move get_tuple_element instructions to their new locations. + +move_defs(V, From, To, Blocks) -> + #{From:=FromBlk0,To:=ToBlk0} = Blocks, + {Def,FromBlk} = remove_def(V, FromBlk0), + try insert_def(V, Def, ToBlk0) of + ToBlk -> + %%io:format("~p: ~p => ~p\n", [V,From,To]), + Blocks#{From:=FromBlk,To:=ToBlk} + catch + throw:not_possible -> + Blocks + end. + +remove_def(V, #b_blk{is=Is0}=Blk) -> + {Def,Is} = remove_def_is(Is0, V, []), + {Def,Blk#b_blk{is=Is}}. + +remove_def_is([#b_set{dst=#b_var{name=Dst}}=Def|Is], Dst, Acc) -> + {Def,reverse(Acc, Is)}; +remove_def_is([I|Is], Dst, Acc) -> + remove_def_is(Is, Dst, [I|Acc]). + +insert_def(V, Def, #b_blk{is=Is0}=Blk) -> + Is = insert_def_is(Is0, V, Def), + Blk#b_blk{is=Is}. + +insert_def_is([#b_set{op=phi}=I|Is], V, Def) -> + case member(V, beam_ssa:used(I)) of + true -> + throw(not_possible); + false -> + [I|insert_def_is(Is, V, Def)] + end; +insert_def_is([#b_set{op=Op}=I|Is]=Is0, V, Def) -> + Action0 = case Op of + call -> beyond; + 'catch_end' -> beyond; + set_tuple_element -> beyond; + timeout -> beyond; + _ -> here + end, + Action = case Is of + [#b_set{op=succeeded}|_] -> here; + _ -> Action0 + end, + case Action of + beyond -> + case member(V, beam_ssa:used(I)) of + true -> + %% The variable is used by this instruction. We must + %% place the definition before this instruction. + [Def|Is0]; + false -> + %% Place it beyond the current instruction. + [I|insert_def_is(Is, V, Def)] + end; + here -> + [Def|Is0] + end; +insert_def_is([], _V, Def) -> + [Def]. + + +%%% +%%% Common utilities. +%%% + +rel2fam(S0) -> + S1 = sofs:relation(S0), + S = sofs:rel2fam(S1), + sofs:to_external(S). + +sub(#b_set{op=phi,args=Args}=I, Sub) -> + I#b_set{args=[{sub_arg(A, Sub),P} || {A,P} <- Args]}; +sub(#b_set{args=Args}=I, Sub) -> + I#b_set{args=[sub_arg(A, Sub) || A <- Args]}; +sub(#b_br{bool=#b_var{}=Old}=Br, Sub) -> + New = sub_arg(Old, Sub), + Br#b_br{bool=New}; +sub(#b_switch{arg=#b_var{}=Old}=Sw, Sub) -> + New = sub_arg(Old, Sub), + Sw#b_switch{arg=New}; +sub(#b_ret{arg=#b_var{}=Old}=Ret, Sub) -> + New = sub_arg(Old, Sub), + Ret#b_ret{arg=New}; +sub(Last, _) -> Last. + +sub_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub) -> + Rem#b_remote{mod=sub_arg(Mod, Sub),name=sub_arg(Name, Sub)}; +sub_arg(Old, Sub) -> + case Sub of + #{Old:=New} -> New; + #{} -> Old + end. diff --git a/lib/compiler/src/beam_ssa_pp.erl b/lib/compiler/src/beam_ssa_pp.erl new file mode 100644 index 0000000000..9daa2c2523 --- /dev/null +++ b/lib/compiler/src/beam_ssa_pp.erl @@ -0,0 +1,238 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_ssa_pp). + +-export([format_function/1,format_instr/1,format_var/1]). + +-include("beam_ssa.hrl"). + +-spec format_function(beam_ssa:b_function()) -> iolist(). + +format_function(#b_function{anno=Anno0,args=Args, + bs=Blocks,cnt=Counter}) -> + #{func_info:={M,F,_}} = Anno0, + Anno = maps:without([func_info,location,live_intervals,registers], Anno0), + FuncAnno = case Anno0 of + #{live_intervals:=Intervals} -> + Anno0#{live_intervals:=maps:from_list(Intervals)}; + #{} -> + Anno0 + end, + ReachableBlocks = beam_ssa:rpo(Blocks), + All = maps:keys(Blocks), + Unreachable = ordsets:subtract(ordsets:from_list(All), + ordsets:from_list(ReachableBlocks)), + [case Anno0 of + #{location:={Filename,Line}} -> + io_lib:format("%% ~ts:~p\n", [Filename,Line]); + #{} -> + [] + end, + io_lib:format("%% Counter = ~p\n", [Counter]), + [format_anno(Key, Value) || + {Key,Value} <- lists:sort(maps:to_list(Anno))], + io_lib:format("function ~p:~p(~ts) {\n", [M,F,format_args(Args, FuncAnno)]), + [format_live_interval(Var, FuncAnno) || Var <- Args], + format_blocks(ReachableBlocks, Blocks, FuncAnno), + case Unreachable of + [] -> + []; + [_|_] -> + ["\n%% Unreachable blocks\n\n", + format_blocks(Unreachable, Blocks, FuncAnno)] + end, + + "}\n"]. + + +-spec format_instr(beam_ssa:b_set()) -> iolist(). + +format_instr(#b_set{}=I) -> + Cs = lists:flatten(format_instr(I#b_set{anno=#{}}, #{}, true)), + string:trim(Cs, leading); +format_instr(I0) -> + I = setelement(2, I0, #{}), + Cs = lists:flatten(format_terminator(I, #{})), + string:trim(Cs, both). + +-spec format_var(beam_ssa:b_var()) -> iolist(). + +format_var(V) -> + Cs = lists:flatten(format_var(V, #{})), + string:trim(Cs, leading). + +%%% +%%% Local functions. +%%% + +format_anno(Key, Map) when is_map(Map) -> + Sorted = lists:sort(maps:to_list(Map)), + [io_lib:format("%% ~s:\n", [Key]), + [io_lib:format("%% ~w => ~w\n", [K,V]) || {K,V} <- Sorted]]; +format_anno(Key, Value) -> + io_lib:format("%% ~s: ~p\n", [Key,Value]). + +format_blocks(Ls, Blocks, Anno) -> + PP = [format_block(L, Blocks, Anno) || L <- Ls], + lists:join($\n, PP). + +format_block(L, Blocks, FuncAnno) -> + #b_blk{anno=Anno,is=Is,last=Last} = maps:get(L, Blocks), + [case map_size(Anno) of + 0 -> []; + _ -> io_lib:format("%% ~p\n", [Anno]) + end, + io_lib:format("~p:", [L]), + format_instrs(Is, FuncAnno, true), + $\n, + format_terminator(Last, FuncAnno)]. + +format_instrs([I|Is], FuncAnno, First) -> + [$\n, + format_instr(I, FuncAnno, First), + format_instrs(Is, FuncAnno, false)]; +format_instrs([], _FuncAnno, _First) -> + []. + +format_instr(#b_set{anno=Anno,op=Op,dst=Dst,args=Args}, + FuncAnno, First) -> + AnnoStr = format_anno(Anno), + LiveIntervalStr = format_live_interval(Dst, FuncAnno), + [if + First -> + []; + AnnoStr =/= []; LiveIntervalStr =/= [] -> + $\n; + true -> + [] + end, + AnnoStr, + LiveIntervalStr, + io_lib:format(" ~s~ts = ~ts", [format_i_number(Anno), + format_var(Dst, FuncAnno), + format_op(Op)]), + case Args of + [] -> + []; + [_|_] -> + io_lib:format(" ~ts", [format_args(Args, FuncAnno)]) + end]. + +format_i_number(#{n:=N}) -> + io_lib:format("[~p] ", [N]); +format_i_number(#{}) -> []. + +format_terminator(#b_br{anno=A,bool=#b_literal{val=true},succ=Lbl}, _) -> + io_lib:format(" ~sbr label ~p\n", [format_i_number(A),Lbl]); +format_terminator(#b_br{anno=A,bool=#b_literal{val=false},fail=Lbl}, _) -> + io_lib:format(" ~sbr label ~p\n", [format_i_number(A),Lbl]); +format_terminator(#b_br{anno=A,bool=Bool,succ=Succ,fail=Fail}, FuncAnno) -> + io_lib:format(" ~sbr ~ts, label ~p, label ~p\n", + [format_i_number(A),format_arg(Bool, FuncAnno),Succ,Fail]); +format_terminator(#b_switch{anno=A,arg=Arg,fail=Fail,list=List}, FuncAnno) -> + io_lib:format(" ~sswitch ~ts, label ~p, ~ts\n", + [format_i_number(A),format_arg(Arg, FuncAnno),Fail, + format_list(List,FuncAnno)]); +format_terminator(#b_ret{anno=A,arg=Arg}, FuncAnno) -> + io_lib:format(" ~sret ~ts\n", [format_i_number(A),format_arg(Arg, FuncAnno)]). + +format_op({Prefix,Name}) -> + io_lib:format("~p:~p", [Prefix,Name]); +format_op(Name) -> + io_lib:format("~p", [Name]). + +format_register(#b_var{name=V}, #{registers:=Regs}) -> + {Tag,N} = maps:get(V, Regs), + io_lib:format("~p~p", [Tag,N]); +format_register(_, #{}) -> "". + +format_var(Var, FuncAnno) -> + VarString = format_var_1(Var), + case format_register(Var, FuncAnno) of + [] -> VarString; + [_|_]=Reg -> [Reg,$/,VarString] + end. + +format_var_1(#b_var{name={Name,Uniq}}) -> + if + is_atom(Name) -> + io_lib:format("~ts:~p", [Name,Uniq]); + is_integer(Name) -> + io_lib:format("_~p:~p", [Name,Uniq]) + end; +format_var_1(#b_var{name=Name}) when is_atom(Name) -> + atom_to_list(Name); +format_var_1(#b_var{name=Name}) when is_integer(Name) -> + "_"++integer_to_list(Name). + +format_args(Args, FuncAnno) -> + Ss = [format_arg(Arg, FuncAnno) || Arg <- Args], + lists:join(", ", Ss). + +format_arg(#b_var{}=Arg, FuncAnno) -> + format_var(Arg, FuncAnno); +format_arg(#b_literal{val=Val}, _FuncAnno) -> + io_lib:format("literal ~p", [Val]); +format_arg(#b_remote{mod=Mod,name=Name,arity=Arity}, FuncAnno) -> + io_lib:format("remote (~ts):(~ts)/~p", + [format_arg(Mod, FuncAnno),format_arg(Name, FuncAnno),Arity]); +format_arg(#b_local{name=Name,arity=Arity}, FuncAnno) -> + io_lib:format("local ~ts/~p", [format_arg(Name, FuncAnno),Arity]); +format_arg({Value,Label}, FuncAnno) when is_integer(Label) -> + io_lib:format("{ ~ts, ~p }", [format_arg(Value, FuncAnno),Label]); +format_arg(Other, _) -> + io_lib:format("*** ~p ***", [Other]). + +format_list(List, FuncAnno) -> + Ss = [io_lib:format("{ ~ts, ~ts }", [format_arg(Val, FuncAnno),format_label(L)]) || + {Val,L} <- List], + io_lib:format("[ ~ts ]", [lists:join(", ", Ss)]). + +format_label(L) -> + ["label ",integer_to_list(L)]. + +format_anno(#{n:=_}=Anno) -> + format_anno(maps:remove(n, Anno)); +format_anno(#{location:={File,Line}}=Anno0) -> + Anno = maps:remove(location, Anno0), + [io_lib:format(" %% ~ts:~p\n", [File,Line])|format_anno_1(Anno)]; +format_anno(Anno) -> + format_anno_1(Anno). + +format_anno_1(Anno) -> + case map_size(Anno) of + 0 -> + []; + _ -> + [io_lib:format(" %% Anno: ~p\n", [Anno])] + end. + +format_live_interval(#b_var{name=V}=Dst, #{live_intervals:=Intervals}) -> + case Intervals of + #{V:=Rs0} -> + Rs1 = [io_lib:format("~p..~p", [Start,End]) || + {Start,End} <- Rs0], + Rs = lists:join(" ", Rs1), + io_lib:format(" %% ~ts: ~s\n", [format_var_1(Dst),Rs]); + #{} -> + [] + end; +format_live_interval(_, _) -> []. + diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl new file mode 100644 index 0000000000..54aa2efaf6 --- /dev/null +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -0,0 +1,2440 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose: Prepare for code generation, including register allocation. +%% +%% The output of this compiler pass is still in the SSA format, but +%% it has been annotated and transformed to help the code generator. +%% +%% * Some instructions are translated to other instructions closer to +%% the BEAM instructions. For example, the put_tuple instruction is +%% broken apart into the put_tuple_arity and put_tuple_elements +%% instructions. Similary, the binary matching instructions are +%% transformed from the optimization-friendly internal format to +%% instruction more similar to the actual BEAM instructions. +%% +%% * Blocks that will need an instruction for allocating a stack frame +%% are annotated with a {frame_size,Size} annotation. +%% +%% * 'copy' instructions are added for all variables that need +%% to be saved to the stack frame. Additional 'copy' instructions +%% can be added as an optimization to reuse y registers (see +%% the copy_retval sub pass). +%% +%% * Each function is annotated with a {register,RegisterMap} +%% annotation that maps each variable to a BEAM register. The linear +%% scan algorithm is used to allocate registers. +%% +%% There are four kind of registers. x, y, fr (floating point register), +%% and z. A variable will be allocated to a z register if it is only +%% used by the instruction following the instruction that defines the +%% the variable. The code generator will typically combine those +%% instructions to a test instruction. z registers are also used for +%% some instructions that don't have a return value. +%% +%% References: +%% +%% [1] H. Mössenböck and M. Pfeiffer. Linear scan register allocation +%% in the context of SSA form and register constraints. In Proceedings +%% of the International Conference on Compiler Construction, pages +%% 229–246. LNCS 2304, Springer-Verlag, 2002. +%% +%% [2] C. Wimmer and H. Mössenböck. Optimized interval splitting in a +%% linear scan register allocator. In Proceedings of the ACM/USENIX +%% International Conference on Virtual Execution Environments, pages +%% 132–141. ACM Press, 2005. +%% +%% [3] C. Wimmer and M. Franz. Linear Scan Register Allocation on SSA +%% Form. In Proceedings of the International Symposium on Code +%% Generation and Optimization, pages 170-179. ACM Press, 2010. +%% + +-module(beam_ssa_pre_codegen). + +-export([module/2]). + +-include("beam_ssa.hrl"). + +-import(lists, [all/2,any/2,append/1,duplicate/2, + foldl/3,last/1,map/2,member/2,partition/2, + reverse/1,reverse/2,sort/1,zip/2]). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, Opts) -> + FixTuples = proplists:get_bool(no_put_tuple2, Opts), + ExtraAnnos = proplists:get_bool(dprecg, Opts), + Ps = passes(FixTuples, ExtraAnnos), + Fs = functions(Fs0, Ps), + {ok,Module#b_module{body=Fs}}. + +functions([F|Fs], Ps) -> + [function(F, Ps)|functions(Fs, Ps)]; +functions([], _Ps) -> []. + +-type b_var() :: beam_ssa:b_var(). +-type var_name() :: beam_ssa:var_name(). +-type instr_number() :: pos_integer(). +-type range() :: {instr_number(),instr_number()}. +-type reg_num() :: beam_asm:reg_num(). +-type xreg() :: {'x',reg_num()}. +-type yreg() :: {'y',reg_num()}. +-type ypool() :: {'y',beam_ssa:label()}. +-type reservation() :: 'fr' | {'prefer',xreg()} | 'x' | {'x',xreg()} | + ypool() | {yreg(),ypool()} | 'z'. +-type ssa_register() :: beam_ssa_codegen:ssa_register(). + +-define(TC(Body), tc(fun() -> Body end, ?FILE, ?LINE)). +-record(st, {ssa :: beam_ssa:block_map(), + args :: [b_var()], + cnt :: beam_ssa:label(), + frames=[] :: [beam_ssa:label()], + intervals=[] :: [{b_var(),[range()]}], + aliases=[] :: [{b_var(),b_var()}], + res=[] :: [{b_var(),reservation()}] | #{b_var():=reservation()}, + regs=#{} :: #{b_var():=ssa_register()}, + extra_annos=[] :: [{atom(),term()}] + }). +-define(PASS(N), {N,fun N/1}). + +passes(FixTuples, ExtraAnnos) -> + Ps = [?PASS(assert_no_critical_edges), + + %% Preliminaries. + ?PASS(fix_bs), + ?PASS(sanitize), + case FixTuples of + false -> ignore; + true -> ?PASS(fix_tuples) + end, + ?PASS(place_frames), + ?PASS(fix_receives), + + %% Find and reserve Y registers. + ?PASS(find_yregs), + ?PASS(reserve_yregs), + + %% Improve reuse of Y registers to potentially + %% reduce the size of the stack frame. + ?PASS(copy_retval), + ?PASS(opt_get_list), + + %% Calculate live intervals. + ?PASS(number_instructions), + ?PASS(live_intervals), + ?PASS(remove_unsuitable_aliases), + ?PASS(reserve_regs), + ?PASS(merge_intervals), + + %% If needed for a .precg file, save the live intervals + %% so they can be included in an annotation. + case ExtraAnnos of + false -> ignore; + true -> ?PASS(save_live_intervals) + end, + + %% Allocate registers. + ?PASS(linear_scan), + ?PASS(fix_aliased_regs), + ?PASS(frame_size), + ?PASS(turn_yregs)], + [P || P <- Ps, P =/= ignore]. + +function(#b_function{anno=Anno,args=Args,bs=Blocks0,cnt=Count0}=F0, Ps) -> + try + St0 = #st{ssa=Blocks0,args=Args,cnt=Count0}, + St = compile:run_sub_passes(Ps, St0), + #st{ssa=Blocks,cnt=Count,regs=Regs,extra_annos=ExtraAnnos} = St, + F1 = add_extra_annos(F0, ExtraAnnos), + F = beam_ssa:add_anno(registers, Regs, F1), + F#b_function{bs=Blocks,cnt=Count} + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +save_live_intervals(#st{intervals=Intervals}=St) -> + St#st{extra_annos=[{live_intervals,Intervals}]}. + +fix_aliased_regs(#st{aliases=Aliases,regs=Regs}=St) -> + St#st{regs=fix_aliased_regs(Aliases, Regs)}. + +fix_aliased_regs([{Alias,V}|Aliases], Regs) -> + #{V:=Reg} = Regs, + fix_aliased_regs(Aliases, Regs#{Alias=>Reg}); +fix_aliased_regs([], Regs) -> Regs. + +%% Add extra annotations when a .precg listing file is being produced. +add_extra_annos(F, Annos) -> + foldl(fun({Name,Value}, Acc) -> + beam_ssa:add_anno(Name, Value, Acc) + end, F, Annos). + +%% assert_no_critical_edges(St0) -> St. +%% The code generator will not work if there are critial edges. +%% Abort if any critical edges are found. + +assert_no_critical_edges(#st{ssa=Blocks}=St) -> + F = fun assert_no_ces/3, + beam_ssa:fold_rpo(F, Blocks, Blocks), + St. + +assert_no_ces(_, #b_blk{is=[#b_set{op=phi,args=[_,_]=Phis}|_]}, Blocks) -> + %% This block has multiple predecessors. Make sure that none + %% of the precessors have more than one successor. + true = all(fun({_,P}) -> + length(beam_ssa:successors(P, Blocks)) =:= 1 + end, Phis), %Assertion. + Blocks; +assert_no_ces(_, _, Blocks) -> Blocks. + +%% fix_bs(St0) -> St. +%% Fix up the binary matching instructions: +%% +%% * Insert bs_save and bs_restore instructions where needed. +%% +%% * Combine bs_match and bs_extract instructions to bs_get +%% instructions. + +fix_bs(#st{ssa=Blocks,cnt=Count0}=St) -> + F = fun(#b_set{op=bs_start_match,dst=Dst}, A) -> + %% Mark the root of the match context list. + [{Dst,{context,Dst}}|A]; + (#b_set{op=bs_match,dst=Dst,args=[_,ParentCtx|_]}, A) -> + %% Link this match context the previous match context. + [{Dst,ParentCtx}|A]; + (_, A) -> + A + end, + case beam_ssa:fold_instrs_rpo(F, [0], [],Blocks) of + [] -> + %% No binary matching in this function. + St; + [_|_]=M -> + CtxChain = maps:from_list(M), + Linear0 = beam_ssa:linearize(Blocks), + + %% Insert bs_save / bs_restore instructions where needed. + {Linear1,Count} = bs_save_restore(Linear0, CtxChain, Count0), + + %% Rename instructions. + Linear = bs_instrs(Linear1, CtxChain, []), + + St#st{ssa=maps:from_list(Linear),cnt=Count} + end. + + +%% Insert bs_save and bs_restore instructions as needed. + +bs_save_restore(Linear0, CtxChain, Count0) -> + Rs0 = bs_restores(Linear0, CtxChain, #{}, #{}), + Rs = maps:values(Rs0), + S0 = sofs:relation(Rs, [{context,save_point}]), + S1 = sofs:relation_to_family(S0), + S = sofs:to_external(S1), + Slots = make_save_point_dict(S, []), + {Saves,Count1} = make_save_map(Rs, Slots, Count0, []), + {Restores,Count} = make_restore_map(maps:to_list(Rs0), Slots, Count1, []), + + %% Now insert all saves and restores. + {bs_insert(Linear0, Saves, Restores, Slots),Count}. + +make_save_map([{Ctx,Save}=Ps|T], Slots, Count, Acc) -> + Ignored = #b_var{name={'@ssa_ignored',Count}}, + case make_slot(Ps, Slots) of + #b_literal{val=start} -> + make_save_map(T, Slots, Count, Acc); + Slot -> + I = #b_set{op=bs_save,dst=Ignored,args=[Ctx,Slot]}, + make_save_map(T, Slots, Count+1, [{Save,I}|Acc]) + end; +make_save_map([], _, Count, Acc) -> + {maps:from_list(Acc),Count}. + +make_restore_map([{Bef,{Ctx,_}=Ps}|T], Slots, Count, Acc) -> + Ignored = #b_var{name={'@ssa_ignored',Count}}, + I = #b_set{op=bs_restore,dst=Ignored,args=[Ctx,make_slot(Ps, Slots)]}, + make_restore_map(T, Slots, Count+1, [{Bef,I}|Acc]); +make_restore_map([], _, Count, Acc) -> + {maps:from_list(Acc),Count}. + +make_slot({Same,Same}, _Slots) -> + #b_literal{val=start}; +make_slot({_,_}=Ps, Slots) -> + #b_literal{val=maps:get(Ps, Slots)}. + +make_save_point_dict([{Ctx,Pts}|T], Acc0) -> + Acc = make_save_point_dict_1(Pts, Ctx, 0, Acc0), + make_save_point_dict(T, Acc); +make_save_point_dict([], Acc) -> + maps:from_list(Acc). + +make_save_point_dict_1([Ctx|T], Ctx, I, Acc) -> + %% Special {atom,start} save point. Does not need a + %% bs_save instruction. + make_save_point_dict_1(T, Ctx, I, Acc); +make_save_point_dict_1([H|T], Ctx, I, Acc) -> + make_save_point_dict_1(T, Ctx, I+1, [{{Ctx,H},I}|Acc]); +make_save_point_dict_1([], Ctx, I, Acc) -> + [{Ctx,I}|Acc]. + +bs_restores([{L,#b_blk{is=Is,last=Last}}|Bs], CtxChain, D0, Rs0) -> + FPos = case D0 of + #{L:=Pos0} -> Pos0; + #{} -> #{} + end, + {SPos,Rs} = bs_restores_is(Is, CtxChain, FPos, Rs0), + D = bs_update_successors(Last, SPos, FPos, D0), + bs_restores(Bs, CtxChain, D, Rs); +bs_restores([], _, _, Rs) -> Rs. + +bs_update_successors(#b_br{succ=Succ,fail=Fail}, SPos, FPos, D) -> + join_positions([{Succ,SPos},{Fail,FPos}], D); +bs_update_successors(#b_switch{fail=Fail,list=List}, SPos, FPos, D) -> + SPos = FPos, %Assertion. + Update = [{L,SPos} || {_,L} <- List] ++ [{Fail,SPos}], + join_positions(Update, D); +bs_update_successors(#b_ret{}, _, _, D) -> D. + +join_positions([{L,MapPos0}|T], D) -> + case D of + #{L:=MapPos0} -> + %% Same map. + join_positions(T, D); + #{L:=MapPos1} -> + %% Different maps. + MapPos = join_positions_1(MapPos0, MapPos1), + join_positions(T, D#{L:=MapPos}); + #{} -> + join_positions(T, D#{L=>MapPos0}) + end; +join_positions([], D) -> D. + +join_positions_1(MapPos0, MapPos1) -> + MapPos2 = maps:map(fun(Start, Pos) -> + case MapPos0 of + #{Start:=Pos} -> Pos; + #{Start:=_} -> unknown; + #{} -> Pos + end + end, MapPos1), + maps:merge(MapPos0, MapPos2). + +bs_restores_is([#b_set{op=bs_start_match,dst=Start}|Is], + CtxChain, PosMap0, Rs) -> + PosMap = PosMap0#{Start=>Start}, + bs_restores_is(Is, CtxChain, PosMap, Rs); +bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is], + CtxChain, PosMap0, Rs0) -> + Start = bs_subst_ctx(NewPos, CtxChain), + [_,FromPos|_] = Args, + case PosMap0 of + #{Start:=FromPos} -> + %% Same position, no restore needed. + PosMap = case bs_match_type(I) of + plain -> + %% Update position to new position. + PosMap0#{Start:=NewPos}; + _ -> + %% Position will not change (test_unit + %% instruction or no instruction at + %% all). + PosMap0#{Start:=FromPos} + end, + bs_restores_is(Is, CtxChain, PosMap, Rs0); + #{Start:=_} -> + %% Different positions, might need a restore instruction. + case bs_match_type(I) of + none -> + %% The tail test will be optimized away. + %% No need to do a restore. + PosMap = PosMap0#{Start:=FromPos}, + bs_restores_is(Is, CtxChain, PosMap, Rs0); + test_unit -> + %% This match instruction will be replaced by + %% a test_unit instruction. We will need a + %% restore. The new position will be the position + %% restored to (NOT NewPos). + PosMap = PosMap0#{Start:=FromPos}, + Rs = Rs0#{NewPos=>{Start,FromPos}}, + bs_restores_is(Is, CtxChain, PosMap, Rs); + plain -> + %% Match or skip. Position will be changed. + PosMap = PosMap0#{Start:=NewPos}, + Rs = Rs0#{NewPos=>{Start,FromPos}}, + bs_restores_is(Is, CtxChain, PosMap, Rs) + end + end; +bs_restores_is([#b_set{op=bs_extract,args=[FromPos|_]}|Is], + CtxChain, PosMap, Rs) -> + Start = bs_subst_ctx(FromPos, CtxChain), + #{Start:=FromPos} = PosMap, %Assertion. + bs_restores_is(Is, CtxChain, PosMap, Rs); +bs_restores_is([#b_set{op=Op,dst=Dst,args=Args}|Is], + CtxChain, PosMap0, Rs0) + when Op =:= bs_test_tail; + Op =:= call -> + {Rs,PosMap} = bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0), + bs_restores_is(Is, CtxChain, PosMap, Rs); +bs_restores_is([_|Is], CtxChain, PosMap, Rs) -> + bs_restores_is(Is, CtxChain, PosMap, Rs); +bs_restores_is([], _CtxChain, PosMap, Rs) -> + {PosMap,Rs}. + + +bs_match_type(#b_set{args=[#b_literal{val=skip},_Ctx, + #b_literal{val=binary},_Flags, + #b_literal{val=all},#b_literal{val=U}]}) -> + case U of + 1 -> none; + _ -> test_unit + end; +bs_match_type(_) -> + plain. + +bs_restore_args([#b_var{}=Arg|Args], PosMap0, CtxChain, Dst, Rs0) -> + Start = bs_subst_ctx(Arg, CtxChain), + case PosMap0 of + #{Start:=Arg} -> + %% Same position, no restore needed. + bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0); + #{Start:=_} -> + %% Different positions, need a restore instruction. + PosMap = PosMap0#{Start:=Arg}, + Rs = Rs0#{Dst=>{Start,Arg}}, + bs_restore_args(Args, PosMap, CtxChain, Dst, Rs); + #{} -> + %% Not a match context. + bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0) + end; +bs_restore_args([_|Args], PosMap, CtxChain, Dst, Rs) -> + bs_restore_args(Args, PosMap, CtxChain, Dst, Rs); +bs_restore_args([], PosMap, _CtxChain, _Dst, Rs) -> + {Rs,PosMap}. + +%% Insert all bs_save and bs_restore instructions. + +bs_insert([{L,#b_blk{is=Is0}=Blk}|Bs0], Saves, Restores, Slots) -> + Is = bs_insert_is_1(Is0, Restores, Slots), + Bs = bs_insert_saves(Is, Bs0, Saves), + [{L,Blk#b_blk{is=Is}}|bs_insert(Bs, Saves, Restores, Slots)]; +bs_insert([], _, _, _) -> []. + +bs_insert_is_1([#b_set{op=Op,dst=Dst}=I0|Is], Restores, Slots) -> + if + Op =:= bs_test_tail; + Op =:= bs_match; + Op =:= call -> + Rs = case Restores of + #{Dst:=R} -> [R]; + #{} -> [] + end, + Rs ++ [I0|bs_insert_is_1(Is, Restores, Slots)]; + Op =:= bs_start_match -> + NumSlots = case Slots of + #{Dst:=NumSlots0} -> NumSlots0; + #{} -> 0 + end, + I = beam_ssa:add_anno(num_slots, NumSlots, I0), + [I|bs_insert_is_1(Is, Restores, Slots)]; + true -> + [I0|bs_insert_is_1(Is, Restores, Slots)] + end; +bs_insert_is_1([], _, _) -> []. + +bs_insert_saves([#b_set{dst=Dst}|Is], Bs, Saves) -> + case Saves of + #{Dst:=S} -> + bs_insert_save(S, Bs); + #{} -> + bs_insert_saves(Is, Bs, Saves) + end; +bs_insert_saves([], Bs, _) -> Bs. + +bs_insert_save(Save, [{L,#b_blk{is=Is0}=Blk}|Bs]) -> + Is = case Is0 of + [#b_set{op=bs_extract}=Ex|Is1] -> + [Ex,Save|Is1]; + _ -> + [Save|Is0] + end, + [{L,Blk#b_blk{is=Is}}|Bs]. + +%% Translate bs_match instructions to bs_get, bs_match_string, +%% or bs_skip. Also rename match context variables to use the +%% variable assigned to by the start_match instruction. + +bs_instrs([{L,#b_blk{is=Is0}=Blk}|Bs], CtxChain, Acc0) -> + case bs_instrs_is(Is0, CtxChain, []) of + [#b_set{op=bs_extract,dst=Dst,args=[Ctx]}|Is] -> + %% Drop this instruction. Rewrite the corresponding + %% bs_match instruction in the previous block to + %% a bs_get instruction. + Acc = bs_combine(Dst, Ctx, Acc0), + bs_instrs(Bs, CtxChain, [{L,Blk#b_blk{is=Is}}|Acc]); + Is -> + bs_instrs(Bs, CtxChain, [{L,Blk#b_blk{is=Is}}|Acc0]) + end; +bs_instrs([], _, Acc) -> + reverse(Acc). + +bs_instrs_is([#b_set{op=Op,args=Args0}=I0|Is], CtxChain, Acc) -> + Args = [bs_subst_ctx(A, CtxChain) || A <- Args0], + I1 = I0#b_set{args=Args}, + I = case {Op,Args} of + {bs_match,[#b_literal{val=skip},Ctx,Type|As]} -> + I1#b_set{op=bs_skip,args=[Type,Ctx|As]}; + {bs_match,[#b_literal{val=string},Ctx|As]} -> + I1#b_set{op=bs_match_string,args=[Ctx|As]}; + {_,_} -> + I1 + end, + bs_instrs_is(Is, CtxChain, [I|Acc]); +bs_instrs_is([], _, Acc) -> + reverse(Acc). + +%% Combine a bs_match instruction with the destination register +%% taken from a bs_extract instruction. + +bs_combine(Dst, Ctx, [{L,#b_blk{is=Is0}=Blk}|Acc]) -> + [#b_set{}=Succeeded, + #b_set{op=bs_match,args=[Type,_|As]}=BsMatch|Is1] = reverse(Is0), + Is = reverse(Is1, [BsMatch#b_set{op=bs_get,dst=Dst,args=[Type,Ctx|As]}, + Succeeded#b_set{args=[Dst]}]), + [{L,Blk#b_blk{is=Is}}|Acc]. + +bs_subst_ctx(#b_var{}=Var, CtxChain) -> + case CtxChain of + #{Var:={context,Ctx}} -> + Ctx; + #{Var:=ParentCtx} -> + bs_subst_ctx(ParentCtx, CtxChain); + #{} -> + %% Not a match context variable. + Var + end; +bs_subst_ctx(Other, _CtxChain) -> + Other. + +%% sanitize(St0) -> St. +%% Remove constructs that can cause problems later: +%% +%% * Unreachable blocks may cause problems for determination of +%% dominators. +%% +%% * Some instructions (such as get_hd) don't accept literal +%% arguments. Evaluate the instructions and remove them. + +sanitize(#st{ssa=Blocks0,cnt=Count0}=St) -> + Ls = beam_ssa:rpo(Blocks0), + {Blocks,Count} = sanitize(Ls, Count0, Blocks0, #{}), + St#st{ssa=Blocks,cnt=Count}. + +sanitize([L|Ls], Count0, Blocks0, Values0) -> + #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks0), + case sanitize_is(Is0, Count0, Values0, false, []) of + no_change -> + sanitize(Ls, Count0, Blocks0, Values0); + {Is,Count,Values} -> + Blk = Blk0#b_blk{is=Is}, + Blocks = Blocks0#{L:=Blk}, + sanitize(Ls, Count, Blocks, Values) + end; +sanitize([], Count, Blocks0, Values) -> + Blocks = if + map_size(Values) =:= 0 -> + Blocks0; + true -> + beam_ssa:rename_vars(Values, [0], Blocks0) + end, + + %% Unreachable blocks can cause problems for the dominator calculations. + Ls = beam_ssa:rpo(Blocks), + Reachable = gb_sets:from_list(Ls), + {case map_size(Blocks) =:= gb_sets:size(Reachable) of + true -> Blocks; + false -> remove_unreachable(Ls, Blocks, Reachable, []) + end,Count}. + +sanitize_is([#b_set{op=get_map_element, + args=[#b_literal{}=Map,Key]}=I0|Is], + Count0, Values, _Changed, Acc) -> + {MapVarName,Count} = new_var_name('@ssa_map', Count0), + MapVar = #b_var{name=MapVarName}, + I = I0#b_set{args=[MapVar,Key]}, + Copy = #b_set{op=copy,dst=MapVar,args=[Map]}, + sanitize_is(Is, Count, Values, true, [I,Copy|Acc]); +sanitize_is([#b_set{op=Op,dst=#b_var{name=Dst},args=Args0}=I0|Is0], + Count, Values, Changed, Acc) -> + Args = map(fun(#b_var{name=V}=Var) -> + case Values of + #{V:=New} -> New; + #{} -> Var + end; + (Lit) -> Lit + end, Args0), + case sanitize_instr(Op, Args, I0) of + {value,Value0} -> + Value = #b_literal{val=Value0}, + sanitize_is(Is0, Count, Values#{Dst=>Value}, true, Acc); + {ok,I} -> + sanitize_is(Is0, Count, Values, true, [I|Acc]); + ok -> + sanitize_is(Is0, Count, Values, Changed, [I0|Acc]) + end; +sanitize_is([], Count, Values, Changed, Acc) -> + case Changed of + true -> + {reverse(Acc),Count,Values}; + false -> + no_change + end. + +sanitize_instr({bif,Bif}, [#b_literal{val=Lit}], _I) -> + case erl_bifs:is_pure(erlang, Bif, 1) of + false -> + ok; + true -> + try + {value,erlang:Bif(Lit)} + catch + error:_ -> + ok + end + end; +sanitize_instr({bif,Bif}, [#b_literal{val=Lit1},#b_literal{val=Lit2}], _I) -> + true = erl_bifs:is_pure(erlang, Bif, 2), %Assertion. + try + {value,erlang:Bif(Lit1, Lit2)} + catch + error:_ -> + ok + end; +sanitize_instr(get_hd, [#b_literal{val=[Hd|_]}], _I) -> + {value,Hd}; +sanitize_instr(get_tl, [#b_literal{val=[_|Tl]}], _I) -> + {value,Tl}; +sanitize_instr(get_tuple_element, [#b_literal{val=T}, + #b_literal{val=I}], _I) + when I < tuple_size(T) -> + {value,element(I+1, T)}; +sanitize_instr(is_nonempty_list, [#b_literal{val=Lit}], _I) -> + {value,case Lit of + [_|_] -> true; + _ -> false + end}; +sanitize_instr(is_tagged_tuple, [#b_literal{val=Tuple}, + #b_literal{val=Arity}, + #b_literal{val=Tag}], _I) + when is_integer(Arity), is_atom(Tag) -> + if + tuple_size(Tuple) =:= Arity, element(1, Tuple) =:= Tag -> + {value,true}; + true -> + {value,false} + end; +sanitize_instr(bs_init, [#b_literal{val=new},#b_literal{val=Sz}|_], I0) -> + if + is_integer(Sz), Sz >= 0 -> ok; + true -> {ok,sanitize_badarg(I0)} + end; +sanitize_instr(bs_init, [#b_literal{val=append},_,#b_literal{val=Sz}|_], I0) -> + if + is_integer(Sz), Sz >= 0 -> ok; + true -> {ok,sanitize_badarg(I0)} + end; +sanitize_instr(succeeded, [#b_literal{}], _I) -> + {value,true}; +sanitize_instr(_, _, _) -> ok. + +sanitize_badarg(I) -> + Func = #b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error},arity=1}, + I#b_set{op=call,args=[Func,#b_literal{val=badarg}]}. + +remove_unreachable([L|Ls], Blocks, Reachable, Acc) -> + #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks), + case split_phis(Is0) of + {[_|_]=Phis,Rest} -> + Is = [prune_phi(Phi, Reachable) || Phi <- Phis] ++ Rest, + Blk = Blk0#b_blk{is=Is}, + remove_unreachable(Ls, Blocks, Reachable, [{L,Blk}|Acc]); + {[],_} -> + remove_unreachable(Ls, Blocks, Reachable, [{L,Blk0}|Acc]) + end; +remove_unreachable([], _Blocks, _, Acc) -> + maps:from_list(Acc). + +prune_phi(#b_set{args=Args0}=Phi, Reachable) -> + Args = [A || {_,Pred}=A <- Args0, + gb_sets:is_element(Pred, Reachable)], + Phi#b_set{args=Args}. + +%%% +%%% Fix tuples. +%%% + +%% fix_tuples(St0) -> St. +%% If compatibility with a previous version of Erlang has been +%% requested, tuple creation must be split into two instruction to +%% mirror the the way tuples are created in BEAM prior to OTP 22. +%% Each put_tuple instruction is split into put_tuple_arity followed +%% by put_tuple_elements. + +fix_tuples(#st{ssa=Blocks0,cnt=Count0}=St) -> + F = fun (#b_set{op=put_tuple,args=Args}=Put, C0) -> + Arity = #b_literal{val=length(Args)}, + {VarName,C} = new_var_name('@ssa_ignore', C0), + Ignore = #b_var{name=VarName}, + {[Put#b_set{op=put_tuple_arity,args=[Arity]}, + #b_set{dst=Ignore,op=put_tuple_elements,args=Args}],C}; + (I, C) -> {[I],C} + end, + {Blocks,Count} = beam_ssa:flatmapfold_instrs_rpo(F, [0], Count0, Blocks0), + St#st{ssa=Blocks,cnt=Count}. + +%%% +%%% Find out where frames should be placed. +%%% + +%% place_frames(St0) -> St. +%% Return a list of the labels for the blocks that need stack frame +%% allocation instructions. +%% +%% This function attempts to place stack frames as tight as possible +%% around the code, to avoid building stack frames for code paths +%% that don't need one. +%% +%% Stack frames are placed in blocks that dominate all of their +%% descendants. That guarantees that the deallocation instructions +%% cannot be reached from other execution paths that didn't set up +%% a stack frame or set up a stack frame with a different size. + +place_frames(#st{ssa=Blocks}=St) -> + Doms = beam_ssa:dominators(Blocks), + Ls = beam_ssa:rpo(Blocks), + Tried = gb_sets:empty(), + Frames0 = [], + {Frames,_} = place_frames_1(Ls, Blocks, Doms, Tried, Frames0), + St#st{frames=Frames}. + +place_frames_1([L|Ls], Blocks, Doms, Tried0, Frames0) -> + Blk = maps:get(L, Blocks), + case need_frame(Blk) of + true -> + %% This block needs a frame. Try to place it here. + {Frames,Tried} = do_place_frame(L, Blocks, Doms, Tried0, Frames0), + + %% Successfully placed. Try to place more frames in descendants + %% that are not dominated by this block. + place_frames_1(Ls, Blocks, Doms, Tried, Frames); + false -> + try + place_frames_1(Ls, Blocks, Doms, Tried0, Frames0) + catch + throw:{need_frame,For,Tried1}=Reason -> + %% An descendant block needs a stack frame. Try to + %% place it here. + case is_dominated_by(For, L, Doms) of + true -> + %% Try to place a frame here. + {Frames,Tried} = do_place_frame(L, Blocks, Doms, + Tried1, Frames0), + place_frames_1(Ls, Blocks, Doms, Tried, Frames); + false -> + %% Wrong place. This block does not dominate + %% the block that needs the frame. Pass it on + %% to our ancestors. + throw(Reason) + end + end + end; +place_frames_1([], _, _, Tried, Frames) -> + {Frames,Tried}. + +%% do_place_frame(Label, Blocks, Dominators, Tried0, Frames0) -> {Frames,Tried}. +%% Try to place a frame in this block. This function returns +%% successfully if it either succeds at placing a frame in this +%% block, if an ancestor that dominates this block has already placed +%% a frame, or if we have already tried to put a frame in this block. +%% +%% An {need_frame,Label,Tried} exception will be thrown if this block +%% block is not suitable for having a stack frame (i.e. it does not dominate +%% all of its descendants). The exception means that an ancestor will have to +%% place the frame needed by this block. + +do_place_frame(L, Blocks, Doms, Tried0, Frames) -> + case gb_sets:is_element(L, Tried0) of + true -> + %% We have already tried to put a frame in this block. + {Frames,Tried0}; + false -> + %% Try to place a frame in this block. + Tried = gb_sets:insert(L, Tried0), + case place_frame_here(L, Blocks, Doms, Frames) of + yes -> + %% We need a frame and it is safe to place it here. + {[L|Frames],Tried}; + no -> + %% An ancestor has a frame. Not needed. + {Frames,Tried}; + ancestor -> + %% This block does not dominate all of its + %% descendants. We must place the frame in + %% an ancestor. + throw({need_frame,L,Tried}) + end + end. + +%% place_frame_here(Label, Blocks, Doms, Frames) -> no|yes|ancestor. +%% Determine whether a frame should be placed in block Label. + +place_frame_here(L, Blocks, Doms, Frames) -> + B0 = any(fun(DomBy) -> + is_dominated_by(L, DomBy, Doms) + end, Frames), + case B0 of + true -> + %% This block is dominated by an ancestor block that + %% defines a frame. Not needed/allowed to put a frame + %% here. + no; + false -> + %% No frame in any ancestor. We need a frame. + %% Now check whether the frame can be placed here. + %% If this block dominates all of its descendants + %% and the predecessors of any phi nodes it can be + %% placed here. + Descendants = beam_ssa:rpo([L], Blocks), + PhiPredecessors = phi_predecessors(L, Blocks), + MustDominate = ordsets:from_list(PhiPredecessors ++ Descendants), + Dominates = all(fun(?BADARG_BLOCK) -> + %% This block defines no variables and calls + %% erlang:error(badarg). It does not matter + %% whether L dominates ?BADARG_BLOCK or not; + %% it is still safe to put the frame in L. + true; + (Bl) -> + is_dominated_by(Bl, L, Doms) + end, MustDominate), + + %% Also, this block must not be a loop header. + IsLoopHeader = is_loop_header(L, Blocks), + case Dominates andalso not IsLoopHeader of + true -> yes; + false -> ancestor + end + end. + +%% phi_predecessors(Label, Blocks) -> +%% Return all predecessors referenced in phi nodes. + +phi_predecessors(L, Blocks) -> + #b_blk{is=Is} = maps:get(L, Blocks), + [P || #b_set{op=phi,args=Args} <- Is, {_,P} <- Args]. + +%% is_dominated_by(Label, DominatedBy, Dominators) -> true|false. +%% Test whether block Label is dominated by block DominatedBy. + +is_dominated_by(L, DomBy, Doms) -> + DominatedBy = maps:get(L, Doms), + ordsets:is_element(DomBy, DominatedBy). + +%% need_frame(#b_blk{}) -> true|false. +%% Test whether any of the instructions in the block requires a stack frame. + +need_frame(#b_blk{is=Is,last=#b_ret{arg=Ret}}) -> + need_frame_1(Is, {return,Ret}); +need_frame(#b_blk{is=Is}) -> + need_frame_1(Is, body). + +need_frame_1([#b_set{op=make_fun,dst=#b_var{name=Fun}}|Is], {return,_}=Context) -> + %% Since make_fun clobbers X registers, a stack frame is needed if + %% any of the following instructions use any other variable than + %% the one holding the reference to the created fun. + need_frame_1(Is, Context) orelse + case beam_ssa:used(#b_blk{is=Is,last=#b_ret{arg=#b_var{name=Fun}}}) of + [Fun] -> false; + [_|_] -> true + end; +need_frame_1([#b_set{op=new_try_tag}|_], _) -> + true; +need_frame_1([#b_set{op=call,dst=Val}]=Is, {return,Ret}) -> + if + Val =:= Ret -> need_frame_1(Is, tail); + true -> need_frame_1(Is, body) + end; +need_frame_1([#b_set{op=call,args=[Func|_]}|Is], Context) -> + case Func of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}, + arity=Arity} -> + case erl_bifs:is_exit_bif(Mod, Name, Arity) of + true -> + false; + false -> + Context =:= body orelse + Is =/= [] orelse + is_trap_bif(Mod, Name, Arity) + end; + #b_remote{} -> + %% This is an apply(), which always needs a frame. + true; + #b_var{} -> + %% A fun call always needs a frame. + true; + _ -> + Context =:= body orelse Is =/= [] + end; +need_frame_1([I|Is], Context) -> + beam_ssa:clobbers_xregs(I) orelse need_frame_1(Is, Context); +need_frame_1([], _) -> false. + +%% is_trap_bif(Mod, Name, Arity) -> true|false. +%% Test whether we need a stack frame for this BIF. + +is_trap_bif(erlang, '!', 2) -> true; +is_trap_bif(erlang, link, 1) -> true; +is_trap_bif(erlang, unlink, 1) -> true; +is_trap_bif(erlang, monitor_node, 2) -> true; +is_trap_bif(erlang, group_leader, 2) -> true; +is_trap_bif(erlang, exit, 2) -> true; +is_trap_bif(_, _, _) -> false. + +%%% +%%% Fix variables used in matching in receive. +%%% +%%% The loop_rec/2 instruction may return a reference to a +%%% message outside of any heap or heap fragment. If the message +%%% does not match, it is not allowed to store any reference to +%%% the message (or part of the message) on the stack. If we do, +%%% the message will be corrupted if there happens to be a GC. +%%% +%%% Here we make sure to introduce copies of variables that are +%%% matched out and subsequently used after the remove_message/0 +%%% instructions. That will make sure that only X registers are +%%% used during matching. +%%% +%%% Depending on where variables are defined and used, they must +%%% be handling in two different ways. +%%% +%%% Variables that are always defined in the receive (before branching +%%% out into the different clauses of the receive) and used after the +%%% receive, must be handled in the following way: Before each +%%% remove_message instruction, each such variable must be copied, and +%%% all variables must be consolidated using a phi node in the +%%% common exit block for the receive. +%%% +%%% Variables that are matched out and used in the same clause +%%% need copy instructions before the remove_message instruction +%%% in that clause. +%%% + +fix_receives(#st{ssa=Blocks0,cnt=Count0}=St) -> + {Blocks,Count} = fix_receives_1(maps:to_list(Blocks0), + Blocks0, Count0), + St#st{ssa=Blocks,cnt=Count}. + +fix_receives_1([{L,Blk}|Ls], Blocks0, Count0) -> + case Blk of + #b_blk{is=[#b_set{op=peek_message}|_]} -> + Rm = find_rm_blocks(L, Blocks0), + LoopExit = find_loop_exit(Rm, Blocks0), + Defs0 = beam_ssa:def([L], Blocks0), + CommonUsed = recv_common(Defs0, LoopExit, Blocks0), + {Blocks1,Count1} = recv_fix_common(CommonUsed, LoopExit, Rm, + Blocks0, Count0), + Defs = ordsets:subtract(Defs0, CommonUsed), + {Blocks,Count} = fix_receive(Rm, Defs, Blocks1, Count1), + fix_receives_1(Ls, Blocks, Count); + #b_blk{} -> + fix_receives_1(Ls, Blocks0, Count0) + end; +fix_receives_1([], Blocks, Count) -> + {Blocks,Count}. + +recv_common(_Defs, none, _Blocks) -> + %% There is no common exit block because receive is used + %% in the tail position of a function. + []; +recv_common(Defs, Exit, Blocks) -> + {ExitDefs,ExitUsed} = beam_ssa:def_used([Exit], Blocks), + Def = ordsets:subtract(Defs, ExitDefs), + ordsets:intersection(Def, ExitUsed). + +%% recv_fix_common([CommonVar], LoopExit, [RemoveMessageLabel], +%% Blocks0, Count0) -> {Blocks,Count}. +%% Handle variables alwys defined in a receive and used +%% in the exit block following the receive. + +recv_fix_common([Msg0|T], Exit, Rm, Blocks0, Count0) -> + {Msg1,Count1} = new_var_name('@recv', Count0), + Msg = #b_var{name=Msg1}, + Blocks1 = beam_ssa:rename_vars(#{Msg0=>Msg}, [Exit], Blocks0), + N = length(Rm), + {MsgVars0,Count} = new_var_names(duplicate(N, '@recv'), Count1), + MsgVars = [#b_var{name=V} || V <- MsgVars0], + PhiArgs = fix_exit_phi_args(MsgVars, Rm, Exit, Blocks1), + Phi = #b_set{op=phi,dst=Msg,args=PhiArgs}, + ExitBlk0 = maps:get(Exit, Blocks1), + ExitBlk = ExitBlk0#b_blk{is=[Phi|ExitBlk0#b_blk.is]}, + Blocks2 = Blocks1#{Exit:=ExitBlk}, + Blocks = recv_fix_common_1(MsgVars, Rm, Msg0, Blocks2), + recv_fix_common(T, Exit, Rm, Blocks, Count); +recv_fix_common([], _, _, Blocks, Count) -> + {Blocks,Count}. + +recv_fix_common_1([V|Vs], [Rm|Rms], Msg, Blocks0) -> + Ren = #{Msg=>V}, + Blocks1 = beam_ssa:rename_vars(Ren, [Rm], Blocks0), + #b_blk{is=Is0} = Blk0 = maps:get(Rm, Blocks1), + Copy = #b_set{op=copy,dst=V,args=[#b_var{name=Msg}]}, + Is = insert_after_phis(Is0, [Copy]), + Blk = Blk0#b_blk{is=Is}, + Blocks = Blocks1#{Rm:=Blk}, + recv_fix_common_1(Vs, Rms, Msg, Blocks); +recv_fix_common_1([], [], _Msg, Blocks) -> Blocks. + +fix_exit_phi_args([V|Vs], [Rm|Rms], Exit, Blocks) -> + Path = beam_ssa:rpo([Rm], Blocks), + Pred = exit_predecessor(Path, Exit), + [{V,Pred}|fix_exit_phi_args(Vs, Rms, Exit, Blocks)]; +fix_exit_phi_args([], [], _, _) -> []. + +exit_predecessor([Pred,Exit|_], Exit) -> + Pred; +exit_predecessor([_|Bs], Exit) -> + exit_predecessor(Bs, Exit). + +%% fix_receive([Label], Defs, Blocks0, Count0) -> {Blocks,Count}. +%% Add a copy instruction for all variables that are matched out and +%% later used within a clause of the receive. + +fix_receive([L|Ls], Defs, Blocks0, Count0) -> + {RmDefs,Used0} = beam_ssa:def_used([L], Blocks0), + Def = ordsets:subtract(Defs, RmDefs), + Used = ordsets:intersection(Def, Used0), + {NewVs,Count} = new_var_names(Used, Count0), + NewVars = [#b_var{name=V} || V <- NewVs], + Ren = zip(Used, NewVars), + Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), + #b_blk{is=Is0} = Blk1 = maps:get(L, Blocks1), + CopyIs = [#b_set{op=copy,dst=New,args=[#b_var{name=Old}]} || + {Old,New} <- Ren], + Is = insert_after_phis(Is0, CopyIs), + Blk = Blk1#b_blk{is=Is}, + Blocks = maps:put(L, Blk, Blocks1), + fix_receive(Ls, Defs, Blocks, Count); +fix_receive([], _Defs, Blocks, Count) -> + {Blocks,Count}. + +%% find_loop_exit([Label], Blocks) -> Label | none. +%% Find the block to which control is transferred when the +%% the receive loop is exited. + +find_loop_exit([L1,L2|_Ls], Blocks) -> + Path1 = beam_ssa:rpo([L1], Blocks), + Path2 = beam_ssa:rpo([L2], Blocks), + find_loop_exit_1(reverse(Path1), reverse(Path2), none); +find_loop_exit(_, _) -> none. + +find_loop_exit_1([H|T1], [H|T2], _) -> + find_loop_exit_1(T1, T2, H); +find_loop_exit_1(_, _, Exit) -> Exit. + +%% find_rm_blocks(StartLabel, Blocks) -> [Label]. +%% Find all blocks that start with remove_message within the receive +%% loop whose peek_message label is StartLabel. + +find_rm_blocks(L, Blocks) -> + Seen = gb_sets:singleton(L), + Blk = maps:get(L, Blocks), + Succ = beam_ssa:successors(Blk), + find_rm_blocks_1(Succ, Seen, Blocks). + +find_rm_blocks_1([L|Ls], Seen0, Blocks) -> + case gb_sets:is_member(L, Seen0) of + true -> + find_rm_blocks_1(Ls, Seen0, Blocks); + false -> + Seen = gb_sets:insert(L, Seen0), + Blk = maps:get(L, Blocks), + case find_rm_act(Blk#b_blk.is) of + prune -> + %% Looping back. Don't look at any successors. + find_rm_blocks_1(Ls, Seen, Blocks); + continue -> + %% Neutral block. Do nothing here, but look at + %% all successors. + Succ = beam_ssa:successors(Blk), + find_rm_blocks_1(Succ++Ls, Seen, Blocks); + found -> + %% Found remove_message instruction. + [L|find_rm_blocks_1(Ls, Seen, Blocks)] + end + end; +find_rm_blocks_1([], _, _) -> []. + +find_rm_act([#b_set{op=Op}|Is]) -> + case Op of + remove_message -> found; + peek_message -> prune; + recv_next -> prune; + wait_timeout -> prune; + wait -> prune; + _ -> find_rm_act(Is) + end; +find_rm_act([]) -> + continue. + +%%% +%%% Find out which variables need to be stored in Y registers. +%%% + +-record(dk, {d :: ordsets:ordset(var_name()), + k :: ordsets:ordset(var_name()) + }). + +%% find_yregs(St0) -> St. +%% Find all variables that must be stored in Y registers. Annotate +%% the blocks that allocate frames with the set of Y registers +%% used within that stack frame. +%% +%% Basically, we following all execution paths starting from a block +%% that allocates a frame, keeping track of of all defined registers +%% and all registers killed by an instruction that clobbers X +%% registers. For every use of a variable, we check if if it is in +%% the set of killed variables; if it is, it must be stored in an Y +%% register. + +find_yregs(#st{frames=[]}=St) -> + St; +find_yregs(#st{frames=[_|_]=Frames,args=Args,ssa=Blocks0}=St) -> + FrameDefs = find_defs(Frames, Blocks0, [V || #b_var{name=V} <- Args]), + Blocks = find_yregs_1(FrameDefs, Blocks0), + St#st{ssa=Blocks}. + +find_yregs_1([{F,Defs}|Fs], Blocks0) -> + DK = #dk{d=Defs,k=[]}, + D0 = #{F=>DK}, + Ls = beam_ssa:rpo([F], Blocks0), + Yregs0 = [], + Yregs = find_yregs_2(Ls, Blocks0, D0, Yregs0), + Blk0 = maps:get(F, Blocks0), + Blk = beam_ssa:add_anno(yregs, Yregs, Blk0), + Blocks = Blocks0#{F:=Blk}, + find_yregs_1(Fs, Blocks); +find_yregs_1([], Blocks) -> Blocks. + +find_yregs_2([L|Ls], Blocks0, D0, Yregs0) -> + Blk0 = maps:get(L, Blocks0), + #b_blk{is=Is,last=Last} = Blk0, + Ys0 = maps:get(L, D0), + {Yregs1,Ys} = find_yregs_is(Is, Ys0, Yregs0), + Yregs = find_yregs_terminator(Last, Ys, Yregs1), + Successors = beam_ssa:successors(Blk0), + D = find_update_succ(Successors, Ys, D0), + find_yregs_2(Ls, Blocks0, D, Yregs); +find_yregs_2([], _Blocks, _D, Yregs) -> Yregs. + +find_defs(Frames, Blocks, Defs) -> + Seen = gb_sets:empty(), + FramesSet = gb_sets:from_list(Frames), + {FrameDefs,_} = find_defs_1([0], Blocks, FramesSet, Seen, Defs, []), + FrameDefs. + +find_defs_1([L|Ls], Blocks, Frames, Seen0, Defs0, Acc0) -> + case gb_sets:is_member(L, Frames) of + true -> + OrderedDefs = ordsets:from_list(Defs0), + find_defs_1(Ls, Blocks, Frames, Seen0, Defs0, + [{L,OrderedDefs}|Acc0]); + false -> + case gb_sets:is_member(L, Seen0) of + true -> + find_defs_1(Ls, Blocks, Frames, Seen0, Defs0, Acc0); + false -> + Seen1 = gb_sets:insert(L, Seen0), + {Acc,Seen} = find_defs_1(Ls, Blocks, Frames, Seen1, Defs0, Acc0), + #b_blk{is=Is} = Blk = maps:get(L, Blocks), + Defs = find_defs_is(Is, Defs0), + Successors = beam_ssa:successors(Blk), + find_defs_1(Successors, Blocks, Frames, Seen, Defs, Acc) + end + end; +find_defs_1([], _, _, Seen, _, Acc) -> + {Acc,Seen}. + +find_defs_is([#b_set{dst=#b_var{name=Dst}}|Is], Acc) -> + find_defs_is(Is, [Dst|Acc]); +find_defs_is([], Acc) -> Acc. + +find_update_succ([S|Ss], #dk{d=Defs0,k=Killed0}=DK0, D0) -> + case D0 of + #{S:=#dk{d=Defs1,k=Killed1}} -> + Defs = ordsets:intersection(Defs0, Defs1), + Killed = ordsets:union(Killed0, Killed1), + DK = #dk{d=Defs,k=Killed}, + D = maps:put(S, DK, D0), + find_update_succ(Ss, DK0, D); + #{} -> + D = maps:put(S, DK0, D0), + find_update_succ(Ss, DK0, D) + end; +find_update_succ([], _, D) -> D. + +find_yregs_is([#b_set{dst=#b_var{name=Dst}}=I|Is], #dk{d=Defs0,k=Killed0}=Ys, Yregs0) -> + Used = beam_ssa:used(I), + Yregs1 = ordsets:intersection(Used, Killed0), + Yregs = ordsets:union(Yregs0, Yregs1), + case beam_ssa:clobbers_xregs(I) of + false -> + Defs = ordsets:add_element(Dst, Defs0), + find_yregs_is(Is, Ys#dk{d=Defs}, Yregs); + true -> + Killed = ordsets:union(Defs0, Killed0), + Defs = [Dst], + find_yregs_is(Is, Ys#dk{d=Defs,k=Killed}, Yregs) + end; +find_yregs_is([], Ys, Yregs) -> {Yregs,Ys}. + +find_yregs_terminator(Terminator, #dk{k=Killed}, Yregs0) -> + Used = beam_ssa:used(Terminator), + Yregs = ordsets:intersection(Used, Killed), + ordsets:union(Yregs0, Yregs). + +%%% +%%% Try to reduce the size of the stack frame, by adding an explicit +%%% 'copy' instructions for return values from 'call' and 'make_fun' that +%%% need to be saved in Y registers. Here is an example to show +%%% how that's useful. First, here is the Erlang code: +%%% +%%% f(Pid) -> +%%% Res = foo(42), +%%% _ = node(Pid), +%%% bar(), +%%% Res. +%%% +%%% Compiled to SSA format, the main part of the code looks like this: +%%% +%%% 0: +%%% Res = call local literal foo/1, literal 42 +%%% _1 = bif:node Pid +%%% @ssa_bool = succeeded _1 +%%% br @ssa_bool, label 3, label 1 +%%% 3: +%%% @ssa_ignored = call local literal bar/0 +%%% ret Res +%%% +%%% It can be seen that the variables Pid and Res must be saved in Y +%%% registers in order to survive the function calls. A previous sub +%%% pass has inserted a 'copy' instruction to save the value of the +%%% variable Pid: +%%% +%%% 0: +%%% Pid:4 = copy Pid +%%% Res = call local literal foo/1, literal 42 +%%% _1 = bif:node Pid:4 +%%% @ssa_bool = succeeded _1 +%%% br @ssa_bool, label 3, label 1 +%%% +%%% 3: +%%% @ssa_ignored = call local literal bar/0 +%%% ret Res +%%% +%%% The Res and Pid:4 variables must be assigned to different Y registers +%%% because they are live at the same time. copy_retval() inserts a +%%% 'copy' instruction to copy Res to a new variable: +%%% +%%% 0: +%%% Pid:4 = copy Pid +%%% Res:6 = call local literal foo/1, literal 42 +%%% _1 = bif:node Pid:4 +%%% @ssa_bool = succeeded _1 +%%% br @ssa_bool, label 3, label 1 +%%% +%%% 3: +%%% Res = copy Res:6 +%%% @ssa_ignored = call local literal bar/0 +%%% ret Res +%%% +%%% The new variable Res:6 is used to capture the return value from the call. +%%% The variables Pid:4 and Res are no longer live at the same time, so they +%%% can be assigned to the same Y register. +%%% + +copy_retval(#st{frames=Frames,ssa=Blocks0,cnt=Count0}=St) -> + {Blocks,Count} = copy_retval_1(Frames, Blocks0, Count0), + St#st{ssa=Blocks,cnt=Count}. + +copy_retval_1([F|Fs], Blocks0, Count0) -> + #b_blk{anno=#{yregs:=Yregs0},is=Is} = maps:get(F, Blocks0), + Yregs1 = gb_sets:from_list(Yregs0), + Yregs = collect_yregs(Is, Yregs1), + Ls = beam_ssa:rpo([F], Blocks0), + {Blocks,Count} = copy_retval_2(Ls, Yregs, none, Blocks0, Count0), + copy_retval_1(Fs, Blocks, Count); +copy_retval_1([], Blocks, Count) -> + {Blocks,Count}. + +collect_yregs([#b_set{op=copy,dst=#b_var{name=Y},args=[#b_var{name=X}]}|Is], + Yregs0) -> + true = gb_sets:is_member(X, Yregs0), %Assertion. + Yregs = gb_sets:insert(Y, gb_sets:delete(X, Yregs0)), + collect_yregs(Is, Yregs); +collect_yregs([#b_set{}|Is], Yregs) -> + collect_yregs(Is, Yregs); +collect_yregs([], Yregs) -> Yregs. + +copy_retval_2([L|Ls], Yregs, Copy0, Blocks0, Count0) -> + #b_blk{is=Is0,last=Last} = Blk = maps:get(L, Blocks0), + RC = case {Last,Ls} of + {#b_br{succ=Succ,fail=?BADARG_BLOCK},[Succ|_]} -> + true; + {_,_} -> + false + end, + case copy_retval_is(Is0, RC, Yregs, Copy0, Count0, []) of + {Is,Count} -> + case Copy0 =:= none andalso Count0 =:= Count of + true -> + copy_retval_2(Ls, Yregs, none, Blocks0, Count0); + false -> + Blocks = Blocks0#{L=>Blk#b_blk{is=Is}}, + copy_retval_2(Ls, Yregs, none, Blocks, Count) + end; + {Is,Count,Copy} -> + Blocks = Blocks0#{L=>Blk#b_blk{is=Is}}, + copy_retval_2(Ls, Yregs, Copy, Blocks, Count) + end; +copy_retval_2([], _Yregs, none, Blocks, Count) -> + {Blocks,Count}. + +copy_retval_is([#b_set{op=put_tuple_elements,args=Args0}=I0], false, _Yregs, + Copy, Count, Acc) -> + I = I0#b_set{args=copy_sub_args(Args0, Copy)}, + {reverse(Acc, [I|acc_copy([], Copy)]),Count}; +copy_retval_is([#b_set{}]=Is, false, _Yregs, Copy, Count, Acc) -> + {reverse(Acc, acc_copy(Is, Copy)),Count}; +copy_retval_is([#b_set{},#b_set{op=succeeded}]=Is, false, _Yregs, Copy, Count, Acc) -> + {reverse(Acc, acc_copy(Is, Copy)),Count}; +copy_retval_is([#b_set{op=Op,dst=#b_var{name=RetVal}=Dst}=I0|Is], RC, Yregs, + Copy0, Count0, Acc0) when Op =:= call; Op =:= make_fun -> + {I1,Count1,Acc} = place_retval_copy(I0, Yregs, Copy0, Count0, Acc0), + case gb_sets:is_member(RetVal, Yregs) of + true -> + {NewVarName,Count} = new_var_name(RetVal, Count1), + NewVar = #b_var{name=NewVarName}, + Copy = #b_set{op=copy,dst=Dst,args=[NewVar]}, + I = I1#b_set{dst=NewVar}, + copy_retval_is(Is, RC, Yregs, Copy, Count, [I|Acc]); + false -> + copy_retval_is(Is, RC, Yregs, none, Count1, [I1|Acc]) + end; +copy_retval_is([#b_set{args=Args0}=I0|Is], RC, Yregs, Copy, Count, Acc) -> + I = I0#b_set{args=copy_sub_args(Args0, Copy)}, + case beam_ssa:clobbers_xregs(I) of + true -> + copy_retval_is(Is, RC, Yregs, none, Count, [I|acc_copy(Acc, Copy)]); + false -> + copy_retval_is(Is, RC, Yregs, Copy, Count, [I|Acc]) + end; +copy_retval_is([], RC, _, Copy, Count, Acc) -> + case {Copy,RC} of + {none,_} -> + {reverse(Acc),Count}; + {#b_set{},true} -> + {reverse(Acc),Count,Copy}; + {#b_set{},false} -> + {reverse(Acc, [Copy]),Count} + end. + +%% +%% Consider this code: +%% +%% Var = ... +%% ... +%% A1 = call foo/0 +%% A = copy A1 +%% B = call bar/1, Var +%% +%% If the Var variable is no longer used after this code, its Y register +%% can't be reused for A. To allow the Y register to be reused +%% we will need to insert 'copy' instructions for arguments that are +%% in Y registers: +%% +%% Var = ... +%% ... +%% A1 = call foo/0 +%% Var1 = copy Var +%% A = copy A1 +%% B = call bar/1, Var1 +%% + +place_retval_copy(I, _Yregs, none, Count, Acc) -> + {I,Count,Acc}; +place_retval_copy(#b_set{args=[F|Args0]}=I, Yregs, Copy, Count0, Acc0) -> + #b_set{dst=#b_var{name=Avoid}} = Copy, + {Args,Acc1,Count} = copy_func_args(Args0, Yregs, Avoid, Acc0, [], Count0), + Acc = [Copy|Acc1], + {I#b_set{args=[F|Args]},Count,Acc}. + +copy_func_args([#b_var{name=V}=A|As], Yregs, Avoid, CopyAcc, Acc, Count0) -> + case gb_sets:is_member(V, Yregs) of + true when V =/= Avoid -> + {NewVarName,Count} = new_var_name(V, Count0), + NewVar = #b_var{name=NewVarName}, + Copy = #b_set{op=copy,dst=NewVar,args=[A]}, + copy_func_args(As, Yregs, Avoid, [Copy|CopyAcc], [NewVar|Acc], Count); + _ -> + copy_func_args(As, Yregs, Avoid, CopyAcc, [A|Acc], Count0) + end; +copy_func_args([A|As], Yregs, Avoid, CopyAcc, Acc, Count) -> + copy_func_args(As, Yregs, Avoid, CopyAcc, [A|Acc], Count); +copy_func_args([], _Yregs, _Avoid, CopyAcc, Acc, Count) -> + {reverse(Acc),CopyAcc,Count}. + +acc_copy(Acc, none) -> Acc; +acc_copy(Acc, #b_set{}=Copy) -> [Copy|Acc]. + +copy_sub_args(Args, none) -> + Args; +copy_sub_args(Args, #b_set{dst=Dst,args=[Src]}) -> + [sub_arg(A, Dst, Src) || A <- Args]. + +sub_arg(Old, Old, New) -> New; +sub_arg(Old, _, _) -> Old. + +%%% +%%% Consider: +%%% +%%% x1/Hd = get_hd x0/Cons +%%% y0/Tl = get_tl x0/Cons +%%% +%%% Register x0 can't be reused for Hd. If Hd needs to be in x0, +%%% a 'move' instruction must be inserted. +%%% +%%% If we swap get_hd and get_tl when Tl is in a Y register, +%%% x0 can be used for Hd if Cons is not used again: +%%% +%%% y0/Tl = get_tl x0/Cons +%%% x0/Hd = get_hd x0/Cons +%%% + +opt_get_list(#st{ssa=Blocks,res=Res}=St) -> + ResMap = maps:from_list(Res), + Ls = beam_ssa:rpo(Blocks), + St#st{ssa=opt_get_list_1(Ls, ResMap, Blocks)}. + +opt_get_list_1([L|Ls], Res, Blocks0) -> + #b_blk{is=Is0} = Blk = maps:get(L, Blocks0), + case opt_get_list_is(Is0, Res, [], false) of + no -> + opt_get_list_1(Ls, Res, Blocks0); + {yes,Is} -> + Blocks = Blocks0#{L:=Blk#b_blk{is=Is}}, + opt_get_list_1(Ls, Res, Blocks) + end; +opt_get_list_1([], _, Blocks) -> Blocks. + +opt_get_list_is([#b_set{op=get_hd,dst=#b_var{name=Hd}, + args=[Cons]}=GetHd, + #b_set{op=get_tl,dst=#b_var{name=Tl}, + args=[Cons]}=GetTl|Is], + Res, Acc, Changed) -> + %% Note that when this pass is run, only Y registers have + %% reservations. The absence of an entry for a variable therefore + %% means that the variable will be in an X register. + case Res of + #{Hd:={y,_}} -> + %% Hd will be in a Y register. Don't swap. + opt_get_list_is([GetTl|Is], Res, [GetHd|Acc], Changed); + #{Tl:={y,_}} -> + %% Tl will be in a Y register. Swap. + opt_get_list_is([GetHd|Is], Res, [GetTl|Acc], true); + #{} -> + %% Both are in X registers. Nothing to do. + opt_get_list_is([GetTl|Is], Res, [GetHd|Acc], Changed) + end; +opt_get_list_is([I|Is], Res, Acc, Changed) -> + opt_get_list_is(Is, Res, [I|Acc], Changed); +opt_get_list_is([], _Res, Acc, Changed) -> + case Changed of + true -> + {yes,reverse(Acc)}; + false -> + no + end. + +%%% +%%% Number instructions in the order they are executed. +%%% + +%% number_instructions(St0) -> St. +%% Number instructions in the order they are executed. Use a step +%% size of 2. Don't number phi instructions. All phi variables in +%% a block will be live one unit before the first non-phi instruction +%% in the block. + +number_instructions(#st{ssa=Blocks0}=St) -> + Ls = beam_ssa:rpo(Blocks0), + St#st{ssa=number_is_1(Ls, 1, Blocks0)}. + +number_is_1([L|Ls], N0, Blocks0) -> + #b_blk{is=Is0,last=Last0} = Bl0 = maps:get(L, Blocks0), + {Is,N1} = number_is_2(Is0, N0, []), + Last = beam_ssa:add_anno(n, N1, Last0), + N = N1 + 2, + Bl = Bl0#b_blk{is=Is,last=Last}, + Blocks = maps:put(L, Bl, Blocks0), + number_is_1(Ls, N, Blocks); +number_is_1([], _, Blocks) -> Blocks. + +number_is_2([#b_set{op=phi}=I|Is], N, Acc) -> + number_is_2(Is, N, [I|Acc]); +number_is_2([I0|Is], N, Acc) -> + I = beam_ssa:add_anno(n, N, I0), + number_is_2(Is, N+2, [I|Acc]); +number_is_2([], N, Acc) -> + {reverse(Acc),N}. + +%%% +%%% Calculate live intervals. +%%% + +live_intervals(#st{args=Args,ssa=Blocks}=St) -> + Vars0 = [{V,{0,1}} || #b_var{name=V} <- Args], + F = fun(L, _, A) -> live_interval_blk(L, Blocks, A) end, + LiveMap0 = #{}, + Acc0 = {[],[],LiveMap0}, + {Vars,Aliases,_} = beam_ssa:fold_po(F, Acc0, Blocks), + Intervals = merge_ranges(rel2fam(Vars0++Vars)), + St#st{intervals=Intervals,aliases=Aliases}. + +merge_ranges([{V,Rs}|T]) -> + [{V,merge_ranges_1(Rs)}|merge_ranges(T)]; +merge_ranges([]) -> []. + +merge_ranges_1([{A,N},{N,Z}|Rs]) -> + merge_ranges_1([{A,Z}|Rs]); +merge_ranges_1([R|Rs]) -> + [R|merge_ranges_1(Rs)]; +merge_ranges_1([]) -> []. + +live_interval_blk(L, Blocks, {Vars0,Aliases0,LiveMap0}) -> + Live0 = [], + Successors = beam_ssa:successors(L, Blocks), + Live1 = update_successors(Successors, L, Blocks, LiveMap0, Live0), + + %% Add ranges for all variables that are live in the successors. + #b_blk{is=Is,last=Last} = maps:get(L, Blocks), + End = beam_ssa:get_anno(n, Last), + Use = [{V,{use,End+1}} || V <- Live1], + + %% Determine used and defined variables in this block. + FirstNumber = first_number(Is, Last), + {UseDef0,Aliases} = live_interval_blk_1([Last|reverse(Is)], + FirstNumber, Aliases0, Use), + UseDef = rel2fam(UseDef0), + + %% Update what is live at the beginning of this block and + %% store it. + Used = [V || {V,[{use,_}|_]} <- UseDef], + Live2 = ordsets:union(Live1, Used), + Killed = [V || {V,[{def,_}|_]} <- UseDef], + Live = ordsets:subtract(Live2, Killed), + LiveMap = LiveMap0#{L=>Live}, + + %% Construct the ranges for this block. + Vars = make_block_ranges(UseDef, FirstNumber, Vars0), + {Vars,Aliases,LiveMap}. + +make_block_ranges([{V,[{def,Def}]}|Vs], First, Acc) -> + make_block_ranges(Vs, First, [{V,{Def,Def}}|Acc]); +make_block_ranges([{V,[{def,Def}|Uses]}|Vs], First, Acc) -> + {use,Last} = last(Uses), + make_block_ranges(Vs, First, [{V,{Def,Last}}|Acc]); +make_block_ranges([{V,[{use,_}|_]=Uses}|Vs], First, Acc) -> + {use,Last} = last(Uses), + make_block_ranges(Vs, First, [{V,{First,Last}}|Acc]); +make_block_ranges([], _, Acc) -> Acc. + +live_interval_blk_1([#b_set{op=phi,dst=#b_var{name=Dst}}|Is], + FirstNumber, Aliases, Acc0) -> + Acc = [{Dst,{def,FirstNumber}}|Acc0], + live_interval_blk_1(Is, FirstNumber, Aliases, Acc); +live_interval_blk_1([#b_set{op=bs_start_match}=I|Is], FirstNumber, + Aliases0, Acc0) -> + N = beam_ssa:get_anno(n, I), + #b_set{dst=#b_var{name=Dst}} = I, + Acc1 = [{Dst,{def,N}}|Acc0], + Aliases = case beam_ssa:get_anno(reuse_for_context, I) of + true -> + #b_set{args=[#b_var{name=Src}]} = I, + [{Dst,Src}|Aliases0]; + false -> + Aliases0 + end, + Acc = [{V,{use,N}} || V <- beam_ssa:used(I)] ++ Acc1, + live_interval_blk_1(Is, FirstNumber, Aliases, Acc); +live_interval_blk_1([I|Is], FirstNumber, Aliases, Acc0) -> + N = beam_ssa:get_anno(n, I), + Acc1 = case I of + #b_set{dst=#b_var{name=Dst}} -> + [{Dst,{def,N}}|Acc0]; + _ -> + Acc0 + end, + Used = beam_ssa:used(I), + Acc = [{V,{use,N}} || V <- Used] ++ Acc1, + live_interval_blk_1(Is, FirstNumber, Aliases, Acc); +live_interval_blk_1([], _FirstNumber, Aliases, Acc) -> + {Acc,Aliases}. + +%% first_number([#b_set{}]) -> InstructionNumber. +%% Return the number for the first instruction for the block. +%% Note that this number is one less than the first +%% non-phi instruction in the block. + +first_number([#b_set{op=phi}|Is], Last) -> + first_number(Is, Last); +first_number([I|_], _) -> + beam_ssa:get_anno(n, I) - 1; +first_number([], Last) -> + beam_ssa:get_anno(n, Last) - 1. + +update_successors([L|Ls], Pred, Blocks, LiveMap, Live0) -> + Live1 = ordsets:union(Live0, get_live(L, LiveMap)), + #b_blk{is=Is} = maps:get(L, Blocks), + Live = update_live_phis(Is, Pred, Live1), + update_successors(Ls, Pred, Blocks, LiveMap, Live); +update_successors([], _, _, _, Live) -> Live. + +get_live(L, LiveMap) -> + case LiveMap of + #{L:=Live} -> Live; + #{} -> [] + end. + +update_live_phis([#b_set{op=phi,dst=#b_var{name=Killed},args=Args}|Is], + Pred, Live0) -> + Used = [V || {#b_var{name=V},L} <- Args, L =:= Pred], + Live1 = ordsets:union(ordsets:from_list(Used), Live0), + Live = ordsets:del_element(Killed, Live1), + update_live_phis(Is, Pred, Live); +update_live_phis(_, _, Live) -> Live. + +%%% +%%% Reserve Y registers. +%%% + +%% reserve_yregs(St0) -> St. +%% In each block that allocates a stack frame, insert instructions +%% that copy variables that must be in Y registers (given by +%% YRegisters) to new variables. +%% +%% Also allocate specific Y registers for try and catch tags. +%% The outermost try/catch tag is placed in y0, any directly +%% nested tag in y1, and so on. Note that this is the reversed +%% order as required by BEAM; it will be corrected later by +%% turn_yregs(). + +reserve_yregs(#st{frames=Frames}=St0) -> + foldl(fun reserve_yregs_1/2, St0, Frames). + +reserve_yregs_1(L, #st{ssa=Blocks0,cnt=Count0,res=Res0}=St) -> + Blk = maps:get(L, Blocks0), + Yregs = beam_ssa:get_anno(yregs, Blk), + {Def,Used} = beam_ssa:def_used([L], Blocks0), + UsedYregs = ordsets:intersection(Yregs, Used), + DefBefore = ordsets:subtract(UsedYregs, Def), + {BeforeVars,Blocks,Count} = rename_vars(DefBefore, L, Blocks0, Count0), + InsideVars = ordsets:subtract(UsedYregs, DefBefore), + ResTryTags0 = reserve_try_tags(L, Blocks), + ResTryTags = [{V,{Reg,Count}} || {V,Reg} <- ResTryTags0], + Vars = BeforeVars ++ InsideVars, + Res = [{V,{y,Count}} || V <- Vars] ++ ResTryTags ++ Res0, + St#st{res=Res,ssa=Blocks,cnt=Count+1}. + +reserve_try_tags(L, Blocks) -> + Seen = gb_sets:empty(), + {Res0,_} = reserve_try_tags_1([L], Blocks, Seen, #{}), + Res1 = [maps:to_list(M) || {_,M} <- maps:to_list(Res0)], + Res = [{V,{y,Y}} || {V,Y} <- append(Res1)], + ordsets:from_list(Res). + +reserve_try_tags_1([L|Ls], Blocks, Seen0, ActMap0) -> + case gb_sets:is_element(L, Seen0) of + true -> + reserve_try_tags_1(Ls, Blocks, Seen0, ActMap0); + false -> + Seen1 = gb_sets:insert(L, Seen0), + #b_blk{is=Is} = Blk = maps:get(L, Blocks), + Active0 = get_active(L, ActMap0), + Active = reserve_try_tags_is(Is, Active0), + Successors = beam_ssa:successors(Blk), + ActMap1 = update_act_map(Successors, Active, ActMap0), + {ActMap,Seen} = reserve_try_tags_1(Ls, Blocks, Seen1, ActMap1), + reserve_try_tags_1(Successors, Blocks, Seen,ActMap) + end; +reserve_try_tags_1([], _Blocks, Seen, ActMap) -> + {ActMap,Seen}. + +get_active(L, ActMap) -> + case ActMap of + #{L:=Active} -> Active; + #{} -> #{} + end. + +reserve_try_tags_is([#b_set{op=new_try_tag,dst=#b_var{name=V}}|Is], Active) -> + N = map_size(Active), + reserve_try_tags_is(Is, Active#{V=>N}); +reserve_try_tags_is([#b_set{op=kill_try_tag,args=[#b_var{name=Tag}]}|Is], Active) -> + reserve_try_tags_is(Is, maps:remove(Tag, Active)); +reserve_try_tags_is([_|Is], Active) -> + reserve_try_tags_is(Is, Active); +reserve_try_tags_is([], Active) -> Active. + +update_act_map([L|Ls], Active0, ActMap0) -> + case ActMap0 of + #{L:=Active1} -> + ActMap = ActMap0#{L=>maps:merge(Active0, Active1)}, + update_act_map(Ls, Active0, ActMap); + #{} -> + ActMap = ActMap0#{L=>Active0}, + update_act_map(Ls, Active0, ActMap) + end; +update_act_map([], _, ActMap) -> ActMap. + +rename_vars([], _, Blocks, Count) -> + {[],Blocks,Count}; +rename_vars(Vs, L, Blocks0, Count0) -> + {NewVs,Count} = new_var_names(Vs, Count0), + NewVars = [#b_var{name=V} || V <- NewVs], + Ren = zip(Vs, NewVars), + Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), + #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks1), + CopyIs = [#b_set{op=copy,dst=New,args=[#b_var{name=Old}]} || + {Old,New} <- Ren], + Is = insert_after_phis(Is0, CopyIs), + Blk = Blk0#b_blk{is=Is}, + Blocks = maps:put(L, Blk, Blocks1), + {NewVs,Blocks,Count}. + +insert_after_phis([#b_set{op=phi}=I|Is], InsertIs) -> + [I|insert_after_phis(Is, InsertIs)]; +insert_after_phis(Is, InsertIs) -> + InsertIs ++ Is. + +%% frame_size(St0) -> St. +%% Calculate the frame size for each block that allocates a frame. +%% Annotate the block with the frame size. Also annotate all +%% return instructions with {deallocate,FrameSize} to simplify +%% code generation. + +frame_size(#st{frames=Frames,regs=Regs,ssa=Blocks0}=St) -> + Blocks = foldl(fun(L, Blks) -> + frame_size_1(L, Regs, Blks) + end, Blocks0, Frames), + St#st{ssa=Blocks}. + +frame_size_1(L, Regs, Blocks0) -> + Def = beam_ssa:def([L], Blocks0), + Yregs0 = [maps:get(V, Regs) || V <- Def, is_yreg(maps:get(V, Regs))], + Yregs = ordsets:from_list(Yregs0), + FrameSize = length(ordsets:from_list(Yregs)), + if + FrameSize =/= 0 -> + [{y,0}|_] = Yregs, %Assertion. + {y,Last} = last(Yregs), + Last = FrameSize - 1, %Assertion. + ok; + true -> + ok + end, + Blk0 = maps:get(L, Blocks0), + Blk = beam_ssa:add_anno(frame_size, FrameSize, Blk0), + + %% Insert an annotation for frame deallocation on + %% each #b_ret{}. + Blocks = maps:put(L, Blk, Blocks0), + Reachable = beam_ssa:rpo([L], Blocks), + frame_deallocate(Reachable, FrameSize, Blocks). + +frame_deallocate([L|Ls], Size, Blocks0) -> + Blk0 = maps:get(L, Blocks0), + Blk = case Blk0 of + #b_blk{last=#b_ret{}=Ret0} -> + Ret = beam_ssa:add_anno(deallocate, Size, Ret0), + Blk0#b_blk{last=Ret}; + #b_blk{} -> + Blk0 + end, + Blocks = maps:put(L, Blk, Blocks0), + frame_deallocate(Ls, Size, Blocks); +frame_deallocate([], _, Blocks) -> Blocks. + + +%% turn_yregs(St0) -> St. +%% Renumber y registers so that {y,0} becomes {y,FrameSize-1}, +%% {y,FrameSize-1} becomes {y,0} and so on. This is to make nested +%% catches work. The register allocator (linear_scan()) has given +%% a lower number to the outermost catch. + +turn_yregs(#st{frames=Frames,regs=Regs0,ssa=Blocks}=St) -> + Regs1 = foldl(fun(L, A) -> + Blk = maps:get(L, Blocks), + FrameSize = beam_ssa:get_anno(frame_size, Blk), + Def = beam_ssa:def([L], Blocks), + [turn_yregs_1(Def, FrameSize, Regs0)|A] + end, [], Frames), + Regs = maps:merge(Regs0, maps:from_list(append(Regs1))), + St#st{regs=Regs}. + +turn_yregs_1(Def, FrameSize, Regs) -> + Yregs0 = [{maps:get(V, Regs),V} || V <- Def, is_yreg(maps:get(V, Regs))], + Yregs1 = rel2fam(Yregs0), + FrameSize = length(Yregs1), + Yregs2 = [{{y,FrameSize-Y-1},Vs} || {{y,Y},Vs} <- Yregs1], + R0 = sofs:family(Yregs2), + R1 = sofs:family_to_relation(R0), + R = sofs:converse(R1), + sofs:to_external(R). + +%%% +%%% Reserving registers before register allocation. +%%% + +%% reserve_regs(St0) -> St. +%% Reserve registers prior to register allocation. Y registers +%% have already been reserved. This function will reserve z, +%% fr, and specific x registers. + +reserve_regs(#st{args=Args,ssa=Blocks,intervals=Intervals,res=Res0}=St) -> + %% Reserve x0, x1, and so on for the function arguments. + Res1 = reserve_arg_regs(Args, 0, Res0), + + %% Reserve Z registers (dummy registers) for instructions with no + %% return values (e.g. remove_message) or pseudo-return values + %% (e.g. landingpad). + Res2 = reserve_zregs(Blocks, Intervals, Res1), + + %% Reserve float registers. + Res3 = reserve_fregs(Blocks, Res2), + + %% Reserve all remaining unreserved variables as X registers. + Res = maps:from_list(Res3), + St#st{res=reserve_xregs(Blocks, Res)}. + +reserve_arg_regs([#b_var{name=Arg}|Is], N, Acc) -> + reserve_arg_regs(Is, N+1, [{Arg,{x,N}}|Acc]); +reserve_arg_regs([], _, Acc) -> Acc. + +reserve_zregs(Blocks, Intervals, Res) -> + ShortLived0 = [V || {V,[{Start,End}]} <- Intervals, Start+2 =:= End], + ShortLived = cerl_sets:from_list(ShortLived0), + F = fun(_, #b_blk{is=Is,last=Last}, A) -> + reserve_zreg(Is, Last, ShortLived, A) + end, + beam_ssa:fold_rpo(F, [0], Res, Blocks). + +reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}, + #b_set{op={bif,'=:='},args=[Dst,Val]}], _Last, ShortLived, A0) -> + case Val of + #b_literal{val=Arity} when Arity bsr 32 =:= 0 -> + %% These two instructions can be combined to a test_arity + %% instruction provided that the arity variable is short-lived. + reserve_zreg_1(Dst, ShortLived, A0); + _ -> + A0 + end; +reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}], + #b_switch{}, ShortLived, A) -> + reserve_zreg_1(Dst, ShortLived, A); +reserve_zreg([#b_set{op=Op,dst=#b_var{name=Dst}}|Is], Last, ShortLived, A0) -> + IsZReg = case Op of + context_to_binary -> true; + bs_match_string -> true; + bs_restore -> true; + bs_save -> true; + {float,clearerror} -> true; + kill_try_tag -> true; + landingpad -> true; + put_tuple_elements -> true; + remove_message -> true; + set_tuple_element -> true; + succeeded -> true; + timeout -> true; + wait_timeout -> true; + _ -> false + end, + A = case IsZReg of + true -> [{Dst,z}|A0]; + false -> A0 + end, + reserve_zreg(Is, Last, ShortLived, A); +reserve_zreg([], #b_br{bool=Bool}, ShortLived, A) -> + reserve_zreg_1(Bool, ShortLived, A); +reserve_zreg([], _, _, A) -> A. + +reserve_zreg_1(#b_var{name=V}, ShortLived, A) -> + case cerl_sets:is_element(V, ShortLived) of + true -> [{V,z}|A]; + false -> A + end; +reserve_zreg_1(#b_literal{}, _, A) -> A. + +reserve_fregs(Blocks, Res) -> + F = fun(_, #b_blk{is=Is}, A) -> + reserve_freg(Is, A) + end, + beam_ssa:fold_rpo(F, [0], Res, Blocks). + +reserve_freg([#b_set{op={float,Op},dst=#b_var{name=V}}|Is], Res) -> + case Op of + get -> + reserve_freg(Is, Res); + _ -> + reserve_freg(Is, [{V,fr}|Res]) + end; +reserve_freg([_|Is], Res) -> + reserve_freg(Is, Res); +reserve_freg([], Res) -> Res. + +%% reserve_xregs(St0) -> St. +%% Reserve all remaining variables as X registers. +%% +%% If a variable will need to be in a specific X register for a +%% 'call' or 'make_fun' (and there is nothing that will kill it +%% between the definition and use), reserve the register using a +%% {prefer,{x,X} annotation. That annotation means that the linear +%% scan algorithm will place the variable in the preferred register, +%% unless that register is already occupied. +%% +%% All remaining variables are reserved as X registers. Linear scan +%% will allocate the lowest free X register for the variable. + +reserve_xregs(Blocks, Res) -> + F = fun(L, #b_blk{is=Is,last=Last}, R) -> + {Xs0,Used0} = reserve_terminator(L, Last, Blocks, R), + reserve_xregs_is(reverse(Is), R, Xs0, Used0) + end, + beam_ssa:fold_po(F, Res, Blocks). + +reserve_xregs_is([#b_set{op=Op,dst=#b_var{name=Dst},args=Args}=I|Is], Res0, Xs0, Used0) -> + Xs1 = case is_gc_safe(I) of + true -> + Xs0; + false -> + %% There may be a garbage collection after executing this + %% instruction. We will need prune the list of preferred + %% X registers. + res_xregs_prune(Xs0, Used0, Res0) + end, + Res = reserve_xreg(Dst, Xs1, Res0), + Used1 = ordsets:union(Used0, beam_ssa:used(I)), + Used = ordsets:del_element(Dst, Used1), + case Op of + call -> + Xs = reserve_call_args(tl(Args)), + reserve_xregs_is(Is, Res, Xs, Used); + make_fun -> + Xs = reserve_call_args(tl(Args)), + reserve_xregs_is(Is, Res, Xs, Used); + _ -> + reserve_xregs_is(Is, Res, Xs1, Used) + end; +reserve_xregs_is([], Res, _Xs, _Used) -> Res. + +reserve_terminator(L, #b_br{bool=#b_literal{val=true},succ=Succ}, Blocks, Res) -> + case maps:get(Succ, Blocks) of + #b_blk{is=[],last=Last} -> + reserve_terminator(Succ, Last, Blocks, Res); + #b_blk{is=[_|_]=Is} -> + {res_xregs_from_phi(Is, L, Res, #{}),[]} + end; +reserve_terminator(_, Last, _, _) -> + {#{},beam_ssa:used(Last)}. + +res_xregs_from_phi([#b_set{op=phi,dst=#b_var{name=Dst},args=Args}|Is], + Pred, Res, Acc) -> + case [V || {#b_var{name=V},L} <- Args, L =:= Pred] of + [] -> + res_xregs_from_phi(Is, Pred, Res, Acc); + [V] -> + case Res of + #{Dst:={prefer,Reg}} -> + res_xregs_from_phi(Is, Pred, Res, Acc#{V=>Reg}); + #{Dst:=_} -> + res_xregs_from_phi(Is, Pred, Res, Acc) + end + end; +res_xregs_from_phi(_, _, _, Acc) -> Acc. + +reserve_call_args(Args) -> + reserve_call_args(Args, 0, #{}). + +reserve_call_args([#b_var{name=Name}|As], X, Xs) -> + reserve_call_args(As, X+1, Xs#{Name=>{x,X}}); +reserve_call_args([#b_literal{}|As], X, Xs) -> + reserve_call_args(As, X+1, Xs); +reserve_call_args([], _, Xs) -> Xs. + +reserve_xreg(V, Xs, Res) -> + case Res of + #{V:=_} -> + %% Already reserved. + Res; + #{} -> + case Xs of + #{V:=X} -> + %% Add a hint that a specific X register is + %% preferred, unless it is already in use. + Res#{V=>{prefer,X}}; + #{} -> + %% Reserve as an X register in general. + Res#{V=>x} + end + end. + +is_gc_safe(#b_set{op=phi}) -> + false; +is_gc_safe(#b_set{op=Op,args=Args}) -> + case beam_ssa_codegen:classify_heap_need(Op, Args) of + neutral -> true; + {put,_} -> true; + _ -> false + end. + +%% res_xregs_prune(PreferredRegs, Used, Res) -> PreferredRegs. +%% Prune the list of preferred to only include X registers that +%% are guaranteed to survice a garbage collection. + +res_xregs_prune(Xs, Used, Res) -> + %% The number of safe registers is the number of the X registers + %% used after this point. The actual number of safe registers may + %% be highter than this number, but this is a conservative safe + %% estimate. + NumSafe = foldl(fun(V, N) -> + case Res of + #{V:={x,_}} -> N + 1; + #{V:=_} -> N; + #{} -> N + 1 + end + end, 0, Used), + + %% Remove unsafe registers from the list of potential + %% preferred registers. + maps:filter(fun(_, {x,X}) -> X < NumSafe end, Xs). + +%%% +%%% Remove unsuitable aliases. +%%% +%%% If a binary is matched more than once, we must not put the +%%% the match context in the same register as the binary to +%%% avoid the following situation: +%%% +%%% {test,bs_start_match2,{f,3},1,[{x,0},0],{x,0}}. +%%% . +%%% . +%%% . +%%% {test,bs_start_match2,{f,6},1,[{x,0},0],{x,1}}. %% ILLEGAL! +%%% +%%% The second instruction is illegal because a match context source +%%% is only allowed if source and destination registers are identical. +%%% + +remove_unsuitable_aliases(#st{aliases=[_|_]=Aliases0,ssa=Blocks}=St) -> + R = rem_unsuitable(maps:values(Blocks)), + Unsuitable0 = [V || {V,[_,_|_]} <- rel2fam(R)], + Unsuitable = gb_sets:from_list(Unsuitable0), + Aliases =[P || {_,V}=P <- Aliases0, + not gb_sets:is_member(V, Unsuitable)], + St#st{aliases=Aliases}; +remove_unsuitable_aliases(#st{aliases=[]}=St) -> St. + +rem_unsuitable([#b_blk{is=Is}|Bs]) -> + Vs = [{V,Dst} || + #b_set{op=bs_start_match,dst=#b_var{name=Dst}, + args=[#b_var{name=V}]} <- Is], + Vs ++ rem_unsuitable(Bs); +rem_unsuitable([]) -> []. + +%%% +%%% Merge intervals. +%%% + +merge_intervals(#st{aliases=Aliases0,intervals=Intervals0, + res=Reserved}=St) -> + Aliases1 = [A || A <- Aliases0, + is_suitable_alias(A, Reserved)], + case Aliases1 of + [] -> + St#st{aliases=Aliases1}; + [_|_] -> + Intervals1 = maps:from_list(Intervals0), + {Intervals,Aliases} = + merge_intervals_1(Aliases1, Intervals1, []), + St#st{aliases=Aliases,intervals=Intervals} + end. + +merge_intervals_1([{Alias,V}|Vs], Intervals0, Acc) -> + #{Alias:=Int1,V:=Int2} = Intervals0, + Int3 = lists:merge(Int1, Int2), + Int = merge_intervals_2(Int3), + Intervals1 = maps:remove(Alias, Intervals0), + Intervals = Intervals1#{V:=Int}, + merge_intervals_1(Vs, Intervals, [{Alias,V}|Acc]); +merge_intervals_1([], Intervals, Acc) -> + {maps:to_list(Intervals),Acc}. + +merge_intervals_2([{A1,B1},{A2,B2}|Is]) when A2 =< B1 -> + merge_intervals_2([{min(A1, A2),max(B1, B2)}|Is]); +merge_intervals_2([{_A1,B1}=R|[{A2,_B2}|_]=Is]) when B1 < A2 -> + [R|merge_intervals_2(Is)]; +merge_intervals_2([_]=Is) -> Is. + +is_suitable_alias({V1,V2}, Reserved) -> + #{V1:=Res1,V2:=Res2} = Reserved, + case {Res1,Res2} of + {x,x} -> true; + {x,{x,_}} -> true; + {{x,_},x} -> true; + {_,_} -> false + end. + +%%% +%%% Register allocation using linear scan. +%%% + +-record(i, + {sort=1 :: instr_number(), + reg=none :: i_reg(), + pool=x :: pool_id(), + var=#b_var{} :: b_var(), + rs=[] :: [range()] + }). + +-record(l, + {cur=#i{} :: interval(), + unhandled_res=[] :: [interval()], + unhandled_any=[] :: [interval()], + active=[] :: [interval()], + inactive=[] :: [interval()], + free=#{} :: #{var_name()=>pool(), + {'next',pool_id()}:=reg_num()}, + regs=[] :: [{b_var(),ssa_register()}] + }). + +-type interval() :: #i{}. +-type i_reg() :: ssa_register() | {'prefer',xreg()} | 'none'. +-type pool_id() :: 'fr' | 'x' | 'z' | instr_number(). +-type pool() :: ordsets:ordset(ssa_register()). + +linear_scan(#st{intervals=Intervals0,res=Res}=St0) -> + St = St0#st{intervals=[],res=[]}, + Free = init_free(maps:to_list(Res)), + Intervals1 = [init_interval(Int, Res) || Int <- Intervals0], + Intervals = sort(Intervals1), + IsReserved = fun (#i{reg=Reg}) -> Reg =/= none end, + {UnhandledRes,Unhandled} = partition(IsReserved, Intervals), + L = #l{unhandled_res=UnhandledRes, + unhandled_any=Unhandled,free=Free}, + #l{regs=Regs} = do_linear(L), + St#st{regs=maps:from_list(Regs)}. + +init_interval({V,[{Start,_}|_]=Rs}, Res) -> + Info = maps:get(V, Res), + Pool = case Info of + {prefer,{x,_}} -> x; + x -> x; + {x,_} -> x; + {y,Uniq} -> Uniq; + {{y,_},Uniq} -> Uniq; + z -> z; + fr -> fr + end, + Reg = case Info of + {prefer,{x,_}} -> Info; + {x,_} -> Info; + {{y,_}=Y,_} -> Y; + _ -> none + end, + #i{sort=Start,var=V,reg=Reg,pool=Pool,rs=Rs}. + +init_free(Res) -> + Free0 = rel2fam([{x,{x,0}}|init_free_1(Res)]), + #{x:=Xs0} = Free1 = maps:from_list(Free0), + Xs = init_xregs(Xs0), + Free = Free1#{x:=Xs}, + Next = maps:fold(fun(K, V, A) -> [{{next,K},length(V)}|A] end, [], Free), + maps:merge(Free, maps:from_list(Next)). + +init_free_1([{_,{prefer,{x,_}=Reg}}|Res]) -> + [{x,Reg}|init_free_1(Res)]; +init_free_1([{_,{x,_}=Reg}|Res]) -> + [{x,Reg}|init_free_1(Res)]; +init_free_1([{_,{y,Uniq}}|Res]) -> + [{Uniq,{y,0}}|init_free_1(Res)]; +init_free_1([{_,{{y,_}=Reg,Uniq}}|Res]) -> + [{Uniq,Reg}|init_free_1(Res)]; +init_free_1([{_,z}|Res]) -> + [{z,{z,0}}|init_free_1(Res)]; +init_free_1([{_,fr}|Res]) -> + [{fr,{fr,0}}|init_free_1(Res)]; +init_free_1([{_,x}|Res]) -> + init_free_1(Res); +init_free_1([]) -> []. + +%% Make sure that the pool of xregs is contiguous. +init_xregs([{x,N},{x,M}|Is]) when N+1 =:= M -> + [{x,N}|init_xregs([{x,M}|Is])]; +init_xregs([{x,N}|[{x,_}|_]=Is]) -> + [{x,N}|init_xregs([{x,N+1}|Is])]; +init_xregs([{x,_}]=Is) -> Is. + +do_linear(L0) -> + case set_next_current(L0) of + done -> + L0; + L1 -> + L2 = expire_active(L1), + L3 = check_inactive(L2), + Available = collect_available(L3), + L4 = select_register(Available, L3), + L = make_cur_active(L4), + do_linear(L) + end. + +set_next_current(#l{unhandled_res=[Cur1|T1], + unhandled_any=[Cur2|T2]}=L) -> + case {Cur1,Cur2} of + {#i{sort=N1},#i{sort=N2}} when N1 < N2 -> + L#l{cur=Cur1,unhandled_res=T1}; + {_,_} -> + L#l{cur=Cur2,unhandled_any=T2} + end; +set_next_current(#l{unhandled_res=[], + unhandled_any=[Cur|T]}=L) -> + L#l{cur=Cur,unhandled_any=T}; +set_next_current(#l{unhandled_res=[Cur|T], + unhandled_any=[]}=L) -> + L#l{cur=Cur,unhandled_res=T}; +set_next_current(#l{unhandled_res=[],unhandled_any=[]}) -> + done. + +expire_active(#l{cur=#i{sort=CurBegin},active=Act0}=L0) -> + {Act,L} = expire_active(Act0, CurBegin, L0, []), + L#l{active=Act}. + +expire_active([#i{reg=Reg,rs=Rs0}=I|Is], CurBegin, L0, Acc) -> + {_,_} = Reg, %Assertion. + case overlap_status(Rs0, CurBegin) of + ends_before_cur -> + L = free_reg(I, L0), + expire_active(Is, CurBegin, L, Acc); + overlapping -> + expire_active(Is, CurBegin, L0, [I|Acc]); + not_overlapping -> + Rs = strip_before_current(Rs0, CurBegin), + L1 = free_reg(I, L0), + L = L1#l{inactive=[I#i{rs=Rs}|L1#l.inactive]}, + expire_active(Is, CurBegin, L, Acc) + end; +expire_active([], _CurBegin, L, Acc) -> + {Acc,L}. + +check_inactive(#l{cur=#i{sort=CurBegin},inactive=InAct0}=L0) -> + {InAct,L} = check_inactive(InAct0, CurBegin, L0, []), + L#l{inactive=InAct}. + +check_inactive([#i{rs=Rs0}=I|Is], CurBegin, L0, Acc) -> + case overlap_status(Rs0, CurBegin) of + ends_before_cur -> + check_inactive(Is, CurBegin, L0, Acc); + not_overlapping -> + check_inactive(Is, CurBegin, L0, [I|Acc]); + overlapping -> + Rs = strip_before_current(Rs0, CurBegin), + L1 = L0#l{active=[I#i{rs=Rs}|L0#l.active]}, + L = reserve_reg(I, L1), + check_inactive(Is, CurBegin, L, Acc) + end; +check_inactive([], _CurBegin, L, Acc) -> + {Acc,L}. + +strip_before_current([{_,E}|Rs], CurBegin) when E =< CurBegin -> + strip_before_current(Rs, CurBegin); +strip_before_current(Rs, _CurBegin) -> Rs. + +collect_available(#l{cur=#i{reg={prefer,{_,_}=Prefer}}=I}=L) -> + %% Use the preferred register if it is available. + Avail = collect_available(L#l{cur=I#i{reg=none}}), + case member(Prefer, Avail) of + true -> [Prefer]; + false -> Avail + end; +collect_available(#l{cur=#i{reg={_,_}=ReservedReg}}) -> + %% Return the already reserved register. + [ReservedReg]; +collect_available(#l{unhandled_res=Unhandled,cur=Cur}=L) -> + Free = get_pool(Cur, L), + + %% Note that since the live intervals are constructed from + %% SSA form, there cannot be any overlap of the current interval + %% with any inactive interval. See [3], page 175. Therefore we + %% only have check the unhandled intervals for overlap with + %% the current interval. As a further optimization, we only need + %% to check the intervals that have reserved registers. + collect_available(Unhandled, Cur, Free). + +collect_available([#i{pool=Pool1}|Is], #i{pool=Pool2}=Cur, Free) + when Pool1 =/= Pool2 -> + %% Wrong pool. Ignore this interval. + collect_available(Is, Cur, Free); +collect_available([#i{reg={_,_}=Reg}=I|Is], Cur, Free0) -> + case overlaps(I, Cur) of + true -> + Free = ordsets:del_element(Reg, Free0), + collect_available(Is, Cur, Free); + false -> + collect_available(Is, Cur, Free0) + end; +collect_available([], _, Free) -> Free. + +select_register([{_,_}=Reg|_], #l{cur=Cur0,regs=Regs}=L) -> + Cur = Cur0#i{reg=Reg}, + reserve_reg(Cur, L#l{cur=Cur,regs=[{Cur#i.var,Reg}|Regs]}); +select_register([], #l{cur=Cur0,regs=Regs}=L0) -> + %% Allocate a new register in the pool. + {Reg,L1} = get_next_free(Cur0, L0), + Cur = Cur0#i{reg=Reg}, + L = L1#l{cur=Cur,regs=[{Cur#i.var,Reg}|Regs]}, + reserve_reg(Cur, L). + +make_cur_active(#l{cur=Cur,active=Act}=L) -> + L#l{active=[Cur|Act]}. + +overlaps(#i{rs=Rs1}, #i{rs=Rs2}) -> + are_overlapping(Rs1, Rs2). + +overlap_status([{S,E}], CurBegin) -> + if + E =< CurBegin -> ends_before_cur; + CurBegin < S -> not_overlapping; + true -> overlapping + end; +overlap_status([{S,E}|Rs], CurBegin) -> + if + E =< CurBegin -> + overlap_status(Rs, CurBegin); + S =< CurBegin -> + overlapping; + true -> + not_overlapping + end. + +reserve_reg(#i{reg={_,_}=Reg}=I, L) -> + FreeRegs0 = get_pool(I, L), + FreeRegs = ordsets:del_element(Reg, FreeRegs0), + update_pool(I, FreeRegs, L). + +free_reg(#i{reg={_,_}=Reg}=I, L) -> + FreeRegs0 = get_pool(I, L), + FreeRegs = ordsets:add_element(Reg, FreeRegs0), + update_pool(I, FreeRegs, L). + +get_pool(#i{pool=Pool}, #l{free=Free}) -> + maps:get(Pool, Free). + +update_pool(#i{pool=Pool}, New, #l{free=Free0}=L) -> + Free = maps:put(Pool, New, Free0), + L#l{free=Free}. + +get_next_free(#i{pool=Pool}, #l{free=Free0}=L0) -> + K = {next,Pool}, + N = maps:get(K, Free0), + Free = maps:put(K, N+1, Free0), + L = L0#l{free=Free}, + if + is_integer(Pool) -> {{y,N},L}; + is_atom(Pool) -> {{Pool,N},L} + end. + +%%% +%%% Interval utilities. +%%% + +are_overlapping([R|Rs1], Rs2) -> + case are_overlapping_1(R, Rs2) of + true -> + true; + false -> + are_overlapping(Rs1, Rs2) + end; +are_overlapping([], _) -> false. + +are_overlapping_1({_S1,E1}, [{S2,_E2}|_]) when E1 < S2 -> + false; +are_overlapping_1({S1,E1}=R, [{S2,E2}|Rs]) -> + (S2 < E1 andalso E2 > S1) orelse are_overlapping_1(R, Rs); +are_overlapping_1({_,_}, []) -> false. + +%%% +%%% Utilities. +%%% + +%% is_loop_header(L, Blocks) -> false|true. +%% Check whether the block is a loop header. + +is_loop_header(L, Blocks) -> + %% We KNOW that a loop header must start with a peek_message + %% instruction. + case maps:get(L, Blocks) of + #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + _ -> false + end. + +rel2fam(S0) -> + S1 = sofs:relation(S0), + S = sofs:rel2fam(S1), + sofs:to_external(S). + +split_phis(Is) -> + partition(fun(#b_set{op=Op}) -> Op =:= phi end, Is). + +is_yreg({y,_}) -> true; +is_yreg({x,_}) -> false; +is_yreg({z,_}) -> false; +is_yreg({fr,_}) -> false. + +new_var_names([V0|Vs0], Count0) -> + {V,Count1} = new_var_name(V0, Count0), + {Vs,Count} = new_var_names(Vs0, Count1), + {[V|Vs],Count}; +new_var_names([], Count) -> {[],Count}. + +new_var_name({Base,Int}, Count) -> + true = is_integer(Int), %Assertion. + {{Base,Count},Count+1}; +new_var_name(Base, Count) -> + {{Base,Count},Count+1}. diff --git a/lib/compiler/src/beam_ssa_recv.erl b/lib/compiler/src/beam_ssa_recv.erl new file mode 100644 index 0000000000..82fe006487 --- /dev/null +++ b/lib/compiler/src/beam_ssa_recv.erl @@ -0,0 +1,281 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_ssa_recv). +-export([module/2]). + +%%% +%%% In code such as: +%%% +%%% Ref = make_ref(), %Or erlang:monitor(process, Pid) +%%% . +%%% . +%%% . +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% we know that none of the messages that exist in the message queue +%%% before the call to make_ref/0 can be matched out in the receive +%%% statement. Therefore we can avoid going through the entire message +%%% queue if we introduce two new instructions (here written as +%%% BIFs in pseudo-Erlang): +%%% +%%% recv_mark(SomeUniqInteger), +%%% Ref = make_ref(), +%%% . +%%% . +%%% . +%%% recv_set(SomeUniqInteger), +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% The recv_mark/1 instruction will save the current position and +%%% SomeUniqInteger in the process context. The recv_set +%%% instruction will verify that SomeUniqInteger is still stored +%%% in the process context. If it is, it will set the current pointer +%%% for the message queue (the next message to be read out) to the +%%% position that was saved by recv_mark/1. +%%% +%%% The remove_message instruction must be modified to invalidate +%%% the information stored by the previous recv_mark/1, in case there +%%% is another receive executed between the calls to recv_mark/1 and +%%% recv_set/1. +%%% +%%% We use a reference to a label (i.e. a position in the loaded code) +%%% as the SomeUniqInteger. +%%% + +-include("beam_ssa.hrl"). +-import(lists, [all/2,reverse/2]). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, _Opts) -> + Fs = [function(F) || F <- Fs0], + {ok,Module#b_module{body=Fs}}. + +%%% +%%% Local functions. +%%% + +function(#b_function{anno=Anno,bs=Blocks0}=F) -> + try + Blocks = opt(Blocks0), + F#b_function{bs=Blocks} + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +opt(Blocks) -> + Linear = beam_ssa:linearize(Blocks), + opt(Linear, Blocks, []). + +opt([{L,#b_blk{is=[#b_set{op=peek_message}|_]}=Blk0}|Bs], Blocks0, Preds) -> + %% Search for a suitable reference creating call in one of the predecessor + %% blocks. Whether we find such a call or not, we always clear the + %% the list of predecessors to ensure that any nested receive can't + %% search above the current receive. + case recv_opt(Preds, L, Blocks0) of + {yes,Blocks1} -> + Blk = beam_ssa:add_anno(recv_set, L, Blk0), + Blocks = maps:put(L, Blk, Blocks1), + opt(Bs, Blocks, []); + no -> + opt(Bs, Blocks0, []) + end; +opt([{L,_}|Bs], Blocks, Preds) -> + opt(Bs, Blocks, [L|Preds]); +opt([], Blocks, _) -> Blocks. + +recv_opt([L|Ls], RecvLbl, Blocks) -> + #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks), + case recv_opt_is(Is0, RecvLbl, Blocks, []) of + {yes,Is} -> + Blk = Blk0#b_blk{is=Is}, + {yes,maps:put(L, Blk, Blocks)}; + no -> + recv_opt(Ls, RecvLbl, Blocks) + end; +recv_opt([], _, _Blocks) -> no. + +recv_opt_is([#b_set{op=call}=I0|Is], RecvLbl, Blocks0, Acc) -> + case makes_ref(I0, Blocks0) of + no -> + recv_opt_is(Is, RecvLbl, Blocks0, [I0|Acc]); + {yes,Ref} -> + case opt_ref_used(RecvLbl, Ref, Blocks0) of + false -> + recv_opt_is(Is, RecvLbl, Blocks0, [I0|Acc]); + true -> + I = beam_ssa:add_anno(recv_mark, RecvLbl, I0), + {yes,reverse(Acc, [I|Is])} + end + end; +recv_opt_is([I|Is], RecvLbl, Blocks, Acc) -> + recv_opt_is(Is, RecvLbl, Blocks, [I|Acc]); +recv_opt_is([], _, _, _) -> no. + +makes_ref(#b_set{dst=#b_var{name=Dst},args=[Func0|_]}, Blocks) -> + Func = case Func0 of + #b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=Name},arity=A0} -> + {Name,A0}; + _ -> + none + end, + case Func of + {make_ref,0} -> + {yes,Dst}; + {monitor,2} -> + {yes,Dst}; + {spawn_monitor,A} when A =:= 1; A =:= 3 -> + ref_in_tuple(Dst, Blocks); + _ -> + no + end. + +ref_in_tuple(Tuple, Blocks) -> + F = fun(#b_set{op=get_tuple_element,dst=#b_var{name=Ref}, + args=[#b_var{name=Tup},#b_literal{val=1}]}, no) + when Tup =:= Tuple -> {yes,Ref}; + (_, A) -> A + end, + beam_ssa:fold_instrs_rpo(F, [0], no, Blocks). + +opt_ref_used(RecvLbl, Ref, Blocks) -> + Vs = #{{var,Ref}=>ref,ref=>Ref,ref_matched=>false}, + case opt_ref_used_1(RecvLbl, Vs, Blocks) of + used -> true; + not_used -> false; + done -> false + end. + +opt_ref_used_1(L, Vs0, Blocks) -> + #b_blk{is=Is} = Blk = maps:get(L, Blocks), + case opt_ref_used_is(Is, Vs0) of + #{}=Vs -> + opt_ref_used_last(Blk, Vs, Blocks); + Result -> + Result + end. + +opt_ref_used_is([#b_set{op=peek_message,dst=#b_var{name=M}}|Is], Vs0) -> + Vs = Vs0#{{var,M}=>message}, + opt_ref_used_is(Is, Vs); +opt_ref_used_is([#b_set{op={bif,Bif},args=Args,dst=#b_var{name=B}}=I|Is], + Vs0) -> + S = case Bif of + '=:=' -> true; + '==' -> true; + _ -> none + end, + case S of + none -> + Vs = update_vars(I, Vs0), + opt_ref_used_is(Is, Vs); + Bool when is_boolean(Bool) -> + case is_ref_msg_comparison(Args, Vs0) of + true -> + Vs = Vs0#{B=>{is_ref,Bool}}, + opt_ref_used_is(Is, Vs); + false -> + opt_ref_used_is(Is, Vs0) + end + end; +opt_ref_used_is([#b_set{op=remove_message}|_], Vs) -> + case Vs of + #{ref_matched:=true} -> + used; + #{ref_matched:=false} -> + not_used + end; +opt_ref_used_is([#b_set{op=recv_next}|_], _Vs) -> + done; +opt_ref_used_is([#b_set{op=wait_timeout}|_], _Vs) -> + done; +opt_ref_used_is([#b_set{op=wait}|_], _Vs) -> + done; +opt_ref_used_is([#b_set{}=I|Is], Vs0) -> + Vs = update_vars(I, Vs0), + opt_ref_used_is(Is, Vs); +opt_ref_used_is([], Vs) -> Vs. + +opt_ref_used_last(#b_blk{last=Last}=Blk, Vs, Blocks) -> + case Last of + #b_br{bool=#b_var{name=Bool},succ=Succ,fail=Fail} -> + case Vs of + #{Bool:={is_ref,Matched}} -> + ref_used_in([{Succ,Vs#{ref_matched:=Matched}}, + {Fail,Vs#{ref_matched:=not Matched}}], + Blocks); + #{} -> + ref_used_in([{Succ,Vs},{Fail,Vs}], Blocks) + end; + _ -> + SuccVs = [{Succ,Vs} || Succ <- beam_ssa:successors(Blk)], + ref_used_in(SuccVs, Blocks) + end. + +ref_used_in([{L,Vs0}|Ls], Blocks) -> + case opt_ref_used_1(L, Vs0, Blocks) of + not_used -> + not_used; + used -> + case ref_used_in(Ls, Blocks) of + done -> used; + Result -> Result + end; + done -> ref_used_in(Ls, Blocks) + end; +ref_used_in([], _) -> done. + +update_vars(#b_set{args=Args,dst=#b_var{name=B}}, Vs) -> + Vars = [V || #b_var{name=V} <- Args], + All = all(fun(V) -> + Var = {var,V}, + case Vs of + #{Var:=message} -> true; + #{} -> false + end + end, Vars), + case All of + true -> Vs#{{var,B}=>message}; + false -> Vs + end. + +%% is_ref_msg_comparison(Args, Variables) -> true|false. +%% Return 'true' if Args denotes a comparison between the +%% reference and message or part of the message. + +is_ref_msg_comparison([#b_var{name=A1},#b_var{name=A2}], Vs) -> + V1 = {var,A1}, + V2 = {var,A2}, + case Vs of + #{V1:=ref,V2:=message} -> true; + #{V1:=message,V2:=ref} -> true; + #{} -> false + end; +is_ref_msg_comparison(_, _) -> false. diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl new file mode 100644 index 0000000000..e5f15da836 --- /dev/null +++ b/lib/compiler/src/beam_ssa_type.erl @@ -0,0 +1,1106 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_ssa_type). +-export([opt/2]). + +-include("beam_ssa.hrl"). +-import(lists, [any/2,droplast/1,foldl/3,last/1,member/2, + reverse/1,search/2,sort/1]). + +-define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). + +-record(d, {ds :: #{beam_ssa:var_name():=beam_ssa:b_set()}, + ls :: #{beam_ssa:label():=type_db()}}). + +-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(), + elements=[] :: [any()] + }). + +-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([{Label0,Block0}], Args) -> [{Label,Block}] when + Label0 :: beam_ssa:label(), + Block0 :: beam_ssa:b_blk(), + Args :: [beam_ssa:b_var()], + Label :: beam_ssa:label(), + Block :: beam_ssa:b_blk(). + +opt(Linear, Args) -> + Ts = maps:from_list([{V,any} || #b_var{name=V} <- Args]), + FakeCall = #b_set{op=call,args=[#b_remote{mod=#b_literal{val=unknown}, + name=#b_literal{val=unknown}, + arity=0}]}, + Defs = maps:from_list([{V,FakeCall#b_set{dst=Var}} || + #b_var{name=V}=Var <- Args]), + D = #d{ds=Defs,ls=#{0=>Ts}}, + opt_1(Linear, D). + +opt_1([{L,Blk}|Bs], #d{ls=Ls}=D) -> + case Ls of + #{L:=Ts} -> + opt_2(L, Blk, Bs, Ts, D); + #{} -> + %% This block is never reached. Discard it. + opt_1(Bs, D) + end; +opt_1([], _) -> []. + +opt_2(L, #b_blk{is=Is0}=Blk0, Bs, Ts, D0) -> + case Is0 of + [#b_set{op=call,dst=Dst, + args=[#b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}}=Rem|Args0]}=I0] -> + case erl_bifs:is_exit_bif(Mod, Name, length(Args0)) of + true -> + %% This call will never reach the successor block. + %% Rewrite the terminator to a 'ret', and remove + %% all type information for this label. That will + %% simplify the phi node in the former successor. + Args = [simplify_arg(Arg, Ts) || Arg <- Args0], + I = I0#b_set{args=[Rem|Args]}, + Ret = #b_ret{arg=Dst}, + Blk = Blk0#b_blk{is=[I],last=Ret}, + Ls = maps:remove(L, D0#d.ls), + D = D0#d{ls=Ls}, + [{L,Blk}|opt_1(Bs, D)]; + false -> + opt_3(L, Blk0, Bs, Ts, D0) + end; + _ -> + opt_3(L, Blk0, Bs, Ts, D0) + end. + +opt_3(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, #d{ds=Ds0,ls=Ls0}=D0) -> + {Is,Ts,Ds} = opt_is(Is0, Ts0, Ds0, Ls0, []), + D1 = D0#d{ds=Ds}, + Last = opt_terminator(Last0, Ts, Ds), + D = update_successors(Last, Ts, D1), + Blk = Blk0#b_blk{is=Is,last=Last}, + [{L,Blk}|opt_1(Bs, D)]. + +opt_is([#b_set{op=phi,dst=#b_var{name=Dst},args=Args0}=I0|Is], Ts0, Ds0, Ls, Acc) -> + %% Simplify the phi node by removing all predecessor blocks that no + %% longer exists or no longer branches to this block. + Args = [P || {_,From}=P <- Args0, maps:is_key(From, Ls)], + I = I0#b_set{args=Args}, + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{Dst=>I}, + opt_is(Is, Ts, Ds, Ls, [I|Acc]); +opt_is([#b_set{dst=#b_var{name=Dst}}=I0|Is], Ts0, Ds0, Ls, Acc) -> + I = simplify(I0, Ts0), + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{Dst=>I}, + opt_is(Is, Ts, Ds, Ls, [I|Acc]); +opt_is([], Ts, Ds, _Ls, Acc) -> + {reverse(Acc),Ts,Ds}. + +simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I, Ts) -> + case t_tuple_size(get_type(Tuple, Ts)) of + {_,Size} when is_integer(Index), 1 =< Index, Index =< Size -> + I#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=Index-1}]}; + _ -> + I + end; +simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) -> + case get_type(List, Ts) of + cons -> + I#b_set{op=get_hd}; + _ -> + I + end; +simplify(#b_set{op={bif,tl},args=[List]}=I, Ts) -> + case get_type(List, Ts) of + cons -> + I#b_set{op=get_tl}; + _ -> + I + end; +simplify(#b_set{op={bif,size},args=[Term]}=I, Ts) -> + case get_type(Term, Ts) of + #t_tuple{} -> + I#b_set{op={bif,tuple_size}}; + _ -> + I + end; +simplify(#b_set{op={bif,'=='},args=Args0}=I0, Ts) -> + Args = [simplify_arg(Arg, Ts) || Arg <- Args0], + I = I0#b_set{args=Args}, + Types = get_types(Args, Ts), + EqEq = case {meet(Types),join(Types)} of + {none,any} -> true; + {#t_integer{},#t_integer{}} -> true; + {float,float} -> true; + {{binary,_},_} -> true; + {#t_atom{},_} -> true; + {_,_} -> false + end, + case EqEq of + true -> + I#b_set{op={bif,'=:='}}; + false -> + I + end; +simplify(#b_set{op={bif,Op},args=Args0}=I0, Ts) -> + Args = [simplify_arg(Arg, Ts) || Arg <- Args0], + I = I0#b_set{args=Args}, + Types = get_types(Args, Ts), + case is_float_op(Op, Types) of + false -> + I; + true -> + AnnoArgs = [anno_float_arg(A) || A <- Types], + beam_ssa:add_anno(float_op, AnnoArgs, I) + end; +simplify(#b_set{op=wait_timeout,args=[Timeout0]}=I, Ts) -> + case simplify_arg(Timeout0, Ts) of + #b_literal{val=infinity} -> + I#b_set{op=wait,args=[]}; + Timeout -> + I#b_set{args=[Timeout]} + end; +simplify(#b_set{op=Op,args=Args0}=I, Ts) -> + Safe = case Op of + call -> true; + put_list -> true; + put_tuple -> true; + _ -> false + end, + case Safe of + true -> + Args = [simplify_arg(Arg, Ts) || Arg <- Args0], + I#b_set{args=Args}; + false -> + I + end. + +simplify_arg(#b_var{}=Arg, Ts) -> + Type = get_type(Arg, Ts), + case get_literal_from_type(Type) of + none -> Arg; + #b_literal{}=Lit -> Lit + end; +simplify_arg(Arg, _Ts) -> Arg. + +is_float_op('-', [float]) -> + true; +is_float_op('/', [_,_]) -> + true; +is_float_op(Op, [float,_Other]) -> + is_float_op_1(Op); +is_float_op(Op, [_Other,float]) -> + is_float_op_1(Op); +is_float_op(_, _) -> false. + +is_float_op_1('+') -> true; +is_float_op_1('-') -> true; +is_float_op_1('*') -> true; +is_float_op_1(_) -> false. + +anno_float_arg(float) -> float; +anno_float_arg(_) -> convert. + +opt_terminator(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> + Br; +opt_terminator(#b_br{bool=#b_var{name=V}=Var}=Br, Ts, Ds) -> + BoolType = get_type(Var, Ts), + case get_literal_from_type(BoolType) of + #b_literal{}=BoolLit -> + Br#b_br{bool=BoolLit}; + none -> + #{V:=Set} = Ds, + case Set of + #b_set{op={bif,'=:='},args=[Bool,#b_literal{val=true}]} -> + case t_is_boolean(get_type(Bool, Ts)) of + true -> + %% Bool =:= true ==> Bool + simplify_not(Br#b_br{bool=Bool}, Ts, Ds); + false -> + Br + end; + #b_set{} -> + simplify_not(Br, Ts, Ds) + end + end; +opt_terminator(#b_switch{arg=#b_literal{val=Val0}=Arg,fail=Fail,list=List}, + _Ts, _Ds) -> + {value,{_,L}} = search(fun({#b_literal{val=Val1},_}) -> + Val1 =:= Val0 + end, List ++ [{Arg,Fail}]), + #b_br{bool=#b_literal{val=true},succ=L,fail=L}; +opt_terminator(#b_switch{arg=V}=Sw0, Ts, Ds) -> + case get_literal_from_type(Ts) of + #b_literal{}=Lit -> + Sw = Sw0#b_switch{arg=Lit}, + opt_terminator(Sw, Ts, Ds); + none -> + case get_type(V, Ts) of + #t_integer{elements={_,_}=Range} -> + simplify_switch_int(Sw0, Range); + Type -> + case t_is_boolean(Type) of + true -> + case simplify_switch_bool(Sw0, Ts, Ds) of + #b_br{}=Br -> + opt_terminator(Br, Ts, Ds); + Sw -> + Sw + end; + false -> + Sw0 + end + end + end; +opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> + Ret. + +update_successors(#b_br{bool=#b_literal{val=false},fail=S}, Ts, D) -> + update_successor(S, Ts, D); +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{name=V},succ=Succ,fail=Fail}, Ts, D0) -> + D = update_successor(Fail, Ts#{V:=t_atom(false)}, D0), + SuccTs = infer_types(V, Ts, D0), + update_successor(Succ, SuccTs#{V:=t_atom(true)}, D); +update_successors(#b_switch{arg=#b_var{name=V},fail=Fail,list=List}, Ts, D0) -> + D = update_successor(Fail, Ts, D0), + foldl(fun({Val,S}, A) -> + T = get_type(Val, Ts), + update_successor(S, Ts#{V=>T}, A) + end, D, List); +update_successors(#b_ret{}, _Ts, D) -> D. + +update_successor(S, Ts0, #d{ls=Ls}=D) -> + case Ls of + #{S:=Ts1} -> + Ts = join_types(Ts0, Ts1), + D#d{ls=Ls#{S:=Ts}}; + #{} -> + D#d{ls=Ls#{S=>Ts0}} + end. + +update_types(#b_set{op=Op,dst=#b_var{name=Dst},args=Args}, Ts, Ds) -> + T = type(Op, Args, Ts, Ds), + Ts#{Dst=>T}. + +type(phi, Args, Ts, _Ds) -> + Types = [get_type(A, Ts) || {A,_} <- Args], + join(Types); +type({bif,'=:='}, [Same,Same], _Ts, _Ds) -> + t_atom(true); +type({bif,'=:='}, [_,_]=Args, Ts, _Ds) -> + case get_literals(Args, Ts) of + [#b_literal{val=Lit1},#b_literal{val=Lit2}] -> + t_atom(Lit1 =:= Lit2); + [_,_] -> + case meet(get_types(Args, Ts)) of + none -> t_atom(false); + _ -> t_boolean() + end + end; +type({bif,tuple_size}, [Src], Ts, _Ds) -> + case t_tuple_size(get_type(Src, Ts)) of + {exact,Size} -> + t_integer(Size); + _ -> + t_integer() + end; +type({bif,'band'}, Args, Ts, _Ds) -> + band_type(Args, Ts); +type({bif,Bif}, [Src]=Args, Ts, _Ds) -> + case get_type(Src, Ts) of + any -> + bif_type(Bif, Args); + Type -> + case will_succeed(Bif, Type) of + yes -> + t_atom(true); + no -> + t_atom(false); + maybe -> + bif_type(Bif, Args) + end + end; +type({bif,Bif}, Args, Ts, _Ds) -> + case bif_type(Bif, Args) of + number -> + arith_op_type(Args, Ts); + Type -> + Type + end; +type(bs_init, [#b_literal{val=Type}|Args], _Ts, _Ds) -> + case {Type,Args} of + {new,[_,#b_literal{val=Unit}]} -> + {binary,Unit}; + {append,[_,_,#b_literal{val=Unit}]} -> + {binary,Unit}; + {private_append,[_,_,#b_literal{val=Unit}]} -> + {binary,Unit} + end; +type(bs_extract, [Ctx], Ts, _Ds) -> + #t_bs_match{type=Type} = get_type(Ctx, Ts), + Type; +type(bs_match, Args, _Ts, _Ds) -> + #t_bs_match{type=bs_match_type(Args)}; +type(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,_]} -> + case {get_type(Pos, Ts),get_type(Tuple, Ts)} of + {#t_integer{elements={MinIndex,_}},#t_tuple{}=T} + when MinIndex > 1 -> + %% First element is not updated. The result + %% will have the same type. + T; + {_,#t_tuple{}=T} -> + %% Position is 1 or unknown. May update the first + %% element of the tuple. + T#t_tuple{elements=[]}; + {#t_integer{elements={MinIndex,_}},_} -> + #t_tuple{size=MinIndex}; + {_,_} -> + #t_tuple{} + end; + {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,#b_literal{val=0}], Ts, _Ds) -> + case get_type(Tuple, Ts) of + #t_tuple{elements=[First]} -> + get_type(#b_literal{val=First}, Ts); + #t_tuple{} -> + any + end; +type(is_nonempty_list, [Src], Ts, _Ds) -> + case get_type(Src, Ts) of + any -> + t_boolean(); + list -> + t_boolean(); + cons -> + t_atom(true); + _ -> + t_atom(false) + end; +type(is_tagged_tuple, [Src,#b_literal{val=Size},#b_literal{val=Tag}], Ts, _Ds) -> + case get_type(Src, Ts) of + #t_tuple{exact=true,size=Size,elements=[Tag]} -> + t_atom(true); + #t_tuple{exact=true,size=ActualSize,elements=[]} -> + if + Size =/= ActualSize -> + t_atom(false); + true -> + t_boolean() + end; + #t_tuple{exact=false} -> + t_boolean(); + any -> + t_boolean(); + _ -> + t_atom(false) + end; +type(put_list, _Args, _Ts, _Ds) -> + cons; +type(put_tuple, Args, _Ts, _Ds) -> + case Args of + [#b_literal{val=First}|_] -> + #t_tuple{exact=true,size=length(Args),elements=[First]}; + _ -> + #t_tuple{exact=true,size=length(Args)} + end; +type(succeeded, [#b_var{name=Src}], Ts, Ds) -> + case maps:get(Src, Ds) of + #b_set{op={bif,Bif},args=BifArgs} -> + Types = get_types(BifArgs, Ts), + case {Bif,Types} of + {byte_size,[{binary,_}]} -> + t_atom(true); + {bit_size,[{binary,_}]} -> + t_atom(true); + {map_size,[map]} -> + t_atom(true); + {'not',[Type]} -> + case t_is_boolean(Type) of + true -> t_atom(true); + false -> t_boolean() + end; + {size,[{binary,_}]} -> + t_atom(true); + {tuple_size,[#t_tuple{}]} -> + t_atom(true); + {_,_} -> + t_boolean() + end; + #b_set{op=get_hd} -> + t_atom(true); + #b_set{op=get_tl} -> + t_atom(true); + #b_set{op=get_tuple_element} -> + t_atom(true); + #b_set{op=wait} -> + t_atom(false); + #b_set{} -> + t_boolean() + end; +type(_, _, _, _) -> 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; + (_, any) -> number; + (Same, Same) -> Same; + (_, _) -> none + end, unknown, Types). + +%% will_succeed(TestOperation, Type) -> yes|no|maybe. +%% Test whether TestOperation applied to an argument of type Type +%% will succeed. Return yes, no, or maybe. +%% +%% Type is a type as described in the comment for verified_type/1 at +%% the very end of this file, but it will *never* be 'any'. + +will_succeed(is_atom, Type) -> + case Type of + #t_atom{} -> yes; + _ -> no + end; +will_succeed(is_binary, Type) -> + case Type of + {binary,U} when U rem 8 =:= 0 -> yes; + {binary,_} -> maybe; + _ -> no + end; +will_succeed(is_bitstring, Type) -> + case Type of + {binary,_} -> yes; + _ -> no + end; +will_succeed(is_boolean, Type) -> + case Type of + #t_atom{elements=any} -> + maybe; + #t_atom{elements=Es} -> + case t_is_boolean(Type) of + true -> + yes; + false -> + case any(fun is_boolean/1, Es) of + true -> maybe; + false -> no + end + end; + _ -> + no + end; +will_succeed(is_float, Type) -> + case Type of + float -> yes; + number -> maybe; + _ -> no + end; +will_succeed(is_integer, Type) -> + case Type of + #t_integer{} -> yes; + number -> maybe; + _ -> no + end; +will_succeed(is_list, Type) -> + case Type of + list -> yes; + cons -> yes; + nil -> yes; + _ -> no + end; +will_succeed(is_map, Type) -> + case Type of + map -> yes; + _ -> no + end; +will_succeed(is_number, Type) -> + case Type of + float -> yes; + #t_integer{} -> yes; + number -> yes; + _ -> no + end; +will_succeed(is_tuple, Type) -> + case Type of + #t_tuple{} -> yes; + _ -> no + end; +will_succeed(_, _) -> maybe. + + +band_type([#b_literal{val=Int},Other], Ts) when is_integer(Int) -> + band_type_1(Int, Other, Ts); +band_type([Other,#b_literal{val=Int}], Ts) when is_integer(Int) -> + band_type_1(Int, Other, Ts); +band_type([_,_], _) -> t_integer(). + +band_type_1(Int, OtherSrc, Ts) -> + Type = band_type_2(Int, 0), + OtherType = get_type(OtherSrc, Ts), + meet(Type, OtherType). + +band_type_2(N, Bits) when Bits < 64 -> + case 1 bsl Bits of + P when P =:= N + 1 -> + t_integer(0, N); + P when P > N + 1 -> + t_integer(); + _ -> + band_type_2(N, Bits+1) + end; +band_type_2(_, _) -> + %% Negative or large positive number. Give up. + t_integer(). + +bs_match_type([#b_literal{val=Type}|Args]) -> + bs_match_type(Type, Args). + +bs_match_type(binary, Args) -> + [_,_,_,#b_literal{val=U}] = Args, + {binary,U}; +bs_match_type(float, _) -> + float; +bs_match_type(integer, Args) -> + case Args of + [_, + #b_literal{val=Flags}, + #b_literal{val=Size}, + #b_literal{val=Unit}] when Size * Unit < 64 -> + NumBits = Size * Unit, + case member(unsigned, Flags) of + true -> + t_integer(0, (1 bsl NumBits)-1); + false -> + %% Signed integer. Don't bother. + t_integer() + end; + [_|_] -> + t_integer() + end; +bs_match_type(skip, _) -> + any; +bs_match_type(string, _) -> + any; +bs_match_type(utf8, _) -> + ?UNICODE_INT; +bs_match_type(utf16, _) -> + ?UNICODE_INT; +bs_match_type(utf32, _) -> + ?UNICODE_INT. + +simplify_switch_int(#b_switch{list=List0}=Sw, {Min,Max}) -> + List1 = sort(List0), + Vs = [V || {#b_literal{val=V},_} <- List1], + case eq_ranges(Vs, Min, Max) of + true -> + {_,LastL} = last(List1), + List = droplast(List1), + Sw#b_switch{fail=LastL,list=List}; + false -> + Sw + end. + +eq_ranges([H], H, H) -> true; +eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); +eq_ranges(_, _, _) -> false. + +simplify_switch_bool(#b_switch{arg=B,list=List0}=Sw, Ts, Ds) -> + List = sort(List0), + case List of + [{#b_literal{val=false},Fail},{#b_literal{val=true},Succ}] -> + simplify_not(#b_br{bool=B,succ=Succ,fail=Fail}, Ts, Ds); + [_|_] -> + Sw + end. + +simplify_not(#b_br{bool=#b_var{name=V},succ=Succ,fail=Fail}=Br, Ts, Ds) -> + case Ds of + #{V:=#b_set{op={bif,'not'},args=[Bool]}} -> + case t_is_boolean(get_type(Bool, Ts)) of + true -> + Br#b_br{bool=Bool,succ=Fail,fail=Succ}; + false -> + Br + end; + #{} -> + Br + end. + +get_literals(Values, Ts) -> + [get_literal_from_type(get_type(Val, Ts)) || Val <- Values]. + +get_types(Values, Ts) -> + [get_type(Val, Ts) || Val <- Values]. + +-spec get_type(beam_ssa:value(), type_db()) -> type(). + +get_type(#b_var{name=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) -> + #t_tuple{exact=true,size=tuple_size(Val), + elements=[element(1, Val)]}; + Val =:= [] -> + nil; + true -> + any + end. + +infer_types(V, Ts, #d{ds=Ds}) -> + #{V:=#b_set{op=Op,args=Args}} = Ds, + Types = infer_type(Op, Args, Ds), + meet_types(Types, Ts). + +infer_type({bif,element}, [#b_literal{val=Pos},#b_var{name=Tuple}], _Ds) -> + if + is_integer(Pos), 1 =< Pos -> + [{Tuple,#t_tuple{size=Pos}}]; + true -> + [] + end; +infer_type({bif,'=:='}, [#b_var{name=Src},#b_literal{}=Lit], Ds) -> + Def = maps:get(Src, Ds), + Type = get_type(Lit, #{}), + [{Src,Type}|infer_tuple_size(Def, Lit) ++ + infer_first_element(Def, Lit)]; +infer_type({bif,Bif}, [#b_var{name=Src}]=Args, _Ds) -> + case inferred_bif_type(Bif, Args) of + any -> []; + T -> [{Src,T}] + end; +infer_type({bif,is_map_key}, [_,#b_var{name=Src}], _Ds) -> + [{Src,map}]; +infer_type({bif,map_get}, [_,#b_var{name=Src}], _Ds) -> + [{Src,map}]; +infer_type(bs_start_match, [#b_var{name=Bin}], _Ds) -> + [{Bin,{binary,1}}]; +infer_type(is_nonempty_list, [#b_var{name=Src}], _Ds) -> + [{Src,cons}]; +infer_type(is_tagged_tuple, [#b_var{name=Src},#b_literal{val=Size}, + #b_literal{val=Tag}], _Ds) -> + [{Src,#t_tuple{exact=true,size=Size,elements=[Tag]}}]; +infer_type(succeeded, [#b_var{name=Src}], Ds) -> + #b_set{op=Op,args=Args} = maps:get(Src, Ds), + infer_type(Op, Args, Ds); +infer_type(_Op, _Args, _Ds) -> + []. + +%% bif_type(Name, Args) -> Type +%% Return the return type for the guard BIF or operator Name with +%% arguments Args. +%% +%% Note that that the following BIFs are handle elsewhere: +%% +%% band/2 +%% tuple_size/1 + +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(round, [_]) -> t_integer(); +bif_type(size, [_]) -> t_integer(); +bif_type(trunc, [_]) -> 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(byte_size, [_]) -> {binary,1}; +inferred_bif_type(ceil, [_]) -> number; +inferred_bif_type(float, [_]) -> number; +inferred_bif_type(floor, [_]) -> number; +inferred_bif_type(round, [_]) -> number; +inferred_bif_type(trunc, [_]) -> number; +inferred_bif_type(tuple_size, [_]) -> #t_tuple{}; +inferred_bif_type(_, _) -> any. + +infer_tuple_size(#b_set{op={bif,tuple_size},args=[#b_var{name=Tuple}]}, + #b_literal{val=Size}) when is_integer(Size) -> + [{Tuple,#t_tuple{exact=true,size=Size}}]; +infer_tuple_size(_, _) -> []. + +infer_first_element(#b_set{op=get_tuple_element, + args=[#b_var{name=Tuple},#b_literal{val=0}]}, + #b_literal{val=First}) -> + [{Tuple,#t_tuple{size=1,elements=[First]}}]; +infer_first_element(_, _) -> []. + +is_math_bif(cos, 1) -> true; +is_math_bif(cosh, 1) -> true; +is_math_bif(sin, 1) -> true; +is_math_bif(sinh, 1) -> true; +is_math_bif(tan, 1) -> true; +is_math_bif(tanh, 1) -> true; +is_math_bif(acos, 1) -> true; +is_math_bif(acosh, 1) -> true; +is_math_bif(asin, 1) -> true; +is_math_bif(asinh, 1) -> true; +is_math_bif(atan, 1) -> true; +is_math_bif(atanh, 1) -> true; +is_math_bif(erf, 1) -> true; +is_math_bif(erfc, 1) -> true; +is_math_bif(exp, 1) -> true; +is_math_bif(log, 1) -> true; +is_math_bif(log2, 1) -> true; +is_math_bif(log10, 1) -> true; +is_math_bif(sqrt, 1) -> true; +is_math_bif(atan2, 2) -> true; +is_math_bif(pow, 2) -> true; +is_math_bif(ceil, 1) -> true; +is_math_bif(floor, 1) -> true; +is_math_bif(fmod, 2) -> true; +is_math_bif(pi, 0) -> true; +is_math_bif(_, _) -> false. + +join_types(Ts0, Ts1) -> + if + map_size(Ts0) < map_size(Ts1) -> + join_types_1(maps:keys(Ts0), Ts1, Ts0); + true -> + join_types_1(maps:keys(Ts1), Ts0, Ts1) + end. + +join_types_1([V|Vs], Ts0, Ts1) -> + case {Ts0,Ts1} of + {#{V:=Same},#{V:=Same}} -> + join_types_1(Vs, Ts0, Ts1); + {#{V:=T0},#{V:=T1}} -> + case join(T0, T1) of + T1 -> + join_types_1(Vs, Ts0, Ts1); + T -> + join_types_1(Vs, Ts0, Ts1#{V:=T}) + end; + {#{},#{V:=_}} -> + join_types_1(Vs, Ts0, Ts1) + end; +join_types_1([], Ts0, Ts1) -> + maps:merge(Ts0, Ts1). + +join([T1,T2|Ts]) -> + join([join(T1, T2)|Ts]); +join([T]) -> T. + +get_literal_from_type(#t_atom{elements=[Atom]}) -> + #b_literal{val=Atom}; +get_literal_from_type(#t_integer{elements={Int,Int}}) -> + #b_literal{val=Int}; +get_literal_from_type(nil) -> + #b_literal{val=[]}; +get_literal_from_type(_) -> none. + +t_atom() -> + #t_atom{elements=any}. + +t_atom(Atom) when is_atom(Atom) -> + #t_atom{elements=[Atom]}. + +t_boolean() -> + #t_atom{elements=[false,true]}. + +t_integer() -> + #t_integer{elements=any}. + +t_integer(Int) when is_integer(Int) -> + #t_integer{elements={Int,Int}}. + +t_integer(Min, Max) when is_integer(Min), is_integer(Max) -> + #t_integer{elements={Min,Max}}. + +t_is_boolean(#t_atom{elements=[F,T]}) -> + F =:= false andalso T =:= true; +t_is_boolean(#t_atom{elements=[B]}) -> + is_boolean(B); +t_is_boolean(_) -> false. + +t_tuple_size(#t_tuple{size=Size,exact=false}) -> + {at_least,Size}; +t_tuple_size(#t_tuple{size=Size,exact=true}) -> + {exact,Size}; +t_tuple_size(_) -> + none. + +%% 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=Exact1}, #t_tuple{size=Sz,exact=Exact2}) -> + Exact = Exact1 and Exact2, + #t_tuple{size=Sz,exact=Exact}; +join(#t_tuple{size=Sz1}, #t_tuple{size=Sz2}) -> + #t_tuple{size=min(Sz1, Sz2)}; +join(_T1, _T2) -> + %%io:format("~p ~p\n", [_T1,_T2]), + any. + +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + +meet_types([{V,T0}|Vs], Ts) -> + #{V:=T1} = Ts, + T = meet(T0, T1), + meet_types(Vs, Ts#{V:=T}); +meet_types([], Ts) -> Ts. + +meet([T1,T2|Ts]) -> + meet([meet(T1, T2)|Ts]); +meet([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, number) -> float; +meet(#t_integer{}=T, number) -> T; +meet(float, number) -> float; +meet(number, #t_integer{}=T) -> T; +meet(#t_integer{}=T, number) -> T; +meet(number, float=T) -> T; +meet(float=T, number) -> 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{elements=[E1]}, #t_tuple{elements=[E2]}) + when E1 =/= E2 -> + 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, + Es = case {Es1,Es2} of + {[],[_|_]} -> Es2; + {[_|_],[]} -> Es1; + {_,_} -> Es1 + end, + #t_tuple{size=Size,exact=Exact,elements=Es}. + +%% 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{}=T) -> T; +verified_type(float=T) -> T. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 4da0985085..1acbedd45b 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -288,7 +288,7 @@ frame_size([{get_map_elements,{f,L},_,_}|Is], Safe) -> frame_size([{deallocate,N}|_], _) -> N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); -frame_size([_|_], _) -> throw(not_possible). +frame_size(_, _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> frame_size(Is, Safe); diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl deleted file mode 100644 index b5c979e529..0000000000 --- a/lib/compiler/src/beam_type.erl +++ /dev/null @@ -1,1117 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% Purpose: Type-based optimisations. See the comment for verified_type/1 -%% the very end of this file for a description of the types in the -%% type database. - --module(beam_type). - --export([module/2]). - --import(lists, [foldl/3,member/2,reverse/1,reverse/2,sort/1]). - --define(UNICODE_INT, {integer,{0,16#10FFFF}}). - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> - Fs = [function(F) || F <- Fs0], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Asm0}) -> - try - Asm1 = beam_utils:live_opt(Asm0), - Asm2 = opt(Asm1, [], tdb_new()), - Asm3 = beam_utils:live_opt(Asm2), - Asm = beam_utils:delete_annos(Asm3), - {function,Name,Arity,CLabel,Asm} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%% opt([Instruction], Accumulator, TypeDb) -> {[Instruction'],TypeDb'} -%% Keep track of type information; try to simplify. - -opt([{block,Body1}|Is], [{block,Body0}|Acc], Ts0) -> - {Body2,Ts} = simplify(Body1, Ts0), - Body = merge_blocks(Body0, Body2), - opt(Is, [{block,Body}|Acc], Ts); -opt([{block,Body0}|Is], Acc, Ts0) -> - {Body,Ts} = simplify(Body0, Ts0), - opt(Is, [{block,Body}|Acc], Ts); -opt([I0|Is], Acc, Ts0) -> - case simplify_basic([I0], Ts0) of - {[],Ts} -> opt(Is, Acc, Ts); - {[I],Ts} -> opt(Is, [I|Acc], Ts) - end; -opt([], Acc, _) -> reverse(Acc). - -%% simplify(Instruction, TypeDb) -> NewInstruction -%% Simplify an instruction using type information (this is -%% technically a "strength reduction"). - -simplify(Is0, TypeDb0) -> - {Is,_} = BasicRes = simplify_basic(Is0, TypeDb0), - case simplify_float(Is, TypeDb0) of - not_possible -> BasicRes; - {_,_}=Res -> Res - end. - -%% simplify_basic([Instruction], TypeDatabase) -> {[Instruction],TypeDatabase'} -%% Basic simplification, mostly tuples, no floating point optimizations. - -simplify_basic(Is, Ts) -> - simplify_basic(Is, Ts, []). - -simplify_basic([I0|Is], Ts0, Acc) -> - case simplify_instr(I0, Ts0) of - [] -> - simplify_basic(Is, Ts0, Acc); - [I] -> - Ts = update(I, Ts0), - simplify_basic(Is, Ts, [I|Acc]) - end; -simplify_basic([], Ts, Acc) -> - {reverse(Acc),Ts}. - -%% simplify_instr(Instruction, Ts) -> [Instruction]. - -%% Simplify a simple instruction using type information. Return an -%% empty list if the instruction should be removed, or a list with -%% the original or modified instruction. - -simplify_instr({set,[D],[{integer,Index},Reg],{bif,element,_}}=I, Ts) -> - case max_tuple_size(Reg, Ts) of - Sz when 0 < Index, Index =< Sz -> - [{set,[D],[Reg],{get_tuple_element,Index-1}}]; - _ -> [I] - end; -simplify_instr({test,Test,Fail,[R]}=I, Ts) -> - case tdb_find(R, Ts) of - any -> - [I]; - Type -> - case will_succeed(Test, Type) of - yes -> []; - no -> [{jump,Fail}]; - maybe -> [I] - end - end; -simplify_instr({set,[D],[TupleReg],{get_tuple_element,0}}=I, Ts) -> - case tdb_find(TupleReg, Ts) of - {tuple,_,_,[Contents]} -> - [{set,[D],[Contents],move}]; - _ -> - [I] - end; -simplify_instr({test,test_arity,_,[R,Arity]}=I, Ts) -> - case tdb_find(R, Ts) of - {tuple,exact_size,Arity,_} -> []; - _ -> [I] - end; -simplify_instr({test,is_eq_exact,Fail,[R,{atom,A}=Atom]}=I, Ts) -> - case tdb_find(R, Ts) of - {atom,_}=Atom -> []; - boolean when is_boolean(A) -> [I]; - any -> [I]; - _ -> [{jump,Fail}] - end; -simplify_instr({test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I, Ts) -> - case tdb_find(R, Ts) of - {tuple,exact_size,Arity,[Tag]} -> []; - _ -> [I] - end; -simplify_instr({select,select_val,Reg,_,_}=I, Ts) -> - [case tdb_find(Reg, Ts) of - {integer,Range} -> - simplify_select_val_int(I, Range); - boolean -> - simplify_select_val_bool(I); - _ -> - I - end]; -simplify_instr({test,bs_test_unit,_,[Src,Unit]}=I, Ts) -> - case tdb_find(Src, Ts) of - {binary,U} when U rem Unit =:= 0 -> []; - _ -> [I] - end; -simplify_instr(I, _) -> [I]. - -simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) -> - Vs = sort([V || {integer,V} <- L0]), - case eq_ranges(Vs, Min, Max) of - false -> I; - true -> simplify_select_val_1(L0, {integer,Max}, R, []) - end. - -simplify_select_val_bool({select,select_val,R,_,L}=I) -> - Vs = sort([V || {atom,V} <- L]), - case Vs of - [false,true] -> - simplify_select_val_1(L, {atom,false}, R, []); - _ -> - I - end. - -simplify_select_val_1([Val,F|T], Val, R, Acc) -> - L = reverse(Acc, T), - {select,select_val,R,F,L}; -simplify_select_val_1([V,F|T], Val, R, Acc) -> - simplify_select_val_1(T, Val, R, [F,V|Acc]). - -eq_ranges([H], H, H) -> true; -eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); -eq_ranges(_, _, _) -> false. - -%% will_succeed(TestOperation, Type) -> yes|no|maybe. -%% Test whether TestOperation applied to an argument of type Type -%% will succeed. Return yes, no, or maybe. -%% -%% Type is a type as described in the comment for verified_type/1 at -%% the very end of this file, but it will *never* be 'any'. - -will_succeed(is_atom, Type) -> - case Type of - {atom,_} -> yes; - boolean -> yes; - _ -> no - end; -will_succeed(is_binary, Type) -> - case Type of - {binary,U} when U rem 8 =:= 0 -> yes; - {binary,_} -> maybe; - _ -> no - end; -will_succeed(is_bitstr, Type) -> - case Type of - {binary,_} -> yes; - _ -> no - end; -will_succeed(is_integer, Type) -> - case Type of - integer -> yes; - {integer,_} -> yes; - _ -> no - end; -will_succeed(is_map, Type) -> - case Type of - map -> yes; - _ -> no - end; -will_succeed(is_nonempty_list, Type) -> - case Type of - nonempty_list -> yes; - _ -> no - end; -will_succeed(is_tuple, Type) -> - case Type of - {tuple,_,_,_} -> yes; - _ -> no - end; -will_succeed(_, _) -> maybe. - -%% simplify_float([Instruction], TypeDatabase) -> -%% {[Instruction],TypeDatabase'} | not_possible -%% Simplify floating point operations in blocks. -%% -simplify_float(Is0, Ts0) -> - {Is1,Ts} = simplify_float_1(Is0, Ts0, [], []), - Is2 = opt_fmoves(Is1, []), - Is3 = flt_need_heap(Is2), - try - {flt_liveness(Is3),Ts} - catch - throw:not_possible -> not_possible - end. - -simplify_float_1([{set,[],[],fclearerror}|Is], Ts, Rs, Acc) -> - simplify_float_1(Is, Ts, Rs, clearerror(Acc)); -simplify_float_1([{set,[],[],fcheckerror}|Is], Ts, Rs, Acc) -> - simplify_float_1(Is, Ts, Rs, checkerror(Acc)); -simplify_float_1([{set,[{fr,_}],_,_}=I|Is], Ts, Rs, Acc) -> - simplify_float_1(Is, Ts, Rs, [I|Acc]); -simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, - Ts0, Rs0, Acc0) -> - case tdb_find(A0, Ts0) of - float -> - A = coerce_to_float(A0), - {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), - {D,Rs} = find_dest(D0, Rs1), - Areg = fetch_reg(A, Rs), - Acc = [{set,[D],[Areg],{bif,fnegate,{f,0}}}|clearerror(Acc1)], - Ts = tdb_store(D0, float, Ts0), - simplify_float_1(Is, Ts, Rs, Acc); - _Other -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]) - end; -simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, - Ts0, Rs0, Acc0) -> - case float_op(Op0, A0, B0, Ts0) of - no -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]); - {yes,Op} -> - A = coerce_to_float(A0), - B = coerce_to_float(B0), - {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), - {Rs2,Acc2} = load_reg(B, Ts0, Rs1, Acc1), - {D,Rs} = find_dest(D0, Rs2), - Areg = fetch_reg(A, Rs), - Breg = fetch_reg(B, Rs), - Acc = [{set,[D],[Areg,Breg],{bif,Op,{f,0}}}|clearerror(Acc2)], - Ts = tdb_store(D0, float, Ts0), - simplify_float_1(Is, Ts, Rs, Acc) - end; -simplify_float_1([{set,_,_,{try_catch,_,_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> - Acc = flush_all(Rs0, Is0, Acc0), - simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); -simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> - simplify_float_1(Is, Ts, Rs, [I|Acc]); -simplify_float_1([I|Is], Ts0, [], Acc) -> - Ts = update(I, Ts0), - simplify_float_1(Is, Ts, [], [I|Acc]); -simplify_float_1([I|Is]=Is0, Ts0, Rs0, Acc0) -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]); -simplify_float_1([], Ts, [], Acc) -> - Is = reverse(Acc), - {Is,Ts}. - -coerce_to_float({integer,I}=Int) -> - try float(I) of - F -> - {float,F} - catch _:_ -> - %% Let the overflow happen at run-time. - Int - end; -coerce_to_float(Other) -> Other. - -opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1, - {set,[_]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> - case beam_utils:is_killed_block(R, Is) of - false -> opt_fmoves(Is, [I2,I1|Acc]); - true -> opt_fmoves(Is, [{set,Dst,Src,fmove}|Acc]) - end; -opt_fmoves([I|Is], Acc) -> - opt_fmoves(Is, [I|Acc]); -opt_fmoves([], Acc) -> reverse(Acc). - -clearerror(Is) -> - clearerror(Is, Is). - -clearerror([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs; -clearerror([{set,[],[],fcheckerror}|_], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]; -clearerror([_|Is], OrigIs) -> clearerror(Is, OrigIs); -clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]. - -%% merge_blocks(Block1, Block2) -> Block. -%% Combine two blocks and eliminate any move instructions that assign -%% to registers that are killed later in the block. -%% -merge_blocks(B1, [{'%anno',_}|B2]) -> - merge_blocks_1(B1++[{set,[],[],stop_here}|B2]). - -merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is; -merge_blocks_1([{set,[D],_,move}=I|Is]) -> - case beam_utils:is_killed_block(D, Is) of - true -> merge_blocks_1(Is); - false -> [I|merge_blocks_1(Is)] - end; -merge_blocks_1([I|Is]) -> [I|merge_blocks_1(Is)]. - -%% flt_need_heap([Instruction]) -> [Instruction] -%% Insert need heap allocation instructions in the instruction stream -%% to properly account for both inserted floating point operations and -%% normal term build operations (such as put_list/3). -%% -%% Ignore old heap allocation instructions (except if they allocate a stack -%% frame too), as they may be in the wrong place (because gc_bif instructions -%% could have been converted to floating point operations). - -flt_need_heap(Is) -> - flt_need_heap_1(reverse(Is), 0, 0, []). - -flt_need_heap_1([{set,[],[],{alloc,_,Alloc}}|Is], H, Fl, Acc) -> - case Alloc of - {_,nostack,_,_} -> - %% Remove any existing test_heap/2 instruction. - flt_need_heap_1(Is, H, Fl, Acc); - {Z,Stk,_,Inits} when is_integer(Stk) -> - %% Keep any allocate*/2 instruction and recalculate heap need. - I = {set,[],[],{alloc,regs,{Z,Stk,build_alloc(H, Fl),Inits}}}, - flt_need_heap_1(Is, 0, 0, [I|Acc]) - end; -flt_need_heap_1([I|Is], H0, Fl0, Acc) -> - {Ns,H1,Fl1} = flt_need_heap_2(I, H0, Fl0), - flt_need_heap_1(Is, H1, Fl1, [I|Ns]++Acc); -flt_need_heap_1([], H, Fl, Acc) -> - flt_alloc(H, Fl) ++ Acc. - -%% First come all instructions that build. We pass through, while we -%% add to the need for heap words and floats on the heap. -flt_need_heap_2({set,[_],[{fr,_}],fmove}, H, Fl) -> - {[],H,Fl+1}; -flt_need_heap_2({set,_,_,put_list}, H, Fl) -> - {[],H+2,Fl}; -flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) -> - {[],H+1,Fl}; -flt_need_heap_2({set,_,_,put}, H, Fl) -> - {[],H+1,Fl}; -%% The following instructions cause the insertion of an allocation -%% instruction if needed. -flt_need_heap_2({set,_,_,{alloc,_,_}}, H, Fl) -> - {flt_alloc(H, Fl),0,0}; -flt_need_heap_2({set,_,_,{set_tuple_element,_}}, H, Fl) -> - {flt_alloc(H, Fl),0,0}; -flt_need_heap_2({'%anno',_}, H, Fl) -> - {flt_alloc(H, Fl),0,0}; -%% All other instructions are "neutral". We just pass them. -flt_need_heap_2(_, H, Fl) -> - {[],H,Fl}. - -flt_alloc(0, 0) -> - []; -flt_alloc(H, 0) -> - [{set,[],[],{alloc,regs,{nozero,nostack,H,[]}}}]; -flt_alloc(H, F) -> - [{set,[],[],{alloc,regs,{nozero,nostack, - build_alloc(H, F),[]}}}]. - -build_alloc(Words, 0) -> Words; -build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}. - - -%% flt_liveness([Instruction]) -> [Instruction] -%% (Re)calculate the number of live registers for each heap allocation -%% function. We base liveness of the number of register map at the -%% beginning of the instruction sequence. -%% -%% A 'not_possible' term will be thrown if the set of live registers -%% is not continous at an allocation function (e.g. if {x,0} and {x,2} -%% are live, but not {x,1}). - -flt_liveness([{'%anno',{used,Regs}}=LiveInstr|Is]) -> - flt_liveness_1(Is, Regs, [LiveInstr]). - -flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) -> - Live = min(Live0, live_regs(Regs0)), - I = {set,Ds,Ss,{alloc,Live,Alloc}}, - Regs1 = init_regs(Live), - Regs = x_live(Ds, Regs1), - flt_liveness_1(Is, Regs, [I|Acc]); -flt_liveness_1([{set,Ds,_,_}=I|Is], Regs0, Acc) -> - Regs = x_live(Ds, Regs0), - flt_liveness_1(Is, Regs, [I|Acc]); -flt_liveness_1([{'%anno',_}], _Regs, Acc) -> - reverse(Acc). - -init_regs(Live) -> - (1 bsl Live) - 1. - -live_regs(Regs) -> - live_regs_1(Regs, 0). - -live_regs_1(0, N) -> N; -live_regs_1(R, N) -> - case R band 1 of - 0 -> throw(not_possible); - 1 -> live_regs_1(R bsr 1, N+1) - end. - -x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); -x_live([_|Rs], Regs) -> x_live(Rs, Regs); -x_live([], Regs) -> Regs. - -%% update(Instruction, TypeDb) -> NewTypeDb -%% Update the type database to account for executing an instruction. -%% -%% First the cases for instructions inside basic blocks. -update({'%anno',_}, Ts) -> - Ts; -update({set,[D],[S],move}, Ts) -> - tdb_copy(S, D, Ts); -update({set,[D],[Index,Reg],{bif,element,_}}, Ts0) -> - MinSize = case Index of - {integer,I} -> I; - _ -> 0 - end, - Ts = tdb_meet(Reg, {tuple,min_size,MinSize,[]}, Ts0), - tdb_store(D, any, Ts); -update({set,[D],[_Key,Map],{bif,map_get,_}}, Ts0) -> - Ts = tdb_meet(Map, map, Ts0), - tdb_store(D, any, Ts); -update({set,[D],Args,{bif,N,_}}, Ts) -> - Ar = length(Args), - BoolOp = erl_internal:new_type_test(N, Ar) orelse - erl_internal:comp_op(N, Ar) orelse - erl_internal:bool_op(N, Ar), - Type = case BoolOp of - true -> boolean; - false -> unary_op_type(N) - end, - tdb_store(D, Type, Ts); -update({set,[D],[S],{get_tuple_element,0}}, Ts0) -> - if - D =:= S -> - tdb_store(D, any, Ts0); - true -> - Ts = tdb_store(D, {tuple_element,S,0}, Ts0), - tdb_store(S, {tuple,min_size,1,[]}, Ts) - end; -update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) -> - %% Make sure we reject non-numeric literal argument. - case possibly_numeric(S) of - true -> tdb_store(D, float, Ts0); - false -> Ts0 - end; -update({set,[D],[S1,S2],{alloc,_,{gc_bif,'band',{f,0}}}}, Ts) -> - Type = band_type(S1, S2, Ts), - tdb_store(D, Type, Ts); -update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts) -> - %% Make sure we reject non-numeric literals. - case possibly_numeric(S1) andalso possibly_numeric(S2) of - true -> tdb_store(D, float, Ts); - false -> Ts - end; -update({set,[D],[S1,S2],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts0) -> - case op_type(Op) of - integer -> - tdb_store(D, integer, Ts0); - {float,_} -> - case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of - {float,_} -> tdb_store(D, float, Ts0); - {_,float} -> tdb_store(D, float, Ts0); - {_,_} -> tdb_store(D, any, Ts0) - end; - Type -> - tdb_store(D, Type, Ts0) - end; -update({set,[D],[_],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts) -> - tdb_store(D, unary_op_type(Op), Ts); -update({set,[],_Src,_Op}, Ts) -> - Ts; -update({set,[D],_Src,_Op}, Ts) -> - tdb_store(D, any, Ts); -update({kill,D}, Ts) -> - tdb_store(D, any, Ts); - -%% Instructions outside of blocks. -update({test,test_arity,_Fail,[Src,Arity]}, Ts) -> - tdb_meet(Src, {tuple,exact_size,Arity,[]}, Ts); -update({get_map_elements,_,Src,{list,Elems0}}, Ts0) -> - Ts1 = tdb_meet(Src, map, Ts0), - {_Ss,Ds} = beam_utils:split_even(Elems0), - foldl(fun(Dst, A) -> tdb_store(Dst, any, A) end, Ts1, Ds); -update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts0) -> - Ts = case tdb_find_source_tuple(Reg, Ts0) of - {source_tuple,TupleReg} -> - tdb_meet(TupleReg, {tuple,min_size,1,[Atom]}, Ts0); - none -> - Ts0 - end, - tdb_meet(Reg, Atom, Ts); -update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) -> - tdb_meet(Src, {tuple,exact_size,Arity,[Tag]}, Ts); - -%% Binaries and binary matching. - -update({test,bs_get_integer2,_,_,Args,Dst}, Ts) -> - tdb_store(Dst, get_bs_integer_type(Args), Ts); -update({test,bs_get_utf8,_,_,_,Dst}, Ts) -> - tdb_store(Dst, ?UNICODE_INT, Ts); -update({test,bs_get_utf16,_,_,_,Dst}, Ts) -> - tdb_store(Dst, ?UNICODE_INT, Ts); -update({test,bs_get_utf32,_,_,_,Dst}, Ts) -> - tdb_store(Dst, ?UNICODE_INT, Ts); -update({bs_init,_,{bs_init2,_,_},_,_,Dst}, Ts) -> - tdb_store(Dst, {binary,8}, Ts); -update({bs_init,_,_,_,_,Dst}, Ts) -> - tdb_store(Dst, {binary,1}, Ts); -update({bs_put,_,_,_}, Ts) -> - Ts; -update({bs_save2,_,_}, Ts) -> - Ts; -update({bs_restore2,_,_}, Ts) -> - Ts; -update({bs_context_to_binary,Dst}, Ts) -> - tdb_store(Dst, any, Ts); -update({test,bs_start_match2,_,_,[Src,_],Dst}, Ts0) -> - Ts = tdb_meet(Src, {binary,1}, Ts0), - tdb_copy(Src, Dst, Ts); -update({test,bs_get_binary2,_,_,[_,_,Unit,_],Dst}, Ts) -> - true = is_integer(Unit), %Assertion. - tdb_store(Dst, {binary,Unit}, Ts); -update({test,bs_get_float2,_,_,_,Dst}, Ts) -> - tdb_store(Dst, float, Ts); -update({test,bs_test_unit,_,[Src,Unit]}, Ts) -> - tdb_meet(Src, {binary,Unit}, Ts); - -%% Other test instructions -update({test,Test,_Fail,[Src]}, Ts) -> - Type = case Test of - is_binary -> {binary,8}; - is_bitstr -> {binary,1}; - is_boolean -> boolean; - is_float -> float; - is_integer -> integer; - is_map -> map; - is_nonempty_list -> nonempty_list; - _ -> any - end, - tdb_meet(Src, Type, Ts); -update({test,_Test,_Fail,_Other}, Ts) -> - Ts; - -%% Calls - -update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> - case is_math_bif(Math, Ar) of - true -> tdb_store({x,0}, float, Ts); - false -> tdb_kill_xregs(Ts) - end; -update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> - Ts = tdb_kill_xregs(Ts0), - case tdb_find({x,1}, Ts0) of - {tuple,SzKind,Sz,_}=T0 -> - T = case tdb_find({x,0}, Ts0) of - {integer,{I,I}} when I > 1 -> - %% First element is not changed. The result - %% will have the same type. - T0; - _ -> - %% Position is 1 or unknown. May change the - %% first element of the tuple. - {tuple,SzKind,Sz,[]} - end, - tdb_store({x,0}, T, Ts); - _ -> - Ts - end; -update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); -update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); -update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); -update({call_fun, _}, Ts) -> tdb_kill_xregs(Ts); -update({apply, _}, Ts) -> tdb_kill_xregs(Ts); - -update({line,_}, Ts) -> Ts; -update({'%',_}, Ts) -> Ts; - -%% The instruction is unknown. Kill all information. -update(_I, _Ts) -> tdb_new(). - -band_type({integer,Int}, Other, Ts) -> - band_type_1(Int, Other, Ts); -band_type(Other, {integer,Int}, Ts) -> - band_type_1(Int, Other, Ts); -band_type(_, _, _) -> integer. - -band_type_1(Int, OtherSrc, Ts) -> - Type = band_type_2(Int, 0), - OtherType = tdb_find(OtherSrc, Ts), - meet(Type, OtherType). - -band_type_2(N, Bits) when Bits < 64 -> - case 1 bsl Bits of - P when P =:= N + 1 -> - {integer,{0,N}}; - P when P > N + 1 -> - integer; - _ -> - band_type_2(N, Bits+1) - end; -band_type_2(_, _) -> - %% Negative or large positive number. Give up. - integer. - -get_bs_integer_type([_,{integer,N},U,{field_flags,Fl}]) - when N*U < 64 -> - NumBits = N*U, - case member(unsigned, Fl) of - true -> - {integer,{0,(1 bsl NumBits)-1}}; - false -> - %% Signed integer. Don't bother. - integer - end; -get_bs_integer_type(_) -> - %% Avoid creating ranges with a huge upper limit. - integer. - -is_math_bif(cos, 1) -> true; -is_math_bif(cosh, 1) -> true; -is_math_bif(sin, 1) -> true; -is_math_bif(sinh, 1) -> true; -is_math_bif(tan, 1) -> true; -is_math_bif(tanh, 1) -> true; -is_math_bif(acos, 1) -> true; -is_math_bif(acosh, 1) -> true; -is_math_bif(asin, 1) -> true; -is_math_bif(asinh, 1) -> true; -is_math_bif(atan, 1) -> true; -is_math_bif(atanh, 1) -> true; -is_math_bif(erf, 1) -> true; -is_math_bif(erfc, 1) -> true; -is_math_bif(exp, 1) -> true; -is_math_bif(log, 1) -> true; -is_math_bif(log2, 1) -> true; -is_math_bif(log10, 1) -> true; -is_math_bif(sqrt, 1) -> true; -is_math_bif(atan2, 2) -> true; -is_math_bif(pow, 2) -> true; -is_math_bif(ceil, 1) -> true; -is_math_bif(floor, 1) -> true; -is_math_bif(fmod, 2) -> true; -is_math_bif(pi, 0) -> true; -is_math_bif(_, _) -> false. - -%% Reject non-numeric literals. -possibly_numeric({x,_}) -> true; -possibly_numeric({y,_}) -> true; -possibly_numeric({integer,_}) -> true; -possibly_numeric({float,_}) -> true; -possibly_numeric(_) -> false. - -max_tuple_size(Reg, Ts) -> - case tdb_find(Reg, Ts) of - {tuple,_,Sz,_} -> Sz; - _Other -> 0 - end. - -float_op('/', A, B, _) -> - case possibly_numeric(A) andalso possibly_numeric(B) of - true -> {yes,fdiv}; - false -> no - end; -float_op(Op, {float,_}, B, _) -> - case possibly_numeric(B) of - true -> arith_op(Op); - false -> no - end; -float_op(Op, A, {float,_}, _) -> - case possibly_numeric(A) of - true -> arith_op(Op); - false -> no - end; -float_op(Op, A, B, Ts) -> - case {tdb_find(A, Ts),tdb_find(B, Ts)} of - {float,_} -> arith_op(Op); - {_,float} -> arith_op(Op); - {_,_} -> no - end. - -find_dest(V, Rs0) -> - case find_reg(V, Rs0) of - {ok,FR} -> - {FR,mark(V, Rs0, dirty)}; - error -> - Rs = put_reg(V, Rs0, dirty), - {ok,FR} = find_reg(V, Rs), - {FR,Rs} - end. - -load_reg({float,_}=F, _, Rs0, Is0) -> - Rs = put_reg(F, Rs0, clean), - {ok,FR} = find_reg(F, Rs), - Is = [{set,[FR],[F],fmove}|Is0], - {Rs,Is}; -load_reg(V, Ts, Rs0, Is0) -> - case find_reg(V, Rs0) of - {ok,_FR} -> {Rs0,Is0}; - error -> - Rs = put_reg(V, Rs0, clean), - {ok,FR} = find_reg(V, Rs), - Op = case tdb_find(V, Ts) of - float -> fmove; - _ -> fconv - end, - Is = [{set,[FR],[V],Op}|Is0], - {Rs,Is} - end. - -arith_op(Op) -> - case op_type(Op) of - {float,Instr} -> {yes,Instr}; - _ -> no - end. - -op_type('+') -> {float,fadd}; -op_type('-') -> {float,fsub}; -op_type('*') -> {float,fmul}; -%% '/' and 'band' are specially handled. -op_type('bor') -> integer; -op_type('bxor') -> integer; -op_type('bsl') -> integer; -op_type('bsr') -> integer; -op_type('div') -> integer; -op_type(_) -> any. - -unary_op_type(bit_size) -> integer; -unary_op_type(byte_size) -> integer; -unary_op_type(length) -> integer; -unary_op_type(map_size) -> integer; -unary_op_type(size) -> integer; -unary_op_type(tuple_size) -> integer; -unary_op_type(_) -> any. - -flush(Rs, [{set,[_],[_,_,_],{bif,is_record,_}}|_]=Is0, Acc0) -> - Acc = flush_all(Rs, Is0, Acc0), - {[],Acc}; -flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) -> - Acc = flush_all(Rs, Is0, Acc0), - {[],Acc}; -flush(Rs0, [{set,Ds,Ss,_Op}|_], Acc0) -> - Save = cerl_sets:from_list(Ss), - Acc = save_regs(Rs0, Save, Acc0), - Rs1 = foldl(fun(S, A) -> mark(S, A, clean) end, Rs0, Ss), - Kill = cerl_sets:from_list(Ds), - Rs = kill_regs(Rs1, Kill), - {Rs,Acc}; -flush(Rs0, Is, Acc0) -> - Acc = flush_all(Rs0, Is, Acc0), - {[],Acc}. - -flush_all([{_,{float,_},_}|Rs], Is, Acc) -> - flush_all(Rs, Is, Acc); -flush_all([{I,V,dirty}|Rs], Is, Acc0) -> - Acc = checkerror(Acc0), - case beam_utils:is_killed_block(V, Is) of - true -> flush_all(Rs, Is, Acc); - false -> flush_all(Rs, Is, [{set,[V],[{fr,I}],fmove}|Acc]) - end; -flush_all([{_,_,clean}|Rs], Is, Acc) -> flush_all(Rs, Is, Acc); -flush_all([free|Rs], Is, Acc) -> flush_all(Rs, Is, Acc); -flush_all([], _, Acc) -> Acc. - -save_regs(Rs, Save, Acc) -> - foldl(fun(R, A) -> save_reg(R, Save, A) end, Acc, Rs). - -save_reg({I,V,dirty}, Save, Acc) -> - case cerl_sets:is_element(V, Save) of - true -> [{set,[V],[{fr,I}],fmove}|checkerror(Acc)]; - false -> Acc - end; -save_reg(_, _, Acc) -> Acc. - -kill_regs(Rs, Kill) -> - [kill_reg(R, Kill) || R <- Rs]. - -kill_reg({_,V,_}=R, Kill) -> - case cerl_sets:is_element(V, Kill) of - true -> free; - false -> R - end; -kill_reg(R, _) -> R. - -mark(V, [{I,V,_}|Rs], Mark) -> [{I,V,Mark}|Rs]; -mark(V, [R|Rs], Mark) -> [R|mark(V, Rs, Mark)]; -mark(_, [], _) -> []. - -fetch_reg(V, [{I,V,_}|_]) -> {fr,I}; -fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). - -find_reg(V, [{I,V,_}|_]) -> {ok,{fr,I}}; -find_reg(V, [_|SRs]) -> find_reg(V, SRs); -find_reg(_, []) -> error. - -put_reg(V, Rs, Dirty) -> put_reg_1(V, Rs, Dirty, 0). - -put_reg_1(V, [free|Rs], Dirty, I) -> [{I,V,Dirty}|Rs]; -put_reg_1(V, [R|Rs], Dirty, I) -> [R|put_reg_1(V, Rs, Dirty, I+1)]; -put_reg_1(V, [], Dirty, I) -> [{I,V,Dirty}]. - -checkerror(Is) -> - checkerror_1(Is, Is). - -checkerror_1([{set,[],[],fcheckerror}|_], OrigIs) -> OrigIs; -checkerror_1([{set,_,_,{bif,fadd,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fsub,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fmul,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fdiv,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fnegate,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([_|Is], OrigIs) -> checkerror_1(Is, OrigIs); -checkerror_1([], OrigIs) -> OrigIs. - -checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. - - -%%% Routines for maintaining a type database. The type database -%%% associates type information with registers. -%%% -%%% See the comment for verified_type/1 at the end of module for -%%% a description of the possible types. - -%% tdb_new() -> EmptyDataBase -%% Creates a new, empty type database. - -tdb_new() -> []. - -%% tdb_find(Register, Db) -> Type -%% Returns type information or the atom error if there is no type -%% information available for Register. -%% -%% See the comment for verified_type/1 at the end of module for -%% a description of the possible types. - -tdb_find(Reg, Ts) -> - case tdb_find_raw(Reg, Ts) of - {tuple_element,_,_} -> any; - Type -> Type - end. - -%% tdb_find_source_tuple(Register, Ts) -> {source_tuple,Register} | 'none'. -%% Find the tuple whose first element was fetched to the register Register. - -tdb_find_source_tuple(Reg, Ts) -> - case tdb_find_raw(Reg, Ts) of - {tuple_element,Src,0} -> - {source_tuple,Src}; - _ -> - none - end. - -%% tdb_copy(Source, Dest, Db) -> Db' -%% Update the type information for Dest to have the same type -%% as the Source. - -tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y -> - case tdb_find_raw(S, Ts) of - any -> orddict:erase(D, Ts); - Type -> orddict:store(D, Type, Ts) - end; -tdb_copy(Literal, D, Ts) -> - Type = case Literal of - {atom,_} -> Literal; - {float,_} -> float; - {integer,Int} -> {integer,{Int,Int}}; - {literal,[_|_]} -> nonempty_list; - {literal,#{}} -> map; - {literal,Tuple} when tuple_size(Tuple) >= 1 -> - Lit = tag_literal(element(1, Tuple)), - {tuple,exact_size,tuple_size(Tuple),[Lit]}; - _ -> any - end, - tdb_store(D, verified_type(Type), Ts). - -%% tdb_store(Register, Type, Ts0) -> Ts. -%% Store a new type for register Register. Return the update type -%% database. Use this function when a new value is assigned to -%% a register. -%% -%% See the comment for verified_type/1 at the end of module for -%% a description of the possible types. - -tdb_store(Reg, any, Ts) -> - erase(Reg, Ts); -tdb_store(Reg, Type, Ts) -> - store(Reg, verified_type(Type), Ts). - -store(Key, New, [{K,_}|_]=Dict) when Key < K -> - [{Key,New}|Dict]; -store(Key, New, [{K,Val}=E|Dict]) when Key > K -> - case Val of - {tuple_element,Key,_} -> store(Key, New, Dict); - _ -> [E|store(Key, New, Dict)] - end; -store(Key, New, [{_K,Old}|Dict]) -> %Key == K - case Old of - {tuple,_,_,_} -> - [{Key,New}|erase_tuple_element(Key, Dict)]; - _ -> - [{Key,New}|Dict] - end; -store(Key, New, []) -> [{Key,New}]. - -erase(Key, [{K,_}=E|Dict]) when Key < K -> - [E|Dict]; -erase(Key, [{K,Val}=E|Dict]) when Key > K -> - case Val of - {tuple_element,Key,_} -> erase(Key, Dict); - _ -> [E|erase(Key, Dict)] - end; -erase(Key, [{_K,Val}|Dict]) -> %Key == K - case Val of - {tuple,_,_,_} -> erase_tuple_element(Key, Dict); - _ -> Dict - end; -erase(_, []) -> []. - -erase_tuple_element(Key, [{_,{tuple_element,Key,_}}|Dict]) -> - erase_tuple_element(Key, Dict); -erase_tuple_element(Key, [E|Dict]) -> - [E|erase_tuple_element(Key, Dict)]; -erase_tuple_element(_Key, []) -> []. - -%% tdb_meet(Register, Type, Ts0) -> Ts. -%% Update information of a register that is used as the source for an -%% instruction. The type Type will be combined using the meet operation -%% with the previous type information for the register, resulting in -%% narrower (more specific) type. -%% -%% For example, if the previous type is {tuple,min_size,2,[]} and the -%% the new type is {tuple,exact_size,5,[]}, the meet of the types will -%% be {tuple,exact_size,5,[]}. -%% -%% See the comment for verified_type/1 at the end of module for -%% a description of the possible types. - -tdb_meet(Reg, NewType, Ts) -> - Update = fun(Type0) -> meet(Type0, NewType) end, - orddict:update(Reg, Update, NewType, Ts). - -%%% -%%% Here follows internal helper functions for accessing and -%%% updating the type database. -%%% - -tdb_find_raw({x,_}=K, Ts) -> tdb_find_raw_1(K, Ts); -tdb_find_raw({y,_}=K, Ts) -> tdb_find_raw_1(K, Ts); -tdb_find_raw(_, _) -> any. - -tdb_find_raw_1(K, Ts) -> - case orddict:find(K, Ts) of - {ok,Val} -> Val; - error -> any - end. - -tag_literal(A) when is_atom(A) -> {atom,A}; -tag_literal(F) when is_float(F) -> {float,F}; -tag_literal(I) when is_integer(I) -> {integer,I}; -tag_literal([]) -> nil; -tag_literal(Lit) -> {literal,Lit}. - -%% tdb_kill_xregs(Db) -> NewDb -%% Kill all information about x registers. Also kill all tuple_element -%% dependencies from y registers to x registers. - -tdb_kill_xregs([{{x,_},_Type}|Db]) -> tdb_kill_xregs(Db); -tdb_kill_xregs([{{y,_},{tuple_element,{x,_},_}}|Db]) -> tdb_kill_xregs(Db); -tdb_kill_xregs([Any|Db]) -> [Any|tdb_kill_xregs(Db)]; -tdb_kill_xregs([]) -> []. - -%% meet(Type1, Type2) -> Type -%% Returns the "meet" of Type1 and Type2. The meet is a narrower -%% type than Type1 and Type2. For example: -%% -%% meet(integer, {integer,{0,3}}) -> {integer,{0,3}} -%% -%% The meet for two different types result in 'none', which is -%% the bottom element for our type lattice: -%% -%% meet(integer, map) -> none - -meet(T, T) -> - T; -meet({integer,_}=T, integer) -> - T; -meet(integer, {integer,_}=T) -> - T; -meet({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) -> - {integer,{max(Min1, Min2),min(Max1, Max2)}}; -meet({tuple,min_size,Sz1,Same}, {tuple,min_size,Sz2,Same}=Max) when Sz1 < Sz2 -> - Max; -meet({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 -> - Max; -meet({tuple,exact_size,_,Same}=Exact, {tuple,_,_,Same}) -> - Exact; -meet({tuple,_,_,Same},{tuple,exact_size,_,Same}=Exact) -> - Exact; -meet({tuple,SzKind1,Sz1,[]}, {tuple,_SzKind2,_Sz2,First}=Tuple2) -> - meet({tuple,SzKind1,Sz1,First}, Tuple2); -meet({tuple,_SzKind1,_Sz1,First}=Tuple1, {tuple,SzKind2,Sz2,_}) -> - meet(Tuple1, {tuple,SzKind2,Sz2,First}); -meet({binary,U1}, {binary,U2}) -> - {binary,max(U1, U2)}; -meet(T1, T2) -> - case is_any(T1) of - true -> - verified_type(T2); - false -> - case is_any(T2) of - true -> - verified_type(T1); - false -> - none %The bottom element. - end - end. - -is_any(any) -> true; -is_any({tuple_element,_,_}) -> true; -is_any(_) -> false. - -%% verified_type(Type) -> Type -%% Returns the passed in type if it is one of the defined types. -%% Crashes if there is anything wrong with the type. -%% -%% Here are all possible types: -%% -%% any Any Erlang term (top element for the type lattice). -%% -%% {atom,Atom} The specific atom Atom. -%% {binary,Unit} Binary/bitstring aligned to unit Unit. -%% boolean 'true' | 'false' -%% float Floating point number. -%% integer Integer. -%% {integer,{Min,Max}} Integer in the inclusive range Min through Max. -%% map Map. -%% nonempty_list Nonempty list. -%% {tuple,_,_,_} Tuple (see below). -%% -%% none No type (bottom element for the type lattice). -%% -%% {tuple,min_size,Size,First} means that the corresponding register -%% contains a tuple with *at least* Size elements (conversely, -%% {tuple,exact_size,Size,First} means that it contains a tuple with -%% *exactly* Size elements). An tuple with unknown size is -%% represented as {tuple,min_size,0,[]}. First is either [] (meaning -%% that the tuple's first element is unknown) or [FirstElement] (the -%% contents of the first element). -%% -%% There is also a pseudo-type called {tuple_element,_,_}: -%% -%% {tuple_element,SrcTuple,ElementNumber} -%% -%% that does not provide any information about the type of the -%% register itself, but provides a link back to the source tuple that -%% the register got its value from. -%% -%% Note that {tuple_element,_,_} will *never* be returned by tdb_find/2. -%% Use tdb_find_source_tuple/2 to locate the source tuple for a register. - -verified_type(any=T) -> T; -verified_type({atom,_}=T) -> T; -verified_type({binary,U}=T) when is_integer(U) -> T; -verified_type(boolean=T) -> T; -verified_type(integer=T) -> T; -verified_type({integer,{Min,Max}}=T) - when is_integer(Min), is_integer(Max) -> T; -verified_type(map=T) -> T; -verified_type(nonempty_list=T) -> T; -verified_type({tuple,_,Sz,[]}=T) when is_integer(Sz) -> T; -verified_type({tuple,_,Sz,[_]}=T) when is_integer(Sz) -> T; -verified_type({tuple_element,_,_}=T) -> T; -verified_type(float=T) -> T. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 3bb671f034..686d314c2d 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -21,18 +21,16 @@ %% -module(beam_utils). --export([is_killed_block/2,is_killed/3,is_killed_at/3, - is_not_used/3,usage/3, +-export([is_killed/3,is_killed_at/3,is_not_used/3, empty_label_index/0,index_label/3,index_labels/1,replace_labels/4, code_at/2,bif_to_test/3,is_pure_test/1, - live_opt/1,delete_annos/1,combine_heap_needs/2, - anno_defs/1, + combine_heap_needs/2, split_even/1 ]). -export_type([code_index/0,module_code/0,instruction/0]). --import(lists, [flatmap/2,map/2,member/2,sort/1,reverse/1,splitwith/2]). +-import(lists, [flatmap/2,map/2,member/2,sort/1,reverse/1]). -define(is_const(Val), (Val =:= nil orelse element(1, Val) =:= integer orelse @@ -62,46 +60,6 @@ {lbl :: code_index(), %Label to code index. res :: result_cache()}). %Result cache for each label. -%% usage(Register, [Instruction], State) -> killed|not_used|used. -%% Determine the usage of Register in the instruction sequence. -%% The return value is one of: -%% -%% killed - The register is not used in any way. -%% not_used - The register is referenced only by an allocating instruction -%% (the actual value does not matter). -%% used - The register is used (its value do matter). - --spec usage(beam_asm:reg(), [instruction()], code_index()) -> - 'killed' | 'not_used' | 'used'. - -usage(R, Is, D) -> - St = #live{lbl=D,res=gb_trees:empty()}, - {Usage,_} = check_liveness(R, Is, St), - Usage. - - -%% is_killed_block(Register, [Instruction]) -> true|false -%% Determine whether a register is killed by the instruction sequence inside -%% a block. -%% -%% If true is returned, it means that the register will not be -%% referenced in ANY way (not even indirectly by an allocate instruction); -%% i.e. it is OK to enter the instruction sequence with Register -%% containing garbage. - --spec is_killed_block(beam_asm:reg(), [instruction()]) -> boolean(). - -is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) -> - X >= Live; -is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> - not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is)); -is_killed_block(R, [{'%anno',{used,Regs}}|Is]) -> - case R of - {x,X} when (Regs bsr X) band 1 =:= 0 -> true; - _ -> is_killed_block(R, Is) - end; -is_killed_block(_, []) -> false. - %% is_killed(Register, [Instruction], State) -> true|false %% Determine whether a register is killed by the instruction sequence. %% If true is returned, it means that the register will not be @@ -224,23 +182,18 @@ bif_to_test('=<', [A,B], Fail) -> {test,is_ge,Fail,[B,A]}; bif_to_test('>', [A,B], Fail) -> {test,is_lt,Fail,[B,A]}; bif_to_test('<', [_,_]=Ops, Fail) -> {test,is_lt,Fail,Ops}; bif_to_test('>=', [_,_]=Ops, Fail) -> {test,is_ge,Fail,Ops}; -bif_to_test('==', [A,nil], Fail) -> {test,is_nil,Fail,[A]}; -bif_to_test('==', [nil,A], Fail) -> {test,is_nil,Fail,[A]}; bif_to_test('==', [C,A], Fail) when ?is_const(C) -> {test,is_eq,Fail,[A,C]}; bif_to_test('==', [_,_]=Ops, Fail) -> {test,is_eq,Fail,Ops}; bif_to_test('/=', [C,A], Fail) when ?is_const(C) -> {test,is_ne,Fail,[A,C]}; bif_to_test('/=', [_,_]=Ops, Fail) -> {test,is_ne,Fail,Ops}; -bif_to_test('=:=', [A,nil], Fail) -> {test,is_nil,Fail,[A]}; -bif_to_test('=:=', [nil,A], Fail) -> {test,is_nil,Fail,[A]}; bif_to_test('=:=', [C,A], Fail) when ?is_const(C) -> {test,is_eq_exact,Fail,[A,C]}; bif_to_test('=:=', [_,_]=Ops, Fail) -> {test,is_eq_exact,Fail,Ops}; bif_to_test('=/=', [C,A], Fail) when ?is_const(C) -> {test,is_ne_exact,Fail,[A,C]}; -bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops}; -bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. +bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops}. %% is_pure_test({test,Op,Fail,Ops}) -> true|false. @@ -256,8 +209,8 @@ is_pure_test({test,is_eq_exact,_,[_,_]}) -> true; is_pure_test({test,is_ne_exact,_,[_,_]}) -> true; is_pure_test({test,is_ge,_,[_,_]}) -> true; is_pure_test({test,is_lt,_,[_,_]}) -> true; -is_pure_test({test,is_nil,_,[_]}) -> true; is_pure_test({test,is_nonempty_list,_,[_]}) -> true; +is_pure_test({test,is_tagged_tuple,_,[_,_,_]}) -> true; is_pure_test({test,test_arity,_,[_,_]}) -> true; is_pure_test({test,has_map_fields,_,[_|_]}) -> true; is_pure_test({test,is_bitstr,_,[_]}) -> true; @@ -265,42 +218,6 @@ is_pure_test({test,is_function2,_,[_,_]}) -> true; is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). - -%% live_opt([Instruction]) -> [Instruction]. -%% Go through the instruction sequence in reverse execution -%% order, keep track of liveness and remove 'move' instructions -%% whose destination is a register that will not be used. -%% Also insert {used,Regs} annotations at the beginning -%% and end of each block. - --spec live_opt([instruction()]) -> [instruction()]. - -live_opt(Is0) -> - {[{label,Fail}|_]=Bef,[Fi|Is]} = - splitwith(fun({func_info,_,_,_}) -> false; - (_) -> true - end, Is0), - {func_info,_,_,Live} = Fi, - D = gb_trees:insert(Fail, live_call(Live), gb_trees:empty()), - Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])]. - - -%% delete_annos([Instruction]) -> [Instruction]. -%% Delete all annotations. - --spec delete_annos([instruction()]) -> [instruction()]. - -delete_annos([{block,Bl0}|Is]) -> - case delete_annos(Bl0) of - [] -> delete_annos(Is); - [_|_]=Bl -> [{block,Bl}|delete_annos(Is)] - end; -delete_annos([{'%anno',_}|Is]) -> - delete_annos(Is); -delete_annos([I|Is]) -> - [I|delete_annos(Is)]; -delete_annos([]) -> []. - %% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed %% Combine the heap need for two allocation instructions. @@ -314,24 +231,6 @@ combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) -> combine_heap_needs(H1, H2) -> {alloc,combine_alloc_lists([H1,H2])}. - -%% anno_defs(Instructions) -> Instructions' -%% Add {def,RegisterBitmap} annotations to the beginning of -%% each block. Iff bit X is set in the the bitmap, it means -%% that {x,X} is defined when the block is entered. - --spec anno_defs([instruction()]) -> [instruction()]. - -anno_defs(Is0) -> - {Bef,[Fi|Is1]} = - splitwith(fun({func_info,_,_,_}) -> false; - (_) -> true - end, Is0), - {func_info,_,_,Arity} = Fi, - Regs = init_def_regs(Arity), - Is = defs(Is1, Regs, #{}), - Bef ++ [Fi|Is]. - %% split_even/1 %% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} @@ -850,466 +749,7 @@ combine_alloc_lists(Al0) -> %% live_opt/4. -%% Bit syntax instructions. -live_opt([{bs_context_to_binary,Src}=I|Is], Regs0, D, Acc) -> - Regs = x_live([Src], Regs0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_init,Fail,_,none,Ss,Dst}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live(Ss, x_dead([Dst], Regs0)), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_init,Fail,Info,Live0,Ss,Dst}|Is], Regs0, D, Acc) -> - Regs1 = x_dead([Dst], Regs0), - Live = live_regs(Regs1), - true = Live =< Live0, %Assertion. - Regs2 = live_call(Live), - Regs3 = x_live(Ss, Regs2), - Regs = live_join_label(Fail, D, Regs3), - I = {bs_init,Fail,Info,Live,Ss,Dst}, - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_put,Fail,_,Ss}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live(Ss, Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_restore2,Src,_}=I|Is], Regs0, D, Acc) -> - Regs = x_live([Src], Regs0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_save2,Src,_}=I|Is], Regs0, D, Acc) -> - Regs = x_live([Src], Regs0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) -> - Regs0 = live_call(Live), - Regs1 = x_live([Src], Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); - -%% Other instructions. -live_opt([{block,Bl0}|Is], Regs0, D, Acc) -> - Live0 = make_anno({used,Regs0}), - {Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]), - Live = make_anno({used,Regs}), - live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]); -live_opt([build_stacktrace=I|Is], _, D, Acc) -> - live_opt(Is, live_call(1), D, [I|Acc]); -live_opt([raw_raise=I|Is], _, D, Acc) -> - live_opt(Is, live_call(3), D, [I|Acc]); -live_opt([{label,L}=I|Is], Regs, D0, Acc) -> - D = gb_trees:insert(L, Regs, D0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{jump,{f,L}}=I|Is], _, D, Acc) -> - Regs = gb_trees:get(L, D), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([return=I|Is], _, D, Acc) -> - live_opt(Is, 1, D, [I|Acc]); -live_opt([{catch_end,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(1), D, [I|Acc]); -live_opt([{badmatch,Src}=I|Is], _, D, Acc) -> - Regs = x_live([Src], 0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{case_end,Src}=I|Is], _, D, Acc) -> - Regs = x_live([Src], 0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{try_case_end,Src}=I|Is], _, D, Acc) -> - Regs = x_live([Src], 0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([if_end=I|Is], _, D, Acc) -> - Regs = 0, - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{call,Arity,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([{call_ext,Arity,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([{call_fun,Arity}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity+1), D, [I|Acc]); -live_opt([{apply,Arity}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity+2), D, [I|Acc]); -live_opt([{make_fun2,_,_,_,Arity}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([{test,_,Fail,Ss}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live(Ss, Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{test,_,Fail,Live,Ss,_}=I|Is], _, D, Acc) -> - Regs0 = live_call(Live), - Regs1 = x_live(Ss, Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{select,_,Src,Fail,List}=I|Is], _, D, Acc) -> - Regs0 = 0, - Regs1 = x_live([Src], Regs0), - Regs = live_join_labels([Fail|List], D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{try_case,Y}=I|Is], Regs0, D, Acc) -> - Regs = live_call(1), - case Regs0 of - 0 -> - live_opt(Is, Regs, D, [{try_end,Y}|Acc]); - _ -> - live_opt(Is, live_call(1), D, [I|Acc]) - end; -live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) -> - live_opt(Is, 0, D, [I|Acc]); -live_opt([timeout=I|Is], _, D, Acc) -> - live_opt(Is, 0, D, [I|Acc]); -live_opt([{wait,_}=I|Is], _, D, Acc) -> - live_opt(Is, 0, D, [I|Acc]); -live_opt([{get_map_elements,Fail,Src,{list,List}}=I|Is], Regs0, D, Acc) -> - {Ss,Ds} = split_even(List), - Regs1 = x_live([Src|Ss], x_dead(Ds, Regs0)), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{gc_bif,N,F,R,As,Dst}=I|Is], Regs0, D, Acc) -> - Bl = [{set,[Dst],As,{alloc,R,{gc_bif,N,F}}}], - {_,Regs} = live_opt_block(Bl, Regs0, D, []), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bif,N,F,As,Dst}=I|Is], Regs0, D, Acc) -> - Bl = [{set,[Dst],As,{bif,N,F}}], - {_,Regs} = live_opt_block(Bl, Regs0, D, []), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{get_tuple_element,Src,Idx,Dst}=I|Is], Regs0, D, Acc) -> - Bl = [{set,[Dst],[Src],{get_tuple_element,Idx}}], - {_,Regs} = live_opt_block(Bl, Regs0, D, []), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{move,Src,Dst}=I|Is], Regs0, D, Acc) -> - Regs = x_live([Src], x_dead([Dst], Regs0)), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{put_map,F,Op,S,Dst,R,{list,Puts}}=I|Is], Regs0, D, Acc) -> - Bl = [{set,[Dst],[S|Puts],{alloc,R,{put_map,Op,F}}}], - {_,Regs} = live_opt_block(Bl, Regs0, D, []), - live_opt(Is, Regs, D, [I|Acc]); - -%% Transparent instructions - they neither use nor modify x registers. -live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{kill,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{wait_timeout,_,nil}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{line,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{'catch',_,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{'try',_,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); - -%% The following instructions can occur if the "compilation" has been -%% started from a .S file using the 'from_asm' option. -live_opt([{trim,_,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{'%',_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{recv_set,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); - -live_opt([], _, _, Acc) -> Acc. - -live_opt_block([{set,[{x,X}]=Ds,Ss,move}=I|Is], Regs0, D, Acc) -> - Regs = x_live(Ss, x_dead(Ds, Regs0)), - case is_live(X, Regs0) of - true -> - live_opt_block(Is, Regs, D, [I|Acc]); - false -> - %% Useless move, will never be used. - live_opt_block(Is, Regs, D, Acc) - end; -live_opt_block([{set,Ds,Ss,{alloc,Live0,AllocOp}}|Is], Regs0, D, Acc) -> - %% Calculate liveness from the point of view of the GC. - %% There will never be a GC if the instruction fails, so we should - %% ignore the failure branch. - GcRegs1 = x_dead(Ds, Regs0), - GcRegs = x_live(Ss, GcRegs1), - Live = live_regs(GcRegs), - - %% The life-time analysis used by the code generator is sometimes too - %% conservative, so it may be possible to lower the number of live - %% registers based on the exact liveness information. The main benefit is - %% that more optimizations that depend on liveness information (such as the - %% beam_dead pass) may be applied. - true = Live =< Live0, %Assertion. - I = {set,Ds,Ss,{alloc,Live,AllocOp}}, - - %% Calculate liveness from the point of view of the preceding instruction. - %% The liveness is the union of live registers in the GC and the live - %% registers at the failure label. - Regs1 = live_call(Live), - Regs = live_join_alloc(AllocOp, D, Regs1), - live_opt_block(Is, Regs, D, [I|Acc]); -live_opt_block([{set,Ds,Ss,{bif,_,Fail}}=I|Is], Regs0, D, Acc) -> - Regs1 = x_dead(Ds, Regs0), - Regs2 = x_live(Ss, Regs1), - Regs = live_join_label(Fail, D, Regs2), - live_opt_block(Is, Regs, D, [I|Acc]); -live_opt_block([{set,Ds,Ss,_}=I|Is], Regs0, D, Acc) -> - Regs = x_live(Ss, x_dead(Ds, Regs0)), - live_opt_block(Is, Regs, D, [I|Acc]); -live_opt_block([{'%anno',_}|Is], Regs, D, Acc) -> - live_opt_block(Is, Regs, D, Acc); -live_opt_block([], Regs, _, Acc) -> {Acc,Regs}. - -live_join_alloc({Kind,_Name,Fail}, D, Regs) when Kind =:= gc_bif; Kind =:= put_map -> - live_join_label(Fail, D, Regs); -live_join_alloc(_, _, Regs) -> Regs. - -live_join_labels([{f,L}|T], D, Regs0) when L =/= 0 -> - Regs = gb_trees:get(L, D) bor Regs0, - live_join_labels(T, D, Regs); -live_join_labels([_|T], D, Regs) -> - live_join_labels(T, D, Regs); -live_join_labels([], _, Regs) -> Regs. - -live_join_label({f,0}, _, Regs) -> - Regs; -live_join_label({f,L}, D, Regs) -> - gb_trees:get(L, D) bor Regs. - -live_call(Live) -> (1 bsl Live) - 1. - -live_regs(Regs) -> - live_regs_1(0, Regs). - -live_regs_1(N, 0) -> N; -live_regs_1(N, Regs) -> live_regs_1(N+1, Regs bsr 1). - -x_dead([{x,N}|Rs], Regs) -> x_dead(Rs, Regs band (bnot (1 bsl N))); -x_dead([_|Rs], Regs) -> x_dead(Rs, Regs); -x_dead([], Regs) -> Regs. - -x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); -x_live([_|Rs], Regs) -> x_live(Rs, Regs); -x_live([], Regs) -> Regs. - -is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1. - split_even([], Ss, Ds) -> {reverse(Ss),reverse(Ds)}; split_even([S,D|Rs], Ss, Ds) -> split_even(Rs, [S|Ss], [D|Ds]). - -%%% -%%% Add annotations for defined registers. -%%% -%%% This analysis is done by scanning the instructions in -%%% execution order. -%%% - -defs([{apply,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{bif,_,{f,Fail},_Src,Dst}=I|Is], Regs0, D) -> - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; -defs([{block,Block0}|Is], Regs0, D0) -> - {Block,Regs,D} = defs_list(Block0, Regs0, D0), - [{block,[make_anno({def,Regs0})|Block]}|defs(Is, Regs, D)]; -defs([{bs_init,{f,L},_,Live,_,Dst}=I|Is], Regs0, D) -> - Regs1 = case Live of - none -> Regs0; - _ -> init_def_regs(Live) - end, - Regs = def_regs([Dst], Regs1), - [I|defs(Is, Regs, update_regs(L, Regs, D))]; -defs([{bs_put,{f,L},_,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, update_regs(L, Regs, D))]; -defs([build_stacktrace=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{call,_,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{call_ext,_,{extfunc,M,F,A}}=I|Is], _Regs, D) -> - case erl_bifs:is_exit_bif(M, F, A) of - false -> - [I|defs(Is, 1, D)]; - true -> - [I|defs_unreachable(Is, D)] - end; -defs([{call_ext,_,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{call_fun,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{'catch',_,{f,L}}=I|Is], Regs, D) -> - RegsAtLabel = init_def_regs(1), - [I|defs(Is, Regs, update_regs(L, RegsAtLabel, D))]; -defs([{catch_end,_}=I|Is], _Regs, D) -> - Regs = init_def_regs(1), - [I|defs(Is, Regs, D)]; -defs([{gc_bif,_,{f,Fail},Live,_Src,Dst}=I|Is], Regs0, D) -> - true = all_defined(Live, Regs0), %Assertion. - Regs = def_regs([Dst], init_def_regs(Live)), - [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; -defs([{get_map_elements,{f,L},_Src,{list,DstList}}=I|Is], Regs0, D) -> - {_,Ds} = beam_utils:split_even(DstList), - Regs = def_regs(Ds, Regs0), - [I|defs(Is, Regs, update_regs(L, Regs0, D))]; -defs([{get_tuple_element,_,_,Dst}=I|Is], Regs0, D) -> - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, D)]; -defs([{jump,{f,L}}=I|Is], Regs, D) -> - [I|defs_unreachable(Is, update_regs(L, Regs, D))]; -defs([{label,L}=I|Is], Regs0, D) -> - case D of - #{L:=Regs1} -> - Regs = Regs0 band Regs1, - [I|defs(Is, Regs, D)]; - #{} -> - [I|defs(Is, Regs0, D)] - end; -defs([{loop_rec,{f,L},{x,0}}=I|Is], _Regs, D0) -> - RegsAtLabel = init_def_regs(0), - D = update_regs(L, RegsAtLabel, D0), - [I|defs(Is, init_def_regs(1), D)]; -defs([{loop_rec_end,_}=I|Is], _Regs, D) -> - [I|defs(Is, 0, D)]; -defs([{make_fun2,_,_,_,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{move,_,Dst}=I|Is], Regs0, D) -> - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, D)]; -defs([{put_map,{f,Fail},_,_,Dst,_,_}=I|Is], Regs0, D) -> - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; -defs([raw_raise=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([return=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{select,_,_Src,Fail,List}=I|Is], Regs, D0) -> - D = update_list([Fail|List], Regs, D0), - [I|defs_unreachable(Is, D)]; -defs([{test,_,{f,L},_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, update_regs(L, Regs, D))]; -defs([{test,_,{f,L},Live,_,Dst}=I|Is], Regs0, D) -> - true = all_defined(Live, Regs0), %Assertion. - Regs = def_regs([Dst], init_def_regs(Live)), - [I|defs(Is, Regs, update_regs(L, Regs0, D))]; -defs([{'try',_,{f,L}}=I|Is], Regs, D) -> - RegsAtLabel = init_def_regs(3), - [I|defs(Is, Regs, update_regs(L, RegsAtLabel, D))]; -defs([{try_case,_}=I|Is], _Regs, D) -> - [I|defs(Is, init_def_regs(3), D)]; -defs([{wait,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{wait_timeout,_,_}=I|Is], _Regs, D) -> - [I|defs(Is, 0, D)]; - -%% Exceptions. -defs([{badmatch,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{case_end,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([if_end=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{try_case_end,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; - -%% Neutral instructions -defs([{bs_context_to_binary,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{bs_restore2,_,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{bs_save2,_,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{deallocate,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{kill,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{line,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{recv_mark,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{recv_set,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([timeout=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{trim,_,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{try_end,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{'%',_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([], _, _) -> []. - -defs_unreachable([{label,L}=I|Is], D) -> - case D of - #{L:=Regs} -> - [I|defs(Is, Regs, D)]; - #{} -> - defs_unreachable(Is, D) - end; -defs_unreachable([_|Is], D) -> - defs_unreachable(Is, D); -defs_unreachable([], _D) -> []. - -defs_list(Is, Regs, D) -> - defs_list(Is, Regs, D, []). - -defs_list([{set,Ds,_,{alloc,Live,Info}}=I|Is], Regs0, D0, Acc) -> - true = all_defined(Live, Regs0), %Assertion. - D = case Info of - {gc_bif,_,{f,Fail}} -> - update_regs(Fail, Regs0, D0); - {put_map,_,{f,Fail}} -> - update_regs(Fail, Regs0, D0); - _ -> - D0 - end, - Regs = def_regs(Ds, init_def_regs(Live)), - defs_list(Is, Regs, D, [I|Acc]); -defs_list([{set,Ds,_,Info}=I|Is], Regs0, D0, Acc) -> - D = case Info of - {bif,_,{f,Fail}} -> - update_regs(Fail, Regs0, D0); - {try_catch,'catch',{f,Fail}} -> - update_regs(Fail, init_def_regs(1), D0); - {try_catch,'try',{f,Fail}} -> - update_regs(Fail, init_def_regs(3), D0); - _ -> - D0 - end, - Regs = def_regs(Ds, Regs0), - defs_list(Is, Regs, D, [I|Acc]); -defs_list([], Regs, D, Acc) -> - {reverse(Acc),Regs,D}. - -init_def_regs(Arity) -> - (1 bsl Arity) - 1. - -def_regs([{x,X}|T], Regs) -> - def_regs(T, Regs bor (1 bsl X)); -def_regs([_|T], Regs) -> - def_regs(T, Regs); -def_regs([], Regs) -> Regs. - -update_list([{f,L}|T], Regs, D0) -> - D = update_regs(L, Regs, D0), - update_list(T, Regs, D); -update_list([_|T], Regs, D) -> - update_list(T, Regs, D); -update_list([], _Regs, D) -> D. - -update_regs(L, Regs0, D) -> - case D of - #{L:=Regs1} -> - Regs = Regs0 band Regs1, - D#{L:=Regs}; - #{} -> - D#{L=>Regs0} - end. - -all_defined(Live, Regs) -> - All = (1 bsl Live) - 1, - Regs band All =:= All. - -%%% -%%% Utilities. -%%% - -%% make_anno(Anno) -> WrappedAnno. -%% Wrap an annotation term. - -make_anno(Anno) -> - {'%anno',Anno}. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index a1b71251b7..953aced66e 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -27,7 +27,7 @@ %% Interface for compiler. -export([module/2, format_error/1]). --import(lists, [any/2,dropwhile/2,foldl/3,foreach/2,reverse/1]). +-import(lists, [any/2,dropwhile/2,foldl/3,map/2,foreach/2,reverse/1]). %% To be called by the compiler. @@ -145,7 +145,9 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> fls=undefined, %Floating point state. ct=[], %List of hot catch/try labels setelem=false, %Previous instruction was setelement/3. - puts_left=none %put/1 instructions left. + puts_left=none, %put/1 instructions left. + defs=#{}, %Defining expression for each register. + aliases=#{} }). -type label() :: integer(). @@ -203,6 +205,12 @@ validate_fun_info_branches([], _, _) -> ok. validate_fun_info_branches_1(Arity, {_,_,Arity}, _) -> ok; validate_fun_info_branches_1(X, {Mod,Name,Arity}=MFA, Vst) -> try + case Vst of + #vst{current=#st{numy=none}} -> + ok; + #vst{current=#st{numy=Size}} -> + error({unexpected_stack_frame,Size}) + end, get_term_type({x,X}, Vst) catch Error -> I = {func_info,{atom,Mod},{atom,Name},Arity}, @@ -280,7 +288,7 @@ valfun_1({try_case_end,Src}, Vst) -> verify_y_init(Vst), assert_term(Src, Vst), kill_state(Vst); -%% Instructions that can not cause exceptions +%% Instructions that cannot cause exceptions valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) -> case Ctx of {Tag,X} when Tag =:= x; Tag =:= y -> @@ -304,9 +312,10 @@ valfun_1({move,{y,_}=Src,{y,_}=Dst}, Vst) -> {trytag,_} -> error({trytag,Src}); Type -> set_type_reg(Type, Dst, Vst) end; -valfun_1({move,Src,Dst}, Vst) -> - Type = get_move_term_type(Src, Vst), - set_type_reg(Type, Dst, Vst); +valfun_1({move,Src,Dst}, Vst0) -> + Type = get_move_term_type(Src, Vst0), + Vst = set_type_reg(Type, Dst, Vst0), + set_alias(Src, Dst, Vst); valfun_1({fmove,Src,{fr,_}=Dst}, Vst) -> assert_type(float, Src, Vst), set_freg(Dst, Vst); @@ -332,7 +341,7 @@ valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> %% catch state). validate_src(Src, Vst), Type = bif_type(Op, Src, Vst), - set_type_reg(Type, Dst, Vst) + set_type_reg_expr(Type, I, Dst, Vst) end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> @@ -340,6 +349,12 @@ valfun_1({put_list,A,B,Dst}, Vst0) -> assert_term(B, Vst0), Vst = eat_heap(2, Vst0), set_type_reg(cons, Dst, Vst); +valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> + _ = [assert_term(El, Vst0) || El <- Elements], + Size = length(Elements), + Vst = eat_heap(Size+1, Vst0), + Type = {tuple,Size}, + set_type_reg(Type, Dst, Vst); valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), Vst = set_type_reg(tuple_in_progress, Dst, Vst1), @@ -408,35 +423,27 @@ valfun_1({trim,N,Remaining}, #vst{current=#st{y=Yregs0,numy=NumY}=St}=Vst) -> N =< NumY, N+Remaining =:= NumY -> Yregs1 = [{Y-N,Type} || {Y,Type} <- gb_trees:to_list(Yregs0), Y >= N], Yregs = gb_trees_from_list(Yregs1), - Vst#vst{current=St#st{y=Yregs,numy=NumY-N}}; + Vst#vst{current=St#st{y=Yregs,numy=NumY-N,aliases=#{}}}; true -> error({trim,N,Remaining,allocated,NumY}) end; %% Catch & try. -valfun_1({'catch',Dst,{f,Fail}}, Vst0) when Fail /= none -> - Vst = #vst{current=#st{ct=Fails}=St} = - set_type_y({catchtag,[Fail]}, Dst, Vst0), - Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({'try',Dst,{f,Fail}}, Vst0) -> - Vst = #vst{current=#st{ct=Fails}=St} = - set_type_y({trytag,[Fail]}, Dst, Vst0), - Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; +valfun_1({'catch',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|Fails]}}=Vst0) -> case get_special_y_type(Reg, Vst0) of {catchtag,Fail} -> Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; + Xregs = gb_trees:enter(0, term, St#st.x), + Vst#vst{current=St#st{x=Xregs,ct=Fails,fls=undefined,aliases=#{}}}; Type -> error({bad_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> - case get_special_y_type(Reg, Vst0) of +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst) -> + case get_special_y_type(Reg, Vst) of {trytag,Fail} -> - Vst = case Fail of - [FailLabel] -> branch_state(FailLabel, Vst0); - _ -> Vst0 - end, St = St0#st{ct=Fails,fls=undefined}, set_catch_end(Reg, Vst#vst{current=St}); Type -> @@ -447,18 +454,51 @@ valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> {trytag,Fail} -> Vst = #vst{current=St} = set_catch_end(Reg, Vst0), Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), - Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; + Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined,aliases=#{}}}; Type -> error({bad_type,Type}) end; +valfun_1({get_list,Src,D1,D2}, Vst0) -> + assert_type(cons, Src, Vst0), + Vst = set_type_reg(term, Src, D1, Vst0), + set_type_reg(term, Src, D2, Vst); +valfun_1({get_hd,Src,Dst}, Vst) -> + assert_type(cons, Src, Vst), + set_type_reg(term, Src, Dst, Vst); +valfun_1({get_tl,Src,Dst}, Vst) -> + assert_type(cons, Src, Vst), + set_type_reg(term, Src, Dst, Vst); +valfun_1({get_tuple_element,Src,I,Dst}, Vst) -> + assert_type({tuple_element,I+1}, Src, Vst), + set_type_reg(term, Src, Dst, Vst); +valfun_1({jump,{f,Lbl}}, Vst) -> + kill_state(branch_state(Lbl, Vst)); valfun_1(I, Vst) -> valfun_2(I, Vst). +init_try_catch_branch(Tag, Dst, Fail, Vst0) -> + Vst1 = set_type_y({Tag,[Fail]}, Dst, Vst0), + #vst{current=#st{ct=Fails}=St0} = Vst1, + CurrentSt = St0#st{ct=[[Fail]|Fails]}, + + %% Set the initial state at the try/catch label. + %% Assume that Y registers contain terms or try/catch + %% tags. + Yregs0 = map(fun({Y,uninitialized}) -> {Y,term}; + ({Y,initialized}) -> {Y,term}; + (E) -> E + end, gb_trees:to_list(CurrentSt#st.y)), + Yregs = gb_trees:from_orddict(Yregs0), + BranchSt = CurrentSt#st{y=Yregs}, + + Vst = branch_state(Fail, Vst1#vst{current=BranchSt}), + Vst#vst{current=CurrentSt}. + %% Update branched state if necessary and try next set of instructions. valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> valfun_3(I, Vst); valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> - %% Update branched state + %% Update branched state. valfun_3(I, branch_state(Fail, Vst)); valfun_2(_, _) -> error(ambiguous_catch_try_state). @@ -528,18 +568,18 @@ valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs -valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}, Vst0) -> +valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}=I, Vst0) -> TupleType0 = get_term_type(Tuple, Vst0), Vst1 = branch_state(Fail, Vst0), TupleType = upgrade_tuple_type({tuple,[0]}, TupleType0), Vst = set_type(TupleType, Tuple, Vst1), - set_type_reg({integer,[]}, Dst, Vst); + set_type_reg_expr({integer,[]}, I, Dst, Vst); valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> TupleType0 = get_term_type(Tuple, Vst0), PosType = get_term_type(Pos, Vst0), Vst1 = branch_state(Fail, Vst0), TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0), - Vst = set_type(TupleType, Tuple, Vst1), + Vst = set_aliased_type(TupleType, Tuple, Vst1), set_type_reg(term, Tuple, Dst, Vst); valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), @@ -552,6 +592,12 @@ valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) -> Vst = set_type(map, Map, Vst1), Type = propagate_fragility(term, Src, Vst), set_type_reg(Type, Dst, Vst); +valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) -> + validate_src(Src, Vst0), + Vst1 = branch_state(Fail, Vst0), + Vst = set_type(map, Map, Vst1), + Type = propagate_fragility(bool, Src, Vst), + set_type_reg(Type, Dst, Vst); valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> validate_src(Src, Vst0), Vst = branch_state(Fail, Vst0), @@ -574,8 +620,6 @@ valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> kill_state(Vst); valfun_4(return, #vst{current=#st{numy=NumY}}) -> error({stack_frame,NumY}); -valfun_4({jump,{f,Lbl}}, Vst) -> - kill_state(branch_state(Lbl, Vst)); valfun_4({loop_rec,{f,Fail},Dst}, Vst0) -> Vst = branch_state(Fail, Vst0), %% This term may not be part of the root set until @@ -602,26 +646,18 @@ valfun_4({set_tuple_element,Src,Tuple,I}, Vst) -> assert_type({tuple_element,I+1}, Tuple, Vst), Vst; %% Match instructions. -valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> - assert_term(Src, Vst), - Lbls = [L || {f,L} <- Choices]++[Fail], - kill_state(foldl(fun(L, S) -> branch_state(L, S) end, Vst, Lbls)); +valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst0) -> + assert_term(Src, Vst0), + Vst = branch_state(Fail, Vst0), + kill_state(select_val_branches(Src, Choices, Vst)); valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> assert_type(tuple, Tuple, Vst), - kill_state(branch_arities(Choices, Tuple, branch_state(Fail, Vst))); -valfun_4({get_list,Src,D1,D2}, Vst0) -> - assert_type(cons, Src, Vst0), - Vst = set_type_reg(term, Src, D1, Vst0), - set_type_reg(term, Src, D2, Vst); -valfun_4({get_hd,Src,Dst}, Vst) -> - assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); -valfun_4({get_tl,Src,Dst}, Vst) -> - assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); -valfun_4({get_tuple_element,Src,I,Dst}, Vst) -> - assert_type({tuple_element,I+1}, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + TupleType = case get_term_type(Tuple, Vst) of + {fragile,TupleType0} -> TupleType0; + TupleType0 -> TupleType0 + end, + kill_state(branch_arities(Choices, Tuple, TupleType, + branch_state(Fail, Vst))); %% New bit syntax matching instructions. valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> @@ -694,16 +730,19 @@ valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) -> valfun_4({test,is_tuple,{f,Lbl},[Tuple]}, Vst) -> Type0 = get_term_type(Tuple, Vst), Type = upgrade_tuple_type({tuple,[0]}, Type0), - set_type(Type, Tuple, branch_state(Lbl, Vst)); + set_aliased_type(Type, Tuple, branch_state(Lbl, Vst)); valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) -> assert_term(Cons, Vst), - set_type(cons, Cons, branch_state(Lbl, Vst)); + Type = cons, + set_aliased_type(Type, Cons, branch_state(Lbl, Vst)); valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> assert_type(tuple, Tuple, Vst), - set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst)); + Type = {tuple,Sz}, + set_aliased_type(Type, Tuple, branch_state(Lbl, Vst)); valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) -> validate_src([Src], Vst), - set_type_reg({tuple, Sz}, Src, branch_state(Lbl, Vst)); + Type = {tuple,Sz}, + set_aliased_type(Type, Src, branch_state(Lbl, Vst)); valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), assert_unique_map_keys(List), @@ -712,11 +751,26 @@ valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> Vst = branch_state(Lbl, Vst0), case Src of {Tag,_} when Tag =:= x; Tag =:= y -> - set_type_reg(map, Src, Vst); + Type = map, + set_aliased_type(Type, Src, Vst); {literal,Map} when is_map(Map) -> - Vst; + Vst0; _ -> - kill_state(Vst) + kill_state(Vst0) + end; +valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> + validate_src(Ss, Vst0), + Infer = infer_types(Src, Vst0), + Vst1 = Infer(Val, Vst0), + Vst = branch_state(Lbl, Vst1), + case Val of + {literal,Tuple} when is_tuple(Tuple) -> + Type0 = get_term_type(Val, Vst), + Type = upgrade_tuple_type({tuple,tuple_size(Tuple)}, + Type0), + set_aliased_type(Type, Src, Vst); + _ -> + Vst end; valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), @@ -879,21 +933,15 @@ val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> error(illegal_context_for_set_tuple_element); val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> Vst; +val_dsetel({get_tuple_element,_,_,_}, Vst) -> + Vst; val_dsetel({line,_}, Vst) -> Vst; val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) -> Vst#vst{current=St#st{setelem=false}}; val_dsetel(_, Vst) -> Vst. -kill_state(#vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> - %% There is an active catch. Make sure that we merge the state into - %% the catch label before clearing it, so that that we can be sure - %% that the label gets a state. - kill_state_1(branch_state(Fail, Vst)); kill_state(Vst) -> - kill_state_1(Vst). - -kill_state_1(Vst) -> Vst#vst{current=none}. %% A "plain" call. @@ -906,7 +954,7 @@ call(Name, Live, #vst{current=St}=Vst) -> Type when Type =/= exception -> %% Type is never 'exception' because it has been handled earlier. Xs = gb_trees_from_list([{0,Type}]), - Vst#vst{current=St#st{x=Xs,f=init_fregs()}} + Vst#vst{current=St#st{x=Xs,f=init_fregs(),aliases=#{}}} end. %% Tail call. @@ -1019,11 +1067,25 @@ heap_alloc_2([{floats,Floats}|T], St0) -> St = St0#st{hf=Floats}, heap_alloc_2(T, St); heap_alloc_2([], St) -> St. - -prune_x_regs(Live, #vst{current=#st{x=Xs0}=St0}=Vst) when is_integer(Live) -> + +prune_x_regs(Live, #vst{current=St0}=Vst) + when is_integer(Live) -> + #st{x=Xs0,defs=Defs0,aliases=Aliases0} = St0, Xs1 = gb_trees:to_list(Xs0), Xs = [P || {R,_}=P <- Xs1, R < Live], - St = St0#st{x=gb_trees:from_orddict(Xs)}, + Defs = maps:filter(fun({x,X}, _) -> X < Live; + ({y,_}, _) -> true + end, Defs0), + Aliases = maps:filter(fun({x,X1}, {x,X2}) -> + X1 < Live andalso X2 < Live; + ({x,X}, _) -> + X < Live; + (_, {x,X}) -> + X < Live; + (_, _) -> + true + end, Aliases0), + St = St0#st{x=gb_trees:from_orddict(Xs),defs=Defs,aliases=Aliases}, Vst#vst{current=St}. %%% @@ -1154,10 +1216,73 @@ bsm_restore(Reg, SavePoint, Vst) -> _ -> error({illegal_restore,SavePoint,range}) end. +select_val_branches(Src, Choices, Vst) -> + Infer = infer_types(Src, Vst), + select_val_branches_1(Choices, Infer, Vst). + +select_val_branches_1([Val,{f,L}|T], Infer, Vst0) -> + Vst = branch_state(L, Infer(Val, Vst0)), + select_val_branches_1(T, Infer, Vst); +select_val_branches_1([], _, Vst) -> Vst. + +infer_types(Src, Vst) -> + case get_def(Src, Vst) of + {bif,is_map,{f,_},[Map],_} -> + fun({atom,true}, S) -> set_type_reg(map, Map, S); + (_, S) -> S + end; + {bif,tuple_size,{f,_},[Tuple],_} -> + fun({integer,Arity}, S) -> + Type0 = get_term_type(Tuple, S), + Type = upgrade_tuple_type({tuple,Arity}, Type0), + set_type(Type, Tuple, S); + (_, S) -> S + end; + {bif,'=:=',{f,_},[ArityReg,{integer,_}=Val],_} when ArityReg =/= Src -> + fun({atom,true}, S) -> + Infer = infer_types(ArityReg, S), + Infer(Val, S); + (_, S) -> S + end; + _ -> + fun(_, S) -> S end + end. + %%% %%% Keeping track of types. %%% +set_alias(Reg1, Reg2, #vst{current=St0}=Vst) -> + case Reg1 of + {Kind,_} when Kind =:= x; Kind =:= y -> + #st{aliases=Aliases0} = St0, + Aliases = Aliases0#{Reg1=>Reg2,Reg2=>Reg1}, + St = St0#st{aliases=Aliases}, + Vst#vst{current=St}; + _ -> + Vst + end. + +set_aliased_type(Type, Reg, #vst{current=#st{aliases=Aliases}}=Vst0) -> + Vst1 = set_type(Type, Reg, Vst0), + case Aliases of + #{Reg:=OtherReg} -> + Vst = set_type_reg(Type, OtherReg, Vst1), + #vst{current=St} = Vst, + Vst#vst{current=St#st{aliases=Aliases}}; + #{} -> + Vst1 + end. + +kill_aliases(Reg, #st{aliases=Aliases0}=St) -> + case Aliases0 of + #{Reg:=OtherReg} -> + Aliases = maps:without([Reg,OtherReg], Aliases0), + St#st{aliases=Aliases}; + #{} -> + St + end. + set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst); set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst); set_type(_, _, #vst{}=Vst) -> Vst. @@ -1170,12 +1295,18 @@ set_type_reg(Type, Src, Dst, Vst) -> set_type_reg(Type, Dst, Vst) end. -set_type_reg(Type, {x,_}=Reg, Vst) -> - set_type_x(Type, Reg, Vst); set_type_reg(Type, Reg, Vst) -> - set_type_y(Type, Reg, Vst). + set_type_reg_expr(Type, none, Reg, Vst). -set_type_x(Type, {x,X}=Reg, #vst{current=#st{x=Xs0}=St}=Vst) +set_type_reg_expr(Type, Expr, {x,_}=Reg, Vst) -> + set_type_x(Type, Expr, Reg, Vst); +set_type_reg_expr(Type, Expr, Reg, Vst) -> + set_type_y(Type, Expr, Reg, Vst). + +set_type_y(Type, Reg, Vst) -> + set_type_y(Type, none, Reg, Vst). + +set_type_x(Type, Expr, {x,X}=Reg, #vst{current=#st{x=Xs0,defs=Defs0}=St0}=Vst) when is_integer(X), 0 =< X -> check_limit(Reg), Xs = case gb_trees:lookup(X, Xs0) of @@ -1186,11 +1317,13 @@ set_type_x(Type, {x,X}=Reg, #vst{current=#st{x=Xs0}=St}=Vst) {value,_} -> gb_trees:update(X, Type, Xs0) end, - Vst#vst{current=St#st{x=Xs}}; -set_type_x(Type, Reg, #vst{}) -> + Defs = Defs0#{Reg=>Expr}, + St = kill_aliases(Reg, St0), + Vst#vst{current=St#st{x=Xs,defs=Defs}}; +set_type_x(Type, _Expr, Reg, #vst{}) -> error({invalid_store,Reg,Type}). -set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) +set_type_y(Type, Expr, {y,Y}=Reg, #vst{current=#st{y=Ys0,defs=Defs0}=St0}=Vst) when is_integer(Y), 0 =< Y -> check_limit(Reg), Ys = case gb_trees:lookup(Y, Ys0) of @@ -1204,8 +1337,11 @@ set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) gb_trees:update(Y, Type, Ys0) end, check_try_catch_tags(Type, Y, Ys0), - Vst#vst{current=St#st{y=Ys}}; -set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}). + Defs = Defs0#{Reg=>Expr}, + St = kill_aliases(Reg, St0), + Vst#vst{current=St#st{y=Ys,defs=Defs}}; +set_type_y(Type, _Expr, Reg, #vst{}) -> + error({invalid_store,Reg,Type}). make_fragile({fragile,_}=Type) -> Type; make_fragile(Type) -> {fragile,Type}. @@ -1417,6 +1553,8 @@ get_term_type_1({atom,A}=T, _) when is_atom(A) -> T; get_term_type_1({float,F}=T, _) when is_float(F) -> T; get_term_type_1({integer,I}=T, _) when is_integer(I) -> T; get_term_type_1({literal,Map}, _) when is_map(Map) -> map; +get_term_type_1({literal,Tuple}, _) when is_tuple(Tuple) -> + {tuple,tuple_size(Tuple)}; get_term_type_1({literal,_}=T, _) -> T; get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) -> case gb_trees:lookup(X, Xs) of @@ -1431,6 +1569,11 @@ get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> end; get_term_type_1(Src, _) -> error({bad_source,Src}). +get_def(Src, #vst{current=#st{defs=Defs}}) -> + case Defs of + #{Src:=Def} -> Def; + #{} -> none + end. %% get_literal(Src) -> literal_value(). get_literal(nil) -> []; @@ -1440,13 +1583,20 @@ get_literal({integer,I}) when is_integer(I) -> I; get_literal({literal,L}) -> L; get_literal(T) -> error({not_literal,T}). - -branch_arities([], _, #vst{}=Vst) -> Vst; -branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) - when is_integer(Sz) -> - Vst1 = set_type_reg({tuple,Sz}, Tuple, Vst0), +branch_arities([Sz,{f,L}|T], Tuple, {tuple,[_]}=Type0, Vst0) when is_integer(Sz) -> + Vst1 = set_aliased_type({tuple,Sz}, Tuple, Vst0), Vst = branch_state(L, Vst1), - branch_arities(T, Tuple, Vst#vst{current=St}). + branch_arities(T, Tuple, Type0, Vst); +branch_arities([Sz,{f,L}|T], Tuple, {tuple,Sz}=Type, Vst0) when is_integer(Sz) -> + %% The type is already correct. (This test is redundant.) + Vst = branch_state(L, Vst0), + branch_arities(T, Tuple, Type, Vst); +branch_arities([Sz0,{f,_}|T], Tuple, {tuple,Sz}=Type, Vst) + when is_integer(Sz), Sz0 =/= Sz -> + %% We already have an established different exact size for the tuple. + %% This label can't possibly be reached. + branch_arities(T, Tuple, Type, Vst); +branch_arities([], _, _, #vst{}=Vst) -> Vst. branch_state(0, #vst{}=Vst) -> %% If the instruction fails, the stack may be scanned @@ -1476,13 +1626,14 @@ merge_states(L, St, Branched) when L =/= 0 -> {value,OtherSt} -> merge_states_1(St, OtherSt) end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}, - #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> +merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0,aliases=Aliases0}, + #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1,aliases=Aliases1}) -> NumY = merge_stk(NumY0, NumY1), Xs = merge_regs(Xs0, Xs1), Ys = merge_y_regs(Ys0, Ys1), Ct = merge_ct(Ct0, Ct1), - #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. + Aliases = merge_aliases(Aliases0, Aliases1), + #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct,aliases=Aliases}. merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. @@ -1567,6 +1718,12 @@ merge_types(bool, {atom,A}) -> merge_bool(A); merge_types({atom,A}, bool) -> merge_bool(A); +merge_types(cons, {literal,[_|_]}) -> + cons; +merge_types({literal,[_|_]}, cons) -> + cons; +merge_types({literal,[_|_]}, {literal,[_|_]}) -> + cons; merge_types(#ms{id=Id1,valid=B1,slots=Slots1}, #ms{id=Id2,valid=B2,slots=Slots2}) -> Id = if @@ -1585,7 +1742,17 @@ merge_bool([]) -> {atom,[]}; merge_bool(true) -> bool; merge_bool(false) -> bool; merge_bool(_) -> {atom,[]}. - + +merge_aliases(Al0, Al1) when map_size(Al0) =< map_size(Al1) -> + maps:filter(fun(K, V) -> + case Al1 of + #{K:=V} -> true; + #{} -> false + end + end, Al0); +merge_aliases(Al0, Al1) -> + merge_aliases(Al1, Al0). + verify_y_init(#vst{current=#st{y=Ys}}) -> verify_y_init_1(gb_trees:to_list(Ys)). diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 1c9d762eb1..677094b3cd 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -110,6 +110,8 @@ undo_rename({test,has_map_fields,Fail,[Src|List]}) -> {test,has_map_fields,Fail,Src,{list,List}}; undo_rename({get_map_elements,Fail,Src,{list,List}}) -> {get_map_elements,Fail,Src,{list,List}}; +undo_rename({test,is_eq_exact,Fail,[Src,nil]}) -> + {test,is_nil,Fail,[Src]}; undo_rename({select,I,Reg,Fail,List}) -> {I,Reg,Fail,{list,List}}; undo_rename(I) -> I. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 5ef9611504..0a7f723c64 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -31,6 +31,9 @@ %% Erlc interface. -export([compile/3,compile_beam/3,compile_asm/3,compile_core/3]). +%% Utility functions for compiler passes. +-export([run_sub_passes/2]). + -export_type([option/0]). -include("erl_compile.hrl"). @@ -39,6 +42,8 @@ -import(lists, [member/2,reverse/1,reverse/2,keyfind/3,last/1, map/2,flatmap/2,foreach/2,foldr/3,any/2]). +-define(SUB_PASS_TIMES, compile__sub_pass_times). + %%---------------------------------------------------------------------- -type abstract_code() :: [erl_parse:abstract_form()]. @@ -64,6 +69,7 @@ -type err_ret() :: 'error' | {'error', errors(), warnings()}. -type comp_ret() :: mod_ret() | bin_ret() | err_ret(). + %%---------------------------------------------------------------------- %% @@ -143,6 +149,30 @@ noenv_output_generated(Opts) -> env_compiler_options() -> env_default_opts(). + +%%% +%%% Run sub passes from a compiler pass. +%%% + +-spec run_sub_passes([term()], term()) -> term(). + +run_sub_passes(Ps, St) -> + case get(?SUB_PASS_TIMES) of + undefined -> + Runner = fun(_Name, Run, S) -> Run(S) end, + run_sub_passes_1(Ps, Runner, St); + Times when is_list(Times) -> + Runner = fun(Name, Run, S0) -> + T1 = erlang:monotonic_time(), + S = Run(S0), + T2 = erlang:monotonic_time(), + put(?SUB_PASS_TIMES, + [{Name,T2-T1}|get(?SUB_PASS_TIMES)]), + S + end, + run_sub_passes_1(Ps, Runner, St) + end. + %% %% Local functions %% @@ -219,22 +249,24 @@ expand_opt(report, Os) -> expand_opt(return, Os) -> [return_errors,return_warnings|Os]; expand_opt(r16, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); expand_opt(r17, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); expand_opt(r18, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); expand_opt(r19, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); expand_opt(r20, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); +expand_opt(r21, Os) -> + [no_put_tuple2|Os]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; -expand_opt(no_float_opt, Os) -> - %%Turn off the entire type optimization pass. - [no_topt|Os]; expand_opt(O, Os) -> [O|Os]. +expand_opt_before_21(Os) -> + [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,no_utf8_atoms|Os]. + %% format_error(ErrorDescriptor) -> string() -spec format_error(term()) -> iolist(). @@ -387,17 +419,57 @@ fold_comp([{Name,Pass}|Ps], Run, Code0, St0) -> end; fold_comp([], _Run, Code, St) -> {ok,Code,St}. +run_sub_passes_1([{Name,Run}|Ps], Runner, St0) + when is_atom(Name), is_function(Run, 1) -> + try Runner(Name, Run, St0) of + St -> + run_sub_passes_1(Ps, Runner, St) + catch + C:E:Stk -> + io:format("Sub pass ~s\n", [Name]), + erlang:raise(C, E, Stk) + end; +run_sub_passes_1([], _, St) -> St. + run_tc({Name,Fun}, Code, St) -> + put(?SUB_PASS_TIMES, []), T1 = erlang:monotonic_time(), Val = (catch Fun(Code, St)), T2 = erlang:monotonic_time(), - Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond), + Times = erase(?SUB_PASS_TIMES), + Elapsed = erlang:convert_time_unit(T2 - T1, native, microsecond), Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])), io:format(" ~-30s: ~10.3f s ~12s\n", - [Name,Elapsed/1000,Mem]), + [Name,Elapsed/1000000,Mem]), + print_times(Times, Name), Val. +print_times(Times0, Name) -> + Fam0 = sofs:relation(Times0), + Fam1 = sofs:rel2fam(Fam0), + Fam2 = sofs:to_external(Fam1), + Fam3 = [{W,lists:sum(Times)} || {W,Times} <- Fam2], + Fam = reverse(lists:keysort(2, Fam3)), + Total = case lists:sum([T || {_,T} <- Fam]) of + 0 -> 1; + Total0 -> Total0 + end, + case Fam of + [] -> + ok; + [_|_] -> + io:format(" %% Sub passes of ~s from slowest to fastest:\n", [Name]), + print_times_1(Fam, Total) + end. + +print_times_1([{Name,T}|Ts], Total) -> + Elapsed = erlang:convert_time_unit(T, native, microsecond), + io:format(" ~-27s: ~10.3f s ~3w %\n", + [Name,Elapsed/1000000,round(100*T/Total)]), + print_times_1(Ts, Total); +print_times_1([], _Total) -> ok. + run_eprof({Name,Fun}, Code, Name, St) -> io:format("~p: Running eprof\n", [Name]), c:appcall(tools, eprof, start_profiling, [[self()]]), @@ -741,8 +813,20 @@ kernel_passes() -> ?pass(v3_kernel), {iff,dkern,{listing,"kernel"}}, {iff,'to_kernel',{done,"kernel"}}, - {pass,v3_codegen}, - {iff,dcg,{listing,"codegen"}} + {pass,beam_kernel_to_ssa}, + {iff,dssa,{listing,"ssa"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_ssa_opt,{pass,beam_ssa_opt}}, + {iff,dssaopt,{listing,"ssaopt"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_recv_opt,{pass,beam_ssa_recv}}, + {iff,drecv,{listing,"recv"}}, + {pass,beam_ssa_pre_codegen}, + {iff,dprecg,{listing,"precodegen"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {pass,beam_ssa_codegen}, + {iff,dcg,{listing,"codegen"}}, + {iff,doldcg,{listing,"codegen"}} | asm_passes()]. asm_passes() -> @@ -751,16 +835,12 @@ asm_passes() -> [{pass,beam_a}, {iff,da,{listing,"a"}}, {unless,no_postopt, - [{unless,no_reorder,{pass,beam_reorder}}, - {iff,dre,{listing,"reorder"}}, - {pass,beam_block}, + [{pass,beam_block}, {iff,dblk,{listing,"block"}}, {unless,no_except,{pass,beam_except}}, {iff,dexcept,{listing,"except"}}, {unless,no_bs_opt,{pass,beam_bs}}, {iff,dbs,{listing,"bs"}}, - {unless,no_topt,{pass,beam_type}}, - {iff,dtype,{listing,"type"}}, {pass,beam_split}, {iff,dsplit,{listing,"split"}}, {unless,no_dead,{pass,beam_dead}}, @@ -773,12 +853,6 @@ asm_passes() -> {iff,dclean,{listing,"clean"}}, {unless,no_bsm_opt,{pass,beam_bsm}}, {iff,dbsm,{listing,"bsm"}}, - {unless,no_recv_opt,{pass,beam_receive}}, - {iff,drecv,{listing,"recv"}}, - {unless,no_record_opt,{pass,beam_record}}, - {iff,drecord,{listing,"record"}}, - {unless,no_blk2,?pass(block2)}, - {iff,dblk2,{listing,"block2"}}, {unless,no_stack_trimming,{pass,beam_trim}}, {iff,dtrim,{listing,"trim"}}, {pass,beam_flatten}]}, @@ -1354,10 +1428,6 @@ v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) -> {ok,Code,St} end. -block2(Code0, #compile{options=Opts}=St) -> - {ok,Code} = beam_block:module(Code0, [no_blockify|Opts]), - {ok,Code,St}. - test_old_inliner(#compile{options=Opts}) -> %% The point of this test is to avoid loading the old inliner %% if we know that it will not be used. @@ -1432,16 +1502,30 @@ encrypt_debug_info(DebugInfo, Key, Opts) -> end. cleanup_compile_options(Opts) -> - lists:filter(fun keep_compile_option/1, Opts). - + IsDeterministic = lists:member(deterministic, Opts), + lists:filter(fun(Opt) -> + keep_compile_option(Opt, IsDeterministic) + end, Opts). + +%% Include paths and current directory don't affect compilation, but they might +%% be helpful so we include them unless we're doing a deterministic build. +keep_compile_option({i, _}, Deterministic) -> + not Deterministic; +keep_compile_option({cwd, _}, Deterministic) -> + not Deterministic; %% We are storing abstract, not asm or core. -keep_compile_option(from_asm) -> false; -keep_compile_option(from_core) -> false; +keep_compile_option(from_asm, _Deterministic) -> + false; +keep_compile_option(from_core, _Deterministic) -> + false; %% Parse transform and macros have already been applied. -keep_compile_option({parse_transform, _}) -> false; -keep_compile_option({d, _, _}) -> false; +keep_compile_option({parse_transform, _}, _Deterministic) -> + false; +keep_compile_option({d, _, _}, _Deterministic) -> + false; %% Do not affect compilation result on future calls. -keep_compile_option(Option) -> effects_code_generation(Option). +keep_compile_option(Option, _Deterministic) -> + effects_code_generation(Option). start_crypto() -> try crypto:start() of @@ -1589,6 +1673,7 @@ effects_code_generation(Option) -> binary -> false; verbose -> false; {cwd,_} -> false; + {i,_} -> false; {outdir, _} -> false; _ -> true end. @@ -1957,14 +2042,17 @@ pre_load() -> beam_except, beam_flatten, beam_jump, + beam_kernel_to_ssa, beam_opcodes, beam_peep, - beam_receive, - beam_record, - beam_reorder, + beam_ssa, + beam_ssa_codegen, + beam_ssa_opt, + beam_ssa_pre_codegen, + beam_ssa_recv, + beam_ssa_type, beam_split, beam_trim, - beam_type, beam_utils, beam_validator, beam_z, @@ -1983,7 +2071,6 @@ pre_load() -> sys_core_bsm, sys_core_dsetel, sys_core_fold, - v3_codegen, v3_core, v3_kernel], _ = code:ensure_modules_loaded(L), diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index cf32fd251c..74529f7fef 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -33,15 +33,20 @@ beam_except, beam_flatten, beam_jump, + beam_kernel_to_ssa, beam_listing, beam_opcodes, beam_peep, - beam_receive, - beam_reorder, - beam_record, + beam_ssa, + beam_ssa_codegen, + beam_ssa_lint, + beam_ssa_opt, + beam_ssa_pp, + beam_ssa_pre_codegen, + beam_ssa_recv, + beam_ssa_type, beam_split, beam_trim, - beam_type, beam_utils, beam_validator, beam_z, @@ -65,7 +70,6 @@ sys_core_fold_lists, sys_core_inline, sys_pre_attributes, - v3_codegen, v3_core, v3_kernel, v3_kernel_pp diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 02dead9e92..8e34e3e291 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -142,8 +142,7 @@ BEAM_FORMAT_NUMBER=0 20: send/0 ## @spec remove_message -## @doc Unlink the current message from the message queue and store a -## pointer to the message in x(0). Remove any timeout. +## @doc Unlink the current message from the message queue. Remove any timeout. 21: remove_message/0 ## @spec timeout @@ -574,3 +573,8 @@ BEAM_FORMAT_NUMBER=0 ## @doc Get the tail (or cdr) part of a list (a cons cell) from Source and ## put it into the register Tail. 163: get_tl/2 + +## @spec put_tuple2 Destination Elements +## @doc Build a tuple with the elements in the list Elements and put it +## put into register Destination. +164: put_tuple2/2 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 0aa58a46e4..d848cd8f19 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -115,13 +115,6 @@ module(#c_module{defs=Ds0}=Mod, Opts) -> {ok,Mod#c_module{defs=Ds1},get_warnings()}. function_1({#c_var{name={F,Arity}}=Name,B0}) -> - %% Find a suitable starting value for the variable counter. Note - %% that this pass assumes that new_var_name/1 returns a variable - %% name distinct from any variable used in the entire body of - %% the function. We use integers as variable names to avoid - %% filling up the atom table when compiling huge functions. - Count = cerl_trees:next_free_variable_name(B0), - put(new_var_num, Count), try %% Find a suitable starting value for the variable %% counter. Note that this pass assumes that new_var_name/1 @@ -352,7 +345,12 @@ expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) -> void(); expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) -> Fs1 = map(fun ({Name,Fb}) -> - {Name,expr(Fb, {letrec,Ctxt}, Sub)} + case Ctxt =:= effect andalso is_fun_effect_safe(Name, B0) of + true -> + {Name,expr(Fb, {letrec, effect}, Sub)}; + false -> + {Name,expr(Fb, {letrec, value}, Sub)} + end end, Fs0), B1 = body(B0, Ctxt, Sub), Letrec#c_letrec{defs=Fs1,body=B1}; @@ -480,9 +478,101 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) false -> {Evs1,Sub2} = var_list(Evs0, Sub0), H1 = body(H0, value, Sub2), - Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1} + H2 = opt_try_handler(H1, lists:last(Evs1)), + Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H2} end. +%% Attempts to convert old erlang:get_stacktrace/0 calls into the new +%% three-argument catch, with possibility of further optimisations. +opt_try_handler(#c_call{anno=A,module=#c_literal{val=erlang},name=#c_literal{val=get_stacktrace},args=[]}, Var) -> + #c_primop{anno=A,name=#c_literal{val=build_stacktrace},args=[Var]}; +opt_try_handler(#c_case{clauses=Cs0} = Case, Var) -> + Cs = [C#c_clause{body=opt_try_handler(B, Var)} || #c_clause{body=B} = C <- Cs0], + Case#c_case{clauses=Cs}; +opt_try_handler(#c_let{arg=Arg} = Let, Var) -> + Let#c_let{arg=opt_try_handler(Arg, Var)}; +opt_try_handler(X, _) -> X. + +%% If a fun or its application is used as an argument, then it's unsafe to +%% handle it in effect context as the side-effects may rely on its return +%% value. The following is a minimal example of where it can go wrong: +%% +%% do letrec 'f'/0 = fun () -> ... whatever ... +%% in call 'side':'effect'(apply 'f'/0()) +%% 'ok' +%% +%% This function returns 'true' if Body definitely does not rely on a +%% value produced by FVar, or 'false' if Body depends on or might depend on +%% a value produced by FVar. + +is_fun_effect_safe(#c_var{}=FVar, Body) -> + ifes_1(FVar, Body, true). + +ifes_1(FVar, #c_alias{pat=Pat}, _Safe) -> + ifes_1(FVar, Pat, false); +ifes_1(FVar, #c_apply{op=Op,args=Args}, Safe) -> + %% FVar(...) is safe as long its return value is ignored, but it's never + %% okay to pass FVar as an argument. + ifes_list(FVar, Args, false) andalso ifes_1(FVar, Op, Safe); +ifes_1(FVar, #c_binary{segments=Segments}, _Safe) -> + ifes_list(FVar, Segments, false); +ifes_1(FVar, #c_bitstr{val=Val,size=Size,unit=Unit}, _Safe) -> + ifes_list(FVar, [Val, Size, Unit], false); +ifes_1(FVar, #c_call{args=Args}, _Safe) -> + ifes_list(FVar, Args, false); +ifes_1(FVar, #c_case{arg=Arg,clauses=Clauses}, Safe) -> + ifes_1(FVar, Arg, false) andalso ifes_list(FVar, Clauses, Safe); +ifes_1(FVar, #c_catch{body=Body}, _Safe) -> + ifes_1(FVar, Body, false); +ifes_1(FVar, #c_clause{pats=Pats,guard=Guard,body=Body}, Safe) -> + ifes_list(FVar, Pats, false) andalso + ifes_1(FVar, Guard, false) andalso + ifes_1(FVar, Body, Safe); +ifes_1(FVar, #c_cons{hd=Hd,tl=Tl}, _Safe) -> + ifes_1(FVar, Hd, false) andalso ifes_1(FVar, Tl, false); +ifes_1(FVar, #c_fun{body=Body}, _Safe) -> + ifes_1(FVar, Body, false); +ifes_1(FVar, #c_let{arg=Arg,body=Body}, Safe) -> + ifes_1(FVar, Arg, false) andalso ifes_1(FVar, Body, Safe); +ifes_1(FVar, #c_letrec{defs=Defs,body=Body}, Safe) -> + Funs = [Fun || {_,Fun} <- Defs], + ifes_list(FVar, Funs, false) andalso ifes_1(FVar, Body, Safe); +ifes_1(_FVar, #c_literal{}, _Safe) -> + true; +ifes_1(FVar, #c_map{arg=Arg,es=Elements}, _Safe) -> + ifes_1(FVar, Arg, false) andalso ifes_list(FVar, Elements, false); +ifes_1(FVar, #c_map_pair{key=Key,val=Val}, _Safe) -> + ifes_1(FVar, Key, false) andalso ifes_1(FVar, Val, false); +ifes_1(FVar, #c_primop{args=Args}, _Safe) -> + ifes_list(FVar, Args, false); +ifes_1(FVar, #c_receive{timeout=Timeout,action=Action,clauses=Clauses}, Safe) -> + ifes_1(FVar, Timeout, false) andalso + ifes_1(FVar, Action, Safe) andalso + ifes_list(FVar, Clauses, Safe); +ifes_1(FVar, #c_seq{arg=Arg,body=Body}, Safe) -> + %% Arg of a #c_seq{} has no effect so it's okay to use FVar there even if + %% Safe=false. + ifes_1(FVar, Arg, true) andalso ifes_1(FVar, Body, Safe); +ifes_1(FVar, #c_try{arg=Arg,handler=Handler,body=Body}, Safe) -> + ifes_1(FVar, Arg, false) andalso + ifes_1(FVar, Handler, Safe) andalso + ifes_1(FVar, Body, Safe); +ifes_1(FVar, #c_tuple{es=Elements}, _Safe) -> + ifes_list(FVar, Elements, false); +ifes_1(FVar, #c_values{es=Elements}, _Safe) -> + ifes_list(FVar, Elements, false); +ifes_1(#c_var{name=Name}, #c_var{name=Name}, Safe) -> + %% It's safe to return FVar if it's unused. + Safe; +ifes_1(_FVar, #c_var{}, _Safe) -> + true. + +ifes_list(FVar, [E|Es], Safe) -> + ifes_1(FVar, E, Safe) andalso ifes_list(FVar, Es, Safe); +ifes_list(_FVar, [], _Safe) -> + true. + + expr_list(Es, Ctxt, Sub) -> [expr(E, Ctxt, Sub) || E <- Es]. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl deleted file mode 100644 index 6cd114abf7..0000000000 --- a/lib/compiler/src/v3_codegen.erl +++ /dev/null @@ -1,2930 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% Purpose : Code generator for Beam. - --module(v3_codegen). - -%% The main interface. --export([module/2]). - --import(lists, [member/2,keymember/3,keysort/2,keydelete/3, - append/1,flatmap/2,filter/2,foldl/3,foldr/3,mapfoldl/3, - sort/1,reverse/1,reverse/2,map/2]). --import(ordsets, [add_element/2,intersection/2,union/2]). - --include("v3_kernel.hrl"). - -%% These are not defined in v3_kernel.hrl. -get_kanno(Kthing) -> element(2, Kthing). -set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). - -%% Main codegen structure. --record(cg, {lcount=1, %Label counter - bfail, %Fail label for BIFs - break, %Break label - recv, %Receive label - is_top_block, %Boolean: top block or not - functable=#{}, %Map of local functions: {Name,Arity}=>Label - in_catch=false, %Inside a catch or not. - need_frame, %Need a stack frame. - ultimate_failure, %Label for ultimate match failure. - ctx %Match context. - }). - -%% Stack/register state record. --record(sr, {reg=[], %Register table - stk=[], %Stack table - res=[]}). %Registers to reserve - -%% Internal records. --record(cg_need_heap, {anno=[] :: term(), - h=0 :: integer()}). --record(cg_block, {anno=[] :: term(), - es=[] :: [term()]}). - --type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}. - --record(l, {i=0 :: non_neg_integer(), %Op number - vdb=[] :: [vdb_entry()], %Variable database - a=[] :: [term()]}). %Core annotation - --spec module(#k_mdef{}, [compile:option()]) -> {'ok',beam_asm:module_code()}. - -module(#k_mdef{name=Mod,exports=Es,attributes=Attr,body=Forms}, _Opts) -> - {Asm,St} = functions(Forms, {atom,Mod}), - {ok,{Mod,Es,Attr,Asm,St#cg.lcount}}. - -functions(Forms, AtomMod) -> - mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms). - -function(#k_fdef{anno=#k{a=Anno},func=Name,arity=Arity, - vars=As,body=Kb}, AtomMod, St0) -> - try - #k_match{} = Kb, %Assertion. - - %% Try to suppress the stack frame unless it is - %% really needed. - Body0 = avoid_stack_frame(Kb), - - %% Annotate kernel records with variable usage. - Vdb0 = init_vars(As), - {Body,_,Vdb} = body(Body0, 1, Vdb0), - - %% Generate the BEAM assembly code. - {Asm,EntryLabel,St} = cg_fun(Body, As, Vdb, AtomMod, - {Name,Arity}, Anno, St0), - Func = {function,Name,Arity,EntryLabel,Asm}, - {Func,St} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - - -%% avoid_stack_frame(Kernel) -> Kernel' -%% If possible, avoid setting up a stack frame. Functions -%% that only do matching, calls to guard BIFs, and tail-recursive -%% calls don't need a stack frame. - -avoid_stack_frame(#k_match{body=Body}=M) -> - try - M#k_match{body=avoid_stack_frame_1(Body)} - catch - impossible -> - M - end. - -avoid_stack_frame_1(#k_alt{first=First0,then=Then0}=Alt) -> - First = avoid_stack_frame_1(First0), - Then = avoid_stack_frame_1(Then0), - Alt#k_alt{first=First,then=Then}; -avoid_stack_frame_1(#k_bif{op=Op}=Bif) -> - case Op of - #k_internal{} -> - %% Most internal BIFs clobber the X registers. - throw(impossible); - _ -> - Bif - end; -avoid_stack_frame_1(#k_break{anno=Anno,args=Args}) -> - #k_guard_break{anno=Anno,args=Args}; -avoid_stack_frame_1(#k_guard_break{}=Break) -> - Break; -avoid_stack_frame_1(#k_enter{}=Enter) -> - %% Tail-recursive calls don't need a stack frame. - Enter; -avoid_stack_frame_1(#k_guard{clauses=Cs0}=Guard) -> - Cs = avoid_stack_frame_list(Cs0), - Guard#k_guard{clauses=Cs}; -avoid_stack_frame_1(#k_guard_clause{guard=G0,body=B0}=C) -> - G = avoid_stack_frame_1(G0), - B = avoid_stack_frame_1(B0), - C#k_guard_clause{guard=G,body=B}; -avoid_stack_frame_1(#k_match{anno=A,vars=Vs,body=B0,ret=Ret}) -> - %% Use #k_guard_match{} instead to avoid saving the X registers - %% to the stack before matching. - B = avoid_stack_frame_1(B0), - #k_guard_match{anno=A,vars=Vs,body=B,ret=Ret}; -avoid_stack_frame_1(#k_guard_match{body=B0}=M) -> - B = avoid_stack_frame_1(B0), - M#k_guard_match{body=B}; -avoid_stack_frame_1(#k_protected{arg=Arg0}=Prot) -> - Arg = avoid_stack_frame_1(Arg0), - Prot#k_protected{arg=Arg}; -avoid_stack_frame_1(#k_put{}=Put) -> - Put; -avoid_stack_frame_1(#k_return{}=Ret) -> - Ret; -avoid_stack_frame_1(#k_select{var=#k_var{anno=Vanno},types=Types0}=Select) -> - case member(reuse_for_context, Vanno) of - false -> - Types = avoid_stack_frame_list(Types0), - Select#k_select{types=Types}; - true -> - %% Including binary patterns that overwrite the register containing - %% the binary with the match context may not be safe. For example, - %% bs_match_SUITE:bin_tail_e/1 with inlining will be rejected by - %% beam_validator. - %% - %% Essentially the following code is produced: - %% - %% bs_match {x,0} => {x,0} - %% ... - %% bs_match {x,0} => {x,1} %% ILLEGAL - %% - %% A bs_match instruction will only accept a match context as the - %% source operand if the source and destination registers are the - %% the same (as in the first bs_match instruction above). - %% The second bs_match instruction is therefore illegal. - %% - %% This situation is avoided if there is a stack frame: - %% - %% move {x,0} => {y,0} - %% bs_match {x,0} => {x,0} - %% ... - %% bs_match {y,0} => {x,1} %% LEGAL - %% - throw(impossible) - end; -avoid_stack_frame_1(#k_seq{arg=#k_call{anno=Anno,op=Op}=Call, - body=#k_break{args=BrArgs0}}=Seq) -> - case Op of - #k_remote{mod=#k_atom{val=Mod}, - name=#k_atom{val=Name}, - arity=Arity} -> - case erl_bifs:is_exit_bif(Mod, Name, Arity) of - false -> - %% Will clobber X registers. Must have a stack frame. - throw(impossible); - true -> - %% The call to this BIF will never return. It is safe - %% to suppress the stack frame. - Bif = #k_bif{anno=Anno, - op=#k_internal{name=guard_error,arity=1}, - args=[Call],ret=[]}, - BrArgs = lists:duplicate(length(BrArgs0), #k_nil{}), - GB = #k_guard_break{anno=#k{us=[],ns=[],a=[]},args=BrArgs}, - Seq#k_seq{arg=Bif,body=GB} - end; - _ -> - %% Will clobber X registers. Must have a stack frame. - throw(impossible) - end; -avoid_stack_frame_1(#k_seq{arg=A0,body=B0}=Seq) -> - A = avoid_stack_frame_1(A0), - B = avoid_stack_frame_1(B0), - Seq#k_seq{arg=A,body=B}; -avoid_stack_frame_1(#k_test{}=Test) -> - Test; -avoid_stack_frame_1(#k_type_clause{values=Values0}=TC) -> - Values = avoid_stack_frame_list(Values0), - TC#k_type_clause{values=Values}; -avoid_stack_frame_1(#k_val_clause{body=B0}=VC) -> - B = avoid_stack_frame_1(B0), - VC#k_val_clause{body=B}; -avoid_stack_frame_1(_Body) -> - throw(impossible). - -avoid_stack_frame_list([H|T]) -> - [avoid_stack_frame_1(H)|avoid_stack_frame_list(T)]; -avoid_stack_frame_list([]) -> []. - - -%% This pass creates beam format annotated with variable lifetime -%% information. Each thing is given an index and for each variable we -%% store the first and last index for its occurrence. The variable -%% database, VDB, attached to each thing is only relevant internally -%% for that thing. -%% -%% For nested things like matches the numbering continues locally and -%% the VDB for that thing refers to the variable usage within that -%% thing. Variables which live through a such a thing are internally -%% given a very large last index. Internally the indexes continue -%% after the index of that thing. This creates no problems as the -%% internal variable info never escapes and externally we only see -%% variable which are alive both before or after. -%% -%% This means that variables never "escape" from a thing and the only -%% way to get values from a thing is to "return" them, with 'break' or -%% 'return'. Externally these values become the return values of the -%% thing. This is no real limitation as most nested things have -%% multiple threads so working out a common best variable usage is -%% difficult. - -%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. -%% Handle a body. - -body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> - %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), - A = get_kanno(Ke), - Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), - {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1), - E = expr(Ke, I, Vdb2), - {[E|Es],MaxI,Vdb2}; -body(Ke, I, Vdb0) -> - %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), - A = get_kanno(Ke), - Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), - E = expr(Ke, I, Vdb1), - {[E],I,Vdb1}. - -%% expr(Kexpr, I, Vdb) -> Expr. - -expr(#k_test{anno=A}=Test, I, _Vdb) -> - Test#k_test{anno=#l{i=I,a=A#k.a}}; -expr(#k_call{anno=A}=Call, I, _Vdb) -> - Call#k_call{anno=#l{i=I,a=A#k.a}}; -expr(#k_enter{anno=A}=Enter, I, _Vdb) -> - Enter#k_enter{anno=#l{i=I,a=A#k.a}}; -expr(#k_bif{anno=A}=Bif, I, _Vdb) -> - Bif#k_bif{anno=#l{i=I,a=A#k.a}}; -expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, Mdb), - L = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}, - #k_match{anno=L,body=M,ret=Rs}; -expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, Mdb), - L = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}, - #k_guard_match{anno=L,body=M,ret=Rs}; -expr(#k_protected{}=Protected, I, Vdb) -> - protected(Protected, I, Vdb); -expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}=Try, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% the body and handler. Add try tag 'variable'. - Ab = get_kanno(Kb), - Ah = get_kanno(Kh), - Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), - Tdb2 = vdb_sub(I, I+2, Tdb1), - Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names - {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), - L = #l{i=I,vdb=Tdb1,a=A#k.a}, - Try#k_try{anno=L, - arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}}, - vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}}, - evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}}; -expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% the body and handler. Add try tag 'variable'. - Ab = get_kanno(Kb), - Ah = get_kanno(Kh), - Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), - Tdb2 = vdb_sub(I, I+2, Tdb1), - Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names - {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), - L = #l{i=I,vdb=Tdb1,a=A#k.a}, - #k_try_enter{anno=L, - arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}}, - vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}}, - evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}}; -expr(#k_catch{anno=A,body=Kb}=Catch, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the catch. - %% Add catch tag 'variable'. - Cdb0 = vdb_sub(I, I+1, Vdb), - {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)), - L = #l{i=I,vdb=Cdb1,a=A#k.a}, - Catch#k_catch{anno=L,body=#cg_block{es=Es}}; -expr(#k_receive{anno=A,var=V,body=Kb,action=Ka}=Recv, I, Vdb) -> - %% Work out imported variables which need to be locked. - Rdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, - new_vars([V#k_var.name], I, Rdb)), - {Tes,_,Adb} = body(Ka, I+1, Rdb), - Le = #l{i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a}, - Recv#k_receive{anno=Le,body=M, - action=#cg_block{anno=#l{i=I+1,vdb=Adb,a=[]},es=Tes}}; -expr(#k_receive_accept{anno=A}, I, _Vdb) -> - #k_receive_accept{anno=#l{i=I,a=A#k.a}}; -expr(#k_receive_next{anno=A}, I, _Vdb) -> - #k_receive_next{anno=#l{i=I,a=A#k.a}}; -expr(#k_put{anno=A}=Put, I, _Vdb) -> - Put#k_put{anno=#l{i=I,a=A#k.a}}; -expr(#k_break{anno=A}=Break, I, _Vdb) -> - Break#k_break{anno=#l{i=I,a=A#k.a}}; -expr(#k_guard_break{anno=A}=Break, I, _Vdb) -> - Break#k_guard_break{anno=#l{i=I,a=A#k.a}}; -expr(#k_return{anno=A}=Ret, I, _Vdb) -> - Ret#k_return{anno=#l{i=I,a=A#k.a}}. - -%% protected(Kprotected, I, Vdb) -> Protected. -%% Only used in guards. - -protected(#k_protected{anno=A,arg=Ts}=Prot, I, Vdb) -> - %% Lock variables that are alive before try and used afterwards. - %% Don't lock variables that are only used inside the protected - %% expression. - Pdb0 = vdb_sub(I, I+1, Vdb), - {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0), - Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values - Prot#k_protected{arg=T,anno=#l{i=I,a=A#k.a,vdb=Pdb2}}. - -%% match(Kexpr, [LockVar], I, Vdb) -> Expr. -%% Convert match tree to old format. - -match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - F = match(Kf, Ls, I+1, Vdb1), - T = match(Kt, Ls, I+1, Vdb1), - #k_alt{anno=[],first=F,then=T}; -match(#k_select{anno=A,types=Kts}=Select, Ls, I, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - Ts = [type_clause(Tc, Ls, I+1, Vdb1) || Tc <- Kts], - Select#k_select{anno=[],types=Ts}; -match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - Cs = [guard_clause(G, Ls, I+1, Vdb1) || G <- Kcs], - #k_guard{anno=[],clauses=Cs}; -match(Other, Ls, I, Vdb0) -> - Vdb1 = use_vars(Ls, I, Vdb0), - {B,_,Vdb2} = body(Other, I+1, Vdb1), - Le = #l{i=I,vdb=Vdb2,a=[]}, - #cg_block{anno=Le,es=B}. - -type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Vdb0) -> - %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]), - Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0), - Vs = [val_clause(Vc, Ls, I+1, Vdb1) || Vc <- Kvs], - #k_type_clause{anno=[],type=T,values=Vs}. - -val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Vdb0) -> - New = (get_kanno(V))#k.ns, - Bus = (get_kanno(Kb))#k.us, - %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]), - Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety - Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)), - B = match(Kb, Ls1, I+1, Vdb1), - Le = #l{i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}, - #k_val_clause{anno=Le,val=V,body=B}. - -guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), - Gdb = vdb_sub(I+1, I+2, Vdb1), - G = protected(Kg, I+1, Gdb), - B = match(Kb, Ls, I+2, Vdb1), - Le = #l{i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),a=A#k.a}, - #k_guard_clause{anno=Le,guard=G,body=B}. - - -%% Here follows the code generator pass. -%% -%% The following assumptions have been made: -%% -%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return -%% values; no variables are exported. If the match would have returned -%% extra variables then these have been transformed to multiple return -%% values. -%% -%% 2. All BIF's called in guards are gc-safe so there is no need to -%% put thing on the stack in the guard. While this would in principle -%% work it would be difficult to keep track of the stack depth when -%% trimming. -%% -%% The code generation uses variable lifetime information added by -%% the previous pass to save variables, allocate registers and -%% move registers to the stack when necessary. -%% -%% We try to use a consistent variable name scheme throughout. The -%% StackReg record is always called Bef,Int<n>,Aft. - -%% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State} - -cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> - {Fi,St1} = new_label(St0), %FuncInfo label - {Fl,St2} = local_func_label(NameArity, St1), - - %% - %% The pattern matching compiler (in v3_kernel) no longer - %% provides its own catch-all clause, because the - %% call to erlang:exit/1 caused problem when cases were - %% used in guards. Therefore, there may be tests that - %% cannot fail (providing that there is not a bug in a - %% previous optimzation pass), but still need to provide - %% a label (there are instructions, such as is_tuple/2, - %% that do not allow {f,0}). - %% - %% We will generate an ultimate failure label and put it - %% at the end of function, followed by an 'if_end' instruction. - %% Note that and 'if_end' instruction does not need any - %% live x registers, so it will always be safe to jump to - %% it. (We never ever expect the jump to be taken, and in - %% most functions there will never be any references to - %% the label in the first place.) - %% - - {UltimateMatchFail,St3} = new_label(St2), - - %% Create initial stack/register state, clear unused arguments. - Bef = clear_dead(#sr{reg=foldl(fun (#k_var{name=V}, Reg) -> - put_reg(V, Reg) - end, [], Hvs), - stk=[]}, 0, Vdb), - {B,_Aft,St} = cg_list(Les, Vdb, Bef, - St3#cg{bfail=0, - ultimate_failure=UltimateMatchFail, - is_top_block=true}), - {Name,Arity} = NameArity, - Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity}, - {label,Fl}|B++[{label,UltimateMatchFail},if_end]], - {Asm,Fl,St}. - -%% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}. -%% Generate code for a kexpr. - -cg(#cg_block{anno=Le,es=Es}, Vdb, Bef, St) -> - block_cg(Es, Le, Vdb, Bef, St); -cg(#k_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) -> - match_cg(M, Rs, Le, Vdb, Bef, St); -cg(#k_guard_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) -> - guard_match_cg(M, Rs, Le, Vdb, Bef, St); -cg(#k_call{anno=Le,op=Func,args=As,ret=Rs}, Vdb, Bef, St) -> - call_cg(Func, As, Rs, Le, Vdb, Bef, St); -cg(#k_enter{anno=Le,op=Func,args=As}, Vdb, Bef, St) -> - enter_cg(Func, As, Le, Vdb, Bef, St); -cg(#k_bif{anno=Le}=Bif, Vdb, Bef, St) -> - bif_cg(Bif, Le, Vdb, Bef, St); -cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs}, - Vdb, Bef, St) -> - recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St); -cg(#k_receive_next{anno=Le}, Vdb, Bef, St) -> - recv_next_cg(Le, Vdb, Bef, St); -cg(#k_receive_accept{}, _Vdb, Bef, St) -> - {[remove_message],Bef,St}; -cg(#k_try{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th,ret=Rs}, - Vdb, Bef, St) -> - try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St); -cg(#k_try_enter{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th}, - Vdb, Bef, St) -> - try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St); -cg(#k_catch{anno=Le,body=Cb,ret=[R]}, Vdb, Bef, St) -> - catch_cg(Cb, R, Le, Vdb, Bef, St); -cg(#k_put{anno=Le,arg=Con,ret=Var}, Vdb, Bef, St) -> - put_cg(Var, Con, Le, Vdb, Bef, St); -cg(#k_return{anno=Le,args=Rs}, Vdb, Bef, St) -> - return_cg(Rs, Le, Vdb, Bef, St); -cg(#k_break{anno=Le,args=Bs}, Vdb, Bef, St) -> - break_cg(Bs, Le, Vdb, Bef, St); -cg(#k_guard_break{anno=Le,args=Bs}, Vdb, Bef, St) -> - guard_break_cg(Bs, Le, Vdb, Bef, St); -cg(#cg_need_heap{h=H}, _Vdb, Bef, St) -> - {[{test_heap,H,max_reg(Bef#sr.reg)}],Bef,St}. - -%% cg_list([Kexpr], FirstI, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. - -cg_list(Kes, Vdb, Bef, St0) -> - {Keis,{Aft,St1}} = - flatmapfoldl(fun (Ke, {Inta,Sta}) -> - {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta), - {Keis,{Intb,Stb}} - end, {Bef,St0}, need_heap(Kes)), - {Keis,Aft,St1}. - -%% need_heap([Lkexpr], I, St) -> [Lkexpr]. -%% Insert need_heap instructions in Kexpr list. Try to be smart and -%% collect them together as much as possible. - -need_heap(Kes0) -> - {Kes,H} = need_heap_0(reverse(Kes0), 0, []), - - %% Prepend need_heap if necessary. - need_heap_need(H) ++ Kes. - -need_heap_0([Ke|Kes], H0, Acc) -> - {Ns,H} = need_heap_1(Ke, H0), - need_heap_0(Kes, H, [Ke|Ns]++Acc); -need_heap_0([], H, Acc) -> - {Acc,H}. - -need_heap_1(#k_put{arg=#k_binary{}}, H) -> - {need_heap_need(H),0}; -need_heap_1(#k_put{arg=#k_map{}}, H) -> - {need_heap_need(H),0}; -need_heap_1(#k_put{arg=Val}, H) -> - %% Just pass through adding to needed heap. - {[],H + case Val of - #k_cons{} -> 2; - #k_tuple{es=Es} -> 1 + length(Es); - _Other -> 0 - end}; -need_heap_1(#k_bif{}=Bif, H) -> - case is_gc_bif(Bif) of - false -> - {[],H}; - true -> - {need_heap_need(H),0} - end; -need_heap_1(_Ke, H) -> - %% Call or call-like instruction such as set_tuple_element/3. - {need_heap_need(H),0}. - -need_heap_need(0) -> []; -need_heap_need(H) -> [#cg_need_heap{h=H}]. - -%% is_gc_bif(#k_bif{}) -> true|false. -%% is_gc_bif(Name, Arity) -> true|false. -%% Determines whether the BIF Name/Arity might do a GC. - -is_gc_bif(#k_bif{op=#k_remote{name=#k_atom{val=Name}},args=Args}) -> - is_gc_bif(Name, length(Args)); -is_gc_bif(#k_bif{op=#k_internal{}}) -> - true. - -is_gc_bif(hd, 1) -> false; -is_gc_bif(tl, 1) -> false; -is_gc_bif(self, 0) -> false; -is_gc_bif(node, 0) -> false; -is_gc_bif(node, 1) -> false; -is_gc_bif(element, 2) -> false; -is_gc_bif(get, 1) -> false; -is_gc_bif(tuple_size, 1) -> false; -is_gc_bif(map_get, 2) -> false; -is_gc_bif(is_map_key, 2) -> false; -is_gc_bif(Bif, Arity) -> - not (erl_internal:bool_op(Bif, Arity) orelse - erl_internal:new_type_test(Bif, Arity) orelse - erl_internal:comp_op(Bif, Arity)). - -%% match_cg(Matc, [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% Generate code for a match. First save all variables on the stack -%% that are to survive after the match. We leave saved variables in -%% their registers as they might actually be in the right place. - -match_cg(M, Rs, Le, Vdb, Bef, St0) -> - I = Le#l.i, - {Sis,Int0} = adjust_stack(Bef, I, I+1, Vdb), - {B,St1} = new_label(St0), - {Mis,Int1,St2} = match_cg(M, St1#cg.ultimate_failure, - Int0, St1#cg{break=B}), - %% Put return values in registers. - Reg = load_vars(Rs, Int1#sr.reg), - {Sis ++ Mis ++ [{label,B}], - clear_dead(Int1#sr{reg=Reg}, I, Vdb), - St2#cg{break=St1#cg.break}}. - -guard_match_cg(M, Rs, Le, Vdb, Bef, St0) -> - I = Le#l.i, - {B,St1} = new_label(St0), - Fail = case St0 of - #cg{bfail=0,ultimate_failure=Fail0} -> Fail0; - #cg{bfail=Fail0} -> Fail0 - end, - {Mis,Aft,St2} = match_cg(M, Fail, Bef, St1#cg{break=B}), - %% Update the register descriptors for the return registers. - Reg = guard_match_regs(Aft#sr.reg, Rs), - {Mis ++ [{label,B}], - clear_dead(Aft#sr{reg=Reg}, I, Vdb), - St2#cg{break=St1#cg.break}}. - -guard_match_regs([{I,gbreakvar}|Rs], [#k_var{name=V}|Vs]) -> - [{I,V}|guard_match_regs(Rs, Vs)]; -guard_match_regs([R|Rs], Vs) -> - [R|guard_match_regs(Rs, Vs)]; -guard_match_regs([], []) -> []. - - -%% match_cg(Match, Fail, StackReg, State) -> {[Ainstr],StackReg,State}. -%% Generate code for a match tree. N.B. there is no need pass Vdb -%% down as each level which uses this takes its own internal Vdb not -%% the outer one. - -match_cg(#k_alt{first=F,then=S}, Fail, Bef, St0) -> - {Tf,St1} = new_label(St0), - {Fis,Faft,St2} = match_cg(F, Tf, Bef, St1), - {Sis,Saft,St3} = match_cg(S, Fail, Bef, St2), - Aft = sr_merge(Faft, Saft), - {Fis ++ [{label,Tf}] ++ Sis,Aft,St3}; -match_cg(#k_select{var=#k_var{anno=Vanno,name=Vname}=V,types=Scs0}, Fail, Bef, St) -> - ReuseForContext = member(reuse_for_context, Vanno) andalso - find_reg(Vname, Bef#sr.reg) =/= error, - Scs = case ReuseForContext of - false -> Scs0; - true -> bsm_rename_ctx(Scs0, Vname) - end, - match_fmf(fun (S, F, Sta) -> - select_cg(S, V, F, Fail, Bef, Sta) end, - Fail, St, Scs); -match_cg(#k_guard{clauses=Gcs}, Fail, Bef, St) -> - match_fmf(fun (G, F, Sta) -> guard_clause_cg(G, F, Bef, Sta) end, - Fail, St, Gcs); -match_cg(#cg_block{anno=Le,es=Es}, _Fail, Bef, St) -> - %% Must clear registers and stack of dead variables. - Int = clear_dead(Bef, Le#l.i, Le#l.vdb), - block_cg(Es, Le, Int, St). - -%% bsm_rename_ctx([Clause], Var) -> [Clause] -%% We know from an annotation that the register for a binary can -%% be reused for the match context because the two are not truly -%% alive at the same time (even though the life time information -%% says so). -%% -%% The easiest way to have those variables share the same register is -%% to rename the variable with the shortest life-span (the match -%% context) to the variable for the binary (which can have a very -%% long life-time because it is locked during matching). We KNOW that -%% the match state variable will only be alive during the matching. -%% -%% We must also remove all information about the match context -%% variable from all life-time information databases (Vdb). - -bsm_rename_ctx([#k_type_clause{type=k_binary,values=Vcs}=TC|Cs], New) -> - [#k_val_clause{val=#k_binary{segs=#k_var{name=Old}}=Bin, - body=Ke0}=VC0] = Vcs, - Ke = bsm_rename_ctx(Ke0, Old, New, false), - VC = VC0#k_val_clause{val=Bin#k_binary{segs=#k_var{name=New}}, - body=Ke}, - [TC#k_type_clause{values=[VC]}|bsm_rename_ctx(Cs, New)]; -bsm_rename_ctx([C|Cs], New) -> - [C|bsm_rename_ctx(Cs, New)]; -bsm_rename_ctx([], _) -> []. - -%% bsm_rename_ctx(Ke, OldName, NewName, InProt) -> Ke' -%% Rename and clear OldName from life-time information. We must -%% recurse into any block contained in a protected, but it would -%% only complicatate things to recurse into blocks not in a protected -%% (the match context variable is not live inside them). - -bsm_rename_ctx(#k_select{var=#k_var{name=V},types=Cs0}=Sel, - Old, New, InProt) -> - Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt), - Sel#k_select{var=#k_var{name=bsm_rename_var(V, Old, New)},types=Cs}; -bsm_rename_ctx(#k_type_clause{values=Cs0}=TC, Old, New, InProt) -> - Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt), - TC#k_type_clause{values=Cs}; -bsm_rename_ctx(#k_val_clause{body=Ke0}=VC, Old, New, InProt) -> - Ke = bsm_rename_ctx(Ke0, Old, New, InProt), - VC#k_val_clause{body=Ke}; -bsm_rename_ctx(#k_alt{first=F0,then=S0}=Alt, Old, New, InProt) -> - F = bsm_rename_ctx(F0, Old, New, InProt), - S = bsm_rename_ctx(S0, Old, New, InProt), - Alt#k_alt{first=F,then=S}; -bsm_rename_ctx(#k_guard{clauses=Gcs0}=Guard, Old, New, InProt) -> - Gcs = bsm_rename_ctx_list(Gcs0, Old, New, InProt), - Guard#k_guard{clauses=Gcs}; -bsm_rename_ctx(#k_guard_clause{guard=G0,body=B0}=GC, Old, New, InProt) -> - G = bsm_rename_ctx(G0, Old, New, InProt), - B = bsm_rename_ctx(B0, Old, New, InProt), - %% A guard clause may cause unsaved variables to be saved on the stack. - %% Since the match state variable Old is an alias for New (uses the - %% same register), it is neither in the stack nor register descriptor - %% lists and we would crash when we didn't find it unless we remove - %% it from the database. - bsm_forget_var(GC#k_guard_clause{guard=G,body=B}, Old); -bsm_rename_ctx(#k_protected{arg=Ts0}=Prot, Old, New, _InProt) -> - InProt = true, - Ts = bsm_rename_ctx_list(Ts0, Old, New, InProt), - bsm_forget_var(Prot#k_protected{arg=Ts}, Old); -bsm_rename_ctx(#k_guard_match{body=Ms0}=Match, Old, New, InProt) -> - Ms = bsm_rename_ctx(Ms0, Old, New, InProt), - Match#k_guard_match{body=Ms}; -bsm_rename_ctx(#k_test{}=Test, _, _, _) -> Test; -bsm_rename_ctx(#k_bif{}=Bif, _, _, _) -> Bif; -bsm_rename_ctx(#k_put{}=Put, _, _, _) -> Put; -bsm_rename_ctx(#k_call{}=Call, _, _, _) -> Call; -bsm_rename_ctx(#cg_block{}=Block, Old, _, false) -> - %% This block is not inside a protected. The match context variable cannot - %% possibly be live inside the block. - bsm_forget_var(Block, Old); -bsm_rename_ctx(#cg_block{es=Es0}=Block, Old, New, true) -> - %% A block in a protected. We must recursively rename the variable - %% inside the block. - Es = bsm_rename_ctx_list(Es0, Old, New, true), - bsm_forget_var(Block#cg_block{es=Es}, Old); -bsm_rename_ctx(#k_guard_break{}=Break, Old, _New, _InProt) -> - bsm_forget_var(Break, Old). - -bsm_rename_ctx_list([C|Cs], Old, New, InProt) -> - [bsm_rename_ctx(C, Old, New, InProt)| - bsm_rename_ctx_list(Cs, Old, New, InProt)]; -bsm_rename_ctx_list([], _, _, _) -> []. - -bsm_rename_var(Old, Old, New) -> New; -bsm_rename_var(V, _, _) -> V. - -%% bsm_forget_var(#l{}, Variable) -> #l{} -%% Remove a variable from the variable life-time database. - -bsm_forget_var(Ke, V) -> - #l{vdb=Vdb} = L0 = get_kanno(Ke), - L = L0#l{vdb=keydelete(V, 1, Vdb)}, - set_kanno(Ke, L). - -%% block_cg([Kexpr], Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. -%% block_cg([Kexpr], Le, StackReg, St) -> {[Ainstr],StackReg,St}. - -block_cg(Es, Le, _Vdb, Bef, St) -> - block_cg(Es, Le, Bef, St). - -block_cg(Es, Le, Bef, #cg{is_top_block=false}=St) -> - cg_block(Es, Le#l.vdb, Bef, St); -block_cg(Es, Le, Bef, #cg{is_top_block=true}=St0) -> - %% No stack frame has been established yet. Do we need one? - case need_stackframe(Es) of - true -> - %% We need a stack frame. Generate the code and add the - %% code for creating and deallocating the stack frame. - {Is0,Aft,St} = cg_block(Es, Le#l.vdb, Bef, - St0#cg{is_top_block=false,need_frame=false}), - Is = top_level_block(Is0, Aft, max_reg(Bef#sr.reg), St), - {Is,Aft,St#cg{is_top_block=true}}; - false -> - %% This sequence of instructions ending in a #k_match{} (a - %% 'case' or 'if') in the Erlang code does not need a - %% stack frame yet. Delay the creation (if a stack frame - %% is needed at all, it will be created inside the - %% #k_match{}). - cg_list(Es, Le#l.vdb, Bef, St0) - end. - -%% need_stackframe([Kexpr]) -> true|false. -%% Does this list of instructions need a stack frame? -%% -%% A sequence of instructions that don't clobber the X registers -%% followed by a single #k_match{} doesn't need a stack frame. - -need_stackframe([H|T]) -> - case H of - #k_bif{op=#k_internal{}} -> true; - #k_put{arg=#k_binary{}} -> true; - #k_bif{} -> need_stackframe(T); - #k_put{} -> need_stackframe(T); - #k_guard_match{} -> need_stackframe(T); - #k_match{} when T =:= [] -> false; - _ -> true - end; -need_stackframe([]) -> false. - -cg_block([], _Vdb, Bef, St0) -> - {[],Bef,St0}; -cg_block(Kes0, Vdb, Bef, St0) -> - {Kes2,Int1,St1} = - case basic_block(Kes0) of - {Kes1,LastI,Args,Rest} -> - cg_basic_block(Kes1, LastI, Args, Vdb, Bef, St0); - {Kes1,Rest} -> - cg_list(Kes1, Vdb, Bef, St0) - end, - {Kes3,Int2,St2} = cg_block(Rest, Vdb, Int1, St1), - {Kes2 ++ Kes3,Int2,St2}. - -basic_block(Kes) -> basic_block(Kes, []). - -basic_block([Ke|Kes], Acc) -> - case collect_block(Ke) of - include -> basic_block(Kes, [Ke|Acc]); - {block_end,As} -> - case Acc of - [] -> - %% If the basic block does not contain any #k_put{} instructions, - %% it serves no useful purpose to do basic block optimizations. - {[Ke],Kes}; - _ -> - #l{i=I} = get_kanno(Ke), - {reverse(Acc, [Ke]),I,As,Kes} - end; - no_block -> {reverse(Acc, [Ke]),Kes} - end. - -collect_block(#k_put{arg=Arg}) -> - %% #k_put{} instructions that may garbage collect are not allowed - %% in basic blocks. - case Arg of - #k_binary{} -> no_block; - #k_map{} -> no_block; - _ -> include - end; -collect_block(#k_call{op=Func,args=As}) -> - {block_end,As++func_vars(Func)}; -collect_block(#k_enter{op=Func,args=As}) -> - {block_end,As++func_vars(Func)}; -collect_block(#k_return{args=Rs}) -> - {block_end,Rs}; -collect_block(#k_break{args=Bs}) -> - {block_end,Bs}; -collect_block(_) -> no_block. - -func_vars(#k_var{}=Var) -> - [Var]; -func_vars(#k_remote{mod=M,name=F}) - when is_record(M, k_var); is_record(F, k_var) -> - [M,F]; -func_vars(_) -> []. - -%% cg_basic_block([Kexpr], FirstI, LastI, Arguments, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% -%% Do a specialized code generation for a basic block of #put{} -%% instructions (that don't do any garbage collection) followed by a -%% call, break, or return. -%% -%% 'Arguments' is a list of the variables that must be loaded into -%% consecutive X registers before the last instruction in the block. -%% The point of this specialized code generation is to try put the -%% all of the variables in 'Arguments' into the correct X register -%% to begin with, instead of putting them into the first available -%% X register and having to move them to the correct X register -%% later. -%% -%% To achieve that, we attempt to reserve the X registers that the -%% variables in 'Arguments' will need to be in when the block ends. -%% -%% To make it more likely that reservations will be successful, we -%% will try to save variables that need to be saved to the stack as -%% early as possible (if an X register needed by a variable in -%% Arguments is occupied by another variable, the value in the -%% X register can be evicted if it is saved on the stack). -%% -%% We will take care not to increase the size of stack frame compared -%% to what the standard code generator would have done (that is, to -%% save all X registers at the last possible moment). We will do that -%% by extending the stack frame to the minimal size needed to save -%% all that needs to be saved using extend_stack/4, and use -%% save_carefully/4 during code generation to only save the variables -%% that can be saved without growing the stack frame. - -cg_basic_block(Kes, Lf, As, Vdb, Bef, St0) -> - Int0 = reserve_arg_regs(As, Bef), - Int = extend_stack(Int0, Lf, Lf+1, Vdb), - {Keis,{Aft,St1}} = - flatmapfoldl(fun(Ke, St) -> cg_basic_block(Ke, St, Lf, Vdb) end, - {Int,St0}, need_heap(Kes)), - {Keis,Aft,St1}. - -cg_basic_block(#cg_need_heap{}=Ke, {Bef,St0}, _Lf, Vdb) -> - {Keis,Aft,St1} = cg(Ke, Vdb, Bef, St0), - {Keis,{Aft,St1}}; -cg_basic_block(Ke, {Bef,St0}, Lf, Vdb) -> - #l{i=I} = get_kanno(Ke), - - %% Save all we can to increase the possibility that reserving - %% registers will succeed. - {Sis,Int0} = save_carefully(Bef, I, Lf+1, Vdb), - Int1 = reserve(Int0), - {Keis,Aft,St1} = cg(Ke, Vdb, Int1, St0), - {Sis ++ Keis,{Aft,St1}}. - -%% reserve_arg_regs([Argument], Bef) -> Aft. -%% Try to reserve the X registers for all arguments. All registers -%% that we wish to reserve will be saved in Bef#sr.res. - -reserve_arg_regs(As, Bef) -> - Res = reserve_arg_regs_1(As, 0), - reserve(Bef#sr{res=Res}). - -reserve_arg_regs_1([#k_var{name=V}|As], I) -> - [{I,V}|reserve_arg_regs_1(As, I+1)]; -reserve_arg_regs_1([A|As], I) -> - [{I,A}|reserve_arg_regs_1(As, I+1)]; -reserve_arg_regs_1([], _) -> []. - -%% reserve(Bef) -> Aft. -%% Try to reserve more registers. The registers we wish to reserve -%% are found in Bef#sr.res. - -reserve(#sr{reg=Regs,stk=Stk,res=Res}=Sr) -> - Sr#sr{reg=reserve_1(Res, Regs, Stk)}. - -reserve_1([{I,V}|Rs], [free|Regs], Stk) -> - [{reserved,I,V}|reserve_1(Rs, Regs, Stk)]; -reserve_1([{I,V}|Rs], [{I,V}|Regs], Stk) -> - [{I,V}|reserve_1(Rs, Regs, Stk)]; -reserve_1([{I,V}|Rs], [{I,Var}|Regs], Stk) -> - case on_stack(Var, Stk) of - true -> [{reserved,I,V}|reserve_1(Rs, Regs, Stk)]; - false -> [{I,Var}|reserve_1(Rs, Regs, Stk)] - end; -reserve_1([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) -> - [{reserved,I,V}|reserve_1(Rs, Regs, Stk)]; -reserve_1([{I,V}|Rs], [], Stk) -> - [{reserved,I,V}|reserve_1(Rs, [], Stk)]; -reserve_1([], Regs, _) -> Regs. - -%% extend_stack(Bef, FirstBefore, LastFrom, Vdb) -> Aft. -%% Extend the stack enough to fit all variables alive past LastFrom -%% and not already on the stack. - -extend_stack(#sr{stk=Stk0}=Bef, Fb, Lf, Vdb) -> - Stk1 = clear_dead_stk(Stk0, Fb, Vdb), - New = new_not_on_stack(Stk1, Fb, Lf, Vdb), - Stk2 = foldl(fun ({V,_,_}, Stk) -> put_stack(V, Stk) end, Stk1, New), - Stk = Stk0 ++ lists:duplicate(length(Stk2) - length(Stk0), free), - Bef#sr{stk=Stk}. - -%% save_carefully(Bef, FirstBefore, LastFrom, Vdb) -> {[SaveVar],Aft}. -%% Save variables which are used past current point and which are not -%% already on the stack, but only if the variables can be saved without -%% growing the stack frame. - -save_carefully(#sr{stk=Stk}=Bef, Fb, Lf, Vdb) -> - New0 = new_not_on_stack(Stk, Fb, Lf, Vdb), - New = keysort(2, New0), - save_carefully_1(New, Bef, []). - -save_carefully_1([{V,_,_}|Vs], #sr{reg=Regs,stk=Stk0}=Bef, Acc) -> - case put_stack_carefully(V, Stk0) of - error -> - {reverse(Acc),Bef}; - Stk1 -> - SrcReg = fetch_reg(V, Regs), - Move = {move,SrcReg,fetch_stack(V, Stk1)}, - {x,_} = SrcReg, %Assertion - must be X register. - save_carefully_1(Vs, Bef#sr{stk=Stk1}, [Move|Acc]) - end; -save_carefully_1([], Bef, Acc) -> - {reverse(Acc),Bef}. - -%% top_level_block([Instruction], Bef, MaxRegs, St) -> [Instruction]. -%% For the top-level block, allocate a stack frame a necessary, -%% adjust Y register numbering and instructions that return -%% from the function. - -top_level_block(Keis, #sr{stk=[]}, _MaxRegs, #cg{need_frame=false}) -> - Keis; -top_level_block(Keis, Bef, MaxRegs, _St) -> - %% This top block needs an allocate instruction before it, and a - %% deallocate instruction before each return. - FrameSz = length(Bef#sr.stk), - MaxY = FrameSz-1, - Keis1 = flatmap(fun ({call_only,Arity,Func}) -> - [{call_last,Arity,Func,FrameSz}]; - ({call_ext_only,Arity,Func}) -> - [{call_ext_last,Arity,Func,FrameSz}]; - ({apply_only,Arity}) -> - [{apply_last,Arity,FrameSz}]; - (return) -> - [{deallocate,FrameSz},return]; - (Tuple) when is_tuple(Tuple) -> - [turn_yregs(Tuple, MaxY)]; - (Other) -> - [Other] - end, Keis), - [{allocate_zero,FrameSz,MaxRegs}|Keis1]. - -%% turn_yregs(Size, Tuple, MaxY) -> Tuple' -%% Renumber y register so that {y,0} becomes {y,FrameSize-1}, -%% {y,FrameSize-1} becomes {y,0} and so on. This is to make nested -%% catches work. The code generation algorithm gives a lower register -%% number to the outer catch, which is wrong. - -turn_yregs({call,_,_}=I, _MaxY) -> I; -turn_yregs({call_ext,_,_}=I, _MaxY) -> I; -turn_yregs({jump,_}=I, _MaxY) -> I; -turn_yregs({label,_}=I, _MaxY) -> I; -turn_yregs({line,_}=I, _MaxY) -> I; -turn_yregs({test_heap,_,_}=I, _MaxY) -> I; -turn_yregs({bif,Op,F,A,B}, MaxY) -> - {bif,Op,F,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; -turn_yregs({gc_bif,Op,F,Live,A,B}, MaxY) when is_integer(Live) -> - {gc_bif,Op,F,Live,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; -turn_yregs({get_tuple_element,S,N,D}, MaxY) -> - {get_tuple_element,turn_yreg(S, MaxY),N,turn_yreg(D, MaxY)}; -turn_yregs({put_tuple,Arity,D}, MaxY) -> - {put_tuple,Arity,turn_yreg(D, MaxY)}; -turn_yregs({select_val,R,F,L}, MaxY) -> - {select_val,turn_yreg(R, MaxY),F,L}; -turn_yregs({test,Op,F,L}, MaxY) -> - {test,Op,F,turn_yreg(L, MaxY)}; -turn_yregs({test,Op,F,Live,A,B}, MaxY) when is_integer(Live) -> - {test,Op,F,Live,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; -turn_yregs({Op,A}, MaxY) -> - {Op,turn_yreg(A, MaxY)}; -turn_yregs({Op,A,B}, MaxY) -> - {Op,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; -turn_yregs({Op,A,B,C}, MaxY) -> - {Op,turn_yreg(A, MaxY),turn_yreg(B, MaxY),turn_yreg(C, MaxY)}; -turn_yregs(Tuple, MaxY) -> - turn_yregs(tuple_size(Tuple), Tuple, MaxY). - -turn_yregs(1, Tp, _) -> - Tp; -turn_yregs(N, Tp, MaxY) -> - E = turn_yreg(element(N, Tp), MaxY), - turn_yregs(N-1, setelement(N, Tp, E), MaxY). - -turn_yreg({yy,YY}, MaxY) -> - {y,MaxY-YY}; -turn_yreg({list,Ls},MaxY) -> - {list,turn_yreg(Ls, MaxY)}; -turn_yreg([_|_]=Ts, MaxY) -> - [turn_yreg(T, MaxY) || T <- Ts]; -turn_yreg(Other, _MaxY) -> - Other. - -%% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) -> -%% {Is,StackReg,State}. -%% Selecting type and value needs two failure labels, TypeFail is the -%% label to jump to of the next type test when this type fails, and -%% ValueFail is the label when this type is correct but the value is -%% wrong. These are different as in the second case there is no need -%% to try the next type, it will always fail. - -select_cg(#k_type_clause{type=Type,values=Vs}, Var, Tf, Vf, Bef, St) -> - #k_var{name=V} = Var, - select_cg(Type, Vs, V, Tf, Vf, Bef, St). - -select_cg(k_cons, [S], V, Tf, Vf, Bef, St) -> - select_cons(S, V, Tf, Vf, Bef, St); -select_cg(k_nil, [S], V, Tf, Vf, Bef, St) -> - select_nil(S, V, Tf, Vf, Bef, St); -select_cg(k_binary, [S], V, Tf, Vf, Bef, St) -> - select_binary(S, V, Tf, Vf, Bef, St); -select_cg(k_bin_seg, S, V, Tf, _Vf, Bef, St) -> - select_bin_segs(S, V, Tf, Bef, St); -select_cg(k_bin_int, S, V, Tf, _Vf, Bef, St) -> - select_bin_segs(S, V, Tf, Bef, St); -select_cg(k_bin_end, [S], V, Tf, _Vf, Bef, St) -> - select_bin_end(S, V, Tf, Bef, St); -select_cg(k_map, S, V, Tf, Vf, Bef, St) -> - select_map(S, V, Tf, Vf, Bef, St); -select_cg(k_literal, S, V, Tf, Vf, Bef, St) -> - select_literal(S, V, Tf, Vf, Bef, St); -select_cg(Type, Scs, V, Tf, Vf, Bef, St0) -> - {Vis,{Aft,St1}} = - mapfoldl(fun (S, {Int,Sta}) -> - {Val,Is,Inta,Stb} = select_val(S, V, Vf, Bef, Sta), - {{Is,[Val]},{sr_merge(Int, Inta),Stb}} - end, {void,St0}, Scs), - OptVls = combine(lists:sort(combine(Vis))), - {Vls,Sis,St2} = select_labels(OptVls, St1, [], []), - {select_val_cg(Type, fetch_var(V, Bef), Vls, Tf, Vf, Sis), Aft, St2}. - -select_val_cg(k_tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> - [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; -select_val_cg(k_tuple, R, Vls, Tf, Vf, Sis) -> - [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; -select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> - [{test,is_eq_exact,{f,Fail},[R,{type(Type),Val}]}|Sis]; -select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> - [{test,select_type_test(Type),{f,Tf},[R]}, - {test,is_eq_exact,{f,Vf},[R,{type(Type),Val}]}|Sis]; -select_val_cg(Type, R, Vls0, Tf, Vf, Sis) -> - Vls1 = [case Value of - {f,_Lbl} -> Value; - _ -> {type(Type),Value} - end || Value <- Vls0], - [{test,select_type_test(Type),{f,Tf},[R]}, {select_val,R,{f,Vf},{list,Vls1}}|Sis]. - -type(k_atom) -> atom; -type(k_float) -> float; -type(k_int) -> integer. - -select_type_test(k_int) -> is_integer; -select_type_test(k_atom) -> is_atom; -select_type_test(k_float) -> is_float. - -combine([{Is,Vs1}, {Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]); -combine([V|Vis]) -> [V|combine(Vis)]; -combine([]) -> []. - -select_labels([{Is,Vs}|Vis], St0, Vls, Sis) -> - {Lbl,St1} = new_label(St0), - select_labels(Vis, St1, add_vls(Vs, Lbl, Vls), [[{label,Lbl}|Is]|Sis]); -select_labels([], St, Vls, Sis) -> - {Vls,append(Sis),St}. - -add_vls([V|Vs], Lbl, Acc) -> - add_vls(Vs, Lbl, [V, {f,Lbl}|Acc]); -add_vls([], _, Acc) -> Acc. - -select_literal(S, V, Tf, Vf, Bef, St) -> - Reg = fetch_var(V, Bef), - F = fun(ValClause, Fail, St0) -> - {Val,Is,Aft,St1} = select_val(ValClause, V, Vf, Bef, St0), - Test = {test,is_eq_exact,{f,Fail},[Reg,{literal,Val}]}, - {[Test|Is],Aft,St1} - end, - match_fmf(F, Tf, St, S). - -select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B,anno=#l{i=I,vdb=Vdb}}, - V, Tf, Vf, Bef, St0) -> - Es = [Hd,Tl], - {Eis,Int,St1} = select_extract_cons(V, Es, I, Vdb, Bef, St0), - {Bis,Aft,St2} = match_cg(B, Vf, Int, St1), - {[{test,is_nonempty_list,{f,Tf},[fetch_var(V, Bef)]}] ++ Eis ++ Bis,Aft,St2}. - -select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, Bef, St0) -> - {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0), - {[{test,is_nil,{f,Tf},[fetch_var(V, Bef)]}] ++ Bis,Aft,St1}. - -select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=V}},body=B, - anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) -> - #cg{ctx=OldCtx} = St0, - Int0 = clear_dead(Bef#sr{reg=Bef#sr.reg}, I, Vdb), - {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=V}), - CtxReg = fetch_var(V, Int0), - Live = max_reg(Bef#sr.reg), - Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,{context,V}],CtxReg}, - {bs_save2,CtxReg,{V,V}}|Bis0], - Bis = finish_select_binary(Bis1), - {Bis,Aft,St1#cg{ctx=OldCtx}}; -select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ivar}},body=B, - anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) -> - #cg{ctx=OldCtx} = St0, - Regs = put_reg(Ivar, Bef#sr.reg), - Int0 = clear_dead(Bef#sr{reg=Regs}, I, Vdb), - {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=Ivar}), - CtxReg = fetch_var(Ivar, Int0), - Live = max_reg(Bef#sr.reg), - Bis1 = [{test,bs_start_match2,{f,Tf},Live, - [fetch_var(V, Bef),{context,Ivar}],CtxReg}, - {bs_save2,CtxReg,{Ivar,Ivar}}|Bis0], - Bis = finish_select_binary(Bis1), - {Bis,Aft,St1#cg{ctx=OldCtx}}. - -finish_select_binary([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is]) -> - [I|finish_select_binary(Is)]; -finish_select_binary([{bs_save2,R,Point}=I,{test,is_eq_exact,_,_}=Test, - {bs_restore2,R,Point}|Is]) -> - [I,Test|finish_select_binary(Is)]; -finish_select_binary([{test,bs_match_string,F,[Ctx,BinList]}|Is]) - when is_list(BinList) -> - I = {test,bs_match_string,F,[Ctx,list_to_bitstring(BinList)]}, - [I|finish_select_binary(Is)]; -finish_select_binary([I|Is]) -> - [I|finish_select_binary(Is)]; -finish_select_binary([]) -> []. - -%% New instructions for selection of binary segments. - -select_bin_segs(Scs, Ivar, Tf, Bef, St) -> - match_fmf(fun(S, Fail, Sta) -> - select_bin_seg(S, Ivar, Fail, Bef, Sta) end, - Tf, St, Scs). - -select_bin_seg(#k_val_clause{val=#k_bin_seg{size=Size,unit=U,type=T, - seg=Seg,flags=Fs0,next=Next}, - body=B, - anno=#l{i=I,vdb=Vdb,a=A}}, Ivar, Fail, Bef, St0) -> - Ctx = St0#cg.ctx, - Fs = [{anno,A}|Fs0], - Es = case Next of - [] -> [Seg]; - _ -> [Seg,Next] - end, - {Mis,Int,St1} = select_extract_bin(Es, Size, U, T, Fs, Fail, - I, Vdb, Bef, Ctx, B, St0), - {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), - CtxReg = fetch_var(Ctx, Bef), - Is = if - Mis =:= [] -> - %% No bs_restore2 instruction needed if no match instructions. - Bis; - true -> - [{bs_restore2,CtxReg,{Ctx,Ivar}}|Mis++Bis] - end, - {Is,Aft,St2}; -select_bin_seg(#k_val_clause{val=#k_bin_int{size=Sz,unit=U,flags=Fs, - val=Val,next=Next}, - body=B, - anno=#l{i=I,vdb=Vdb}}, Ivar, Fail, Bef, St0) -> - Ctx = St0#cg.ctx, - {Mis,Int,St1} = select_extract_int(Next, Val, Sz, U, Fs, Fail, - I, Vdb, Bef, Ctx, St0), - {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), - CtxReg = fetch_var(Ctx, Bef), - Is = case Mis ++ Bis of - [{test,bs_match_string,F,[OtherCtx,Bin1]}, - {bs_save2,OtherCtx,_}, - {bs_restore2,OtherCtx,_}, - {test,bs_match_string,F,[OtherCtx,Bin2]}|Is0] -> - %% We used to do this optimization later, but it - %% turns out that in huge functions with many - %% bs_match_string instructions, it's a big win - %% to do the combination now. To avoid copying the - %% binary data again and again, we'll combine bitstrings - %% in a list and convert all of it to a bitstring later. - [{test,bs_match_string,F,[OtherCtx,[Bin1,Bin2]]}|Is0]; - Is0 -> - Is0 - end, - {[{bs_restore2,CtxReg,{Ctx,Ivar}}|Is],Aft,St2}. - -select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, - I, Vdb, Bef, Ctx, St) -> - Bits = U*Sz, - Bin = case member(big, Fs) of - true -> - <<Val:Bits>>; - false -> - true = member(little, Fs), %Assertion. - <<Val:Bits/little>> - end, - Bits = bit_size(Bin), %Assertion. - CtxReg = fetch_var(Ctx, Bef), - Is = if - Bits =:= 0 -> - [{bs_save2,CtxReg,{Ctx,Tl}}]; - true -> - [{test,bs_match_string,{f,Vf},[CtxReg,Bin]}, - {bs_save2,CtxReg,{Ctx,Tl}}] - end, - {Is,clear_dead(Bef, I, Vdb),St}. - -select_extract_bin([#k_var{name=Hd},#k_var{name=Tl}], Size0, Unit, Type, Flags, Vf, - I, Vdb, Bef, Ctx, _Body, St) -> - SizeReg = get_bin_size_reg(Size0, Bef), - {Es,Aft} = - case vdb_find(Hd, Vdb) of - {_,_,Lhd} when Lhd =< I -> - %% The extracted value will not be used. - CtxReg = fetch_var(Ctx, Bef), - Live = max_reg(Bef#sr.reg), - Skip = build_skip_instr(Type, Vf, CtxReg, Live, - SizeReg, Unit, Flags), - {[Skip,{bs_save2,CtxReg,{Ctx,Tl}}],Bef}; - {_,_,_} -> - Reg = put_reg(Hd, Bef#sr.reg), - Int1 = Bef#sr{reg=Reg}, - Rhd = fetch_reg(Hd, Reg), - CtxReg = fetch_reg(Ctx, Reg), - Live = max_reg(Bef#sr.reg), - {[build_bs_instr(Type, Vf, CtxReg, Live, SizeReg, - Unit, Flags, Rhd), - {bs_save2,CtxReg,{Ctx,Tl}}],Int1} - end, - {Es,clear_dead(Aft, I, Vdb),St}; -select_extract_bin([#k_var{name=Hd}], Size, Unit, binary, Flags, Vf, - I, Vdb, Bef, Ctx, Body, St) -> - %% Match the last segment of a binary. We KNOW that the size - %% must be 'all'. - #k_atom{val=all} = Size, %Assertion. - {Es,Aft} = - case vdb_find(Hd, Vdb) of - {_,_,Lhd} when Lhd =< I -> - %% The result will not be used. Furthermore, since we - %% we are at the end of the binary, the position will - %% not be used again; thus, it is safe to do a cheaper - %% test of the unit. - CtxReg = fetch_var(Ctx, Bef), - {case Unit of - 1 -> - []; - _ -> - [{test,bs_test_unit,{f,Vf},[CtxReg,Unit]}] - end,Bef}; - {_,_,_} -> - case is_context_unused(Body) of - false -> - Reg = put_reg(Hd, Bef#sr.reg), - Int1 = Bef#sr{reg=Reg}, - Rhd = fetch_reg(Hd, Reg), - CtxReg = fetch_reg(Ctx, Reg), - Name = bs_get_binary2, - Live = max_reg(Bef#sr.reg), - {[{test,Name,{f,Vf},Live, - [CtxReg,atomic(Size),Unit,{field_flags,Flags}],Rhd}], - Int1}; - true -> - %% Since the matching context will not be used again, - %% we can reuse its register. Reusing the register - %% opens some interesting optimizations in the - %% run-time system. - - Reg0 = Bef#sr.reg, - CtxReg = fetch_reg(Ctx, Reg0), - Reg = replace_reg_contents(Ctx, Hd, Reg0), - Int1 = Bef#sr{reg=Reg}, - Name = bs_get_binary2, - Live = max_reg(Int1#sr.reg), - {[{test,Name,{f,Vf},Live, - [CtxReg,atomic(Size),Unit,{field_flags,Flags}],CtxReg}], - Int1} - end - end, - {Es,clear_dead(Aft, I, Vdb),St}. - -%% is_context_unused(Ke) -> true | false -%% Simple heurististic to determine whether the code that follows -%% will use the current matching context again. (The liveness -%% information is too conservative to be useful for this purpose.) -%% 'true' means that the code that follows will definitely not use -%% the context again (because it is a block, not guard or matching -%% code); 'false' that we are not sure (there could be more -%% matching). - -is_context_unused(#k_alt{then=Then}) -> - %% #k_alt{} can be used for different purposes. If the Then part - %% is a block, it means that matching has finished and is used for a guard - %% to choose between the matched clauses. - is_context_unused(Then); -is_context_unused(#cg_block{}) -> - true; -is_context_unused(_) -> - false. - -select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Ivar, Tf, Bef, St0) -> - Ctx = St0#cg.ctx, - {Bis,Aft,St2} = match_cg(B, Tf, Bef, St0), - CtxReg = fetch_var(Ctx, Bef), - {[{bs_restore2,CtxReg,{Ctx,Ivar}}, - {test,bs_test_tail2,{f,Tf},[CtxReg,0]}|Bis],Aft,St2}. - -get_bin_size_reg(#k_var{name=V}, Bef) -> - fetch_var(V, Bef); -get_bin_size_reg(Literal, _Bef) -> - atomic(Literal). - -build_bs_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags, Rhd) -> - {Format,Name} = case Type of - integer -> {plain,bs_get_integer2}; - float -> {plain,bs_get_float2}; - binary -> {plain,bs_get_binary2}; - utf8 -> {utf,bs_get_utf8}; - utf16 -> {utf,bs_get_utf16}; - utf32 -> {utf,bs_get_utf32} - end, - case Format of - plain -> - {test,Name,{f,Vf},Live, - [CtxReg,SizeReg,Unit,{field_flags,Flags}],Rhd}; - utf -> - {test,Name,{f,Vf},Live, - [CtxReg,{field_flags,Flags}],Rhd} - end. - -build_skip_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags) -> - {Format,Name} = case Type of - utf8 -> {utf,bs_skip_utf8}; - utf16 -> {utf,bs_skip_utf16}; - utf32 -> {utf,bs_skip_utf32}; - _ -> {plain,bs_skip_bits2} - end, - case Format of - plain -> - {test,Name,{f,Vf},[CtxReg,SizeReg,Unit,{field_flags,Flags}]}; - utf -> - {test,Name,{f,Vf},[CtxReg,Live,{field_flags,Flags}]} - end. - -select_val(#k_val_clause{val=#k_tuple{es=Es},body=B,anno=#l{i=I,vdb=Vdb}}, - V, Vf, Bef, St0) -> - {Eis,Int,St1} = select_extract_tuple(V, Es, I, Vdb, Bef, St0), - {Bis,Aft,St2} = match_cg(B, Vf, Int, St1), - {length(Es),Eis ++ Bis,Aft,St2}; -select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, Bef, St0) -> - Val = case Val0 of - #k_atom{val=Lit} -> Lit; - #k_float{val=Lit} -> Lit; - #k_int{val=Lit} -> Lit; - #k_literal{val=Lit} -> Lit - end, - {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0), - {Val,Bis,Aft,St1}. - -%% select_extract_tuple(Src, [V], I, Vdb, StackReg, State) -> -%% {[E],StackReg,State}. -%% Extract tuple elements, but only if they do not immediately die. - -select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> - F = fun (#k_var{name=V}, {Int0,Elem}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> {[], {Int0,Elem+1}}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - Rsrc = fetch_var(Src, Int1), - {[{get_tuple_element,Rsrc,Elem,fetch_reg(V, Reg1)}], - {Int1,Elem+1}} - end - end, - {Es,{Aft,_}} = flatmapfoldl(F, {Bef,0}, Vs), - {Es,Aft,St}. - -select_map(Scs, V, Tf, Vf, Bef, St0) -> - Reg = fetch_var(V, Bef), - {Is,Aft,St1} = - match_fmf(fun(#k_val_clause{val=#k_map{op=exact,es=Es}, - body=B,anno=#l{i=I,vdb=Vdb}}, Fail, St1) -> - select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) - end, Vf, St0, Scs), - {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. - -select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) -> - {Eis,Int,St1} = select_extract_map(V, Es, Fail, I, Vdb, Bef, St0), - {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), - {Eis++Bis,Aft,St2}. - -select_extract_map(_, [], _, _, _, Bef, St) -> {[],Bef,St}; -select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> - %% First split the instruction flow - %% We want one set of each - %% 1) has_map_fields (no target registers) - %% 2) get_map_elements (with target registers) - %% Assume keys are term-sorted - Rsrc = fetch_var(Src, Bef), - - {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = - foldr(fun(#k_map_pair{key=#k_var{name=K},val=#k_var{name=V}}, - {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> - RK = fetch_var(K,Int0), - {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - RK = fetch_var(K,Int0), - RV = fetch_reg(V,Reg1), - {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1} - end; - (#k_map_pair{key=Key,val=#k_var{name=V}}, - {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> - {{[atomic(Key)|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - {{HasKsi,[atomic(Key),fetch_reg(V, Reg1)|GetVsi], - HasVarVsi,GetVarVsi},Int1} - end - end, {{[],[],[],[]},Bef}, Vs), - - Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++ - [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++ - [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}} || GetVs =/= []] ++ - [{get_map_elements, {f,Fail},Rsrc,{list,[K,V]}} || [K,V] <- GetVarVs], - {Code, Aft, St}. - - -select_extract_cons(Src, [#k_var{name=Hd},#k_var{name=Tl}], I, Vdb, Bef, St) -> - Rsrc = fetch_var(Src, Bef), - Int = clear_dead(Bef, I, Vdb), - {{_,_,Lhd},{_,_,Ltl}} = {vdb_find(Hd, Vdb),vdb_find(Tl, Vdb)}, - case {Lhd =< I, Ltl =< I} of - {true,true} -> - %% Both dead. - {[],Bef,St}; - {true,false} -> - %% Head dead. - Reg0 = put_reg(Tl, Bef#sr.reg), - Aft = Int#sr{reg=Reg0}, - Rtl = fetch_reg(Tl, Reg0), - {[{get_tl,Rsrc,Rtl}],Aft,St}; - {false,true} -> - %% Tail dead. - Reg0 = put_reg(Hd, Bef#sr.reg), - Aft = Int#sr{reg=Reg0}, - Rhd = fetch_reg(Hd, Reg0), - {[{get_hd,Rsrc,Rhd}],Aft,St}; - {false,false} -> - %% Both used. - Reg0 = put_reg(Tl, put_reg(Hd, Bef#sr.reg)), - Aft = Bef#sr{reg=Reg0}, - Rhd = fetch_reg(Hd, Reg0), - Rtl = fetch_reg(Tl, Reg0), - {[{get_hd,Rsrc,Rhd},{get_tl,Rsrc,Rtl}],Aft,St} - end. - -guard_clause_cg(#k_guard_clause{anno=#l{vdb=Vdb},guard=G,body=B}, Fail, Bef, St0) -> - {Gis,Int,St1} = guard_cg(G, Fail, Vdb, Bef, St0), - {Bis,Aft,St} = match_cg(B, Fail, Int, St1), - {Gis ++ Bis,Aft,St}. - -%% guard_cg(Guard, Fail, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% A guard is a boolean expression of tests. Tests return true or -%% false. A fault in a test causes the test to return false. Tests -%% never return the boolean, instead we generate jump code to go to -%% the correct exit point. Primops and tests all go to the next -%% instruction on success or jump to a failure label. - -guard_cg(#k_protected{arg=Ts,ret=Rs,anno=#l{vdb=Pdb}}, Fail, _Vdb, Bef, St) -> - protected_cg(Ts, Rs, Fail, Pdb, Bef, St); -guard_cg(#k_test{anno=#l{i=I},op=Test0,args=As,inverted=Inverted}, - Fail, Vdb, Bef, St0) -> - #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0, - case Inverted of - false -> - test_cg(Test, As, Fail, I, Vdb, Bef, St0); - true -> - {Psucc,St1} = new_label(St0), - {Is,Aft,St2} = test_cg(Test, As, Psucc, I, Vdb, Bef, St1), - {Is++[{jump,{f,Fail}},{label,Psucc}],Aft,St2} - end; -guard_cg(G, _Fail, Vdb, Bef, St) -> - %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{G,Fail,Vdb,Bef}]), - {Gis,Aft,St1} = cg(G, Vdb, Bef, St), - %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Aft}]), - {Gis,Aft,St1}. - -%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) -> -%% {[Ainstr],StackReg,St}. - -guard_cg_list(Kes, Fail, Vdb, Bef, St0) -> - {Keis,{Aft,St1}} = - flatmapfoldl(fun (Ke, {Inta,Sta}) -> - {Keis,Intb,Stb} = - guard_cg(Ke, Fail, Vdb, Inta, Sta), - {Keis,{Intb,Stb}} - end, {Bef,St0}, need_heap(Kes)), - {Keis,Aft,St1}. - -%% protected_cg([Kexpr], [Ret], Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% Do a protected. Protecteds without return values are just done -%% for effect, the return value is not checked, success passes on to -%% the next instruction and failure jumps to Fail. If there are -%% return values then these must be set to 'false' on failure, -%% control always passes to the next instruction. - -protected_cg(Ts, [], Fail, Vdb, Bef, St0) -> - %% Protect these calls, revert when done. - {Tis,Aft,St1} = guard_cg_list(Ts, Fail, Vdb, Bef, St0#cg{bfail=Fail}), - {Tis,Aft,St1#cg{bfail=St0#cg.bfail}}; -protected_cg(Ts, Rs, _Fail, Vdb, Bef, St0) -> - {Pfail,St1} = new_label(St0), - {Psucc,St2} = new_label(St1), - {Tis,Aft,St3} = guard_cg_list(Ts, Pfail, Vdb, Bef, - St2#cg{bfail=Pfail}), - %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Rs,I,Vdb,Aft}]), - %% Set return values to false. - Mis = [{move,{atom,false},fetch_var(V,Aft)}||#k_var{name=V} <- Rs], - {Tis ++ [{jump,{f,Psucc}}, - {label,Pfail}] ++ Mis ++ [{label,Psucc}], - Aft,St3#cg{bfail=St0#cg.bfail}}. - -%% test_cg(TestName, Args, Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% Generate test instruction. Use explicit fail label here. - -test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> - %% We must avoid creating code like this: - %% - %% move x(0) y(0) - %% is_map Fail [x(0)] - %% make_fun => x(0) %% Overwrite x(0) - %% put_map_assoc y(0) ... - %% - %% The code is safe, but beam_validator does not understand that. - %% Extending beam_validator to handle such (rare) code as the - %% above would make it slower for all programs. Instead, change - %% the code generator to always prefer the Y register for is_map() - %% and put_map_assoc() instructions, ensuring that they use the - %% same register. - Arg = cg_reg_arg_prefer_y(A, Bef), - Aft = clear_dead(Bef, I, Vdb), - {[{test,is_map,{f,Fail},[Arg]}],Aft,St}; -test_cg(is_boolean, [#k_atom{val=Val}], Fail, I, Vdb, Bef, St) -> - Aft = clear_dead(Bef, I, Vdb), - Is = case is_boolean(Val) of - true -> []; - false -> [{jump,{f,Fail}}] - end, - {Is,Aft,St}; -test_cg(is_map_key, As, Fail, I, Vdb, Bef, St) -> - [Key,Map] = cg_reg_args(As, Bef), - Aft = clear_dead(Bef, I, Vdb), - F = {f,Fail}, - {[{test,is_map,F,[Map]},{test,has_map_fields,F,Map,{list,[Key]}}],Aft,St}; -test_cg(Test, As, Fail, I, Vdb, Bef, St) -> - Args = cg_reg_args(As, Bef), - Aft = clear_dead(Bef, I, Vdb), - {[beam_utils:bif_to_test(Test, Args, {f,Fail})],Aft,St}. - -%% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,Aft,State}. -%% This is a special flatmapfoldl for match code gen where we -%% generate a "failure" label for each clause. The last clause uses -%% an externally generated failure label, LastFail. N.B. We do not -%% know or care how the failure labels are used. - -match_fmf(F, LastFail, St, [H]) -> - F(H, LastFail, St); -match_fmf(F, LastFail, St0, [H|T]) -> - {Fail,St1} = new_label(St0), - {R,Aft1,St2} = F(H, Fail, St1), - {Rs,Aft2,St3} = match_fmf(F, LastFail, St2, T), - {R ++ [{label,Fail}] ++ Rs,sr_merge(Aft1, Aft2),St3}. - -%% call_cg(Func, [Arg], [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% enter_cg(Func, [Arg], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% Call and enter first put the arguments into registers and save any -%% other registers, then clean up and compress the stack and set the -%% frame size. Finally the actual call is made. Call then needs the -%% return values filled in. - -call_cg(#k_var{}=Var, As, Rs, Le, Vdb, Bef, St0) -> - {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), - %% Put return values in registers. - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - %% Build complete code and final stack/register state. - Arity = length(As), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft, - need_stack_frame(St0)}; -call_cg(#k_remote{mod=Mod,name=Name}, As, Rs, Le, Vdb, Bef, St0) - when is_record(Mod, k_var); is_record(Name, k_var) -> - {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), - %% Put return values in registers. - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - %% Build complete code and final stack/register state. - Arity = length(As), - St = need_stack_frame(St0), - %%{Call,St1} = build_call(Func, Arity, St0), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [line(Le),{apply,Arity}],Aft,St}; -call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> - case St0 of - #cg{bfail=Fail} when Fail =/= 0 -> - %% Inside a guard. The only allowed function call is to - %% erlang:error/1,2. We will generate the following code: - %% - %% move {atom,ok} DestReg - %% jump FailureLabel - #k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=error}} = Func, %Assertion. - [#k_var{name=DestVar}] = Rs, - Int0 = clear_dead(Bef, Le#l.i, Vdb), - Reg = put_reg(DestVar, Int0#sr.reg), - Int = Int0#sr{reg=Reg}, - Dst = fetch_reg(DestVar, Reg), - {[{move,{atom,ok},Dst},{jump,{f,Fail}}], - clear_dead(Int, Le#l.i, Vdb),St0}; - #cg{} -> - %% Ordinary function call in a function body. - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - %% Put return values in registers. - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - %% Build complete code and final stack/register state. - Arity = length(As), - {Call,St1} = build_call(Func, Arity, St0), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [line(Le)|Call],Aft,St1} - end. - -build_call(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) -> - {[send],need_stack_frame(St0)}; -build_call(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) -> - {[{call_ext,Arity,{extfunc,Mod,Name,Arity}}],need_stack_frame(St0)}; -build_call(#k_local{name=Name}, Arity, St0) when is_atom(Name) -> - {Lbl,St1} = local_func_label(Name, Arity, need_stack_frame(St0)), - {[{call,Arity,{f,Lbl}}],St1}. - -free_dead(#sr{stk=Stk0}=Aft) -> - {Instr,Stk} = free_dead(Stk0, 0, [], []), - {Instr,Aft#sr{stk=Stk}}. - -free_dead([dead|Stk], Y, Instr, StkAcc) -> - %% Note: kill/1 is equivalent to init/1 (translated by beam_asm). - %% We use kill/1 to help further optimisation passes. - free_dead(Stk, Y+1, [{kill,{yy,Y}}|Instr], [free|StkAcc]); -free_dead([Any|Stk], Y, Instr, StkAcc) -> - free_dead(Stk, Y+1, Instr, [Any|StkAcc]); -free_dead([], _, Instr, StkAcc) -> {Instr,reverse(StkAcc)}. - -enter_cg(#k_var{} = Var, As, Le, Vdb, Bef, St0) -> - {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), - %% Build complete code and final stack/register state. - Arity = length(As), - {Sis ++ [line(Le),{call_fun,Arity},return], - clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), - need_stack_frame(St0)}; -enter_cg(#k_remote{mod=Mod,name=Name}, As, Le, Vdb, Bef, St0) - when is_record(Mod, k_var); is_record(Name, k_var) -> - {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), - %% Build complete code and final stack/register state. - Arity = length(As), - St = need_stack_frame(St0), - {Sis ++ [line(Le),{apply_only,Arity}], - clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), - St}; -enter_cg(Func, As, Le, Vdb, Bef, St0) -> - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - %% Build complete code and final stack/register state. - Arity = length(As), - {Call,St1} = build_enter(Func, Arity, St0), - Line = enter_line(Func, Arity, Le), - {Sis ++ Line ++ Call, - clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), - St1}. - -build_enter(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) -> - {[send,return],need_stack_frame(St0)}; -build_enter(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) -> - St1 = case trap_bif(Mod, Name, Arity) of - true -> need_stack_frame(St0); - false -> St0 - end, - {[{call_ext_only,Arity,{extfunc,Mod,Name,Arity}}],St1}; -build_enter(#k_local{name=Name}, Arity, St0) when is_atom(Name) -> - {Lbl,St1} = local_func_label(Name, Arity, St0), - {[{call_only,Arity,{f,Lbl}}],St1}. - -enter_line(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, Le) -> - case erl_bifs:is_safe(Mod, Name, Arity) of - false -> - %% Tail-recursive call, possibly to a BIF. - %% We'll need a line instruction in case the - %% BIF call fails. - [line(Le)]; - true -> - %% Call to a safe BIF. Since it cannot fail, - %% we don't need any line instruction here. - [] - end; -enter_line(_, _, _) -> - %% Tail-recursive call to a local function. A line - %% instruction will not be useful. - []. - -%% local_func_label(Name, Arity, State) -> {Label,State'} -%% local_func_label({Name,Arity}, State) -> {Label,State'} -%% Get the function entry label for a local function. - -local_func_label(Name, Arity, St) -> - local_func_label({Name,Arity}, St). - -local_func_label(Key, #cg{functable=Map}=St0) -> - case Map of - #{Key := Label} -> {Label,St0}; - _ -> - {Label,St} = new_label(St0), - {Label,St#cg{functable=Map#{Key => Label}}} - end. - -%% need_stack_frame(State) -> State' -%% Make a note in the state that this function will need a stack frame. - -need_stack_frame(#cg{need_frame=true}=St) -> St; -need_stack_frame(St) -> St#cg{need_frame=true}. - -%% trap_bif(Mod, Name, Arity) -> true|false -%% Trap bifs that need a stack frame. - -trap_bif(erlang, link, 1) -> true; -trap_bif(erlang, unlink, 1) -> true; -trap_bif(erlang, monitor_node, 2) -> true; -trap_bif(erlang, group_leader, 2) -> true; -trap_bif(erlang, exit, 2) -> true; -trap_bif(_, _, _) -> false. - -%% bif_cg(#k_bif{}, Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% Generate code a BIF. - -bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, Vdb, Bef, St) -> - internal_cg(Name, As, Rs, Le, Vdb, Bef, St); -bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, - args=As,ret=Rs}, Le, Vdb, Bef, St) -> - Ar = length(As), - case is_gc_bif(Name, Ar) of - false -> - bif_cg(Name, As, Rs, Le, Vdb, Bef, St); - true -> - gc_bif_cg(Name, As, Rs, Le, Vdb, Bef, St) - end. - -%% internal_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. - -internal_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) -> - [Src] = cg_reg_args([Src0], Bef), - {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}; -internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> - [New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef), - Index = Index1-1, - {[{set_tuple_element,New,Tuple,Index}], - clear_dead(Bef, Le#l.i, Vdb), St0}; -internal_cg(make_fun, [Func0,Arity0|As], Rs, Le, Vdb, Bef, St0) -> - %% This behaves more like a function call. - #k_atom{val=Func} = Func0, - #k_int{val=Arity} = Arity0, - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - {FuncLbl,St1} = local_func_label(Func, Arity, St0), - MakeFun = {make_fun2,{f,FuncLbl},0,0,length(As)}, - {Sis ++ [MakeFun], - clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb), - St1}; -internal_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) -> - %% This behaves like a function call. - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}; -internal_cg(build_stacktrace=I, As, Rs, Le, Vdb, Bef, St) -> - %% This behaves like a function call. - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}; -internal_cg(raise, As, Rs, Le, Vdb, Bef, St) -> - %% raise can be treated like a guard BIF. - bif_cg(raise, As, Rs, Le, Vdb, Bef, St); -internal_cg(guard_error, [ExitCall], _Rs, Le, Vdb, Bef, St) -> - %% A call an exit BIF from inside a #k_guard_match{}. - %% Generate a standard call, but leave the register descriptors - %% alone, effectively pretending that there was no call. - #k_call{op=#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, - args=As} = ExitCall, - Arity = length(As), - {Ms,_} = cg_call_args(As, Bef, Le#l.i, Vdb), - Call = {call_ext,Arity,{extfunc,Mod,Name,Arity}}, - Is = Ms++[line(Le),Call], - {Is,Bef,St}; -internal_cg(raw_raise=I, As, Rs, Le, Vdb, Bef, St) -> - %% This behaves like a function call. - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}. - -%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. - -bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) -> - Ars = cg_reg_args(As, Bef), - - %% If we are inside a catch and in a body (not in guard) and the - %% BIF may fail, we must save everything that will be alive after - %% the catch (because the code after the code assumes that all - %% variables that are live are stored on the stack). - %% - %% Currently, we are somewhat pessimistic in - %% that we save any variable that will be live after this BIF call. - - MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), - {Sis,Int0} = - case MayFail of - true -> - maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0); - false -> - {[],Bef} - end, - Int1 = clear_dead(Int0, Le#l.i, Vdb), - Reg = put_reg(V, Int1#sr.reg), - Int = Int1#sr{reg=Reg}, - Dst = fetch_reg(V, Reg), - BifFail = {f,St0#cg.bfail}, - %% We need a line instructions for BIFs that may fail in a body. - Line = case BifFail of - {f,0} when MayFail -> - [line(Le)]; - _ -> - [] - end, - {Sis++Line++[{bif,Bif,BifFail,Ars,Dst}], - clear_dead(Int, Le#l.i, Vdb), St0}. - - -%% gc_bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. - -gc_bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) -> - Ars = cg_reg_args(As, Bef), - - %% If we are inside a catch and in a body (not in guard) and the - %% BIF may fail, we must save everything that will be alive after - %% the catch (because the code after the code assumes that all - %% variables that are live are stored on the stack). - %% - %% Currently, we are somewhat pessimistic in - %% that we save any variable that will be live after this BIF call. - - {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), - - Int1 = clear_dead(Int0, Le#l.i, Vdb), - Reg = put_reg(V, Int1#sr.reg), - Int = Int1#sr{reg=Reg}, - Dst = fetch_reg(V, Reg), - BifFail = {f,St0#cg.bfail}, - Line = case BifFail of - {f,0} -> [line(Le)]; - {f,_} -> [] - end, - {Sis++Line++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}], - clear_dead(Int, Le#l.i, Vdb), St0}. - -%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, -%% [Ret], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. - -recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) -> - {Sis,Int0} = adjust_stack(Bef, Le#l.i, Le#l.i, Vdb), - Int1 = Int0#sr{reg=clear_regs(Int0#sr.reg)}, - %% Get labels. - {Rl,St1} = new_label(St0), - {Tl,St2} = new_label(St1), - {Bl,St3} = new_label(St2), - St4 = St3#cg{break=Bl,recv=Rl}, %Set correct receive labels - {Ris,Raft,St5} = cg_recv_mesg(Rvar, Rm, Tl, Int1, St4), - {Wis,Taft,St6} = cg_recv_wait(Te, Tes, Le#l.i, Int1, St5), - Int2 = sr_merge(Raft, Taft), %Merge stack/registers - Reg = load_vars(Rs, Int2#sr.reg), - {Sis ++ [line(Le)] ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], - clear_dead(Int2#sr{reg=Reg}, Le#l.i, Vdb), - St6#cg{break=St0#cg.break,recv=St0#cg.recv}}. - -%% cg_recv_mesg( ) -> {[Ainstr],Aft,St}. - -cg_recv_mesg(#k_var{name=R}, Rm, Tl, Bef, St0) -> - Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, - Ret = fetch_reg(R, Int0#sr.reg), - %% Int1 = clear_dead(Int0, I, Rm#l.vdb), - Int1 = Int0, - {Mis,Int2,St1} = match_cg(Rm, none, Int1, St0), - {[{label,St1#cg.recv},{loop_rec,{f,Tl},Ret}|Mis],Int2,St1}. - -%% cg_recv_wait(Te, Tes, I, Vdb, Int2, St3) -> {[Ainstr],Aft,St}. - -cg_recv_wait(#k_atom{val=infinity}, #cg_block{anno=Le,es=Tes}, I, Bef, St0) -> - %% We know that the 'after' body will never be executed. - %% But to keep the stack and register information up to date, - %% we will generate the code for the 'after' body, and then discard it. - Int1 = clear_dead(Bef, I, Le#l.vdb), - {_,Int2,St1} = cg_block(Tes, Le#l.vdb, - Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0), - {[{wait,{f,St1#cg.recv}}],Int2,St1}; -cg_recv_wait(#k_int{val=0}, #cg_block{anno=Le,es=Tes}, _I, Bef, St0) -> - {Tis,Int,St1} = cg_block(Tes, Le#l.vdb, Bef, St0), - {[timeout|Tis],Int,St1}; -cg_recv_wait(Te, #cg_block{anno=Le,es=Tes}, I, Bef, St0) -> - Reg = cg_reg_arg(Te, Bef), - %% Must have empty registers here! Bug if anything in registers. - Int0 = clear_dead(Bef, I, Le#l.vdb), - {Tis,Int,St1} = cg_block(Tes, Le#l.vdb, - Int0#sr{reg=clear_regs(Int0#sr.reg)}, St0), - {[{wait_timeout,{f,St1#cg.recv},Reg},timeout] ++ Tis,Int,St1}. - -%% recv_next_cg(Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. -%% Use adjust stack to clear stack, but only need it for Aft. - -recv_next_cg(Le, Vdb, Bef, St) -> - {Sis,Aft} = adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb), - {[{loop_rec_end,{f,St#cg.recv}}] ++ Sis,Aft,St}. %Joke - -%% try_cg(TryBlock, [BodyVar], TryBody, [ExcpVar], TryHandler, [Ret], -%% Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. - -try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) -> - {B,St1} = new_label(St0), %Body label - {H,St2} = new_label(St1), %Handler label - {E,St3} = new_label(St2), %End label - #l{i=TryTag} = get_kanno(Ta), - Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)}, - TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk), - {Ais,Int2,St4} = cg(Ta, Vdb, Int1, St3#cg{break=B,in_catch=true}), - Int3 = Int2#sr{stk=drop_catch(TryTag, Int2#sr.stk)}, - St5 = St4#cg{break=E,in_catch=St3#cg.in_catch}, - {Bis,Baft,St6} = cg(Tb, Vdb, Int3#sr{reg=load_vars(Vs, Int3#sr.reg)}, St5), - {His,Haft,St7} = cg(Th, Vdb, Int3#sr{reg=load_vars(Evs, Int3#sr.reg)}, St6), - Int4 = sr_merge(Baft, Haft), %Merge stack/registers - Aft = Int4#sr{reg=load_vars(Rs, Int4#sr.reg)}, - {[{'try',TryReg,{f,H}}] ++ Ais ++ - [{label,B},{try_end,TryReg}] ++ Bis ++ - [{label,H},{try_case,TryReg}] ++ His ++ - [{label,E}], - clear_dead(Aft, Le#l.i, Vdb), - St7#cg{break=St0#cg.break}}. - -try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) -> - {B,St1} = new_label(St0), %Body label - {H,St2} = new_label(St1), %Handler label - #l{i=TryTag} = get_kanno(Ta), - Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)}, - TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk), - {Ais,Int2,St3} = cg(Ta, Vdb, Int1, St2#cg{break=B,in_catch=true}), - Int3 = Int2#sr{stk=drop_catch(TryTag, Int2#sr.stk)}, - St4 = St3#cg{in_catch=St2#cg.in_catch}, - {Bis,Baft,St5} = cg(Tb, Vdb, Int3#sr{reg=load_vars(Vs, Int3#sr.reg)}, St4), - {His,Haft,St6} = cg(Th, Vdb, Int3#sr{reg=load_vars(Evs, Int3#sr.reg)}, St5), - Int4 = sr_merge(Baft, Haft), %Merge stack/registers - Aft = Int4, - {[{'try',TryReg,{f,H}}] ++ Ais ++ - [{label,B},{try_end,TryReg}] ++ Bis ++ - [{label,H},{try_case,TryReg}] ++ His, - clear_dead(Aft, Le#l.i, Vdb), - St6#cg{break=St0#cg.break}}. - -%% catch_cg(CatchBlock, Ret, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. - -catch_cg(#cg_block{es=C}, #k_var{name=R}, Le, Vdb, Bef, St0) -> - {B,St1} = new_label(St0), - CatchTag = Le#l.i, - Int1 = Bef#sr{stk=put_catch(CatchTag, Bef#sr.stk)}, - CatchReg = fetch_stack({catch_tag,CatchTag}, Int1#sr.stk), - {Cis,Int2,St2} = cg_block(C, Le#l.vdb, Int1, - St1#cg{break=B,in_catch=true}), - [] = Int2#sr.reg, %Assertion. - Aft = Int2#sr{reg=[{0,R}],stk=drop_catch(CatchTag, Int2#sr.stk)}, - {[{'catch',CatchReg,{f,B}}] ++ Cis ++ - [{label,B},{catch_end,CatchReg}], - clear_dead(Aft, Le#l.i, Vdb), - St2#cg{break=St1#cg.break,in_catch=St1#cg.in_catch}}. - -%% put_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% We have to be careful how a 'put' works. First the structure is -%% built, then it is filled and finally things can be cleared. The -%% annotation must reflect this and make sure that the return -%% variable is allocated first. -%% -%% put_list and put_map are atomic instructions, both of -%% which can safely resuse one of the source registers as target. - -put_cg([#k_var{name=R}], #k_cons{hd=Hd,tl=Tl}, Le, Vdb, Bef, St) -> - [S1,S2] = cg_reg_args([Hd,Tl], Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, - Ret = fetch_reg(R, Int1#sr.reg), - {[{put_list,S1,S2,Ret}], Int1, St}; -put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, Vdb, Bef, - #cg{bfail=Bfail}=St) -> - %% At run-time, binaries are constructed in three stages: - %% 1) First the size of the binary is calculated. - %% 2) Then the binary is allocated. - %% 3) Then each field in the binary is constructed. - %% For simplicity, we use the target register to also hold the - %% size of the binary. Therefore the target register must *not* - %% be one of the source registers. - - %% First allocate the target register. - Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, - Target = fetch_reg(R, Int0#sr.reg), - - %% Also allocate a scratch register for size calculations. - Temp = find_scratch_reg(Int0#sr.reg), - - %% First generate the code that constructs each field. - Fail = {f,Bfail}, - PutCode = cg_bin_put(Segs, Fail, Bef), - {Sis,Int1} = maybe_adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb, St), - MaxRegs = max_reg(Bef#sr.reg), - Aft = clear_dead(Int1, Le#l.i, Vdb), - - %% Now generate the complete code for constructing the binary. - Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), - {Sis++Code,Aft,St}; - -%% Map: single variable key. -put_cg([#k_var{name=R}], #k_map{op=Op,var=Map, - es=[#k_map_pair{key=#k_var{}=K,val=V}]}, - Le, Vdb, Bef, St0) -> - {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), - - SrcReg = cg_reg_arg_prefer_y(Map, Int0), - Line = line(Le#l.a), - - List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], - - Live = max_reg(Bef#sr.reg), - - %% The target register can reuse one of the source registers. - Aft0 = clear_dead(Int0, Le#l.i, Vdb), - Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, - Target = fetch_reg(R, Aft#sr.reg), - - {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0), - {Sis++Is,Aft,St1}; - -%% Map: (possibly) multiple literal keys. -put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,es=Es}, Le, Vdb, Bef, St0) -> - - %% assert key literals - [] = [Var || #k_map_pair{key=#k_var{}=Var} <- Es], - - {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), - SrcReg = cg_reg_arg_prefer_y(Map, Int0), - Line = line(Le#l.a), - - %% fetch registers for values to be put into the map - List = flatmap(fun(#k_map_pair{key=K,val=V}) -> - [atomic(K),cg_reg_arg(V, Int0)] - end, Es), - - Live = max_reg(Bef#sr.reg), - - %% The target register can reuse one of the source registers. - Aft0 = clear_dead(Int0, Le#l.i, Vdb), - Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, - Target = fetch_reg(R, Aft#sr.reg), - - {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0), - {Sis++Is,Aft,St1}; - -%% Everything else. -put_cg([#k_var{name=R}], Con, Le, Vdb, Bef, St) -> - %% Find a place for the return register first. - Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, - Ret = fetch_reg(R, Int#sr.reg), - Ais = case Con of - #k_tuple{es=Es} -> - [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef); - Other -> - [{move,cg_reg_arg(Other, Int),Ret}] - end, - {Ais,clear_dead(Int, Le#l.i, Vdb),St}. - - -put_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) -> - Bfail = St0#cg.bfail, - Fail = {f,St0#cg.bfail}, - Op = case Op0 of - assoc -> put_map_assoc; - exact -> put_map_exact - end, - {OkLbl,St1} = new_label(St0), - {BadLbl,St2} = new_label(St1), - Is = if - Bfail =:= 0 orelse Op =:= put_map_assoc -> - [Line,{Op,{f,0},SrcReg,Target,Live,{list,List}}]; - true -> - %% Ensure that Target is always set, even if - %% the map update operation fails. That is necessary - %% because Target may be included in a test_heap - %% instruction. - [Line, - {Op,{f,BadLbl},SrcReg,Target,Live,{list,List}}, - {jump,{f,OkLbl}}, - {label,BadLbl}, - {move,{atom,ok},Target}, - {jump,Fail}, - {label,OkLbl}] - end, - {Is,St2}. - -%%% -%%% Code generation for constructing binaries. -%%% - -cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode], - Target, Temp, Fail, MaxRegs, Anno) -> - Line = line(Anno), - Live = cg_live(Target, MaxRegs), - SzCode = cg_bitstr_size(PutCode, Target, Temp, Fail, Live), - BinFlags = {field_flags,[]}, - Code = [Line|SzCode] ++ - [case member(single_use, Anno) of - true -> - {bs_private_append,Fail,Target,U,Src,BinFlags,Target}; - false -> - {bs_append,Fail,Target,0,MaxRegs,U,Src,BinFlags,Target} - end] ++ PutCode, - cg_bin_opt(Code); -cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Anno) -> - Line = line(Anno), - Live = cg_live(Target, MaxRegs), - {InitOp,SzCode} = cg_binary_size(PutCode, Target, Temp, Fail, Live), - - Code = [Line|SzCode] ++ [{InitOp,Fail,Target,0,MaxRegs, - {field_flags,[]},Target}|PutCode], - cg_bin_opt(Code). - -cg_live({x,X}, MaxRegs) when X =:= MaxRegs -> MaxRegs+1; -cg_live({x,X}, MaxRegs) when X < MaxRegs -> MaxRegs. - -%% Generate code that calculate the size of the bitstr to be -%% built in BITS. - -cg_bitstr_size(PutCode, Target, Temp, Fail, Live) -> - {Bits,Es} = cg_bitstr_size_1(PutCode, 0, []), - reverse(cg_gen_binsize(Es, Target, Temp, Fail, Live, - [{move,{integer,Bits},Target}])). - -cg_bitstr_size_1([{bs_put_utf8,_,_,Src}|Next], Bits, Acc) -> - cg_bitstr_size_1(Next, Bits, [{'*',{bs_utf8_size,Src},8}|Acc]); -cg_bitstr_size_1([{bs_put_utf16,_,_,Src}|Next], Bits, Acc) -> - cg_bitstr_size_1(Next, Bits, [{'*',{bs_utf16_size,Src},8}|Acc]); -cg_bitstr_size_1([{bs_put_utf32,_,_,_}|Next], Bits, Acc) -> - cg_bitstr_size_1(Next, Bits+32, Acc); -cg_bitstr_size_1([{_,_,S,U,_,Src}|Next], Bits, Acc) -> - case S of - {integer,N} -> cg_bitstr_size_1(Next, Bits+N*U, Acc); - {atom,all} -> cg_bitstr_size_1(Next, Bits, [{bit_size,Src}|Acc]); - _ when U =:= 1 -> cg_bitstr_size_1(Next, Bits, [S|Acc]); - _ -> cg_bitstr_size_1(Next, Bits, [{'*',S,U}|Acc]) - end; -cg_bitstr_size_1([], Bits, Acc) -> {Bits,Acc}. - -%% Generate code that calculate the size of the bitstr to be -%% built in BYTES or BITS (depending on what is easiest). - -cg_binary_size(PutCode, Target, Temp, Fail, Live) -> - {InitInstruction,Szs} = cg_binary_size_1(PutCode, 0, []), - SizeExpr = reverse(cg_gen_binsize(Szs, Target, Temp, Fail, Live, [{move,{integer,0},Target}])), - {InitInstruction,SizeExpr}. - -cg_binary_size_1([{bs_put_utf8,_Fail,_Flags,Src}|T], Bits, Acc) -> - cg_binary_size_1(T, Bits, [{8,{bs_utf8_size,Src}}|Acc]); -cg_binary_size_1([{bs_put_utf16,_Fail,_Flags,Src}|T], Bits, Acc) -> - cg_binary_size_1(T, Bits, [{8,{bs_utf16_size,Src}}|Acc]); -cg_binary_size_1([{bs_put_utf32,_Fail,_Flags,_Src}|T], Bits, Acc) -> - cg_binary_size_1(T, Bits+32, Acc); -cg_binary_size_1([{_Put,_Fail,S,U,_Flags,Src}|T], Bits, Acc) -> - cg_binary_size_2(S, U, Src, T, Bits, Acc); -cg_binary_size_1([], Bits, Acc) -> - Bytes = Bits div 8, - RemBits = Bits rem 8, - Sizes0 = sort([{1,{integer,RemBits}},{8,{integer,Bytes}}|Acc]), - Sizes = filter(fun({_,{integer,0}}) -> false; - (_) -> true end, Sizes0), - case Sizes of - [{1,_}|_] -> - {bs_init_bits,cg_binary_bytes_to_bits(Sizes, [])}; - [{8,_}|_] -> - {bs_init2,[E || {8,E} <- Sizes]}; - [] -> - {bs_init_bits,[]} - end. - -cg_binary_size_2({integer,N}, U, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits+N*U, Acc); -cg_binary_size_2({atom,all}, U, E, Next, Bits, Acc) -> - if - U rem 8 =:= 0 -> - cg_binary_size_1(Next, Bits, [{8,{byte_size,E}}|Acc]); - true -> - cg_binary_size_1(Next, Bits, [{1,{bit_size,E}}|Acc]) - end; -cg_binary_size_2(Reg, 1, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{1,Reg}|Acc]); -cg_binary_size_2(Reg, 8, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{8,Reg}|Acc]); -cg_binary_size_2(Reg, U, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{1,{'*',Reg,U}}|Acc]). - -cg_binary_bytes_to_bits([{8,{integer,N}}|T], Acc) -> - cg_binary_bytes_to_bits(T, [{integer,8*N}|Acc]); -cg_binary_bytes_to_bits([{8,{byte_size,Reg}}|T], Acc) -> - cg_binary_bytes_to_bits(T, [{bit_size,Reg}|Acc]); -cg_binary_bytes_to_bits([{8,Reg}|T], Acc) -> - cg_binary_bytes_to_bits(T, [{'*',Reg,8}|Acc]); -cg_binary_bytes_to_bits([{1,Sz}|T], Acc) -> - cg_binary_bytes_to_bits(T, [Sz|Acc]); -cg_binary_bytes_to_bits([], Acc) -> - cg_binary_bytes_to_bits_1(sort(Acc)). - -cg_binary_bytes_to_bits_1([{integer,I},{integer,J}|T]) -> - cg_binary_bytes_to_bits_1([{integer,I+J}|T]); -cg_binary_bytes_to_bits_1([H|T]) -> - [H|cg_binary_bytes_to_bits_1(T)]; -cg_binary_bytes_to_bits_1([]) -> []. - -cg_gen_binsize([{'*',{bs_utf8_size,Src},B}|T], Target, Temp, Fail, Live, Acc) -> - Size = {bs_utf8_size,Fail,Src,Temp}, - Add = {bs_add,Fail,[Target,Temp,B],Target}, - cg_gen_binsize(T, Target, Temp, Fail, Live, - [Add,Size|Acc]); -cg_gen_binsize([{'*',{bs_utf16_size,Src},B}|T], Target, Temp, Fail, Live, Acc) -> - Size = {bs_utf16_size,Fail,Src,Temp}, - Add = {bs_add,Fail,[Target,Temp,B],Target}, - cg_gen_binsize(T, Target, Temp, Fail, Live, - [Add,Size|Acc]); -cg_gen_binsize([{'*',A,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize(T, Target, Temp, Fail, Live, - [{bs_add,Fail,[Target,A,B],Target}|Acc]); -cg_gen_binsize([{bit_size,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, Live, - [{gc_bif,bit_size,Fail,Live,[B],Temp}|Acc]); -cg_gen_binsize([{byte_size,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, Live, - [{gc_bif,byte_size,Fail,Live,[B],Temp}|Acc]); -cg_gen_binsize([{bs_utf8_size,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, Live, - [{bs_utf8_size,Fail,B,Temp}|Acc]); -cg_gen_binsize([{bs_utf16_size,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, Live, - [{bs_utf16_size,Fail,B,Temp}|Acc]); -cg_gen_binsize([E0|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize(T, Target, Temp, Fail, Live, - [{bs_add,Fail,[Target,E0,1],Target}|Acc]); -cg_gen_binsize([], _, _, _, _, Acc) -> Acc. - - -%% cg_bin_opt(Code0) -> Code -%% Optimize the size calculations for binary construction. - -cg_bin_opt([{move,S1,{x,X}=D},{gc_bif,Op,Fail,Live0,As,Dst}|Is]) -> - Live = if - X + 1 =:= Live0 -> X; - true -> Live0 - end, - [{gc_bif,Op,Fail,Live,As,D}|cg_bin_opt([{move,S1,Dst}|Is])]; -cg_bin_opt([{move,_,_}=I1,{Op,_,_,_}=I2|Is]) - when Op =:= bs_utf8_size orelse Op =:= bs_utf16_size -> - [I2|cg_bin_opt([I1|Is])]; -cg_bin_opt([{bs_add,_,[{integer,0},Src,1],Dst}|Is]) -> - cg_bin_opt_1([{move,Src,Dst}|Is]); -cg_bin_opt([{bs_add,_,[Src,{integer,0},_],Dst}|Is]) -> - cg_bin_opt_1([{move,Src,Dst}|Is]); -cg_bin_opt(Is) -> - cg_bin_opt_1(Is). - -cg_bin_opt_1([{move,Size,D},{bs_append,Fail,D,Extra,Regs,U,Bin,Flags,D}|Is]) -> - [{bs_append,Fail,Size,Extra,Regs,U,Bin,Flags,D}|cg_bin_opt(Is)]; -cg_bin_opt_1([{move,Size,D},{bs_private_append,Fail,D,U,Bin,Flags,D}|Is]) -> - [{bs_private_append,Fail,Size,U,Bin,Flags,D}|cg_bin_opt(Is)]; -cg_bin_opt_1([{move,Size,D},{Op,Fail,D,Extra,Regs,Flags,D}|Is]) - when Op =:= bs_init2; Op =:= bs_init_bits -> - Bytes = case Size of - {integer,Int} -> Int; - _ -> Size - end, - [{Op,Fail,Bytes,Extra,Regs,Flags,D}|cg_bin_opt(Is)]; -cg_bin_opt_1([{move,S1,D},{bs_add,Fail,[D,S2,U],Dst}|Is]) -> - cg_bin_opt([{bs_add,Fail,[S1,S2,U],Dst}|Is]); -cg_bin_opt_1([{move,S1,D},{bs_add,Fail,[S2,D,U],Dst}|Is]) -> - cg_bin_opt([{bs_add,Fail,[S2,S1,U],Dst}|Is]); -cg_bin_opt_1([I|Is]) -> - [I|cg_bin_opt(Is)]; -cg_bin_opt_1([]) -> - []. - -cg_bin_put(#k_bin_seg{size=S0,unit=U,type=T,flags=Fs,seg=E0,next=Next}, - Fail, Bef) -> - S1 = cg_reg_arg(S0, Bef), - E1 = cg_reg_arg(E0, Bef), - {Format,Op} = case T of - integer -> {plain,bs_put_integer}; - utf8 -> {utf,bs_put_utf8}; - utf16 -> {utf,bs_put_utf16}; - utf32 -> {utf,bs_put_utf32}; - binary -> {plain,bs_put_binary}; - float -> {plain,bs_put_float} - end, - case Format of - plain -> - [{Op,Fail,S1,U,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)]; - utf -> - [{Op,Fail,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)] - end; -cg_bin_put(#k_bin_end{}, _, _) -> []. - -cg_build_args(As, Bef) -> - [{put,cg_reg_arg(A, Bef)} || A <- As]. - -%% return_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% break_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% These are very simple, just put return/break values in registers -%% from 0, then return/break. Use the call setup to clean up stack, -%% but must clear registers to ensure sr_merge works correctly. - -return_cg(Rs, Le, Vdb, Bef, St) -> - {Ms,Int} = cg_setup_call(Rs, Bef, Le#l.i, Vdb), - {Ms ++ [return],Int#sr{reg=clear_regs(Int#sr.reg)},St}. - -break_cg(Bs, Le, Vdb, Bef, St) -> - {Ms,Int} = cg_setup_call(Bs, Bef, Le#l.i, Vdb), - {Ms ++ [{jump,{f,St#cg.break}}], - Int#sr{reg=clear_regs(Int#sr.reg)},St}. - -guard_break_cg(Bs, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) -> - #sr{reg=Reg1} = Int = clear_dead(Bef, I, Vdb), - Reg2 = trim_free(Reg1), - NumLocked = length(Reg2), - Moves0 = gen_moves(Bs, Bef, NumLocked, []), - Moves = order_moves(Moves0, find_scratch_reg(Reg0)), - {BreakVars,_} = mapfoldl(fun(_, RegNum) -> - {{RegNum,gbreakvar},RegNum+1} - end, length(Reg2), Bs), - Reg = Reg2 ++ BreakVars, - Aft = Int#sr{reg=Reg}, - {Moves ++ [{jump,{f,St#cg.break}}],Aft,St}. - -%% cg_reg_arg(Arg0, Info) -> Arg -%% cg_reg_args([Arg0], Info) -> [Arg] -%% Convert argument[s] into registers. Literal values are returned unchanged. - -cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As]. - -cg_reg_arg(#k_var{name=V}, Bef) -> fetch_var(V, Bef); -cg_reg_arg(Literal, _) -> atomic(Literal). - -cg_reg_arg_prefer_y(#k_var{name=V}, Bef) -> fetch_var_prefer_y(V, Bef); -cg_reg_arg_prefer_y(Literal, _) -> atomic(Literal). - -%% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}. -%% Do the complete setup for a call/enter. - -cg_setup_call(As, Bef, I, Vdb) -> - {Ms,Int0} = cg_call_args(As, Bef, I, Vdb), - %% Have set up arguments, can now clean up, compress and save to stack. - Int1 = Int0#sr{stk=clear_dead_stk(Int0#sr.stk, I, Vdb),res=[]}, - {Sis,Int2} = adjust_stack(Int1, I, I+1, Vdb), - {Ms ++ Sis,Int2}. - -%% cg_call_args([Arg], SrState) -> {[Instr],SrState}. -%% Setup the arguments to a call/enter/bif. Put the arguments into -%% consecutive registers starting at {x,0} moving any data which -%% needs to be saved. Return a modified SrState structure with the -%% new register contents. N.B. the resultant register info will -%% contain non-variable values when there are non-variable values. -%% -%% This routine is complicated by unsaved values in x registers. -%% We'll move away any unsaved values that are in the registers -%% to be overwritten by the arguments. - -cg_call_args(As, Bef, I, Vdb) -> - Regs0 = load_arg_regs(Bef#sr.reg, As), - Unsaved = unsaved_registers(Regs0, Bef#sr.stk, I, I+1, Vdb), - {UnsavedMoves,Regs} = move_unsaved(Unsaved, Bef#sr.reg, Regs0), - Moves0 = gen_moves(As, Bef), - Moves = order_moves(Moves0, find_scratch_reg(Regs)), - {UnsavedMoves ++ Moves,Bef#sr{reg=Regs}}. - -%% load_arg_regs([Reg], Arguments) -> [Reg] -%% Update the register descriptor to include the arguments (from {x,0} -%% and upwards). Values in argument register are overwritten. -%% Values in x registers above the arguments are preserved. - -load_arg_regs(Regs, As) -> load_arg_regs(Regs, As, 0). - -load_arg_regs([_|Rs], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)]; -load_arg_regs([_|Rs], [A|As], I) -> [{I,A}|load_arg_regs(Rs, As, I+1)]; -load_arg_regs([], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)]; -load_arg_regs([], [A|As], I) -> [{I,A}|load_arg_regs([], As, I+1)]; -load_arg_regs(Rs, [], _) -> Rs. - -%% Returns the variables must be saved and are currently in the -%% x registers that are about to be overwritten by the arguments. - -unsaved_registers(Regs, Stk, Fb, Lf, Vdb) -> - [V || {V,F,L} <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk), - not in_reg(V, Regs)]. - -in_reg(V, Regs) -> keymember(V, 2, Regs). - -%% Move away unsaved variables from the registers that are to be -%% overwritten by the arguments. -move_unsaved(Vs, OrigRegs, NewRegs) -> - move_unsaved(Vs, OrigRegs, NewRegs, []). - -move_unsaved([V|Vs], OrigRegs, NewRegs0, Acc) -> - NewRegs = put_reg(V, NewRegs0), - Src = fetch_reg(V, OrigRegs), - Dst = fetch_reg(V, NewRegs), - move_unsaved(Vs, OrigRegs, NewRegs, [{move,Src,Dst}|Acc]); -move_unsaved([], _, Regs, Acc) -> {Acc,Regs}. - -%% gen_moves(As, Sr) -%% Generate the basic move instruction to move the arguments -%% to their proper registers. The list will be sorted on -%% destinations. (I.e. the move to {x,0} will be first -- -%% see the comment to order_moves/2.) - -gen_moves(As, Sr) -> gen_moves(As, Sr, 0, []). - -gen_moves([#k_var{name=V}|As], Sr, I, Acc) -> - case fetch_var(V, Sr) of - {x,I} -> gen_moves(As, Sr, I+1, Acc); - Reg -> gen_moves(As, Sr, I+1, [{move,Reg,{x,I}}|Acc]) - end; -gen_moves([A0|As], Sr, I, Acc) -> - A = atomic(A0), - gen_moves(As, Sr, I+1, [{move,A,{x,I}}|Acc]); -gen_moves([], _, _, Acc) -> lists:keysort(3, Acc). - -%% order_moves([Move], ScratchReg) -> [Move] -%% Orders move instruction so that source registers are not -%% destroyed before they are used. If there are cycles -%% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}), -%% the scratch register is used to break up the cycle. -%% If possible, the first move of the input list is placed -%% last in the result list (to make the move to {x,0} occur -%% just before the call to allow the Beam loader to coalesce -%% the instructions). - -order_moves(Ms, Scr) -> order_moves(Ms, Scr, []). - -order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) -> - {Chain,Ms} = collect_chain(Ms0, [M], ScrReg), - Acc = reverse(Chain, Acc0), - order_moves(Ms, ScrReg, Acc); -order_moves([], _, Acc) -> Acc. - -collect_chain(Ms, Path, ScrReg) -> - collect_chain(Ms, Path, [], ScrReg). - -collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) -> - case lists:keyfind(Src, 3, Path) of - false -> - collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg); - _ -> % We have a cycle. - {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)} - end; -collect_chain([M|Ms], Path, Others, ScrReg) -> - collect_chain(Ms, Path, [M|Others], ScrReg); -collect_chain([], Path, Others, _) -> - {Path,Others}. - -break_up_cycle({move,Src,_}=M, Path, ScrReg) -> - [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)]. - -break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) -> - [{move,Src,ScrReg}|Path]; -break_up_cycle1(Dst, [M|Path], LastMove) -> - [M|break_up_cycle1(Dst, Path, LastMove)]. - -%% clear_dead(Sr, Until, Vdb) -> Aft. -%% Remove all variables in Sr which have died AT ALL so far. - -clear_dead(#sr{stk=Stk}=Sr0, Until, Vdb) -> - Sr = Sr0#sr{reg=clear_dead_reg(Sr0, Until, Vdb), - stk=clear_dead_stk(Stk, Until, Vdb)}, - reserve(Sr). - -clear_dead_reg(Sr, Until, Vdb) -> - [case R of - {_I,V} = IV -> - case vdb_find(V, Vdb) of - {V,_,L} when L > Until -> IV; - _ -> free %Remove anything else - end; - {reserved,_I,_V}=Reserved -> Reserved; - free -> free - end || R <- Sr#sr.reg]. - -clear_dead_stk(Stk, Until, Vdb) -> - [case S of - {V} = T -> - case vdb_find(V, Vdb) of - {V,_,L} when L > Until -> T; - _ -> dead %Remove anything else - end; - free -> free; - dead -> dead - end || S <- Stk]. - - -%% sr_merge(Sr1, Sr2) -> Sr. -%% Merge two stack/register states keeping the longest of both stack -%% and register. Perform consistency check on both, elements must be -%% the same. Allow frame size 'void' to make easy creation of -%% "empty" frame. - -sr_merge(#sr{reg=R1,stk=S1,res=[]}, #sr{reg=R2,stk=S2,res=[]}) -> - #sr{reg=longest(R1, R2),stk=longest(S1, S2),res=[]}; -sr_merge(void, S2) -> S2#sr{res=[]}. - -longest([H|T1], [H|T2]) -> [H|longest(T1, T2)]; -longest([dead|T1], [free|T2]) -> [dead|longest(T1, T2)]; -longest([free|T1], [dead|T2]) -> [dead|longest(T1, T2)]; -longest([dead|_] = L, []) -> L; -longest([], [dead|_] = L) -> L; -longest([free|_] = L, []) -> L; -longest([], [free|_] = L) -> L; -longest([], []) -> []. - -trim_free([R|Rs0]) -> - case {trim_free(Rs0),R} of - {[],free} -> []; - {Rs,R} -> [R|Rs] - end; -trim_free([]) -> []. - -%% maybe_adjust_stack(Bef, FirstBefore, LastFrom, Vdb, St) -> {[Ainstr],Aft}. -%% Adjust the stack, but only if the code is inside a catch and not -%% inside a guard. Use this funtion before instructions that may -%% cause an exception. - -maybe_adjust_stack(Bef, Fb, Lf, Vdb, St) -> - case St of - #cg{in_catch=true,bfail=0} -> - adjust_stack(Bef, Fb, Lf, Vdb); - #cg{} -> - {[],Bef} - end. - -%% adjust_stack(Bef, FirstBefore, LastFrom, Vdb) -> {[Ainstr],Aft}. -%% Do complete stack adjustment by compressing stack and adding -%% variables to be saved. Try to optimise ordering on stack by -%% having reverse order to their lifetimes. -%% -%% In Beam, there is a fixed stack frame and no need to do stack compression. - -adjust_stack(Bef, Fb, Lf, Vdb) -> - Stk0 = Bef#sr.stk, - {Stk1,Saves} = save_stack(Stk0, Fb, Lf, Vdb), - {saves(Saves, Bef#sr.reg, Stk1), - Bef#sr{stk=Stk1}}. - -%% save_stack(Stack, FirstBefore, LastFrom, Vdb) -> {[SaveVar],NewStack}. -%% Save variables which are used past current point and which are not -%% already on the stack. - -save_stack(Stk0, Fb, Lf, Vdb) -> - %% New variables that are in use but not on stack. - New = new_not_on_stack(Stk0, Fb, Lf, Vdb), - - %% Add new variables that are not just dropped immediately. - %% N.B. foldr works backwards from the end!! - Saves = [V || {V,_,_} <- keysort(3, New)], - Stk1 = foldr(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves), - {Stk1,Saves}. - -%% new_not_on_stack(Stack, FirstBefore, LastFrom, Vdb) -> -%% [{Variable,First,Last}] -%% Return information about all variables that are used past current -%% point and that are not already on the stack. - -new_not_on_stack(Stk, Fb, Lf, Vdb) -> - [VFL || {V,F,L} = VFL <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk)]. - -%% saves([SaveVar], Reg, Stk) -> [{move,Reg,Stk}]. -%% Generate move instructions to save variables onto stack. The -%% stack/reg info used is that after the new stack has been made. - -saves(Ss, Reg, Stk) -> - [{move,fetch_reg(V, Reg),fetch_stack(V, Stk)} || V <- Ss]. - -%% fetch_var(VarName, StkReg) -> r{R} | sp{Sp}. -%% find_var(VarName, StkReg) -> ok{r{R} | sp{Sp}} | error. -%% Fetch/find a variable in either the registers or on the -%% stack. Fetch KNOWS it's there. - -fetch_var(V, Sr) -> - case find_reg(V, Sr#sr.reg) of - {ok,R} -> R; - error -> fetch_stack(V, Sr#sr.stk) - end. - -fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) -> - case find_stack(V, Stk) of - {ok,R} -> R; - error -> fetch_reg(V, Reg) - end. - -load_vars(Vs, Regs) -> - foldl(fun (#k_var{name=V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). - -%% put_reg(Val, Regs) -> Regs. -%% find_reg(Val, Regs) -> {ok,r{R}} | error. -%% fetch_reg(Val, Regs) -> r{R}. -%% Functions to interface the registers. - -% put_regs(Vs, Rs) -> foldl(fun put_reg/2, Rs, Vs). - -put_reg(V, Rs) -> put_reg_1(V, Rs, 0). - -put_reg_1(V, [free|Rs], I) -> [{I,V}|Rs]; -put_reg_1(V, [{reserved,I,V}|Rs], I) -> [{I,V}|Rs]; -put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)]; -put_reg_1(V, [], I) -> [{I,V}]. - -fetch_reg(V, [{I,V}|_]) -> {x,I}; -fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). - -find_reg(V, [{I,V}|_]) -> {ok,{x,I}}; -find_reg(V, [_|SRs]) -> find_reg(V, SRs); -find_reg(_, []) -> error. - -%% For the bit syntax, we need a scratch register if we are constructing -%% a binary that will not be used. - -find_scratch_reg(Rs) -> find_scratch_reg(Rs, 0). - -find_scratch_reg([free|_], I) -> {x,I}; -find_scratch_reg([_|Rs], I) -> find_scratch_reg(Rs, I+1); -find_scratch_reg([], I) -> {x,I}. - -replace_reg_contents(Old, New, [{I,Old}|Rs]) -> [{I,New}|Rs]; -replace_reg_contents(Old, New, [R|Rs]) -> [R|replace_reg_contents(Old, New, Rs)]. - -%%clear_regs(Regs) -> map(fun (R) -> free end, Regs). -clear_regs(_) -> []. - -max_reg(Regs) -> - foldl(fun ({I,_}, _) -> I; - (_, Max) -> Max end, - -1, Regs) + 1. - -%% put_stack(Val, [{Val}]) -> [{Val}]. -%% fetch_stack(Var, Stk) -> sp{S}. -%% find_stack(Var, Stk) -> ok{sp{S}} | error. -%% Functions to interface the stack. - -put_stack(Val, []) -> [{Val}]; -put_stack(Val, [dead|Stk]) -> [{Val}|Stk]; -put_stack(Val, [free|Stk]) -> [{Val}|Stk]; -put_stack(Val, [NotFree|Stk]) -> [NotFree|put_stack(Val, Stk)]. - -put_stack_carefully(Val, Stk0) -> - try - put_stack_carefully1(Val, Stk0) - catch - throw:error -> - error - end. - -put_stack_carefully1(_, []) -> throw(error); -put_stack_carefully1(Val, [dead|Stk]) -> [{Val}|Stk]; -put_stack_carefully1(Val, [free|Stk]) -> [{Val}|Stk]; -put_stack_carefully1(Val, [NotFree|Stk]) -> - [NotFree|put_stack_carefully1(Val, Stk)]. - -fetch_stack(Var, Stk) -> fetch_stack(Var, Stk, 0). - -fetch_stack(V, [{V}|_], I) -> {yy,I}; -fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1). - -find_stack(Var, Stk) -> find_stack(Var, Stk, 0). - -find_stack(V, [{V}|_], I) -> {ok,{yy,I}}; -find_stack(V, [_|Stk], I) -> find_stack(V, Stk, I+1); -find_stack(_, [], _) -> error. - -on_stack(V, Stk) -> keymember(V, 1, Stk). - -%% put_catch(CatchTag, Stack) -> Stack' -%% drop_catch(CatchTag, Stack) -> Stack' -%% Special interface for putting and removing catch tags, to ensure that -%% catches nest properly. Also used for try tags. - -put_catch(Tag, Stk0) -> put_catch(Tag, reverse(Stk0), []). - -put_catch(Tag, [], Stk) -> - put_stack({catch_tag,Tag}, Stk); -put_catch(Tag, [{{catch_tag,_}}|_]=RevStk, Stk) -> - reverse(RevStk, put_stack({catch_tag,Tag}, Stk)); -put_catch(Tag, [Other|Stk], Acc) -> - put_catch(Tag, Stk, [Other|Acc]). - -drop_catch(Tag, [{{catch_tag,Tag}}|Stk]) -> [free|Stk]; -drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)]. - -%% atomic(Klit) -> Lit. -%% atomic_list([Klit]) -> [Lit]. - -atomic(#k_literal{val=V}) -> {literal,V}; -atomic(#k_int{val=I}) -> {integer,I}; -atomic(#k_float{val=F}) -> {float,F}; -atomic(#k_atom{val=A}) -> {atom,A}; -%%atomic(#k_char{val=C}) -> {char,C}; -atomic(#k_nil{}) -> nil. - -%% new_label(St) -> {L,St}. - -new_label(#cg{lcount=Next}=St) -> - {Next,St#cg{lcount=Next+1}}. - -%% line(Le) -> {line,[] | {location,File,Line}} -%% Create a line instruction, containing information about -%% the current filename and line number. A line information -%% instruction should be placed before any operation that could -%% cause an exception. - -line(#l{a=Anno}) -> - line(Anno); -line([Line,{file,Name}]) when is_integer(Line) -> - line_1(Name, Line); -line([_|_]=A) -> - {Name,Line} = find_loc(A, no_file, 0), - line_1(Name, Line); -line([]) -> - {line,[]}. - -line_1(no_file, _) -> - {line,[]}; -line_1(_, 0) -> - %% Missing line number or line number 0. - {line,[]}; -line_1(Name, Line) -> - {line,[{location,Name,Line}]}. - -find_loc([Line|T], File, _) when is_integer(Line) -> - find_loc(T, File, Line); -find_loc([{file,File}|T], _, Line) -> - find_loc(T, File, Line); -find_loc([_|T], File, Line) -> - find_loc(T, File, Line); -find_loc([], File, Line) -> {File,Line}. - -flatmapfoldl(F, Accu0, [Hd|Tail]) -> - {R,Accu1} = F(Hd, Accu0), - {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), - {R++Rs,Accu2}; -flatmapfoldl(_, Accu, []) -> {[],Accu}. - -%% Keep track of life time for variables. -%% -%% init_vars([{var,VarName}]) -> Vdb. -%% new_vars([VarName], I, Vdb) -> Vdb. -%% use_vars([VarName], I, Vdb) -> Vdb. -%% add_var(VarName, F, L, Vdb) -> Vdb. -%% -%% The list of variable names for new_vars/3 and use_vars/3 -%% must be sorted. - -init_vars(Vs) -> - vdb_new(Vs). - -new_vars([], _, Vdb) -> Vdb; -new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb); -new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). - -use_vars([], _, Vdb) -> - Vdb; -use_vars([V], I, Vdb) -> - case vdb_find(V, Vdb) of - {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb); - {V,_,_} -> Vdb; - error -> vdb_store_new(V, {V,I,I}, Vdb) - end; -use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). - -add_var(V, F, L, Vdb) -> - vdb_store_new(V, {V,F,L}, Vdb). - -%% vdb - -vdb_new(Vs) -> - ordsets:from_list([{V,0,0} || #k_var{name=V} <- Vs]). - --type var() :: atom(). - --spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry(). - -vdb_find(V, Vdb) -> - case lists:keyfind(V, 1, Vdb) of - false -> error; - Vd -> Vd - end. - -vdb_update(V, Update, [{V,_,_}|Vdb]) -> - [Update|Vdb]; -vdb_update(V, Update, [Vd|Vdb]) -> - [Vd|vdb_update(V, Update, Vdb)]. - -vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 -> - [Vd|vdb_store_new(V, New, Vdb)]; -vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 -> - [New|Vdb]; -vdb_store_new(_, New, []) -> [New]. - -vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> - [Vd|vdb_update_vars(Vs, Vdb, I)]; -vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> - %% New variable. - [{V,I,I}|vdb_update_vars(Vs, Vdb, I)]; -vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) -> - %% Existing variable. - if - I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)]; - true -> [Vd|vdb_update_vars(Vs, Vdb, I)] - end; -vdb_update_vars([V|Vs], [], I) -> - %% New variable. - [{V,I,I}|vdb_update_vars(Vs, [], I)]; -vdb_update_vars([], Vdb, _) -> Vdb. - -%% vdb_sub(Min, Max, Vdb) -> Vdb. -%% Extract variables which are used before and after Min. Lock -%% variables alive after Max. - -vdb_sub(Min, Max, Vdb) -> - [ if L >= Max -> {V,F,locked}; - true -> Vd - end || {V,F,L}=Vd <- Vdb, - F < Min, - L >= Min ]. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 0196e7fdfd..45e0ed5088 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -228,7 +228,8 @@ function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), - {Args,St1} = new_vars(Anno, Arity, St0), + {Args0,St1} = new_vars(Anno, Arity, St0), + Args = reverse(Args0), %Nicer order case clauses(Cs0, St1) of {Cs1,[],St2} -> {Ps,St3} = new_vars(Arity, St2), %Need new variables here @@ -328,14 +329,16 @@ gexpr({protect,Line,Arg}, Bools0, St0) -> Anno = lineno_anno(Line, St), {#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St} end; -gexpr({op,L,'andalso',E1,E2}, Bools, St0) -> +gexpr({op,_,'andalso',_,_}=E0, Bools, St0) -> + {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso', St0), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, False = {atom,L,false}, E = make_bool_switch_guard(L, E1, V, E2, False), gexpr(E, Bools, St); -gexpr({op,L,'orelse',E1,E2}, Bools, St0) -> +gexpr({op,_,'orelse',_,_}=E0, Bools, St0) -> + {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse', St0), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -1501,7 +1504,7 @@ bc_initial_size(E0, Q, St0) -> end. bc_elem_size({bin,_,El}, St0) -> - case bc_elem_size_1(El, 0, []) of + case bc_elem_size_1(El, ordsets:new(), 0, []) of {Bits,[]} -> {#c_literal{val=Bits},[],[],St0}; {Bits,Vars0} -> @@ -1515,19 +1518,33 @@ bc_elem_size(_, _) -> throw(impossible). bc_elem_size_1([{bin_element,_,{string,_,String},{integer,_,N},_}=El|Es], - Bits, Vars) -> + DefVars, Bits, SizeVars) -> U = get_unit(El), - bc_elem_size_1(Es, Bits+U*N*length(String), Vars); -bc_elem_size_1([{bin_element,_,_,{integer,_,N},_}=El|Es], Bits, Vars) -> + bc_elem_size_1(Es, DefVars, Bits+U*N*length(String), SizeVars); +bc_elem_size_1([{bin_element,_,Expr,{integer,_,N},_}=El|Es], + DefVars0, Bits, SizeVars) -> U = get_unit(El), - bc_elem_size_1(Es, Bits+U*N, Vars); -bc_elem_size_1([{bin_element,_,_,{var,_,Var},_}=El|Es], Bits, Vars) -> - U = get_unit(El), - bc_elem_size_1(Es, Bits, [{U,#c_var{name=Var}}|Vars]); -bc_elem_size_1([_|_], _, _) -> + DefVars = bc_elem_size_def_var(Expr, DefVars0), + bc_elem_size_1(Es, DefVars, Bits+U*N, SizeVars); +bc_elem_size_1([{bin_element,_,Expr,{var,_,Src},_}=El|Es], + DefVars0, Bits, SizeVars) -> + case ordsets:is_element(Src, DefVars0) of + false -> + U = get_unit(El), + DefVars = bc_elem_size_def_var(Expr, DefVars0), + bc_elem_size_1(Es, DefVars, Bits, [{U,#c_var{name=Src}}|SizeVars]); + true -> + throw(impossible) + end; +bc_elem_size_1([_|_], _, _, _) -> throw(impossible); -bc_elem_size_1([], Bits, Vars) -> - {Bits,Vars}. +bc_elem_size_1([], _DefVars, Bits, SizeVars) -> + {Bits,SizeVars}. + +bc_elem_size_def_var({var,_,Var}, DefVars) -> + ordsets:add_element(Var, DefVars); +bc_elem_size_def_var(_Expr, DefVars) -> + DefVars. bc_elem_size_combine([{U,V}|T], U, UVars, Acc) -> bc_elem_size_combine(T, U, [V|UVars], Acc); @@ -2040,6 +2057,19 @@ fail_clause(Pats, Anno, Arg) -> body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail}, args=[Arg]}]}. +%% Optimization for Dialyzer. +right_assoc(E, Op, St) -> + case member(dialyzer, St#core.opts) of + true -> + right_assoc2(E, Op); + false -> + E + end. + +right_assoc2({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) -> + right_assoc2({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op); +right_assoc2(E, _Op) -> E. + annotate_tuple(A, Es, St) -> case member(dialyzer, St#core.opts) of true -> diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index aef0b6cc9f..fe8e252e5a 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -2043,9 +2043,6 @@ get_match(#k_cons{}, St0) -> get_match(#k_binary{}, St0) -> {[V]=Mes,St1} = new_vars(1, St0), {#k_binary{segs=V},Mes,St1}; -get_match(#k_bin_seg{size=#k_atom{val=all},next={k_bin_end,[]}}=Seg, St0) -> - {[S]=Vars,St1} = new_vars(1, St0), - {Seg#k_bin_seg{seg=S,next=[]},Vars,St1}; get_match(#k_bin_seg{}=Seg, St0) -> {[S,N0],St1} = new_vars(2, St0), N = set_kanno(N0, [no_usage]), @@ -2073,9 +2070,6 @@ new_clauses(Cs0, U, St) -> #k_cons{hd=H,tl=T} -> [H,T|As]; #k_tuple{es=Es} -> Es ++ As; #k_binary{segs=E} -> [E|As]; - #k_bin_seg{size=#k_atom{val=all}, - seg=S,next={k_bin_end,[]}} -> - [S|As]; #k_bin_seg{seg=S,next=N} -> [S,N|As]; #k_bin_int{next=N} -> @@ -2374,9 +2368,10 @@ uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, true -> {[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion. #k_atom{val=false} = H0, %Assertion. - {A1,Bu,St1} = uexpr(A0, Br, St0), + {Avs,St1} = new_vars(length(Rs0), St0), + {A1,Bu,St} = uexpr(A0, {break,Avs}, St1), {#k_protected{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A}, - arg=A1,ret=Rs0},Bu,St1}; + arg=A1,ret=Rs0,inner=Avs},Bu,St}; false -> {Avs,St1} = new_vars(length(Vs), St0), {A1,Au,St2} = ubody(A0, {break,Avs}, St1), diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index e6f0d3c1f7..e26360a6da 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -66,7 +66,7 @@ -record(k_receive_next, {anno=[]}). -record(k_try, {anno=[],arg,vars,body,evars,handler,ret=[]}). -record(k_try_enter, {anno=[],arg,vars,body,evars,handler}). --record(k_protected, {anno=[],arg,ret=[]}). +-record(k_protected, {anno=[],arg,ret=[],inner}). -record(k_catch, {anno=[],body,ret=[]}). -record(k_guard_match, {anno=[],vars,body,ret=[]}). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index da5d207db9..2a5004aa4c 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -14,6 +14,7 @@ MODULES= \ beam_except_SUITE \ beam_jump_SUITE \ beam_reorder_SUITE \ + beam_ssa_SUITE \ beam_type_SUITE \ beam_utils_SUITE \ bif_SUITE \ @@ -52,6 +53,7 @@ NO_OPT= \ beam_except \ beam_jump \ beam_reorder \ + beam_ssa \ beam_type \ beam_utils \ bif \ @@ -75,6 +77,7 @@ INLINE= \ andor \ apply \ beam_block \ + beam_ssa \ beam_utils \ bif \ bs_bincomp \ @@ -124,7 +127,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += +clint +clint0 +ERL_COMPILE_FLAGS += +clint +clint0 +ssalint EBIN = . @@ -135,7 +138,8 @@ EBIN = . make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(INLINE_ERL_FILES) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ > $(EMAKEFILE) - $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt $(ERL_COMPILE_FLAGS) \ + $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt \ + +no_ssa_opt +no_recv_opt $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_copt $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(POST_OPT_MODULES) >> $(EMAKEFILE) diff --git a/lib/compiler/test/beam_ssa_SUITE.erl b/lib/compiler/test/beam_ssa_SUITE.erl new file mode 100644 index 0000000000..0356c99c5a --- /dev/null +++ b/lib/compiler/test/beam_ssa_SUITE.erl @@ -0,0 +1,290 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_ssa_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + calls/1,tuple_matching/1,recv/1,maps/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group,p}]. + +groups() -> + [{p,test_lib:parallel(), + [tuple_matching, + calls, + recv, + maps + ]}]. + +init_per_suite(Config) -> + test_lib:recompile(?MODULE), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +calls(Config) -> + Ret = {return,value,Config}, + Ret = fun_call(fun(42) -> ok end, Ret), + Ret = apply_fun(fun(a, b) -> ok end, [a,b], Ret), + Ret = apply_mfa(test_lib, id, [anything], Ret), + {'EXIT',{badarg,_}} = (catch call_error()), + {'EXIT',{badarg,_}} = (catch call_error(42)), + 5 = start_it([erlang,length,1,2,3,4,5]), + ok. + +fun_call(Fun, X0) -> + X = id(X0), + Fun(42), + X. + +apply_fun(Fun, Args, X0) -> + X = id(X0), + apply(Fun, Args), + X. + +apply_mfa(Mod, Name, Args, X0) -> + X = id(X0), + apply(Mod, Name, Args), + X. + +call_error() -> + error(badarg), + ok. + +call_error(I) -> + <<I:(-8)>>, + ok. + +start_it([_|_]=MFA) -> + case MFA of + [M,F|Args] -> M:F(Args) + end. + +tuple_matching(_Config) -> + do_tuple_matching({tag,42}). + +do_tuple_matching(Arg) -> + Res = do_tuple_matching_1(Arg), + Res = do_tuple_matching_2(Arg), + Res = do_tuple_matching_3(Arg), + Res. + +do_tuple_matching_1({tag,V}) -> + {ok,V}. + +do_tuple_matching_2(Tuple) when is_tuple(Tuple) -> + Size = tuple_size(Tuple), + if + Size =:= 2 -> + {ok,element(2, Tuple)} + end. + +do_tuple_matching_3(Tuple) when is_tuple(Tuple) -> + Size = tuple_size(Tuple), + if + Size =:= 2 -> + 2 = id(Size), + {ok,element(2, Tuple)} + end. + +-record(reporter_state, {res,run_config}). +-record(run_config, {report_interval=0}). + +recv(_Config) -> + Parent = self(), + + %% Test sync_wait_mon/2. + Succ = fun() -> Parent ! {ack,self(),{result,42}} end, + {result,42} = sync_wait_mon(spawn_monitor(Succ), infinity), + + Down = fun() -> exit(down) end, + {error,down} = sync_wait_mon(spawn_monitor(Down), infinity), + + Exit = fun() -> + Self = self(), + spawn(fun() -> exit(Self, kill_me) end), + receive _ -> ok end + end, + {error,kill_me} = sync_wait_mon(spawn_monitor(Exit), infinity), + + Timeout = fun() -> receive _ -> ok end end, + {error,timeout} = sync_wait_mon(spawn_monitor(Timeout), 0), + + %% Test reporter_loop/1. + {a,Parent} = reporter_loop(#reporter_state{res={a,Parent}, + run_config=#run_config{}}), + + %% Test bad_sink/0. + bad_sink(), + + %% Test tricky_recv_1/0. + self() ! 1, + a = tricky_recv_1(), + self() ! 2, + b = tricky_recv_1(), + + %% Test tricky_recv_2/0. + self() ! 1, + {1,yes} = tricky_recv_2(), + self() ! 2, + {2,maybe} = tricky_recv_2(), + + %% Test 'receive after infinity' in try/catch. + Pid = spawn(fun recv_after_inf_in_try/0), + exit(Pid, done), + + %% Test tricky_recv_3(). + self() ! {{self(),r0},{1,42,"name"}}, + {Parent,r0,[<<1:32,1:8,42:8>>,"name",0]} = tricky_recv_3(), + self() ! {{self(),r1},{2,99,<<"data">>}}, + {Parent,r1,<<1:32,2:8,99:8,"data">>} = tricky_recv_3(), + + %% Test tricky_recv_4(). + self() ! {[self(),r0],{1,42,"name"}}, + {Parent,r0,[<<1:32,1:8,42:8>>,"name",0]} = tricky_recv_4(), + self() ! {[self(),r1],{2,99,<<"data">>}}, + {Parent,r1,<<1:32,2:8,99:8,"data">>} = tricky_recv_4(), + + ok. + +sync_wait_mon({Pid, Ref}, Timeout) -> + receive + {ack,Pid,Return} -> + erlang:demonitor(Ref, [flush]), + Return; + {'DOWN',Ref,_Type,Pid,Reason} -> + {error,Reason}; + {'EXIT',Pid,Reason} -> + erlang:demonitor(Ref, [flush]), + {error,Reason} + after Timeout -> + erlang:demonitor(Ref, [flush]), + exit(Pid, kill), + {error,timeout} + end. + +reporter_loop(State) -> + RC = State#reporter_state.run_config, + receive after RC#run_config.report_interval -> + State#reporter_state.res + end. + +bad_sink() -> + {ok,Pid} = my_spawn(self()), + %% The get_tuple_element instruction for the matching + %% above was sinked into the receive loop. That will + %% not work (and would be bad for performance if it + %% would work). + receive + {ok,Pid} -> + ok; + error -> + exit(failed) + end, + exit(Pid, kill). + +my_spawn(Parent) -> + Pid = spawn(fun() -> + Parent ! {ok,self()}, + receive _ -> ok end + end), + {ok,Pid}. + +tricky_recv_1() -> + receive + X=1 -> + id(42), + a; + X=2 -> + b + end, + case X of + 1 -> a; + 2 -> b + end. + +tricky_recv_2() -> + receive + X=1 -> + Y = case id(X) of + 1 -> yes; + _ -> no + end, + a; + X=2 -> + Y = maybe, + b + end, + {X,Y}. + +recv_after_inf_in_try() -> + try + %% Used to crash beam_kernel_to_ssa. + receive after infinity -> ok end + catch + _A:_B -> + receive after infinity -> ok end + end. + +tricky_recv_3() -> + {Pid, R, Request} = + receive + {{Pid0,R0}, {1, Proto0, Name0}} -> + {Pid0, R0, + [<<1:32, 1:8, Proto0:8>>,Name0,0]}; + {{Pid1,R1}, {2, Proto1, Data1}} -> + {Pid1, R1, + <<1:32, 2:8, Proto1:8, Data1/binary>>} + end, + id({Pid,R,Request}). + +tricky_recv_4() -> + {Pid, R, Request} = + receive + {[Pid0,R0], {1, Proto0, Name0}} -> + {Pid0, R0, + [<<1:32, 1:8, Proto0:8>>,Name0,0]}; + {[Pid1,R1], {2, Proto1, Data1}} -> + {Pid1, R1, + <<1:32, 2:8, Proto1:8, Data1/binary>>} + end, + id({Pid,R,Request}). + +maps(_Config) -> + {'EXIT',{{badmatch,#{}},_}} = (catch maps_1(any)), + ok. + +maps_1(K) -> + _ = id(42), + #{K:=V} = #{}, + V. + +%% The identity function. +id(I) -> I. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 061076b3ff..caf43dad40 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -23,7 +23,8 @@ init_per_group/2,end_per_group/2, integers/1,coverage/1,booleans/1,setelement/1,cons/1, tuple/1,record_float/1,binary_float/1,float_compare/1, - arity_checks/1,elixir_binaries/1,find_best/1]). + arity_checks/1,elixir_binaries/1,find_best/1, + test_size/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -43,7 +44,8 @@ groups() -> float_compare, arity_checks, elixir_binaries, - find_best + find_best, + test_size ]}]. init_per_suite(Config) -> @@ -177,11 +179,50 @@ setelement(_Config) -> cons(_Config) -> [did] = cons(assigned, did), + + true = cons_is_empty_list([]), + false = cons_is_empty_list([a]), + + false = cons_not(true), + true = cons_not(false), + + {$a,"bc"} = cons_hdtl(true), + {$d,"ef"} = cons_hdtl(false), ok. cons(assigned, Instrument) -> [Instrument] = [did]. +cons_is_empty_list(L) -> + Cons = case L of + [] -> "true"; + _ -> "false" + end, + id(1), + case Cons of + "true" -> true; + "false" -> false + end. + +cons_not(B) -> + Cons = case B of + true -> "true"; + false -> "false" + end, + id(1), + case Cons of + "true" -> false; + "false" -> true + end. + +cons_hdtl(B) -> + Cons = case B of + true -> "abc"; + false -> "def" + end, + id(1), + {id(hd(Cons)),id(tl(Cons))}. + tuple(_Config) -> {'EXIT',{{badmatch,{necessary}},_}} = (catch do_tuple()), ok. @@ -320,6 +361,15 @@ find_best([], <<"a">>) -> find_best([], nil) -> {error,<<"should not get here">>}. +test_size(Config) -> + 2 = do_test_size({a,b}), + 4 = do_test_size(<<42:32>>), + ok. + +do_test_size(Term) when is_tuple(Term) -> + size(Term); +do_test_size(Term) when is_binary(Term) -> + size(Term). id(I) -> I. diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 42361ea546..a5d49020a9 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -26,7 +26,7 @@ init_per_group/2,end_per_group/2, byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1, - nomatch/1,sizes/1,general_expressions/1]). + nomatch/1,sizes/1,general_expressions/1,matched_out_size/1]). -include_lib("common_test/include/ct.hrl"). @@ -35,7 +35,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [byte_aligned, bit_aligned, extended_byte_aligned, extended_bit_aligned, mixed, filters, trim_coverage, - nomatch, sizes, general_expressions]. + nomatch, sizes, general_expressions, matched_out_size]. groups() -> []. @@ -338,6 +338,13 @@ general_expressions(_) -> -undef(BAD). +matched_out_size(Config) when is_list(Config) -> + <<1, 2>> = matched_out_size_1(<<4, 1:4, 4, 2:4>>), + ok. + +matched_out_size_1(Binary) -> + << <<X>> || <<S, X:S>> <= Binary>>. + cs_init() -> erts_debug:set_internal_state(available_internal_state, true), ok. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index e737839575..b4277f0705 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -40,7 +40,7 @@ map_and_binary/1,unsafe_branch_caching/1, bad_literals/1,good_literals/1,constant_propagation/1, parse_xml/1,get_payload/1,escape/1,num_slots_different/1, - beam_bsm/1,guard/1,is_ascii/1,non_opt_eq/1]). + beam_bsm/1,guard/1,is_ascii/1,non_opt_eq/1,erl_689/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -72,7 +72,7 @@ groups() -> map_and_binary,unsafe_branch_caching, bad_literals,good_literals,constant_propagation,parse_xml, get_payload,escape,num_slots_different, - beam_bsm,guard,is_ascii,non_opt_eq]}]. + beam_bsm,guard,is_ascii,non_opt_eq,erl_689]}]. init_per_suite(Config) -> @@ -248,6 +248,12 @@ bin_tail(Config) when is_list(Config) -> ok = bin_tail_e(<<2:2,1:1,1:5,42:64>>), error = bin_tail_e(<<3:2,1:1,1:5,42:64>>), error = bin_tail_e(<<>>), + + MD5 = erlang:md5(<<42>>), + <<"abc">> = bin_tail_f(<<MD5/binary,"abc">>, MD5, 3), + error = bin_tail_f(<<MD5/binary,"abc">>, MD5, 999), + {'EXIT',{_,_}} = (catch bin_tail_f(<<0:16/unit:8>>, MD5, 0)), + ok. bin_tail_c(Bin, Offset) -> @@ -304,6 +310,14 @@ bin_tail_e_var(Bin) -> <<2:2,_:1,1:5,Tail/binary>> -> Tail; _ -> error end. + +bin_tail_f(Bin, MD5, Size) -> + case Bin of + <<MD5:16/binary, Tail:Size/binary>> -> + Tail; + <<MD5:16/binary, _/binary>> -> + error + end. save_restore(Config) when is_list(Config) -> 0 = save_restore_1(<<0:2,42:6>>), @@ -455,6 +469,15 @@ unit(Config) when is_list(Config) -> 127 = peek7(<<127:7>>), 100 = peek7(<<100:7,19:7>>), fc(peek7, [<<1,2>>], catch peek7(<<1,2>>)), + + 1 = unit_opt(1, -1), + 8 = unit_opt(8, -1), + + <<1:32,"abc">> = unit_opt_2(<<1:32,"abc">>), + <<"def">> = unit_opt_2(<<2:32,"def">>), + {'EXIT',_} = (catch unit_opt_2(<<1:32,33:7>>)), + {'EXIT',_} = (catch unit_opt_2(<<2:32,55:7>>)), + ok. peek1(<<B:8,_/bitstring>>) -> B. @@ -465,6 +488,27 @@ peek8(<<B:8,_/binary>>) -> B. peek16(<<B:16,_/binary-unit:16>>) -> B. +unit_opt(U, X) -> + %% Cover type analysis in beam_ssa_type. + Bin = case U of + 1 -> <<X:7>>; + 8 -> <<X>> + end, + %% The type of Bin will be set to {binary,gcd(1, 8)}. + case Bin of + <<_/binary-unit:8>> -> 8; + <<_/binary-unit:1>> -> 1 + end. + +unit_opt_2(<<St:32,KO/binary>> = Bin0) -> + Bin = if + St =:= 1 -> + Bin0; + St =:= 2 -> + <<KO/binary>> + end, + id(Bin). + shared_sub_bins(Config) when is_list(Config) -> {15,[<<>>,<<5>>,<<4,5>>,<<3,4,5>>,<<2,3,4,5>>]} = sum(<<1,2,3,4,5>>, [], 0), ok. @@ -1688,6 +1732,35 @@ non_opt_eq([_|_], <<_,_/binary>>) -> non_opt_eq([], <<>>) -> true. +%% ERL-689 + +erl_689(Config) -> + {{0, 0, 0}, <<>>} = do_erl_689_1(<<0>>, ?MODULE), + {{2018, 8, 7}, <<>>} = do_erl_689_1(<<4,2018:16/little,8,7>>, ?MODULE), + {{0, 0, 0}, <<>>} = do_erl_689_2(?MODULE, <<0>>), + {{2018, 8, 7}, <<>>} = do_erl_689_2(?MODULE, <<4,2018:16/little,8,7>>), + ok. + +do_erl_689_1(<<Length, Data/binary>>, _) -> + case {Data, Length} of + {_, 0} -> + %% bs_context_to_binary would incorrectly set Data to the original + %% binary (before matching in the function head). + {{0, 0, 0}, Data}; + {<<Y:16/little, M, D, Rest/binary>>, 4} -> + {{Y, M, D}, Rest} + end. + +do_erl_689_2(_, <<Length, Data/binary>>) -> + case {Length, Data} of + {0, _} -> + %% bs_context_to_binary would incorrectly set Data to the original + %% binary (before matching in the function head). + {{0, 0, 0}, Data}; + {4, <<Y:16/little, M, D, Rest/binary>>} -> + {{Y, M, D}, Rest} + end. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 3ba3ce7cdf..def7a60f45 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -170,7 +170,7 @@ try_it(Module, Conf) -> atom_to_list(Module)), Out = proplists:get_value(priv_dir,Conf), io:format("Compiling: ~s\n", [Src]), - CompRc0 = compile:file(Src, [clint0,clint,{outdir,Out},report, + CompRc0 = compile:file(Src, [clint0,clint,ssalint,{outdir,Out},report, bin_opt_info|OtherOpts]), io:format("Result: ~p\n",[CompRc0]), {ok,_Mod} = CompRc0, @@ -189,7 +189,7 @@ try_it(Module, Conf) -> ct:timetrap(Timetrap), io:format("Compiling (with old inliner): ~s\n", [Src]), - CompRc2 = compile:file(Src, [clint, + CompRc2 = compile:file(Src, [clint,ssalint, {outdir,Out},report,bin_opt_info, {inline,1000}|OtherOpts]), io:format("Result: ~p\n",[CompRc2]), @@ -355,7 +355,7 @@ compile_compiler(Files, OutDir, Version, InlineOpts) -> io:format("~ts", [code:which(compile)]), io:format("Compiling ~s into ~ts", [Version,OutDir]), Opts = [report, - clint0,clint, + clint0,clint,ssalint, bin_opt_info, {outdir,OutDir}, {d,'COMPILER_VSN',"\""++Version++"\""}, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 2206927ed1..8d8fc23027 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -36,7 +36,7 @@ core_roundtrip/1, asm/1, optimized_guards/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1, env_compiler_options/1, - bc_options/1 + bc_options/1, deterministic_include/1 ]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -53,7 +53,7 @@ all() -> cover, env, core_pp, core_roundtrip, asm, optimized_guards, sys_pre_attributes, dialyzer, warnings, pre_load_check, env_compiler_options, custom_debug_info, bc_options, - custom_compile_info]. + custom_compile_info, deterministic_include]. groups() -> []. @@ -385,11 +385,13 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dcbsm, ".core_bsm"), do_listing(Simple, TargetDir, dsetel, ".dsetel"), do_listing(Simple, TargetDir, dkern, ".kernel"), + do_listing(Simple, TargetDir, dssa, ".ssa"), + do_listing(Simple, TargetDir, dssaopt, ".ssaopt"), + do_listing(Simple, TargetDir, dprecg, ".precodegen"), do_listing(Simple, TargetDir, dcg, ".codegen"), do_listing(Simple, TargetDir, dblk, ".block"), do_listing(Simple, TargetDir, dexcept, ".except"), do_listing(Simple, TargetDir, dbs, ".bs"), - do_listing(Simple, TargetDir, dtype, ".type"), do_listing(Simple, TargetDir, ddead, ".dead"), do_listing(Simple, TargetDir, djmp, ".jump"), do_listing(Simple, TargetDir, dclean, ".clean"), @@ -424,6 +426,9 @@ listings_big(Config) when is_list(Config) -> do_listing(Big, TargetDir, 'E'), do_listing(Big, TargetDir, 'P'), do_listing(Big, TargetDir, dkern, ".kernel"), + do_listing(Big, TargetDir, dssa, ".ssa"), + do_listing(Big, TargetDir, dssaopt, ".ssaopt"), + do_listing(Big, TargetDir, dprecg, ".precodegen"), do_listing(Big, TargetDir, to_dis, ".dis"), TargetNoext = filename:rootname(Target, code:objfile_extension()), @@ -920,7 +925,7 @@ do_core_pp_1(M, A, Outdir) -> ok = file:delete(CoreFile), %% Compile as usual (including optimizations). - compile_forms(M, Core, [clint,from_core,binary]), + compile_forms(M, Core, [clint,ssalint,from_core,binary]), %% Don't optimize to test that we are not dependent %% on the Core Erlang optmimization passes. @@ -929,7 +934,7 @@ do_core_pp_1(M, A, Outdir) -> %% records; if sys_core_fold was run it would fix %% that; if sys_core_fold was not run v3_kernel would %% crash.) - compile_forms(M, Core, [clint,from_core,no_copt,binary]), + compile_forms(M, Core, [clint,ssalint,from_core,no_copt,binary]), ok. @@ -1242,21 +1247,14 @@ do_opt_guards_fun([_|Is]) -> do_opt_guards_fun(Is); do_opt_guards_fun([]) -> []. -is_exception(bs_match_SUITE, {matching_and_andalso_2,2}) -> true; -is_exception(bs_match_SUITE, {matching_and_andalso_3,2}) -> true; is_exception(guard_SUITE, {'-complex_not/1-fun-4-',1}) -> true; is_exception(guard_SUITE, {'-complex_not/1-fun-5-',1}) -> true; -is_exception(guard_SUITE, {basic_andalso_orelse,1}) -> true; is_exception(guard_SUITE, {bad_guards,1}) -> true; is_exception(guard_SUITE, {bad_guards_2,2}) -> true; is_exception(guard_SUITE, {bad_guards_3,2}) -> true; -is_exception(guard_SUITE, {cqlc,4}) -> true; is_exception(guard_SUITE, {csemi7,3}) -> true; -is_exception(guard_SUITE, {misc,1}) -> true; is_exception(guard_SUITE, {nested_not_2b,4}) -> true; is_exception(guard_SUITE, {tricky_1,2}) -> true; -is_exception(map_SUITE, {map_guard_update,2}) -> true; -is_exception(map_SUITE, {map_guard_update_variables,3}) -> true; is_exception(_, _) -> false. sys_pre_attributes(Config) -> @@ -1478,18 +1476,22 @@ bc_options(Config) -> 101 = highest_opcode(DataDir, small_float, [no_get_hd_tl,no_line_info]), 103 = highest_opcode(DataDir, big, - [no_get_hd_tl,no_record_opt, + [no_put_tuple2, + no_get_hd_tl,no_ssa_opt_record, no_line_info,no_stack_trimming]), 125 = highest_opcode(DataDir, small_float, - [no_get_hd_tl,no_line_info,no_float_opt]), + [no_get_hd_tl,no_line_info,no_ssa_opt_float]), 132 = highest_opcode(DataDir, small, - [no_get_hd_tl,no_record_opt,no_float_opt,no_line_info]), + [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + no_ssa_opt_float,no_line_info]), - 136 = highest_opcode(DataDir, big, [no_get_hd_tl,no_record_opt,no_line_info]), + 136 = highest_opcode(DataDir, big, [no_put_tuple2,no_get_hd_tl, + no_ssa_opt_record,no_line_info]), - 153 = highest_opcode(DataDir, big, [no_get_hd_tl,no_record_opt]), + 153 = highest_opcode(DataDir, big, [no_put_tuple2,no_get_hd_tl, + no_ssa_opt_record]), 153 = highest_opcode(DataDir, big, [r16]), 153 = highest_opcode(DataDir, big, [r17]), 153 = highest_opcode(DataDir, big, [r18]), @@ -1501,9 +1503,10 @@ bc_options(Config) -> 158 = highest_opcode(DataDir, small_maps, [r18]), 158 = highest_opcode(DataDir, small_maps, [r19]), 158 = highest_opcode(DataDir, small_maps, [r20]), - 158 = highest_opcode(DataDir, small_maps, []), + 158 = highest_opcode(DataDir, small_maps, [r21]), - 163 = highest_opcode(DataDir, big, []), + 164 = highest_opcode(DataDir, small_maps, []), + 164 = highest_opcode(DataDir, big, []), ok. @@ -1514,6 +1517,23 @@ highest_opcode(DataDir, Mod, Opt) -> <<16:32,0:32,HighestOpcode:32,_/binary>> = Code, HighestOpcode. +deterministic_include(Config) when is_list(Config) -> + DataDir = proplists:get_value(data_dir, Config), + Simple = filename:join(DataDir, "simple"), + + %% Files without +deterministic should differ if their include paths do, + %% as their debug info will be different. + {ok,_,NonDetA} = compile:file(Simple, [binary, {i,"gurka"}]), + {ok,_,NonDetB} = compile:file(Simple, [binary, {i,"gaffel"}]), + true = NonDetA =/= NonDetB, + + %% ... but files with +deterministic shouldn't. + {ok,_,DetC} = compile:file(Simple, [binary, deterministic, {i,"gurka"}]), + {ok,_,DetD} = compile:file(Simple, [binary, deterministic, {i,"gaffel"}]), + true = DetC =:= DetD, + + ok. + %%% %%% Utilities. %%% diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 23f420f5f2..e5611e99d1 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -29,7 +29,7 @@ bs_shadowed_size_var/1, cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1, cover_v3_kernel_4/1,cover_v3_kernel_5/1, - non_variable_apply/1,name_capture/1]). + non_variable_apply/1,name_capture/1,fun_letrec_effect/1]). -include_lib("common_test/include/ct.hrl"). @@ -57,7 +57,7 @@ groups() -> bs_shadowed_size_var, cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3, cover_v3_kernel_4,cover_v3_kernel_5, - non_variable_apply,name_capture + non_variable_apply,name_capture,fun_letrec_effect ]}]. @@ -94,6 +94,7 @@ end_per_group(_GroupName, Config) -> ?comp(cover_v3_kernel_5). ?comp(non_variable_apply). ?comp(name_capture). +?comp(fun_letrec_effect). try_it(Mod, Conf) -> Src = filename:join(proplists:get_value(data_dir, Conf), diff --git a/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core b/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core new file mode 100644 index 0000000000..ab6f5b7940 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core @@ -0,0 +1,25 @@ +module 'fun_letrec_effect' ['fun_letrec_effect'/0, 'ok'/0, 'wat'/0] +attributes [] + +'fun_letrec_effect'/0 = + fun () -> + do apply 'wat'/0() + receive + <'bar'> when 'true' -> 'ok' + <_0> when 'true' -> 'failed' + after 'infinity' -> + 'true' + +%% The return value (bar) of the fun was optimized away because the result of +%% the `letrec ... in` was unused, despite the fun's return value being +%% relevant for the side-effect of the expression. +'wat'/0 = + fun () -> + let <Self> = call 'erlang':'self'() in + do letrec 'f'/0 = fun () -> + do call 'maps':'put'('foo', 'bar', ~{}~) + 'bar' + in call 'erlang':'send'(Self, apply 'f'/0()) + 'undefined' + +end diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index aa357dbc9c..68bc5c6e2f 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -28,7 +28,7 @@ mixed_matching_clauses/1,unnecessary_building/1, no_no_file/1,configuration/1,supplies/1, redundant_stack_frame/1,export_from_case/1, - empty_values/1]). + empty_values/1,cover_letrec_effect/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -48,7 +48,7 @@ groups() -> mixed_matching_clauses,unnecessary_building, no_no_file,configuration,supplies, redundant_stack_frame,export_from_case, - empty_values]}]. + empty_values,cover_letrec_effect]}]. init_per_suite(Config) -> @@ -373,7 +373,7 @@ unused_multiple_values_error(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), Dir = test_lib:get_data_dir(Config), Core = filename:join(Dir, "unused_multiple_values_error"), - Opts = [no_copt,clint,return,from_core,{outdir,PrivDir} + Opts = [no_copt,clint,ssalint,return,from_core,{outdir,PrivDir} |test_lib:opt_opts(?MODULE)], {error,[{unused_multiple_values_error, [{none,core_lint,{return_mismatch,{hello,1}}}]}], @@ -615,5 +615,25 @@ empty_values(_Config) -> do_empty_values() when (#{})#{} -> c. +cover_letrec_effect(_Config) -> + self() ! {tag,42}, + _ = try + try + ignore + after + receive + {tag,Int}=Term -> + Res = #{k => {Term,<<Int:16>>}}, + self() ! Res + end + end + after + ok + end, + receive + Any -> + #{k := {{tag,42},<<42:16>>}} = Any + end, + ok. id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 99dc06b525..73a8dc0fda 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1788,6 +1788,11 @@ t_tuple_size(Config) when is_list(Config) -> 14 = Mod:t({1,2,3,4}), _ = code:delete(Mod), _ = code:purge(Mod), + + good_ip({1,2,3,4}), + good_ip({1,2,3,4,5,6,7,8}), + error = validate_ip({42,11}), + error = validate_ip(atom), ok. @@ -1805,6 +1810,16 @@ ludicrous_tuple_size(T) when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok; ludicrous_tuple_size(_) -> error. +good_ip(IP) -> + IP = validate_ip(IP). + +validate_ip(Value) when is_tuple(Value) andalso + ((size(Value) =:= 4) orelse (size(Value) =:= 8)) -> + %% size/1 (converted to tuple_size) used more than once. + Value; +validate_ip(_) -> + error. + %% %% The binary_part/2,3 guard BIFs %% diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index fdf2fe88b4..e03769012b 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -96,7 +96,8 @@ try_inline(Mod, Config) -> %% Normal compilation. io:format("Compiling: ~s\n", [Src]), - {ok,Mod} = compile:file(Src, [{outdir,Out},report,bin_opt_info,clint]), + {ok,Mod} = compile:file(Src, [{outdir,Out},report, + bin_opt_info,clint,ssalint]), ct:timetrap({minutes,10}), NormalResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]), @@ -104,7 +105,7 @@ try_inline(Mod, Config) -> %% Inlining. io:format("Compiling with old inliner: ~s\n", [Src]), {ok,Mod} = compile:file(Src, [{outdir,Out},report,bin_opt_info, - {inline,1000},clint]), + {inline,1000},clint,ssalint]), %% Run inlined code. ct:timetrap({minutes,10}), @@ -117,7 +118,7 @@ try_inline(Mod, Config) -> %% Inlining. io:format("Compiling with new inliner: ~s\n", [Src]), {ok,Mod} = compile:file(Src, [{outdir,Out},report, - bin_opt_info,inline,clint]), + bin_opt_info,inline,clint,ssalint]), %% Run inlined code. ct:timetrap({minutes,10}), @@ -351,7 +352,8 @@ otp_7223_2({a}) -> coverage(Config) when is_list(Config) -> Mod = bsdecode, Src = filename:join(proplists:get_value(data_dir, Config), Mod), - {ok,Mod,_} = compile:file(Src, [binary,report,{inline,0},clint]), + {ok,Mod,_} = compile:file(Src, [binary,report,{inline,0}, + clint,ssalint]), {ok,Mod,_} = compile:file(Src, [binary,report,{inline,20}, - verbose,clint]), + verbose,clint,ssalint]), ok. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 9182c1b5ed..3e0ab78390 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -1212,10 +1212,25 @@ t_guard_bifs(Config) when is_list(Config) -> true = map_guard_empty_2(), true = map_guard_head(#{a=>1}), false = map_guard_head([]), + true = map_get_head(#{a=>1}), + false = map_get_head(#{}), + false = map_get_head([]), + + true = map_get_head_not(#{a=>false}), + false = map_get_head_not(#{a=>true}), + false = map_get_head(#{}), false = map_get_head([]), + true = map_is_key_head(#{a=>1}), false = map_is_key_head(#{}), + false = map_is_key_head(not_a_map), + + false = map_is_key_head_not(#{a=>1}), + true = map_is_key_head_not(#{b=>1}), + true = map_is_key_head_not(#{}), + false = map_is_key_head_not(not_a_map), + true = map_guard_body(#{a=>1}), false = map_guard_body({}), true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), @@ -1224,6 +1239,57 @@ t_guard_bifs(Config) when is_list(Config) -> true = map_guard_ill_map_size(), true = map_field_check_sequence(#{a=>1}), false = map_field_check_sequence(#{}), + + %% The guard BIFs used in a body. + + v = map_get(a, id(#{a=>v})), + {'EXIT',{{badkey,a},_}} = + (catch map_get(a, id(#{}))), + {'EXIT',{{badmap,not_a_map},_}} = + (catch map_get(a, id(not_a_map))), + + true = is_map_key(a, id(#{a=>1})), + false = is_map_key(b, id(#{a=>1})), + false = is_map_key(b, id(#{})), + {'EXIT',{{badmap,not_a_map},_}} = + (catch is_map_key(b, id(not_a_map))), + + {true,v} = erl_699(#{k=>v}), + {'EXIT',{{badkey,k},_}} = (catch erl_699(#{})), + {'EXIT',{{badmap,not_a_map},_}} = (catch erl_699(not_a_map)), + + %% Cover optimizations in beam_dead. + + ok = beam_dead_1(#{a=>any,k=>true}), + error = beam_dead_1(#{a=>any,k=>false}), + error = beam_dead_1(#{a=>any}), + error = beam_dead_1(#{}), + + ok = beam_dead_2(#{a=>any,k=>true}), + error = beam_dead_2(#{a=>any,k=>false}), + error = beam_dead_2(#{a=>any}), + error = beam_dead_2(#{}), + + ok = beam_dead_3(#{k=>true}), + error = beam_dead_3(#{k=>false}), + error = beam_dead_3(#{}), + + ok = beam_dead_4(#{k=>true}), + error = beam_dead_4(#{k=>false}), + error = beam_dead_4(#{}), + error = beam_dead_4(not_a_map), + + ok = beam_dead_5(#{k=>true}), + error = beam_dead_5(#{k=>false}), + error = beam_dead_3(#{}), + + %% Test is_map_key/2 followed by map update. + + Used0 = map_usage(var, #{other=>value}), + Used0 = #{other=>value,var=>dead}, + Used1 = map_usage(var, #{var=>live}), + Used1 = #{var=>live}, + ok. map_guard_empty() when is_map(#{}); false -> true. @@ -1236,8 +1302,14 @@ map_guard_head(_) -> false. map_get_head(M) when map_get(a, M) =:= 1 -> true; map_get_head(_) -> false. +map_get_head_not(M) when not map_get(a, M) -> true; +map_get_head_not(_) -> false. + map_is_key_head(M) when is_map_key(a, M) -> true; -map_is_key_head(M) -> false. +map_is_key_head(_) -> false. + +map_is_key_head_not(M) when not is_map_key(a, M) -> true; +map_is_key_head_not(_) -> false. map_guard_body(M) -> is_map(M). @@ -1254,6 +1326,52 @@ map_field_check_sequence(M) map_field_check_sequence(_) -> false. +erl_699(M) -> + %% Used to cause an internal consistency failure. + {is_map_key(k, M),maps:get(k, M)}. + +beam_dead_1(#{a:=_,k:=_}=M) when map_get(k, M) -> + ok; +beam_dead_1(#{}) -> + error. + +beam_dead_2(M) -> + case M of + #{a:=_,k:=_} when map_get(k, M) -> + ok; + #{} -> + error + end. + +beam_dead_3(M) -> + case M of + #{k:=_} when map_get(k, M) -> + ok; + #{} -> + error + end. + +beam_dead_4(M) -> + case M of + #{} when map_get(k, M) -> + ok; + _ -> + error + end. + +beam_dead_5(#{}=M) when map_get(k, M) -> + ok; +beam_dead_5(#{}) -> + error. + +%% Test is_map_key/2, followed by an update of the map. +map_usage(Def, Used) -> + case is_map_key(Def, Used) of + true -> Used; + false -> Used#{Def=>dead} + end. + + t_guard_sequence(Config) when is_list(Config) -> {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index a1d931b994..beae5eb618 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -171,7 +171,7 @@ silly_coverage(Config) when is_list(Config) -> expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end), expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), - %% v3_codegen + %% beam_kernel_to_ssa BadKernel = {k_mdef,[],?MODULE, [{foo,0}], [], @@ -179,7 +179,31 @@ silly_coverage(Config) when is_list(Config) -> {k,[],[],[]}, f,0,[], seriously_bad_body}]}, - expect_error(fun() -> v3_codegen:module(BadKernel, []) end), + expect_error(fun() -> beam_kernel_to_ssa:module(BadKernel, []) end), + + %% beam_ssa_lint + %% beam_ssa_recv + %% beam_ssa_pre_codegen + %% beam_ssa_opt + %% beam_ssa_codegen + BadSSA = {b_module,#{},a,b,c, + [{b_function,#{func_info=>{mod,foo,0}},args,bad_blocks,0}]}, + expect_error(fun() -> beam_ssa_lint:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_recv:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_pre_codegen:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_opt:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_codegen:module(BadSSA, []) end), + + %% beam_ssa_lint, beam_ssa_pp + {error,[{_,Errors}]} = beam_ssa_lint:module(bad_ssa_lint_input(), []), + _ = [io:put_chars(Mod:format_error(Reason)) || + {Mod,Reason} <- Errors], + + %% Cover printing of annotations in beam_ssa_pp + PPAnno = #{func_info=>{mod,foo,0},other_anno=>value,map_anno=>#{k=>v}}, + PPBlocks = #{0=>{b_blk,#{},[],{b_ret,#{},{b_literal,42}}}}, + PP = {b_function,PPAnno,[],PPBlocks,0}, + io:put_chars(beam_ssa_pp:format_function(PP)), %% beam_a BeamAInput = {?MODULE,[{foo,0}],[], @@ -189,14 +213,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_a:module(BeamAInput, []) end), - %% beam_reorder - BlockInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list]}],99}, - expect_error(fun() -> beam_reorder:module(BlockInput, []) end), - %% beam_block BlockInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -209,15 +225,6 @@ silly_coverage(Config) when is_list(Config) -> BsInput = BlockInput, expect_error(fun() -> beam_bs:module(BsInput, []) end), - %% beam_type - TypeInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {line,loc}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list]}],99}, - expect_error(fun() -> beam_type:module(TypeInput, []) end), - %% beam_except ExceptInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -268,33 +275,6 @@ silly_coverage(Config) when is_list(Config) -> {block,[a|b]}]}],0}, expect_error(fun() -> beam_bsm:module(BsmInput, []) end), - %% beam_receive. - ReceiveInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}, - {call_ext,0,{extfunc,erlang,make_ref,0}}, - {block,[a|b]}]}],0}, - expect_error(fun() -> beam_receive:module(ReceiveInput, []) end), - - %% beam_record. - RecordInput = {?MODULE,[{foo,0}],[], - [{function,foo,1,2, - [{label,1}, - {func_info,{atom,?MODULE},{atom,foo},1}, - {label,2}, - {test,is_tuple,{f,1},[{x,0}]}, - {test,test_arity,{f,1},[{x,0},3]}, - {block,[{set,[{x,1}],[{x,0}],{get_tuple_element,0}}]}, - {test,is_eq_exact,{f,1},[{x,1},{atom,bar}]}, - {block,[{set,[{x,2}],[{x,0}],{get_tuple_element,1}}|a]}, - {test,is_eq_exact,{f,1},[{x,2},{integer,1}]}, - {block,[{set,[{x,0}],[{atom,ok}],move}]}, - return]}],0}, - - expect_error(fun() -> beam_record:module(RecordInput, []) end), - BeamZInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, [{label,1}, @@ -312,6 +292,31 @@ silly_coverage(Config) when is_list(Config) -> ok. +bad_ssa_lint_input() -> + {b_module,#{},t, + [{foobar,1},{module_info,0},{module_info,1}], + [], + [{b_function, + #{func_info => {t,foobar,1},location => {"t.erl",4}}, + [{b_var,0}], + #{0 => {b_blk,#{},[],{b_ret,#{},{b_var,'@undefined_var'}}}}, + 3}, + {b_function, + #{func_info => {t,module_info,0}}, + [], + #{0 => + {b_blk,#{}, + [{b_set,#{}, + {b_var,{'@ssa_ret',3}}, + call, + [{b_remote, + {b_literal,erlang}, + {b_literal,get_module_info}, + 1}, + {b_var,'@unknown_variable'}]}], + {b_ret,#{},{b_var,{'@ssa_ret',3}}}}}, + 4}]}. + expect_error(Fun) -> try Fun() of Any -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 81ef0d33f2..4219768d6f 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -25,7 +25,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, - wait/1]). + wait/1,recv_in_try/1,double_recv/1]). -include_lib("common_test/include/ct.hrl"). @@ -44,7 +44,8 @@ all() -> groups() -> [{p,test_lib:parallel(), - [recv,coverage,otp_7980,ref_opt,export,wait]}]. + [recv,coverage,otp_7980,ref_opt,export,wait, + recv_in_try,double_recv]}]. init_per_suite(Config) -> @@ -305,4 +306,76 @@ wait_1(r, _, _) -> wait_1(A, B, C) -> {A,B,C}. +recv_in_try(_Config) -> + self() ! {ok,fh}, {ok,fh} = recv_in_try(infinity, native), + self() ! {ok,ignored}, {ok,42} = recv_in_try(infinity, plain), + self() ! {error,ignored}, nok = recv_in_try(infinity, plain), + timeout = recv_in_try(1, plain), + ok. + +recv_in_try(Timeout, Format) -> + try + receive + {Status,History} -> + %% {test,is_tuple,{f,148},[{x,0}]}. + %% {test,test_arity,{f,148},[{x,0},2]}. + %% {get_tuple_element,{x,0},0,{y,1}}. %y1 is fragile. + %% + %% %% Here the fragility of y1 would be be progated to + %% %% the 'catch' below. Incorrect, since get_tuple_element + %% %% can't fail. + %% {get_tuple_element,{x,0},1,{x,2}}. + %% + %% remove_message. %y1 fragility cleared. + FH = case Format of + native -> + id(History); + plain -> + id(42) + end, + case Status of + ok -> + {ok,FH}; + error -> + nok + end + after Timeout -> + timeout + end + catch + %% The fragility of y1 incorrectly propagated to here. + %% beam_validator would complain. + throw:{error,Reason} -> + {nok,Reason} + end. + +%% ERL-703. The compiler would crash because beam_utils:anno_defs/1 +%% failed to take into account that code after loop_rec_end is +%% unreachable. + +double_recv(_Config) -> + self() ! {more,{a,term}}, + ok = do_double_recv({more,{a,term}}, any), + self() ! message, + ok = do_double_recv(whatever, message), + + error = do_double_recv({more,42}, whatever), + error = do_double_recv(whatever, whatever), + ok. + +do_double_recv({more, Rest}, _Msg) -> + receive + {more, Rest} -> + ok + after 0 -> + error + end; +do_double_recv(_, Msg) -> + receive + Msg -> + ok + after 0 -> + error + end. + id(I) -> I. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_5.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_5.erl new file mode 100644 index 0000000000..4fbde3a83d --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_5.erl @@ -0,0 +1,38 @@ +-module(no_5). +-compile([export_all,nowarn_export_all]). + +?MODULE() -> + ok. + +%% Nested receives were not handled properly. + +confusing_recv_mark(Pid) -> + Ref = make_ref(), + %% There would be a recv_mark here. + MRef = erlang:monitor(process, Pid), + receive + Ref -> + %% And a recv_set here. + receive + MRef -> gurka + end; + MRef -> + gaffel + end. + +%% The optimization could potentially be improved to +%% handle matching of multiple refs, like this: + +proper_recv_mark(Pid) -> + %% Place the recv_mark before the creation of both refs. + Ref = make_ref(), + MRef = erlang:monitor(process, Pid), + %% Place the recv_set here. + receive + Ref -> + receive + MRef -> gurka + end; + MRef -> + gaffel + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S deleted file mode 100644 index fd14228135..0000000000 --- a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S +++ /dev/null @@ -1,71 +0,0 @@ -{module, yes_14}. %% version = 0 - -{exports, [{f,2},{module_info,0},{module_info,1},{yes_14,0}]}. - -{attributes, []}. - -{labels, 12}. - - -{function, yes_14, 0, 2}. - {label,1}. - {func_info,{atom,yes_14},{atom,yes_14},0}. - {label,2}. - {move,{atom,ok},{x,0}}. - return. - - -{function, f, 2, 4}. - {label,3}. - {func_info,{atom,yes_14},{atom,f},2}. - {label,4}. - {allocate_heap,2,3,2}. - {move,{x,0},{y,1}}. - {put_tuple,2,{y,0}}. - {put,{atom,data}}. - {put,{x,1}}. - {call_ext,0,{extfunc,erlang,make_ref,0}}. % Ref in [x0] - {test_heap,4,1}. - {put_tuple,3,{x,1}}. - {put,{atom,request}}. - {put,{x,0}}. - {put,{y,0}}. - {move,{x,0},{y,0}}. % Ref in [x0,y0] - {move,{y,1},{x,0}}. % Ref in [y0] - {kill,{y,1}}. - send. - {move,{y,0},{x,0}}. % Ref in [x0,y0] - {move,{x,0},{y,1}}. % Ref in [x0,y0,y1] - {label,5}. - {loop_rec,{f,7},{x,0}}. % Ref in [y0,y1] - {test,is_tuple,{f,6},[{x,0}]}. - {test,test_arity,{f,6},[{x,0},2]}. - {get_tuple_element,{x,0},0,{x,1}}. - {get_tuple_element,{x,0},1,{x,2}}. - {test,is_eq_exact,{f,6},[{x,1},{atom,reply}]}. - {test,is_eq_exact,{f,6},[{x,2},{y,1}]}. - remove_message. - {move,{atom,ok},{x,0}}. - {deallocate,2}. - return. - {label,6}. - {loop_rec_end,{f,5}}. - {label,7}. - {wait,{f,5}}. - - -{function, module_info, 0, 9}. - {label,8}. - {func_info,{atom,yes_14},{atom,module_info},0}. - {label,9}. - {move,{atom,yes_14},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - - -{function, module_info, 1, 11}. - {label,10}. - {func_info,{atom,yes_14},{atom,module_info},1}. - {label,11}. - {move,{x,0},{x,1}}. - {move,{atom,yes_14},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.erl new file mode 100644 index 0000000000..aa47c02af9 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.erl @@ -0,0 +1,27 @@ +-module(yes_14). +-compile(export_all). + +?MODULE() -> + ok. + +do_call(Process, Request) -> + Mref = erlang:monitor(process, Process), + Process ! Request, + Local = case node(Process) of + Node when Node =:= node() -> true; + _Node -> false + end, + id(Local), + receive + {X,Y,Z} when Mref =/= X, Z =:= 42, Mref =:= Y -> + error; + {X,Y,_} when Mref =/= X, Mref =:= Y -> + error; + {Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + {ok, Reply}; + {'DOWN', Mref, _, _, _} -> + error + end. + +id(I) -> I. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 8954a9f5fb..c6baa611ec 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -72,11 +72,9 @@ opt_opts(Mod) -> {options,Opts} = lists:keyfind(options, 1, Comp), lists:filter(fun(no_copt) -> true; (no_postopt) -> true; - (no_float_opt) -> true; - (no_new_funs) -> true; - (no_new_binaries) -> true; - (no_new_apply) -> true; - (no_gc_bifs) -> true; + (no_ssa_opt) -> true; + (no_recv_opt) -> true; + (no_ssa_float) -> true; (no_stack_trimming) -> true; (debug_info) -> true; (inline) -> true; diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index f99b6721e2..355113a94d 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.2.2 +COMPILER_VSN = 7.2.3 diff --git a/lib/configure.in.src b/lib/configure.in.src deleted file mode 100644 index d507a5c0dd..0000000000 --- a/lib/configure.in.src +++ /dev/null @@ -1,62 +0,0 @@ -dnl -dnl %CopyrightBegin% -dnl -dnl Copyright Ericsson AB 1999-2016. All Rights Reserved. -dnl -dnl Licensed under the Apache License, Version 2.0 (the "License"); -dnl you may not use this file except in compliance with the License. -dnl You may obtain a copy of the License at -dnl -dnl http://www.apache.org/licenses/LICENSE-2.0 -dnl -dnl Unless required by applicable law or agreed to in writing, software -dnl distributed under the License is distributed on an "AS IS" BASIS, -dnl WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -dnl See the License for the specific language governing permissions and -dnl limitations under the License. -dnl -dnl %CopyrightEnd% -dnl - -dnl Turn off caching -define([AC_CACHE_LOAD], )dnl -define([AC_CACHE_SAVE], )dnl - -dnl Process this file with autoconf to produce a configure script. -AC_INIT - -dnl -dnl This is just to run configure in all applications that need it. -dnl - -if test -z "$ERL_TOP" || test ! -d $ERL_TOP ; then - AC_MSG_ERROR(You need to set the environment variable ERL_TOP!) -fi -erl_top=${ERL_TOP} -AC_CONFIG_AUX_DIRS($erl_top/erts/autoconf) - -AC_ARG_ENABLE(bootstrap-only, -[ --enable-bootstrap-only enable bootstrap only configuration], -[ if test "X$enableval" = "Xyes"; then - bootstrap_only=yes - else - bootstrap_only=no - fi -], -bootstrap_only=no) - -# Multiple versions of autoconf generates code that -# don't work on all platforms (e.g. SunOS 5.8) if -# sub directories are soft links. Internally at Ericsson -# some OTP application directories are soft links. -# An added "/." solves this problem. - -@BOOTSTRAP_CONFIGURE_APPS@ - -if test $bootstrap_only = no; then - -@NON_BOOTSTRAP_CONFIGURE_APPS@ - -fi - -AC_OUTPUT diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index 31124ba477..cd0e5442e9 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -19,7 +19,6 @@ # include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -include $(ERL_TOP)/make/$(TARGET)/otp_ded.mk # ---------------------------------------------------- # Application version @@ -31,23 +30,20 @@ VSN=$(CRYPTO_VSN) # The following variables differ between systems. # Set by configure. # ---------------------------------------------------- -CC = $(DED_CC) -LD = $(DED_LD) +CC = @DED_CC@ +LD = @DED_LD@ SHELL = /bin/sh -LIBS = $(DED_LIBS) -LDFLAGS += $(DED_LDFLAGS) -CFLAGS = $(DED_CFLAGS) +LIBS = @DED_LIBS@ +LDFLAGS += @DED_LDFLAGS@ +CFLAGS = @DED_CFLAGS@ @SSL_FLAGS@ # From erts/configure SSL_LIBDIR = @SSL_LIBDIR@ SSL_INCLUDE = @SSL_INCLUDE@ SSL_CRYPTO_LIBNAME = @SSL_CRYPTO_LIBNAME@ SSL_SSL_LIBNAME = @SSL_SSL_LIBNAME@ -SSL_FLAGS = @SSL_FLAGS@ - -INCLUDES = $(SSL_INCLUDE) $(DED_INCLUDES) -CFLAGS += $(SSL_FLAGS) +INCLUDES = $(SSL_INCLUDE) @DED_INCLUDE@ ifeq ($(TYPE),debug) TYPEMARKER = .debug @@ -70,6 +66,11 @@ RELSYSDIR = $(RELEASE_PATH)/lib/crypto-$(VSN) # ---------------------------------------------------- # Misc Macros # ---------------------------------------------------- + +PRIVDIR = ../priv +OBJDIR = $(PRIVDIR)/obj/$(TARGET) +LIBDIR = $(PRIVDIR)/lib/$(TARGET) + CRYPTO_OBJS = $(OBJDIR)/crypto$(TYPEMARKER).o CALLBACK_OBJS = $(OBJDIR)/crypto_callback$(TYPEMARKER).o NIF_MAKEFILE = $(PRIVDIR)/Makefile @@ -80,19 +81,10 @@ NIF_ARCHIVE = $(LIBDIR)/crypto$(TYPEMARKER).a TEST_ENGINE_OBJS = $(OBJDIR)/otp_test_engine$(TYPEMARKER).o -ifeq ($(findstring win32,$(TARGET)), win32) -NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).dll -CALLBACK_LIB = $(LIBDIR)/crypto_callback$(TYPEMARKER).dll -TEST_ENGINE_LIB = $(LIBDIR)/otp_test_engine$(TYPEMARKER).dll -else -NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).so -CALLBACK_LIB = $(LIBDIR)/crypto_callback$(TYPEMARKER).so -TEST_ENGINE_LIB = $(LIBDIR)/otp_test_engine$(TYPEMARKER).so -endif +NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).@DED_EXT@ +CALLBACK_LIB = $(LIBDIR)/crypto_callback$(TYPEMARKER).@DED_EXT@ +TEST_ENGINE_LIB = $(LIBDIR)/otp_test_engine$(TYPEMARKER).@DED_EXT@ -ifeq ($(HOST_OS),) -HOST_OS := $(shell $(ERL_TOP)/erts/autoconf/config.guess) -endif DYNAMIC_CRYPTO_LIB=@SSL_DYNAMIC_ONLY@ ifeq ($(DYNAMIC_CRYPTO_LIB),yes) @@ -125,7 +117,7 @@ RANLIB=true endif ALL_CFLAGS = $(TYPE_FLAGS) $(EXTRA_FLAGS) $(INCLUDES) -ALL_STATIC_CFLAGS = $(DED_STATIC_CFLAGS) $(INCLUDES) +ALL_STATIC_CFLAGS = @DED_STATIC_CFLAGS@ $(INCLUDES) # ---------------------------------------------------- # Targets @@ -181,21 +173,13 @@ endif clean: -ifeq ($(findstring win32,$(TARGET)), win32) - rm -f $(LIBDIR)/crypto.dll - rm -f $(LIBDIR)/crypto.debug.dll - rm -f $(LIBDIR)/crypto_callback.dll - rm -f $(LIBDIR)/crypto_callback.debug.dll - rm -f $(LIBDIR)/otp_test_engine.dll -else - rm -f $(LIBDIR)/crypto.so - rm -f $(LIBDIR)/crypto.debug.so - rm -f $(LIBDIR)/crypto.valgrind.so - rm -f $(LIBDIR)/crypto_callback.so - rm -f $(LIBDIR)/crypto_callback.debug.so - rm -f $(LIBDIR)/crypto_callback.valgrind.so - rm -f $(LIBDIR)/otp_test_engine.so -endif + rm -f $(LIBDIR)/crypto.@DED_EXT@ + rm -f $(LIBDIR)/crypto.debug.@DED_EXT@ + rm -f $(LIBDIR)/crypto.valgrind.@DED_EXT@ + rm -f $(LIBDIR)/crypto_callback.@DED_EXT@ + rm -f $(LIBDIR)/crypto_callback.debug.@DED_EXT@ + rm -f $(LIBDIR)/crypto_callback.valgrind.@DED_EXT@ + rm -f $(LIBDIR)/otp_test_engine.@DED_EXT@ rm -f $(OBJDIR)/crypto.o rm -f $(OBJDIR)/crypto_static.o rm -f $(OBJDIR)/crypto.debug.o diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 6eeebb67a2..550342a88d 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -148,6 +148,20 @@ # define HAVE_DES_ede3_cfb_encrypt #endif +// SHA3: +# ifdef NID_sha3_224 +//Error # define HAVE_SHA3_224 +# endif +# ifdef NID_sha3_256 +//Error # define HAVE_SHA3_256 +# endif +# ifdef NID_sha3_384 +# define HAVE_SHA3_384 +# endif +# ifdef NID_sha3_512 +# define HAVE_SHA3_512 +# endif + #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'o') \ && !defined(OPENSSL_NO_EC) \ && !defined(OPENSSL_NO_ECDH) \ @@ -155,12 +169,11 @@ # define HAVE_EC #endif -// (test for == 1.1.1pre8) -#if OPENSSL_VERSION_NUMBER == (PACKED_OPENSSL_VERSION_PLAIN(1,1,1) - 7) \ +// (test for >= 1.1.1pre8) +#if OPENSSL_VERSION_NUMBER >= (PACKED_OPENSSL_VERSION_PLAIN(1,1,1) - 7) \ && !defined(HAS_LIBRESSL) \ && defined(HAVE_EC) -// EXPERIMENTAL: -# define HAVE_EDDH +# define HAVE_ED_CURVE_DH #endif #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'c') @@ -178,7 +191,16 @@ #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,0) # ifndef HAS_LIBRESSL +# define HAVE_CHACHA20 # define HAVE_CHACHA20_POLY1305 +# define HAVE_RSA_OAEP_MD +# endif +#endif + +// OPENSSL_VERSION_NUMBER >= 1.1.1-pre8 +#if OPENSSL_VERSION_NUMBER >= (PACKED_OPENSSL_VERSION_PLAIN(1,1,1)-7) +# ifndef HAS_LIBRESSL +# define HAVE_POLY1305 # endif #endif @@ -523,6 +545,11 @@ static ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_N static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM chacha20_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM chacha20_stream_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM poly1305_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -536,6 +563,7 @@ static ERL_NIF_TERM engine_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE static ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM engine_get_next_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM engine_get_name_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); /* helpers */ @@ -612,6 +640,12 @@ static ErlNifFunc nif_funcs[] = { {"chacha20_poly1305_encrypt", 4, chacha20_poly1305_encrypt}, {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt}, + {"chacha20_stream_init", 2, chacha20_stream_init}, + {"chacha20_stream_encrypt", 2, chacha20_stream_crypt}, + {"chacha20_stream_decrypt", 2, chacha20_stream_crypt}, + + {"poly1305_nif", 2, poly1305_nif}, + {"engine_by_id_nif", 1, engine_by_id_nif}, {"engine_init_nif", 1, engine_init_nif}, {"engine_finish_nif", 1, engine_finish_nif}, @@ -625,6 +659,7 @@ static ErlNifFunc nif_funcs[] = { {"engine_get_first_nif", 0, engine_get_first_nif}, {"engine_get_next_nif", 1, engine_get_next_nif}, {"engine_get_id_nif", 1, engine_get_id_nif}, + {"engine_get_name_nif", 1, engine_get_name_nif}, {"engine_get_all_methods_nif", 0, engine_get_all_methods_nif} }; @@ -684,8 +719,7 @@ static ERL_NIF_TERM atom_rsa; static ERL_NIF_TERM atom_dss; static ERL_NIF_TERM atom_ecdsa; -#ifdef HAVE_EDDH -static ERL_NIF_TERM atom_eddh; +#ifdef HAVE_ED_CURVE_DH static ERL_NIF_TERM atom_x25519; static ERL_NIF_TERM atom_x448; #endif @@ -705,6 +739,10 @@ static ERL_NIF_TERM atom_sha224; static ERL_NIF_TERM atom_sha256; static ERL_NIF_TERM atom_sha384; static ERL_NIF_TERM atom_sha512; +static ERL_NIF_TERM atom_sha3_224; +static ERL_NIF_TERM atom_sha3_256; +static ERL_NIF_TERM atom_sha3_384; +static ERL_NIF_TERM atom_sha3_512; static ERL_NIF_TERM atom_md5; static ERL_NIF_TERM atom_ripemd160; @@ -790,6 +828,35 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"sha3_224"}, +#ifdef HAVE_SHA3_224 + {&EVP_sha3_224} +#else + {NULL} +#endif + }, + {{"sha3_256"}, +#ifdef HAVE_SHA3_256 + {&EVP_sha3_256} +#else + {NULL} +#endif + }, + {{"sha3_384"}, +#ifdef HAVE_SHA3_384 + {&EVP_sha3_384} +#else + {NULL} +#endif + }, + {{"sha3_512"}, +#ifdef HAVE_SHA3_512 + {&EVP_sha3_512} +#else + {NULL} +#endif + }, + {{NULL}} }; @@ -1097,8 +1164,7 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_rsa = enif_make_atom(env,"rsa"); atom_dss = enif_make_atom(env,"dss"); atom_ecdsa = enif_make_atom(env,"ecdsa"); -#ifdef HAVE_EDDH - atom_eddh = enif_make_atom(env,"eddh"); +#ifdef HAVE_ED_CURVE_DH atom_x25519 = enif_make_atom(env,"x25519"); atom_x448 = enif_make_atom(env,"x448"); #endif @@ -1117,6 +1183,10 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_sha256 = enif_make_atom(env,"sha256"); atom_sha384 = enif_make_atom(env,"sha384"); atom_sha512 = enif_make_atom(env,"sha512"); + atom_sha3_224 = enif_make_atom(env,"sha3_224"); + atom_sha3_256 = enif_make_atom(env,"sha3_256"); + atom_sha3_384 = enif_make_atom(env,"sha3_384"); + atom_sha3_512 = enif_make_atom(env,"sha3_512"); atom_md5 = enif_make_atom(env,"md5"); atom_ripemd160 = enif_make_atom(env,"ripemd160"); @@ -1237,13 +1307,13 @@ static void unload(ErlNifEnv* env, void* priv_data) } static int algo_hash_cnt, algo_hash_fips_cnt; -static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */ +static ERL_NIF_TERM algo_hash[12]; /* increase when extending the list */ static int algo_pubkey_cnt, algo_pubkey_fips_cnt; static ERL_NIF_TERM algo_pubkey[11]; /* increase when extending the list */ static int algo_cipher_cnt, algo_cipher_fips_cnt; static ERL_NIF_TERM algo_cipher[24]; /* increase when extending the list */ static int algo_mac_cnt, algo_mac_fips_cnt; -static ERL_NIF_TERM algo_mac[2]; /* increase when extending the list */ +static ERL_NIF_TERM algo_mac[3]; /* increase when extending the list */ static int algo_curve_cnt, algo_curve_fips_cnt; static ERL_NIF_TERM algo_curve[87]; /* increase when extending the list */ @@ -1264,6 +1334,18 @@ static void init_algorithms_types(ErlNifEnv* env) #ifdef HAVE_SHA512 algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha512"); #endif +#ifdef HAVE_SHA3_224 + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha3_224"); +#endif +#ifdef HAVE_SHA3_256 + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha3_256"); +#endif +#ifdef HAVE_SHA3_384 + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha3_384"); +#endif +#ifdef HAVE_SHA3_512 + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha3_512"); +#endif // Non-validated algorithms follow algo_hash_fips_cnt = algo_hash_cnt; algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md4"); @@ -1283,9 +1365,6 @@ static void init_algorithms_types(ErlNifEnv* env) #endif // Non-validated algorithms follow algo_pubkey_fips_cnt = algo_pubkey_cnt; -#ifdef HAVE_EDDH - algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "eddh"); -#endif algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "srp"); // Validated algorithms first @@ -1331,23 +1410,119 @@ static void init_algorithms_types(ErlNifEnv* env) #if defined(HAVE_CHACHA20_POLY1305) algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305"); #endif - +#if defined(HAVE_CHACHA20) + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20"); +#endif + // Validated algorithms first algo_mac_cnt = 0; algo_mac[algo_mac_cnt++] = enif_make_atom(env,"hmac"); #ifdef HAVE_CMAC algo_mac[algo_mac_cnt++] = enif_make_atom(env,"cmac"); #endif +#ifdef HAVE_POLY1305 + algo_mac[algo_mac_cnt++] = enif_make_atom(env,"poly1305"); +#endif // Non-validated algorithms follow algo_mac_fips_cnt = algo_mac_cnt; - // Validated algorithms first algo_curve_cnt = 0; +#if defined(HAVE_EC) + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp160k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp160r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp160r2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp192r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp192k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp224k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp224r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp256k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp256r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp384r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp521r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"prime192v1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"prime192v2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"prime192v3"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"prime239v1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"prime239v2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"prime239v3"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"prime256v1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls7"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls9"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls12"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP160r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP160t1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP192r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP192t1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP224r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP224t1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP256r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP256t1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP320r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP320t1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP384r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP384t1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP512r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"brainpoolP512t1"); +#if !defined(OPENSSL_NO_EC2M) + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect163k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect163r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect163r2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect193r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect193r2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect233k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect233r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect239k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect283k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect283r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect409k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect409r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect571k1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect571r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2pnb163v1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2pnb163v2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2pnb163v3"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2pnb176v1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2tnb191v1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2tnb191v2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2tnb191v3"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2pnb208w1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2tnb239v1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2tnb239v2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2tnb239v3"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2pnb272w1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2pnb304w1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2tnb359v1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2pnb368w1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"c2tnb431r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls3"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls5"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls10"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls11"); +#endif +#endif // Non-validated algorithms follow algo_curve_fips_cnt = algo_curve_cnt; +#if defined(HAVE_EC) + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp112r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp112r2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp128r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"secp128r2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls6"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls8"); +#if !defined(OPENSSL_NO_EC2M) + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect113r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect113r2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect131r1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"sect131r2"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls1"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"wtls4"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"ipsec3"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"ipsec4"); +#endif +#endif //-- -#ifdef HAVE_EDDH +#ifdef HAVE_ED_CURVE_DH algo_curve[algo_curve_cnt++] = enif_make_atom(env,"x25519"); algo_curve[algo_curve_cnt++] = enif_make_atom(env,"x448"); #endif @@ -1989,6 +2164,62 @@ static ERL_NIF_TERM cmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] #endif } +/* For OpenSSL >= 1.1.1 the hmac_nif and cmac_nif could be integrated into poly1305 (with 'type' as parameter) */ +static ERL_NIF_TERM poly1305_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Text) */ +#ifdef HAVE_POLY1305 + ErlNifBinary key_bin, text, ret_bin; + ERL_NIF_TERM ret = atom_error; + EVP_PKEY *key = NULL; + EVP_MD_CTX *mctx = NULL; + EVP_PKEY_CTX *pctx = NULL; + const EVP_MD *md = NULL; + size_t size; + int type; + + type = EVP_PKEY_POLY1305; + + if (!enif_inspect_binary(env, argv[0], &key_bin) || + !(key_bin.size == 32) ) { + return enif_make_badarg(env); + } + + if (!enif_inspect_binary(env, argv[1], &text) ) { + return enif_make_badarg(env); + } + + key = EVP_PKEY_new_raw_private_key(type, /*engine*/ NULL, key_bin.data, key_bin.size); + + if (!key || + !(mctx = EVP_MD_CTX_new()) || + !EVP_DigestSignInit(mctx, &pctx, md, /*engine*/ NULL, key) || + !EVP_DigestSignUpdate(mctx, text.data, text.size)) { + goto err; + } + + if (!EVP_DigestSignFinal(mctx, NULL, &size) || + !enif_alloc_binary(size, &ret_bin) || + !EVP_DigestSignFinal(mctx, ret_bin.data, &size)) { + goto err; + } + + if ((size != ret_bin.size) && + !enif_realloc_binary(&ret_bin, size)) { + goto err; + } + + ret = enif_make_binary(env, &ret_bin); + + err: + EVP_MD_CTX_free(mctx); + EVP_PKEY_free(key); + return ret; + +#else + return atom_notsup; +#endif +} + static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Key, Ivec, Text, IsEncrypt) or (Type, Key, Text, IsEncrypt) */ struct cipher_type_t *cipherp = NULL; @@ -2573,6 +2804,69 @@ out_err: #endif } + +static ERL_NIF_TERM chacha20_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IV) */ +#if defined(HAVE_CHACHA20) + ErlNifBinary key_bin, ivec_bin; + struct evp_cipher_ctx *ctx; + const EVP_CIPHER *cipher; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || key_bin.size != 32 + || ivec_bin.size != 16) { + return enif_make_badarg(env); + } + + cipher = EVP_chacha20(); + + ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx)); + ctx->ctx = EVP_CIPHER_CTX_new(); + + + EVP_CipherInit_ex(ctx->ctx, cipher, NULL, + key_bin.data, ivec_bin.data, 1); + EVP_CIPHER_CTX_set_padding(ctx->ctx, 0); + ret = enif_make_resource(env, ctx); + enif_release_resource(ctx); + return ret; +#else + return enif_raise_exception(env, atom_notsup); +#endif +}; + +static ERL_NIF_TERM chacha20_stream_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (State, Data) */ +#if defined(HAVE_CHACHA20) + struct evp_cipher_ctx *ctx, *new_ctx; + ErlNifBinary data_bin; + ERL_NIF_TERM ret, cipher_term; + unsigned char *out; + int outl = 0; + + if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx) + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); + } + new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx)); + new_ctx->ctx = EVP_CIPHER_CTX_new(); + EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx); + out = enif_make_new_binary(env, data_bin.size, &cipher_term); + EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, data_bin.size); + ASSERT(outl == data_bin.size); + + ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); + enif_release_resource(new_ctx); + CONSUME_REDS(env,data_bin); + return ret; +#else + return enif_raise_exception(env, atom_notsup); +#endif +}; + + static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes) */ unsigned bytes; @@ -3810,7 +4104,7 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF int i; EC_GROUP *group; const BIGNUM *priv_key; - EC_POINT *my_ecpoint; + EC_POINT *my_ecpoint = NULL; EC_KEY *other_ecdh = NULL; if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key)) @@ -3853,11 +4147,10 @@ out_err: #endif } -// EXPERIMENTAL! static ERL_NIF_TERM evp_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) /* (Curve, PeerBin, MyBin) */ { -#ifdef HAVE_EDDH +#ifdef HAVE_ED_CURVE_DH int type; EVP_PKEY_CTX *ctx; ErlNifBinary peer_bin, my_bin, key_bin; @@ -3909,11 +4202,10 @@ static ERL_NIF_TERM evp_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ #endif } -// EXPERIMENTAL! static ERL_NIF_TERM evp_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) /* (Curve) */ { -#ifdef HAVE_EDDH +#ifdef HAVE_ED_CURVE_DH int type; EVP_PKEY_CTX *ctx; EVP_PKEY *pkey = NULL; @@ -3926,22 +4218,20 @@ static ERL_NIF_TERM evp_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF if (!(ctx = EVP_PKEY_CTX_new_id(type, NULL))) return enif_make_badarg(env); - if (!EVP_PKEY_keygen_init(ctx)) return enif_make_atom(env,"EVP_PKEY_keygen_init failed"); - if (!EVP_PKEY_keygen(ctx, &pkey)) return enif_make_atom(env,"EVP_PKEY_keygen failed"); + if (!EVP_PKEY_keygen_init(ctx)) return atom_error; + if (!EVP_PKEY_keygen(ctx, &pkey)) return atom_error; - if (!EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len)) - return enif_make_atom(env,"EVP_PKEY_get_raw_public_key 1 failed"); + if (!EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len)) return atom_error; if (!EVP_PKEY_get_raw_public_key(pkey, enif_make_new_binary(env, key_len, &ret_pub), &key_len)) - return enif_make_atom(env,"EVP_PKEY_get_raw_public_key 2 failed"); + return atom_error; - if (!EVP_PKEY_get_raw_private_key(pkey, NULL, &key_len)) - return enif_make_atom(env,"EVP_PKEY_get_raw_private_key 1 failed"); + if (!EVP_PKEY_get_raw_private_key(pkey, NULL, &key_len)) return atom_error; if (!EVP_PKEY_get_raw_private_key(pkey, enif_make_new_binary(env, key_len, &ret_prv), &key_len)) - return enif_make_atom(env,"EVP_PKEY_get_raw_private_key 2 failed"); + return atom_error; return enif_make_tuple2(env, ret_pub, ret_prv); #else @@ -4876,7 +5166,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM } else { /* non-evp rsa private decrypt */ i = RSA_private_decrypt(in_bin.size, in_bin.data, - out_bin.data, rsa, crypt_opt.rsa_padding); + out_bin.data, rsa, crypt_opt.rsa_padding); if (i > 0) { ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); enif_realloc_binary(&out_bin, i); @@ -4894,7 +5184,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM } else { /* non-evp rsa public decrypt */ i = RSA_public_decrypt(in_bin.size, in_bin.data, - out_bin.data, rsa, crypt_opt.rsa_padding); + out_bin.data, rsa, crypt_opt.rsa_padding); if (i > 0) { ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); enif_realloc_binary(&out_bin, i); @@ -5012,7 +5302,7 @@ static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NI / * Example of result: { Curve = {Field, Prime, Point, Order, CoFactor} = - { + { Field = {prime_field,<<255,...,255>>}, Prime = {<<255,...,252>>, <<90,...,75>>, @@ -5025,9 +5315,9 @@ static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NI Key = <<151,...,62>> } or - { + { Curve = - {characteristic_two_field, + {characteristic_two_field, M, Basis = {tpbasis, _} | {ppbasis, k1, k2, k3} @@ -5040,7 +5330,7 @@ static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NI */ #endif } - + if (pkey) EVP_PKEY_free(pkey); return enif_make_badarg(env); } @@ -5221,7 +5511,7 @@ static ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const error: for(i = 0; cmds != NULL && cmds[i] != NULL; i++) - enif_free(cmds[i]); + enif_free(cmds[i]); enif_free(cmds); return ret; #else @@ -5539,7 +5829,7 @@ static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE if (!engine_id) { enif_alloc_binary(0, &engine_id_bin); engine_id_bin.size = 0; - return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_id_bin)); + return enif_make_binary(env, &engine_id_bin); } size = strlen(engine_id); @@ -5547,7 +5837,39 @@ static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE engine_id_bin.size = size; memcpy(engine_id_bin.data, engine_id, size); - return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_id_bin)); + return enif_make_binary(env, &engine_id_bin); +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM engine_get_name_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Engine) */ +#ifdef HAS_ENGINE_SUPPORT + ErlNifBinary engine_name_bin; + const char *engine_name; + int size; + struct engine_ctx *ctx; + + // Get Engine + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { + PRINTF_ERR0("engine_get_id_nif Leaved: Parameter not an engine resource object"); + return enif_make_badarg(env); + } + + engine_name = ENGINE_get_name(ctx->engine); + if (!engine_name) { + enif_alloc_binary(0, &engine_name_bin); + engine_name_bin.size = 0; + return enif_make_binary(env, &engine_name_bin); + } + + size = strlen(engine_name); + enif_alloc_binary(size, &engine_name_bin); + engine_name_bin.size = size; + memcpy(engine_name_bin.data, engine_name, size); + + return enif_make_binary(env, &engine_name_bin); #else return atom_notsup; #endif diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c index b6c9067964..34c825059f 100644 --- a/lib/crypto/c_src/otp_test_engine.c +++ b/lib/crypto/c_src/otp_test_engine.c @@ -64,7 +64,8 @@ static int test_init(ENGINE *e) { printf("OTP Test Engine Initializatzion!\r\n"); /* Load all digest and cipher algorithms. Needed for password protected private keys */ - OpenSSL_add_all_algorithms(); + OpenSSL_add_all_ciphers(); + OpenSSL_add_all_digests(); return 111; } diff --git a/lib/crypto/configure.in b/lib/crypto/configure.in new file mode 100644 index 0000000000..a3b6673f29 --- /dev/null +++ b/lib/crypto/configure.in @@ -0,0 +1,775 @@ +dnl Process this file with autoconf to produce a configure script. -*-m4-*- +dnl +dnl %CopyrightBegin% +dnl +dnl Copyright Ericsson AB 2018. All Rights Reserved. +dnl +dnl Licensed under the Apache License, Version 2.0 (the "License"); +dnl you may not use this file except in compliance with the License. +dnl You may obtain a copy of the License at +dnl +dnl http://www.apache.org/licenses/LICENSE-2.0 +dnl +dnl Unless required by applicable law or agreed to in writing, software +dnl distributed under the License is distributed on an "AS IS" BASIS, +dnl WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +dnl See the License for the specific language governing permissions and +dnl limitations under the License. +dnl +dnl %CopyrightEnd% +dnl + +dnl define([AC_CACHE_LOAD], )dnl +dnl define([AC_CACHE_SAVE], )dnl + + +AC_INIT(vsn.mk) + +if test -z "$ERL_TOP" || test ! -d "$ERL_TOP" ; then + AC_CONFIG_AUX_DIRS(autoconf) +else + erl_top=${ERL_TOP} + AC_CONFIG_AUX_DIRS($erl_top/erts/autoconf) +fi + +if test "X$host" != "Xfree_source" -a "X$host" != "Xwin32"; then + AC_CANONICAL_HOST +else + host_os=win32 +fi + +LM_PRECIOUS_VARS + +if test "$cross_compiling" = "yes"; then + CROSS_COMPILING=yes +else + CROSS_COMPILING=no +fi +AC_SUBST(CROSS_COMPILING) + +ERL_XCOMP_SYSROOT_INIT + +AC_PROG_CC +LM_WINDOWS_ENVIRONMENT + +ERL_DED + +dnl +dnl SSL, SSH and CRYPTO need the OpenSSL libraries +dnl +dnl Check flags --with-ssl, --without-ssl --with-ssl=PATH. +dnl If no option is given or --with-ssl is set without a path then we +dnl search for OpenSSL libraries and header files in the standard locations. +dnl If set to --without-ssl we disable the use of SSL, SSH and CRYPTO. +dnl If set to --with-ssl=PATH we use that path as the prefix, i.e. we +dnl use "PATH/include" and "PATH/lib". + +AC_CHECK_SIZEOF(void *) + +std_ssl_locations="/usr/local /usr/sfw /usr /opt/local /usr/pkg /usr/local/openssl /usr/lib/openssl /usr/openssl /usr/local/ssl /usr/lib/ssl /usr/ssl /" + +AC_ARG_WITH(ssl-zlib, +AS_HELP_STRING([--with-ssl-zlib=PATH], + [specify location of ZLib to be used by OpenSSL]) +AS_HELP_STRING([--with-ssl-zlib], + [link SSL with Zlib (default if found)]) +AS_HELP_STRING([--without-ssl-zlib], + [don't link SSL with ZLib])) + +if test "x$with_ssl_zlib" = "xno"; then + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= +elif test "x$with_ssl_zlib" = "xyes" || test "x$with_ssl_zlib" = "x"; then + if test $erl_xcomp_without_sysroot = yes; then + AC_MSG_WARN([Cannot search for zlib; missing cross system root (erl_xcomp_sysroot).]) + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= + elif test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= + else + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= + AC_MSG_CHECKING(for static ZLib to be used by SSL in standard locations) + for rdir in $std_ssl_locations; do + dir="$erl_xcomp_sysroot$rdir" + if test "x$ac_cv_sizeof_void_p" = "x8"; then + if test -f "$dir/lib64/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS="$dir/lib64/libz.a" + break + elif test -f "$dir/lib/64/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS="$dir/lib/64/libz.a" + break + fi + fi + if test -f "$dir/lib/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS="$dir/lib/libz.a" + break + fi + done + if test "x$SSL_LINK_WITH_ZLIB" = "xno"; then + AC_MSG_RESULT([no]) + else + AC_MSG_RESULT([$STATIC_ZLIB_LIBS]) + fi + fi +else + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= + if test -f "$with_ssl_zlib/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS=$with_ssl_zlib/libz.a + elif test -f "$with_ssl_zlib/lib/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS=$with_ssl_zlib/lib/libz.a + fi + if test "x$ac_cv_sizeof_void_p" = "x8"; then + if test -f "$with_ssl_zlib/lib64/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS=$with_ssl_zlib/lib64/libz.a + elif test -f "$with_ssl_zlib/lib/64/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS=$with_ssl_zlib/lib/64/libz.a + fi + fi + if test "x$SSL_LINK_WITH_ZLIB" = "xno"; then + AC_MSG_ERROR(Invalid path to option --with-ssl-zlib=PATH) + fi +fi + + +AC_ARG_WITH(ssl, +AS_HELP_STRING([--with-ssl=PATH], [specify location of OpenSSL include and lib]) +AS_HELP_STRING([--with-ssl], [use SSL (default)]) +AS_HELP_STRING([--without-ssl], [don't use SSL])) + +AC_ARG_WITH(ssl-incl, +AS_HELP_STRING([--with-ssl-incl=PATH], [location of OpenSSL include dir, if different than specified by --with-ssl=PATH]), +[ +case X$with_ssl in + X | Xyes | Xno) AC_MSG_ERROR([--with-ssl-incl=PATH set without --with-ssl=PATH]);; +esac +], +[with_ssl_incl=$with_ssl]) #default + +AC_ARG_WITH(ssl-rpath, +AS_HELP_STRING([--with-ssl-rpath=yes|no|PATHS], + [runtime library path for OpenSSL. Default is "yes", which equates to a + number of standard locations. If "no", then no runtime + library paths will be used. Anything else should be a + comma separated list of paths.]), +[ +case X$with_ssl in + Xno) AC_MSG_ERROR([--with-ssl-rpath set without --with-ssl]);; +esac +], +[with_ssl_rpath=yes]) #default + + +AC_ARG_ENABLE(dynamic-ssl-lib, +AS_HELP_STRING([--disable-dynamic-ssl-lib], + [disable using dynamic openssl libraries]), +[ case "$enableval" in + no) enable_dynamic_ssl=no ;; + *) enable_dynamic_ssl=yes ;; + esac ], enable_dynamic_ssl=yes) + +#---------------------------------------------------------------------- +# We actually might do the SSL tests twice due to late discovery of +# kerberos problems with static linking, in case we redo it all trying +# dynamic SSL libraries instead. +#---------------------------------------------------------------------- + +ssl_done=no + +while test "x$ssl_done" != "xyes"; do + +ssl_done=yes # Default only one run + +# Remove all SKIP files from previous runs +for a in ssl crypto ssh; do + rm -f "$ERL_TOP/lib/$a/SKIP" +done + +SSL_DYNAMIC_ONLY=$enable_dynamic_ssl +SSL_STATIC_ONLY=no + +case "$erl_xcomp_without_sysroot-$with_ssl" in + yes-* | no-no) + SSL_APP= + CRYPTO_APP= + SSH_APP= + if test "$with_ssl" = "no"; then + skip="User gave --without-ssl option" + else + skip="Cannot search for ssl; missing cross system root (erl_xcomp_sysroot)." + fi + for a in ssl crypto ssh; do + echo "$skip" > $ERL_TOP/lib/$a/SKIP + done + ;; + no-yes | no- ) + # On windows, we could try to find the installation + # of Shining Light OpenSSL, which can be found by poking in + # the uninstall section in the registry, it's worth a try... + extra_dir="" + if test "x$MIXED_CYGWIN" = "xyes"; then + AC_CHECK_PROG(REGTOOL, regtool, regtool, false) + if test "$ac_cv_prog_REGTOOL" != false; then + wrp="/machine/software/microsoft/windows/currentversion/" + if test "x$ac_cv_sizeof_void_p" = "x8"; then + urp="uninstall/openssl (64-bit)_is1/inno setup: app path" + regtool_subsystem=-w + else + urp="uninstall/openssl (32-bit)_is1/inno setup: app path" + regtool_subsystem=-W + fi + rp="$wrp$urp" + if regtool -q $regtool_subsystem get "$rp" > /dev/null; then + true + else + # Fallback to unspecified wordlength + urp="uninstall/openssl_is1/inno setup: app path" + rp="$wrp$urp" + fi + if regtool -q $regtool_subsystem get "$rp" > /dev/null; then + ssl_install_dir=`regtool -q $regtool_subsystem get "$rp"` + # Try hard to get rid of spaces... + if cygpath -d "$ssl_install_dir" > /dev/null 2>&1; then + ssl_install_dir=`cygpath -d "$ssl_install_dir"` + fi + extra_dir=`cygpath $ssl_install_dir` + fi + fi + elif test "x$MIXED_MSYS" = "xyes"; then + AC_CHECK_PROG(REGTOOL, reg_query.sh, reg_query.sh, false) + if test "$ac_cv_prog_REGTOOL" != false; then + if test "x$ac_cv_sizeof_void_p" = "x8"; then + rp="HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/OpenSSL (64-bit)_is1" + else + rp="HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/OpenSSL_is1" + fi + key="Inno Setup: App Path" + if "$ac_cv_prog_REGTOOL" "$rp" "$key" > /dev/null; then + ssl_install_dir=`"$ac_cv_prog_REGTOOL" "$rp" "$key"` + extra_dir=`win2msys_path.sh "$ssl_install_dir"` + fi + fi + fi + # We search for OpenSSL in the common OS standard locations. + SSL_APP=ssl + CRYPTO_APP=crypto + SSH_APP=ssh + + SSL_CRYPTO_LIBNAME=crypto + SSL_SSL_LIBNAME=ssl + + if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then + if test "x$ac_cv_sizeof_void_p" = "x8"; then + std_win_ssl_locations="/cygdrive/c/OpenSSL-Win64 /c/OpenSSL-Win64 /opt/local64/pgm/OpenSSL" + else + std_win_ssl_locations="/cygdrive/c/OpenSSL-Win32 /c/OpenSSL-Win32 /cygdrive/c/OpenSSL /c/OpenSSL /opt/local/pgm/OpenSSL" + fi + else + std_win_ssl_locations="" + fi + + + AC_MSG_CHECKING(for OpenSSL >= 0.9.8c in standard locations) + for rdir in $extra_dir $std_win_ssl_locations $std_ssl_locations; do + dir="$erl_xcomp_sysroot$rdir" + if test -f "$erl_xcomp_isysroot$rdir/include/openssl/opensslv.h"; then + is_real_ssl=yes + SSL_INCDIR="$dir" + if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then + if test -f "$dir/lib/VC/libeay32.lib"; then + SSL_RUNTIME_LIBDIR="$rdir/lib/VC" + SSL_LIBDIR="$dir/lib/VC" + SSL_CRYPTO_LIBNAME=libeay32 + SSL_SSL_LIBNAME=ssleay32 + elif test -f "$dir/lib/VC/openssl.lib"; then + SSL_RUNTIME_LIBDIR="$rdir/lib/VC" + SSL_LIBDIR="$dir/lib/VC" + elif test -f $dir/lib/VC/libeay32MD.lib; then + SSL_CRYPTO_LIBNAME=libeay32MD + SSL_SSL_LIBNAME=ssleay32MD + if test "x$enable_dynamic_ssl" = "xno" && \ + test -f $dir/lib/VC/static/libeay32MD.lib; then + SSL_RUNTIME_LIBDIR="$rdir/lib/VC/static" + SSL_LIBDIR="$dir/lib/VC/static" + else + SSL_RUNTIME_LIBDIR="$rdir/lib/VC" + SSL_LIBDIR="$dir/lib/VC" + fi + elif test -f "$dir/lib/libeay32.lib"; then + SSL_RUNTIME_LIBDIR="$rdir/lib" + SSL_LIBDIR="$dir/lib" + SSL_CRYPTO_LIBNAME=libeay32 + SSL_SSL_LIBNAME=ssleay32 + elif test -f "$dir/lib/openssl.lib"; then + SSL_RUNTIME_LIBDIR="$rdir/lib" + SSL_LIBDIR="$dir/lib" + else + is_real_ssl=no + fi + elif test -f "$dir/lib/powerpc/libsslcrypto.a"; then + SSL_CRYPTO_LIBNAME=sslcrypto + SSL_LIBDIR="$dir/lib/powerpc/" + SSL_RUNTIME_LIBDIR="$rdir/lib/powerpc/" + else + if test "x$ac_cv_sizeof_void_p" = "x8"; then + if test -f "$dir/lib64/libcrypto.a"; then + SSL_RUNTIME_LIBDIR="$rdir/lib64" + SSL_LIBDIR="$dir/lib64" + elif test -f "$dir/lib/64/libcrypto.a"; then + SSL_RUNTIME_LIBDIR="$rdir/lib/64" + SSL_LIBDIR="$dir/lib/64" + elif test -f "$dir/lib64/libcrypto.so"; then + SSL_RUNTIME_LIBDIR="$rdir/lib64" + SSL_LIBDIR="$dir/lib64" + elif test -f "$dir/lib/64/libcrypto.so"; then + SSL_RUNTIME_LIBDIR="$rdir/lib/64" + SSL_LIBDIR="$dir/lib/64" + else + SSL_RUNTIME_LIBDIR="$rdir/lib" + SSL_LIBDIR="$dir/lib" + fi + else + SSL_RUNTIME_LIBDIR="$rdir/lib" + SSL_LIBDIR="$dir/lib" + fi + fi + if test '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.a"; then + SSL_DYNAMIC_ONLY=yes + elif test '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.so" -a '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.dylib"; then + SSL_STATIC_ONLY=yes + fi + SSL_BINDIR="$rdir/bin" + if test "x$is_real_ssl" = "xyes" ; then + SSL_INCLUDE="-I$dir/include" + old_CPPFLAGS=$CPPFLAGS + CPPFLAGS=$SSL_INCLUDE + AC_EGREP_CPP(^yes$,[ +#include <openssl/opensslv.h> +#if OPENSSL_VERSION_NUMBER >= 0x0090803fL +yes +#endif + ],[ + ssl_found=yes + ],[ + SSL_APP= + ssl_found=no + ]) + CPPFLAGS=$old_CPPFLAGS + if test "x$ssl_found" = "xyes"; then + if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then + ssl_linkable=yes + elif test "x${SSL_CRYPTO_LIBNAME}" = "xsslcrypto"; then + # This should only be triggered seen OSE + ssl_linkable=yes + else + saveCFLAGS="$CFLAGS" + saveLDFLAGS="$LDFLAGS" + saveLIBS="$LIBS" + CFLAGS="$CFLAGS $SSL_INCLUDE" + if test "x$SSL_STATIC_ONLY" = "xyes"; then + LIBS="${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.a" + else + LDFLAGS="$LDFLAGS -L$SSL_LIBDIR" + LIBS="$LIBS -l${SSL_CRYPTO_LIBNAME}" + fi + AC_TRY_LINK([ + #include <stdio.h> + #include <openssl/hmac.h>], + [ + HMAC(0, 0, 0, 0, 0, 0, 0); + ], + [ssl_linkable=yes], + [ssl_linkable=no]) + CFLAGS="$saveCFLAGS" + LDFLAGS="$saveLDFLAGS" + LIBS="$saveLIBS" + fi + fi + if test "x$ssl_found" = "xyes" && test "x$ssl_linkable" = "xyes"; then + AC_MSG_RESULT([$dir]) + break; + fi + fi + fi + done + + if test "x$ssl_found" != "xyes" ; then + dnl + dnl If no SSL found above, check whether we are running on OpenBSD. + dnl + case $host_os in + openbsd*) + if test -f "$erl_xcomp_isysroot/usr/include/openssl/opensslv.h"; then + # Trust OpenBSD to have everything the in the correct locations. + ssl_found=yes + ssl_linkable=yes + SSL_INCDIR="$erl_xcomp_sysroot/usr" + AC_MSG_RESULT([$SSL_INCDIR]) + SSL_RUNTIME_LIB="/usr/lib" + SSL_LIB="$erl_xcomp_sysroot/usr/lib" + SSL_BINDIR="/usr/sbin" + dnl OpenBSD requires us to link with -L and -l + SSL_DYNAMIC_ONLY="yes" + fi + ;; + esac + fi +dnl Now, certain linuxes have a 64bit libcrypto +dnl that cannot build shared libraries (i.e. not PIC) +dnl One could argue that this is wrong, but +dnl so it is - be adoptable + if test "$ssl_found" = "yes" && test "$ssl_linkable" = "yes" && test "$SSL_DYNAMIC_ONLY" != "yes"; then + case $host_os in + linux*) + saveCFLAGS="$CFLAGS" + saveLDFLAGS="$LDFLAGS" + saveLIBS="$LIBS" + CFLAGS="$DED_CFLAGS $SSL_INCLUDE" + LDFLAGS="$DED_LDFLAGS" + LIBS="$SSL_LIBDIR/libcrypto.a $STATIC_ZLIB_LIBS" + AC_TRY_LINK([ + #include <stdio.h> + #include <openssl/hmac.h>], + [ + HMAC(0, 0, 0, 0, 0, 0, 0); + ], + [ssl_dyn_linkable=yes], + [ssl_dyn_linkable=no]) + CFLAGS="$saveCFLAGS" + LDFLAGS="$saveLDFLAGS" + LIBS="$saveLIBS" + if test "x$ssl_dyn_linkable" != "xyes"; then + SSL_DYNAMIC_ONLY=yes + AC_MSG_WARN([SSL will be linked against dynamic lib as static lib is not purely relocatable]) + fi + ;; + esac + fi + + + + + if test "x$ssl_found" != "xyes" || test "x$ssl_linkable" != "xyes"; then + if test "x$ssl_found" = "xyes"; then + AC_MSG_RESULT([found; but not usable]) + else + AC_MSG_RESULT([no]) + fi + SSL_APP= + CRYPTO_APP= + SSH_APP= + AC_MSG_WARN([No (usable) OpenSSL found, skipping ssl, ssh and crypto applications]) + + for a in ssl crypto ssh; do + echo "No usable OpenSSL found" > $ERL_TOP/lib/$a/SKIP + done + fi + ;; + *) + # Option given with PATH to package + if test ! -d "$with_ssl" ; then + AC_MSG_ERROR(Invalid path to option --with-ssl=PATH) + fi + if test ! -d "$with_ssl_incl" ; then + AC_MSG_ERROR(Invalid path to option --with-ssl-incl=PATH) + fi + SSL_INCDIR="$with_ssl_incl" + SSL_CRYPTO_LIBNAME=crypto + SSL_SSL_LIBNAME=ssl + if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes" && test -d "$with_ssl/lib/VC"; then + if test -f "$with_ssl/lib/VC/libeay32.lib"; then + SSL_LIBDIR="$with_ssl/lib/VC" + SSL_CRYPTO_LIBNAME=libeay32 + SSL_SSL_LIBNAME=ssleay32 + elif test -f "$with_ssl/lib/VC/openssl.lib"; then + SSL_LIBDIR="$with_ssl/lib/VC" + elif test -f $with_ssl/lib/VC/libeay32MD.lib; then + SSL_CRYPTO_LIBNAME=libeay32MD + SSL_SSL_LIBNAME=ssleay32MD + if test "x$enable_dynamic_ssl" = "xno" && \ + test -f $with_ssl/lib/VC/static/libeay32MD.lib; then + SSL_LIBDIR="$with_ssl/lib/VC/static" + else + SSL_LIBDIR="$with_ssl/lib/VC" + fi + elif test -f "$with_ssl/lib/libeay32.lib"; then + SSL_LIBDIR="$with_ssl/lib" + SSL_CRYPTO_LIBNAME=libeay32 + SSL_SSL_LIBNAME=ssleay32 + else + # This probably wont work, but that's what the user said, so... + SSL_LIBDIR="$with_ssl/lib" + fi + elif test -f "$dir/lib/powerpc/libsslcrypto.a"; then + SSL_CRYPTO_LIBNAME=sslcrypto + SSL_LIBDIR="$with_ssl/lib/powerpc/" + elif test "x$ac_cv_sizeof_void_p" = "x8"; then + if test -f "$with_ssl/lib64/libcrypto.a"; then + SSL_LIBDIR="$with_ssl/lib64" + elif test -f "$with_ssl/lib/64/libcrypto.a"; then + SSL_LIBDIR="$with_ssl/lib/64" + elif test -f "$with_ssl/lib64/libcrypto.so"; then + SSL_LIBDIR="$with_ssl/lib64" + elif test -f "$with_ssl/lib/64/libcrypto.so"; then + SSL_LIBDIR="$with_ssl/lib/64" + else + SSL_LIBDIR="$with_ssl/lib" + fi + else + SSL_LIBDIR="$with_ssl/lib" + fi + if test '!' -f "${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.a"; then + SSL_DYNAMIC_ONLY=yes + elif test '!' -f ${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.so -a '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.dylib"; then + SSL_STATIC_ONLY=yes + fi + SSL_INCLUDE="-I$with_ssl_incl/include" + SSL_APP=ssl + CRYPTO_APP=crypto + SSH_APP=ssh + if test "$cross_compiling" = "yes"; then + SSL_RUNTIME_LIBDIR=`echo "$SSL_LIBDIR" | sed -n "s|^$erl_xcomp_sysroot\(/*\)\(.*\)\$|/\2|p"` + else + SSL_RUNTIME_LIBDIR="$SSL_LIBDIR" + fi +esac + +if test "x$SSL_APP" != "x" ; then + dnl We found openssl, now check if we use kerberos 5 support + dnl FIXME: Do we still support platforms that have Kerberos? + AC_MSG_CHECKING(for OpenSSL kerberos 5 support) + old_CPPFLAGS=$CPPFLAGS + CPPFLAGS=$SSL_INCLUDE + AC_EGREP_CPP(^yes$,[ +#include <openssl/opensslv.h> +#include <openssl/opensslconf.h> +#if OPENSSL_VERSION_NUMBER < 0x1010000fL && !defined(OPENSSL_NO_KRB5) +yes +#endif + ],[ + AC_MSG_RESULT([yes]) + ssl_krb5_enabled=yes + if test "x$SSL_DYNAMIC_ONLY" != "xyes"; then + if test -f "$SSL_LIBDIR/libkrb5.a"; then + SSL_LINK_WITH_KERBEROS=yes + STATIC_KERBEROS_LIBS="$SSL_LIBDIR/libkrb5.a" + if test -f "$SSL_LIBDIR/libkrb5support.a"; then + STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libkrb5support.a" + fi + if test -f "$SSL_LIBDIR/libk5crypto.a"; then + STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libk5crypto.a" + fi + if test -f "$SSL_LIBDIR/libresolv.a"; then + STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libresolv.a" + fi + if test -f "$SSL_LIBDIR/libcom_err.a"; then + STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libcom_err.a" + fi + else + AC_MSG_WARN([Kerberos needed but no kerberos static libraries found]) + AC_MSG_WARN([Rescanning for dynamic SSL libraries]) + enable_dynamic_ssl=yes + ssl_done=no + SSL_LINK_WITH_KERBEROS=no + STATIC_KERBEROS_LIBS="" + ssl_krb5_enabled=no + SSL_WITH_KERBEROS=no + fi + else + SSL_LINK_WITH_KERBEROS=no + STATIC_KERBEROS_LIBS="" + fi + ],[ + AC_MSG_RESULT([no]) + ssl_krb5_enabled=no + SSL_WITH_KERBEROS=no + ]) + CPPFLAGS=$old_CPPFLAGS + SSL_KRB5_INCLUDE= + if test "x$ssl_krb5_enabled" = "xyes" ; then + AC_MSG_CHECKING(for krb5.h in standard locations) + for dir in $extra_dir "$SSL_INCDIR/include" "$SSL_INCDIR/include/openssl" \ + "$SSL_INCDIR/include/kerberos" \ + "$erl_xcomp_isysroot/cygdrive/c/kerberos/include" \ + "$erl_xcomp_isysroot/usr/local/kerberos/include" \ + "$erl_xcomp_isysroot/usr/kerberos/include" \ + "$erl_xcomp_isysroot/usr/include" + do + if test -f "$dir/krb5.h" ; then + SSL_KRB5_INCLUDE="$dir" + break + fi + done + if test "x$SSL_KRB5_INCLUDE" = "x" ; then + AC_MSG_RESULT([not found]) + SSL_APP= + CRYPTO_APP= + SSH_APP= + AC_MSG_WARN([OpenSSL is configured for kerberos but no krb5.h found]) + for a in ssl crypto ssh ; do + echo "OpenSSL is configured for kerberos but no krb5.h found" > $ERL_TOP/lib/$a/SKIP + done + else + AC_MSG_RESULT([found in $SSL_KRB5_INCLUDE]) + SSL_INCLUDE="$SSL_INCLUDE -I$SSL_KRB5_INCLUDE" + fi + fi +fi + +done # while test ssl_done != yes + +SSL_DED_LD_RUNTIME_LIBRARY_PATH= +ded_ld_rflg="$DED_LD_FLAG_RUNTIME_LIBRARY_PATH" + + +case "$with_ssl_rpath" in + +yes) # Use standard lib locations for ssl runtime library path + + if test "$SSL_APP" != "" && test "$SSL_DYNAMIC_ONLY" = "yes" && test "$ded_ld_rflg" != ""; then + + AC_MSG_CHECKING(for ssl runtime library path to use) + + libdirs="/lib" + + if test "$ac_cv_sizeof_void_p" = "8"; then + dir_lib64=no + dir_lib_64=no + + case "$SSL_RUNTIME_LIBDIR" in + */lib/64 | */lib/64/ ) dir_lib_64=yes;; + */lib64 | */lib64/ ) dir_lib64=yes;; + *) ;; + esac + + for dir in $std_ssl_locations; do + test $dir_lib_64 = no && + test -d "$erl_xcomp_sysroot$dir/lib/64" && + dir_lib_64=yes + test $dir_lib64 = no && + test -d "$erl_xcomp_sysroot$dir/lib64" && + dir_lib64=yes + done + + test $dir_lib_64 = yes && libdirs="/lib/64 $libdirs" + test $dir_lib64 = yes && libdirs="/lib64 $libdirs" + fi + + for type in std x_std curr; do + + ded_ld_rpath="$ded_ld_rflg$SSL_RUNTIME_LIBDIR" + rpath="$SSL_RUNTIME_LIBDIR" + + if test $type != curr; then + for ldir in $libdirs; do + for dir in $std_ssl_locations; do + test "$SSL_LIBDIR" != "$dir$ldir" || continue + test $type != x_std || test -d "$dir$ldir" || continue + if test "$dir" = "/"; then + libdir="$ldir" + else + libdir="$dir$ldir" + fi + ded_ld_rpath="$ded_ld_rpath $ded_ld_rflg$libdir" + rpath="$rpath:$libdir" + done + done + fi + + saveCFLAGS="$CFLAGS" + saveLDFLAGS="$LDFLAGS" + saveLIBS="$LIBS" + CFLAGS="$CFLAGS $SSL_INCLUDE" + LDFLAGS="$LDFLAGS $ld_rpath -L$SSL_LIBDIR" + LIBS="-lcrypto" + AC_TRY_LINK([ + #include <stdio.h> + #include <openssl/hmac.h> + ], + [ + HMAC(0, 0, 0, 0, 0, 0, 0); + ], + [rpath_success=yes], + [rpath_success=no]) + CFLAGS="$saveCFLAGS" + LDFLAGS="$saveLDFLAGS" + LIBS="$saveLIBS" + + test "$rpath_success" = "yes" && break + done + + test "$rpath_success" = "yes" || { ded_ld_rpath=; rpath=; } + + SSL_DED_LD_RUNTIME_LIBRARY_PATH="$ded_ld_rpath" + + AC_MSG_RESULT([$rpath]) + test "$rpath" != "" || AC_MSG_WARN([Cannot set run path during linking]) + fi + ;; + +no) # Use no ssl runtime library path + SSL_DED_LD_RUNTIME_LIBRARY_PATH= + ;; + +*) # Use ssl runtime library paths set by --with-ssl-rpath (without any check) + ded_ld_rpath= + delimit= + for dir in `echo $with_ssl_rpath | sed "s/,/ /g"`; do + ded_ld_rpath="$ded_ld_rpath$delimit$ded_ld_rflg$dir" + delimit=" " + done + SSL_DED_LD_RUNTIME_LIBRARY_PATH="$ded_ld_rpath" + ;; + +esac + + +AC_ARG_ENABLE(fips, +AS_HELP_STRING([--enable-fips], [enable OpenSSL FIPS mode support]) +AS_HELP_STRING([--disable-fips], [disable OpenSSL FIPS mode support (default)]), +[ case "$enableval" in + yes) enable_fips_support=yes ;; + *) enable_fips_support=no ;; + esac ], enable_fips_support=no) + +if test "x$enable_fips_support" = "xyes" && test "$CRYPTO_APP" != ""; then + saveCFLAGS="$CFLAGS" + saveLDFLAGS="$LDFLAGS" + saveLIBS="$LIBS" + CFLAGS="$CFLAGS $SSL_INCLUDE" + LDFLAGS="$LDFLAGS $ded_ld_rpath -L$SSL_LIBDIR" + LIBS="-lcrypto" + AC_CHECK_FUNC([FIPS_mode_set], + [SSL_FLAGS="-DFIPS_SUPPORT"], + [SSL_FLAGS=]) + CFLAGS="$saveCFLAGS" + LDFLAGS="$saveLDFLAGS" + LIBS="$saveLIBS" +else + SSL_FLAGS= +fi + +AC_SUBST(SSL_INCLUDE) +AC_SUBST(SSL_INCDIR) +AC_SUBST(SSL_LIBDIR) +AC_SUBST(SSL_FLAGS) +AC_SUBST(SSL_CRYPTO_LIBNAME) +AC_SUBST(SSL_SSL_LIBNAME) +AC_SUBST(SSL_DED_LD_RUNTIME_LIBRARY_PATH) +AC_SUBST(SSL_DYNAMIC_ONLY) +AC_SUBST(SSL_LINK_WITH_KERBEROS) +AC_SUBST(STATIC_KERBEROS_LIBS) +AC_SUBST(SSL_LINK_WITH_ZLIB) +AC_SUBST(STATIC_ZLIB_LIBS) + +AC_OUTPUT(c_src/$host/Makefile:c_src/Makefile.in) + diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 42e411a0e3..5811c18ce4 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -110,6 +110,9 @@ <code>ecdh_params() = ec_named_curve() | ec_explicit_curve()</code> + <code>ed_named_curves_ecdh() -> x448 | x25519</code> + <p>Note that the curves are only supported if the underlying OpenSSL has support for them.</p> + <code>ec_explicit_curve() = {ec_field(), Prime :: key_value(), Point :: key_value(), Order :: integer(), CoFactor :: none | integer()} </code> @@ -143,7 +146,7 @@ password => password()}</code> <code>engine_ref() = term()</code> - <p>The result of a call to <seealso marker="#engine_load-3">engine_load/3</seealso>. + <p>The result of a call to for example <seealso marker="#engine_load-3">engine_load/3</seealso>. </p> <code>key_id() = string() | binary()</code> @@ -155,12 +158,13 @@ <p>The key's password </p> - <code>stream_cipher() = rc4 | aes_ctr </code> + <code>stream_cipher() = rc4 | aes_ctr | chacha20 </code> <code>block_cipher() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc | blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cfb | des_ede3 | rc2_cbc </code> <code>aead_cipher() = aes_gcm | chacha20_poly1305 </code> + <p>Note that the actual supported algorithms depends on the underlying crypto library.</p> <code>stream_key() = aes_key() | rc4_key() </code> @@ -189,13 +193,16 @@ <code>rsa_sign_padding() = rsa_pkcs1_padding | rsa_pkcs1_pss_padding</code> - <code> hash_algorithms() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512 </code> <p>md4 is also supported for hash_init/1 and hash/2. + <code> hash_algorithms() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512 | + sha3_224 | sha3_256 | sha3_384 | sha3_512 </code> + <p>md4 is also supported for hash_init/1 and hash/2. Note that both md4 and md5 are recommended only for compatibility with existing applications. + Note that the actual supported hash_algorithms depends on the underlying crypto library. </p> <code> cipher_algorithms() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ctr | aes_gcm | - aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | + aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20 | chacha20_poly1305 | des_cbc | des_cfb | des3_cbc | des3_cfb | des_ede3 | rc2_cbc | rc4 </code> - <code> mac_algorithms() = hmac | cmac</code> + <code> mac_algorithms() = hmac | cmac | poly1305</code> <code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code> <p>Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported with ecdsa and ecdh. @@ -306,7 +313,7 @@ <v> Type = dh | ecdh | srp </v> <v>OthersPublicKey = dh_public() | ecdh_public() | srp_public() </v> <v>MyKey = dh_private() | ecdh_private() | {srp_public(),srp_private()}</v> - <v>Params = dh_params() | ecdh_params() | SrpUserParams | SrpHostParams</v> + <v>Params = dh_params() | ecdh_params() | ed_named_curves_ecdh() | SrpUserParams | SrpHostParams</v> <v>SrpUserParams = {user, [DerivedKey::binary(), Prime::binary(), Generator::binary(), Version::atom() | [Scrambler:binary()]]} </v> <v>SrpHostParams = {host, [Verifier::binary(), Prime::binary(), Version::atom() | [Scrambler::binary]]} </v> <v>SharedSecret = binary()</v> @@ -336,7 +343,7 @@ <fsummary>Generates a public key of type <c>Type</c></fsummary> <type> <v> Type = dh | ecdh | rsa | srp </v> - <v>Params = dh_params() | ecdh_params() | RsaParams | SrpUserParams | SrpHostParams </v> + <v>Params = dh_params() | ecdh_params() | ed_named_curves_ecdh()| RsaParams | SrpUserParams | SrpHostParams </v> <v>RsaParams = {ModulusSizeInBits::integer(), PublicExponent::key_value()}</v> <v>SrpUserParams = {user, [Generator::binary(), Prime::binary(), Version::atom()]}</v> <v>SrpHostParams = {host, [Verifier::binary(), Generator::binary(), Prime::binary(), Version::atom()]}</v> @@ -598,6 +605,20 @@ </func> <func> + <name>poly1305(Key, Data) -> Mac</name> + <fsummary></fsummary> + <type> + <v>Key = iodata()</v> + <v>Data = iodata()</v> + <v>Mac = binary()</v> + </type> + <desc> + <p>Computes a POLY1305 message authentication code (<c>Mac</c>) from <c>Data</c> using + <c>Key</c> as the authentication key.</p> + </desc> + </func> + + <func> <name>private_decrypt(Type, CipherText, PrivateKey, Padding) -> PlainText</name> <fsummary>Decrypts CipherText using the private Key.</fsummary> <type> @@ -629,7 +650,7 @@ <desc> <p>Fetches the corresponding public key from a private key stored in an Engine. The key must be of the type indicated by the Type parameter. - </p> + </p> </desc> </func> @@ -830,7 +851,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> </p> <note> <p> - The state returned from this function can not be used + The state returned from this function cannot be used to get a reproducable random sequence as from the other <seealso marker="stdlib:rand">rand</seealso> @@ -920,7 +941,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> </p> <note> <p> - The state returned from this function can not be used + The state returned from this function cannot be used to get a reproducable random sequence as from the other <seealso marker="stdlib:rand">rand</seealso> @@ -958,7 +979,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <name>stream_init(Type, Key, IVec) -> State</name> <fsummary></fsummary> <type> - <v>Type = aes_ctr </v> + <v>Type = aes_ctr | chacha20</v> <v>State = opaque() </v> <v>Key = iodata()</v> <v>IVec = binary()</v> @@ -1075,8 +1096,8 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <p> Returns a list of all possible engine methods. </p> - <p> - May throw exception notsup in case there is + <p> + May throw exception notsup in case there is no engine support in the underlying OpenSSL implementation. </p> <p> @@ -1092,18 +1113,18 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <type> <v>EngineId = unicode:chardata()</v> <v>PreCmds, PostCmds = [{unicode:chardata(), unicode:chardata()}]</v> - <v>Result = {ok, Engine::term()} | {error, Reason::term()}</v> + <v>Result = {ok, Engine::engine_ref()} | {error, Reason::term()}</v> </type> <desc> <p> Loads the OpenSSL engine given by <c>EngineId</c> if it is available and then returns ok and - an engine handle. This function is the same as calling <c>engine_load/4</c> with - <c>EngineMethods</c> set to a list of all the possible methods. An error tuple is + an engine handle. This function is the same as calling <c>engine_load/4</c> with + <c>EngineMethods</c> set to a list of all the possible methods. An error tuple is returned if the engine can't be loaded. </p> <p> The function throws a badarg if the parameters are in wrong format. - It may also throw the exception notsup in case there is + It may also throw the exception notsup in case there is no engine support in the underlying OpenSSL implementation. </p> <p> @@ -1120,7 +1141,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <v>EngineId = unicode:chardata()</v> <v>PreCmds, PostCmds = [{unicode:chardata(), unicode:chardata()}]</v> <v>EngineMethods = [engine_method_type()]</v> - <v>Result = {ok, Engine::term()} | {error, Reason::term()}</v> + <v>Result = {ok, Engine::engine_ref()} | {error, Reason::term()}</v> </type> <desc> <p> @@ -1129,7 +1150,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> </p> <p> The function throws a badarg if the parameters are in wrong format. - It may also throw the exception notsup in case there is + It may also throw the exception notsup in case there is no engine support in the underlying OpenSSL implementation. </p> <p> @@ -1143,17 +1164,17 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <name>engine_unload(Engine) -> Result</name> <fsummary>Dynamical load an encryption engine</fsummary> <type> - <v>Engine = term()</v> + <v>Engine = engine_ref()</v> <v>Result = ok | {error, Reason::term()}</v> </type> <desc> <p> - Unloads the OpenSSL engine given by <c>EngineId</c>. + Unloads the OpenSSL engine given by <c>Engine</c>. An error tuple is returned if the engine can't be unloaded. </p> <p> The function throws a badarg if the parameter is in wrong format. - It may also throw the exception notsup in case there is + It may also throw the exception notsup in case there is no engine support in the underlying OpenSSL implementation. </p> <p> @@ -1164,19 +1185,24 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> </func> <func> - <name>engine_list() -> Result</name> - <fsummary>List the known engine ids</fsummary> + <name>engine_by_id(EngineId) -> Result</name> + <fsummary>Get a reference to an already loaded engine</fsummary> <type> - <v>Result = [EngineId::unicode:chardata()]</v> + <v>EngineID = unicode:chardata()engine_ref()</v> + <v>Result = {ok, Engine::engine_ref()} | {error, Reason::term()}</v> </type> <desc> - <p>List the id's of all engines in OpenSSL's internal list.</p> <p> - It may also throw the exception notsup in case there is + Get a reference to an already loaded engine with <c>EngineId</c>. + An error tuple is returned if the engine can't be unloaded. + </p> + <p> + The function throws a badarg if the parameter is in wrong format. + It may also throw the exception notsup in case there is no engine support in the underlying OpenSSL implementation. </p> <p> - See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> in the User's Guide. </p> </desc> @@ -1186,7 +1212,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <name>engine_ctrl_cmd_string(Engine, CmdName, CmdArg) -> Result</name> <fsummary>Sends ctrl commands to an OpenSSL engine</fsummary> <type> - <v>Engine = term()</v> + <v>Engine = engine_ref()</v> <v>CmdName = unicode:chardata()</v> <v>CmdArg = unicode:chardata()</v> <v>Result = ok | {error, Reason::term()}</v> @@ -1194,12 +1220,12 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <desc> <p> Sends ctrl commands to the OpenSSL engine given by <c>Engine</c>. - This function is the same as calling <c>engine_ctrl_cmd_string/4</c> with + This function is the same as calling <c>engine_ctrl_cmd_string/4</c> with <c>Optional</c> set to <c>false</c>. </p> <p> The function throws a badarg if the parameters are in wrong format. - It may also throw the exception notsup in case there is + It may also throw the exception notsup in case there is no engine support in the underlying OpenSSL implementation. </p> </desc> @@ -1209,7 +1235,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <name>engine_ctrl_cmd_string(Engine, CmdName, CmdArg, Optional) -> Result</name> <fsummary>Sends ctrl commands to an OpenSSL engine</fsummary> <type> - <v>Engine = term()</v> + <v>Engine = engine_ref()</v> <v>CmdName = unicode:chardata()</v> <v>CmdArg = unicode:chardata()</v> <v>Optional = boolean()</v> @@ -1218,18 +1244,218 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <desc> <p> Sends ctrl commands to the OpenSSL engine given by <c>Engine</c>. - <c>Optional</c> is a boolean argument that can relax the semantics of the function. - If set to <c>true</c> it will only return failure if the ENGINE supported the given - command name but failed while executing it, if the ENGINE doesn't support the command - name it will simply return success without doing anything. In this case we assume + <c>Optional</c> is a boolean argument that can relax the semantics of the function. + If set to <c>true</c> it will only return failure if the ENGINE supported the given + command name but failed while executing it, if the ENGINE doesn't support the command + name it will simply return success without doing anything. In this case we assume the user is only supplying commands specific to the given ENGINE so we set this to <c>false</c>. </p> <p> The function throws a badarg if the parameters are in wrong format. - It may also throw the exception notsup in case there is + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + </desc> + </func> + + <func> + <name>engine_add(Engine) -> Result</name> + <fsummary>Add engine to OpenSSL internal list</fsummary> + <type> + <v>Engine = engine_ref()</v> + <v>Result = ok | {error, Reason::term()}</v> + </type> + <desc> + <p>Add the engine to OpenSSL's internal list.</p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + </desc> + </func> + + <func> + <name>engine_remove(Engine) -> Result</name> + <fsummary>Remove engine to OpenSSL internal list</fsummary> + <type> + <v>Engine = engine_ref()</v> + <v>Result = ok | {error, Reason::term()}</v> + </type> + <desc> + <p>Remove the engine from OpenSSL's internal list.</p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + </desc> + </func> + + <func> + <name>engine_get_id(Engine) -> EngineId</name> + <fsummary>Fetch engine ID</fsummary> + <type> + <v>Engine = engine_ref()</v> + <v>EngineId = unicode:chardata()</v> + </type> + <desc> + <p>Return the ID for the engine, or an empty binary if there is no id set.</p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + </desc> + </func> + + <func> + <name>engine_get_name(Engine) -> EngineName</name> + <fsummary>Fetch engine name</fsummary> + <type> + <v>Engine = engine_ref()</v> + <v>EngineName = unicode:chardata()</v> + </type> + <desc> + <p>Return the name (eg a description) for the engine, or an empty binary if there is no name set.</p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + </desc> + </func> + + <func> + <name>engine_list() -> Result</name> + <fsummary>List the known engine ids</fsummary> + <type> + <v>Result = [EngineId::unicode:chardata()]</v> + </type> + <desc> + <p>List the id's of all engines in OpenSSL's internal list.</p> + <p> + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + <p> + May throw exception notsup in case engine functionality is not supported by the underlying + OpenSSL implementation. + </p> + </desc> + </func> + + <func> + <name>ensure_engine_loaded(EngineId, LibPath) -> Result</name> + <fsummary>Ensure encryption engine just loaded once</fsummary> + <type> + <v>EngineId = unicode:chardata()</v> + <v>LibPath = unicode:chardata()</v> + <v>Result = {ok, Engine::engine_ref()} | {error, Reason::term()}</v> + </type> + <desc> + <p> + Loads the OpenSSL engine given by <c>EngineId</c> and the path to the dynamic library + implementing the engine. This function is the same as calling <c>ensure_engine_loaded/3</c> with + <c>EngineMethods</c> set to a list of all the possible methods. An error tuple is + returned if the engine can't be loaded. + </p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is no engine support in the underlying OpenSSL implementation. </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + </desc> + </func> + + <func> + <name>ensure_engine_loaded(EngineId, LibPath, EngineMethods) -> Result</name> + <fsummary>Ensure encryption engine just loaded once</fsummary> + <type> + <v>EngineId = unicode:chardata()</v> + <v>LibPath = unicode:chardata()</v> + <v>EngineMethods = [engine_method_type()]</v> + <v>Result = {ok, Engine::engine_ref()} | {error, Reason::term()}</v> + </type> + <desc> + <p> + Loads the OpenSSL engine given by <c>EngineId</c> and the path to the dynamic library + implementing the engine. This function differs from the normal engine_load in that sense it + also add the engine id to the internal list in OpenSSL. Then in the following calls to the function + it just fetch the reference to the engine instead of loading it again. + An error tuple is returned if the engine can't be loaded. + </p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + </desc> + </func> + + <func> + <name>ensure_engine_unloaded(Engine) -> Result</name> + <fsummary>Unload an engine loaded with the ensure function</fsummary> + <type> + <v>Engine = engine_ref()</v> + <v>Result = ok | {error, Reason::term()}</v> + </type> + <desc> + <p> + Unloads an engine loaded with the <c>ensure_engine_loaded</c> function. + It both removes the label from the OpenSSL internal engine list and unloads the engine. + This function is the same as calling <c>ensure_engine_unloaded/2</c> with + <c>EngineMethods</c> set to a list of all the possible methods. An error tuple is + returned if the engine can't be unloaded. + </p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> + </desc> + </func> + + <func> + <name>ensure_engine_unloaded(Engine, EngineMethods) -> Result</name> + <fsummary>Unload an engine loaded with the ensure function</fsummary> + <type> + <v>Engine = engine_ref()</v> + <v>EngineMethods = [engine_method_type()]</v> + <v>Result = ok | {error, Reason::term()}</v> + </type> + <desc> + <p> + Unloads an engine loaded with the <c>ensure_engine_loaded</c> function. + It both removes the label from the OpenSSL internal engine list and unloads the engine. + An error tuple is returned if the engine can't be unloaded. + </p> + <p> + The function throws a badarg if the parameters are in wrong format. + It may also throw the exception notsup in case there is + no engine support in the underlying OpenSSL implementation. + </p> + <p> + See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso> + in the User's Guide. + </p> </desc> </func> diff --git a/lib/crypto/doc/src/engine_keys.xml b/lib/crypto/doc/src/engine_keys.xml index 38714fed8a..80d811c47e 100644 --- a/lib/crypto/doc/src/engine_keys.xml +++ b/lib/crypto/doc/src/engine_keys.xml @@ -40,7 +40,7 @@ </p> <p> An engine could among other tasks provide a storage for - private or public keys. Such a storage could be made safer than the normal file system. Thoose techniques are not + private or public keys. Such a storage could be made safer than the normal file system. Those techniques are not described in this User's Guide. Here we concentrate on how to use private or public keys stored in such an engine. </p> diff --git a/lib/crypto/doc/src/engine_load.xml b/lib/crypto/doc/src/engine_load.xml index e5c3f5d561..3d0aa0c32a 100644 --- a/lib/crypto/doc/src/engine_load.xml +++ b/lib/crypto/doc/src/engine_load.xml @@ -42,6 +42,9 @@ operations. The hardware implementation usually offers improved performance over its software-based counterpart, which is known as cryptographic acceleration. </p> + <note> + <p>The file name requirement on the engine dynamic library can differ between SSL versions.</p> + </note> </section> <section> @@ -54,9 +57,6 @@ <code> 1> {ok, Engine} = crypto:engine_load(<<"otp_test_engine">>, [], []). {ok, #Ref}</code> - <note> - <p>The file name requirement on the engine dynamic library can differ between SSL versions.</p> - </note> </section> <section> @@ -72,9 +72,6 @@ <<"LOAD">>], []). {ok, #Ref}</code> - <note> - <p>The dynamic engine is not supported in LibreSSL from version 2.2.1</p> - </note> </section> <section> @@ -100,6 +97,28 @@ engine_method_pkey_meths, engine_method_pkey_asn1_meths]. </section> <section> + <title>Load with the ensure loaded function</title> + <p> + This function makes sure the engine is loaded just once and the ID is added to the internal + engine list of OpenSSL. The following calls to the function will check if the ID is loaded + and then just get a new reference to the engine. + </p> + <code> + 5> {ok, Engine} = crypto:ensure_engine_loaded(<<"MD5">>, + <<"/some/path/otp_test_engine.so">>). + {ok, #Ref}</code> + <p> + To unload it use crypto:ensure_engine_unloaded/1 which removes the ID from the internal list + before unloading the engine. + </p> + <code> + 6> crypto:ensure_engine_unloaded(<<"MD5">>). + ok</code> + </section> + + + + <section> <title>List all engines currently loaded</title> <code> 5> crypto:engine_list(). diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 2e48b48d67..9207d09821 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -31,6 +31,53 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 4.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Update the crypto engine functions to handle multiple + loads of an engine. </p> <p><c>engine_load/3/4</c> is + updated so it doesn't add the engine ID to OpenSSLs + internal list of engines which makes it possible to run + the engine_load more than once if it doesn't contain + global data.</p> <p>Added <c>ensure_engine_loaded/2/3</c> + which guarantees that the engine just is loaded once and + the following calls just returns a reference to it. This + is done by add the ID to the internal OpenSSL list and + check if it is already registered when the function is + called.</p> <p>Added <c>ensure_engine_unloaded/1/2</c> to + unload engines loaded with ensure_engine_loaded.</p> + <p>Then some more utility functions are added.</p> + <p><c>engine_add/1</c>, adds the engine to OpenSSL + internal list</p> <p><c>engine_remove/1</c>, remove the + engine from OpenSSL internal list</p> + <p><c>engine_get_id/1</c>, fetch the engines id</p> + <p><c>engine_get_name/1</c>, fetch the engine name</p> + <p> + Own Id: OTP-15233</p> + </item> + </list> + </section> + +</section> + +<section><title>Crypto 4.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a node crash in <c>crypto:compute_key(ecdh, + ...)</c> when passing a wrongly typed Others + argument.</p> + <p> + Own Id: OTP-15194 Aux Id: ERL-673 </p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 4.3</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -78,6 +125,22 @@ </section> +<section><title>Crypto 4.2.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a node crash in <c>crypto:compute_key(ecdh, + ...)</c> when passing a wrongly typed Others + argument.</p> + <p> + Own Id: OTP-15194 Aux Id: ERL-673 </p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 4.2.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 714cba58b9..17351d10ea 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -29,6 +29,7 @@ -export([generate_key/2, generate_key/3, compute_key/4]). -export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). -export([cmac/3, cmac/4]). +-export([poly1305/2]). -export([exor/2, strong_rand_bytes/1, mod_pow/3]). -export([rand_seed/0, rand_seed_alg/1]). -export([rand_seed_s/0, rand_seed_alg_s/1]). @@ -51,9 +52,18 @@ engine_load/3, engine_load/4, engine_unload/1, + engine_by_id/1, engine_list/0, engine_ctrl_cmd_string/3, - engine_ctrl_cmd_string/4 + engine_ctrl_cmd_string/4, + engine_add/1, + engine_remove/1, + engine_get_id/1, + engine_get_name/1, + ensure_engine_loaded/2, + ensure_engine_loaded/3, + ensure_engine_unloaded/1, + ensure_engine_unloaded/2 ]). -export_type([engine_ref/0, @@ -108,17 +118,11 @@ stop() -> supports()-> {Hashs, PubKeys, Ciphers, Macs, Curves} = algorithms(), - [{hashs, Hashs}, {ciphers, Ciphers}, {public_keys, PubKeys}, - {macs, Macs} - | case Curves of - [] -> []; - _ -> [{curves, Curves}] % Only show this experimental feature - % if OpenSSL 1.1.1 beta4 or higher (where - % eddsa and eddh is enabled) - end + {macs, Macs}, + {curves, Curves} ]. info_lib() -> ?nif_stub. @@ -139,7 +143,8 @@ hash(Hash, Data0) -> hash(Hash, Data, erlang:byte_size(Data), MaxBytes). -spec hash_init('md5'|'md4'|'ripemd160'| - 'sha'|'sha224'|'sha256'|'sha384'|'sha512') -> any(). + 'sha'|'sha224'|'sha256'|'sha384'|'sha512'| + 'sha3_224' | 'sha3_256' | 'sha3_384' | 'sha3_512') -> any(). hash_init(Hash) -> notsup_to_error(hash_init_nif(Hash)). @@ -191,6 +196,11 @@ cmac(Type, Key, Data) -> cmac(Type, Key, Data, MacSize) -> erlang:binary_part(cmac(Type, Key, Data), 0, MacSize). +-spec poly1305(iodata(), iodata()) -> binary(). + +poly1305(Key, Data) -> + poly1305_nif(Key, Data). + %% Ecrypt/decrypt %%% -spec block_encrypt(des_cbc | des_cfb | @@ -288,8 +298,10 @@ next_iv(Type, Data) when is_binary(Data) -> IVecSize = case Type of des_cbc -> 8; des3_cbc -> 8; + blowfish_cbc -> 8; aes_cbc -> 16; - aes_ige -> 32 + aes_ige -> 32; % For compatibility if someone has bug-adapted code + aes_ige256 -> 32 % The name used in block_encrypt et al end, {_, IVec} = split_binary(Data, size(Data) - IVecSize), IVec; @@ -306,7 +318,10 @@ next_iv(Type, Data, _Ivec) -> next_iv(Type, Data). stream_init(aes_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}. + {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; +stream_init(chacha20, Key, Ivec) -> + {chacha20, chacha20_stream_init(Key,Ivec)}. + stream_init(rc4, Key) -> {rc4, notsup_to_error(rc4_set_key(Key))}. @@ -488,7 +503,7 @@ sign(Algorithm, Type, Data, Key, Options) -> -type engine_key_ref() :: #{engine := engine_ref(), key_id := key_id(), password => password(), - term() => term() + term() => term() }. -type pk_algs() :: rsa | ecdsa | dss . @@ -664,7 +679,7 @@ evp_compute_key_nif(_Curve, _OthersBin, _MyBin) -> ?nif_stub. -type engine_method_type() :: engine_method_rsa | engine_method_dsa | engine_method_dh | engine_method_rand | engine_method_ecdh | engine_method_ecdsa | engine_method_ciphers | engine_method_digests | engine_method_store | - engine_method_pkey_meths | engine_method_pkey_asn1_meths | + engine_method_pkey_meths | engine_method_pkey_asn1_meths | engine_method_ec. -type engine_ref() :: term(). @@ -681,7 +696,8 @@ engine_get_all_methods() -> PreCmds::[{unicode:chardata(), unicode:chardata()}], PostCmds::[{unicode:chardata(), unicode:chardata()}]) -> {ok, Engine::engine_ref()} | {error, Reason::term()}. -engine_load(EngineId, PreCmds, PostCmds) when is_list(PreCmds), is_list(PostCmds) -> +engine_load(EngineId, PreCmds, PostCmds) when is_list(PreCmds), + is_list(PostCmds) -> engine_load(EngineId, PreCmds, PostCmds, engine_get_all_methods()). %%---------------------------------------------------------------------- @@ -698,28 +714,26 @@ engine_load(EngineId, PreCmds, PostCmds, EngineMethods) when is_list(PreCmds), ok = notsup_to_error(engine_load_dynamic_nif()), case notsup_to_error(engine_by_id_nif(ensure_bin_chardata(EngineId))) of {ok, Engine} -> - ok = engine_load_1(Engine, PreCmds, PostCmds, EngineMethods), - {ok, Engine}; + engine_load_1(Engine, PreCmds, PostCmds, EngineMethods); {error, Error1} -> {error, Error1} end catch - throw:Error2 -> - Error2 + throw:Error2 -> + Error2 end. engine_load_1(Engine, PreCmds, PostCmds, EngineMethods) -> try ok = engine_nif_wrapper(engine_ctrl_cmd_strings_nif(Engine, ensure_bin_cmds(PreCmds), 0)), - ok = engine_nif_wrapper(engine_add_nif(Engine)), ok = engine_nif_wrapper(engine_init_nif(Engine)), engine_load_2(Engine, PostCmds, EngineMethods), - ok + {ok, Engine} catch - throw:Error -> - %% The engine couldn't initialise, release the structural reference - ok = engine_free_nif(Engine), - throw(Error) + throw:Error -> + %% The engine couldn't initialise, release the structural reference + ok = engine_free_nif(Engine), + throw(Error) end. engine_load_2(Engine, PostCmds, EngineMethods) -> @@ -749,7 +763,6 @@ engine_unload(Engine, EngineMethods) -> try [ok = engine_nif_wrapper(engine_unregister_nif(Engine, engine_method_atom_to_int(Method))) || Method <- EngineMethods], - ok = engine_nif_wrapper(engine_remove_nif(Engine)), %% Release the functional reference from engine_init_nif ok = engine_nif_wrapper(engine_finish_nif(Engine)), %% Release the structural reference from engine_by_id_nif @@ -760,6 +773,41 @@ engine_unload(Engine, EngineMethods) -> end. %%---------------------------------------------------------------------- +%% Function: engine_by_id/1 +%%---------------------------------------------------------------------- +engine_by_id(EngineId) -> + try + notsup_to_error(engine_by_id_nif(ensure_bin_chardata(EngineId))) + catch + throw:Error -> + Error + end. + +%%---------------------------------------------------------------------- +%% Function: engine_add/1 +%%---------------------------------------------------------------------- +engine_add(Engine) -> + notsup_to_error(engine_add_nif(Engine)). + +%%---------------------------------------------------------------------- +%% Function: engine_remove/1 +%%---------------------------------------------------------------------- +engine_remove(Engine) -> + notsup_to_error(engine_remove_nif(Engine)). + +%%---------------------------------------------------------------------- +%% Function: engine_get_id/1 +%%---------------------------------------------------------------------- +engine_get_id(Engine) -> + notsup_to_error(engine_get_id_nif(Engine)). + +%%---------------------------------------------------------------------- +%% Function: engine_get_name/1 +%%---------------------------------------------------------------------- +engine_get_name(Engine) -> + notsup_to_error(engine_get_name_nif(Engine)). + +%%---------------------------------------------------------------------- %% Function: engine_list/0 %%---------------------------------------------------------------------- -spec engine_list() -> @@ -770,9 +818,9 @@ engine_list() -> []; {ok, Engine} -> case notsup_to_error(engine_get_id_nif(Engine)) of - {ok, <<>>} -> + <<>> -> engine_list(Engine, []); - {ok, EngineId} -> + EngineId -> engine_list(Engine, [EngineId]) end end. @@ -783,9 +831,9 @@ engine_list(Engine0, IdList) -> lists:reverse(IdList); {ok, Engine1} -> case notsup_to_error(engine_get_id_nif(Engine1)) of - {ok, <<>>} -> + <<>> -> engine_list(Engine1, IdList); - {ok, EngineId} -> + EngineId -> engine_list(Engine1, [EngineId |IdList]) end end. @@ -794,7 +842,7 @@ engine_list(Engine0, IdList) -> %% Function: engine_ctrl_cmd_string/3 %%---------------------------------------------------------------------- -spec engine_ctrl_cmd_string(Engine::term(), - CmdName::unicode:chardata(), + CmdName::unicode:chardata(), CmdArg::unicode:chardata()) -> ok | {error, Reason::term()}. engine_ctrl_cmd_string(Engine, CmdName, CmdArg) -> @@ -804,13 +852,13 @@ engine_ctrl_cmd_string(Engine, CmdName, CmdArg) -> %% Function: engine_ctrl_cmd_string/4 %%---------------------------------------------------------------------- -spec engine_ctrl_cmd_string(Engine::term(), - CmdName::unicode:chardata(), + CmdName::unicode:chardata(), CmdArg::unicode:chardata(), Optional::boolean()) -> ok | {error, Reason::term()}. engine_ctrl_cmd_string(Engine, CmdName, CmdArg, Optional) -> - case engine_ctrl_cmd_strings_nif(Engine, - ensure_bin_cmds([{CmdName, CmdArg}]), + case engine_ctrl_cmd_strings_nif(Engine, + ensure_bin_cmds([{CmdName, CmdArg}]), bool_to_int(Optional)) of ok -> ok; @@ -820,6 +868,82 @@ engine_ctrl_cmd_string(Engine, CmdName, CmdArg, Optional) -> {error, Error} end. +%%---------------------------------------------------------------------- +%% Function: ensure_engine_loaded/2 +%% Special version of load that only uses dynamic engine to load +%%---------------------------------------------------------------------- +ensure_engine_loaded(EngineId, LibPath) -> + ensure_engine_loaded(EngineId, LibPath, engine_get_all_methods()). + +%%---------------------------------------------------------------------- +%% Function: ensure_engine_loaded/3 +%% Special version of load that only uses dynamic engine to load +%%---------------------------------------------------------------------- +ensure_engine_loaded(EngineId, LibPath, EngineMethods) -> + try + List = crypto:engine_list(), + case lists:member(EngineId, List) of + true -> + notsup_to_error(engine_by_id_nif(ensure_bin_chardata(EngineId))); + false -> + ok = notsup_to_error(engine_load_dynamic_nif()), + case notsup_to_error(engine_by_id_nif(ensure_bin_chardata(<<"dynamic">>))) of + {ok, Engine} -> + PreCommands = [{<<"SO_PATH">>, ensure_bin_chardata(LibPath)}, + {<<"ID">>, ensure_bin_chardata(EngineId)}, + <<"LOAD">>], + ensure_engine_loaded_1(Engine, PreCommands, EngineMethods); + {error, Error1} -> + {error, Error1} + end + end + catch + throw:Error2 -> + Error2 + end. + +ensure_engine_loaded_1(Engine, PreCmds, Methods) -> + try + ok = engine_nif_wrapper(engine_ctrl_cmd_strings_nif(Engine, ensure_bin_cmds(PreCmds), 0)), + ok = engine_nif_wrapper(engine_add_nif(Engine)), + ok = engine_nif_wrapper(engine_init_nif(Engine)), + ensure_engine_loaded_2(Engine, Methods), + {ok, Engine} + catch + throw:Error -> + %% The engine couldn't initialise, release the structural reference + ok = engine_free_nif(Engine), + throw(Error) + end. + +ensure_engine_loaded_2(Engine, Methods) -> + try + [ok = engine_nif_wrapper(engine_register_nif(Engine, engine_method_atom_to_int(Method))) || + Method <- Methods], + ok + catch + throw:Error -> + %% The engine registration failed, release the functional reference + ok = engine_finish_nif(Engine), + throw(Error) + end. +%%---------------------------------------------------------------------- +%% Function: ensure_engine_unloaded/1 +%%---------------------------------------------------------------------- +ensure_engine_unloaded(Engine) -> + ensure_engine_unloaded(Engine, engine_get_all_methods()). + +%%---------------------------------------------------------------------- +%% Function: ensure_engine_unloaded/2 +%%---------------------------------------------------------------------- +ensure_engine_unloaded(Engine, EngineMethods) -> + case engine_remove(Engine) of + ok -> + engine_unload(Engine, EngineMethods); + {error, E} -> + {error, E} + end. + %%-------------------------------------------------------------------- %%% On load %%-------------------------------------------------------------------- @@ -892,7 +1016,7 @@ path2bin(Path) when is_list(Path) -> max_bytes() -> ?MAX_BYTES_TO_NIF. -notsup_to_error(notsup) -> +notsup_to_error(notsup) -> erlang:error(notsup); notsup_to_error(Other) -> Other. @@ -948,9 +1072,12 @@ hmac_final_nif(_Context) -> ?nif_stub. hmac_final_nif(_Context, _MacSize) -> ?nif_stub. %% CMAC - cmac_nif(_Type, _Key, _Data) -> ?nif_stub. +%% POLY1305 +poly1305_nif(_Key, _Data) -> ?nif_stub. + + %% CIPHERS -------------------------------------------------------------------- block_crypt_nif(_Type, _Key, _Ivec, _Text, _IsEncrypt) -> ?nif_stub. @@ -1005,14 +1132,20 @@ do_stream_encrypt({aes_ctr, State0}, Data) -> {{aes_ctr, State}, Cipher}; do_stream_encrypt({rc4, State0}, Data) -> {State, Cipher} = rc4_encrypt_with_state(State0, Data), - {{rc4, State}, Cipher}. + {{rc4, State}, Cipher}; +do_stream_encrypt({chacha20, State0}, Data) -> + {State, Cipher} = chacha20_stream_encrypt(State0, Data), + {{chacha20, State}, Cipher}. do_stream_decrypt({aes_ctr, State0}, Data) -> {State, Text} = aes_ctr_stream_decrypt(State0, Data), {{aes_ctr, State}, Text}; do_stream_decrypt({rc4, State0}, Data) -> {State, Text} = rc4_encrypt_with_state(State0, Data), - {{rc4, State}, Text}. + {{rc4, State}, Text}; +do_stream_decrypt({chacha20, State0}, Data) -> + {State, Cipher} = chacha20_stream_decrypt(State0, Data), + {{chacha20, State}, Cipher}. %% @@ -1036,6 +1169,18 @@ aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub. rc4_set_key(_Key) -> ?nif_stub. rc4_encrypt_with_state(_State, _Data) -> ?nif_stub. +%% +%% CHACHA20 - stream cipher +%% +-type chacha20_state() :: term(). +-spec chacha20_stream_init(iodata(), binary()) -> chacha20_state(). +-spec chacha20_stream_encrypt(chacha20_state(), binary()) -> {chacha20_state(), binary()}. +-spec chacha20_stream_decrypt(chacha20_state(), binary()) -> {chacha20_state(), binary()}. + +chacha20_stream_init(_Key, _IVec) -> ?nif_stub. +chacha20_stream_encrypt(_State, _Data) -> ?nif_stub. +chacha20_stream_decrypt(_State, _Data) -> ?nif_stub. + %% Secure remote password ------------------------------------------------------------------- user_srp_gen_key(Private, Generator, Prime) -> @@ -1148,7 +1293,7 @@ privkey_to_pubkey(Alg, EngineMap) when Alg == rsa; Alg == dss; Alg == ecdsa -> error:notsup -> {error, notsup} end. - + privkey_to_pubkey_nif(_Alg, _EngineMap) -> ?nif_stub. @@ -1314,6 +1459,7 @@ engine_unregister_nif(_Engine, _EngineMethod) -> ?nif_stub. engine_get_first_nif() -> ?nif_stub. engine_get_next_nif(_Engine) -> ?nif_stub. engine_get_id_nif(_Engine) -> ?nif_stub. +engine_get_name_nif(_Engine) -> ?nif_stub. engine_get_all_methods_nif() -> ?nif_stub. %%-------------------------------------------------------------------- @@ -1371,7 +1517,7 @@ get_test_engine() -> Type = erlang:system_info(system_architecture), LibDir = filename:join([code:priv_dir(crypto), "lib"]), ArchDir = filename:join([LibDir, Type]), - case filelib:is_dir(ArchDir) of + case filelib:is_dir(ArchDir) of true -> check_otp_test_engine(ArchDir); false -> check_otp_test_engine(LibDir) end. @@ -1389,4 +1535,3 @@ check_otp_test_engine(LibDir) -> {error, notexist} end end. - diff --git a/lib/crypto/src/crypto_ec_curves.erl b/lib/crypto/src/crypto_ec_curves.erl index 9602a7e24b..a0a2f99601 100644 --- a/lib/crypto/src/crypto_ec_curves.erl +++ b/lib/crypto/src/crypto_ec_curves.erl @@ -3,41 +3,7 @@ -export([curve/1, curves/0]). curves() -> - CryptoSupport = crypto:supports(), - PubKeys = proplists:get_value(public_keys, CryptoSupport), - HasEC = proplists:get_bool(ecdh, PubKeys), - HasGF2m = proplists:get_bool(ec_gf2m, PubKeys), - FIPSMode = crypto:info_fips() == enabled, - prime_curves(HasEC, FIPSMode) ++ characteristic_two_curves(HasGF2m, FIPSMode). - - -prime_curves(true, true) -> - [secp160k1,secp160r1,secp160r2, - secp192r1,secp192k1,secp224k1,secp224r1,secp256k1,secp256r1,secp384r1, - secp521r1,prime192v1,prime192v2,prime192v3,prime239v1,prime239v2,prime239v3, - prime256v1,wtls7,wtls9,wtls12, - brainpoolP160r1,brainpoolP160t1,brainpoolP192r1,brainpoolP192t1, - brainpoolP224r1,brainpoolP224t1,brainpoolP256r1,brainpoolP256t1, - brainpoolP320r1,brainpoolP320t1,brainpoolP384r1,brainpoolP384t1, - brainpoolP512r1,brainpoolP512t1]; -prime_curves(true, false) -> - [secp112r1,secp112r2,secp128r1,secp128r2,wtls6,wtls8] - ++ prime_curves(true, true); -prime_curves(_, _) -> - []. - -characteristic_two_curves(true, true) -> - [sect163k1,sect163r1, - sect163r2,sect193r1,sect193r2,sect233k1,sect233r1,sect239k1,sect283k1, - sect283r1,sect409k1,sect409r1,sect571k1,sect571r1,c2pnb163v1,c2pnb163v2, - c2pnb163v3,c2pnb176v1,c2tnb191v1,c2tnb191v2,c2tnb191v3,c2pnb208w1,c2tnb239v1, - c2tnb239v2,c2tnb239v3,c2pnb272w1,c2pnb304w1,c2tnb359v1,c2pnb368w1,c2tnb431r1, - wtls3,wtls5,wtls10,wtls11]; -characteristic_two_curves(true, _) -> - [sect113r1,sect113r2,sect131r1,sect131r2,wtls1,wtls4,ipsec3,ipsec4] - ++ characteristic_two_curves(true, true); -characteristic_two_curves(_, _) -> - []. + proplists:get_value(curves, crypto:supports()) -- [x25519,x448]. curve(secp112r1) -> { diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index ebb55c4a34..5dd630526c 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -31,6 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app, + {group, api_errors}, appup, {group, fips}, {group, non_fips}, @@ -50,6 +51,10 @@ groups() -> {group, sha256}, {group, sha384}, {group, sha512}, + {group, sha3_224}, + {group, sha3_256}, + {group, sha3_384}, + {group, sha3_512}, {group, rsa}, {group, dss}, {group, ecdsa}, @@ -76,6 +81,8 @@ groups() -> {group, aes_ctr}, {group, aes_gcm}, {group, chacha20_poly1305}, + {group, chacha20}, + {group, poly1305}, {group, aes_cbc}]}, {fips, [], [{group, no_md4}, {group, no_md5}, @@ -111,6 +118,7 @@ groups() -> {group, aes_ctr}, {group, aes_gcm}, {group, no_chacha20_poly1305}, + {group, no_chacha20}, {group, aes_cbc}]}, {md4, [], [hash]}, {md5, [], [hash, hmac]}, @@ -120,6 +128,10 @@ groups() -> {sha256, [], [hash, hmac]}, {sha384, [], [hash, hmac]}, {sha512, [], [hash, hmac]}, + {sha3_224, [], [hash, hmac]}, + {sha3_256, [], [hash, hmac]}, + {sha3_384, [], [hash, hmac]}, + {sha3_512, [], [hash, hmac]}, {rsa, [], [sign_verify, public_encrypt, private_encrypt, @@ -133,7 +145,7 @@ groups() -> ]}, {dh, [], [generate_compute, compute_bug]}, - {ecdh, [], [compute, generate]}, + {ecdh, [], [generate_all_supported, compute, generate]}, {srp, [], [generate_compute]}, {des_cbc, [], [block]}, {des_cfb, [], [block]}, @@ -156,6 +168,8 @@ groups() -> {aes_ctr, [], [stream]}, {aes_gcm, [], [aead]}, {chacha20_poly1305, [], [aead]}, + {chacha20, [], [stream]}, + {poly1305, [], [poly1305]}, {aes_cbc, [], [block]}, {no_md4, [], [no_support, no_hash]}, {no_md5, [], [no_support, no_hash, no_hmac]}, @@ -169,8 +183,10 @@ groups() -> {no_blowfish_ofb64, [], [no_support, no_block]}, {no_aes_ige256, [], [no_support, no_block]}, {no_chacha20_poly1305, [], [no_support, no_aead]}, + {no_chacha20, [], [no_support, no_stream_ivec]}, {no_rc2_cbc, [], [no_support, no_block]}, - {no_rc4, [], [no_support, no_stream]} + {no_rc4, [], [no_support, no_stream]}, + {api_errors, [], [api_errors_ecdh]} ]. %%------------------------------------------------------------------- @@ -205,7 +221,7 @@ init_per_suite(Config) -> Config end catch _:_ -> - {skip, "Crypto did not start"} + {fail, "Crypto did not start"} end. end_per_suite(_Config) -> @@ -238,6 +254,8 @@ init_per_group(non_fips, Config) -> _NotEnabled -> NonFIPSConfig end; +init_per_group(api_errors, Config) -> + Config; init_per_group(GroupName, Config) -> case atom_to_list(GroupName) of "no_" ++ TypeStr -> @@ -352,6 +370,20 @@ cmac(Config) when is_list(Config) -> lists:foreach(fun cmac_check/1, Pairs), lists:foreach(fun cmac_check/1, cmac_iolistify(Pairs)). %%-------------------------------------------------------------------- +poly1305() -> + [{doc, "Test poly1305 function"}]. +poly1305(Config) -> + lists:foreach( + fun({Key, Txt, Expect}) -> + case crypto:poly1305(Key,Txt) of + Expect -> + ok; + Other -> + ct:fail({{crypto, poly1305, [Key, Txt]}, {expected, Expect}, {got, Other}}) + end + end, proplists:get_value(poly1305, Config)). + +%%-------------------------------------------------------------------- block() -> [{doc, "Test block ciphers"}]. block(Config) when is_list(Config) -> @@ -416,6 +448,13 @@ no_stream(Config) when is_list(Config) -> notsup(fun crypto:stream_init/2, [Type, <<"Key">>]). %%-------------------------------------------------------------------- +no_stream_ivec() -> + [{doc, "Test disabled stream ciphers that uses ivec"}]. +no_stream_ivec(Config) when is_list(Config) -> + Type = ?config(type, Config), + notsup(fun crypto:stream_init/3, [Type, <<"Key">>, <<"Ivec">>]). + +%%-------------------------------------------------------------------- aead() -> [{doc, "Test AEAD ciphers"}]. aead(Config) when is_list(Config) -> @@ -466,7 +505,7 @@ generate_compute(Config) when is_list(Config) -> %%-------------------------------------------------------------------- compute_bug() -> [{doc, "Test that it works even if the Secret is smaller than expected"}]. -compute_bug(Config) -> +compute_bug(_Config) -> ExpectedSecret = <<118,89,171,16,156,18,156,103,189,134,130,49,28,144,111,241,247,82,79,32,228,11,209,141,119,176,251,80,105,143,235,251,203,121,223,211,129,3,233,133,45,2,31,157,24,111,5,75,153,66,135,185,128,115,229,178,216,39,73,52,80,151,8,241,34,52,226,71,137,167,53,48,59,224,175,154,89,110,76,83,24,117,149,21,72,6,186,78,149,74,188,56,98,244,30,77,108,248,88,194,195,237,23,51,20,242,254,123,21,12,209,74,217,168,230,65,7,60,211,139,128,239,234,153,22,229,180,59,159,121,41,156,121,200,177,130,163,162,54,224,93,1,94,11,177,254,118,28,156,26,116,10,207,145,219,166,214,189,214,230,221,170,228,15,69,88,31,68,94,255,113,58,49,82,86,192,248,176,131,133,39,186,194,172,206,84,184,16,66,68,153,128,178,227,27,118,52,130,122,92,24,222,102,195,221,207,255,13,152,175,65,32,167,84,54,244,243,109,244,18,234,16,159,224,188,2,106,123,27,17,131,171,226,34,111,251,62,119,155,124,221,124,254,62,97,167,1,105,116,98,98,19,197,30,72,180,79,221,100,134,120,117,124,85,73,132,224,223,222,41,155,137,218,130,238,237,157,161,134,150,69,206,91,141,17,89,120,218,235,229,37,150,76,197,7,157,56,144,42,203,137,100,200,72,141,194,239,1,67,236,238,183,48,214,75,76,108,235,3,237,67,40,137,45,182,236,246,37,116,103,144,237,142,211,88,233,11,24,21,218,41,245,250,51,130,250,104,74,189,17,69,145,70,50,50,215,253,155,10,128,41,114,185,211,82,164,72,92,17,145,104,66,6,140,226,80,43,62,1,166,216,153,118,96,15,147,126,137,118,191,192,75,149,241,206,18,92,17,154,215,219,18,6,139,190,103,210,156,184,29,224,213,157,60,112,189,104,220,125,40,186,50,119,17,143,136,149,38,74,107,21,192,59,61,59,42,231,144,59,175,3,176,87,23,16,122,54,31,82,34,230,211,44,81,41,47,86,37,228,175,130,148,88,136,131,254,241,202,99,199,175,1,141,215,124,155,120,43,141,89,11,140,120,141,29,35,82,219,155,204,75,12,66,241,253,33,250,84,24,85,68,13,80,85,142,227,34,139,26,146,24>>, OthersPublicKey = 635619632099733175381667940709387641100492974601603060984753028943194386334921787463327680809776598322996634648015962954045728174069768874873236397421720142610982770302060309928552098274817978606093380781524199673890631795310930242601197479471368910519338301177304682162189801040921618559902948819107531088646753320486728060005223263561551402855338732899079439899705951063999951507319258050864346087428042978411873495523439615429804957374639092580169417598963105885529553632847023899713490485619763926900318508906706745060947269748612049634207985438016935262521715769812475329234748426647554362991758104620357149045960316987533503707855364806010494793980069245562784050236811004893018183726397041999426883788660276453352521120006817370050691205529335316794439089316232980047277245051173281601960196573681285904611182521967067911862467395705665888521948321299521549941618586026714676885890192323289343756440666276226084448279082483536164085883288884231665240707495770544705648564889889198060417915693315346959170105413290799314390963124178046425737828369059171472978294050322371452255088799865552038756937873388385970088906560408959959429398326288750834357514847891423941047433478384621074116184703014798814515161475596555032391555842, MyPrivateKey = 387759582879975726965038486537011291913744975764132199838375902680222019267527675651273586836110220500657652661706223760165097275862806031329642160439090779625708664007910974206651834216043397115514725827856461492311499129200688538220719685637154290305617686974719521885238198226075381217068175824097878445476010193039590876624464274744156624589136789060427283492343902761765833713520850870233407503430180028104167029073459918756981323130062648615262139444306321256382009848217866984408901761817655567071716275177768316006340055589170095799943481591033461616307776069027985761229636731465482676467627154100912586936231051371168178564599296638350391246393336702334311781595616786107810962134407697848002331639021101685320844880636050048769216986088652236979636019052557155807310341483407890060105599892252118584570558049301477535792498672552850760356632076013402382600669875697284264329434950712239302528367835155163504374877787288116104285944993818319105835423479332617802010952731990182088670508346704423006877514817882782443833997288652405892920173712497948376815825396272381214976859009518623799156300136570204539240675245115597412280078940442452936425561984312708387584800789375684525365060589104566195610526570099527133097201479, @@ -506,6 +545,33 @@ compute(Config) when is_list(Config) -> Gen = proplists:get_value(compute, Config), lists:foreach(fun do_compute/1, Gen). %%-------------------------------------------------------------------- +generate_all_supported() -> + [{doc, " Test that all curves from crypto:ec_curves/0 returns two binaries"}]. +generate_all_supported(_Config) -> + Results = + [try + crypto:generate_key(ecdh, C) + of + {B1,B2} when is_binary(B1) and is_binary(B2) -> + %% That is, seems like it works as expected. + {ok,C}; + Err -> + ct:log("ERROR: Curve ~p generated ~p", [C,Err]), + {error,{C,Err}} + catch + Cls:Err:Stack -> + ct:log("ERROR: Curve ~p exception ~p:~p~n~p", [C,Cls,Err,Stack]), + {error,{C,{Cls,Err}}} + end + || C <- crypto:ec_curves() + ], + OK = [C || {ok,C} <- Results], + ct:log("Ok (len=~p): ~p", [length(OK), OK]), + false = lists:any(fun({error,_}) -> true; + (_) -> false + end, Results). + +%%-------------------------------------------------------------------- generate() -> [{doc, " Test crypto:generate_key"}]. generate(Config) when is_list(Config) -> @@ -571,31 +637,29 @@ hash_increment(State0, [Increment | Rest]) -> hmac(_, [],[],[]) -> ok; hmac(sha = Type, [Key | Keys], [ <<"Test With Truncation">> = Data| Rest], [Expected | Expects]) -> - case crypto:hmac(Type, Key, Data, 20) of - Expected -> - ok; - Other -> - ct:fail({{crypto, hmac, [Type, Key, Data]}, {expected, Expected}, {got, Other}}) - end, + call_crypto_hmac([Type, Key, Data, 20], Type, Expected), hmac(Type, Keys, Rest, Expects); - hmac(Type, [Key | Keys], [ <<"Test With Truncation">> = Data| Rest], [Expected | Expects]) -> - case crypto:hmac(Type, Key, Data, 16) of - Expected -> - ok; - Other -> - ct:fail({{crypto, hmac, [Type, Key, Data]}, {expected, Expected}, {got, Other}}) - end, + call_crypto_hmac([Type, Key, Data, 16], Type, Expected), hmac(Type, Keys, Rest, Expects); - hmac(Type, [Key | Keys], [Data| Rest], [Expected | Expects]) -> - case crypto:hmac(Type, Key, Data) of + call_crypto_hmac([Type, Key, Data], Type, Expected), + hmac(Type, Keys, Rest, Expects). + +call_crypto_hmac(Args, Type, Expected) -> + try apply(crypto, hmac, Args) + of Expected -> ok; Other -> - ct:fail({{crypto, hmac, [Type, Key, Data]}, {expected, Expected}, {got, Other}}) - end, - hmac(Type, Keys, Rest, Expects). + ct:fail({{crypto,hmac,Args}, {expected,Expected}, {got,Other}}) + catch + error:notsup -> + ct:fail("HMAC ~p not supported", [Type]); + Class:Cause -> + ct:fail({{crypto,hmac,Args}, {expected,Expected}, {got,{Class,Cause}}}) + end. + hmac_increment(Type) -> Key = hmac_key(Type), @@ -726,16 +790,33 @@ stream_cipher({Type, Key, IV, PlainText}) -> ok; Other -> ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other}}) + end; +stream_cipher({Type, Key, IV, PlainText, CipherText}) -> + Plain = iolist_to_binary(PlainText), + State = crypto:stream_init(Type, Key, IV), + case crypto:stream_encrypt(State, PlainText) of + {_, CipherText} -> + ok; + {_, Other0} -> + ct:fail({{crypto, stream_encrypt, [State, Type, Key, IV, Plain]}, {expected, CipherText}, {got, Other0}}) + end, + case crypto:stream_decrypt(State, CipherText) of + {_, Plain} -> + ok; + Other1 -> + ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other1}}) end. stream_cipher_incment({Type, Key, PlainTexts}) -> State = crypto:stream_init(Type, Key), - stream_cipher_incment(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)); + stream_cipher_incment_loop(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)); stream_cipher_incment({Type, Key, IV, PlainTexts}) -> State = crypto:stream_init(Type, Key, IV), - stream_cipher_incment(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)). + stream_cipher_incment_loop(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)); +stream_cipher_incment({Type, Key, IV, PlainTexts, _CipherText}) -> + stream_cipher_incment({Type, Key, IV, PlainTexts}). -stream_cipher_incment(_State, OrigState, [], Acc, Plain) -> +stream_cipher_incment_loop(_State, OrigState, [], Acc, Plain) -> CipherText = iolist_to_binary(lists:reverse(Acc)), case crypto:stream_decrypt(OrigState, CipherText) of {_, Plain} -> @@ -743,9 +824,9 @@ stream_cipher_incment(_State, OrigState, [], Acc, Plain) -> Other -> ct:fail({{crypto, stream_decrypt, [OrigState, CipherText]}, {expected, Plain}, {got, Other}}) end; -stream_cipher_incment(State0, OrigState, [PlainText | PlainTexts], Acc, Plain) -> +stream_cipher_incment_loop(State0, OrigState, [PlainText | PlainTexts], Acc, Plain) -> {State, CipherText} = crypto:stream_encrypt(State0, PlainText), - stream_cipher_incment(State, OrigState, PlainTexts, [CipherText | Acc], Plain). + stream_cipher_incment_loop(State, OrigState, PlainTexts, [CipherText | Acc], Plain). aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag}) -> Plain = iolist_to_binary(PlainText), @@ -811,7 +892,7 @@ do_sign_verify({Type, Hash, Public, Private, Msg, Options}) -> error:notsup when NotSupLow == true, is_integer(LibVer), LibVer < 16#10001000 -> - %% Thoose opts where introduced in 1.0.1 + %% Those opts where introduced in 1.0.1 ct:log("notsup but OK in old cryptolib crypto:sign(~p, ~p, ..., ..., ..., ~p)", [Type,Hash,Options]), true; @@ -836,26 +917,69 @@ negative_verify(Type, Hash, Msg, Signature, Public, Options) -> ok end. +-define(PUB_PRIV_ENC_DEC_CATCH(Type,Padding), + CC:EE -> + ct:log("~p:~p in ~p:~p/~p, line ~p.~n" + "Type = ~p~nPadding = ~p", + [CC,EE,?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY,?LINE,(Type),(Padding)]), + MaybeUnsupported = + case crypto:info_lib() of + [{<<"OpenSSL">>,_,_}] -> + is_list(Padding) andalso + lists:any(fun(P) -> lists:member(P,(Padding)) end, + [{rsa_padding, rsa_pkcs1_oaep_padding}, + {rsa_padding, rsa_sslv23_padding}, + {rsa_padding, rsa_x931_padding}]); + _ -> + false + end, + case CC of + error when MaybeUnsupported -> + ct:comment("Padding unsupported?",[]); + _ -> + ct:fail({?FUNCTION_NAME,CC,EE,(Type),(Padding)}) + end + ). + do_public_encrypt({Type, Public, Private, Msg, Padding}) -> - PublicEcn = (catch crypto:public_encrypt(Type, Msg, Public, Padding)), - case crypto:private_decrypt(Type, PublicEcn, Private, Padding) of - Msg -> - ok; - Other -> - ct:fail({{crypto, private_decrypt, [Type, PublicEcn, Private, Padding]}, {expected, Msg}, {got, Other}}) + try + crypto:public_encrypt(Type, Msg, Public, Padding) + of + PublicEcn -> + try + crypto:private_decrypt(Type, PublicEcn, Private, Padding) + of + Msg -> + ok; + Other -> + ct:fail({{crypto, private_decrypt, [Type, PublicEcn, Private, Padding]}, {expected, Msg}, {got, Other}}) + catch + ?PUB_PRIV_ENC_DEC_CATCH(Type, Padding) + end + catch + ?PUB_PRIV_ENC_DEC_CATCH(Type, Padding) end. -do_private_encrypt({_Type, _Public, _Private, _Msg, rsa_pkcs1_oaep_padding}) -> - ok; %% Not supported by openssl + do_private_encrypt({Type, Public, Private, Msg, Padding}) -> - PrivEcn = (catch crypto:private_encrypt(Type, Msg, Private, Padding)), - case crypto:public_decrypt(Type, PrivEcn, Public, Padding) of - Msg -> - ok; - Other -> - ct:fail({{crypto, public_decrypt, [Type, PrivEcn, Public, Padding]}, {expected, Msg}, {got, Other}}) + try + crypto:private_encrypt(Type, Msg, Private, Padding) + of + PrivEcn -> + try + crypto:public_decrypt(Type, PrivEcn, Public, Padding) + of + Msg -> + ok; + Other -> + ct:fail({{crypto, public_decrypt, [Type, PrivEcn, Public, Padding]}, {expected, Msg}, {got, Other}}) + catch + ?PUB_PRIV_ENC_DEC_CATCH(Type, Padding) + end + catch + ?PUB_PRIV_ENC_DEC_CATCH(Type, Padding) end. - + do_generate_compute({srp = Type, UserPrivate, UserGenParams, UserComParams, HostPublic, HostPrivate, HostGenParams, HostComParam, SessionKey}) -> {UserPublic, UserPrivate} = crypto:generate_key(Type, UserGenParams, UserPrivate), @@ -924,6 +1048,8 @@ hexstr2bin(S) when is_binary(S) -> hexstr2bin(S) -> list_to_binary(hexstr2list(S)). +hexstr2list([$ |T]) -> + hexstr2list(T); hexstr2list([X,Y|T]) -> [mkint(X)*16 + mkint(Y) | hexstr2list(T)]; hexstr2list([]) -> @@ -953,7 +1079,9 @@ do_cmac_iolistify({Type, Key, Text, Size, CMac}) -> do_stream_iolistify({Type, Key, PlainText}) -> {Type, iolistify(Key), iolistify(PlainText)}; do_stream_iolistify({Type, Key, IV, PlainText}) -> - {Type, iolistify(Key), IV, iolistify(PlainText)}. + {Type, iolistify(Key), IV, iolistify(PlainText)}; +do_stream_iolistify({Type, Key, IV, PlainText, CipherText}) -> + {Type, iolistify(Key), IV, iolistify(PlainText), CipherText}. do_block_iolistify({des_cbc = Type, Key, IV, PlainText}) -> {Type, Key, IV, des_iolistify(PlainText)}; @@ -1199,7 +1327,7 @@ group_config(sha224 = Type, Config) -> Keys = rfc_4231_keys(), Data = rfc_4231_msgs(), Hmac = rfc4231_hmac_sha224(), - [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; group_config(sha256 = Type, Config) -> Msgs = [rfc_4634_test1(), rfc_4634_test2_1(), long_msg()], Digests = rfc_4634_sha256_digests() ++ [long_sha256_digest()], @@ -1221,6 +1349,18 @@ group_config(sha512 = Type, Config) -> Data = rfc_4231_msgs() ++ [long_msg()], Hmac = rfc4231_hmac_sha512() ++ [long_hmac(sha512)], [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(sha3_224 = Type, Config) -> + {Msgs,Digests} = sha3_test_vectors(Type), + [{hash, {Type, Msgs, Digests}}, {hmac, hmac_sha3(Type)} | Config]; +group_config(sha3_256 = Type, Config) -> + {Msgs,Digests} = sha3_test_vectors(Type), + [{hash, {Type, Msgs, Digests}}, {hmac, hmac_sha3(Type)} | Config]; +group_config(sha3_384 = Type, Config) -> + {Msgs,Digests} = sha3_test_vectors(Type), + [{hash, {Type, Msgs, Digests}}, {hmac, hmac_sha3(Type)} | Config]; +group_config(sha3_512 = Type, Config) -> + {Msgs,Digests} = sha3_test_vectors(Type), + [{hash, {Type, Msgs, Digests}}, {hmac, hmac_sha3(Type)} | Config]; group_config(rsa = Type, Config) -> Msg = rsa_plain(), Public = rsa_public(), @@ -1241,7 +1381,12 @@ group_config(rsa = Type, Config) -> end, MsgPubEnc = <<"7896345786348 Asldi">>, PubPrivEnc = [{rsa, PublicS, PrivateS, MsgPubEnc, rsa_pkcs1_padding}, + {rsa, PublicS, PrivateS, MsgPubEnc, [{rsa_padding, rsa_pkcs1_padding}]}, + {rsa, PublicS, PrivateS, MsgPubEnc, [{rsa_padding, rsa_sslv23_padding}]}, + {rsa, PublicS, PrivateS, MsgPubEnc, [{rsa_padding, rsa_x931_padding}]}, rsa_oaep(), + rsa_oaep_label(), + rsa_oaep256(), no_padding() ], Generate = [{rsa, 1024, 3}, {rsa, 2048, 17}, {rsa, 3072, 65537}], @@ -1353,6 +1498,18 @@ group_config(aes_gcm, Config) -> group_config(chacha20_poly1305, Config) -> AEAD = chacha20_poly1305(), [{aead, AEAD} | Config]; +group_config(chacha20, Config) -> + Stream = chacha20(), + [{stream, Stream} | Config]; +group_config(poly1305, Config) -> + V = [%% {Key, Txt, Expect} + {%% RFC7539 2.5.2 + crypto_SUITE:hexstr2bin("85d6be7857556d337f4452fe42d506a80103808afb0db2fd4abff6af4149f51b"), + <<"Cryptographic Forum Research Group">>, + crypto_SUITE:hexstr2bin("a8061dc1305136c6c22b8baf0c0127a9") + } + ], + [{poly1305,V} | Config]; group_config(aes_cbc, Config) -> Block = aes_cbc(Config), [{block, Block} | Config]; @@ -1421,6 +1578,160 @@ rfc_1321_md5_digests() -> hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f"), hexstr2bin("57edf4a22be3c955ac49da2e2107b67a")]. +%%% https://www.di-mgt.com.au/sha_testvectors.html +sha3_msgs() -> + ["abc", + "", + "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq", % length 448 bits + "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu", % length 896 bits + lists:duplicate(1000000,$a) + ]. + +sha3_test_vectors(sha3_224) -> + {sha3_msgs(), + [hexstr2bin("e642824c3f8cf24a d09234ee7d3c766f c9a3a5168d0c94ad 73b46fdf"), + hexstr2bin("6b4e03423667dbb7 3b6e15454f0eb1ab d4597f9a1b078e3f 5b5a6bc7"), + hexstr2bin("8a24108b154ada21 c9fd5574494479ba 5c7e7ab76ef264ea d0fcce33"), + hexstr2bin("543e6868e1666c1a 643630df77367ae5 a62a85070a51c14c bf665cbc"), + hexstr2bin("d69335b93325192e 516a912e6d19a15c b51c6ed5c15243e7 a7fd653c") + ] + }; +sha3_test_vectors(sha3_256) -> + {sha3_msgs(), + [hexstr2bin("3a985da74fe225b2 045c172d6bd390bd 855f086e3e9d525b 46bfe24511431532"), + hexstr2bin("a7ffc6f8bf1ed766 51c14756a061d662 f580ff4de43b49fa 82d80a4b80f8434a"), + hexstr2bin("41c0dba2a9d62408 49100376a8235e2c 82e1b9998a999e21 db32dd97496d3376"), + hexstr2bin("916f6061fe879741 ca6469b43971dfdb 28b1a32dc36cb325 4e812be27aad1d18"), + hexstr2bin("5c8875ae474a3634 ba4fd55ec85bffd6 61f32aca75c6d699 d0cdcb6c115891c1") + ] + }; +sha3_test_vectors(sha3_384) -> + {sha3_msgs(), + [hexstr2bin("ec01498288516fc9 26459f58e2c6ad8d f9b473cb0fc08c25 96da7cf0e49be4b2 98d88cea927ac7f5 39f1edf228376d25"), + hexstr2bin("0c63a75b845e4f7d 01107d852e4c2485 c51a50aaaa94fc61 995e71bbee983a2a c3713831264adb47 fb6bd1e058d5f004"), + hexstr2bin("991c665755eb3a4b 6bbdfb75c78a492e 8c56a22c5c4d7e42 9bfdbc32b9d4ad5a a04a1f076e62fea1 9eef51acd0657c22"), + hexstr2bin("79407d3b5916b59c 3e30b09822974791 c313fb9ecc849e40 6f23592d04f625dc 8c709b98b43b3852 b337216179aa7fc7"), + hexstr2bin("eee9e24d78c18553 37983451df97c8ad 9eedf256c6334f8e 948d252d5e0e7684 7aa0774ddb90a842 190d2c558b4b8340") + ] + }; +sha3_test_vectors(sha3_512) -> + {sha3_msgs(), + [hexstr2bin("b751850b1a57168a 5693cd924b6b096e 08f621827444f70d 884f5d0240d2712e 10e116e9192af3c9 1a7ec57647e39340 57340b4cf408d5a5 6592f8274eec53f0"), + hexstr2bin("a69f73cca23a9ac5 c8b567dc185a756e 97c982164fe25859 e0d1dcc1475c80a6 15b2123af1f5f94c 11e3e9402c3ac558 f500199d95b6d3e3 01758586281dcd26"), + hexstr2bin("04a371e84ecfb5b8 b77cb48610fca818 2dd457ce6f326a0f d3d7ec2f1e91636d ee691fbe0c985302 ba1b0d8dc78c0863 46b533b49c030d99 a27daf1139d6e75e"), + hexstr2bin("afebb2ef542e6579 c50cad06d2e578f9 f8dd6881d7dc824d 26360feebf18a4fa 73e3261122948efc fd492e74e82e2189 ed0fb440d187f382 270cb455f21dd185"), + hexstr2bin("3c3a876da14034ab 60627c077bb98f7e 120a2a5370212dff b3385a18d4f38859 ed311d0a9d5141ce 9cc5c66ee689b266 a8aa18ace8282a0e 0db596c90b0a7b87") + ] + }. + + + +%%% http://www.wolfgang-ehrhardt.de/hmac-sha3-testvectors.html + +hmac_sha3(Type) -> + N = case Type of + sha3_224 -> 1; + sha3_256 -> 2; + sha3_384 -> 3; + sha3_512 -> 4 + end, + {Keys, Datas, Hmacs} = + lists:unzip3( + [{hexstr2bin(Key), hexstr2bin(Data), hexstr2bin(element(N,Hmacs))} + || {Key,Data,Hmacs} <- hmac_sha3_data()]), + {Type, Keys, Datas, Hmacs}. + + +hmac_sha3_data() -> + [ + {"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b 0b0b0b0b", + "4869205468657265", + {"3b16546bbc7be2706a031dcafd56373d 9884367641d8c59af3c860f7", + "ba85192310dffa96e2a3a40e69774351 140bb7185e1202cdcc917589f95e16bb", + "68d2dcf7fd4ddd0a2240c8a437305f61 fb7334cfb5d0226e1bc27dc10a2e723a 20d370b47743130e26ac7e3d532886bd", + "eb3fbd4b2eaab8f5c504bd3a41465aac ec15770a7cabac531e482f860b5ec7ba 47ccb2c6f2afce8f88d22b6dc61380f2 3a668fd3888bb80537c0a0b86407689e" + }}, + + {"4a656665", + "7768617420646f2079612077616e7420 666f72206e6f7468696e673f", + {"7fdb8dd88bd2f60d1b798634ad386811 c2cfc85bfaf5d52bbace5e66", + "c7d4072e788877ae3596bbb0da73b887 c9171f93095b294ae857fbe2645e1ba5", + "f1101f8cbf9766fd6764d2ed61903f21 ca9b18f57cf3e1a23ca13508a93243ce 48c045dc007f26a21b3f5e0e9df4c20a", + "5a4bfeab6166427c7a3647b747292b83 84537cdb89afb3bf5665e4c5e709350b 287baec921fd7ca0ee7a0c31d022a95e 1fc92ba9d77df883960275beb4e62024" + }}, + + {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaa", + "dddddddddddddddddddddddddddddddd dddddddddddddddddddddddddddddddd dddddddddddddddddddddddddddddddd dddd", + {"676cfc7d16153638780390692be142d2 df7ce924b909c0c08dbfdc1a", + "84ec79124a27107865cedd8bd82da996 5e5ed8c37b0ac98005a7f39ed58a4207", + "275cd0e661bb8b151c64d288f1f782fb 91a8abd56858d72babb2d476f0458373 b41b6ab5bf174bec422e53fc3135ac6e", + "309e99f9ec075ec6c6d475eda1180687 fcf1531195802a99b5677449a8625182 851cb332afb6a89c411325fbcbcd42af cb7b6e5aab7ea42c660f97fd8584bf03" + }}, + + {"0102030405060708090a0b0c0d0e0f10 111213141516171819", + "cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd cdcd", + {"a9d7685a19c4e0dbd9df2556cc8a7d2a 7733b67625ce594c78270eeb", + "57366a45e2305321a4bc5aa5fe2ef8a9 21f6af8273d7fe7be6cfedb3f0aea6d7", + "3a5d7a879702c086bc96d1dd8aa15d9c 46446b95521311c606fdc4e308f4b984 da2d0f9449b3ba8425ec7fb8c31bc136", + "b27eab1d6e8d87461c29f7f5739dd58e 98aa35f8e823ad38c5492a2088fa0281 993bbfff9a0e9c6bf121ae9ec9bb09d8 4a5ebac817182ea974673fb133ca0d1d" + }}, + + %% {"0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c 0c0c0c0c", + %% "546573742057697468205472756e6361 74696f6e", + %% {"49fdd3abd005ebb8ae63fea946d1883c", + %% "6e02c64537fb118057abb7fb66a23b3c", + %% "47c51ace1ffacffd7494724682615783", + %% "0fa7475948f43f48ca0516671e18978c" + %% }}, + + {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaa", + "54657374205573696e67204c61726765 72205468616e20426c6f636b2d53697a 65204b6579202d2048617368204b6579 204669727374", + {"b4a1f04c00287a9b7f6075b313d279b8 33bc8f75124352d05fb9995f", + "ed73a374b96c005235f948032f09674a 58c0ce555cfc1f223b02356560312c3b", + "0fc19513bf6bd878037016706a0e57bc 528139836b9a42c3d419e498e0e1fb96 16fd669138d33a1105e07c72b6953bcc", + "00f751a9e50695b090ed6911a4b65524 951cdc15a73a5d58bb55215ea2cd839a c79d2b44a39bafab27e83fde9e11f634 0b11d991b1b91bf2eee7fc872426c3a4" + }}, + + {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaa", + "54657374205573696e67204c61726765 72205468616e20426c6f636b2d53697a 65204b6579202d2048617368204b6579 204669727374", + { + "b96d730c148c2daad8649d83defaa371 9738d34775397b7571c38515", + "a6072f86de52b38bb349fe84cd6d97fb 6a37c4c0f62aae93981193a7229d3467", + "713dff0302c85086ec5ad0768dd65a13 ddd79068d8d4c6212b712e4164944911 1480230044185a99103ed82004ddbfcc", + "b14835c819a290efb010ace6d8568dc6 b84de60bc49b004c3b13eda763589451 e5dd74292884d1bdce64e6b919dd61dc 9c56a282a81c0bd14f1f365b49b83a5b" + }}, + + {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaa", + "54686973206973206120746573742075 73696e672061206c6172676572207468 616e20626c6f636b2d73697a65206b65 7920616e642061206c61726765722074 68616e20626c6f636b2d73697a652064 6174612e20546865206b6579206e6565 647320746f2062652068617368656420 6265666f7265206265696e6720757365 642062792074686520484d414320616c 676f726974686d2e", + { + "05d8cd6d00faea8d1eb68ade28730bbd 3cbab6929f0a086b29cd62a0", + "65c5b06d4c3de32a7aef8763261e49ad b6e2293ec8e7c61e8de61701fc63e123", + "026fdf6b50741e373899c9f7d5406d4e b09fc6665636fc1a530029ddf5cf3ca5 a900edce01f5f61e2f408cdf2fd3e7e8", + "38a456a004bd10d32c9ab83366841128 62c3db61adcca31829355eaf46fd5c73 d06a1f0d13fec9a652fb3811b577b1b1 d1b9789f97ae5b83c6f44dfcf1d67eba" + }}, + + {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaa", + "54686973206973206120746573742075 73696e672061206c6172676572207468 616e20626c6f636b2d73697a65206b65 7920616e642061206c61726765722074 68616e20626c6f636b2d73697a652064 6174612e20546865206b6579206e6565 647320746f2062652068617368656420 6265666f7265206265696e6720757365 642062792074686520484d414320616c 676f726974686d2e", + { + "c79c9b093424e588a9878bbcb089e018 270096e9b4b1a9e8220c866a", + "e6a36d9b915f86a093cac7d110e9e04c f1d6100d30475509c2475f571b758b5a", + "cad18a8ff6c4cc3ad487b95f9769e9b6 1c062aefd6952569e6e6421897054cfc 70b5fdc6605c18457112fc6aaad45585", + "dc030ee7887034f32cf402df34622f31 1f3e6cf04860c6bbd7fa488674782b46 59fdbdf3fd877852885cfe6e22185fe7 b2ee952043629bc9d5f3298a41d02c66" + }} + %%, + + %% {"4a656665", + %% "'11001' or LSB 13 or MSB c8", + %% { + %% "5f8c0ea7fafecd0c3463aad09742cece b142fe0ab6f4539438c59de8", + %% "ec8222773fac68b3d3dcb182aec8b050 7ace4448d20a1147e682118da4e3f44c", + %% "21fbd3bf3ebba3cfc9ef64c0591c92c5 acb265e92d8761d1f91a52a103a6c796 94cfd67a9a2ac1324f02fea63b81effc", + %% "27f9388c1567ef4ef200602a6cf871d6 8a6fb048d4737ac4418a2f021289d13d 1fd1120fecb9cf964c5b117ab5b11c61 4b2da39dadd51f2f5e22aaccec7d576e" + %% }} + ]. + + + rfc_4634_test1() -> <<"abc">>. rfc_4634_test2_1() -> @@ -1990,6 +2301,7 @@ aes_gcm(Config) -> "gcmEncryptExtIV192.rsp", "gcmEncryptExtIV256.rsp"]). + %% https://tools.ietf.org/html/rfc7539#appendix-A.5 chacha20_poly1305() -> [ @@ -2035,6 +2347,103 @@ chacha20_poly1305() -> hexstr2bin("eead9d67890cbb22392336fea1851f38")} %% CipherTag ]. + +chacha20() -> +%%% chacha20 (no mode) test vectors from RFC 7539 A.2 + [ + %% Test Vector #1: + {chacha20, + hexstr2bin("00000000000000000000000000000000" + "00000000000000000000000000000000"), %% Key + hexstr2bin("00000000" % Initial counter = 0, little-endian + "000000000000000000000000"), %% IV + hexstr2bin("00000000000000000000000000000000" %% PlainText + "00000000000000000000000000000000" + "00000000000000000000000000000000" + "00000000000000000000000000000000"), + hexstr2bin("76b8e0ada0f13d90405d6ae55386bd28" %% CipherText + "bdd219b8a08ded1aa836efcc8b770dc7" + "da41597c5157488d7724e03fb8d84a37" + "6a43b8f41518a11cc387b669b2ee6586")}, + %% Test Vector #2: + {chacha20, + hexstr2bin("00000000000000000000000000000000" + "00000000000000000000000000000001"), %% Key + hexstr2bin("01000000" % Initial counter = 1, little-endian + "000000000000000000000002"), %% IV + hexstr2bin("416e79207375626d697373696f6e2074" %% PlainText + "6f20746865204945544620696e74656e" + "6465642062792074686520436f6e7472" + "696275746f7220666f72207075626c69" + "636174696f6e20617320616c6c206f72" + "2070617274206f6620616e2049455446" + "20496e7465726e65742d447261667420" + "6f722052464320616e6420616e792073" + "746174656d656e74206d616465207769" + "7468696e2074686520636f6e74657874" + "206f6620616e20494554462061637469" + "7669747920697320636f6e7369646572" + "656420616e20224945544620436f6e74" + "7269627574696f6e222e205375636820" + "73746174656d656e747320696e636c75" + "6465206f72616c2073746174656d656e" + "747320696e2049455446207365737369" + "6f6e732c2061732077656c6c20617320" + "7772697474656e20616e6420656c6563" + "74726f6e696320636f6d6d756e696361" + "74696f6e73206d61646520617420616e" + "792074696d65206f7220706c6163652c" + "20776869636820617265206164647265" + "7373656420746f"), + hexstr2bin("a3fbf07df3fa2fde4f376ca23e827370" %% CipherText + "41605d9f4f4f57bd8cff2c1d4b7955ec" + "2a97948bd3722915c8f3d337f7d37005" + "0e9e96d647b7c39f56e031ca5eb6250d" + "4042e02785ececfa4b4bb5e8ead0440e" + "20b6e8db09d881a7c6132f420e527950" + "42bdfa7773d8a9051447b3291ce1411c" + "680465552aa6c405b7764d5e87bea85a" + "d00f8449ed8f72d0d662ab052691ca66" + "424bc86d2df80ea41f43abf937d3259d" + "c4b2d0dfb48a6c9139ddd7f76966e928" + "e635553ba76c5c879d7b35d49eb2e62b" + "0871cdac638939e25e8a1e0ef9d5280f" + "a8ca328b351c3c765989cbcf3daa8b6c" + "cc3aaf9f3979c92b3720fc88dc95ed84" + "a1be059c6499b9fda236e7e818b04b0b" + "c39c1e876b193bfe5569753f88128cc0" + "8aaa9b63d1a16f80ef2554d7189c411f" + "5869ca52c5b83fa36ff216b9c1d30062" + "bebcfd2dc5bce0911934fda79a86f6e6" + "98ced759c3ff9b6477338f3da4f9cd85" + "14ea9982ccafb341b2384dd902f3d1ab" + "7ac61dd29c6f21ba5b862f3730e37cfd" + "c4fd806c22f221")}, + %%Test Vector #3: + {chacha20, + hexstr2bin("1c9240a5eb55d38af333888604f6b5f0" + "473917c1402b80099dca5cbc207075c0"), %% Key + hexstr2bin("2a000000" % Initial counter = 42 (decimal), little-endian + "000000000000000000000002"), %% IV + hexstr2bin("2754776173206272696c6c69672c2061" %% PlainText + "6e642074686520736c6974687920746f" + "7665730a446964206779726520616e64" + "2067696d626c6520696e207468652077" + "6162653a0a416c6c206d696d73792077" + "6572652074686520626f726f676f7665" + "732c0a416e6420746865206d6f6d6520" + "7261746873206f757467726162652e"), + hexstr2bin("62e6347f95ed87a45ffae7426f27a1df" %% CipherText + "5fb69110044c0d73118effa95b01e5cf" + "166d3df2d721caf9b21e5fb14c616871" + "fd84c54f9d65b283196c7fe4f60553eb" + "f39c6402c42234e32a356b3e764312a6" + "1a5532055716ead6962568f87d3f3f77" + "04c6a8d1bcd1bf4d50d6154b6da731b1" + "87b58dfd728afa36757a797ac188d1")} + ]. + + rsa_plain() -> <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" "09812312908312378623487263487623412039812 huagasd">>. @@ -2230,7 +2639,9 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv SessionKey}. ecdh() -> %% http://csrc.nist.gov/groups/STM/cavp/ - Curves = crypto:ec_curves(), + Curves = crypto:ec_curves() ++ + [X || X <- proplists:get_value(curves, crypto:supports(), []), + lists:member(X, [x25519,x448])], TestCases = [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"), hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"), @@ -2313,7 +2724,32 @@ ecdh() -> "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"), hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"), brainpoolP512r1, - hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}], + hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}, + + %% RFC 7748, 6.1 + {ecdh, + 16#8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a, + 16#5dab087e624a8a4b79e17f8b83800ee66f3bb1292618b6fd1c2f8b27ff88e0eb, + x25519, + hexstr2bin("4a5d9d5ba4ce2de1728e3bf480350f25e07e21c947d19e3376f09b3c1e161742")}, + {ecdh, + 16#de9edb7d7b7dc1b4d35b61c2ece435373f8343c85b78674dadfc7e146f882b4f, + 16#77076d0a7318a57d3c16c17251b26645df4c2f87ebc0992ab177fba51db92c2a, + x25519, + hexstr2bin("4a5d9d5ba4ce2de1728e3bf480350f25e07e21c947d19e3376f09b3c1e161742")}, + + %% RFC 7748, 6.2 + {ecdh, + 16#9b08f7cc31b7e3e67d22d5aea121074a273bd2b83de09c63faa73d2c22c5d9bbc836647241d953d40c5b12da88120d53177f80e532c41fa0, + 16#1c306a7ac2a0e2e0990b294470cba339e6453772b075811d8fad0d1d6927c120bb5ee8972b0d3e21374c9c921b09d1b0366f10b65173992d, + x448, + hexstr2bin("07fff4181ac6cc95ec1c16a94a0f74d12da232ce40a77552281d282bb60c0b56fd2464c335543936521c24403085d59a449a5037514a879d")}, + {ecdh, + 16#3eb7a829b0cd20f5bcfc0b599b6feccf6da4627107bdb0d4f345b43027d8b972fc3e34fb4232a13ca706dcb57aec3dae07bdc1c67bf33609, + 16#9a8f4925d1519f5775cf46b04b5800d4ee9ee8bae8bc5565d498c28dd9c9baf574a9419744897391006382a6f127ab1d9ac2d8c0a598726b, + x448, + hexstr2bin("07fff4181ac6cc95ec1c16a94a0f74d12da232ce40a77552281d282bb60c0b56fd2464c335543936521c24403085d59a449a5037514a879d")} + ], lists:filter(fun ({_Type, _Pub, _Priv, Curve, _SharedSecret}) -> lists:member(Curve, Curves) end, @@ -2334,7 +2770,32 @@ rsa_oaep() -> hexstr2bin("4f456c502493bdc0ed2ab756a3a6ed4d67352a697d4216e93212b127a63d5411ce6fa98d5dbefd73263e3728142743818166ed7dd63687dd2a8ca1d2f4fbd8e1")], %%Msg = hexstr2bin("6628194e12073db03ba94cda9ef9532397d50dba79b987004afefe34"), Msg = hexstr2bin("750c4047f547e8e41411856523298ac9bae245efaf1397fbe56f9dd5"), - {rsa, Public, Private, Msg, rsa_pkcs1_oaep_padding}. + {rsa, Public, Private, Msg, [{rsa_padding, rsa_pkcs1_oaep_padding}]}. + +rsa_oaep_label() -> + Public = [hexstr2bin("010001"), + hexstr2bin("a8b3b284af8eb50b387034a860f146c4919f318763cd6c5598c8ae4811a1e0abc4c7e0b082d693a5e7fced675cf4668512772c0cbc64a742c6c630f533c8cc72f62ae833c40bf25842e984bb78bdbf97c0107d55bdb662f5c4e0fab9845cb5148ef7392dd3aaff93ae1e6b667bb3d4247616d4f5ba10d4cfd226de88d39f16fb")], + Private = Public ++ [hexstr2bin("53339cfdb79fc8466a655c7316aca85c55fd8f6dd898fdaf119517ef4f52e8fd8e258df93fee180fa0e4ab29693cd83b152a553d4ac4d1812b8b9fa5af0e7f55fe7304df41570926f3311f15c4d65a732c483116ee3d3d2d0af3549ad9bf7cbfb78ad884f84d5beb04724dc7369b31def37d0cf539e9cfcdd3de653729ead5d1"), + hexstr2bin("d32737e7267ffe1341b2d5c0d150a81b586fb3132bed2f8d5262864a9cb9f30af38be448598d413a172efb802c21acf1c11c520c2f26a471dcad212eac7ca39d"), + hexstr2bin("cc8853d1d54da630fac004f471f281c7b8982d8224a490edbeb33d3e3d5cc93c4765703d1dd791642f1f116a0dd852be2419b2af72bfe9a030e860b0288b5d77"), + hexstr2bin("0e12bf1718e9cef5599ba1c3882fe8046a90874eefce8f2ccc20e4f2741fb0a33a3848aec9c9305fbecbd2d76819967d4671acc6431e4037968db37878e695c1"), + hexstr2bin("95297b0f95a2fa67d00707d609dfd4fc05c89dafc2ef6d6ea55bec771ea333734d9251e79082ecda866efef13c459e1a631386b7e354c899f5f112ca85d71583"), + hexstr2bin("4f456c502493bdc0ed2ab756a3a6ed4d67352a697d4216e93212b127a63d5411ce6fa98d5dbefd73263e3728142743818166ed7dd63687dd2a8ca1d2f4fbd8e1")], + Msg = hexstr2bin("750c4047f547e8e41411856523298ac9bae245efaf1397fbe56f9dd5"), + Lbl = hexstr2bin("1332a67ca7088f75c9b8fb5e3d072882"), + {rsa, Public, Private, Msg, [{rsa_padding, rsa_pkcs1_oaep_padding}, {rsa_oaep_label, Lbl}]}. + +rsa_oaep256() -> + Public = [hexstr2bin("010001"), + hexstr2bin("a8b3b284af8eb50b387034a860f146c4919f318763cd6c5598c8ae4811a1e0abc4c7e0b082d693a5e7fced675cf4668512772c0cbc64a742c6c630f533c8cc72f62ae833c40bf25842e984bb78bdbf97c0107d55bdb662f5c4e0fab9845cb5148ef7392dd3aaff93ae1e6b667bb3d4247616d4f5ba10d4cfd226de88d39f16fb")], + Private = Public ++ [hexstr2bin("53339cfdb79fc8466a655c7316aca85c55fd8f6dd898fdaf119517ef4f52e8fd8e258df93fee180fa0e4ab29693cd83b152a553d4ac4d1812b8b9fa5af0e7f55fe7304df41570926f3311f15c4d65a732c483116ee3d3d2d0af3549ad9bf7cbfb78ad884f84d5beb04724dc7369b31def37d0cf539e9cfcdd3de653729ead5d1"), + hexstr2bin("d32737e7267ffe1341b2d5c0d150a81b586fb3132bed2f8d5262864a9cb9f30af38be448598d413a172efb802c21acf1c11c520c2f26a471dcad212eac7ca39d"), + hexstr2bin("cc8853d1d54da630fac004f471f281c7b8982d8224a490edbeb33d3e3d5cc93c4765703d1dd791642f1f116a0dd852be2419b2af72bfe9a030e860b0288b5d77"), + hexstr2bin("0e12bf1718e9cef5599ba1c3882fe8046a90874eefce8f2ccc20e4f2741fb0a33a3848aec9c9305fbecbd2d76819967d4671acc6431e4037968db37878e695c1"), + hexstr2bin("95297b0f95a2fa67d00707d609dfd4fc05c89dafc2ef6d6ea55bec771ea333734d9251e79082ecda866efef13c459e1a631386b7e354c899f5f112ca85d71583"), + hexstr2bin("4f456c502493bdc0ed2ab756a3a6ed4d67352a697d4216e93212b127a63d5411ce6fa98d5dbefd73263e3728142743818166ed7dd63687dd2a8ca1d2f4fbd8e1")], + Msg = hexstr2bin("750c4047f547e8e41411856523298ac9bae245efaf1397fbe56f9dd5"), + {rsa, Public, Private, Msg, [{rsa_padding, rsa_pkcs1_oaep_padding}, {rsa_oaep_md, sha256}]}. ecc() -> %% http://point-at-infinity.org/ecc/nisttv @@ -2510,3 +2971,14 @@ parse_rsp_cmac(Type, Key0, Msg0, Mlen0, Tlen, MAC0, Next, Acc) -> I -> parse_rsp(Type, Next, [{Type, Key, Msg, I, MAC}|Acc]) end. + +api_errors_ecdh(Config) when is_list(Config) -> + %% Check that we don't segfault when fed garbage. + Test = fun(Others, Curve) -> + {_Pub, Priv} = crypto:generate_key(ecdh, Curve), + crypto:compute_key(ecdh, Others, Priv, Curve) + end, + Others = [gurka, 0, <<0>>], + Curves = [gaffel, 0, sect571r1], + [_= (catch Test(O, C)) || O <- Others, C <- Curves], + ok. diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl index f708d7272d..4b3ea10315 100644 --- a/lib/crypto/test/engine_SUITE.erl +++ b/lib/crypto/test/engine_SUITE.erl @@ -39,6 +39,10 @@ all() -> get_all_possible_methods, engine_load_all_methods, engine_load_some_methods, + multiple_engine_load, + engine_list, + get_id_and_name, + engine_by_id, bad_arguments, unknown_engine, pre_command_fail_bad_value, @@ -46,6 +50,7 @@ all() -> failed_engine_init, ctrl_cmd_string, ctrl_cmd_string_optional, + ensure_load, {group, engine_stored_key} ]. @@ -97,7 +102,7 @@ init_per_group(engine_stored_key, Config) -> {error, notexist} -> {skip, "OTP Test engine not found"}; {error, notsup} -> - {skip, "Engine not supported on this OpenSSL version"}; + {skip, "Engine not supported on this SSL version"}; {error, bad_engine_id} -> {skip, "Dynamic Engine not supported"}; Other -> @@ -132,11 +137,12 @@ get_all_possible_methods() -> get_all_possible_methods(Config) when is_list(Config) -> try List = crypto:engine_get_all_methods(), + true = erlang:is_list(List), ct:log("crypto:engine_get_all_methods() -> ~p\n", [List]), ok catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} + {skip, "Engine not supported on this SSL version"} end. engine_load_all_methods()-> @@ -149,13 +155,12 @@ engine_load_all_methods(Config) when is_list(Config) -> {error, notexist} -> {skip, "OTP Test engine not found"}; {ok, Engine} -> - try + try Md5Hash1 = <<106,30,3,246,166,222,229,158,244,217,241,179,50,232,107,109>>, Md5Hash1 = crypto:hash(md5, "Don't panic"), Md5Hash2 = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, case crypto:engine_load(<<"dynamic">>, [{<<"SO_PATH">>, Engine}, - {<<"ID">>, <<"MD5">>}, <<"LOAD">>], []) of {ok, E} -> @@ -181,7 +186,7 @@ engine_load_all_methods(Config) when is_list(Config) -> end catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} + {skip, "Engine not supported on this SSL version"} end end. @@ -195,21 +200,20 @@ engine_load_some_methods(Config) when is_list(Config) -> {error, notexist} -> {skip, "OTP Test engine not found"}; {ok, Engine} -> - try + try Md5Hash1 = <<106,30,3,246,166,222,229,158,244,217,241,179,50,232,107,109>>, Md5Hash1 = crypto:hash(md5, "Don't panic"), Md5Hash2 = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, EngineMethods = crypto:engine_get_all_methods() -- - [engine_method_dh,engine_method_rand, + [engine_method_dh, engine_method_rand, engine_method_ciphers, engine_method_store, engine_method_pkey_meths, engine_method_pkey_asn1_meths], case crypto:engine_load(<<"dynamic">>, [{<<"SO_PATH">>, Engine}, - {<<"ID">>, <<"MD5">>}, <<"LOAD">>], [], EngineMethods) of - {ok, E} -> + {ok, E} -> case crypto:hash(md5, "Don't panic") of Md5Hash1 -> ct:fail(fail_to_load_engine_still_original); @@ -232,7 +236,168 @@ engine_load_some_methods(Config) when is_list(Config) -> end catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} + {skip, "Engine not supported on this SSL version"} + end + end. + +multiple_engine_load()-> + [{doc, "Use a dummy md5 engine that does not implement md5" + "but rather returns a static binary to test that crypto:engine_load " + "functions works when called multiple times."}]. + +multiple_engine_load(Config) when is_list(Config) -> + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + try + Md5Hash1 = <<106,30,3,246,166,222,229,158,244,217,241,179,50,232,107,109>>, + Md5Hash1 = crypto:hash(md5, "Don't panic"), + Md5Hash2 = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + <<"LOAD">>], + []) of + {ok, E} -> + {ok, E1} = crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + <<"LOAD">>], + []), + {ok, E2} = crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + <<"LOAD">>], + []), + case crypto:hash(md5, "Don't panic") of + Md5Hash1 -> + ct:fail(fail_to_load_still_original_engine); + Md5Hash2 -> + ok; + _ -> + ct:fail(fail_to_load_engine) + end, + ok = crypto:engine_unload(E2), + case crypto:hash(md5, "Don't panic") of + Md5Hash1 -> + ct:fail(fail_to_load_still_original_engine); + Md5Hash2 -> + ok; + _ -> + ct:fail(fail_to_load_engine) + end, + ok = crypto:engine_unload(E), + case crypto:hash(md5, "Don't panic") of + Md5Hash1 -> + ct:fail(fail_to_load_still_original_engine); + Md5Hash2 -> + ok; + _ -> + ct:fail(fail_to_load_engine) + end, + ok = crypto:engine_unload(E1), + case crypto:hash(md5, "Don't panic") of + Md5Hash2 -> + ct:fail(fail_to_unload_still_test_engine); + Md5Hash1 -> + ok; + _ -> + ct:fail(fail_to_unload_engine) + end; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + catch + error:notsup -> + {skip, "Engine not supported on this SSL version"} + end + end. + +engine_list()-> + [{doc, "Test add and remove engine ID to the SSL internal engine list."}]. + +engine_list(Config) when is_list(Config) -> + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + try + EngineList0 = crypto:engine_list(), + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + <<"LOAD">>], + []) of + {ok, E} -> + EngineList0 = crypto:engine_list(), + ok = crypto:engine_add(E), + [<<"MD5">>] = lists:subtract(crypto:engine_list(), EngineList0), + ok = crypto:engine_remove(E), + EngineList0 = crypto:engine_list(), + ok = crypto:engine_unload(E); + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + catch + error:notsup -> + {skip, "Engine not supported on this SSL version"} + end + end. + +get_id_and_name()-> + [{doc, "Test fetching id and name from an engine."}]. + +get_id_and_name(Config) when is_list(Config) -> + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + try + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + <<"LOAD">>], + []) of + {ok, E} -> + <<"MD5">> = crypto:engine_get_id(E), + <<"MD5 test engine">> = crypto:engine_get_name(E), + ok = crypto:engine_unload(E); + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + catch + error:notsup -> + {skip, "Engine not supported on this SSL version"} + end + end. + +engine_by_id()-> + [{doc, "Test fetching a new reference the the engine when the" + "engine id is added to the SSL engine list."}]. + +engine_by_id(Config) when is_list(Config) -> + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + try + case crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, Engine}, + <<"LOAD">>], + []) of + {ok, E} -> + case crypto:engine_by_id(<<"MD5">>) of + {error,bad_engine_id} -> + ok; + {ok, _} -> + ct:fail(fail_engine_found) + end, + ok = crypto:engine_add(E), + {ok, _E1} = crypto:engine_by_id(<<"MD5">>), + ok = crypto:engine_remove(E), + ok = crypto:engine_unload(E); + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + catch + error:notsup -> + {skip, "Engine not supported on this SSL version"} end end. @@ -246,7 +411,7 @@ bad_arguments(Config) when is_list(Config) -> {error, notexist} -> {skip, "OTP Test engine not found"}; {ok, Engine} -> - try + try try crypto:engine_load(fail_engine, [], []) catch @@ -276,7 +441,7 @@ bad_arguments(Config) when is_list(Config) -> end catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} + {skip, "Engine not supported on this SSL version"} end end. @@ -289,7 +454,7 @@ unknown_engine(Config) when is_list(Config) -> ok catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} + {skip, "Engine not supported on this SSL version"} end. pre_command_fail_bad_value() -> @@ -311,7 +476,7 @@ pre_command_fail_bad_value(Config) when is_list(Config) -> end catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} + {skip, "Engine not supported on this SSL version"} end. pre_command_fail_bad_key() -> @@ -334,9 +499,9 @@ pre_command_fail_bad_key(Config) when is_list(Config) -> {skip, "Dynamic Engine not supported"} end end - catch + catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} + {skip, "Engine not supported on this SSL version"} end. failed_engine_init()-> @@ -352,18 +517,20 @@ failed_engine_init(Config) when is_list(Config) -> [{<<"SO_PATH">>, Engine}, {<<"ID">>, <<"MD5">>}], []) of - {error, add_engine_failed} -> + {error, engine_init_failed} -> ok; {error, bad_engine_id} -> {skip, "Dynamic Engine not supported"} end end - catch + catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} + {skip, "Engine not supported on this SSL version"} end. +%%------------------------------------------------------------------------- +%% Test the optional flag in ctrl comands ctrl_cmd_string()-> [{doc, "Test that a not known optional ctrl comand do not fail"}]. ctrl_cmd_string(Config) when is_list(Config) -> @@ -377,22 +544,22 @@ ctrl_cmd_string(Config) when is_list(Config) -> {<<"ID">>, <<"MD5">>}, <<"LOAD">>], []) of - {ok, E} -> + {ok, E} -> case crypto:engine_ctrl_cmd_string(E, <<"TEST">>, <<"17">>) of ok -> ct:fail(fail_ctrl_cmd_should_fail); - {error,ctrl_cmd_failed} -> + {error,ctrl_cmd_failed} -> ok end, - ok = crypto:engine_unload(E); + ok = crypto:engine_unload(E); {error, bad_engine_id} -> {skip, "Dynamic Engine not supported"} end end - catch + catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} - end. + {skip, "Engine not supported on this SSL version"} + end. ctrl_cmd_string_optional()-> [{doc, "Test that a not known optional ctrl comand do not fail"}]. @@ -407,25 +574,66 @@ ctrl_cmd_string_optional(Config) when is_list(Config) -> {<<"ID">>, <<"MD5">>}, <<"LOAD">>], []) of - {ok, E} -> + {ok, E} -> case crypto:engine_ctrl_cmd_string(E, <<"TEST">>, <<"17">>, true) of ok -> ok; - _ -> + _ -> ct:fail(fail_ctrl_cmd_string) end, - ok = crypto:engine_unload(E); + ok = crypto:engine_unload(E); {error, bad_engine_id} -> {skip, "Dynamic Engine not supported"} end end - catch + catch error:notsup -> - {skip, "Engine not supported on this OpenSSL version"} - end. + {skip, "Engine not supported on this SSL version"} + end. + +ensure_load()-> + [{doc, "Test the special ensure load function."}]. + +ensure_load(Config) when is_list(Config) -> + case crypto:get_test_engine() of + {error, notexist} -> + {skip, "OTP Test engine not found"}; + {ok, Engine} -> + try + Md5Hash1 = <<106,30,3,246,166,222,229,158,244,217,241,179,50,232,107,109>>, + Md5Hash1 = crypto:hash(md5, "Don't panic"), + Md5Hash2 = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + case crypto:ensure_engine_loaded(<<"MD5">>, Engine) of + {ok, E} -> + {ok, _E1} = crypto:ensure_engine_loaded(<<"MD5">>, Engine), + case crypto:hash(md5, "Don't panic") of + Md5Hash1 -> + ct:fail(fail_to_load_still_original_engine); + Md5Hash2 -> + ok; + _ -> + ct:fail(fail_to_load_engine) + end, + ok = crypto:ensure_engine_unloaded(E), + case crypto:hash(md5, "Don't panic") of + Md5Hash2 -> + ct:fail(fail_to_unload_still_test_engine); + Md5Hash1 -> + ok; + _ -> + ct:fail(fail_to_unload_engine) + end; + {error, bad_engine_id} -> + {skip, "Dynamic Engine not supported"} + end + catch + error:notsup -> + {skip, "Engine not supported on this SSL version"} + end + end. %%%---------------------------------------------------------------- -%%% Pub/priv key storage tests. Thoose are for testing the crypto.erl +%%% Pub/priv key storage tests. Those are for testing the crypto.erl %%% support for using priv/pub keys stored in an engine. sign_verify_rsa(Config) -> @@ -467,7 +675,7 @@ sign_verify_rsa_pwd_bad_pwd(Config) -> _ -> {fail, "PWD prot pubkey sign succeded with no pwd!"} catch error:badarg -> ok - end. + end. priv_encrypt_pub_decrypt_rsa(Config) -> Priv = #{engine => engine_ref(Config), @@ -540,7 +748,7 @@ get_pub_from_priv_key_rsa_pwd_no_pwd(Config) -> {skip, "RSA not supported"}; {error, Error} -> {fail, {wrong_error,Error}}; - Pub -> + Pub -> ct:log("rsa Pub = ~p",[Pub]), {fail, "PWD prot pubkey fetch succeded although no pwd!"} end. @@ -556,7 +764,7 @@ get_pub_from_priv_key_rsa_pwd_bad_pwd(Config) -> {skip, "RSA not supported"}; {error, Error} -> {fail, {wrong_error,Error}}; - Pub -> + Pub -> ct:log("rsa Pub = ~p",[Pub]), {fail, "PWD prot pubkey fetch succeded with bad pwd!"} end. @@ -590,7 +798,7 @@ get_pub_from_priv_key_ecdsa(Config) -> ct:log("ecdsa Pub = ~p",[Pub]), sign_verify(ecdsa, sha, Priv, Pub) end. - + %%%================================================================ %%% Help for engine_stored_pub_priv_keys* test cases %%% diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index cc34c20ac6..d262492668 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 4.3 +CRYPTO_VSN = 4.3.2 diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index ac901c5469..0eb258567f 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -248,7 +248,7 @@ handle_int_msg({attached, AttPid}, Status, _Bs, tell_attached({attached, M, Line, get(trace)}), %% Give info about status and call level as well - %% In this case, Status can not be exit_at + %% In this case, Status cannot be exit_at Msg = case Status of idle -> {func_at,M,Line,Le}; break -> {break_at,M,Line,Le}; diff --git a/lib/dialyzer/src/typer.erl b/lib/dialyzer/src/typer.erl index 4b99f5f72e..5a1b8619c9 100644 --- a/lib/dialyzer/src/typer.erl +++ b/lib/dialyzer/src/typer.erl @@ -980,7 +980,7 @@ fatal_error(Slogan) -> mode_error(OldMode, NewMode) -> Msg = io_lib:format("Mode was previously set to '~s'; " - "can not set it to '~s' now", + "cannot set it to '~s' now", [OldMode, NewMode]), fatal_error(Msg). diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl index ea92613781..3606b21932 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl @@ -272,7 +272,7 @@ valfun_1(if_end, Vst) -> valfun_1({try_case_end,Src}, Vst) -> assert_term(Src, Vst), kill_state(Vst); -%% Instructions that can not cause exceptions +%% Instructions that cannot cause exceptions valfun_1({move,Src,Dst}, Vst) -> Type = get_term_type(Src, Vst), set_type_reg(Type, Dst, Vst); diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_gen_ber.erl b/lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_gen_ber.erl index 1d065b3723..88b464a721 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_gen_ber.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_gen_ber.erl @@ -300,7 +300,7 @@ gen_encode_prim(_Erules,D,DoTag,Value) when record(D,type) -> 'ASN1_OPEN_TYPE' -> emit_encode_func('open_type', Value,DoTag); XX -> - exit({'can not encode' ,XX}) + exit({'cannot encode' ,XX}) end. @@ -562,7 +562,7 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Length,_Form,OptOrMand) -> BytesVar,","]), false; Other -> - exit({'can not decode' ,Other}) + exit({'cannot decode' ,Other}) end, NewLength = case DoLength of diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_gen_ber_bin_v2.erl b/lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_gen_ber_bin_v2.erl index 9164ec6551..573bb15c92 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_gen_ber_bin_v2.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_gen_ber_bin_v2.erl @@ -290,7 +290,7 @@ gen_encode_prim(_Erules,D,DoTag,Value) when record(D,type) -> 'ASN1_OPEN_TYPE' -> emit_encode_func('open_type', Value,DoTag); XX -> - exit({'can not encode' ,XX}) + exit({'cannot encode' ,XX}) end. @@ -602,7 +602,7 @@ gen_dec_prim(_Erules,Att,BytesVar,DoTag,_TagIn,_Form,_OptOrMand) -> BytesVar,","]), add_func({decode_open_type_as_binary,2}); Other -> - exit({'can not decode' ,Other}) + exit({'cannot decode' ,Other}) end, case {DoTag,NewTypeName} of diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_lib.erl b/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_lib.erl index 4008f8d789..9e0cdac2dc 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_lib.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_lib.erl @@ -779,7 +779,7 @@ error_desc(no_transaction) -> "Operation not allowed outside transactions"; error_desc(combine_error) -> "Table options were ilegally combined"; error_desc(bad_index) -> "Index already exists or was out of bounds"; error_desc(already_exists) -> "Some schema option we try to set is already on"; -error_desc(index_exists)-> "Some ops can not be performed on tabs with index"; +error_desc(index_exists)-> "Some ops cannot be performed on tabs with index"; error_desc(no_exists)-> "Tried to perform op on non-existing (non alive) item"; error_desc(system_limit) -> "Some system_limit was exhausted"; error_desc(mnesia_down) -> "A transaction involving objects at some remote " diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl b/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl index af49ceff72..b4e9edb7ce 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl @@ -1529,7 +1529,7 @@ commit_participant(Coord, Tid, Bin, C0, DiscNs, _RamNs) -> ?eval_debug_fun({?MODULE, commit_participant, pre}, [{tid, Tid}]), case catch mnesia_schema:prepare_commit(Tid, C0, {part, Coord}) of {Modified, C, DumperMode} when record(C, commit) -> - %% If we can not find any local unclear decision + %% If we cannot find any local unclear decision %% we should presume abort at startup recovery case lists:member(node(), DiscNs) of false -> diff --git a/lib/dialyzer/test/small_SUITE_data/results/left_assoc b/lib/dialyzer/test/small_SUITE_data/results/left_assoc new file mode 100644 index 0000000000..58cdad29de --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/left_assoc @@ -0,0 +1,2 @@ + +left_assoc.erl:93: The variable __@2 can never match since previous clauses completely covered the type binary() diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_sum b/lib/dialyzer/test/small_SUITE_data/results/maps_sum index b29ac77d88..daa099e490 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps_sum +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_sum @@ -1,4 +1,4 @@ -maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (maps:iterator() | map()) -> any() +maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (maps:iterator(_,_) | map()) -> any() maps_sum.erl:26: Function wrong2/1 has no local return maps_sum.erl:27: The call lists:foldl(fun((_,_,_) -> any()),0,Data::any()) will never return since it differs in the 1st argument from the success typing arguments: (fun((_,_) -> any()),any(),[any()]) diff --git a/lib/dialyzer/test/small_SUITE_data/src/left_assoc.erl b/lib/dialyzer/test/small_SUITE_data/src/left_assoc.erl new file mode 100644 index 0000000000..0250e4ab49 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/left_assoc.erl @@ -0,0 +1,96 @@ +-module(left_assoc). + +%% As pointed out in ERL-680, analyzing guards with short circuit +%% operators becomes very slow as the number of left associations +%% grows. + +-spec from_iso8601('Elixir.String':t(), 'Elixir.Calendar':calendar()) -> + {ok, t()} | {error, atom()}. + +-export_type([t/0]). + +-type t() :: + #{'__struct__' := 'Elixir.Date', + calendar := 'Elixir.Calendar':calendar(), + day := 'Elixir.Calendar':day(), + month := 'Elixir.Calendar':month(), + year := 'Elixir.Calendar':year()}. + +-export([from_iso8601/1, + from_iso8601/2]). + +from_iso8601(__@1) -> + from_iso8601(__@1, 'Elixir.Calendar.ISO'). + +from_iso8601(<<45/integer,_rest@1/binary>>, _calendar@1) -> + case raw_from_iso8601(_rest@1, _calendar@1) of + {ok,#{year := _year@1} = _date@1} -> + {ok,_date@1#{year := - _year@1}}; + __@1 -> + __@1 + end; +from_iso8601(<<_rest@1/binary>>, _calendar@1) -> + raw_from_iso8601(_rest@1, _calendar@1). + +raw_from_iso8601(_string@1, _calendar@1) -> + case _string@1 of + <<_y1@1/integer, + _y2@1/integer, + _y3@1/integer, + _y4@1/integer, + 45/integer, + _m1@1/integer, + _m2@1/integer, + 45/integer, + _d1@1/integer, + _d2@1/integer>> + when + ((((((((((((((_y1@1 >= 48 + andalso + _y1@1 =< 57) + andalso + _y2@1 >= 48) + andalso + _y2@1 =< 57) + andalso + _y3@1 >= 48) + andalso + _y3@1 =< 57) + andalso + _y4@1 >= 48) + andalso + _y4@1 =< 57) + andalso + _m1@1 >= 48) + andalso + _m1@1 =< 57) + andalso + _m2@1 >= 48) + andalso + _m2@1 =< 57) + andalso + _d1@1 >= 48) + andalso + _d1@1 =< 57) + andalso + _d2@1 >= 48) + andalso + _d2@1 =< 57 -> + {ok, + #{year => (_y1@1 - 48) * 1000 + (_y2@1 - 48) * 100 + + + (_y3@1 - 48) * 10 + + + (_y4@1 - 48), + month => (_m1@1 - 48) * 10 + (_m2@1 - 48), + day => (_d1@1 - 48) * 10 + (_d2@1 - 48), + calendar => _calendar@1, + '__struct__' => 'Elixir.Date'}}; + __@1 -> + case __@1 of + _ -> + {error,invalid_format}; + __@2 -> + error({with_clause,__@2}) + end + end. diff --git a/lib/erl_docgen/priv/xsl/db_eix.xsl b/lib/erl_docgen/priv/xsl/db_eix.xsl index b496614854..6bce577f08 100644 --- a/lib/erl_docgen/priv/xsl/db_eix.xsl +++ b/lib/erl_docgen/priv/xsl/db_eix.xsl @@ -3,7 +3,7 @@ # # %CopyrightBegin% # - # Copyright Ericsson AB 2009-2016. All Rights Reserved. + # Copyright Ericsson AB 2009-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. @@ -199,11 +199,34 @@ <xsl:template name="name"> <xsl:param name="lastfuncsblock"/> + <xsl:variable name="signature"> + <xsl:variable name="signature1"> + <xsl:choose> + <xsl:when test="ancestor::cref"> + <xsl:value-of + select="normalize-space(nametext)"/> + </xsl:when> + <xsl:otherwise> + <xsl:value-of + select="normalize-space(substring-before(., '->'))"/> + </xsl:otherwise> + </xsl:choose> + </xsl:variable> + <xsl:choose> + <xsl:when test="string-length($signature1) > 0"> + <xsl:value-of select="$signature1"/> + </xsl:when> + <xsl:otherwise> + <xsl:value-of select="normalize-space(.)"/> + </xsl:otherwise> + </xsl:choose> + </xsl:variable> + <xsl:variable name="tmpstring"> - <xsl:value-of select="substring-before(substring-after(., '('), '->')"/> + <xsl:value-of select="substring-after($signature, '(')"/> </xsl:variable> - <xsl:variable name="ustring"> + <xsl:variable name="argstring"> <xsl:choose> <xsl:when test="string-length($tmpstring) > 0"> <xsl:call-template name="remove-paren"> @@ -219,10 +242,19 @@ </xsl:variable> <xsl:variable name="arity"> - <xsl:call-template name="calc-arity"> - <xsl:with-param name="string" select="substring-before($ustring, ')')"/> - <xsl:with-param name="no-of-pars" select="0"/> - </xsl:call-template> + <xsl:choose> + <xsl:when + test="string-length(substring-before(., '->')) > 0"> + <xsl:call-template name="calc-arity"> + <xsl:with-param + name="string" + select="substring-before($argstring, ')')"/> + <xsl:with-param name="no-of-pars" select="0"/> + </xsl:call-template> + </xsl:when> + <xsl:otherwise/> + </xsl:choose> + </xsl:variable> <xsl:variable name="fname"> @@ -250,10 +282,18 @@ </xsl:variable> <xsl:text> {"</xsl:text><xsl:value-of select="$fname"/> + <xsl:text>", "</xsl:text> + <xsl:call-template name="escape-doublequotes"> + <xsl:with-param name="string" select="$signature"/> + </xsl:call-template> <xsl:text>", "</xsl:text><xsl:value-of select="$fname"/> - <xsl:text>(</xsl:text><xsl:value-of select="normalize-space($tmpstring)"/> - <xsl:text>", "</xsl:text><xsl:value-of select="$fname"/> - <xsl:text>-</xsl:text><xsl:value-of select="$arity"/><xsl:text>"}</xsl:text> + <xsl:choose> + <xsl:when test="string-length($arity) > 0"> + <xsl:text>-</xsl:text><xsl:value-of select="$arity"/> + </xsl:when> + <xsl:otherwise/> + </xsl:choose> + <xsl:text>"}</xsl:text> <xsl:choose> <xsl:when test="($lastfuncsblock = 'true') and (position() = last())"> @@ -345,6 +385,27 @@ </xsl:template> + <xsl:template name="escape-doublequotes"> + <xsl:param name="string"/> + <xsl:param name="pPat">"</xsl:param> + <xsl:param name="pRep">\"</xsl:param> + + <xsl:choose> + <xsl:when test="not(contains($string, $pPat))"> + <xsl:copy-of select="$string"/> + </xsl:when> + <xsl:otherwise> + <xsl:copy-of select="substring-before($string, $pPat)"/> + <xsl:copy-of select="$pRep"/> + <xsl:call-template name="escape-doublequotes"> + <xsl:with-param + name="string" + select="substring-after($string, $pPat)"/> + </xsl:call-template> + </xsl:otherwise> + </xsl:choose> + </xsl:template> + <!-- default content handling --> <xsl:template match="text()"/> diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl index b065c18cda..d562cfddcc 100644 --- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl @@ -182,7 +182,7 @@ chapter_title(#xmlElement{content=Es}) -> % name = h3 | h4 %% otp_xmlify(Es1) -> Es2 %% Es1 = Es2 = [#xmlElement{} | #xmlText{}] %% Fix things that are allowed in XHTML but not in chapter/erlref DTDs. -%% 1) lists (<ul>, <ol>, <dl>) and code snippets (<pre>) can not occur +%% 1) lists (<ul>, <ol>, <dl>) and code snippets (<pre>) cannot occur %% within a <p>, such a <p> must be splitted into a sequence of <p>, %% <ul>, <ol>, <dl> and <pre>. %% 2) <a> must only have either a href attribute (corresponds to a diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in index a155ceef7e..46dd995289 100644 --- a/lib/erl_interface/configure.in +++ b/lib/erl_interface/configure.in @@ -29,11 +29,6 @@ dnl m4_define(EI_VERSION,regexp(m4_include(VERSION),[version \([-.0-9A-Za-z]+\)] AC_INIT() -if test "x$no_recursion" != "xyes" -a "x$OVERRIDE_CONFIG_CACHE" = "x"; then - # We do not want to use a common cache! - cache_file=/dev/null -fi - dnl How to set srcdir absolute is taken from the GNU Emacs distribution #### Make srcdir absolute, if it isn't already. It's important to #### avoid running the path through pwd unnecessary, since pwd can diff --git a/lib/erl_interface/src/INSTALL b/lib/erl_interface/src/INSTALL index b42a17ac46..bf3ca8b6a5 100644 --- a/lib/erl_interface/src/INSTALL +++ b/lib/erl_interface/src/INSTALL @@ -122,10 +122,10 @@ you can use the `configure' options `--x-includes=DIR' and Specifying the System Type ========================== - There may be some features `configure' can not figure out + There may be some features `configure' cannot figure out automatically, but needs to determine by the type of host the package will run on. Usually `configure' can figure that out, but if it prints -a message saying it can not guess the host type, give it the +a message saying it cannot guess the host type, give it the `--host=TYPE' option. TYPE can either be a short name for the system type, such as `sun4', or a canonical name with three fields: CPU-COMPANY-SYSTEM diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 75b705a8fa..9df4fa3b6c 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -1022,7 +1022,7 @@ int ei_do_receive_msg(int fd, int staticbuffer_p, erl_errno = EMSGSIZE; return ERL_ERROR; } - x->index = x->buffsz; + x->index = msglen; switch (msg->msgtype) { /* FIXME does not handle trace tokens and monitors */ case ERL_SEND: case ERL_REG_SEND: diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c index c18067b9bc..932bba43bf 100644 --- a/lib/erl_interface/src/legacy/erl_marshal.c +++ b/lib/erl_interface/src/legacy/erl_marshal.c @@ -1803,7 +1803,7 @@ static int cmp_exe2(unsigned char **e1, unsigned char **e2) k = 0; while (1) { if (k++ == min){ - if (i == j) return 0; + if (i == j) return compare_top_ext(e1 , e2); if (i < j) return -1; return 1; } diff --git a/lib/erl_interface/src/misc/ei_pthreads.c b/lib/erl_interface/src/misc/ei_pthreads.c index 25608edeec..8c7e86555d 100644 --- a/lib/erl_interface/src/misc/ei_pthreads.c +++ b/lib/erl_interface/src/misc/ei_pthreads.c @@ -78,7 +78,7 @@ static void tls_init_once(void) errno_tls_index = TlsAlloc(); if (errno_tls_index == TLS_OUT_OF_INDEXES) { fprintf(stderr, - "FATAL ERROR: can not allocate TLS index for " + "FATAL ERROR: cannot allocate TLS index for " "erl_errno (error code = %d)!\n",GetLastError()); exit(1); } @@ -206,6 +206,7 @@ volatile int *__erl_errno_place(void) use_fallback = 1; return &fallback_errno; } + *erl_errno_p = 0; if (pthread_setspecific(erl_errno_key, erl_errno_p) != 0 || (erl_errno_p = pthread_getspecific(erl_errno_key)) == NULL) { diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 85c567acd3..78a433d21b 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -25,6 +25,7 @@ -include("ei_accept_SUITE_data/ei_accept_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, ei_accept/1, ei_threaded_accept/1, monitor_ei_process/1]). @@ -38,8 +39,11 @@ all() -> [ei_accept, ei_threaded_accept, monitor_ei_process]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + ei_accept(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), @@ -91,7 +95,7 @@ ei_threaded_accept(Config) when is_list(Config) -> %% Test erlang:monitor toward erl_interface "processes" monitor_ei_process(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), @@ -99,7 +103,6 @@ monitor_ei_process(Config) when is_list(Config) -> EINode = list_to_atom("c42@"++Myname), io:format("EINode ~p ~n", [EINode]), - Self = self(), Port = 6543, {ok, ListenFd} = ei_publish(P, Port), MRef1 = erlang:monitor(process, {any, EINode}), diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c index 04bba90732..50df848b69 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c @@ -75,11 +75,7 @@ TESTCASE(interpret) ei_term term; ei_x_new(&x); - for (;;) { - if (get_bin_term(&x, &term)) { - report(1); - return; - } else { + while (get_bin_term(&x, &term) == 0) { char* buf = x.buff, func[MAXATOMLEN]; int index = x.index, arity; if (term.ei_type != ERL_SMALL_TUPLE_EXT || term.arity != 2) @@ -100,8 +96,9 @@ TESTCASE(interpret) message("\"%d\" \n", func); fail("bad command"); } - } - } + } + report(1); + ei_x_free(&x); } static void cmd_ei_connect_init(char* buf, int len) diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl index 66498deadc..24cd384295 100644 --- a/lib/erl_interface/test/ei_connect_SUITE.erl +++ b/lib/erl_interface/test/ei_connect_SUITE.erl @@ -25,6 +25,7 @@ -include("ei_connect_SUITE_data/ei_connect_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, ei_send/1, ei_reg_send/1, ei_format_pid/1, @@ -44,8 +45,11 @@ all() -> [ei_send, ei_reg_send, ei_rpc, ei_format_pid, ei_send_funs, ei_threaded_send, ei_set_get_tracelevel]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + ei_send(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), {ok,Fd} = ei_connect(P, node()), @@ -58,7 +62,7 @@ ei_send(Config) when is_list(Config) -> ei_format_pid(Config) when is_list(Config) -> S = self(), - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), {ok,Fd} = ei_connect(P, node()), @@ -70,7 +74,7 @@ ei_format_pid(Config) when is_list(Config) -> ok. ei_send_funs(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), {ok,Fd} = ei_connect(P, node()), @@ -88,7 +92,7 @@ ei_send_funs(Config) when is_list(Config) -> ok. ei_reg_send(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), {ok,Fd} = ei_connect(P, node()), @@ -137,7 +141,7 @@ start_einode(Einode, N, Host) -> ok. ei_rpc(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), {ok,Fd} = ei_connect(P, node()), @@ -150,7 +154,7 @@ ei_rpc(Config) when is_list(Config) -> ok. ei_set_get_tracelevel(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 5 = ei_set_get_tracelevel(P, 5), 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), {ok,Fd} = ei_connect(P, node()), diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c index 6a3796dd24..fbd86cdb50 100644 --- a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c +++ b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c @@ -74,11 +74,7 @@ TESTCASE(interpret) ei_term term; ei_x_new(&x); - for (;;) { - if (get_bin_term(&x, &term)) { - report(1); - return; - } else { + while (get_bin_term(&x, &term) == 0) { char* buf = x.buff, func[MAXATOMLEN]; int index = x.index, arity; if (term.ei_type != ERL_SMALL_TUPLE_EXT || term.arity != 2) @@ -99,8 +95,10 @@ TESTCASE(interpret) message("\"%d\" \n", func); fail("bad command"); } - } - } + } + report(1); + ei_x_free(&x); + return; } diff --git a/lib/erl_interface/test/ei_decode_SUITE.erl b/lib/erl_interface/test/ei_decode_SUITE.erl index 74fb9b8916..499f10611e 100644 --- a/lib/erl_interface/test/ei_decode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_SUITE.erl @@ -25,6 +25,7 @@ -include("ei_decode_SUITE_data/ei_decode_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, test_ei_decode_long/1, test_ei_decode_ulong/1, test_ei_decode_longlong/1, @@ -42,6 +43,9 @@ all() -> test_ei_decode_char, test_ei_decode_nonoptimal, test_ei_decode_misc, test_ei_decode_utf8_atom]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + %% --------------------------------------------------------------------------- % NOTE: for historical reasons we don't pach as tight as we can, @@ -51,7 +55,7 @@ all() -> %% ######################################################################## %% test_ei_decode_long(Config) when is_list(Config) -> - P = runner:start(?test_ei_decode_long), + P = runner:start(Config, ?test_ei_decode_long), send_integers(P), runner:recv_eot(P), ok. @@ -60,7 +64,7 @@ test_ei_decode_long(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_decode_ulong(Config) when is_list(Config) -> - P = runner:start(?test_ei_decode_ulong), + P = runner:start(Config, ?test_ei_decode_ulong), send_integers(P), runner:recv_eot(P), ok. @@ -77,7 +81,7 @@ test_ei_decode_longlong(Config) when is_list(Config) -> vxworks -> {skip,"Skipped on VxWorks"}; _ -> - P = runner:start(?test_ei_decode_longlong), + P = runner:start(Config, ?test_ei_decode_longlong), send_integers2(P), runner:recv_eot(P), ok @@ -91,7 +95,7 @@ test_ei_decode_ulonglong(Config) when is_list(Config) -> vxworks -> {skip,"Skipped on VxWorks"}; _ -> - P = runner:start(?test_ei_decode_ulonglong), + P = runner:start(Config, ?test_ei_decode_ulonglong), send_integers2(P), runner:recv_eot(P), ok @@ -104,7 +108,7 @@ test_ei_decode_ulonglong(Config) when is_list(Config) -> %% FIXME maybe the API should change to use "unsigned char" to be clear?! test_ei_decode_char(Config) when is_list(Config) -> - P = runner:start(?test_ei_decode_char), + P = runner:start(Config, ?test_ei_decode_char), send_term_as_binary(P,0), send_term_as_binary(P,16#7f), @@ -119,7 +123,7 @@ test_ei_decode_char(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_decode_nonoptimal(Config) when is_list(Config) -> - P = runner:start(?test_ei_decode_nonoptimal), + P = runner:start(Config, ?test_ei_decode_nonoptimal), send_non_optimal_pos(P), % decode_char send_non_optimal(P), % decode_long @@ -168,7 +172,7 @@ send_non_optimal_neg(P) -> %% ######################################################################## %% test_ei_decode_misc(Config) when is_list(Config) -> - P = runner:start(?test_ei_decode_misc), + P = runner:start(Config, ?test_ei_decode_misc), send_term_as_binary(P,0.0), send_term_as_binary(P,-1.0), @@ -199,7 +203,7 @@ test_ei_decode_misc(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_decode_utf8_atom(Config) -> - P = runner:start(?test_ei_decode_utf8_atom), + P = runner:start(Config, ?test_ei_decode_utf8_atom), send_latin1_atom_as_binary(P,"å"), send_latin1_atom_as_binary(P,"ä"), diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c index b7a2c4bb8b..5a9be1e9a2 100644 --- a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c +++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c @@ -105,6 +105,7 @@ int ei_decode_my_string(const char *buf, int *index, char *to, fail1("size of encoded data (%d) is incorrect", size1); \ return; \ } \ + free_packet(buf); \ } \ #define EI_DECODE_2_FAIL(FUNC,SIZE,TYPE,VAL) \ @@ -148,6 +149,7 @@ int ei_decode_my_string(const char *buf, int *index, char *to, fail("size of encoded data should be 0"); \ return; \ } \ + free_packet(buf); \ } \ #define dump(arr, num) { \ @@ -205,6 +207,7 @@ int ei_decode_my_string(const char *buf, int *index, char *to, fail("size of encoded data is incorrect"); \ return; \ } \ + free_packet(buf); \ } \ #define EI_DECODE_STRING(FUNC,SIZE,VAL) \ @@ -248,6 +251,7 @@ int ei_decode_my_string(const char *buf, int *index, char *to, fail("size of encoded data should be 0"); \ return; \ } \ + free_packet(buf); \ } \ //#define EI_DECODE_UTF8_STRING(FUNC,SIZE,VAL) @@ -310,6 +314,7 @@ int ei_decode_my_string(const char *buf, int *index, char *to, fail("size of encoded data is incorrect"); \ return; \ } \ + free_packet(buf); \ } \ /* ******************************************************************** */ diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl index 160720b413..6476e92be9 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl @@ -25,6 +25,7 @@ -include("ei_decode_encode_SUITE_data/ei_decode_encode_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, test_ei_decode_encode/1]). suite() -> @@ -33,6 +34,9 @@ suite() -> all() -> [test_ei_decode_encode]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + %% --------------------------------------------------------------------------- % NOTE: these types have no meaning on the C side so we pass them @@ -42,7 +46,7 @@ all() -> %% ######################################################################## %% test_ei_decode_encode(Config) when is_list(Config) -> - P = runner:start(?test_ei_decode_encode), + P = runner:start(Config, ?test_ei_decode_encode), Fun = fun (X) -> {X,true} end, Pid = self(), diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c index 467f789fdb..6285b5e199 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c +++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c @@ -466,6 +466,7 @@ void decode_encode_big(struct Type* t) send_buffer(arg.buff, arg.index); ei_x_free(&arg); ei_free_big(p); + free_packet(buf); } diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl index 8857b092f3..8c3b0e193b 100644 --- a/lib/erl_interface/test/ei_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_encode_SUITE.erl @@ -25,6 +25,7 @@ -include("ei_encode_SUITE_data/ei_encode_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, test_ei_encode_long/1, test_ei_encode_ulong/1, test_ei_encode_longlong/1, @@ -45,6 +46,9 @@ all() -> test_ei_encode_fails, test_ei_encode_utf8_atom, test_ei_encode_utf8_atom_len]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + %% --------------------------------------------------------------------------- @@ -55,7 +59,7 @@ all() -> %% ######################################################################## %% test_ei_encode_long(Config) when is_list(Config) -> - P = runner:start(?test_ei_encode_long), + P = runner:start(Config, ?test_ei_encode_long), {<<97,0>> ,0} = get_buf_and_term(P), {<<97,255>> ,255} = get_buf_and_term(P), @@ -77,7 +81,7 @@ test_ei_encode_long(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_encode_ulong(Config) when is_list(Config) -> - P = runner:start(?test_ei_encode_ulong), + P = runner:start(Config, ?test_ei_encode_ulong), {<<97,0>> ,0} = get_buf_and_term(P), {<<97,255>> ,255} = get_buf_and_term(P), @@ -101,7 +105,7 @@ test_ei_encode_longlong(Config) when is_list(Config) -> vxworks -> {skip,"Skipped on VxWorks"}; _ -> - P = runner:start(?test_ei_encode_longlong), + P = runner:start(Config, ?test_ei_encode_longlong), {<<97,0>> ,0} = get_buf_and_term(P), {<<97,255>> ,255} = get_buf_and_term(P), @@ -132,7 +136,7 @@ test_ei_encode_ulonglong(Config) when is_list(Config) -> vxworks -> {skip,"Skipped on VxWorks"}; _ -> - P = runner:start(?test_ei_encode_ulonglong), + P = runner:start(Config, ?test_ei_encode_ulonglong), {<<97,0>> ,0} = get_buf_and_term(P), {<<97,255>> ,255} = get_buf_and_term(P), @@ -158,7 +162,7 @@ test_ei_encode_ulonglong(Config) when is_list(Config) -> %% FIXME maybe the API should change to use "unsigned char" to be clear?! test_ei_encode_char(Config) when is_list(Config) -> - P = runner:start(?test_ei_encode_char), + P = runner:start(Config, ?test_ei_encode_char), {<<97, 0>>,0} = get_buf_and_term(P), {<<97,127>>,16#7f} = get_buf_and_term(P), @@ -171,7 +175,7 @@ test_ei_encode_char(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_encode_misc(Config) when is_list(Config) -> - P = runner:start(?test_ei_encode_misc), + P = runner:start(Config, ?test_ei_encode_misc), <<131>> = get_binaries(P), @@ -217,7 +221,7 @@ test_ei_encode_misc(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_encode_fails(Config) when is_list(Config) -> - P = runner:start(?test_ei_encode_fails), + P = runner:start(Config, ?test_ei_encode_fails), XAtom = list_to_atom(lists:duplicate(255, $x)), YAtom = list_to_atom(lists:duplicate(255, $y)), @@ -236,7 +240,7 @@ test_ei_encode_fails(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_encode_utf8_atom(Config) -> - P = runner:start(?test_ei_encode_utf8_atom), + P = runner:start(Config, ?test_ei_encode_utf8_atom), {<<119,2,195,133>>,'Å'} = get_buf_and_term(P), {<<119,2,195,133>>,'Å'} = get_buf_and_term(P), @@ -251,7 +255,7 @@ test_ei_encode_utf8_atom(Config) -> %% ######################################################################## %% test_ei_encode_utf8_atom_len(Config) -> - P = runner:start(?test_ei_encode_utf8_atom_len), + P = runner:start(Config, ?test_ei_encode_utf8_atom_len), {<<119,2,195,133>>,'Å'} = get_buf_and_term(P), {<<119,4,195,133,195,132>>,'ÅÄ'} = get_buf_and_term(P), diff --git a/lib/erl_interface/test/ei_format_SUITE.erl b/lib/erl_interface/test/ei_format_SUITE.erl index 07ee479b1f..b11a6ff164 100644 --- a/lib/erl_interface/test/ei_format_SUITE.erl +++ b/lib/erl_interface/test/ei_format_SUITE.erl @@ -26,6 +26,7 @@ -export([format_wo_ver/1, all/0, suite/0, + init_per_testcase/2, atoms/1, tuples/1, lists/1]). @@ -41,10 +42,13 @@ suite() -> all() -> [format_wo_ver, atoms, tuples, lists]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + %% Tests formatting various atoms. atoms(Config) when is_list(Config) -> - P = runner:start(?atoms), + P = runner:start(Config, ?atoms), {term, ''} = get_term(P), {term, 'a'} = get_term(P), @@ -84,7 +88,7 @@ atoms(Config) when is_list(Config) -> %% Tests formatting various tuples tuples(Config) when is_list(Config) -> - P = runner:start(?tuples), + P = runner:start(Config, ?tuples), {term, {}} = get_term(P), {term, {a}} = get_term(P), @@ -105,7 +109,7 @@ tuples(Config) when is_list(Config) -> %% Tests formatting various lists lists(Config) when is_list(Config) -> - P = runner:start(?lists), + P = runner:start(Config, ?lists), {term, []} = get_term(P), {term, [a]} = get_term(P), @@ -146,7 +150,7 @@ lists(Config) when is_list(Config) -> format_wo_ver(Config) when is_list(Config) -> - P = runner:start(?format_wo_ver), + P = runner:start(Config, ?format_wo_ver), {term, [-1, 2, $c, {a, "b"}, {c, 10}]} = get_term(P), diff --git a/lib/erl_interface/test/ei_print_SUITE.erl b/lib/erl_interface/test/ei_print_SUITE.erl index 6d5c341eae..cad2686018 100644 --- a/lib/erl_interface/test/ei_print_SUITE.erl +++ b/lib/erl_interface/test/ei_print_SUITE.erl @@ -25,6 +25,7 @@ -include("ei_print_SUITE_data/ei_print_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, atoms/1, tuples/1, lists/1, strings/1]). -import(runner, [get_term/1]). @@ -38,10 +39,13 @@ suite() -> all() -> [atoms, tuples, lists, strings]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + %% Tests formatting various atoms. atoms(Config) when is_list(Config) -> - P = runner:start(?atoms), + P = runner:start(Config, ?atoms), {term, "''"} = get_term(P), {term, "a"} = get_term(P), @@ -79,7 +83,7 @@ atoms(Config) when is_list(Config) -> %% Tests formatting various tuples tuples(Config) when is_list(Config) -> - P = runner:start(?tuples), + P = runner:start(Config, ?tuples), {term, "{}"} = get_term(P), {term, "{a}"} = get_term(P), @@ -100,7 +104,7 @@ tuples(Config) when is_list(Config) -> %% Tests formatting various lists lists(Config) when is_list(Config) -> - P = runner:start(?lists), + P = runner:start(Config, ?lists), {term, "[]"} = get_term(P), {term, "[a]"} = get_term(P), @@ -125,7 +129,7 @@ lists(Config) when is_list(Config) -> ok. strings(Config) when is_list(Config) -> - P = runner:start(?strings), + P = runner:start(Config, ?strings), {term, "\"\\n\""} = get_term(P), {term, "\"\\r\\n\""} = get_term(P), diff --git a/lib/erl_interface/test/ei_tmo_SUITE.erl b/lib/erl_interface/test/ei_tmo_SUITE.erl index 003fe20594..1e76a99e1e 100644 --- a/lib/erl_interface/test/ei_tmo_SUITE.erl +++ b/lib/erl_interface/test/ei_tmo_SUITE.erl @@ -39,14 +39,16 @@ all() -> [framework_check, ei_accept_tmo, ei_connect_tmo, ei_send_tmo, ei_recv_tmo]. -init_per_testcase(_Case, Config) -> +init_per_testcase(Case, Config) -> + Config1 = runner:init_per_testcase(?MODULE, Case, Config), + % test if platform is vxworks_simso {_,Host} = split(node()), Bool = case atom_to_list(Host) of [$v,$x,$s,$i,$m | _] -> true; _ -> false end, - [{vxsim,Bool}|Config]. + [{vxsim,Bool} | Config1]. end_per_testcase(_Case, _Config) -> ok. @@ -55,7 +57,7 @@ end_per_testcase(_Case, _Config) -> framework_check(Config) when is_list(Config) -> %%dbg:tracer(), %%dbg:p(self()), - P = runner:start(?framework_check), + P = runner:start(Config, ?framework_check), runner:send_term(P,{hello,world}), {term, {hello,world}} = runner:get_term(P), runner:recv_eot(P), @@ -71,7 +73,7 @@ ei_recv_tmo(Config) when is_list(Config) -> do_one_recv(Config,CNode) -> {_,Host} = split(node()), - P1 = runner:start(?recv_tmo), + P1 = runner:start(Config, ?recv_tmo), runner:send_term(P1,{CNode, erlang:get_cookie(), node()}), @@ -84,7 +86,7 @@ do_one_recv(Config,CNode) -> runner:recv_eot(P1). do_one_recv_failure(Config,CNode) -> - P1 = runner:start(?recv_tmo), + P1 = runner:start(Config, ?recv_tmo), runner:send_term(P1,{CNode, erlang:get_cookie(), node()}), @@ -110,7 +112,7 @@ ei_send_tmo(Config) when is_list(Config) -> do_one_send(Config,From,CNode) -> {_,Host} = split(node()), - P1 = runner:start(?send_tmo), + P1 = runner:start(Config, ?send_tmo), runner:send_term(P1,{CNode, erlang:get_cookie(), node()}), @@ -139,7 +141,7 @@ do_one_send_failure(Config,From,FakeName,CName,VxSim) -> exit(Else) end, EpmdSocket = register(OurName, LSocket, 1, 5), - P3 = runner:start(?send_tmo), + P3 = runner:start(Config, ?send_tmo), Cookie = kaksmula_som_ingen_bryr_sig_om, runner:send_term(P3,{CName, Cookie, @@ -202,7 +204,7 @@ ei_connect_tmo(Config) when is_list(Config) -> %dbg:p(self()), VxSim = proplists:get_value(vxsim, Config), DummyNode = make_and_check_dummy(), - P = runner:start(?connect_tmo), + P = runner:start(Config, ?connect_tmo), runner:send_term(P,{c_nod_connect_tmo_1, kaksmula_som_ingen_bryr_sig_om, DummyNode}), @@ -219,7 +221,7 @@ ei_connect_tmo(Config) when is_list(Config) -> end end, runner:recv_eot(P), - P2 = runner:start(?connect_tmo), + P2 = runner:start(Config, ?connect_tmo), runner:send_term(P2,{c_nod_connect_tmo_2, erlang:get_cookie(), node()}), @@ -237,7 +239,7 @@ ei_connect_tmo(Config) when is_list(Config) -> exit(Else) end, EpmdSocket = register(OurName, LSocket, 1, 5), - P3 = runner:start(?connect_tmo), + P3 = runner:start(Config, ?connect_tmo), Cookie = kaksmula_som_ingen_bryr_sig_om, runner:send_term(P3,{c_nod_connect_tmo_3, Cookie, @@ -266,12 +268,12 @@ ei_connect_tmo(Config) when is_list(Config) -> ei_accept_tmo(Config) when is_list(Config) -> %%dbg:tracer(), %%dbg:p(self()), - P = runner:start(?accept_tmo), + P = runner:start(Config, ?accept_tmo), runner:send_term(P,{c_nod_som_ingen_kontaktar_1, kaksmula_som_ingen_bryr_sig_om}), {term,{-1,ETimedout,ETimedout}} = runner:get_term(P, 10000), runner:recv_eot(P), - P2 = runner:start(?accept_tmo), + P2 = runner:start(Config, ?accept_tmo), runner:send_term(P2,{c_nod_som_vi_kontaktar_1, erlang:get_cookie()}), receive after 1000 -> ok end, @@ -280,7 +282,7 @@ ei_accept_tmo(Config) when is_list(Config) -> {term, X} = runner:get_term(P2, 10000), runner:recv_eot(P2), true = is_integer(X), - P3 = runner:start(?accept_tmo), + P3 = runner:start(Config, ?accept_tmo), runner:send_term(P3,{c_nod_som_vi_kontaktar_2, erlang:get_cookie()}), receive after 1000 -> ok end, diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl index cd73f07b8f..ad4e34c548 100644 --- a/lib/erl_interface/test/erl_connect_SUITE.erl +++ b/lib/erl_interface/test/erl_connect_SUITE.erl @@ -25,6 +25,7 @@ -include("erl_connect_SUITE_data/erl_connect_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, erl_send/1, erl_reg_send/1, erl_send_cookie_file/1]). @@ -38,8 +39,11 @@ all() -> [erl_send, erl_reg_send, erl_send_cookie_file]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + erl_send(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 1 = erl_connect_init(P, 42, erlang:get_cookie(), 0), {ok,Fd} = erl_connect(P, node()), @@ -56,7 +60,7 @@ erl_send_cookie_file(Config) when is_list(Config) -> vxworks -> {skip,"Skipped on VxWorks"}; _ -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 1 = erl_connect_init(P, 42, '', 0), {ok,Fd} = erl_connect(P, node()), @@ -70,7 +74,7 @@ erl_send_cookie_file(Config) when is_list(Config) -> end. erl_reg_send(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), 1 = erl_connect_init(P, 42, erlang:get_cookie(), 0), {ok,Fd} = erl_connect(P, node()), diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 3d1e33081b..84b58fed54 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -35,6 +35,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([all/0, suite/0, + init_per_testcase/2, build_terms/1, round_trip_conversion/1, decode_terms/1, decode_float/1, t_erl_mk_int/1, t_erl_mk_list/1, @@ -94,6 +95,9 @@ all() -> high_chaparal, broken_data, cnode_1]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 1. B a s i c t e s t s @@ -104,7 +108,7 @@ all() -> %% a list and verifies that the result is as expected. build_terms(Config) when is_list(Config) -> - P = runner:start(?build_terms), + P = runner:start(Config, ?build_terms), {term, Term} = get_term(P), io:format("Received: ~p", [Term]), [ARefLN, ARef, APortLN, APort, APidLN, APid, @@ -136,7 +140,7 @@ build_terms(Config) when is_list(Config) -> %% This test is run entirely in C code. round_trip_conversion(Config) when is_list(Config) -> - runner:test(?round_trip_conversion), + runner:test(Config, ?round_trip_conversion), ok. %% This test sends a list of all data types to the C code function, @@ -156,7 +160,7 @@ decode_terms(Config) when is_list(Config) -> {element1, 42, 767}, "A string", 1, -1, 0, 3.0, ABinary, 'I am an atom'], - P = runner:start(?decode_terms), + P = runner:start(Config, ?decode_terms), runner:send_term(P, Terms), runner:recv_eot(P), @@ -165,7 +169,7 @@ decode_terms(Config) when is_list(Config) -> %% Decodes the floating point number 3.1415. decode_float(Config) when is_list(Config) -> - P = runner:start(?decode_float), + P = runner:start(Config, ?decode_float), runner:send_term(P, 3.1415), runner:recv_eot(P), ok. @@ -173,7 +177,7 @@ decode_float(Config) when is_list(Config) -> %% Tests the erl_free_compound() function. t_erl_free_compound(Config) when is_list(Config) -> - runner:test(?t_erl_free_compound), + runner:test(Config, ?t_erl_free_compound), ok. @@ -186,7 +190,7 @@ t_erl_free_compound(Config) when is_list(Config) -> %% This tests the erl_mk_list() function. t_erl_mk_list(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_list), + P = runner:start(Config, ?t_erl_mk_list), {term, []} = get_term(P), {term, [abc]} = get_term(P), @@ -200,7 +204,7 @@ t_erl_mk_list(Config) when is_list(Config) -> %% This tests the erl_mk_int() function. t_erl_mk_int(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_int), + P = runner:start(Config, ?t_erl_mk_int), {term, 0} = get_term(P), {term, 127} = get_term(P), @@ -255,14 +259,14 @@ t_erl_mk_int(Config) when is_list(Config) -> %% Basic test of erl_copy_term(). basic_copy(Config) when is_list(Config) -> - runner:test(?basic_copy), + runner:test(Config, ?basic_copy), ok. %% This tests the erl_mk_tuple() function. t_erl_mk_tuple(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_tuple), + P = runner:start(Config, ?t_erl_mk_tuple), {term, {madonna, 21, 'mad donna', 12}} = get_term(P), {term, {'Madonna',21,{children,{"Isabella",2}}, @@ -275,7 +279,7 @@ t_erl_mk_tuple(Config) when is_list(Config) -> %% This tests the erl_mk_atom() function. t_erl_mk_atom(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_atom), + P = runner:start(Config, ?t_erl_mk_atom), {term, madonna} = (get_term(P)), {term, 'Madonna'} = (get_term(P)), @@ -295,7 +299,7 @@ t_erl_mk_atom(Config) when is_list(Config) -> %% This tests the erl_mk_binary() function. t_erl_mk_binary(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_binary), + P = runner:start(Config, ?t_erl_mk_binary), {term, Bin} = (get_term(P)), "{madonna,21,'mad donna',1234.567.890, !#$%&/()=?+-@, \" \\}" = binary_to_list(Bin), @@ -307,7 +311,7 @@ t_erl_mk_binary(Config) when is_list(Config) -> %% This tests the erl_mk_empty_list() function. t_erl_mk_empty_list(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_empty_list), + P = runner:start(Config, ?t_erl_mk_empty_list), {term, []} = get_term(P), @@ -322,7 +326,7 @@ t_erl_mk_float(Config) when is_list(Config) -> vxworks -> {skipped, "Floating point numbers never compare equal on PPC"}; _ -> - P = runner:start(?t_erl_mk_float), + P = runner:start(Config, ?t_erl_mk_float), {term, {3.1415, 1.999999, 2.000000, 2.000001, 2.000002, 12345.67890}} = get_term(P), runner:recv_eot(P), @@ -333,7 +337,7 @@ t_erl_mk_float(Config) when is_list(Config) -> %% This tests the erl_mk_pid() function. t_erl_mk_pid(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_pid), + P = runner:start(Config, ?t_erl_mk_pid), {term, A_pid} = (get_term(P)), {pid, kalle@localhost, 3, 2} = nc2vinfo(A_pid), @@ -342,7 +346,7 @@ t_erl_mk_pid(Config) when is_list(Config) -> ok. t_erl_mk_xpid(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_xpid), + P = runner:start(Config, ?t_erl_mk_xpid), {term, A_pid} = (get_term(P)), {pid, kalle@localhost, 32767, 8191} = nc2vinfo(A_pid), @@ -354,7 +358,7 @@ t_erl_mk_xpid(Config) when is_list(Config) -> %% This tests the erl_mk_port() function. t_erl_mk_port(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_port), + P = runner:start(Config, ?t_erl_mk_port), {term, A_port} = (get_term(P)), {port, kalle@localhost, 4} = nc2vinfo(A_port), @@ -363,7 +367,7 @@ t_erl_mk_port(Config) when is_list(Config) -> ok. t_erl_mk_xport(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_xport), + P = runner:start(Config, ?t_erl_mk_xport), {term, A_port} = (get_term(P)), {port, kalle@localhost, 268435455} = nc2vinfo(A_port), @@ -375,7 +379,7 @@ t_erl_mk_xport(Config) when is_list(Config) -> %% This tests the erl_mk_ref() function. t_erl_mk_ref(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_ref), + P = runner:start(Config, ?t_erl_mk_ref), {term, A_ref} = (get_term(P)), {ref, kalle@localhost, _Length, [6]} = nc2vinfo(A_ref), @@ -384,7 +388,7 @@ t_erl_mk_ref(Config) when is_list(Config) -> ok. t_erl_mk_long_ref(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_long_ref), + P = runner:start(Config, ?t_erl_mk_long_ref), {term, A_ref} = (get_term(P)), {ref, kalle@localhost, _Length, [4294967295,4294967295,262143]} @@ -397,7 +401,7 @@ t_erl_mk_long_ref(Config) when is_list(Config) -> %% This tests the erl_mk_string() function. t_erl_mk_string(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_string), + P = runner:start(Config, ?t_erl_mk_string), {term, "madonna"} = (get_term(P)), {term, "Madonna"} = (get_term(P)), @@ -417,7 +421,7 @@ t_erl_mk_string(Config) when is_list(Config) -> %% This tests the erl_mk_estring() function. t_erl_mk_estring(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_estring), + P = runner:start(Config, ?t_erl_mk_estring), {term, "madonna"} = (get_term(P)), {term, "Madonna"} = (get_term(P)), @@ -437,7 +441,7 @@ t_erl_mk_estring(Config) when is_list(Config) -> %% This tests the erl_mk_uint() function. t_erl_mk_uint(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_uint), + P = runner:start(Config, ?t_erl_mk_uint), {term, 54321} = (get_term(P)), {term, 2147483647} = (get_term(P)), @@ -453,7 +457,7 @@ t_erl_mk_uint(Config) when is_list(Config) -> %% This tests the erl_mk_var() function. t_erl_mk_var(Config) when is_list(Config) -> - P = runner:start(?t_erl_mk_var), + P = runner:start(Config, ?t_erl_mk_var), {term, 1} = (get_term(P)), {term, 0} = (get_term(P)), @@ -470,7 +474,7 @@ t_erl_mk_var(Config) when is_list(Config) -> %% This tests the erl_cons() function. t_erl_cons(Config) when is_list(Config) -> - P = runner:start(?t_erl_cons), + P = runner:start(Config, ?t_erl_cons), {term, [madonna, 21]} = get_term(P), @@ -490,7 +494,7 @@ t_erl_cons(Config) when is_list(Config) -> %% Tests the erl_length() function. t_erl_length(Config) when is_list(Config) -> - P = runner:start(?t_erl_length), + P = runner:start(Config, ?t_erl_length), 0 = erl_length(P, []), 1 = erl_length(P, [a]), @@ -513,7 +517,7 @@ erl_length(Port, List) -> %% Tests the erl_hd() function. t_erl_hd(Config) when is_list(Config) -> - P = runner:start(?t_erl_hd), + P = runner:start(Config, ?t_erl_hd), 'NULL' = erl_hd(P, 42), 'NULL' = erl_hd(P, abc), @@ -537,7 +541,7 @@ erl_hd(Port, List) -> %% Tests the erl_tail() function. t_erl_tl(Config) when is_list(Config) -> - P = runner:start(?t_erl_tl), + P = runner:start(Config, ?t_erl_tl), 'NULL' = erl_tl(P, 42), 'NULL' = erl_tl(P, abc), @@ -561,20 +565,20 @@ erl_tl(Port, List) -> %% Tests the type checking macros (done in the C program). type_checks(Config) when is_list(Config) -> - runner:test(?type_checks), + runner:test(Config, ?type_checks), ok. %% Tests the extractor macros (done in the C program). extractor_macros(Config) when is_list(Config) -> - runner:test(?extractor_macros), + runner:test(Config, ?extractor_macros), ok. %% This tests the erl_size() function. t_erl_size(Config) when is_list(Config) -> - P = runner:start(?t_erl_size), + P = runner:start(Config, ?t_erl_size), {term, 0} = (get_term(P)), {term, 4} = (get_term(P)), @@ -589,7 +593,7 @@ t_erl_size(Config) when is_list(Config) -> %% This tests the erl_var_content() function. t_erl_var_content(Config) when is_list(Config) -> - P = runner:start(?t_erl_var_content), + P = runner:start(Config, ?t_erl_var_content), {term, 17} = (get_term(P)), {term, "http://www.madonna.com"} = (get_term(P)), @@ -604,7 +608,7 @@ t_erl_var_content(Config) when is_list(Config) -> %% This tests the erl_element() function. t_erl_element(Config) when is_list(Config) -> - P = runner:start(?t_erl_element), + P = runner:start(Config, ?t_erl_element), {term, madonna} = get_term(P), {term, 21} = get_term(P), @@ -630,7 +634,7 @@ t_erl_element(Config) when is_list(Config) -> %% Tests the erl_iolist_length() function. t_erl_iolist_length(Config) when is_list(Config) -> - P = runner:start(?t_erl_iolist_length), + P = runner:start(Config, ?t_erl_iolist_length), %% Flat lists. @@ -697,7 +701,7 @@ erl_iolist_length(Port, List) -> %% Tests the erl_iolist_to_binary() function. t_erl_iolist_to_binary(Config) when is_list(Config) -> - P = runner:start(?t_erl_iolist_to_binary), + P = runner:start(Config, ?t_erl_iolist_to_binary), %% Flat lists. @@ -768,7 +772,7 @@ iolist_to_list(Port, Term) -> %% Tests the erl_iolist_to_string() function. t_erl_iolist_to_string(Config) when is_list(Config) -> - P = runner:start(?t_erl_iolist_to_string), + P = runner:start(Config, ?t_erl_iolist_to_string), %% Flat lists. @@ -947,14 +951,14 @@ collect_line1([C|Rest], Result) -> %% Test case submitted by Per Lundgren, ERV. high_chaparal(Config) when is_list(Config) -> - P = runner:start(?high_chaparal), + P = runner:start(Config, ?high_chaparal), {term, [hello, world]} = get_term(P), runner:recv_eot(P), ok. %% OTP-7448 broken_data(Config) when is_list(Config) -> - P = runner:start(?broken_data), + P = runner:start(Config, ?broken_data), runner:recv_eot(P), ok. diff --git a/lib/erl_interface/test/erl_ext_SUITE.erl b/lib/erl_interface/test/erl_ext_SUITE.erl index afaba1fd93..806339b122 100644 --- a/lib/erl_interface/test/erl_ext_SUITE.erl +++ b/lib/erl_interface/test/erl_ext_SUITE.erl @@ -25,6 +25,7 @@ -include("erl_ext_SUITE_data/ext_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, compare_tuple/1, compare_list/1, compare_string/1, @@ -40,28 +41,30 @@ all() -> [compare_tuple, compare_list, compare_string, compare_list_string, compare_nc_ext]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). compare_tuple(Config) when is_list(Config) -> - P = runner:start(?compare_tuple), + P = runner:start(Config, ?compare_tuple), runner:recv_eot(P), ok. compare_list(Config) when is_list(Config) -> - P = runner:start(?compare_list), + P = runner:start(Config, ?compare_list), runner:recv_eot(P), ok. compare_string(Config) when is_list(Config) -> - P = runner:start(?compare_string), + P = runner:start(Config, ?compare_string), runner:recv_eot(P), ok. compare_list_string(Config) when is_list(Config) -> - P = runner:start(?compare_list_string), + P = runner:start(Config, ?compare_list_string), runner:recv_eot(P), ok. compare_nc_ext(Config) when is_list(Config) -> - P = runner:start(?compare_nc_ext), + P = runner:start(Config, ?compare_nc_ext), runner:recv_eot(P), ok. diff --git a/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c b/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c index 1e986feacf..04e8ca322e 100644 --- a/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c +++ b/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c @@ -88,6 +88,11 @@ TESTCASE(compare_list) { // erlang:term_to_binary([0, 1000]) unsigned char term4[] = {131,108,0,0,0,2,97,0,98,0,0,3,232,106}; + // erlang:term_to_binary([a|b]) + unsigned char term5a[] = {131,108,0,0,0,1,100,0,1,97,100,0,1,98}; + // erlang:term_to_binary([a|c]) + unsigned char term5b[] = {131,108,0,0,0,1,100,0,1,97,100,0,1,99}; + erl_init(NULL, 0); start_a = term1; start_b = term2; @@ -103,6 +108,13 @@ TESTCASE(compare_list) { test_compare_ext("lists1", start_a, end_a, start_b, end_b, -1); + start_a = term5a; + start_b = term5b; + end_a = term5a + sizeof(term5a); + end_b = term5b + sizeof(term5b); + + test_compare_ext("lists5", start_a, end_a, start_b, end_b, -1); + report(1); } diff --git a/lib/erl_interface/test/erl_format_SUITE.erl b/lib/erl_interface/test/erl_format_SUITE.erl index c1a7d8377e..d984dcb08e 100644 --- a/lib/erl_interface/test/erl_format_SUITE.erl +++ b/lib/erl_interface/test/erl_format_SUITE.erl @@ -25,6 +25,7 @@ -include("erl_format_SUITE_data/format_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, atoms/1, tuples/1, lists/1]). -import(runner, [get_term/1]). @@ -38,10 +39,13 @@ suite() -> all() -> [atoms, tuples, lists]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). + %% Tests formatting various atoms. atoms(Config) when is_list(Config) -> - P = runner:start(?atoms), + P = runner:start(Config, ?atoms), {term, ''} = get_term(P), {term, 'a'} = get_term(P), @@ -79,7 +83,7 @@ atoms(Config) when is_list(Config) -> %% Tests formatting various tuples tuples(Config) when is_list(Config) -> - P = runner:start(?tuples), + P = runner:start(Config, ?tuples), {term, {}} = get_term(P), {term, {a}} = get_term(P), @@ -100,7 +104,7 @@ tuples(Config) when is_list(Config) -> %% Tests formatting various lists lists(Config) when is_list(Config) -> - P = runner:start(?lists), + P = runner:start(Config, ?lists), {term, []} = get_term(P), {term, [a]} = get_term(P), diff --git a/lib/erl_interface/test/erl_global_SUITE.erl b/lib/erl_interface/test/erl_global_SUITE.erl index ecc6753c7f..560afd58ba 100644 --- a/lib/erl_interface/test/erl_global_SUITE.erl +++ b/lib/erl_interface/test/erl_global_SUITE.erl @@ -25,6 +25,7 @@ -include("erl_global_SUITE_data/erl_global_test_cases.hrl"). -export([all/0,suite/0, + init_per_testcase/2, erl_global_registration/1, erl_global_whereis/1, erl_global_names/1]). @@ -39,9 +40,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {seconds, 30}}]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). erl_global_registration(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0), ok = erl_global_register(P, Fd, ?GLOBAL_NAME), @@ -53,7 +56,7 @@ erl_global_registration(Config) when is_list(Config) -> ok. erl_global_whereis(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0), Self = self(), @@ -66,7 +69,7 @@ erl_global_whereis(Config) when is_list(Config) -> ok. erl_global_names(Config) when is_list(Config) -> - P = runner:start(?interpret), + P = runner:start(Config, ?interpret), {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0), Self = self(), diff --git a/lib/erl_interface/test/erl_match_SUITE.erl b/lib/erl_interface/test/erl_match_SUITE.erl index 5566714092..f1f6892ae0 100644 --- a/lib/erl_interface/test/erl_match_SUITE.erl +++ b/lib/erl_interface/test/erl_match_SUITE.erl @@ -25,6 +25,7 @@ -include("erl_match_SUITE_data/match_test_cases.hrl"). -export([all/0, suite/0, + init_per_testcase/2, atoms/1, lists/1, tuples/1, references/1, pids/1, ports/1, bind/1, integers/1, floats/1, binaries/1, strings/1]). @@ -40,6 +41,8 @@ all() -> [atoms, lists, tuples, references, pids, ports, bind, integers, floats, binaries, strings]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). atoms(Config) when is_list(Config) -> P = start_matcher(Config), @@ -239,7 +242,7 @@ bind(Config) when is_list(Config) -> ok. start_bind(Config) -> - runner:start(?erl_match_bind). + runner:start(Config, ?erl_match_bind). bind_ok(Port, Bind, Term) -> true = erl_bind(Port, Bind, Term). @@ -258,7 +261,7 @@ erl_bind(Port, Pattern, Term) -> start_matcher(Config) -> - runner:start(?erl_match_server). + runner:start(Config, ?erl_match_server). eq(Port, Pattern, Term) -> true = erl_match(Port, Pattern, Term). diff --git a/lib/erl_interface/test/port_call_SUITE.erl b/lib/erl_interface/test/port_call_SUITE.erl index fb10bd895f..d31b2372ab 100644 --- a/lib/erl_interface/test/port_call_SUITE.erl +++ b/lib/erl_interface/test/port_call_SUITE.erl @@ -32,7 +32,9 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([all/0, suite/0, basic/1]). +-export([all/0, suite/0, + init_per_testcase/2, + basic/1]). % Private exports -include_lib("common_test/include/ct.hrl"). @@ -44,6 +46,8 @@ suite() -> all() -> [basic]. +init_per_testcase(Case, Config) -> + runner:init_per_testcase(?MODULE, Case, Config). basic(Config) when is_list(Config) -> case os:type() of diff --git a/lib/erl_interface/test/runner.erl b/lib/erl_interface/test/runner.erl index 947e56c4e0..484890006e 100644 --- a/lib/erl_interface/test/runner.erl +++ b/lib/erl_interface/test/runner.erl @@ -21,8 +21,9 @@ %% -module(runner). --export([test/1, test/2, - start/1, send_term/2, finish/1, send_eot/1, recv_eot/1, +-export([test/2, test/3, + init_per_testcase/3, + start/2, send_term/2, finish/1, send_eot/1, recv_eot/1, get_term/1, get_term/2]). -define(default_timeout, 5000). @@ -32,11 +33,11 @@ %% This function is useful for test cases written in C which requires %% no further input, and only returns a result by calling report(). -test(Tc) -> - test(Tc, ?default_timeout). +test(Config, Tc) -> + test(Config, Tc, ?default_timeout). -test(Tc, Timeout) -> - Port = start(Tc), +test(Config, Tc, Timeout) -> + Port = start(Config, Tc), case get_term(Port, Timeout) of eot -> @@ -54,12 +55,51 @@ test(Tc, Timeout) -> %% %% Returns: {ok, Port} -start({Prog, Tc}) when is_list(Prog), is_integer(Tc) -> - Port = open_port({spawn, Prog}, [{packet, 4}, exit_status]), +start(Config, {Prog, Tc}) when is_list(Prog), is_integer(Tc) -> + Port = open_port({spawn, prog_cmd(Config, Prog)}, + [{packet, 4}, exit_status]), Command = [Tc div 256, Tc rem 256], Port ! {self(), {command, Command}}, Port. +prog_cmd(Config, Prog) -> + case proplists:get_value(valgrind_cmd_fun, Config) of + undefined -> + Prog; + Fun when is_function(Fun) -> + Fun(Prog) + end. + +init_per_testcase(Suite, Case, Config) -> + case os:getenv("VALGRIND_LOG_DIR") of + false -> + Config; + LogDir -> + Valgrind = case os:find_executable("valgrind") of + false -> + ct:fail("VALGRIND_LOG_DIR set, " + "but no valgrind executable found"); + VG -> VG + end, + + LogFileOpt = case os:getenv("VALGRIND_LOG_XML") of + false -> + " --log-file="; + "yes" -> + " --xml=yes --xml-file=" + end, + Fun = fun(Prog) -> + LogFile = io_lib:format("erl_interface-~w.~w-~s.log.%p", + [Suite, Case, filename:basename(Prog)]), + Valgrind + ++ LogFileOpt ++ filename:join(LogDir,LogFile) + ++ " " ++ os:getenv("VALGRIND_MISC_FLAGS","") + ++ " " ++ Prog + end, + [{valgrind_cmd_fun, Fun} | Config] + end. + + %% Finishes a test case by send an 'eot' message to the C program %% and waiting for an 'eot'. %% diff --git a/lib/et/doc/src/et_collector.xml b/lib/et/doc/src/et_collector.xml index 6a85b81ec2..ba24c121e0 100644 --- a/lib/et/doc/src/et_collector.xml +++ b/lib/et/doc/src/et_collector.xml @@ -46,7 +46,8 @@ <v>option() = {parent_pid, pid()} | {event_order, event_order()} | {dict_insert, {filter, collector}, collector_fun()} | {dict_insert, {filter, event_filter_name()}, event_filter_fun()} | {dict_insert, {subscriber, pid()}, dict_val()} | {dict_insert, dict_key(), dict_val()} | {dict_delete, dict_key()} | {trace_client, trace_client()} | {trace_global, boolean()} | {trace_pattern, trace_pattern()} | {trace_port, integer()} | {trace_max_queue, integer()}</v> <v>event_order() = trace_ts | event_ts</v> <v>trace_pattern() = {report_module(), extended_dbg_match_spec()} | undefined</v> - <v>report_module() = atom() | undefined <v>extended_dbg_match_spec()() = detail_level() | dbg_match_spec()</v> + <v>report_module() = atom() | undefined</v> + <v>extended_dbg_match_spec() = detail_level() | dbg_match_spec()</v> <v>detail_level() = min | max | integer(X) when X =< 0, X >= 100</v> <v>trace_client() = {event_file, file_name()} | {dbg_trace_type(), dbg_trace_parameters()}</v> <v>file_name() = string()</v> @@ -221,7 +222,7 @@ <v>CollectorPid = pid()</v> <v>RawPattern = {report_module(), extended_dbg_match_spec()}</v> <v>report_module() = atom() | undefined</v> - <v>extended_dbg_match_spec()() = detail_level() | dbg_match_spec()</v> + <v>extended_dbg_match_spec() = detail_level() | dbg_match_spec()</v> <v>RawPattern = detail_level()</v> <v>detail_level() = min | max | integer(X) when X =< 0, X >= 100</v> <v>TracePattern = {report_module(), dbg_match_spec_match_spec()}</v> @@ -348,7 +349,8 @@ <v>done() = 0</v> <v>forward() = infinity | integer(X) where X > 0</v> <v>backward() = '-infinity' | integer(X) where X < 0</v> - <v>Fun = fun(Event, Acc) -> NewAcc <v>Acc = NewAcc = term()</v> + <v>Fun = fun(Event, Acc) -> NewAcc</v> + <v>Acc = NewAcc = term()</v> </type> <desc> <p>Iterate over the currently stored events.</p> diff --git a/lib/et/doc/src/et_selector.xml b/lib/et/doc/src/et_selector.xml index 441a4dd278..b819bbf0c6 100644 --- a/lib/et/doc/src/et_selector.xml +++ b/lib/et/doc/src/et_selector.xml @@ -90,7 +90,9 @@ <fsummary>Transforms trace data and makes an event record out of it</fsummary> <type> - <v>Mod = module_name() | undefined <v>module_name() = atom() <v>ValidTraceData = erlang_trace_data() | record(event)</v> + <v>Mod = module_name() | undefined</v> + <v>module_name() = atom()</v> + <v>ValidTraceData = erlang_trace_data() | record(event)</v> <v>erlang_trace_data() = {trace, Pid, Label, Info} | {trace, Pid, Label, Info, Extra} | {trace_ts, Pid, Label, Info, ReportedTS} | {trace_ts, Pid, Label, Info, Extra, ReportedTS} | {seq_trace, Label, Info} | {seq_trace, Label, Info, ReportedTS} | {drop, NumberOfDroppedItems}</v> </type> diff --git a/lib/et/src/et_collector.erl b/lib/et/src/et_collector.erl index ffe244324c..b432df8c62 100644 --- a/lib/et/src/et_collector.erl +++ b/lib/et/src/et_collector.erl @@ -509,7 +509,7 @@ get_global_pid() -> %% CollectorPid = pid() %% RawPattern = {report_module(), extended_dbg_match_spec()} %% report_module() = atom() | undefined -%% extended_dbg_match_spec()() = detail_level() | dbg_match_spec() +%% extended_dbg_match_spec() = detail_level() | dbg_match_spec() %% RawPattern = detail_level() %% detail_level() = min | max | integer(X) when X =< 0, X >= 100 %% TracePattern = {report_module(), dbg_match_spec_match_spec()} diff --git a/lib/ftp/doc/src/ftp.xml b/lib/ftp/doc/src/ftp.xml index 23a9e3fec7..34e3ff84b0 100644 --- a/lib/ftp/doc/src/ftp.xml +++ b/lib/ftp/doc/src/ftp.xml @@ -314,7 +314,7 @@ <fsummary>Transfers a binary into a remote file.</fsummary> <type> <v>Pid = pid()</v> - <v>Bin = binary()()</v> + <v>Bin = binary()</v> <v>RemoteFile = string()</v> <v>Reason = restriction_reason()| shortage_reason() | common_reason()</v> </type> @@ -736,7 +736,7 @@ <fsummary>Transfers a binary into a remote file.</fsummary> <type> <v>Pid = pid()</v> - <v>Bin = binary()()</v> + <v>Bin = binary()</v> <v>RemoteFile = string()</v> <v>Reason = restriction_reason() | common_reason() | shortage_reason()</v> </type> diff --git a/lib/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml index 63bc6ea2d7..99759a2f2c 100644 --- a/lib/hipe/doc/src/hipe_app.xml +++ b/lib/hipe/doc/src/hipe_app.xml @@ -78,12 +78,12 @@ </item> <tag>NIFs</tag> - <item><p>Modules compiled with HiPE can not call <seealso marker="erts:erlang#load_nif-2"> + <item><p>Modules compiled with HiPE cannot call <seealso marker="erts:erlang#load_nif-2"> <c>erlang:load_nif/2</c></seealso> to load NIFs.</p> </item> <tag>-on_load</tag> - <item><p>Modules compiled with HiPE can not use + <item><p>Modules compiled with HiPE cannot use <seealso marker="doc/reference_manual:code_loading#on_load"><c>-on_load()</c></seealso> directives.</p> </item> diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index f429d40272..ffe81ef9b8 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -647,6 +647,13 @@ trans_fun([{put_tuple,_Size,Reg}|Instructions], Env) -> Primop = hipe_icode:mk_primop(Dest,mktuple,Src), Moves ++ [Primop | trans_fun(Instructions2,Env2)]; %%--- put --- SHOULD NOT REALLY EXIST HERE; put INSTRUCTIONS ARE HANDLED ABOVE. +%%--- put_tuple2 --- +trans_fun([{put_tuple2,Reg,{list,Elements}}|Instructions], Env) -> + Dest = [mk_var(Reg)], + {Moves,Vars,Env2} = trans_elements(Elements, [], [], Env), + Src = lists:reverse(Vars), + Primop = hipe_icode:mk_primop(Dest, mktuple, Src), + Moves ++ [Primop | trans_fun(Instructions, Env2)]; %%--- badmatch --- trans_fun([{badmatch,Arg}|Instructions], Env) -> BadVar = trans_arg(Arg), @@ -1139,9 +1146,10 @@ trans_fun([{test,has_map_fields,{f,Lbl},Map,{list,Keys}}|Instructions], Env) -> lists:flatten([[K, {r, 0}] || K <- Keys])), [MapMove, TestInstructions | trans_fun(Instructions, Env2)]; trans_fun([{get_map_elements,{f,Lbl},Map,{list,KVPs}}|Instructions], Env) -> + KVPs1 = overwrite_map_last(Map, KVPs), {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), {TestInstructions, GetInstructions, Env2} = - trans_map_query(MapVar, map_label(Lbl), Env1, KVPs), + trans_map_query(MapVar, map_label(Lbl), Env1, KVPs1), [MapMove, TestInstructions, GetInstructions | trans_fun(Instructions, Env2)]; %%--- put_map_assoc --- trans_fun([{put_map_assoc,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -> @@ -1563,6 +1571,21 @@ trans_type_test2(function2, Lbl, Arg, Arity, Env) -> hipe_icode:label_name(True), map_label(Lbl)), {[Move1,Move2,I,True],Env2}. + +%% +%% Makes sure that if a get_map_elements instruction will overwrite +%% the map source, it will be done last. +%% +overwrite_map_last(Map, KVPs) -> + overwrite_map_last2(Map, KVPs, []). + +overwrite_map_last2(Map, [Key,Map|KVPs], _Last) -> + overwrite_map_last2(Map, KVPs, [Key,Map]); +overwrite_map_last2(Map, [Key,Val|KVPs], Last) -> + [Key,Val|overwrite_map_last2(Map, KVPs, Last)]; +overwrite_map_last2(_Map, [], Last) -> + Last. + %% %% Handles the get_map_elements instruction and the has_map_fields %% test instruction. @@ -1683,6 +1706,19 @@ trans_puts([{put,X}|Code], Vars, Moves, Env) -> trans_puts(Code, Vars, Moves, Env) -> %% No more put operations {Moves, Code, Vars, Env}. +trans_elements([X|Code], Vars, Moves, Env) -> + case type(X) of + var -> + Var = mk_var(X), + trans_elements(Code, [Var|Vars], Moves, Env); + #beam_const{value=C} -> + Var = mk_var(new), + Move = hipe_icode:mk_move(Var, hipe_icode:mk_const(C)), + trans_elements(Code, [Var|Vars], [Move|Moves], Env) + end; +trans_elements([], Vars, Moves, Env) -> + {Moves, Vars, Env}. + %%----------------------------------------------------------------------- %% The code for this instruction is a bit large because we are treating %% different cases differently. We want to use the icode `type' diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index 34b18acccd..098a7a8d8c 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -1633,7 +1633,7 @@ inf_bsl(_, pos_inf) -> neg_inf; inf_bsl(Number, neg_inf) when is_integer(Number), Number >= 0 -> 0; inf_bsl(_Number, neg_inf) -> -1; inf_bsl(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> - %% We can not shift left with a number which is not a fixnum. We + %% We cannot shift left with a number which is not a fixnum. We %% don't have enough memory. Bits = ?BITS, if Number2 > (Bits bsl 1) -> inf_bsl(Number1, pos_inf); diff --git a/lib/hipe/rtl/hipe_icode2rtl.erl b/lib/hipe/rtl/hipe_icode2rtl.erl index 6da8a76d34..1ab41f4deb 100644 --- a/lib/hipe/rtl/hipe_icode2rtl.erl +++ b/lib/hipe/rtl/hipe_icode2rtl.erl @@ -215,7 +215,7 @@ gen_enter(I, VarMap, ConstTab) -> {Code1, ConstTab2} = case hipe_icode:enter_type(I) of primop -> - IsGuard = false, % enter can not happen in a guard + IsGuard = false, % enter cannot happen in a guard hipe_rtl_primops:gen_enter_primop({Fun, Args}, IsGuard, ConstTab1); Type -> Call = gen_enter_1(Fun, Args, Type), diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc index c05b7aa160..575f10b542 100644 --- a/lib/hipe/rtl/hipe_rtl_arith.inc +++ b/lib/hipe/rtl/hipe_rtl_arith.inc @@ -118,8 +118,8 @@ eval_alu(Op, Arg1, Arg2) -> %% Björn & Bjarni: %% We need to be able to do evaluations based only on the bits, since -%% there are cases where we can evaluate a subset of the bits, but can -%% not do a full eval-alub call (eg. a + 0 gives no carry) +%% there are cases where we can evaluate a subset of the bits, but +%% cannot do a full eval-alub call (eg. a + 0 gives no carry) %% -spec eval_cond_bits(hipe_rtl:alub_cond(), boolean(), boolean(), boolean(), boolean()) -> boolean(). diff --git a/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl b/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl index cad43e2df5..72373e536d 100644 --- a/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl +++ b/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl @@ -31,11 +31,11 @@ %% %% Some things to note: %% -%% 1. All precoloured registers are assumed to contain bottom. We can not +%% 1. All precoloured registers are assumed to contain bottom. We cannot %% do anything with them since they are not in SSA-form. This might be %% possible to resolve in some way, but we decided to not go there. %% -%% 2. const_labels are assumed to be bottom, we can not find the address +%% 2. const_labels are assumed to be bottom, we cannot find the address %% in any nice way (that I know of, maybe someone can help ?). I %% suppose they don't get a value until linking (or some step that %% resembles it). They are only affecting bignums and floats (at least @@ -579,7 +579,7 @@ visit_multimove(Inst, Env) -> %% Procedure : visit_call/2 %% Purpose : execute a call-instruction. All calls return bottom. We make %% this assumption since the icode-leel have taken care of BIF's -%% and we belive that we are left with the things that can not be +%% and we belive that we are left with the things that cannot be %% done att compile time. %% Arguments : Inst - The instruction %% Env - The environment diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 2c70c2b050..e5adb4eb20 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -173,7 +173,7 @@ <item> <p>For <c>ip_comm</c> configuration options, see <seealso marker="kernel:gen_tcp#listen-2">gen_tcp:listen/2</seealso>, some options - that are used internally by httpd can not be set.</p> + that are used internally by httpd cannot be set.</p> <p>For <c>SSL</c> configuration options, see <seealso marker="ssl:ssl#listen-2">ssl:listen/2</seealso>.</p> <p>Default is <c>ip_comm</c>.</p> diff --git a/lib/inets/doc/src/mod_security.xml b/lib/inets/doc/src/mod_security.xml index ec8d6ec42c..d65d2ff998 100644 --- a/lib/inets/doc/src/mod_security.xml +++ b/lib/inets/doc/src/mod_security.xml @@ -135,7 +135,8 @@ <type> <v>What = atom()</v> <v>Port = integer()</v> - <v>Address = {A,B,C,D} | string() <v>Dir = string()</v> + <v>Address = {A,B,C,D} | string()</v> + <v>Dir = string()</v> <v>Data = [Info]</v> <v>Info = {Name, Value}</v> </type> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index d967f56576..8cf2b1e8a4 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,9 +33,25 @@ <file>notes.xml</file> </header> + <section><title>Inets 7.0.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Change status code for no mod found to handle request to + 501</p> + <p> + Own Id: OTP-15215</p> + </item> + </list> + </section> + + </section> + <section><title>Inets 7.0</title> - <section><title>Fixed Bugs and Malfunctions</title> + <section><title>Fixed Bugs and Malfunctions</title> <list> <item> <p> @@ -92,6 +108,65 @@ </section> + <section><title>Inets 6.5.2.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Do not use chunked-encoding with 1xx, 204 and 304 + responses when using mod_esi. Old behavior was not + compliant with HTTP/1.1 RFC and could cause clients to + hang when they received 1xx, 204 or 304 responses that + included an empty chunked-encoded body.</p> + <p> + Own Id: OTP-15241</p> + </item> + <item> + <p> + Add robust handling of chunked-encoded HTTP responses + with an empty body (1xx, 204, 304). Old behavior could + cause the client to hang when connecting to a faulty + server implementation.</p> + <p> + Own Id: OTP-15242</p> + </item> + </list> + </section> + + </section> + + <section><title>Inets 6.5.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Change status code for no mod found to handle request to + 501</p> + <p> + Own Id: OTP-15215</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.5.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Enhance error handling, that is mod_get will return 403 + if a path is a directory and not a file.</p> + <p> + Own Id: OTP-15192</p> + </item> + </list> + </section> + +</section> <section><title>Inets 6.5.2.1</title> @@ -1167,7 +1242,7 @@ Add option {ftp_extension, boolean} to enable use of extended commands EPSV and EPRT, as specified in RFC 2428, for IPv4 instead of using the legacy commands. Ipv6 - can not be supported without the extended commands.</p> + cannot be supported without the extended commands.</p> <p> Own Id: OTP-12255</p> </item> diff --git a/lib/inets/doc/src/notes_history.xml b/lib/inets/doc/src/notes_history.xml index c12899e614..1523827db9 100644 --- a/lib/inets/doc/src/notes_history.xml +++ b/lib/inets/doc/src/notes_history.xml @@ -1149,8 +1149,8 @@ <list type="bulleted"> <item> <p>When further testing the functionality of https requests - that goes through a proxy. We realised that alas this can - not currently be supported as it requires features from + that goes through a proxy. We realised that alas this + cannot currently be supported as it requires features from the ssl implementation that is not currently available. So for now an error message will be returned when trying to use this functionality.</p> diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index cbf428ab3e..2e647a1438 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -271,7 +271,7 @@ lookup_cookies(CookieDb, Host, Path) -> lookup_domain_cookies(_CookieDb, [], AccCookies) -> lists:flatten(AccCookies); -%% Top domains can not have cookies +%% Top domains cannot have cookies lookup_domain_cookies(_CookieDb, [_], AccCookies) -> lists:flatten(AccCookies); diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 5e05b8170a..1bf5d25c98 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -961,13 +961,23 @@ handle_http_body(_, #state{status = {ssl_tunnel, Request}, NewState = answer_request(Request, ClientErrMsg, State), {stop, normal, NewState}; -handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) -> +%% All 1xx (informational), 204 (no content), and 304 (not modified) +%% responses MUST NOT include a message-body, and thus are always +%% terminated by the first empty line after the header fields. +%% This implies that chunked encoding MUST NOT be used for these +%% status codes. +handle_http_body(<<>>, #state{headers = Headers, + status_line = {_,StatusCode, _}} = State) + when Headers#http_response_h.'transfer-encoding' =/= "chunked" andalso + (StatusCode =:= 204 orelse %% No Content + StatusCode =:= 304 orelse %% Not Modified + 100 =< StatusCode andalso StatusCode =< 199) -> %% Informational handle_response(State#state{body = <<>>}); -handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) -> - handle_response(State#state{body = <<>>}); -handle_http_body(<<>>, #state{request = #request{method = head}} = State) -> +handle_http_body(<<>>, #state{headers = Headers, + request = #request{method = head}} = State) + when Headers#http_response_h.'transfer-encoding' =/= "chunked" -> handle_response(State#state{body = <<>>}); handle_http_body(Body, #state{headers = Headers, diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index 0333442bf2..0dc0483fa9 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -863,7 +863,7 @@ select_session(Candidates, _, Max, pipeline) -> select_session(Candidates, Max). select_session([] = _Candidates, _Max) -> - ?hcrd("select session - no candicate", []), + ?hcrd("select session - no candidate", []), no_connection; select_session(Candidates, Max) -> NewCandidates = diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index 52f5fa03a9..37e4f97bc0 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -22,7 +22,7 @@ -export([print/1]). -export([get/2, put/2, post/2, yahoo/2, test1/2, get_bin/2, peer/2,new_status_and_location/2]). --export([newformat/3, post_chunked/3]). +-export([newformat/3, post_chunked/3, post_204/3]). %% These are used by the inets test-suite -export([delay/1, chunk_timeout/3]). @@ -151,6 +151,12 @@ post_chunked(SessionID, _Env, {last, _Body, undefined} = _Bodychunk) -> post_chunked(_, _, _Body) -> exit(body_not_chunked). +post_204(SessionID, _Env, _Input) -> + mod_esi:deliver(SessionID, + ["Status: 204 No Content" ++ "\r\n\r\n"]), + mod_esi:deliver(SessionID, []). + + newformat(SessionID,_,_) -> mod_esi:deliver(SessionID, "Content-Type:text/html\r\n\r\n"), mod_esi:deliver(SessionID, top("new esi format test")), diff --git a/lib/inets/src/http_server/httpd_file.erl b/lib/inets/src/http_server/httpd_file.erl index 4d419172d0..fb71834e95 100644 --- a/lib/inets/src/http_server/httpd_file.erl +++ b/lib/inets/src/http_server/httpd_file.erl @@ -33,6 +33,9 @@ handle_error(enoent, Op, ModData, Path) -> handle_error(enotdir, Op, ModData, Path) -> handle_error(404, Op, ModData, Path, ": A component of the file name is not a directory"); +handle_error(eisdir, Op, ModData, Path) -> + handle_error(403, Op, ModData, Path, + ":Ilegal operation expected a file not a directory"); handle_error(emfile, Op, _ModData, Path) -> handle_error(500, Op, none, Path, ": Too many open files"); handle_error({enfile,_}, Op, _ModData, Path) -> diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index 3ee8665a54..bb946664f9 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -61,8 +61,12 @@ generate_and_send_response(#mod{config_db = ConfigDB} = ModData) -> {StatusCode, Response} -> %% Old way send_response_old(ModData, StatusCode, Response), ok; - undefined -> - send_status(ModData, 500, none), + undefined -> + %% Happens when no mod_* + %% handles the request + send_status(ModData, 501, {ModData#mod.method, + ModData#mod.request_uri, + ModData#mod.http_version}), ok end end diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 21aafa7f7b..443b7ee564 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -394,7 +394,16 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> Continue; {Headers, Body} -> {ok, NewHeaders, StatusCode} = httpd_esi:handle_headers(Headers), - IsDisableChunkedSend = httpd_response:is_disable_chunked_send(Db), + %% All 1xx (informational), 204 (no content), and 304 (not modified) + %% responses MUST NOT include a message-body, and thus are always + %% terminated by the first empty line after the header fields. + %% This implies that chunked encoding MUST NOT be used for these + %% status codes. + IsDisableChunkedSend = + httpd_response:is_disable_chunked_send(Db) orelse + StatusCode =:= 204 orelse %% No Content + StatusCode =:= 304 orelse %% Not Modified + (100 =< StatusCode andalso StatusCode =< 199), %% Informational case (ModData#mod.http_version =/= "HTTP/1.1") or (IsDisableChunkedSend) of true -> @@ -405,8 +414,8 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> send_headers(ModData, StatusCode, [{"transfer-encoding", "chunked"} | NewHeaders]) - end, - handle_body(Pid, ModData, Body, Timeout, length(Body), + end, + handle_body(Pid, ModData, Body, Timeout, length(Body), IsDisableChunkedSend); timeout -> send_headers(ModData, 504, [{"connection", "close"}]), diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 0dcf66265e..b197590bfd 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,10 +18,12 @@ %% %CopyrightEnd% {"%VSN%", [ + {<<"7\\..*">>,[{restart_application, inets}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ + {<<"7\\..*">>,[{restart_application, inets}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index d6b0e5f9f5..0a5aed67d5 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -435,7 +435,7 @@ http_request(Config) when is_list(Config) -> [<<>>, Length1], HttpBody1)). %%------------------------------------------------------------------------- validate_request_line() -> - [{doc, "Test httpd_request:validate/3. Makes sure you can not get past" + [{doc, "Test httpd_request:validate/3. Makes sure you cannot get past" " the server_root and that the request is recognized by the server" " and protcol version."}]. validate_request_line(Config) when is_list(Config) -> diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 6e048a4d56..3d375222b5 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -169,7 +169,8 @@ misc() -> [ server_does_not_exist, timeout_memory_leak, - wait_for_whole_response + wait_for_whole_response, + post_204_chunked ]. sim_mixed() -> @@ -1391,6 +1392,59 @@ wait_for_whole_response(Config) when is_list(Config) -> ReqSeqNumServer ! shutdown. %%-------------------------------------------------------------------- +post_204_chunked() -> + [{doc,"Test that chunked encoded 204 responses do not freeze the http client"}]. +post_204_chunked(_Config) -> + Msg = "HTTP/1.1 204 No Content\r\n" ++ + "Date: Thu, 23 Aug 2018 13:36:29 GMT\r\n" ++ + "Content-Type: text/html\r\n" ++ + "Server: inets/6.5.2.3\r\n" ++ + "Cache-Control: no-cache\r\n" ++ + "Pragma: no-cache\r\n" ++ + "Expires: Fri, 24 Aug 2018 07:49:35 GMT\r\n" ++ + "Transfer-Encoding: chunked\r\n" ++ + "\r\n", + Chunk = "0\r\n\r\n", + + {ok, ListenSocket} = gen_tcp:listen(0, [{active,once}, binary]), + {ok,{_,Port}} = inet:sockname(ListenSocket), + spawn(fun () -> custom_server(Msg, Chunk, ListenSocket) end), + + {ok,Host} = inet:gethostname(), + End = "/cgi-bin/erl/httpd_example:post_204", + URL = ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End, + {ok, _} = httpc:request(post, {URL, [], "text/html", []}, [], []), + timer:sleep(500), + %% Second request times out in the faulty case. + {ok, _} = httpc:request(post, {URL, [], "text/html", []}, [], []). + +custom_server(Msg, Chunk, ListenSocket) -> + {ok, Accept} = gen_tcp:accept(ListenSocket), + receive_packet(), + send_response(Msg, Chunk, Accept), + custom_server_loop(Msg, Chunk, Accept). + +custom_server_loop(Msg, Chunk, Accept) -> + receive_packet(), + send_response(Msg, Chunk, Accept), + custom_server_loop(Msg, Chunk, Accept). + +send_response(Msg, Chunk, Socket) -> + inet:setopts(Socket, [{active, once}]), + gen_tcp:send(Socket, Msg), + timer:sleep(250), + gen_tcp:send(Socket, Chunk). + +receive_packet() -> + receive + {tcp, _, Msg} -> + ct:log("Message received: ~p", [Msg]) + after + 1000 -> + ct:fail("Timeout: did not recive packet") + end. + +%%-------------------------------------------------------------------- stream_fun_server_close() -> [{doc, "Test that an error msg is received when using a receiver fun as stream target"}]. stream_fun_server_close(Config) when is_list(Config) -> diff --git a/lib/inets/test/httpc_proxy_SUITE.erl b/lib/inets/test/httpc_proxy_SUITE.erl index 198b245399..3ee7981660 100644 --- a/lib/inets/test/httpc_proxy_SUITE.erl +++ b/lib/inets/test/httpc_proxy_SUITE.erl @@ -534,7 +534,7 @@ init_local_proxy(Config) -> ct:fail({local_proxy_start_failed,Error}) end; _ -> - {skip,"Platform can not run local proxy start script"} + {skip,"Platform cannot run local proxy start script"} end. init_local_proxy_string(String, Config) -> diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 97aca73d6b..5b6740fba3 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -76,6 +76,8 @@ all() -> {group, http_logging}, {group, http_post}, {group, http_rel_path_script_alias}, + {group, http_not_sup}, + {group, https_not_sup}, mime_types_format ]. @@ -103,6 +105,8 @@ groups() -> {http_reload, [], [{group, reload}]}, {https_reload, [], [{group, reload}]}, {http_post, [], [{group, post}]}, + {http_not_sup, [], [{group, not_sup}]}, + {https_not_sup, [], [{group, not_sup}]}, {http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]}, {limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, {custom, [], [customize, add_default]}, @@ -116,7 +120,7 @@ groups() -> disturbing_0_9, reload_config_file ]}, - {post, [], [chunked_post, chunked_chunked_encoded_post]}, + {post, [], [chunked_post, chunked_chunked_encoded_post, post_204]}, {basic_auth, [], [basic_auth_1_1, basic_auth_1_0, basic_auth_0_9]}, {auth_api, [], [auth_api_1_1, auth_api_1_0, auth_api_0_9 ]}, @@ -134,7 +138,8 @@ groups() -> esi_put, esi_post] ++ http_head() ++ http_get() ++ load()}, {http_1_0, [], [host, cgi, trace] ++ http_head() ++ http_get() ++ load()}, {http_0_9, [], http_head() ++ http_get() ++ load()}, - {http_rel_path_script_alias, [], [cgi]} + {http_rel_path_script_alias, [], [cgi]}, + {not_sup, [], [put_not_sup]} ]. basic_groups ()-> @@ -207,7 +212,8 @@ init_per_group(Group, Config0) when Group == https_basic; Group == https_auth_api_dets; Group == https_auth_api_mnesia; Group == https_security; - Group == https_reload + Group == https_reload; + Group == https_not_sup -> catch crypto:stop(), try crypto:start() of @@ -226,6 +232,7 @@ init_per_group(Group, Config0) when Group == http_basic; Group == http_auth_api_mnesia; Group == http_security; Group == http_reload; + Group == http_not_sup; Group == http_post; Group == http_mime_types -> @@ -275,6 +282,8 @@ init_per_group(http_logging, Config) -> init_per_group(http_rel_path_script_alias = Group, Config) -> ok = start_apps(Group), init_httpd(Group, [{type, ip_comm},{http_version, "HTTP/1.1"}| Config]); +init_per_group(not_sup, Config) -> + [{http_version, "HTTP/1.1"} | Config]; init_per_group(_, Config) -> Config. @@ -448,8 +457,19 @@ get(Config) when is_list(Config) -> {header, "Content-Type", "text/html"}, {header, "Date"}, {header, "Server"}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(proplists:get_value(type, Config), Host, + proplists:get_value(port, Config), + transport_opts(Type, Config), + proplists:get_value(node, Config), + http_request("GET /open/ ", Version, Host), + [{statuscode, 403}, + {header, "Content-Type", "text/html"}, + {header, "Date"}, + {header, "Server"}, {version, Version}]). - + basic_auth_1_1(Config) when is_list(Config) -> basic_auth([{http_version, "HTTP/1.1"} | Config]). @@ -733,6 +753,42 @@ chunked_chunked_encoded_post(Config) when is_list(Config) -> [{http_version, "HTTP/1.1"} | Config], [{statuscode, 200}]). +%%------------------------------------------------------------------------- +post_204() -> + [{doc,"Test that 204 responses are not chunk encoded"}]. +post_204(Config) -> + Host = proplists:get_value(host, Config), + Port = proplists:get_value(port, Config), + SockType = proplists:get_value(type, Config), + TranspOpts = transport_opts(SockType, Config), + Request = "POST /cgi-bin/erl/httpd_example:post_204 ", + + try inets_test_lib:connect_bin(SockType, Host, Port, TranspOpts) of + {ok, Socket} -> + RequestStr = http_request(Request, "HTTP/1.1", Host), + ok = inets_test_lib:send(SockType, Socket, RequestStr), + receive + {tcp, Socket, Data} -> + case binary:match(Data, <<"chunked">>,[]) of + nomatch -> + ok; + {_, _} -> + ct:fail("Chunked encoding detected.") + end + after 2000 -> + ct:fail(connection_timed_out) + end; + ConnectError -> + ct:fail({connect_error, ConnectError, + [SockType, Host, Port, TranspOpts]}) + catch + T:E -> + ct:fail({connect_failure, + [{type, T}, + {error, E}, + {stacktrace, erlang:get_stacktrace()}, + {args, [SockType, Host, Port, TranspOpts]}]}) + end. %%------------------------------------------------------------------------- htaccess_1_1(Config) when is_list(Config) -> @@ -898,6 +954,33 @@ max_clients_0_9() -> max_clients_0_9(Config) when is_list(Config) -> do_max_clients([{http_version, "HTTP/0.9"} | Config]). + + +%%------------------------------------------------------------------------- +put_not_sup() -> + [{doc, "Test unhandled request"}]. + +put_not_sup(Config) when is_list(Config) -> + ok = http_status("PUT /index.html ", + {"Content-Length:100 \r\n", + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ"}, + Config, [{statuscode, 501}]). %%------------------------------------------------------------------------- esi() -> [{doc, "Test mod_esi"}]. @@ -1793,7 +1876,8 @@ start_apps(Group) when Group == https_basic; Group == https_auth_api_mnesia; Group == https_htaccess; Group == https_security; - Group == https_reload + Group == https_reload; + Group == https_not_sup -> inets_test_lib:start_apps([inets, asn1, crypto, public_key, ssl]); start_apps(Group) when Group == http_basic; @@ -1809,7 +1893,9 @@ start_apps(Group) when Group == http_basic; Group == http_reload; Group == http_post; Group == http_mime_types; - Group == http_rel_path_script_alias -> + Group == http_rel_path_script_alias; + Group == http_not_sup; + Group == http_mime_types-> inets_test_lib:start_apps([inets]). server_start(_, HttpdConfig) -> @@ -1844,6 +1930,10 @@ server_config(http_basic, Config) -> basic_conf() ++ server_config(http, Config); server_config(https_basic, Config) -> basic_conf() ++ server_config(https, Config); +server_config(http_not_sup, Config) -> + not_sup_conf() ++ server_config(http, Config); +server_config(https_not_sup, Config) -> + not_sup_conf() ++ server_config(https, Config); server_config(http_reload, Config) -> [{keep_alive_timeout, 2}] ++ server_config(http, Config); server_config(http_post, Config) -> @@ -1992,7 +2082,10 @@ head_status(_) -> basic_conf() -> [{modules, [mod_alias, mod_range, mod_responsecontrol, - mod_trace, mod_esi, mod_cgi, mod_dir, mod_get, mod_head]}]. + mod_trace, mod_esi, mod_cgi, mod_get, mod_head]}]. + +not_sup_conf() -> + [{modules, [mod_get]}]. auth_access_conf() -> [{modules, [mod_alias, mod_htaccess, mod_dir, mod_get, mod_head]}, diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index b76390ad66..26adb854e1 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 7.0 +INETS_VSN = 7.0.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/doc/src/notes.xml b/lib/jinterface/doc/src/notes.xml index 9aaa8a0840..640712ad98 100644 --- a/lib/jinterface/doc/src/notes.xml +++ b/lib/jinterface/doc/src/notes.xml @@ -705,7 +705,7 @@ <item> <p><c>OtpMbox.receive()</c> and <c>OtpMbox.receive(long timeout)</c> can now throw <c>OtpErlangDecodeException</c> if the received message - can not be decoded. <c>null</c> is now only returned from + cannot be decoded. <c>null</c> is now only returned from <c>OtpMbox.receive(long timeout)</c> if a timeout occurs. <c>OtpMbox.receive()</c> will never return <c>null</c>.</p> <p>*** POTENTIAL INCOMPATIBILITY ***</p> diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java index 363fdb950a..fffb8475d3 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java @@ -102,7 +102,7 @@ public class OtpEpmd { /** * Set the port number to be used to contact the epmd process. Only needed * when the default port is not desired and system environment variable - * ERL_EPMD_PORT can not be read (applet). + * ERL_EPMD_PORT cannot be read (applet). */ public static void useEpmdPort(final int port) { EpmdPort.set(port); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java index ded8f6e1e5..6d81ce630b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java @@ -601,7 +601,7 @@ public class OtpInputStream extends ByteArrayInputStream { * @return the integer value. * * @exception OtpErlangDecodeException - * if the next term in the stream can not be represented as a + * if the next term in the stream cannot be represented as a * positive integer. */ public int read_uint() throws OtpErlangDecodeException { @@ -622,7 +622,7 @@ public class OtpInputStream extends ByteArrayInputStream { * @return the integer value. * * @exception OtpErlangDecodeException - * if the next term in the stream can not be represented as + * if the next term in the stream cannot be represented as * an integer. */ public int read_int() throws OtpErlangDecodeException { @@ -643,7 +643,7 @@ public class OtpInputStream extends ByteArrayInputStream { * @return the short value. * * @exception OtpErlangDecodeException - * if the next term in the stream can not be represented as a + * if the next term in the stream cannot be represented as a * positive short. */ public short read_ushort() throws OtpErlangDecodeException { @@ -664,7 +664,7 @@ public class OtpInputStream extends ByteArrayInputStream { * @return the short value. * * @exception OtpErlangDecodeException - * if the next term in the stream can not be represented as a + * if the next term in the stream cannot be represented as a * short. */ public short read_short() throws OtpErlangDecodeException { @@ -685,7 +685,7 @@ public class OtpInputStream extends ByteArrayInputStream { * @return the long value. * * @exception OtpErlangDecodeException - * if the next term in the stream can not be represented as a + * if the next term in the stream cannot be represented as a * positive long. */ public long read_ulong() throws OtpErlangDecodeException { @@ -698,7 +698,7 @@ public class OtpInputStream extends ByteArrayInputStream { * @return the long value. * * @exception OtpErlangDecodeException - * if the next term in the stream can not be represented as a + * if the next term in the stream cannot be represented as a * long. */ public long read_long() throws OtpErlangDecodeException { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java index 42e178c3f6..29a8bc1540 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java @@ -156,7 +156,7 @@ public class OtpMbox { * of the next message waiting in this mailbox. * * @exception OtpErlangDecodeException - * if the message can not be decoded. + * if the message cannot be decoded. * * @exception OtpErlangExit * if a linked {@link OtpErlangPid pid} has exited or has @@ -184,7 +184,7 @@ public class OtpMbox { * of the next message waiting in this mailbox. * * @exception OtpErlangDecodeException - * if the message can not be decoded. + * if the message cannot be decoded. * * @exception OtpErlangExit * if a linked {@link OtpErlangPid pid} has exited or has diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index aff3e8133c..69ce4da61c 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -538,7 +538,7 @@ zip:create("mnesia-4.4.7.ez", </item> <tag><c>not_purged</c></tag> <item> - <p>The object code can not be loaded because an old version + <p>The object code cannot be loaded because an old version of the code already exists.</p> </item> <tag><c>sticky_directory</c></tag> @@ -611,7 +611,7 @@ ok = code:finish_loading(Prepared), <taglist> <tag><c>not_purged</c></tag> <item> - <p>The object code can not be loaded because an old version + <p>The object code cannot be loaded because an old version of the code already exists.</p> </item> <tag><c>sticky_directory</c></tag> diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index e6a7962c5a..f281d61459 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -734,22 +734,23 @@ get_tcpi_sacked(Sock) -> </item> <tag><c>{buffer, Size}</c></tag> <item> - <p>The size of the user-level software buffer used by - the driver. - Not to be confused with options <c>sndbuf</c> + <p>The size of the user-level buffer used by + the driver. Not to be confused with options <c>sndbuf</c> and <c>recbuf</c>, which correspond to the - Kernel socket buffers. It is recommended - to have <c>val(buffer) >= max(val(sndbuf),val(recbuf))</c> to + Kernel socket buffers. For TCP it is recommended + to have <c>val(buffer) >= val(recbuf)</c> to avoid performance issues because of unnecessary copying. + For UDP the same recommendation applies, but the max should + not be larger than the MTU of the network path. <c>val(buffer)</c> is automatically set to the above - maximum when values <c>sndbuf</c> or <c>recbuf</c> are set. - However, as the sizes set for <c>sndbuf</c> and <c>recbuf</c> + maximum when <c>recbuf</c> is set. + However, as the size set for <c>recbuf</c> usually become larger, you are encouraged to use <seealso marker="#getopts/2"><c>getopts/2</c></seealso> to analyze the behavior of your operating system.</p> <p>Note that this is also the maximum amount of data that can be - received from a single recv call. If you are using higher than - normal MTU consider setting buffer higher.</p> + received from a single recv call. If you are using higher than + normal MTU consider setting buffer higher.</p> </item> <tag><c>{delay_send, Boolean}</c></tag> <item> diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 3914226a3e..15dbdb47dc 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -192,7 +192,7 @@ <p>To change the primary log level at runtime, use <seealso marker="logger#set_primary_config/2"> <c>logger:set_primary_config(level, Level)</c></seealso>.</p> - <p>Defaults to <c>info</c>.</p> + <p>Defaults to <c>notice</c>.</p> </item> <tag><marker id="logger_sasl_compatible"/> <c>logger_sasl_compatible = true | false</c></tag> @@ -310,24 +310,31 @@ <tag><c>net_ticktime = TickTime</c></tag> <item> <marker id="net_ticktime"></marker> - <p>Specifies the <c>net_kernel</c> tick time. <c>TickTime</c> - is specified in seconds. Once every <c>TickTime/4</c> second, all - connected nodes are ticked (if anything else is written - to a node). If nothing is received from another node - within the last four tick times, that node is considered - to be down. This ensures that nodes that are not responding, - for reasons such as hardware errors, are considered to be - down.</p> - <p>The time <c>T</c>, in which a node that is not responding is - detected, is calculated as <c><![CDATA[MinT < T < MaxT]]></c>, where:</p> + <p>Specifies the <c>net_kernel</c> tick time in seconds. This is the + approximate time a connected node may be unresponsive until it is + considered down and thereby disconnected.</p> + <p>Once every <c>TickTime/4</c> seconds, each connected node is ticked + if nothing has been sent to it during that last <c>TickTime/4</c> + interval. A tick is a small package sent on the connection. A connected + node is considered to be down if no ticks or payload packages have been + received during the last four <c>TickTime/4</c> intervals. This ensures + that nodes that are not responding, for reasons such as hardware errors, + are considered to be down.</p> + <p>As the availability is only checked every <c>TickTime/4</c> seconds, + the actual time <c>T</c> a node have been unresponsive when + detected may vary between <c>MinT</c> and <c>MaxT</c>, + where:</p> <code type="none"> MinT = TickTime - TickTime / 4 MaxT = TickTime + TickTime / 4</code> - <p><c>TickTime</c> defaults to <c>60</c> (seconds). Thus, - <c><![CDATA[45 < T < 75]]></c> seconds.</p> - <p>Notice that <em>all</em> communicating nodes are to have the <em>same</em> - <c>TickTime</c> value specified.</p> - <p>Normally, a terminating node is detected immediately.</p> + <p><c>TickTime</c> defaults to <c>60</c> seconds. Thus, + <c><![CDATA[45 < T < 75]]></c> seconds.</p> + <p>Notice that <em>all</em> communicating nodes are to have the + <em>same</em> <c>TickTime</c> value specified, as it determines both the + frequency of outgoing ticks and the expected frequency of incominging + ticks.</p> + <p>Normally, a terminating node is detected immediately by the transport + protocol (like TCP/IP).</p> </item> <tag><c>shutdown_timeout = integer() | infinity</c></tag> <item> diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml index f1830a8224..a4d6efa2d8 100644 --- a/lib/kernel/doc/src/logger.xml +++ b/lib/kernel/doc/src/logger.xml @@ -696,6 +696,17 @@ start(_, []) -> </func> <func> + <name name="set_application_level" arity="2"/> + <fsummary>Set the log level for all modules in the specified application.</fsummary> + <desc> + <p>Set the log level for all the modules of the specified application.</p> + <p>This function is a convenience function that calls + <seealso marker="#set_module_level/2">logger:set_module_level/2</seealso> + for each module associated with an application.</p> + </desc> + </func> + + <func> <name name="set_handler_config" arity="2"/> <fsummary>Set configuration data for the specified handler.</fsummary> <desc> @@ -782,8 +793,7 @@ start(_, []) -> <name name="set_module_level" arity="2"/> <fsummary>Set the log level for the specified modules.</fsummary> <desc> - <p>Set the log level for the - specified modules.</p> + <p>Set the log level for the specified modules.</p> <p>The log level for a module overrides the primary log level of Logger for log events originating from the module in question. Notice, however, that it does not override the @@ -839,6 +849,17 @@ start(_, []) -> </func> <func> + <name name="unset_application_level" arity="1"/> + <fsummary>Unset the log level for all modules in the specified application.</fsummary> + <desc> + <p>Unset the log level for all the modules of the specified application.</p> + <p>This function is a convinience function that calls + <seealso marker="#unset_module_level/1">logger:unset_module_level/2</seealso> + for each module associated with an application.</p> + </desc> + </func> + + <func> <name name="unset_module_level" arity="0"/> <fsummary>Remove module specific log settings for all modules.</fsummary> <desc> diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml index 30172f6ca6..7859b49d7e 100644 --- a/lib/kernel/doc/src/logger_chapter.xml +++ b/lib/kernel/doc/src/logger_chapter.xml @@ -210,7 +210,7 @@ </pre> <p>The fun must obey the <c>encoding</c>, <c>depth</c> and <c>chars_limit</c> parameters provided in the second - argument, as the formatter can not do anything useful of these + argument, as the formatter cannot do anything useful of these parameters with the returned string. This variant is used when the formatting of the report depends on the size and encoding parameters.</p> @@ -507,7 +507,7 @@ logger:debug(#{got => connection_request, id => Id, state => State}, <c>logger_level</c></seealso>. It is changed during runtime with <seealso marker="logger#set_primary_config-2"> <c>logger:set_primary_config(level,Level)</c></seealso>.</p> - <p>Defaults to <c>info</c>.</p> + <p>Defaults to <c>notice</c>.</p> </item> <tag><c>filters = [{FilterId,Filter}]</c></tag> <item> diff --git a/lib/kernel/doc/src/logger_formatter.xml b/lib/kernel/doc/src/logger_formatter.xml index 9226d19834..5a060fd42b 100644 --- a/lib/kernel/doc/src/logger_formatter.xml +++ b/lib/kernel/doc/src/logger_formatter.xml @@ -130,10 +130,16 @@ </item> <tag><c>single_line = boolean()</c></tag> <item> - <p>If set to <c>true</c>, all newlines in the message are - replaced with <c>", "</c>, and white spaces following - directly after newlines are removed. Notice that newlines - added by the <c>template</c> parameter are not replaced.</p> + <p>If set to <c>true</c>, each log event is printed as a + single line. To achieve this, <c>logger_formatter</c> + sets the field width to <c>0</c> for all <c>~p</c> + and <c>~P</c> control sequences in the format a string + (see <seealso marker="stdlib:io#format-2"> + <c>io:format/2</c></seealso>), and replaces all + newlines in the message with <c>", "</c>. White spaces + following directly after newlines are removed. Notice + that newlines added by the <c>template</c> parameter are + not replaced.</p> <p>Defaults to <c>true</c>.</p> </item> <tag><marker id="template"/> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 6e88e98c6d..c766c18233 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,6 +31,23 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 6.0.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed bug in <c>net_kernel</c> that could cause an + emulator crash if certain connection attempts failed. Bug + exists since kernel-6.0 (OTP-21.0).</p> + <p> + Own Id: OTP-15280 Aux Id: ERIERL-226, OTP-15279 </p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 6.0</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -314,6 +331,22 @@ </section> +<section><title>Kernel 5.4.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Non semantic change in dist_util.erl to silence dialyzer + warning.</p> + <p> + Own Id: OTP-15170</p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 5.4.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl index 9f76360b8b..e771461b65 100644 --- a/lib/kernel/src/inet_config.erl +++ b/lib/kernel/src/inet_config.erl @@ -98,7 +98,7 @@ init() -> {win32,WinType} -> win32_load_from_registry(WinType); _ -> - error("can not read win32 system registry~n", []) + error("cannot read win32 system registry~n", []) end end, CfgFiles), diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl index f1f58bc872..6c98d2aab7 100644 --- a/lib/kernel/src/inet_dns.erl +++ b/lib/kernel/src/inet_dns.erl @@ -699,7 +699,7 @@ encode_labels(Bin, Comp0, Pos, [L|Ls]=Labels) none -> Comp = if Pos < (3 bsl 14) -> %% Just in case - compression - %% pointers can not reach further + %% pointers cannot reach further gb_trees:insert(Labels, Pos, Comp0); true -> Comp0 end, diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl index ffc90f4fc5..0020fe220b 100644 --- a/lib/kernel/src/logger.erl +++ b/lib/kernel/src/logger.erl @@ -39,6 +39,7 @@ remove_primary_filter/1, remove_handler_filter/2, set_module_level/2, unset_module_level/1, unset_module_level/0, + set_application_level/2, unset_application_level/1, get_module_level/0, get_module_level/1, set_primary_config/1, set_primary_config/2, set_handler_config/2, set_handler_config/3, @@ -488,6 +489,27 @@ unset_module_level(Modules) -> unset_module_level() -> logger_server:unset_module_level(). +-spec set_application_level(Application,Level) -> ok | {error, not_loaded} when + Application :: atom(), + Level :: level() | all | none. +set_application_level(App,Level) -> + case application:get_key(App, modules) of + {ok, Modules} -> + set_module_level(Modules, Level); + undefined -> + {error, {not_loaded, App}} + end. + +-spec unset_application_level(Application) -> ok | {error, not_loaded} when + Application :: atom(). +unset_application_level(App) -> + case application:get_key(App, modules) of + {ok, Modules} -> + unset_module_level(Modules); + undefined -> + {error, {not_loaded, App}} + end. + -spec get_module_level(Modules) -> [{Module,Level}] when Modules :: [Module] | Module, Module :: module(), diff --git a/lib/kernel/src/logger_formatter.erl b/lib/kernel/src/logger_formatter.erl index a5c6984bc6..b0d4adc14d 100644 --- a/lib/kernel/src/logger_formatter.erl +++ b/lib/kernel/src/logger_formatter.erl @@ -188,41 +188,51 @@ format_msg({report,Report},Meta,Config) -> format_msg({report,Report}, Meta#{report_cb=>fun logger:format_report/1}, Config); -format_msg(Msg,_Meta,#{depth:=Depth,chars_limit:=CharsLimit,encoding:=Enc}) -> - limit_size(Msg, Depth, CharsLimit, Enc). - -limit_size(Msg,Depth,unlimited,Enc) -> - limit_size(Msg,Depth,[],Enc); -limit_size(Msg,Depth,CharsLimit,Enc) when is_integer(CharsLimit) -> - limit_size(Msg,Depth,[{chars_limit,CharsLimit}],Enc); -limit_size({Format,Args},unlimited,Opts,Enc) when is_list(Opts) -> - try io_lib:format(Format,Args,Opts) - catch _:_ -> - P = p(Enc), - io_lib:format("FORMAT ERROR: "++P++" - "++P,[Format,Args],Opts) - end; -limit_size({Format0,Args},Depth,Opts,Enc) when is_integer(Depth) -> +format_msg(Msg,_Meta,#{depth:=Depth,chars_limit:=CharsLimit, + encoding:=Enc,single_line:=Single}) -> + Opts = chars_limit_to_opts(CharsLimit), + format_msg(Msg, Depth, Opts, Enc, Single). + +chars_limit_to_opts(unlimited) -> []; +chars_limit_to_opts(CharsLimit) -> [{chars_limit,CharsLimit}]. + +format_msg({Format0,Args},Depth,Opts,Enc,Single) -> try Format1 = io_lib:scan_format(Format0, Args), - Format = limit_format(Format1, Depth), + Format = reformat(Format1, Depth, Single), io_lib:build_text(Format,Opts) - catch _:_ -> - P = p(Enc), - limit_size({"FORMAT ERROR: "++P++" - "++P,[Format0,Args]}, - Depth,Opts,Enc) + catch C:R:S -> + P = p(Enc,Single), + FormatError = "FORMAT ERROR: "++P++" - "++P, + case Format0 of + FormatError -> + %% already been here - avoid failing cyclically + erlang:raise(C,R,S); + _ -> + format_msg({FormatError,[Format0,Args]}, + Depth,Opts,Enc,Single) + end end. -limit_format([#{control_char:=C0}=M0|T], Depth) when C0 =:= $p; - C0 =:= $w -> - C = C0 - ($a - $A), %To uppercase. - #{args:=Args} = M0, - M = M0#{control_char:=C,args:=Args++[Depth]}, - [M|limit_format(T, Depth)]; -limit_format([H|T], Depth) -> - [H|limit_format(T, Depth)]; -limit_format([], _) -> +reformat(Format,unlimited,false) -> + Format; +reformat([#{control_char:=C}=M|T], Depth, true) when C =:= $p -> + [limit_depth(M#{width => 0}, Depth)|reformat(T, Depth, true)]; +reformat([#{control_char:=C}=M|T], Depth, true) when C =:= $P -> + [M#{width => 0}|reformat(T, Depth, true)]; +reformat([#{control_char:=C}=M|T], Depth, Single) when C =:= $p; C =:= $w -> + [limit_depth(M, Depth)|reformat(T, Depth, Single)]; +reformat([H|T], Depth, Single) -> + [H|reformat(T, Depth, Single)]; +reformat([], _, _) -> []. +limit_depth(M0, unlimited) -> + M0; +limit_depth(#{control_char:=C0, args:=Args}=M0, Depth) -> + C = C0 - ($a - $A), %To uppercase. + M0#{control_char:=C,args:=Args++[Depth]}. + truncate(String,unlimited) -> String; truncate(String,Size) -> @@ -492,12 +502,21 @@ check_timezone(Tz) -> error end. -p(#{encoding:=Enc}) -> - p(Enc); -p(latin1) -> - "~p"; -p(_) -> - "~tp". +p(#{encoding:=Enc, single_line:=Single}) -> + p(Enc,Single). + +p(Enc,Single) -> + "~"++p_width(Single)++p_char(Enc). + +p_width(true) -> + "0"; +p_width(false) -> + "". + +p_char(latin1) -> + "p"; +p_char(_) -> + "tp". s(#{encoding:=Enc}) -> s(Enc); diff --git a/lib/kernel/src/logger_server.erl b/lib/kernel/src/logger_server.erl index 28e31d46ea..644fdd5af2 100644 --- a/lib/kernel/src/logger_server.erl +++ b/lib/kernel/src/logger_server.erl @@ -83,7 +83,7 @@ set_module_level(Modules,Level) when is_list(Modules) -> Error -> Error end; false -> - {error,{not_a_list_of_modles,Modules}} + {error,{not_a_list_of_modules,Modules}} end; set_module_level(Modules,_) -> {error,{not_a_list_of_modules,Modules}}. @@ -96,7 +96,7 @@ unset_module_level(Modules) when is_list(Modules) -> true -> call({unset_module_level,Modules}); false -> - {error,{not_a_list_of_modles,Modules}} + {error,{not_a_list_of_modules,Modules}} end; unset_module_level(Modules) -> {error,{not_a_list_of_modules,Modules}}. diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index bea08242d8..ef92f9f4d1 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -279,24 +279,18 @@ passive_connect_monitor(From, Node) -> ok = monitor_nodes(true,[{node_type,all}]), Reply = case lists:member(Node,nodes([connected])) of true -> - io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), true; _ -> receive {nodeup,Node,_} -> - io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), true after connecttime() -> - io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), false end end, ok = monitor_nodes(false,[{node_type,all}]), - io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), {Pid, Tag} = From, - io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]), - erlang:send(Pid, {Tag, Reply}), - io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]). + erlang:send(Pid, {Tag, Reply}). %% If the net_kernel isn't running we ignore all requests to the @@ -358,20 +352,34 @@ init({Name, LongOrShortNames, TickT, CleanHalt}) -> {stop, Error} end. - -do_auto_connect(Type, Node, ConnId, WaitForBarred, From, State) -> - ConnLookup = ets:lookup(sys_dist, Node), - - case ConnLookup of +do_auto_connect_1(Node, ConnId, From, State) -> + case ets:lookup(sys_dist, Node) of [#barred_connection{}] -> - case WaitForBarred of - false -> - {reply, false, State}; - true -> + case ConnId of + passive_cnct -> spawn(?MODULE,passive_connect_monitor,[From,Node]), - {noreply, State} + {noreply, State}; + _ -> + erts_internal:abort_connection(Node, ConnId), + {reply, false, State} end; + ConnLookup -> + do_auto_connect_2(Node, ConnId, From, State, ConnLookup) + end. + +do_auto_connect_2(Node, passive_cnct, From, State, ConnLookup) -> + case (catch erts_internal:new_connection(Node)) of + {Nr,_DHandle}=ConnId when is_integer(Nr) -> + do_auto_connect_2(Node, ConnId, From, State, ConnLookup); + + _Error -> + error_logger:error_msg("~n** Cannot get connection id for node ~w~n", + [Node]), + {reply, false, State} + end; +do_auto_connect_2(Node, ConnId, From, State, ConnLookup) -> + case ConnLookup of [#connection{conn_id=ConnId, state = up}] -> {reply, true, State}; [#connection{conn_id=ConnId, waiting=Waiting}=Conn] -> @@ -385,6 +393,7 @@ do_auto_connect(Type, Node, ConnId, WaitForBarred, From, State) -> case application:get_env(kernel, dist_auto_connect) of {ok, never} -> ?connect_failure(Node,{dist_auto_connect,never}), + erts_internal:abort_connection(Node, ConnId), {reply, false, State}; %% This might happen due to connection close @@ -394,14 +403,16 @@ do_auto_connect(Type, Node, ConnId, WaitForBarred, From, State) -> (hd(ConnLookup))#connection.state =:= up -> ?connect_failure(Node,{barred_connection, ets:lookup(sys_dist, Node)}), + erts_internal:abort_connection(Node, ConnId), {reply, false, State}; _ -> - case setup(ConnLookup, Node,ConnId,Type,From,State) of + case setup(ConnLookup, Node,ConnId,normal,From,State) of {ok, SetupPid} -> Owners = [{SetupPid, Node} | State#state.conn_owners], {noreply,State#state{conn_owners=Owners}}; _Error -> ?connect_failure(Node, {setup_call, failed, _Error}), + erts_internal:abort_connection(Node, ConnId), {reply, false, State} end end @@ -454,18 +465,7 @@ handle_call({passive_cnct, Node}, From, State) when Node =:= node() -> async_reply({reply, true, State}, From); handle_call({passive_cnct, Node}, From, State) -> verbose({passive_cnct, Node}, 1, State), - Type = normal, - WaitForBarred = true, - R = case (catch erts_internal:new_connection(Node)) of - {Nr,_DHandle}=ConnId when is_integer(Nr) -> - do_auto_connect(Type, Node, ConnId, WaitForBarred, From, State); - - _Error -> - error_logger:error_msg("~n** Cannot get connection id for node ~w~n", - [Node]), - {reply, false, State} - end, - + R = do_auto_connect_1(Node, passive_cnct, From, State), return_call(R, From); %% @@ -479,7 +479,16 @@ handle_call({connect, Type, Node}, From, State) -> ConnLookup = ets:lookup(sys_dist, Node), R = case (catch erts_internal:new_connection(Node)) of {Nr,_DHandle}=ConnId when is_integer(Nr) -> - do_explicit_connect(ConnLookup, Type, Node, ConnId, From, State); + R1 = do_explicit_connect(ConnLookup, Type, Node, ConnId, From, State), + case R1 of + {reply, true, _S} -> %% already connected + ok; + {noreply, _S} -> %% connection pending + ok; + {reply, false, _S} -> %% connection refused + erts_internal:abort_connection(Node, ConnId) + end, + R1; _Error -> error_logger:error_msg("~n** Cannot get connection id for node ~w~n", @@ -703,7 +712,7 @@ handle_info({auto_connect,Node, Nr, DHandle}, State) -> verbose({auto_connect, Node, Nr, DHandle}, 1, State), ConnId = {Nr, DHandle}, NewState = - case do_auto_connect(normal, Node, ConnId, false, noreply, State) of + case do_auto_connect_1(Node, ConnId, noreply, State) of {noreply, S} -> %% Pending connection S; @@ -711,7 +720,6 @@ handle_info({auto_connect,Node, Nr, DHandle}, State) -> S; {reply, false, S} -> %% Connection refused - erts_internal:abort_connection(Node, ConnId), S end, {noreply, NewState}; diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 23913ac56a..e784c06865 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -1367,6 +1367,10 @@ file_info_basic_file(Config) when is_list(Config) -> io:put_chars(Fd1, "foo bar"), ok = ?FILE_MODULE:close(Fd1), + %% Don't crash the file server when passing incorrect arguments. + {error,badarg} = ?FILE_MODULE:read_file_info(Name, [{time, gurka}]), + {error,badarg} = ?FILE_MODULE:read_file_info([#{} | gaffel]), + %% Test that the file has the expected attributes. %% The times are tricky, so we will save them to a separate test case. {ok,FileInfo} = ?FILE_MODULE:read_file_info(Name), diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index b39399b18a..3acfff929e 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -34,7 +34,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). -export([send_to_closed/1, active_n/1, - buffer_size/1, binary_passive_recv/1, bad_address/1, + buffer_size/1, binary_passive_recv/1, max_buffer_size/1, bad_address/1, read_packets/1, open_fd/1, connect/1, implicit_inet6/1, local_basic/1, local_unbound/1, local_fdopen/1, local_fdopen_unbound/1, local_abstract/1]). @@ -44,7 +44,7 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [send_to_closed, buffer_size, binary_passive_recv, + [send_to_closed, buffer_size, binary_passive_recv, max_buffer_size, bad_address, read_packets, open_fd, connect, implicit_inet6, active_n, {group, local}]. @@ -237,6 +237,14 @@ buffer_size_server_recv(Socket, IP, Port, Cnt) -> end. +%%------------------------------------------------------------- +%% OTP-15206: Keep buffer small for udp +%%------------------------------------------------------------- +max_buffer_size(Config) when is_list(Config) -> + {ok, Socket} = gen_udp:open(0, [binary]), + ok = inet:setopts(Socket,[{recbuf, 1 bsl 20}]), + {ok, [{buffer, 65536}]} = inet:getopts(Socket,[buffer]), + gen_udp:close(Socket). %%------------------------------------------------------------- %% OTP-3823 gen_udp:recv does not return address in binary mode diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 2e5f8c7d2c..713de8c9a8 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -97,7 +97,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(lookup_bad_search_option, Config) -> Db = inet_db, Key = res_lookup, - %% The bad option can not enter through inet_db:set_lookup/1, + %% The bad option cannot enter through inet_db:set_lookup/1, %% but through e.g .inetrc. Prev = ets:lookup(Db, Key), ets:delete(Db, Key), diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index df6e48abae..cbec8d430c 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -531,7 +531,7 @@ edns0(Config) when is_list(Config) -> case os:version() of {M,V,_} when M < 5; M == 5, V =< 8 -> %% In our test park only known platform - %% with an DNS resolver that can not do + %% with an DNS resolver that cannot do %% EDNS0. {comment,"No EDNS0"} end diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl index 8f74ebdc47..6bd9b20c35 100644 --- a/lib/kernel/test/logger_SUITE.erl +++ b/lib/kernel/test/logger_SUITE.erl @@ -87,6 +87,7 @@ all() -> macros, set_level, set_module_level, + set_application_level, cache_module_level, format_report, filter_failed, @@ -423,6 +424,34 @@ set_module_level(cleanup,_Config) -> logger:unset_module_level(?MODULE), ok. +set_application_level(_Config) -> + + {error,{not_loaded,mnesia}} = logger:set_application_level(mnesia, warning), + {error,{not_loaded,mnesia}} = logger:unset_application_level(mnesia), + + application:load(mnesia), + {ok, Modules} = application:get_key(mnesia, modules), + [] = logger:get_module_level(Modules), + + {error,{invalid_level,warn}} = logger:set_application_level(mnesia, warn), + + ok = logger:set_application_level(mnesia, debug), + DebugModules = lists:sort([{M,debug} || M <- Modules]), + DebugModules = lists:sort(logger:get_module_level(Modules)), + + ok = logger:set_application_level(mnesia, warning), + + WarnModules = lists:sort([{M,warning} || M <- Modules]), + WarnModules = lists:sort(logger:get_module_level(Modules)), + + ok = logger:unset_application_level(mnesia), + [] = logger:get_module_level(Modules). + +set_application_level(cleanup,_Config) -> + ok = logger:unset_application_level(mnesia), + ok = application:unload(mnesia), + ok. + cache_module_level(_Config) -> ok = logger:unset_module_level(?MODULE), [] = ets:lookup(?LOGGER_TABLE,?MODULE), %dirty - add API in logger_config? diff --git a/lib/kernel/test/logger_formatter_SUITE.erl b/lib/kernel/test/logger_formatter_SUITE.erl index aa8dc42691..2ec4b243cf 100644 --- a/lib/kernel/test/logger_formatter_SUITE.erl +++ b/lib/kernel/test/logger_formatter_SUITE.erl @@ -166,6 +166,56 @@ single_line(_Config) -> " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp), String2 = format(info,{"~p",[term]},#{time=>Time},#{single_line=>bad}), + + + %% Test that no extra commas/spaces are added when removing + %% newlines, especially not after "=>" in a map association (as + %% was the case in OTP-21.0, when the only single_line adjustment + %% was done by regexp replacement of "\n" by ", "). + Prefix = + "Some characters to fill the line ------------------------------------- ", + String3 = format(info,{"~s~p~n~s~p~n",[Prefix, + lists:seq(1,10), + Prefix, + #{a=>map,with=>a,few=>accociations}]}, + #{time=>Time}, + #{single_line=>true}), + ct:log(String3), + match = re:run(String3,"\\[1,2,3,4,5,6,7,8,9,10\\]",[{capture,none}]), + match = re:run(String3, + "#{a => map,few => accociations,with => a}", + [{capture,none}]), + + %% This part is added to make sure that the previous test made + %% sense, i.e. that there would actually be newlines inside the + %% list and map. + String4 = format(info,{"~s~p~n~s~p~n",[Prefix, + lists:seq(1,10), + Prefix, + #{a=>map,with=>a,few=>accociations}]}, + #{time=>Time}, + #{single_line=>false}), + ct:log(String4), + match = re:run(String4,"\\[1,2,3,\n",[global,{capture,none}]), + {match,Match4} = re:run(String4,"=>\n",[global,{capture,all}]), + 3 = length(Match4), + + %% Test that big metadata fields do not get line breaks + String5 = format(info,"", + #{mymeta=>lists:seq(1,100)}, + #{single_line=>true,template=>[mymeta,"\n"]}), + ct:log(String5), + [_] = string:lexemes(String5,"\n"), + + %% Ensure that the previous test made sense, i.e. that the + %% metadata field does produce multiple lines if + %% single_line==false. + String6 = format(info,"", + #{mymeta=>lists:seq(1,100)}, + #{single_line=>false,template=>[mymeta,"\n"]}), + ct:log(String6), + [_,_|_] = string:lexemes(String6,"\n"), + ok. template(_Config) -> diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index ceb4e9cc49..cf4bf11328 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -783,6 +783,24 @@ do_shrink(N) -> erlang:garbage_collect(), do_shrink(N-1). +%% Test that messages from a port does not clear the token +port_clean_token(Config) when is_list(Config) -> + seq_trace:reset_trace(), + Label = make_ref(), + seq_trace:set_token(label, Label), + {label,Label} = seq_trace:get_token(label), + + %% Create a port and get messages from it + %% We use os:cmd as a convenience as it does + %% open_port, port_command, port_close and receives replies. + %% Maybe it is not ideal to rely on the internal implementation + %% of os:cmd but it will have to do. + os:cmd("ls"), + + %% Make sure that the seq_trace token is still there + {label,Label} = seq_trace:get_token(label), + + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index aa8e4dc119..fe22e2af98 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 6.0 +KERNEL_VSN = 6.0.1 diff --git a/lib/megaco/configure.in b/lib/megaco/configure.in index eaa875d0a3..bae6144abe 100644 --- a/lib/megaco/configure.in +++ b/lib/megaco/configure.in @@ -22,10 +22,6 @@ dnl dnl define([AC_CACHE_LOAD], )dnl dnl define([AC_CACHE_SAVE], )dnl -if test "x$no_recursion" != "xyes" -a "x$OVERRIDE_CONFIG_CACHE" = "x"; then - # We do not want to use a common cache! - cache_file=/dev/null -fi AC_INIT(vsn.mk) @@ -42,11 +38,14 @@ else host_os=win32 fi - dnl ---------------------------------------------------------------------- dnl Checks for programs. dnl ---------------------------------------------------------------------- +AC_PROG_CC + +LM_WINDOWS_ENVIRONMENT + AC_DEFUN(ERL_REENTRANT_FLEX, [flex_compile='$LEX -R -Pconftest -oconftest.c conftest.flex 1>&AC_FD_CC' changequote(253, 273)dnl @@ -188,111 +187,7 @@ CFLAGS="$CFLAGS $sanitizers" LDFLAGS="$LDFLAGS $sanitizers" ]) -dnl -dnl If ${ERL_TOP}/make/otp_ded.mk.in exists and contains DED_MK_VSN > 0, -dnl every thing releted to compiling Dynamic Erlang Drivers can be found -dnl in $(ERL_TOP)/make/$(TARGET)/ded.mk at compile time. If not, try to -dnl figure these things out. -dnl - -AC_MSG_CHECKING([for usable Dynamic Erlang Driver configuration]) -[ - ded_mk_in="${ERL_TOP}/make/otp_ded.mk.in" - ded_mk_vsn= - test -r "$ded_mk_in" && - ded_mk_vsn=`sed -n "s/^DED_MK_VSN[ ]*=[ ]*\(.*\)/\1/p" < "$ded_mk_in"` - test "$ded_mk_vsn" != "" || ded_mk_vsn=0 -] - -if test $ded_mk_vsn -gt 0; then - -HAVE_USABLE_OTP_DED_MK=yes -AC_MSG_RESULT([yes]) - -CC=false -AC_SUBST(CC) -DED_LD=false -AC_SUBST(DED_LD) - -else dnl --- begin no usable otp_ded.mk.in --- - -HAVE_USABLE_OTP_DED_MK=no -AC_MSG_RESULT([no]) - -dnl -dnl C compiler (related) defs -dnl - -AC_PROG_CC - -dnl -dnl Flags to the C compiler -dnl - -if test "X$host" = "Xwin32"; then - DED_CFLAGS="$CFLAGS" -else - case $host_os in - darwin*) - CFLAGS="$CFLAGS -fno-common" - ;; - esac - - if test "x$GCC" = xyes; then - DED_CFLAGS="$CFLAGS -fPIC $DED_CFLAGS" - else - DED_CFLAGS="$CFLAGS $DED_CFLAGS" - fi -fi - -dnl emulator includes needed -DED_INCLUDES="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE" - -DED_THR_DEFS="-D_THREAD_SAFE -D_REENTRANT" - -case $host_os in - win32) - DED_LDFLAGS="-dll" - ;; - solaris2*|sysv4*) - DED_LDFLAGS="-G" - ;; - aix4*) - DED_LDFLAGS="-G -bnoentry -bexpall" - ;; - freebsd2*) - # Non-ELF GNU linker - DED_LDFLAGS="-Bshareable" - ;; - darwin*) - # Mach-O linker, a shared lib and a loadable - # object file is not the same thing. - DED_LDFLAGS="-bundle -flat_namespace -undefined suppress" - DED_LD="$CC" - ;; - *) - # assume GNU linker and ELF - DED_LDFLAGS="-shared" - ;; -esac - -AC_CHECK_PROGS(DED_LD, [$LD ld.sh]) -AC_CHECK_TOOL(DED_LD, ld, no_ld) -if test "$DED_LD" = no_ld; then - AC_MSG_ERROR([ld is required to build the flex scanner!]) -fi - -AC_MSG_CHECKING(for linker flags for loadable drivers) -DED_LDFLAGS="$LDFLAGS $DED_LDFLAGS" -AC_MSG_RESULT([$DED_LDFLAGS]) - -fi dnl --- end no usable otp_ded.mk.in --- - -AC_SUBST(HAVE_USABLE_OTP_DED_MK) -AC_SUBST(DED_CFLAGS) -AC_SUBST(DED_INCLUDES) -AC_SUBST(DED_THR_DEFS) -AC_SUBST(DED_LDFLAGS) +ERL_DED AC_CHECK_PROG(PERL, perl, perl, no_perl) if test "$PERL" = no_perl; then diff --git a/lib/megaco/src/flex/Makefile.in b/lib/megaco/src/flex/Makefile.in index c37ad4d702..26d2ddd44c 100644 --- a/lib/megaco/src/flex/Makefile.in +++ b/lib/megaco/src/flex/Makefile.in @@ -31,25 +31,6 @@ include ../../vsn.mk VSN=$(MEGACO_VSN) # ---------------------------------------------------- -# Dynamic Erlang Driver -# ---------------------------------------------------- -HAVE_USABLE_OTP_DED_MK = @HAVE_USABLE_OTP_DED_MK@ - -ifeq ($(HAVE_USABLE_OTP_DED_MK),yes) -# otp_ded.mk will be used on R13B04 and later -include $(ERL_TOP)/make/$(TARGET)/otp_ded.mk -else -# megacos configure provide the info instead -DED_CC = @CC@ -DED__NOWARN_NOTHR_CFLAGS = @DED_CFLAGS@ -DED_THR_DEFS = @DED_THR_DEFS@ -DED_LD = @DED_LD@ -DED_LDFLAGS = @DED_LDFLAGS@ -DED_INCLUDES = @DED_INCLUDES@ -DED_EXT = so -endif - -# ---------------------------------------------------- # The following variables differ on different systems, we set # reasonable defaults, if something different is needed it should # be set for that system only. @@ -57,20 +38,19 @@ endif FLEX_VSN = $(shell flex --version) -TMP_CFLAGS = $(DED__NOWARN_NOTHR_CFLAGS) @OTP_EXTRA_FLAGS@ +TMP_CFLAGS = @DED_BASIC_CFLAGS@ @OTP_EXTRA_FLAGS@ ifeq ($(TYPE),valgrind) CFLAGS = $(subst -O2, , $(TMP_CFLAGS)) -DVALGRIND else CFLAGS = $(TMP_CFLAGS) endif -CC = $(DED_CC) -CFLAGS_MT = $(CFLAGS) $(DED_THR_DEFS) -LD = $(DED_LD) -LDFLAGS = $(DED_LDFLAGS) +CC = @DED_CC@ +CFLAGS_MT = $(CFLAGS) @DED_THR_DEFS@ +LD = @DED_LD@ +LDFLAGS = @DED_LDFLAGS@ LEX = @LEX@ LEXLIB = @LEXLIB@ PERL = @PERL@ -ERLANG_OSTYPE = @ERLANG_OSTYPE@ # Shall we build the flex scanner or not. # We assume that it does not exist on windows... @@ -143,8 +123,8 @@ ifeq ($(findstring win32,$(TARGET)), win32) FLEX_SCANNER_SO = SOLIBS = $(FLEX_SCANNER_SO) else -FLEX_SCANNER_SO = $(LIBDIR)/$(STD_DRV).$(DED_EXT) -FLEX_SCANNER_MT_SO = $(LIBDIR)/$(MT_DRV).$(DED_EXT) +FLEX_SCANNER_SO = $(LIBDIR)/$(STD_DRV).@DED_EXT@ +FLEX_SCANNER_MT_SO = $(LIBDIR)/$(MT_DRV).@DED_EXT@ SOLIBS = $(FLEX_SCANNER_SO) $(FLEX_SCANNER_MT_SO) endif @@ -179,7 +159,7 @@ else CFLAGS += -DMFS_FLEX_DEBUG=0 endif -CFLAGS += $(DED_INCLUDES) -I$(ERL_TOP)/erts/$(TARGET) $(DRV_FLAGS) -funroll-loops -Wall +CFLAGS += @DED_INCLUDE@ -I$(ERL_TOP)/erts/$(TARGET) $(DRV_FLAGS) -funroll-loops -Wall #ifneq ($(FLEX_VSN),) #CFLAGS += -DFLEX_VERSION="$(FLEX_VSN)" @@ -398,10 +378,10 @@ $(OBJDIR)/$(MT_DRV).o: $(MT_DRV).c # No need to link with -lfl as we have also defined %option noyywrap - # and having -lfl doesn't work under Darwin for some reason. - Sean -$(LIBDIR)/$(STD_DRV).$(DED_EXT): $(OBJDIR)/$(STD_DRV).o +$(LIBDIR)/$(STD_DRV).@DED_EXT@: $(OBJDIR)/$(STD_DRV).o $(V_colon)@echo "linking std driver:" $(V_LD) $(LDFLAGS) -o $@ $< -$(LIBDIR)/$(MT_DRV).$(DED_EXT): $(OBJDIR)/$(MT_DRV).o +$(LIBDIR)/$(MT_DRV).@DED_EXT@: $(OBJDIR)/$(MT_DRV).o $(V_colon)@echo "linking multi-threaded driver:" $(V_LD) $(LDFLAGS) -o $@ $< diff --git a/lib/mnesia/doc/src/mnesia_frag_hash.xml b/lib/mnesia/doc/src/mnesia_frag_hash.xml index 51b32129b6..2fae542c86 100644 --- a/lib/mnesia/doc/src/mnesia_frag_hash.xml +++ b/lib/mnesia/doc/src/mnesia_frag_hash.xml @@ -130,7 +130,7 @@ <name>key_to_frag_number(State, Key) -> FragNum | abort(Reason)</name> <fsummary>Resolves the key of a record into a fragment number.</fsummary> <type> - <v>FragNum = integer()()</v> + <v>FragNum = integer()</v> <v>Reason = term()</v> </type> <desc> diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 7134e3d1e4..8a7dab739e 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -54,6 +54,32 @@ </section> +<section><title>Mnesia 4.15.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When master node is set do not force a load from + ram_copies replica when there are no available + disc_copies, since that would load an empty table. Wait + until a disk replica is available or until user + explicitly force_loads the table.</p> + <p> + Own Id: OTP-15221 Aux Id: ERIERL-217 </p> + </item> + <item> + <p> + Allow to add replicas even if all other replicas are down + when the other replicase are not stored on disk.</p> + <p> + Own Id: OTP-15226 Aux Id: ERIERL-221 </p> + </item> + </list> + </section> + +</section> + <section><title>Mnesia 4.15.3</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -663,7 +689,7 @@ <p> Returns the same value for mnesia_loader:disc_load_table/2 as - mnesia_loader:net_load_table/4 if a table copy can not be + mnesia_loader:net_load_table/4 if a table copy cannot be found. (Thanks to Uwe Dauernheim)</p> <p> Own Id: OTP-10015</p> diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index e298904e2a..223dba3f90 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -168,6 +168,9 @@ -type snmp_struct() :: [{atom(), snmp_type() | tuple_of(snmp_type())}]. -type snmp_type() :: 'fix_string' | 'string' | 'integer'. -type tuple_of(_T) :: tuple(). +-type config_key() :: extra_db_nodes | dc_dump_limit. +-type config_value() :: [node()] | number(). +-type config_result() :: {ok, config_value()} | {error, term()}. -define(DEFAULT_ACCESS, ?MODULE). @@ -278,7 +281,8 @@ stop() -> Other -> Other end. --spec change_config(Config::atom(), Value::_) -> ok | {error, term()}. +-spec change_config(Config::config_key(), Value::config_value()) -> + config_result(). change_config(extra_db_nodes, Ns) when is_list(Ns) -> mnesia_controller:connect_nodes(Ns); change_config(dc_dump_limit, N) when is_number(N), N > 0 -> @@ -779,12 +783,16 @@ do_delete_object(Tid, Ts, Tab, Val, LockKind) -> ?ets_insert(Store, {Oid, Val, delete_object}); _ -> case ?ets_match_object(Store, {Oid, '_', write}) of - [] -> - ?ets_match_delete(Store, {Oid, Val, '_'}), - ?ets_insert(Store, {Oid, Val, delete_object}); - _ -> - ?ets_delete(Store, Oid), - ?ets_insert(Store, {Oid, Oid, delete}) + [] -> + ?ets_match_delete(Store, {Oid, Val, '_'}), + ?ets_insert(Store, {Oid, Val, delete_object}); + Ops -> + case lists:member({Oid, Val, write}, Ops) of + true -> + ?ets_delete(Store, Oid), + ?ets_insert(Store, {Oid, Oid, delete}); + false -> ok + end end end, ok; diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index f81ba783f2..882de0d613 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -772,22 +772,6 @@ handle_call({unannounce_add_table_copy, [Tab, Node], From}, ReplyTo, State) -> noreply(State#state{early_msgs = [{call, Msg, undefined} | Msgs]}) end; -handle_call({net_load, Tab, Cs}, From, State) -> - State2 = - case State#state.schema_is_merged of - true -> - Worker = #net_load{table = Tab, - opt_reply_to = From, - reason = {dumper,{add_table_copy, unknown}}, - cstruct = Cs - }, - add_worker(Worker, State); - false -> - reply(From, {not_loaded, schema_not_merged}), - State - end, - noreply(State2); - handle_call(Msg, From, State) when State#state.schema_is_merged /= true -> %% Buffer early messages Msgs = State#state.early_msgs, @@ -1457,7 +1441,8 @@ orphan_tables([Tab | Tabs], Node, Ns, Local, Remote) -> L = [Tab | Local], orphan_tables(Tabs, Node, Ns, L, Remote); Masters -> - R = [{Tab, Masters} | Remote], + %% Do not disc_load table from RamCopyHolders + R = [{Tab, Masters -- RamCopyHolders} | Remote], orphan_tables(Tabs, Node, Ns, Local, R) end; _ -> @@ -2162,6 +2147,15 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl {dumper,{add_table_copy,_}} -> true; _ -> false end, + + OnlyRamCopies = case Cs of + #cstruct{disc_copies = DC, + disc_only_copies = DOC, + external_copies = Ext} -> + [] =:= (DC ++ (DOC ++ Ext)) -- [node()]; + _ -> + false + end, if ReadNode == node() -> %% Already loaded locally @@ -2173,6 +2167,8 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl end; AccessMode == read_only, not AddTableCopy -> fun() -> disc_load_table(Tab, Reason, ReplyTo) end; + Active =:= [], AddTableCopy, OnlyRamCopies -> + fun() -> disc_load_table(Tab, Reason, ReplyTo) end; true -> fun() -> %% Either we cannot read the table yet diff --git a/lib/mnesia/src/mnesia_index.erl b/lib/mnesia/src/mnesia_index.erl index 917ada65df..098265d5fc 100644 --- a/lib/mnesia/src/mnesia_index.erl +++ b/lib/mnesia/src/mnesia_index.erl @@ -155,7 +155,7 @@ del_object_bag_([IxK|IxKs], Found, Type, Tab, Key, Obj, Ixt) -> bag -> db_match_erase(Ixt, {IxK, Key}); ordered -> - db_erase(Ixt, {{IxK, Key}}) + db_erase(Ixt, {IxK, Key}) end; _ -> ok diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index a884b8e086..6abc05fade 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -929,7 +929,7 @@ error_desc(no_transaction) -> "Operation not allowed outside transactions"; error_desc(combine_error) -> "Table options were ilegally combined"; error_desc(bad_index) -> "Index already exists or was out of bounds"; error_desc(already_exists) -> "Some schema option we try to set is already on"; -error_desc(index_exists)-> "Some ops can not be performed on tabs with index"; +error_desc(index_exists)-> "Some ops cannot be performed on tabs with index"; error_desc(no_exists)-> "Tried to perform op on non-existing (non alive) item"; error_desc(system_limit) -> "Some system_limit was exhausted"; error_desc(mnesia_down) -> "A transaction involving objects at some remote " diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index ebe924a86e..2cdae0c906 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -67,7 +67,7 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_copies -> EtsOpts = proplists:get_value(ets, StorageProps, []), Args = [{keypos, 2}, public, named_table, Type | EtsOpts], case Reason of - {dumper, _} -> %% Resources already allocated + {dumper, DR} when is_atom(DR) -> %% Resources already allocated ignore; _ -> mnesia_monitor:mktab(Tab, Args), @@ -91,8 +91,8 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == ram_copies -> EtsOpts = proplists:get_value(ets, StorageProps, []), Args = [{keypos, 2}, public, named_table, Type | EtsOpts], case Reason of - {dumper, _} -> %% Resources allready allocated - ignore; + {dumper, DR} when is_atom(DR) -> + ignore; %% Resources already allocated _ -> mnesia_monitor:mktab(Tab, Args), Fname = mnesia_lib:tab2dcd(Tab), @@ -131,7 +131,7 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_only_copies - {repair, mnesia_monitor:get_env(auto_repair)} | DetsOpts], case Reason of - {dumper, _} -> + {dumper, DR} when is_atom(DR) -> mnesia_index:init_index(Tab, Storage), snmpify(Tab, Storage), set({Tab, load_node}, node()), diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index 4b3fffc735..cbf7db28f0 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -1661,7 +1661,7 @@ commit_participant(Coord, Tid, Bin, C0, DiscNs, _RamNs) -> ?eval_debug_fun({?MODULE, commit_participant, pre}, [{tid, Tid}]), try mnesia_schema:prepare_commit(Tid, C0, {part, Coord}) of {Modified, C = #commit{}, DumperMode} -> - %% If we can not find any local unclear decision + %% If we cannot find any local unclear decision %% we should presume abort at startup recovery case lists:member(node(), DiscNs) of false -> diff --git a/lib/mnesia/test/mnesia_durability_test.erl b/lib/mnesia/test/mnesia_durability_test.erl index 62199d8b9a..ccbfdc9738 100644 --- a/lib/mnesia/test/mnesia_durability_test.erl +++ b/lib/mnesia/test/mnesia_durability_test.erl @@ -46,6 +46,7 @@ master_nodes/1, starting_master_nodes/1, master_on_non_local_tables/1, remote_force_load_with_local_master_node/1, + master_node_with_ram_copy_2/1, master_node_with_ram_copy_3/1, dump_ram_copies/1, dump_disc_copies/1, dump_disc_only/1]). -include("mnesia_test_lib.hrl"). @@ -91,7 +92,8 @@ groups() -> {load_tables_with_master_tables, [], [master_nodes, starting_master_nodes, master_on_non_local_tables, - remote_force_load_with_local_master_node]}, + remote_force_load_with_local_master_node, + master_node_with_ram_copy_2, master_node_with_ram_copy_3]}, {durability_of_dump_tables, [], [dump_ram_copies, dump_disc_copies, dump_disc_only]}]. @@ -1165,6 +1167,107 @@ remote_force_load_with_local_master_node(Config) when is_list(Config) -> ?verify_mnesia(Nodes, []). +master_node_with_ram_copy_2(Config) when is_list(Config) -> + [A, B] = Nodes = ?acquire_nodes(2, Config), + Tab = ?FUNCTION_NAME, + ?match({atomic,ok}, mnesia:create_table(Tab, [{disc_copies, [A]}, {ram_copies, [B]}])), + ?match({atomic,ok}, mnesia:sync_transaction(?SDwrite({Tab, 1, init}))), + + %% Test that we don't load from ram_copies + ?match(stopped, rpc:call(A, mnesia, stop, [])), + ?match(stopped, rpc:call(B, mnesia, stop, [])), + ?match(ok, rpc:call(B, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(B, mnesia, wait_for_tables, [[Tab], 1000])), + ?match(ok, rpc:call(A, mnesia, start, [])), + ?match(ok, rpc:call(B, mnesia, wait_for_tables, [[Tab], 3000])), + ?match([{Tab, 1, init}], rpc:call(A, mnesia, dirty_read, [{Tab, 1}])), + ?match([{Tab, 1, init}], rpc:call(B, mnesia, dirty_read, [{Tab, 1}])), + + %% Test that master_nodes set to ram_copy node require force_load + ?match(ok, rpc:call(A, mnesia, set_master_nodes, [[B]])), + ?match(stopped, rpc:call(A, mnesia, stop, [])), + ?match(stopped, rpc:call(B, mnesia, stop, [])), + ?match(ok, rpc:call(B, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(B, mnesia, wait_for_tables, [[Tab], 1000])), + ?match(ok, rpc:call(A, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(B, mnesia, wait_for_tables, [[Tab], 1000])), + + ?match(yes, rpc:call(A, mnesia, force_load_table, [Tab])), + ?match(ok, rpc:call(A, mnesia, wait_for_tables, [[Tab], 1000])), + ?match(ok, rpc:call(B, mnesia, wait_for_tables, [[Tab], 1000])), + ?match([{Tab, 1, init}], rpc:call(A, mnesia, dirty_read, [{Tab, 1}])), + ?match([{Tab, 1, init}], rpc:call(B, mnesia, dirty_read, [{Tab, 1}])), + + ?verify_mnesia(Nodes, []). + + +master_node_with_ram_copy_3(Config) when is_list(Config) -> + [A, B, C] = Nodes = ?acquire_nodes(3, Config), + Tab = ?FUNCTION_NAME, + ?match({atomic,ok}, mnesia:create_table(Tab, [{disc_copies, [A,C]}, {ram_copies, [B]}])), + ?match({atomic,ok}, mnesia:sync_transaction(?SDwrite({Tab, 1, init}))), + + %% Test that we don't load from ram_copies + ?match(stopped, rpc:call(A, mnesia, stop, [])), + ?match(stopped, rpc:call(C, mnesia, stop, [])), + ?match(stopped, rpc:call(B, mnesia, stop, [])), + ?match(ok, rpc:call(B, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(B, mnesia, wait_for_tables, [[Tab], 1000])), + ?match(ok, rpc:call(A, mnesia, start, [])), + ?match(ok, rpc:call(C, mnesia, start, [])), + ?match(ok, rpc:call(B, mnesia, wait_for_tables, [[Tab], 3000])), + ?match(ok, rpc:call(A, mnesia, wait_for_tables, [[Tab], 3000])), + ?match([{Tab, 1, init}], rpc:call(A, mnesia, dirty_read, [{Tab, 1}])), + ?match([{Tab, 1, init}], rpc:call(B, mnesia, dirty_read, [{Tab, 1}])), + ?match([{Tab, 1, init}], rpc:call(C, mnesia, dirty_read, [{Tab, 1}])), + + %% Test that master_nodes set to ram_copy node will wait until loaded + ?match(ok, rpc:call(A, mnesia, set_master_nodes, [[B]])), + ?match(stopped, rpc:call(A, mnesia, stop, [])), + ?match({atomic,ok}, rpc:call(B, mnesia, sync_transaction, [?SDwrite({Tab, 1, update})])), + ?match(stopped, rpc:call(C, mnesia, stop, [])), + ?match({atomic,ok}, rpc:call(B, mnesia, sync_transaction, [?SDwrite({Tab, 1, ram_copies})])), + ?match(stopped, rpc:call(B, mnesia, stop, [])), + ?match(ok, rpc:call(B, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(B, mnesia, wait_for_tables, [[Tab], 500])), + ?match(ok, rpc:call(A, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(A, mnesia, wait_for_tables, [[Tab], 500])), + ?match(ok, rpc:call(C, mnesia, start, [])), + ?match(ok, rpc:call(B, mnesia, wait_for_tables, [[Tab], 3000])), + ?match(ok, rpc:call(A, mnesia, wait_for_tables, [[Tab], 3000])), + ?match([{Tab, 1, update}], rpc:call(A, mnesia, dirty_read, [{Tab, 1}])), + ?match([{Tab, 1, update}], rpc:call(B, mnesia, dirty_read, [{Tab, 1}])), + ?match([{Tab, 1, update}], rpc:call(C, mnesia, dirty_read, [{Tab, 1}])), + + %% Test that master_nodes set to ram_copy node requires force load + ?match({atomic,ok}, mnesia:sync_transaction(?SDwrite({Tab, 1, init}))), + ?match(ok, rpc:call(A, mnesia, set_master_nodes, [[B]])), + ?match(ok, rpc:call(C, mnesia, set_master_nodes, [[B]])), + + ?match(stopped, rpc:call(A, mnesia, stop, [])), + ?match({atomic,ok}, rpc:call(B, mnesia, sync_transaction, [?SDwrite({Tab, 1, update})])), + ?match(stopped, rpc:call(C, mnesia, stop, [])), + ?match({atomic,ok}, rpc:call(B, mnesia, sync_transaction, [?SDwrite({Tab, 1, ram_copies})])), + ?match(stopped, rpc:call(B, mnesia, stop, [])), + ?match(ok, rpc:call(B, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(B, mnesia, wait_for_tables, [[Tab], 500])), + ?match(ok, rpc:call(A, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(A, mnesia, wait_for_tables, [[Tab], 500])), + ?match(ok, rpc:call(C, mnesia, start, [])), + ?match({timeout, [Tab]}, rpc:call(A, mnesia, wait_for_tables, [[Tab], 500])), + ?match({timeout, [Tab]}, rpc:call(B, mnesia, wait_for_tables, [[Tab], 500])), + ?match({timeout, [Tab]}, rpc:call(B, mnesia, wait_for_tables, [[Tab], 500])), + ?match(yes, rpc:call(C, mnesia, force_load_table, [Tab])), + + ?match(ok, rpc:call(A, mnesia, wait_for_tables, [[Tab], 3000])), + ?match(ok, rpc:call(B, mnesia, wait_for_tables, [[Tab], 3000])), + ?match(ok, rpc:call(C, mnesia, wait_for_tables, [[Tab], 3000])), + ?match([{Tab, 1, update}], rpc:call(A, mnesia, dirty_read, [{Tab, 1}])), + ?match([{Tab, 1, update}], rpc:call(B, mnesia, dirty_read, [{Tab, 1}])), + ?match([{Tab, 1, update}], rpc:call(C, mnesia, dirty_read, [{Tab, 1}])), + + ?verify_mnesia(Nodes, []). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1415,7 +1518,7 @@ do_disc_durability(Config,CopyType) -> [{Tab_bag, 22, a_2222}], [{Tab_bag, 33, a_3333}], [{Tab_set, counter, 10}]]), - timer:sleep(1000), %% Debugging strange msgs.. + timer:sleep(500), %% Debugging strange msgs.. ?log("Flushed ~p ~n", [mnesia_test_lib:flush()]), ?verify_mnesia(Nodes, []). diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl index eb1f987cf0..a451c8d0c8 100644 --- a/lib/mnesia/test/mnesia_evil_coverage_test.erl +++ b/lib/mnesia/test/mnesia_evil_coverage_test.erl @@ -31,10 +31,11 @@ db_node_lifecycle/1, evil_delete_db_node/1, start_and_stop/1, checkpoint/1, table_lifecycle/1, storage_options/1, add_copy_conflict/1, add_copy_when_going_down/1, + add_copy_with_down/1, replica_management/1, clear_table_during_load/1, schema_availability/1, local_content/1, replica_location/1, user_properties/1, unsupp_user_props/1, - sorted_ets/1, + sorted_ets/1, index_cleanup/1, change_table_access_mode/1, change_table_load_order/1, set_master_nodes/1, offline_set_master_nodes/1, dump_tables/1, dump_log/1, wait_for_tables/1, force_load_table/1, @@ -48,7 +49,7 @@ record_name_dirty_access_disc_only/1, record_name_dirty_access_xets/1]). --export([info_check/8]). +-export([info_check/8, index_size/1]). -define(cleanup(N, Config), mnesia_test_lib:prepare_test_case([{reload_appls, [mnesia]}], @@ -65,13 +66,14 @@ all() -> db_node_lifecycle, evil_delete_db_node, start_and_stop, checkpoint, table_lifecycle, storage_options, add_copy_conflict, - add_copy_when_going_down, replica_management, clear_table_during_load, + add_copy_when_going_down, add_copy_with_down, replica_management, + clear_table_during_load, schema_availability, local_content, {group, table_access_modifications}, replica_location, {group, table_sync}, user_properties, unsupp_user_props, {group, record_name}, {group, snmp_access}, {group, subscriptions}, {group, iteration}, - {group, debug_support}, sorted_ets, + {group, debug_support}, sorted_ets, index_cleanup, {mnesia_dirty_access_test, all}, {mnesia_trans_access_test, all}, {mnesia_evil_backup, all}]. @@ -732,6 +734,49 @@ add_copy_when_going_down(Config) -> ?match_receive({test,{aborted,_}}), ?verify_mnesia([Node2], []). +add_copy_with_down(suite) -> []; +add_copy_with_down(Config) -> + %% Allow add_table_copy() with ram_copies even all other replicas are down + Nodes = [Node1, Node2, Node3] = ?acquire_nodes(3, Config), + ?match({atomic, ok}, mnesia:create_table(a, [{ram_copies, [Node3]}, {disc_copies, [Node2]}])), + stopped = rpc:call(Node2, mnesia, stop, []), + stopped = rpc:call(Node3, mnesia, stop, []), + ?match({aborted, _}, mnesia:add_table_copy(a, Node1, ram_copies)), + ?match({aborted, _}, mnesia:del_table_copy(a, Node2)), + ok = rpc:call(Node3, mnesia, start, []), + ?match({aborted, _}, mnesia:add_table_copy(a, Node1, ram_copies)), + ?match([], mnesia_test_lib:start_mnesia([Node2], [a])), + ?match({atomic, ok}, mnesia:change_table_copy_type(a, Node2, ram_copies)), + stopped = rpc:call(Node2, mnesia, stop, []), + stopped = rpc:call(Node3, mnesia, stop, []), + ?match({atomic, ok}, mnesia:add_table_copy(a, Node1, ram_copies)), + ?match(ok, mnesia:dirty_write({a,1,1})), + ?match([], mnesia_test_lib:start_mnesia([Node2,Node3], [a])), + ?match([{a,1,1}], rpc:call(Node1, mnesia, dirty_read, [{a,1}])), + ?match([{a,1,1}], rpc:call(Node2, mnesia, dirty_read, [{a,1}])), + ?match([{a,1,1}], rpc:call(Node3, mnesia, dirty_read, [{a,1}])), + + ?match({atomic, ok}, mnesia:del_table_copy(a, Node1)), + stopped = rpc:call(Node2, mnesia, stop, []), + stopped = rpc:call(Node3, mnesia, stop, []), + ?match({atomic, ok}, mnesia:add_table_copy(a, Node1, disc_copies)), + ?match(ok, mnesia:dirty_write({a,1,1})), + ?match([], mnesia_test_lib:start_mnesia([Node2,Node3], [a])), + ?match([{a,1,1}], rpc:call(Node1, mnesia, dirty_read, [{a,1}])), + ?match([{a,1,1}], rpc:call(Node2, mnesia, dirty_read, [{a,1}])), + ?match([{a,1,1}], rpc:call(Node3, mnesia, dirty_read, [{a,1}])), + + ?match({atomic, ok}, mnesia:del_table_copy(a, Node1)), + stopped = rpc:call(Node2, mnesia, stop, []), + stopped = rpc:call(Node3, mnesia, stop, []), + ?match({atomic, ok}, mnesia:add_table_copy(a, Node1, disc_only_copies)), + ?match(ok, mnesia:dirty_write({a,1,1})), + ?match([], mnesia_test_lib:start_mnesia([Node2,Node3], [a])), + ?match([{a,1,1}], rpc:call(Node1, mnesia, dirty_read, [{a,1}])), + ?match([{a,1,1}], rpc:call(Node2, mnesia, dirty_read, [{a,1}])), + ?match([{a,1,1}], rpc:call(Node3, mnesia, dirty_read, [{a,1}])), + + ?verify_mnesia(Nodes, []). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Add, drop and move replicas, change storage types @@ -2514,3 +2559,55 @@ sorted_ets(Config) when is_list(Config) -> ?match({atomic, [{rec,1,1}, {rec,2,1}]}, mnesia:transaction(TestIt)). +index_cleanup(Config) when is_list(Config) -> + [N1, N2] = All = ?acquire_nodes(2, Config), + ?match({atomic, ok}, mnesia:create_table(i_set, [{type, set}, {ram_copies, [N1]}, {index, [val]}, + {disc_only_copies, [N2]}])), + ?match({atomic, ok}, mnesia:create_table(i_bag, [{type, bag}, {ram_copies, [N1]}, {index, [val]}, + {disc_only_copies, [N2]}])), + ?match({atomic, ok}, mnesia:create_table(i_oset, [{type, ordered_set}, {ram_copies, [N1, N2]}, + {index, [val]}])), + + Tabs = [i_set, i_bag, i_oset], + + Add = fun(Tab) -> + Write = fun(Tab) -> + Recs = [{Tab, N, N rem 5} || N <- lists:seq(1,10)], + [ok = mnesia:write(Rec) || Rec <- Recs], + Recs + end, + {atomic, Recs} = mnesia:sync_transaction(Write, [Tab]), + lists:sort(Recs) + end, + + IRead = fun(Tab) -> + Read = fun(Tab) -> + [mnesia:index_read(Tab, N, val) || N <- lists:seq(0,4)] + end, + {atomic, Recs} = mnesia:transaction(Read, [Tab]), + lists:sort(lists:flatten(Recs)) + end, + + Delete = fun(Rec) -> + Del = fun() -> mnesia:delete_object(Rec) end, + {atomic, ok} = mnesia:sync_transaction(Del), + ok + end, + + + Recs = [Add(Tab) || Tab <- Tabs], + ?match(Recs, [IRead(Tab) || Tab <- Tabs]), + [Delete(Rec) || Rec <- lists:flatten(Recs)], + + [?match({Tab,0}, {Tab,mnesia:table_info(Tab, size)}) || Tab <- Tabs], + + [?match({Tab,Node,0, _}, rpc:call(Node, ?MODULE, index_size, [Tab])) + || Node <- All, Tab <- Tabs], + ?verify_mnesia(All, []). + +index_size(Tab) -> + %% White box testing + case mnesia:table_info(Tab, index_info) of + {index, _, [{_, {ram, Ref}}=Dbg]} -> {Tab, node(), ets:info(Ref, size), Dbg}; + {index, _, [{_, {dets, Ref}}=Dbg]} -> {Tab, node(), dets:info(Ref, size), Dbg} + end. diff --git a/lib/mnesia/test/mnesia_isolation_test.erl b/lib/mnesia/test/mnesia_isolation_test.erl index b2eea2390b..49bcec14af 100644 --- a/lib/mnesia/test/mnesia_isolation_test.erl +++ b/lib/mnesia/test/mnesia_isolation_test.erl @@ -1563,7 +1563,8 @@ trans_update_visible_inside_trans(Config) when is_list(Config) -> ?match({atomic, ok}, mnesia:create_table([{name, Tab}, {ram_copies, [Node1]}])), ValPos = 3, - RecA = {Tab, a, 1}, + RecA = {Tab, a, 1}, + RecA2 = {Tab, a, 2}, PatA = {Tab, '$1', 1}, RecB = {Tab, b, 3}, PatB = {Tab, '$1', 3}, @@ -1598,6 +1599,14 @@ trans_update_visible_inside_trans(Config) when is_list(Config) -> ?match([], mnesia:index_read(Tab, 3, ValPos)), %% delete_object + ?match(ok, mnesia:delete_object(RecA2)), + ?match([RecA], mnesia:read({Tab, a})), + ?match([RecA], mnesia:wread({Tab, a})), + ?match([RecA], mnesia:match_object(PatA)), + ?match([a], mnesia:all_keys(Tab)), + ?match([RecA], mnesia:index_match_object(PatA, ValPos)), + ?match([RecA], mnesia:index_read(Tab, 1, ValPos)), + ?match(ok, mnesia:delete_object(RecA)), ?match([], mnesia:read({Tab, a})), ?match([], mnesia:wread({Tab, a})), diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index a4a542297c..91d33474c8 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -49,7 +49,7 @@ format_bin_fun(Format,Bin) -> try io_lib:format(Format,[Bin]) of Str -> plain_html(lists:flatten(Str)) catch error:badarg -> - Warning = "This binary can not be formatted with " ++ Format, + Warning = "This binary cannot be formatted with " ++ Format, observer_html_lib:warning(Warning) end end. @@ -59,7 +59,7 @@ binary_to_term_fun(Bin) -> try binary_to_term(Bin) of Term -> plain_html(io_lib:format("~tp",[Term])) catch error:badarg -> - Warning = "This binary can not be converted to an Erlang term", + Warning = "This binary cannot be converted to an Erlang term", observer_html_lib:warning(Warning) end end. diff --git a/lib/observer/src/cdv_term_cb.erl b/lib/observer/src/cdv_term_cb.erl index 91de6449c4..85da1d227a 100644 --- a/lib/observer/src/cdv_term_cb.erl +++ b/lib/observer/src/cdv_term_cb.erl @@ -51,7 +51,7 @@ format_term_fun(Format,Term,Tab) -> try io_lib:format(Format,[Term]) of Str -> {expand, plain_html(Str), Tab} catch error:badarg -> - Warning = "This term can not be formatted with " ++ Format, + Warning = "This term cannot be formatted with " ++ Format, observer_html_lib:warning(Warning) after observer_lib:report_progress({ok,stop_pulse}) diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index 814f3a1260..dfd19569fd 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -147,7 +147,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_activated, State=#state{holder=Holder, node=Node, opts=#opts{type=Type}, grid=Grid}) -> case get_table(Holder, Index) of #tab{protection=private} -> - self() ! {error, "Table has 'private' protection and can not be read"}; + self() ! {error, "Table has 'private' protection and cannot be read"}; #tab{}=Table -> observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]); _ -> ignore @@ -187,7 +187,7 @@ handle_event(#wx{id=?ID_SHOW_TABLE}, R when is_integer(R) -> case get_table(Holder, R) of #tab{protection=private} -> - self() ! {error, "Table has 'private' protection and can not be read"}; + self() ! {error, "Table has 'private' protection and cannot be read"}; #tab{}=Table -> observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]); _ -> ignore diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 453e3bdc2d..1f748cb8d2 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -806,7 +806,7 @@ is_rb_compatible(Node) -> is_rb_server_running(Node, LogState) -> %% If already started, somebody else may use it. - %% We can not use it too, as far log file would be overriden. Not fair. + %% We cannot use it too, as far log file would be overriden. Not fair. case rpc:block_call(Node, erlang, whereis, [rb_server]) of Pid when is_pid(Pid), (LogState == false) -> throw("Error: rb_server is already started and maybe used by someone."); diff --git a/lib/observer/test/crashdump_viewer_SUITE_data/old_format.dump b/lib/observer/test/crashdump_viewer_SUITE_data/old_format.dump index 2c8944fa9d..2737757bfa 100644 --- a/lib/observer/test/crashdump_viewer_SUITE_data/old_format.dump +++ b/lib/observer/test/crashdump_viewer_SUITE_data/old_format.dump @@ -1285,7 +1285,7 @@ sleep start_prim_loader erl_prim_loader set_path -'can not start loader' +'cannot start loader' add_to_kernel prim_load_flags '-loader' @@ -1304,7 +1304,7 @@ path_flags '-pz' get_boot not_found -'can not get bootfile' +'cannot get bootfile' 'bootfile format error' get_file script @@ -1349,7 +1349,7 @@ extension '-boot/1-fun-0-' '-bs2ss/1-fun-0-' '-bs2as/1-fun-0-' -'can not load' +'cannot load' 'unexpected command in bootfile' prim_inet open @@ -3071,7 +3071,7 @@ change_group change_time master start_slave -'can not get remote filer ' +'cannot get remote filer ' start_relay relay 'Port controlling ~w terminated in file_server' diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 40f5d44847..75336cedcc 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -301,7 +301,7 @@ table_win(Config) when is_list(Config) -> Notebook = setup_whitebox_testing(), Parent = get_top_level_parent(Notebook), TObj = observer_tv_table:start_link(Parent, [{node,node()}, {type,ets}, {table,#tab{name=foo, id=Table}}]), - %% Modal can not test edit.. + %% Modal cannot test edit.. %% TPid = wx_object:get_pid(TObj), %% TPid ! #wx{event=#wxList{type=command_list_item_activated, itemIndex=12}}, timer:sleep(3000), diff --git a/lib/odbc/configure.in b/lib/odbc/configure.in index 2dec6e5abf..c5cf2786ca 100644 --- a/lib/odbc/configure.in +++ b/lib/odbc/configure.in @@ -21,12 +21,6 @@ dnl dnl define([AC_CACHE_LOAD], )dnl dnl define([AC_CACHE_SAVE], )dnl -if test "x$no_recursion" != "xyes" -a "x$OVERRIDE_CONFIG_CACHE" = "x"; then - # We do not want to use a common cache! - cache_file=/dev/null -fi - - dnl Process this file with autoconf to produce a configure script. AC_INIT(c_src/odbcserver.c) diff --git a/lib/odbc/doc/src/databases.xml b/lib/odbc/doc/src/databases.xml index a060f87e46..614c327a46 100644 --- a/lib/odbc/doc/src/databases.xml +++ b/lib/odbc/doc/src/databases.xml @@ -65,7 +65,7 @@ <p>Another obstacle is that some drivers do not support scrollable cursors which has the effect that the only way to traverse the result set is sequentially, with next, from the first row to the - last, and once you pass a row you can not go back. This means + last, and once you pass a row you cannot go back. This means that some functions in the interface will not work together with certain drivers. A similar problem is that not all drivers support "row count" for select queries, hence resulting in that diff --git a/lib/odbc/doc/src/error_handling.xml b/lib/odbc/doc/src/error_handling.xml index 4c80cff12f..8d794d2c99 100644 --- a/lib/odbc/doc/src/error_handling.xml +++ b/lib/odbc/doc/src/error_handling.xml @@ -138,7 +138,7 @@ should be run through the erlang port was not compiled for your platform.</item> <item>Errors discovered by the ODBC driver - If calls to the - ODBC-driver fails due to circumstances that can not be + ODBC-driver fails due to circumstances that cannot be controlled by the Erlang ODBC application programmer, an error string will be dug up from the driver. This string will be the <c>Reason</c> in the <c>{error, Reason} </c> diff --git a/lib/odbc/doc/src/getting_started.xml b/lib/odbc/doc/src/getting_started.xml index f2ff8b8993..b27754ff22 100644 --- a/lib/odbc/doc/src/getting_started.xml +++ b/lib/odbc/doc/src/getting_started.xml @@ -50,7 +50,7 @@ and paths to appropriate values. This may differ a lot between different os's, databases and ODBC drivers. This is a configuration problem related to the third party product - and hence we can not give you a standard solution in this guide.</item> + and hence we cannot give you a standard solution in this guide.</item> <item>The Erlang ODBC application consists of both <c>Erlang</c> and <c>C</c> code. The <c>C</c> code is delivered as a precompiled executable for windows, solaris and linux (SLES10) in the commercial diff --git a/lib/odbc/doc/src/notes_history.xml b/lib/odbc/doc/src/notes_history.xml index 22a92f67cd..d0c0a472e7 100644 --- a/lib/odbc/doc/src/notes_history.xml +++ b/lib/odbc/doc/src/notes_history.xml @@ -63,7 +63,7 @@ <list type="bulleted"> <item> <p>The erlang odbc process will now die normally if a - connection can not be established. No connection no + connection cannot be established. No connection no process it is expected. And as the client has already received the error message that would be the reason with which the erlang process would be stopped, the supervisor @@ -193,7 +193,7 @@ </item> <item> <p>The erlang odbc process will now die normally if a - connection can not be established. No connection no + connection cannot be established. No connection no process it is expected. And as the client has already received the error message that would be the reason with which the erlang process would be stopped, the supervisor diff --git a/lib/odbc/doc/src/odbc.xml b/lib/odbc/doc/src/odbc.xml index 4bb1f035f9..9760908855 100644 --- a/lib/odbc/doc/src/odbc.xml +++ b/lib/odbc/doc/src/odbc.xml @@ -246,7 +246,7 @@ <p>Closes a connection to a database. This will also terminate all processes that may have been spawned when the connection was opened. This call will always succeed. - If the connection can not be disconnected gracefully it will + If the connection cannot be disconnected gracefully it will be brutally killed. However you may receive an error message as result if you try to disconnect a connection started by another process. diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index 261dfc6f20..94ca62b3fb 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -259,7 +259,7 @@ not_exist_db(_Config) -> %%------------------------------------------------------------------------- no_c_executable() -> - [{doc,"Test what happens if the port-program can not be found"}]. + [{doc,"Test what happens if the port-program cannot be found"}]. no_c_executable(_Config) -> process_flag(trap_exit, true), Dir = filename:nativename(filename:join(code:priv_dir(odbc), diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index c0a67c25b8..aaccb5088b 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -682,7 +682,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <tag>{undetermined_details, boolean()}</tag> <item> - <p>Defaults to false. When revocation status can not be + <p>Defaults to false. When revocation status cannot be determined, and this option is set to true, details of why no CRLs where accepted are included in the return value.</p> </item> @@ -902,7 +902,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <note><p> Note that the generated certificates and keys does not provide a formally correct PKIX-trust-chain - and they can not be used to achieve real security. This function is provided for testing purposes only. + and they cannot be used to achieve real security. This function is provided for testing purposes only. </p></note> </desc> </func> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index b34f905fc3..3704503f1e 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -593,8 +593,6 @@ verify(DigestOrPlainText, DigestType, Signature, Key) -> %% Backwards compatible verify(Digest, none, Signature, Key = {_, #'Dss-Parms'{}}, Options) when is_binary(Digest) -> verify({digest, Digest}, sha, Signature, Key, Options); -verify(Digest, none, Signature, Key = #'DSAPrivateKey'{}, Options) when is_binary(Digest) -> - verify({digest, Digest}, sha, Signature, Key, Options); verify(DigestOrPlainText, DigestType, Signature, Key, Options) when is_binary(Signature) -> case format_verify_key(Key) of badarg -> diff --git a/lib/reltool/doc/src/reltool.xml b/lib/reltool/doc/src/reltool.xml index 5bfbee966b..0da9279c80 100644 --- a/lib/reltool/doc/src/reltool.xml +++ b/lib/reltool/doc/src/reltool.xml @@ -806,7 +806,7 @@ target_spec() = [target_spec()] <name>stop(Pid) -> ok | {error, Reason}</name> <fsummary>Stop a server or window process</fsummary> <type> - <v>Pid = server_pid() | window_pid()()</v> + <v>Pid = server_pid() | window_pid()</v> <v>Reason = reason()</v> </type> <desc><p>Stop a server or window process</p></desc> diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl index af71b0cf2a..47aba77835 100644 --- a/lib/reltool/src/reltool_server.erl +++ b/lib/reltool/src/reltool_server.erl @@ -526,7 +526,7 @@ analyse(#state{sys=Sys} = S, Apps, Status) -> %% is included in a release (rel spec - see apps_in_rels above). %% Then initiate the same for each module, and check that there %% are no duplicated module names (in different applications) - %% where we can not decide which one to use. + %% where we cannot decide which one to use. %% Write all #app to app_tab and all #mod to mod_tab. Status2 = apps_init_is_included(S, Apps, RelApps, Status), diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index 4e1937d479..fc976bfb94 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -1038,7 +1038,7 @@ create_standalone_app(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Generate standalone system with inlined archived application -%% Check that the inlined app can not be explicitly configured +%% Check that the inlined app cannot be explicitly configured create_standalone_app_clash(Config) -> %% Create archive @@ -1658,7 +1658,7 @@ set_apps_inlined(Config) -> ?m(true, Someapp1#app.is_included), ?m(true, Someapp1#app.is_pre_included), - %% Check that inlined app can not be configured + %% Check that inlined app cannot be configured Someapp2 = Someapp1#app{incl_cond=exclude}, ?msym({error, "Application someapp is inlined in '*escript* someapp'. " diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in index 4530a83aee..75b3a98d56 100644 --- a/lib/runtime_tools/c_src/Makefile.in +++ b/lib/runtime_tools/c_src/Makefile.in @@ -36,7 +36,7 @@ CC = $(DED_CC) CFLAGS = $(DED_CFLAGS) -I./ LD = $(DED_LD) SHELL = /bin/sh -LIBS = $(DED_LIBS) +LIBS = $(DED_LIBS) @LIBS@ LDFLAGS += $(DED_LDFLAGS) TRACE_LIBNAME = dyntrace trace_file_drv trace_ip_drv @@ -58,7 +58,7 @@ TYPE_FLAGS = $(CFLAGS) endif endif -ALL_CFLAGS = @DEFS@ $(TYPE_FLAGS) $(TRACE_DRV_INCLUDES) \ +ALL_CFLAGS = @DEFS@ @ERTS_CONFIG_H_IDIR@ $(TYPE_FLAGS) $(TRACE_DRV_INCLUDES) \ -I$(OBJDIR) -I$(ERL_TOP)/erts/emulator/$(TARGET) ROOTDIR = $(ERL_TOP)/lib @@ -75,7 +75,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/runtime_tools-$(VSN) # Misc Macros # ---------------------------------------------------- -TRACE_LIBS = $(foreach LIB, $(TRACE_LIBNAME), $(LIBDIR)/$(LIB)$(TYPEMARKER).@DED_EXT@) +TRACE_LIBS = $(foreach LIB, $(TRACE_LIBNAME), $(LIBDIR)/$(LIB)$(TYPEMARKER).$(DED_EXT)) # ---------------------------------------------------- # Targets @@ -94,7 +94,7 @@ $(LIBDIR): $(OBJDIR)/%$(TYPEMARKER).o: %.c dyntrace_lttng.h $(V_CC) -c -o $@ $(ALL_CFLAGS) $< -$(LIBDIR)/%$(TYPEMARKER).@DED_EXT@: $(OBJDIR)/%$(TYPEMARKER).o +$(LIBDIR)/%$(TYPEMARKER).$(DED_EXT): $(OBJDIR)/%$(TYPEMARKER).o $(V_LD) $(LDFLAGS) -o $@ $^ $(LIBS) clean: diff --git a/lib/runtime_tools/doc/src/dbg.xml b/lib/runtime_tools/doc/src/dbg.xml index 3262cafefc..ae60b610ed 100644 --- a/lib/runtime_tools/doc/src/dbg.xml +++ b/lib/runtime_tools/doc/src/dbg.xml @@ -113,7 +113,7 @@ <p>The imported variables will be replaced by match_spec <c>const</c> expressions, which is consistent with the static scoping for Erlang <c>fun()</c>s. Local or global - function calls can not be in the guard or body of the fun + function calls cannot be in the guard or body of the fun however. Calls to builtin match_spec functions of course is allowed:</p> <pre> @@ -756,7 +756,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <c>cant_add_local_node</c> is returned. </p> <p>If a trace port (see <seealso marker="#trace_port-2"><c>trace_port/2</c></seealso>) is - running on the local node, remote nodes can not be traced with + running on the local node, remote nodes cannot be traced with a tracer process. The error reason <c>cant_trace_remote_pid_to_local_port</c> is returned. A trace port can however be started on the remote node with the diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl index 28829132a1..bef4268d3a 100644 --- a/lib/sasl/src/rb.erl +++ b/lib/sasl/src/rb.erl @@ -890,7 +890,7 @@ read_rep(Fd, FilePosition, Device, Abort, Log) -> handle_bad_form(Date, Msg, Device, Abort, Log) -> io:format("rb: ERROR! A report on bad form was encountered. " ++ - "It can not be printed to the log.~n~n"), + "It cannot be printed to the log.~n~n"), io:format("Details:~n~p ~tp~n~n", [Date,Msg]), case {Abort,Device,open_log_file(Log)} of {true,standard_io,standard_io} -> diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index 7570b74c1a..48feac1a21 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -1120,7 +1120,7 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) -> {ok,[FC]} -> FC; {error,Error1} -> - io:format("Warning: ~w can not read ~tp: ~tp~n", + io:format("Warning: ~w cannot read ~tp: ~tp~n", [?MODULE,FromFile,Error1]), [] end, @@ -1130,7 +1130,7 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) -> {ok,[ToConfig]} -> [lists:keyfind(App,1,ToConfig) || App <- [kernel,stdlib,sasl]]; {error,Error2} -> - io:format("Warning: ~w can not read ~tp: ~tp~n", + io:format("Warning: ~w cannot read ~tp: ~tp~n", [?MODULE,ToFile,Error2]), [false,false,false] end, diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index ca97515299..bf18691687 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -147,7 +147,7 @@ split_instructions([], Before) -> %% If PrePurgeMethod == soft_purge, the function will succeed %% only if there is no process running old code of any of the %% modules. Else it will throw {error,Mod}, where Mod is the -%% first module found that can not be soft_purged. +%% first module found that cannot be soft_purged. %% %% If PrePurgeMethod == brutal_purge, the function will %% always succeed and return a list of all modules that are diff --git a/lib/sasl/test/installer.erl b/lib/sasl/test/installer.erl index e38d0cfa7b..5429008a5f 100644 --- a/lib/sasl/test/installer.erl +++ b/lib/sasl/test/installer.erl @@ -905,7 +905,7 @@ start_client(TestNode,Client,Sname) -> wait_started(TestNode,Node) after 30000 -> ?print([{start_client,failed,Node},net_adm:ping(Node)]), - ?fail({"can not start", Node}) + ?fail({"cannot start", Node}) end. start_client_unix(TestNode,Sname,Node) -> diff --git a/lib/sasl/test/rb_SUITE.erl b/lib/sasl/test/rb_SUITE.erl index 2b6e452d14..e5ca1775d5 100644 --- a/lib/sasl/test/rb_SUITE.erl +++ b/lib/sasl/test/rb_SUITE.erl @@ -423,7 +423,7 @@ start_stop_log(Config) -> StdioResult2 = capture(fun() -> rb:log_list() end), {ok,<<>>} = file:read_file(OutFile), - %% Test that standard_io is used if log file can not be opened + %% Test that standard_io is used if log file cannot be opened ok = rb:start_log(filename:join(nonexistingdir,"newfile.txt")), StdioResult = capture(fun() -> rb:show(1) end), {ok,<<>>} = file:read_file(OutFile), diff --git a/lib/sasl/test/sasl_report_SUITE.erl b/lib/sasl/test/sasl_report_SUITE.erl index a03932133e..e639b55cee 100644 --- a/lib/sasl/test/sasl_report_SUITE.erl +++ b/lib/sasl/test/sasl_report_SUITE.erl @@ -106,6 +106,9 @@ gen_server_crash(Config, Encoding) -> ok = rpc:call(Node,?MODULE,crash_me,[]), + ok = rpc:call(Node,logger_std_h,filesync,[default]), + ok = rpc:call(Node,logger_std_h,filesync,[sasl]), + test_server:stop_node(Node), ok = logger:remove_primary_filter(no_remote), diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index 1827974866..6c913850b9 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -1654,7 +1654,7 @@ abnormal_relup(Config) when is_list(Config) -> ok. -%% make_relup: Check relup can not be created is sasl is not in rel file. +%% make_relup: Check relup cannot be created is sasl is not in rel file. no_sasl_relup(Config) when is_list(Config) -> {ok, OldDir} = file:get_cwd(), {Dir1,Name1} = create_script(latest1_no_sasl,Config), diff --git a/lib/snmp/src/agent/snmpa_set_lib.erl b/lib/snmp/src/agent/snmpa_set_lib.erl index 57507a36e8..97b8ddf7c4 100644 --- a/lib/snmp/src/agent/snmpa_set_lib.erl +++ b/lib/snmp/src/agent/snmpa_set_lib.erl @@ -46,9 +46,9 @@ %%* 6) IF value is outside the acceptable range THEN wrongValue. %% 7) IF variable does not exist and could not ever be created %% THEN noCreation. -%% 8) IF variable can not be created now THEN inconsistentName. -%% 9) IF value can not be set now THEN inconsistentValue. -%%* 9) IF instances of the variable can not be modified THEN notWritable. +%% 8) IF variable cannot be created now THEN inconsistentName. +%% 9) IF value cannot be set now THEN inconsistentValue. +%%* 9) IF instances of the variable cannot be modified THEN notWritable. %% 10) IF an unavailable resource is needed THEN resourceUnavailable. %% 11) IF any other error THEN genErr. %% 12) Otherwise ok! diff --git a/lib/snmp/src/agent/snmpa_trap.erl b/lib/snmp/src/agent/snmpa_trap.erl index e75016f7ec..293d1f3ccf 100644 --- a/lib/snmp/src/agent/snmpa_trap.erl +++ b/lib/snmp/src/agent/snmpa_trap.erl @@ -830,11 +830,11 @@ do_send_v1_trap(Enter, Spec, V1Res, NVbs, ExtraInfo, NetIf, SysUpTime) -> case lists:keyfind(transportDomainUdpIpv4, 1, Transports) of false -> ?vtrace( - "snmpa_trap: can not send v1 trap " + "snmpa_trap: cannot send v1 trap " "without IPv4 domain: ~p", [Transports]), user_err( - "snmpa_trap: can not send v1 trap " + "snmpa_trap: cannot send v1 trap " "without IPv4 domain: ~p", [Transports]); DomainAddr -> diff --git a/lib/snmp/test/test-mibs/ALARM-MIB.mib b/lib/snmp/test/test-mibs/ALARM-MIB.mib index 18e43d4b4b..10d2adbff9 100644 --- a/lib/snmp/test/test-mibs/ALARM-MIB.mib +++ b/lib/snmp/test/test-mibs/ALARM-MIB.mib @@ -330,7 +330,7 @@ alarmModelRowStatus OBJECT-TYPE cannot be used as an alarm suppression mechanism. Entries that are notInService will disappear as described in RFC2579. - This row can not be modified while it is being + This row cannot be modified while it is being referenced by a value of alarmActiveModelPointer. In these cases, an error of `inconsistentValue' will be returned to the manager. diff --git a/lib/snmp/test/test-mibs/SNMPv2-TC.mib b/lib/snmp/test/test-mibs/SNMPv2-TC.mib index fd6a728ab5..1d75c4bbd8 100644 --- a/lib/snmp/test/test-mibs/SNMPv2-TC.mib +++ b/lib/snmp/test/test-mibs/SNMPv2-TC.mib @@ -454,7 +454,7 @@ value | | see 1| ->C| ->D associated with this column or that there is no conceptual row for which this column would be accessible in the MIB view used by the retrieval. As - such, the management station can not issue any + such, the management station cannot issue any management protocol set operations to create an instance of this column. @@ -576,7 +576,7 @@ value | | see 1| ->C| ->D associated with this column or that there is no conceptual row for which this column would be accessible in the MIB view used by the retrieval. As - such, the management station can not issue any + such, the management station cannot issue any management protocol set operations to create an instance of this column. diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 2478a8950b..58e8c9ab5b 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -2765,7 +2765,7 @@ </item> <item> <p> - Fixed internal error on when client and server can not + Fixed internal error on when client and server cannot agree o which authmethod to use.</p> <p> Own Id: OTP-10731 Aux Id: seq12237 </p> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index f238bf2ca8..3bc62073a2 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -46,7 +46,7 @@ In that encrypted connection one or more channels could be opened with <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/2,4</seealso>. </p> - <p>Each channel is an isolated "pipe" between a client-side process and a server-side process. Thoose process + <p>Each channel is an isolated "pipe" between a client-side process and a server-side process. Those process pairs could handle for example file transfers (sftp) or remote command execution (shell, exec and/or cli). If a custom shell is implemented, the user of the client could execute the special commands remotely. Note that the user is not necessarily a human but probably a system interfacing the SSH app. diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml index 9ec909d733..e80bb1853d 100644 --- a/lib/ssh/doc/src/ssh_app.xml +++ b/lib/ssh/doc/src/ssh_app.xml @@ -151,6 +151,9 @@ <item>diffie-hellman-group16-sha512</item> <item>diffie-hellman-group18-sha512</item> <item>diffie-hellman-group14-sha256</item> + <item>curve25519-sha256</item> + <item>[email protected]</item> + <item>curve448-sha512</item> <item>diffie-hellman-group14-sha1</item> <item>diffie-hellman-group-exchange-sha1</item> <item>(diffie-hellman-group1-sha1, retired: It can be enabled with the @@ -186,6 +189,7 @@ <tag>Encryption algorithms (ciphers)</tag> <item> <list type="bulleted"> + <item>[email protected]</item> <item>[email protected]</item> <item>aes256-ctr</item> <item>aes192-ctr</item> @@ -365,6 +369,10 @@ </list> <p/> </item> + + <item> + <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-curves">Secure Shell (SSH) Key Exchange Method using Curve25519 and Curve448 (work in progress)</url> + </item> </list> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 9631427749..66dbf0b144 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -118,6 +118,9 @@ 'diffie-hellman-group14-sha256' | 'diffie-hellman-group16-sha512' | 'diffie-hellman-group18-sha512' | + 'curve25519-sha256' | + '[email protected]' | + 'curve448-sha512' | 'ecdh-sha2-nistp256' | 'ecdh-sha2-nistp384' | 'ecdh-sha2-nistp521' @@ -140,7 +143,8 @@ 'aes192-ctr' | 'aes256-ctr' | + '[email protected]' | . -type mac_alg() :: 'AEAD_AES_128_GCM' | @@ -492,4 +496,29 @@ -define(wr_record(N), ?wr_record(N, [])). +%% Circular trace buffer macros + +-record(circ_buf_entry, + { + module, + line, + function, + pid = self(), + value + }). + +-define(CIRC_BUF_IN(VALUE), + ssh_dbg:cbuf_in( + #circ_buf_entry{module = ?MODULE, + line = ?LINE, + function = {?FUNCTION_NAME,?FUNCTION_ARITY}, + pid = self(), + value = (VALUE) + }) + ). + +-define(CIRC_BUF_IN_ONCE(VALUE), + ((fun(V) -> ?CIRC_BUF_IN(V), V end)(VALUE)) + ). + -endif. % SSH_HRL defined diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 8e4831a601..4b41c10cbb 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -356,6 +356,8 @@ alg(ConnectionHandler) -> | undefined, encrypted_data_buffer = <<>> :: binary() | undefined, + aead_data = <<>> :: binary() + | undefined, undecrypted_packet_length :: undefined | non_neg_integer(), key_exchange_init_msg :: #ssh_msg_kexinit{} | undefined, @@ -1308,14 +1310,16 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, try ssh_transport:handle_packet_part( D0#data.decrypted_data_buffer, <<(D0#data.encrypted_data_buffer)/binary, NewData/binary>>, - D0#data.undecrypted_packet_length, + D0#data.aead_data, + D0#data.undecrypted_packet_length, D0#data.ssh_params) of {packet_decrypted, DecryptedBytes, EncryptedDataRest, Ssh1} -> D1 = D0#data{ssh_params = Ssh1#ssh{recv_sequence = ssh_transport:next_seqnum(Ssh1#ssh.recv_sequence)}, decrypted_data_buffer = <<>>, - undecrypted_packet_length = undefined, + undecrypted_packet_length = undefined, + aead_data = <<>>, encrypted_data_buffer = EncryptedDataRest}, try ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D1)) @@ -1353,14 +1357,15 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, StateName, D1), {stop, Shutdown, D} end; - - {get_more, DecryptedBytes, EncryptedDataRest, RemainingSshPacketLen, Ssh1} -> + + {get_more, DecryptedBytes, EncryptedDataRest, AeadData, RemainingSshPacketLen, Ssh1} -> %% Here we know that there are not enough bytes in %% EncryptedDataRest to use. We must wait for more. inet:setopts(Sock, [{active, once}]), {keep_state, D0#data{encrypted_data_buffer = EncryptedDataRest, decrypted_data_buffer = DecryptedBytes, - undecrypted_packet_length = RemainingSshPacketLen, + undecrypted_packet_length = RemainingSshPacketLen, + aead_data = AeadData, ssh_params = Ssh1}}; {bad_mac, Ssh1} -> diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index b53c09b17d..4fe15b24d3 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -54,7 +54,13 @@ start_tracer/0, start_tracer/1, on/1, on/0, off/1, off/0, - go_on/0 + go_on/0, + %% Circular buffer + cbuf_start/0, cbuf_start/1, + cbuf_stop_clear/0, + cbuf_in/1, + cbuf_list/0, + fmt_cbuf_items/0, fmt_cbuf_item/1 ]). -export([shrink_bin/1, @@ -71,6 +77,8 @@ -behaviour(gen_server). -define(SERVER, ?MODULE). +-define(CALL_TIMEOUT, 15000). % 3x the default + %%%================================================================ -define(ALL_DBG_TYPES, get_all_dbg_types()). @@ -107,7 +115,7 @@ start_tracer(WriteFun) when is_function(WriteFun,3) -> start_tracer(WriteFun, InitAcc) when is_function(WriteFun, 3) -> Handler = fun(Arg, Acc0) -> - try_all_types_in_all_modules(gen_server:call(?SERVER, get_on), + try_all_types_in_all_modules(gen_server:call(?SERVER, get_on, ?CALL_TIMEOUT), Arg, WriteFun, Acc0) end, @@ -122,7 +130,7 @@ off() -> off(?ALL_DBG_TYPES). % A bit overkill... off(Type) -> switch(off, Type). go_on() -> - IsOn = gen_server:call(?SERVER, get_on), + IsOn = gen_server:call(?SERVER, get_on, ?CALL_TIMEOUT), on(IsOn). %%%---------------------------------------------------------------- @@ -253,7 +261,7 @@ switch(X, Types) when is_list(Types) -> end, case lists:usort(Types) -- ?ALL_DBG_TYPES of [] -> - gen_server:call(?SERVER, {switch,X,Types}); + gen_server:call(?SERVER, {switch,X,Types}, ?CALL_TIMEOUT); L -> {error, {unknown, L}} end. @@ -331,3 +339,103 @@ ts({_,_,Usec}=Now) when is_integer(Usec) -> io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]); ts(_) -> "-". + +%%%================================================================ +-define(CIRC_BUF, circ_buf). + +cbuf_start() -> + cbuf_start(20). + +cbuf_start(CbufMaxLen) -> + put(?CIRC_BUF, {CbufMaxLen,queue:new()}), + ok. + + +cbuf_stop_clear() -> + case erase(?CIRC_BUF) of + undefined -> + []; + {_CbufMaxLen,Queue} -> + queue:to_list(Queue) + end. + + +cbuf_in(Value) -> + case get(?CIRC_BUF) of + undefined -> + disabled; + {CbufMaxLen,Queue} -> + UpdatedQueue = + try queue:head(Queue) of + {Value, TS0, Cnt0} -> + %% Same Value as last saved in the queue + queue:in_r({Value, TS0, Cnt0+1}, + queue:drop(Queue) + ); + _ -> + queue:in_r({Value, erlang:timestamp(), 1}, + truncate_cbuf(Queue, CbufMaxLen) + ) + catch + error:empty -> + queue:in_r({Value, erlang:timestamp(), 1}, Queue) + end, + put(?CIRC_BUF, {CbufMaxLen,UpdatedQueue}), + ok + end. + + +cbuf_list() -> + case get(?CIRC_BUF) of + undefined -> + []; + {_CbufMaxLen,Queue} -> + queue:to_list(Queue) + end. + + +truncate_cbuf(Q, CbufMaxLen) -> + case queue:len(Q) of + N when N>=CbufMaxLen -> + truncate_cbuf(element(2,queue:out_r(Q)), CbufMaxLen); + _ -> + Q + end. + +fmt_cbuf_items() -> + lists:flatten( + io_lib:format("Circular trace buffer. Latest item first.~n~s~n", + [case get(?CIRC_BUF) of + {Max,_} -> + L = cbuf_list(), + [io_lib:format("==== ~.*w: ~s~n",[num_digits(Max),N,fmt_cbuf_item(X)]) || + {N,X} <- lists:zip(lists:seq(1,length(L)), L) + ]; + _ -> + io_lib:format("Not started.~n",[]) + end])). + + +num_digits(0) -> 1; +num_digits(N) when N>0 -> 1+trunc(math:log10(N)). + + +fmt_cbuf_item({Value, TimeStamp, N}) -> + io_lib:format("~s~s~n~s~n", + [fmt_ts(TimeStamp), + [io_lib:format(" (Repeated ~p times)",[N]) || N>1], + fmt_value(Value)]). + + +fmt_ts(TS = {_,_,Us}) -> + {{YY,MM,DD},{H,M,S}} = calendar:now_to_universal_time(TS), + io_lib:format("~w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w.~.6.0w UTC",[YY,MM,DD,H,M,S,Us]). + +fmt_value(#circ_buf_entry{module = M, + line = L, + function = {F,A}, + pid = Pid, + value = V}) -> + io_lib:format("~p:~p ~p/~p ~p~n~s",[M,L,F,A,Pid,fmt_value(V)]); +fmt_value(Value) -> + io_lib:format("~p",[Value]). diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 55c0548c9b..da4027a763 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -289,12 +289,12 @@ encode(#ssh_msg_kex_dh_gex_reply{ <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>; encode(#ssh_msg_kex_ecdh_init{q_c = Q_c}) -> - <<?Ebyte(?SSH_MSG_KEX_ECDH_INIT), ?Empint(Q_c)>>; + <<?Ebyte(?SSH_MSG_KEX_ECDH_INIT), ?Ebinary(Q_c)>>; encode(#ssh_msg_kex_ecdh_reply{public_host_key = {Key,SigAlg}, q_s = Q_s, h_sig = Sign}) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), EncSign = encode_signature(Key, SigAlg, Sign), - <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Empint(Q_s), ?Ebinary(EncSign)>>; + <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Ebinary(Q_s), ?Ebinary(EncSign)>>; encode(#ssh_msg_ignore{data = Data}) -> <<?Ebyte(?SSH_MSG_IGNORE), ?Estring_utf8(Data)>>; @@ -504,13 +504,13 @@ decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REPLY), ?DEC_BIN(Key,__0), ?DEC_MPINT(F,__1), h_sig = decode_signature(Hashsign) }; -decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_INIT), ?DEC_MPINT(Q_c,__0)>>) -> +decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_INIT), ?DEC_BIN(Q_c,__0)>>) -> #ssh_msg_kex_ecdh_init{ q_c = Q_c }; decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_REPLY), - ?DEC_BIN(Key,__1), ?DEC_MPINT(Q_s,__2), ?DEC_BIN(Sig,__3)>>) -> + ?DEC_BIN(Key,__1), ?DEC_BIN(Q_s,__2), ?DEC_BIN(Sig,__3)>>) -> #ssh_msg_kex_ecdh_reply{ public_host_key = public_key:ssh_decode(Key, ssh2_pubkey), q_s = Q_s, diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 9ec16b420d..c5b0704925 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -36,7 +36,7 @@ default_algorithms/0, default_algorithms/1, algo_classes/0, algo_class/1, algo_two_spec_classes/0, algo_two_spec_class/1, - handle_packet_part/4, + handle_packet_part/5, handle_hello_version/1, key_exchange_init_msg/1, key_init/3, new_keys_message/1, @@ -104,17 +104,14 @@ algo_two_spec_class(_) -> false. default_algorithms(kex) -> supported_algorithms(kex, [ - %% Under devolpment: - 'curve25519-sha256', - '[email protected]', - 'curve448-sha512', %% Gone in OpenSSH 7.3.p1: 'diffie-hellman-group1-sha1' ]); default_algorithms(cipher) -> supported_algorithms(cipher, same(['AEAD_AES_128_GCM', - 'AEAD_AES_256_GCM'])); + 'AEAD_AES_256_GCM' + ])); default_algorithms(mac) -> supported_algorithms(mac, same(['AEAD_AES_128_GCM', 'AEAD_AES_256_GCM'])); @@ -128,18 +125,18 @@ supported_algorithms() -> [{K,supported_algorithms(K)} || K <- algo_classes()]. supported_algorithms(kex) -> select_crypto_supported( [ - {'ecdh-sha2-nistp384', [{public_keys,ecdh}, {ec_curve,secp384r1}, {hashs,sha384}]}, - {'ecdh-sha2-nistp521', [{public_keys,ecdh}, {ec_curve,secp521r1}, {hashs,sha512}]}, - {'ecdh-sha2-nistp256', [{public_keys,ecdh}, {ec_curve,secp256r1}, {hashs,sha256}]}, - %% https://tools.ietf.org/html/draft-ietf-curdle-ssh-curves - %% Secure Shell (SSH) Key Exchange Method using Curve25519 and Curve448 - {'curve25519-sha256', [{public_keys,eddh}, {curves,x25519}, {hashs,sha256}]}, - {'[email protected]', [{public_keys,eddh}, {curves,x25519}, {hashs,sha256}]}, - {'curve448-sha512', [{public_keys,eddh}, {curves,x448}, {hashs,sha512}]}, + {'ecdh-sha2-nistp384', [{public_keys,ecdh}, {curves,secp384r1}, {hashs,sha384}]}, + {'ecdh-sha2-nistp521', [{public_keys,ecdh}, {curves,secp521r1}, {hashs,sha512}]}, + {'ecdh-sha2-nistp256', [{public_keys,ecdh}, {curves,secp256r1}, {hashs,sha256}]}, {'diffie-hellman-group-exchange-sha256', [{public_keys,dh}, {hashs,sha256}]}, {'diffie-hellman-group16-sha512', [{public_keys,dh}, {hashs,sha512}]}, % In OpenSSH 7.3.p1 {'diffie-hellman-group18-sha512', [{public_keys,dh}, {hashs,sha512}]}, % In OpenSSH 7.3.p1 {'diffie-hellman-group14-sha256', [{public_keys,dh}, {hashs,sha256}]}, % In OpenSSH 7.3.p1 + %% https://tools.ietf.org/html/draft-ietf-curdle-ssh-curves + %% Secure Shell (SSH) Key Exchange Method using Curve25519 and Curve448 + {'curve25519-sha256', [{public_keys,ecdh}, {curves,x25519}, {hashs,sha256}]}, + {'[email protected]', [{public_keys,ecdh}, {curves,x25519}, {hashs,sha256}]}, + {'curve448-sha512', [{public_keys,ecdh}, {curves,x448}, {hashs,sha512}]}, {'diffie-hellman-group14-sha1', [{public_keys,dh}, {hashs,sha}]}, {'diffie-hellman-group-exchange-sha1', [{public_keys,dh}, {hashs,sha}]}, {'diffie-hellman-group1-sha1', [{public_keys,dh}, {hashs,sha}]} @@ -147,9 +144,9 @@ supported_algorithms(kex) -> supported_algorithms(public_key) -> select_crypto_supported( [ - {'ecdsa-sha2-nistp384', [{public_keys,ecdsa}, {hashs,sha384}, {ec_curve,secp384r1}]}, - {'ecdsa-sha2-nistp521', [{public_keys,ecdsa}, {hashs,sha512}, {ec_curve,secp521r1}]}, - {'ecdsa-sha2-nistp256', [{public_keys,ecdsa}, {hashs,sha256}, {ec_curve,secp256r1}]}, + {'ecdsa-sha2-nistp384', [{public_keys,ecdsa}, {hashs,sha384}, {curves,secp384r1}]}, + {'ecdsa-sha2-nistp521', [{public_keys,ecdsa}, {hashs,sha512}, {curves,secp521r1}]}, + {'ecdsa-sha2-nistp256', [{public_keys,ecdsa}, {hashs,sha256}, {curves,secp256r1}]}, {'ssh-rsa', [{public_keys,rsa}, {hashs,sha} ]}, {'rsa-sha2-256', [{public_keys,rsa}, {hashs,sha256} ]}, {'rsa-sha2-512', [{public_keys,rsa}, {hashs,sha512} ]}, @@ -160,6 +157,7 @@ supported_algorithms(cipher) -> same( select_crypto_supported( [ + {'[email protected]', [{ciphers,chacha20}, {macs,poly1305}]}, {'[email protected]', [{ciphers,{aes_gcm,256}}]}, {'aes256-ctr', [{ciphers,{aes_ctr,256}}]}, {'aes192-ctr', [{ciphers,{aes_ctr,192}}]}, @@ -174,9 +172,9 @@ supported_algorithms(cipher) -> supported_algorithms(mac) -> same( select_crypto_supported( - [{'hmac-sha2-256', [{hashs,sha256}]}, - {'hmac-sha2-512', [{hashs,sha512}]}, - {'hmac-sha1', [{hashs,sha}]}, + [{'hmac-sha2-256', [{macs,hmac}, {hashs,sha256}]}, + {'hmac-sha2-512', [{macs,hmac}, {hashs,sha512}]}, + {'hmac-sha1', [{macs,hmac}, {hashs,sha}]}, {'AEAD_AES_128_GCM', [{ciphers,{aes_gcm,128}}]}, {'AEAD_AES_256_GCM', [{ciphers,{aes_gcm,256}}]} ] @@ -982,13 +980,14 @@ select_algorithm(Role, Client, Server, Opts) -> %%% the exchanged MAC algorithms are ignored and there doesn't have to be %%% a matching MAC. -aead_gcm_simultan('[email protected]', _) -> {'AEAD_AES_128_GCM', 'AEAD_AES_128_GCM'}; -aead_gcm_simultan('[email protected]', _) -> {'AEAD_AES_256_GCM', 'AEAD_AES_256_GCM'}; -aead_gcm_simultan('AEAD_AES_128_GCM', _) -> {'AEAD_AES_128_GCM', 'AEAD_AES_128_GCM'}; -aead_gcm_simultan('AEAD_AES_256_GCM', _) -> {'AEAD_AES_256_GCM', 'AEAD_AES_256_GCM'}; -aead_gcm_simultan(_, 'AEAD_AES_128_GCM') -> {'AEAD_AES_128_GCM', 'AEAD_AES_128_GCM'}; -aead_gcm_simultan(_, 'AEAD_AES_256_GCM') -> {'AEAD_AES_256_GCM', 'AEAD_AES_256_GCM'}; -aead_gcm_simultan(Cipher, Mac) -> {Cipher,Mac}. +aead_gcm_simultan('[email protected]', _) -> {'AEAD_AES_128_GCM', 'AEAD_AES_128_GCM'}; +aead_gcm_simultan('[email protected]', _) -> {'AEAD_AES_256_GCM', 'AEAD_AES_256_GCM'}; +aead_gcm_simultan('AEAD_AES_128_GCM'=C, _) -> {C, C}; +aead_gcm_simultan('AEAD_AES_256_GCM'=C, _) -> {C, C}; +aead_gcm_simultan(_, 'AEAD_AES_128_GCM'=C) -> {C, C}; +aead_gcm_simultan(_, 'AEAD_AES_256_GCM'=C) -> {C, C}; +aead_gcm_simultan('[email protected]'=C, _)-> {C, C}; +aead_gcm_simultan(Cipher, Mac) -> {Cipher,Mac}. select_encrypt_decrypt(client, Client, Server) -> @@ -1136,7 +1135,7 @@ pack(PlainText, encrypt = CryptoAlg} = Ssh0, PacketLenDeviationForTests) when is_binary(PlainText) -> {Ssh1, CompressedPlainText} = compress(Ssh0, PlainText), - {EcryptedPacket, MAC, Ssh3} = + {FinalPacket, Ssh3} = case pkt_type(CryptoAlg) of common -> PaddingLen = padding_length(4+1+size(CompressedPlainText), Ssh0), @@ -1145,16 +1144,15 @@ pack(PlainText, PlainPacketData = <<?UINT32(PlainPacketLen),?BYTE(PaddingLen), CompressedPlainText/binary, Padding/binary>>, {Ssh2, EcryptedPacket0} = encrypt(Ssh1, PlainPacketData), MAC0 = mac(MacAlg, MacKey, SeqNum, PlainPacketData), - {EcryptedPacket0, MAC0, Ssh2}; + {<<EcryptedPacket0/binary,MAC0/binary>>, Ssh2}; aead -> PaddingLen = padding_length(1+size(CompressedPlainText), Ssh0), Padding = ssh_bits:random(PaddingLen), PlainPacketLen = 1 + PaddingLen + size(CompressedPlainText) + PacketLenDeviationForTests, PlainPacketData = <<?BYTE(PaddingLen), CompressedPlainText/binary, Padding/binary>>, - {Ssh2, {EcryptedPacket0,MAC0}} = encrypt(Ssh1, {<<?UINT32(PlainPacketLen)>>,PlainPacketData}), - {<<?UINT32(PlainPacketLen),EcryptedPacket0/binary>>, MAC0, Ssh2} + {Ssh2, {EcryptedPacket0,MAC0}} = encrypt(Ssh1, <<?UINT32(PlainPacketLen),PlainPacketData/binary>>), + {<<EcryptedPacket0/binary,MAC0/binary>>, Ssh2} end, - FinalPacket = [EcryptedPacket, MAC], Ssh = Ssh3#ssh{send_sequence = (SeqNum+1) band 16#ffffffff}, {FinalPacket, Ssh}. @@ -1174,31 +1172,31 @@ padding_length(Size, #ssh{encrypt_block_size = BlockSize, -handle_packet_part(<<>>, Encrypted0, undefined, #ssh{decrypt = CryptoAlg} = Ssh0) -> +handle_packet_part(<<>>, Encrypted0, AEAD0, undefined, #ssh{decrypt = CryptoAlg} = Ssh0) -> %% New ssh packet case get_length(pkt_type(CryptoAlg), Encrypted0, Ssh0) of get_more -> %% too short to get the length - {get_more, <<>>, Encrypted0, undefined, Ssh0}; + {get_more, <<>>, Encrypted0, AEAD0, undefined, Ssh0}; - {ok, PacketLen, _, _, _} when PacketLen > ?SSH_MAX_PACKET_SIZE -> + {ok, PacketLen, _, _, _, _} when PacketLen > ?SSH_MAX_PACKET_SIZE -> %% far too long message than expected {error, {exceeds_max_size,PacketLen}}; - {ok, PacketLen, Decrypted, Encrypted1, + {ok, PacketLen, Decrypted, Encrypted1, AEAD, #ssh{recv_mac_size = MacSize} = Ssh1} -> %% enough bytes so we got the length and can calculate how many %% more bytes to expect for a full packet TotalNeeded = (4 + PacketLen + MacSize), - handle_packet_part(Decrypted, Encrypted1, TotalNeeded, Ssh1) + handle_packet_part(Decrypted, Encrypted1, AEAD, TotalNeeded, Ssh1) end; -handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, Ssh0) +handle_packet_part(DecryptedPfx, EncryptedBuffer, AEAD, TotalNeeded, Ssh0) when (size(DecryptedPfx)+size(EncryptedBuffer)) < TotalNeeded -> %% need more bytes to finalize the packet - {get_more, DecryptedPfx, EncryptedBuffer, TotalNeeded, Ssh0}; + {get_more, DecryptedPfx, EncryptedBuffer, AEAD, TotalNeeded, Ssh0}; -handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, +handle_packet_part(DecryptedPfx, EncryptedBuffer, AEAD, TotalNeeded, #ssh{recv_mac_size = MacSize, decrypt = CryptoAlg} = Ssh0) -> %% enough bytes to decode the packet. @@ -1216,8 +1214,7 @@ handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, {packet_decrypted, DecompressedPayload, NextPacketBytes, Ssh} end; aead -> - PacketLenBin = DecryptedPfx, - case decrypt(Ssh0, {PacketLenBin,EncryptedSfx,Mac}) of + case decrypt(Ssh0, {AEAD,EncryptedSfx,Mac}) of {Ssh1, error} -> {bad_mac, Ssh1}; {Ssh1, DecryptedSfx} -> @@ -1234,21 +1231,29 @@ get_length(common, EncryptedBuffer, #ssh{decrypt_block_size = BlockSize} = Ssh0) <<EncBlock:BlockSize/binary, EncryptedRest/binary>> = EncryptedBuffer, {Ssh, <<?UINT32(PacketLen),_/binary>> = Decrypted} = decrypt(Ssh0, EncBlock), - {ok, PacketLen, Decrypted, EncryptedRest, Ssh}; + {ok, PacketLen, Decrypted, EncryptedRest, <<>>, Ssh}; false -> get_more end; + get_length(aead, EncryptedBuffer, Ssh) -> - case size(EncryptedBuffer) >= 4 of - true -> + case {size(EncryptedBuffer) >= 4, Ssh#ssh.decrypt} of + {true, '[email protected]'} -> + <<EncryptedLen:4/binary, EncryptedRest/binary>> = EncryptedBuffer, + {Ssh1, PacketLenBin} = decrypt(Ssh, {length,EncryptedLen}), + <<?UINT32(PacketLen)>> = PacketLenBin, + {ok, PacketLen, PacketLenBin, EncryptedRest, EncryptedLen, Ssh1}; + {true, _} -> <<?UINT32(PacketLen), EncryptedRest/binary>> = EncryptedBuffer, - {ok, PacketLen, <<?UINT32(PacketLen)>>, EncryptedRest, Ssh}; - false -> + {ok, PacketLen, <<?UINT32(PacketLen)>>, EncryptedRest, <<?UINT32(PacketLen)>>, Ssh}; + {false, _} -> get_more end. + pkt_type('AEAD_AES_128_GCM') -> aead; pkt_type('AEAD_AES_256_GCM') -> aead; +pkt_type('[email protected]') -> aead; pkt_type(_) -> common. payload(<<PacketLen:32, PaddingLen:8, PayloadAndPadding/binary>>) -> @@ -1353,11 +1358,32 @@ cipher('aes192-ctr') -> cipher('aes256-ctr') -> #cipher_data{key_bytes = 32, iv_bytes = 16, - block_bytes = 16}. + block_bytes = 16}; + +cipher('[email protected]') -> % FIXME: Verify!! + #cipher_data{key_bytes = 32, + iv_bytes = 12, + block_bytes = 8}. + encrypt_init(#ssh{encrypt = none} = Ssh) -> {ok, Ssh}; +encrypt_init(#ssh{encrypt = '[email protected]', role = client} = Ssh) -> + %% [email protected] uses two independent crypto streams, one (chacha20) + %% for the length used in stream mode, and the other (chacha20-poly1305) as AEAD for + %% the payload and to MAC the length||payload. + %% See draft-josefsson-ssh-chacha20-poly1305-openssh-00 + <<K2:32/binary,K1:32/binary>> = hash(Ssh, "C", 512), + {ok, Ssh#ssh{encrypt_keys = {K1,K2} + % encrypt_block_size = 16, %default = 8. What to set it to? 64 (openssl chacha.h) + % ctx and iv is setup for each packet + }}; +encrypt_init(#ssh{encrypt = '[email protected]', role = server} = Ssh) -> + <<K2:32/binary,K1:32/binary>> = hash(Ssh, "D", 512), + {ok, Ssh#ssh{encrypt_keys = {K1,K2} + % encrypt_block_size = 16, %default = 8. What to set it to? + }}; encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> IV = hash(Ssh, "A", 12*8), <<K:16/binary>> = hash(Ssh, "C", 128), @@ -1458,18 +1484,40 @@ encrypt_final(Ssh) -> encrypt(#ssh{encrypt = none} = Ssh, Data) -> {Ssh, Data}; +encrypt(#ssh{encrypt = '[email protected]', + encrypt_keys = {K1,K2}, + send_sequence = Seq} = Ssh, + <<LenData:4/binary, PayloadData/binary>>) -> + %% Encrypt length + IV1 = <<0:8/unit:8, Seq:8/unit:8>>, + {_,EncLen} = crypto:stream_encrypt(crypto:stream_init(chacha20, K1, IV1), + LenData), + %% Encrypt payload + IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, + {_,EncPayloadData} = crypto:stream_encrypt(crypto:stream_init(chacha20, K2, IV2), + PayloadData), + + %% MAC tag + {_,PolyKey} = crypto:stream_encrypt(crypto:stream_init(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>), + <<0:32/unit:8>>), + EncBytes = <<EncLen/binary,EncPayloadData/binary>>, + Ctag = crypto:poly1305(PolyKey, EncBytes), + %% Result + {Ssh, {EncBytes,Ctag}}; encrypt(#ssh{encrypt = 'AEAD_AES_128_GCM', encrypt_keys = K, - encrypt_ctx = IV0} = Ssh, Data={_AAD,_Ptext}) -> - Enc = {_Ctext,_Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, Data), + encrypt_ctx = IV0} = Ssh, + <<LenData:4/binary, PayloadData/binary>>) -> + {Ctext,Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, {LenData,PayloadData}), IV = next_gcm_iv(IV0), - {Ssh#ssh{encrypt_ctx = IV}, Enc}; + {Ssh#ssh{encrypt_ctx = IV}, {<<LenData/binary,Ctext/binary>>,Ctag}}; encrypt(#ssh{encrypt = 'AEAD_AES_256_GCM', encrypt_keys = K, - encrypt_ctx = IV0} = Ssh, Data={_AAD,_Ptext}) -> - Enc = {_Ctext,_Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, Data), + encrypt_ctx = IV0} = Ssh, + <<LenData:4/binary, PayloadData/binary>>) -> + {Ctext,Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, {LenData,PayloadData}), IV = next_gcm_iv(IV0), - {Ssh#ssh{encrypt_ctx = IV}, Enc}; + {Ssh#ssh{encrypt_ctx = IV}, {<<LenData/binary,Ctext/binary>>,Ctag}}; encrypt(#ssh{encrypt = '3des-cbc', encrypt_keys = {K1,K2,K3}, encrypt_ctx = IV0} = Ssh, Data) -> @@ -1502,6 +1550,14 @@ encrypt(#ssh{encrypt = 'aes256-ctr', decrypt_init(#ssh{decrypt = none} = Ssh) -> {ok, Ssh}; +decrypt_init(#ssh{decrypt = '[email protected]', role = client} = Ssh) -> + <<K2:32/binary,K1:32/binary>> = hash(Ssh, "D", 512), + {ok, Ssh#ssh{decrypt_keys = {K1,K2} + }}; +decrypt_init(#ssh{decrypt = '[email protected]', role = server} = Ssh) -> + <<K2:32/binary,K1:32/binary>> = hash(Ssh, "C", 512), + {ok, Ssh#ssh{decrypt_keys = {K1,K2} + }}; decrypt_init(#ssh{decrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> IV = hash(Ssh, "B", 12*8), <<K:16/binary>> = hash(Ssh, "D", 128), @@ -1602,6 +1658,31 @@ decrypt_final(Ssh) -> decrypt(Ssh, <<>>) -> {Ssh, <<>>}; +decrypt(#ssh{decrypt = '[email protected]', + decrypt_keys = {K1,_K2}, + recv_sequence = Seq} = Ssh, {length,EncryptedLen}) -> + {_State,PacketLenBin} = + crypto:stream_decrypt(crypto:stream_init(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>), + EncryptedLen), + {Ssh, PacketLenBin}; +decrypt(#ssh{decrypt = '[email protected]', + decrypt_keys = {_K1,K2}, + recv_sequence = Seq} = Ssh, {AAD,Ctext,Ctag}) -> + %% The length is already decoded and used to divide the input + %% Check the mac (important that it is timing-safe): + {_,PolyKey} = + crypto:stream_encrypt(crypto:stream_init(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>), + <<0:32/unit:8>>), + case equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of + true -> + %% MAC is ok, decode + IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, + {_,PlainText} = + crypto:stream_decrypt(crypto:stream_init(chacha20,K2,IV2), Ctext), + {Ssh, PlainText}; + false -> + {Ssh,error} + end; decrypt(#ssh{decrypt = none} = Ssh, Data) -> {Ssh, Data}; decrypt(#ssh{decrypt = 'AEAD_AES_128_GCM', @@ -1744,7 +1825,7 @@ send_mac_init(SSH) -> Key = hash(SSH, "F", KeySize), {ok, SSH#ssh { send_mac_key = Key }} end; - aead -> + _ -> %% Not applicable {ok, SSH} end. @@ -1765,7 +1846,7 @@ recv_mac_init(SSH) -> Key = hash(SSH, "E", 8*mac_key_bytes(SSH#ssh.recv_mac)), {ok, SSH#ssh { recv_mac_key = Key }} end; - aead -> + _ -> %% Not applicable {ok, SSH} end. @@ -1812,6 +1893,7 @@ hash(K, H, Ki, N, HashAlg) -> kex_hash(SSH, Key, HashAlg, Args) -> crypto:hash(HashAlg, kex_plaintext(SSH,Key,Args)). + kex_plaintext(SSH, Key, Args) -> EncodedKey = public_key:ssh_encode(Key, ssh2_pubkey), <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version), @@ -1819,8 +1901,13 @@ kex_plaintext(SSH, Key, Args) -> ?Ebinary(EncodedKey), (kex_alg_dependent(Args))/binary>>. + +kex_alg_dependent({Q_c, Q_s, K}) when is_binary(Q_c), is_binary(Q_s) -> + %% ecdh + <<?Ebinary(Q_c), ?Ebinary(Q_s), ?Empint(K)>>; + kex_alg_dependent({E, F, K}) -> - %% diffie-hellman and ec diffie-hellman (with E = Q_c, F = Q_s) + %% diffie-hellman <<?Empint(E), ?Empint(F), ?Empint(K)>>; kex_alg_dependent({-1, NBits, -1, Prime, Gen, E, F, K}) -> @@ -1905,6 +1992,7 @@ mac_key_bytes('hmac-sha2-256')-> 32; mac_key_bytes('hmac-sha2-512')-> 64; mac_key_bytes('AEAD_AES_128_GCM') -> 0; mac_key_bytes('AEAD_AES_256_GCM') -> 0; +mac_key_bytes('[email protected]') -> 0; mac_key_bytes(none) -> 0. mac_digest_size('hmac-sha1') -> 20; @@ -1915,6 +2003,7 @@ mac_digest_size('hmac-sha2-256') -> 32; mac_digest_size('hmac-sha2-512') -> 64; mac_digest_size('AEAD_AES_128_GCM') -> 16; mac_digest_size('AEAD_AES_256_GCM') -> 16; +mac_digest_size('[email protected]') -> 16; mac_digest_size(none) -> 0. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1937,11 +2026,13 @@ parallell_gen_key(Ssh = #ssh{keyex_key = {x, {G, P}}, Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}}. +generate_key(ecdh = Algorithm, Args) -> + crypto:generate_key(Algorithm, Args); generate_key(Algorithm, Args) -> {Public,Private} = crypto:generate_key(Algorithm, Args), {crypto:bytes_to_integer(Public), crypto:bytes_to_integer(Private)}. - + compute_key(Algorithm, OthersPublic, MyPrivate, Args) -> Shared = crypto:compute_key(Algorithm, OthersPublic, MyPrivate, Args), crypto:bytes_to_integer(Shared). @@ -1978,15 +2069,10 @@ supported_algorithms(Key, BlackList) -> select_crypto_supported(L) -> - Sup = [{ec_curve,crypto_supported_curves()} | crypto:supports()], + Sup = crypto:supports(), [Name || {Name,CryptoRequires} <- L, crypto_supported(CryptoRequires, Sup)]. -crypto_supported_curves() -> - try crypto:ec_curves() - catch _:_ -> [] - end. - crypto_supported(Conditions, Supported) -> lists:all( fun({Tag,CryptoName}) when is_atom(CryptoName) -> crypto_name_supported(Tag,CryptoName,Supported); @@ -1996,7 +2082,11 @@ crypto_supported(Conditions, Supported) -> end, Conditions). crypto_name_supported(Tag, CryptoName, Supported) -> - lists:member(CryptoName, proplists:get_value(Tag,Supported,[])). + Vs = case proplists:get_value(Tag,Supported,[]) of + [] when Tag == curves -> crypto:ec_curves(); + L -> L + end, + lists:member(CryptoName, Vs). len_supported(Name, Len) -> try @@ -2027,6 +2117,20 @@ same(Algs) -> [{client2server,Algs}, {server2client,Algs}]. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Compare two binaries in a timing safe maner. +%%% The time spent in comparing should not be different depending on where in the binaries they differ. +%%% This is to avoid a certain side-channel attac. +equal_const_time(X1, X2) -> equal_const_time(X1, X2, true). + +equal_const_time(<<B1,R1/binary>>, <<B2,R2/binary>>, Truth) -> + equal_const_time(R1, R2, Truth and (B1 == B2)); +equal_const_time(<<>>, <<>>, Truth) -> + Truth; +equal_const_time(_, _, _) -> + false. + +%%%-------- Remove CR, LF and following characters from a line + trim_tail(Str) -> lists:takewhile(fun(C) -> C=/=$\r andalso C=/=$\n diff --git a/lib/ssh/test/ssh_bench_SUITE.erl b/lib/ssh/test/ssh_bench_SUITE.erl index b6c6147646..441cf97234 100644 --- a/lib/ssh/test/ssh_bench_SUITE.erl +++ b/lib/ssh/test/ssh_bench_SUITE.erl @@ -65,10 +65,10 @@ init_per_suite(Config) -> {preferred_algorithms, Algs}, {modify_algorithms,[{prepend,[{cipher,[none]}, {mac,[none]} - ]}, - {rm, [{cipher,['[email protected]', - '[email protected]']} - ]} + ]} + %% ,{rm, [{cipher,['[email protected]', + %% '[email protected]']} + %% ]} ]}, {max_random_length_padding, 0}, {subsystems, [{"/dev/null", {ssh_bench_dev_null,[DataSize]}}]} @@ -152,7 +152,8 @@ transfer_text(Config) -> || {Crypto,Mac} <- [{ none, none}, {'aes128-ctr', 'hmac-sha1'}, {'aes256-ctr', 'hmac-sha1'}, -%% {'[email protected]', 'hmac-sha1'}, +{'[email protected]', 'hmac-sha1'}, +{'[email protected]', 'hmac-sha1'}, {'aes128-cbc', 'hmac-sha1'}, {'3des-cbc', 'hmac-sha1'}, {'aes128-ctr', 'hmac-sha2-256'}, @@ -182,29 +183,31 @@ gen_data(DataSz) -> %% {suite, ?MODULE}, %% {name, mk_name(["Transfer 1M bytes ",Cipher,"/",Mac," [µs]"])}]); connect_measure(Port, Cipher, Mac, Data, Options) -> - AES_GCM = {cipher,['[email protected]', - '[email protected]']}, + AES_GCM = {cipher, + []}, + %% ['[email protected]', + %% '[email protected]']}, AlgOpt = case {Cipher,Mac} of {none,none} -> [{modify_algorithms,[{prepend, [{cipher,[Cipher]}, - {mac,[Mac]}]}, - {rm,[AES_GCM]} + {mac,[Mac]}]} +%%% ,{rm,[AES_GCM]} ]}]; {none,_} -> - [{modify_algorithms,[{prepend, [{cipher,[Cipher]}]}, - {rm,[AES_GCM]} + [{modify_algorithms,[{prepend, [{cipher,[Cipher]}]} +%%% ,{rm,[AES_GCM]} ]}, {preferred_algorithms, [{mac,[Mac]}]}]; {_,none} -> - [{modify_algorithms,[{prepend, [{mac,[Mac]}]}, - {rm,[AES_GCM]} + [{modify_algorithms,[{prepend, [{mac,[Mac]}]} +%%% ,{rm,[AES_GCM]} ]}, {preferred_algorithms, [{cipher,[Cipher]}]}]; _ -> [{preferred_algorithms, [{cipher,[Cipher]}, - {mac,[Mac]}]}, - {modify_algorithms, [{rm,[AES_GCM]}]} + {mac,[Mac]}]} +%%% ,{modify_algorithms, [{rm,[AES_GCM]}]} ] end, Times = diff --git a/lib/ssh/test/ssh_dbg_SUITE.erl b/lib/ssh/test/ssh_dbg_SUITE.erl index 5439817d10..ab7918fa90 100644 --- a/lib/ssh/test/ssh_dbg_SUITE.erl +++ b/lib/ssh/test/ssh_dbg_SUITE.erl @@ -38,11 +38,20 @@ suite() -> {timetrap,{seconds,60}}]. all() -> - [basic, - dbg_alg_terminate, - dbg_ssh_messages, - dbg_connections, - dbg_channels + [{group, dbg}, + {group, circ_buf} + ]. + +groups() -> + [{dbg, [], [dbg_basic, + dbg_alg_terminate, + dbg_ssh_messages, + dbg_connections, + dbg_channels]}, + {circ_buf, [], [cb_basic, + cb_print, + cb_macros_print + ]} ]. %%-------------------------------------------------------------------- @@ -82,7 +91,7 @@ end_per_testcase(_TC, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -basic(_Config) -> +dbg_basic(_Config) -> L0 = ssh_dbg:start(), true = is_pid(whereis(ssh_dbg)), true = is_list(L0), @@ -342,6 +351,53 @@ dbg_channels(Config) -> stop_and_fail_if_unhandled_dbg_msgs(Ref, [C,D], Pid). %%-------------------------------------------------------------------- +cb_basic(_Config) -> + %% Check that the circular buffer is disabled at start: + [] = ssh_dbg:cbuf_list(), + disabled = ssh_dbg:cbuf_in(anything), + [] = ssh_dbg:cbuf_list(), + %% Start it and enter three values, first is duplicated; + ok = ssh_dbg:cbuf_start(3), + ok = ssh_dbg:cbuf_in(v1), + ok = ssh_dbg:cbuf_in(v1), + ok = ssh_dbg:cbuf_in(v2), + ok = ssh_dbg:cbuf_in(v3), + [{v3,_,1}, {v2,_,1}, {v1,_,2}] = ssh_dbg:cbuf_list(), + %% Check that a fourth value erase the first entered: + ok = ssh_dbg:cbuf_in(v4), + [{v4,_,1}, {v3,_,1}, {v2,_,1}] = ssh_dbg:cbuf_list(), + %% Check that entering a value that is in the tail but not in the head is treated as a new value: + ok = ssh_dbg:cbuf_in(v2), + [{v2,_,1}, {v4,_,1}, {v3,_,1}] = ssh_dbg:cbuf_list(), + %% Stop and check that the buffer is returned: + [{v2,_,1}, {v4,_,1}, {v3,_,1}] = ssh_dbg:cbuf_stop_clear(), + %% Stopping a stopped buffer returns empty: + [] = ssh_dbg:cbuf_stop_clear(), + %% Check that a value can't be entered in a stopped buffer: + disabled = ssh_dbg:cbuf_in(v2). + +%%-------------------------------------------------------------------- +cb_print(_Config) -> + ssh_dbg:cbuf_start(), + [begin + ssh_dbg:cbuf_in(V), + ct:log("Enter ~p",[V]) + end || V <- lists:seq(1,10)], + ct:log("~s",[ssh_dbg:fmt_cbuf_items()]), + ssh_dbg:cbuf_stop_clear(). + +%%-------------------------------------------------------------------- +cb_macros_print(_Config) -> + ssh_dbg:cbuf_start(), + [begin + V = {test,V0}, + ?CIRC_BUF_IN(V), + ct:log("Enter ~p",[V]) + end || V0 <- lists:seq(1,5)], + ct:log("~s",[ssh_dbg:fmt_cbuf_items()]), + ssh_dbg:cbuf_stop_clear(). + +%%-------------------------------------------------------------------- %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 917df03b5b..42cc499fc2 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,23 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.0.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct cipher suite handling for ECDHE_*, the incorrect + handling could cause an incorrrect suite to be selected + and most likly fail the handshake.</p> + <p> + Own Id: OTP-15203</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.0</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -170,6 +187,58 @@ </section> +<section><title>SSL 8.2.6.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct handling of empty server SNI extension</p> + <p> + Own Id: OTP-15168</p> + </item> + <item> + <p> + Correct cipher suite handling for ECDHE_*, the incorrect + handling could cause an incorrrect suite to be selected + and most likly fail the handshake.</p> + <p> + Own Id: OTP-15203</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 8.2.6.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Improve cipher suite handling correcting ECC and TLS-1.2 + requierments. Backport of solution for ERL-641</p> + <p> + Own Id: OTP-15178</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Option keyfile defaults to certfile and should be trumped + with key. This failed for engine keys.</p> + <p> + Own Id: OTP-15193</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 8.2.6</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -339,7 +408,7 @@ <p> TLS sessions must be registered with SNI if provided, so that sessions where client hostname verification would - fail can not connect reusing a session created when the + fail cannot connect reusing a session created when the server name verification succeeded.</p> <p> Own Id: OTP-14632</p> @@ -517,7 +586,7 @@ public_key:pkix_verify_hostname/2 to verify the hostname of the connection with the server certificates specified hostname during certificate path validation. The user may - explicitly disables it. Also if the hostname can not be + explicitly disables it. Also if the hostname cannot be derived from the first argument to connect or is not supplied by the server name indication option, the check will not be performed.</p> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 7ce682e28c..6efa022a79 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -200,14 +200,14 @@ | sect163r1 | sect163r2 | secp160k1 | secp160r1 | secp160r2</c></p></item> <tag><c>hello_extensions() =</c></tag> - <item><p><c>#{renegotiation_info => + <item><p><c>#{renegotiation_info => binary() | undefined, signature_algs => [{hash(), ecsda| rsa| dsa}] | undefined alpn => binary() | undefined, - next_protocol_negotiation, + next_protocol_negotiation => binary() | undefined, srp => string() | undefined, - ec_point_formats , - elliptic_curves = [oid] | undefined - sni = string()} + ec_point_formats => list() | undefined, + elliptic_curves => [oid] | undefined, + sni => string() | undefined} }</c></p></item> @@ -410,7 +410,7 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid <item>check is only performed on the peer certificate.</item> <tag><c>best_effort</c></tag> - <item>if certificate revocation status can not be determined + <item>if certificate revocation status cannot be determined it will be accepted as valid.</item> </taglist> diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index e14f3f90dc..1774bd8f77 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -191,7 +191,7 @@ Eshell V5.0 (abort with ^G) Any available SSL/TLS option can be specified in an options file, but note that options that take a <c>fun()</c> has to use the syntax <c>fun Mod:Func/Arity</c> since a function - body can not be compiled when consulting a file. + body cannot be compiled when consulting a file. </p> <p> Do not tamper with the socket options diff --git a/lib/ssl/examples/src/client_server.erl b/lib/ssl/examples/src/client_server.erl index c150f43bff..7a266f544d 100644 --- a/lib/ssl/examples/src/client_server.erl +++ b/lib/ssl/examples/src/client_server.erl @@ -39,15 +39,15 @@ start() -> %% Accept {ok, ASock} = ssl:transport_accept(LSock), - ok = ssl:ssl_accept(ASock), + {ok, SslSocket} = ssl:handshake(ASock), io:fwrite("Accept: accepted.~n"), - {ok, Cert} = ssl:peercert(ASock), + {ok, Cert} = ssl:peercert(SslSocket), io:fwrite("Accept: peer cert:~n~p~n", [public_key:pkix_decode_cert(Cert, otp)]), io:fwrite("Accept: sending \"hello\".~n"), - ssl:send(ASock, "hello"), - {error, closed} = ssl:recv(ASock, 0), + ssl:send(SslSocket, "hello"), + {error, closed} = ssl:recv(SslSocket, 0), io:fwrite("Accept: detected closed.~n"), - ssl:close(ASock), + ssl:close(SslSocket), io:fwrite("Listen: closing and terminating.~n"), ssl:close(LSock), @@ -75,7 +75,7 @@ mk_opts(Role) -> [{active, false}, {verify, 2}, {depth, 2}, + {server_name_indication, disable}, {cacertfile, filename:join([Dir, Role, "cacerts.pem"])}, {certfile, filename:join([Dir, Role, "cert.pem"])}, {keyfile, filename:join([Dir, Role, "key.pem"])}]. - diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 1db18d4e5a..af36d04a99 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -44,8 +44,6 @@ BEHAVIOUR_MODULES= \ MODULES= \ ssl \ - tls \ - dtls \ ssl_alert \ ssl_app \ ssl_sup \ @@ -64,12 +62,15 @@ MODULES= \ ssl_certificate\ ssl_pkix_db\ ssl_cipher \ + ssl_cipher_format \ ssl_srp_primes \ tls_connection \ dtls_connection \ + tls_sender\ ssl_config \ ssl_connection \ tls_handshake \ + tls_handshake_1_3\ dtls_handshake\ ssl_handshake\ ssl_manager \ @@ -92,8 +93,9 @@ MODULES= \ INTERNAL_HRL_FILES = \ ssl_alert.hrl ssl_cipher.hrl \ tls_connection.hrl dtls_connection.hrl ssl_connection.hrl \ - ssl_handshake.hrl tls_handshake.hrl dtls_handshake.hrl ssl_api.hrl ssl_internal.hrl \ - ssl_record.hrl tls_record.hrl dtls_record.hrl ssl_srp.hrl + ssl_handshake.hrl tls_handshake.hrl tls_handshake_1_3.hrl dtls_handshake.hrl \ + ssl_api.hrl ssl_internal.hrl \ + ssl_record.hrl tls_record.hrl dtls_record.hrl ssl_srp.hrl ERL_FILES= \ $(MODULES:%=%.erl) \ @@ -170,6 +172,7 @@ $(EBIN)/tls_connection.$(EMULATOR): ssl_internal.hrl tls_connection.hrl tls_reco $(EBIN)/dtls_connection.$(EMULATOR): ssl_internal.hrl dtls_connection.hrl dtls_record.hrl ssl_cipher.hrl dtls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl $(EBIN)/tls_handshake.$(EMULATOR): ssl_internal.hrl tls_record.hrl ssl_cipher.hrl tls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl $(EBIN)/tls_handshake.$(EMULATOR): ssl_internal.hrl ssl_connection.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl +$(EBIN)/tls_handshake_1_3.$(EMULATOR): tls_handshake_1_3.hrl tls_handshake.hrl ssl_internal.hrl $(EBIN)/ssl_manager.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl ../../kernel/include/file.hrl $(EBIN)/ssl_record.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl $(EBIN)/ssl_session.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl diff --git a/lib/ssl/src/dtls.erl b/lib/ssl/src/dtls.erl deleted file mode 100644 index cd705152a8..0000000000 --- a/lib/ssl/src/dtls.erl +++ /dev/null @@ -1,113 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% 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. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%%% Purpose : Reflect DTLS specific API options (fairly simple wrapper at the moment) -%% First implementation will support DTLS connections only in a "TLS/TCP like way" - --module(dtls). - --include("ssl_api.hrl"). --include("ssl_internal.hrl"). - --export([connect/2, connect/3, listen/2, accept/1, accept/2, - handshake/1, handshake/2, handshake/3]). - -%%-------------------------------------------------------------------- -%% -%% Description: Connect to a DTLS server. -%%-------------------------------------------------------------------- - --spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | - {error, reason()}. - -connect(Socket, Options) when is_port(Socket) -> - connect(Socket, Options, infinity). - --spec connect(host() | port(), [connect_option()] | inet:port_number(), - timeout() | list()) -> - {ok, #sslsocket{}} | {error, reason()}. - -connect(Socket, SslOptions, Timeout) when is_port(Socket) -> - DTLSOpts = [{protocol, dtls} | SslOptions], - ssl:connect(Socket, DTLSOpts, Timeout); -connect(Host, Port, Options) -> - connect(Host, Port, Options, infinity). - --spec connect(host() | port(), inet:port_number(), list(), timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. - -connect(Host, Port, Options, Timeout) -> - DTLSOpts = [{protocol, dtls} | Options], - ssl:connect(Host, Port, DTLSOpts, Timeout). - -%%-------------------------------------------------------------------- --spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}. - -%% -%% Description: Creates an ssl listen socket. -%%-------------------------------------------------------------------- -listen(Port, Options) -> - DTLSOpts = [{protocol, dtls} | Options], - ssl:listen(Port, DTLSOpts). - -%%-------------------------------------------------------------------- -%% -%% Description: Performs transport accept on an ssl listen socket -%%-------------------------------------------------------------------- --spec accept(#sslsocket{}) -> {ok, #sslsocket{}} | - {error, reason()}. -accept(ListenSocket) -> - accept(ListenSocket, infinity). - --spec accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {error, reason()}. -accept(Socket, Timeout) -> - ssl:transport_accept(Socket, Timeout). - -%%-------------------------------------------------------------------- -%% -%% Description: Performs accept on an ssl listen socket. e.i. performs -%% ssl handshake. -%%-------------------------------------------------------------------- - --spec handshake(#sslsocket{}) -> ok | {error, reason()}. - -handshake(ListenSocket) -> - handshake(ListenSocket, infinity). - - --spec handshake(#sslsocket{} | port(), timeout()| [ssl_option() - | transport_option()]) -> - ok | {ok, #sslsocket{}} | {error, reason()}. - -handshake(#sslsocket{} = Socket, Timeout) -> - ssl:ssl_accept(Socket, Timeout); - -handshake(ListenSocket, SslOptions) when is_port(ListenSocket) -> - handshake(ListenSocket, SslOptions, infinity). - - --spec handshake(port(), [ssl_option()| transport_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. - -handshake(Socket, SslOptions, Timeout) when is_port(Socket) -> - ssl:ssl_accept(Socket, SslOptions, Timeout). diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index c0e81d6a28..b05e4b7f24 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -37,7 +37,7 @@ %% Internal application API %% Setup --export([start_fsm/8, start_link/7, init/1]). +-export([start_fsm/8, start_link/7, init/1, pids/1]). %% State transition handling -export([next_record/1, next_event/3, next_event/4, handle_common_event/4]). @@ -45,10 +45,10 @@ %% Handshake handling -export([renegotiate/2, send_handshake/2, queue_handshake/2, queue_change_cipher/2, - reinit_handshake_data/1, select_sni_extension/1, empty_connection_state/2]). + reinit/1, reinit_handshake_data/1, select_sni_extension/1, empty_connection_state/2]). %% Alert and close handling --export([encode_alert/3,send_alert/2, close/5, protocol_name/0]). +-export([encode_alert/3, send_alert/2, send_alert_in_connection/2, close/5, protocol_name/0]). %% Data handling -export([encode_data/3, passive_receive/2, next_record_if_active/1, @@ -73,7 +73,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} try {ok, Pid} = dtls_connection_sup:start_child([Role, Host, Port, Socket, Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, [Pid], CbModule, Tracker), ssl_connection:handshake(SslSocket, Timeout) catch error:{badmatch, {error, _} = Error} -> @@ -101,6 +101,10 @@ init([Role, Host, Port, Socket, Options, User, CbInfo]) -> EState = State0#state{protocol_specific = Map#{error => Error}}, gen_statem:enter_loop(?MODULE, [], error, EState) end. + +pids(_) -> + [self()]. + %%==================================================================== %% State transition handling %%==================================================================== @@ -329,10 +333,14 @@ queue_change_cipher(ChangeCipher, #state{flight_buffer = Flight, dtls_record:next_epoch(ConnectionStates0, write), State#state{flight_buffer = Flight#{change_cipher_spec => ChangeCipher}, connection_states = ConnectionStates}. + +reinit(State) -> + %% To be API compatible with TLS NOOP here + reinit_handshake_data(State). reinit_handshake_data(#state{protocol_buffers = Buffers} = State) -> State#state{premaster_secret = undefined, public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history(), + tls_handshake_history = ssl_handshake:init_handshake_history(), flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, flight_buffer = new_flight(), protocol_buffers = @@ -366,6 +374,10 @@ send_alert(Alert, #state{negotiated_version = Version, send(Transport, Socket, BinMsg), State0#state{connection_states = ConnectionStates}. +send_alert_in_connection(Alert, State) -> + _ = send_alert(Alert, State), + ok. + close(downgrade, _,_,_,_) -> ok; %% Other @@ -711,6 +723,12 @@ connection(internal, #client_hello{}, #state{role = server, allow_renegotiate = State1 = send_alert(Alert, State0), {Record, State} = ssl_connection:prepare_connection(State1, ?MODULE), next_event(?FUNCTION_NAME, Record, State); +connection({call, From}, {application_data, Data}, State) -> + try + send_application_data(Data, From, ?FUNCTION_NAME, State) + catch throw:Error -> + ssl_connection:hibernate_after(?FUNCTION_NAME, State, [{reply, From, Error}]) + end; connection(Type, Event, State) -> ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). @@ -1132,3 +1150,42 @@ log_ignore_alert(debug, StateName, Alert, Role) -> [Role, StateName, Txt]); log_ignore_alert(_, _, _, _) -> ok. + +send_application_data(Data, From, _StateName, + #state{socket = Socket, + negotiated_version = Version, + protocol_cb = Connection, + transport_cb = Transport, + connection_states = ConnectionStates0, + ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State0) -> + + case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of + true -> + renegotiate(State0#state{renegotiation = {true, internal}}, + [{next_event, {call, From}, {application_data, Data}}]); + false -> + {Msgs, ConnectionStates} = + Connection:encode_data(Data, Version, ConnectionStates0), + State = State0#state{connection_states = ConnectionStates}, + case Connection:send(Transport, Socket, Msgs) of + ok -> + ssl_connection:hibernate_after(connection, State, [{reply, From, ok}]); + Result -> + ssl_connection:hibernate_after(connection, State, [{reply, From, Result}]) + end + end. + +time_to_renegotiate(_Data, + #{current_write := #{sequence_number := Num}}, + RenegotiateAt) -> + + %% We could do test: + %% is_time_to_renegotiate((erlang:byte_size(_Data) div + %% ?MAX_PLAIN_TEXT_LENGTH) + 1, RenegotiateAt), but we chose to + %% have a some what lower renegotiateAt and a much cheaper test + is_time_to_renegotiate(Num, RenegotiateAt). + +is_time_to_renegotiate(N, M) when N < M-> + false; +is_time_to_renegotiate(_,_) -> + true. diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 35c213a182..3f70eaec8a 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -194,7 +194,7 @@ handle_client_hello(Version, no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - #{key_exchange := KeyExAlg} = ssl_cipher:suite_definition(CipherSuite), + #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_definition(CipherSuite), case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, SupportedHashSigns, TLSVersion) of #alert{} = Alert -> diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl index 50e92027d2..a16489bbd1 100644 --- a/lib/ssl/src/dtls_handshake.hrl +++ b/lib/ssl/src/dtls_handshake.hrl @@ -56,4 +56,11 @@ fragment }). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% RFC 7764 Datagram Transport Layer Security (DTLS) Extension to Establish Keys +%% for the Secure Real-time Transport Protocol (SRTP) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Not supported +-define(USE_SRTP, 14). + -endif. % -ifdef(dtls_handshake). diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl index b26d3ae41a..2001afd02f 100644 --- a/lib/ssl/src/dtls_socket.erl +++ b/lib/ssl/src/dtls_socket.erl @@ -48,7 +48,7 @@ accept(dtls, #config{transport_info = {Transport,_,_,_}, dtls_handler = {Listner, _}}, _Timeout) -> case dtls_packet_demux:accept(Listner, self()) of {ok, Pid, Socket} -> - {ok, socket(Pid, Transport, {Listner, Socket}, ConnectionCb)}; + {ok, socket([Pid], Transport, {Listner, Socket}, ConnectionCb)}; {error, Reason} -> {error, Reason} end. @@ -73,12 +73,12 @@ close(gen_udp, {_Client, _Socket}) -> close(Transport, {_Client, Socket}) -> Transport:close(Socket). -socket(Pid, gen_udp = Transport, {{_, _}, Socket}, ConnectionCb) -> - #sslsocket{pid = Pid, +socket(Pids, gen_udp = Transport, {{_, _}, Socket}, ConnectionCb) -> + #sslsocket{pid = Pids, %% "The name "fd" is keept for backwards compatibility fd = {Transport, Socket, ConnectionCb}}; -socket(Pid, Transport, Socket, ConnectionCb) -> - #sslsocket{pid = Pid, +socket(Pids, Transport, Socket, ConnectionCb) -> + #sslsocket{pid = Pids, %% "The name "fd" is keept for backwards compatibility fd = {Transport, Socket, ConnectionCb}}. setopts(_, #sslsocket{pid = {dtls, #config{dtls_handler = {ListenPid, _}}}}, Options) -> diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index df687f579b..b365961a6a 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -27,22 +27,22 @@ -define(COOKIE_BASE_TIMEOUT, 30000). --spec suites(Minor:: 253|255) -> [ssl_cipher:cipher_suite()]. +-spec suites(Minor:: 253|255) -> [ssl_cipher_format:cipher_suite()]. suites(Minor) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) end, tls_v1:suites(corresponding_minor_tls_version(Minor))). all_suites(Version) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) end, ssl_cipher:all_suites(corresponding_tls_version(Version))). anonymous_suites(Version) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) end, ssl_cipher:anonymous_suites(corresponding_tls_version(Version))). diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 1194f4fc72..7f1a77f601 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -70,14 +70,14 @@ is_node_name(Node) -> %% ------------------------------------------------------------------------- -hs_data_common(#sslsocket{pid = DistCtrl} = SslSocket) -> +hs_data_common(#sslsocket{pid = [_, DistCtrl|_]} = SslSocket) -> #hs_data{ f_send = - fun (Ctrl, Packet) when Ctrl == DistCtrl -> + fun (_Ctrl, Packet) -> f_send(SslSocket, Packet) end, f_recv = - fun (Ctrl, Length, Timeout) when Ctrl == DistCtrl -> + fun (_, Length, Timeout) -> f_recv(SslSocket, Length, Timeout) end, f_setopts_pre_nodeup = @@ -176,8 +176,7 @@ mf_getopts(SslSocket, Opts) -> ssl:getopts(SslSocket, Opts). f_handshake_complete(DistCtrl, Node, DHandle) -> - ssl_connection:handshake_complete(DistCtrl, Node, DHandle). - + tls_sender:dist_handshake_complete(DistCtrl, Node, DHandle). setopts_filter(Opts) -> [Opt || {K,_} = Opt <- Opts, @@ -245,7 +244,7 @@ accept_loop(Driver, Listen, Kernel, Socket) -> trace([{active, false},{packet, 4}|Opts]), net_kernel:connecttime()) of - {ok, #sslsocket{pid = DistCtrl} = SslSocket} -> + {ok, #sslsocket{pid = [_, DistCtrl| _]} = SslSocket} -> trace( Kernel ! {accept, self(), DistCtrl, @@ -405,7 +404,7 @@ gen_accept_connection( do_accept( _Driver, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime, Kernel) -> - SslSocket = ssl_connection:get_sslsocket(DistCtrl), + {ok, SslSocket} = tls_sender:dist_tls_socket(DistCtrl), receive {AcceptPid, controller} -> Timer = dist_util:start_timer(SetupTime), @@ -530,7 +529,7 @@ do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNo [binary, {active, false}, {packet, 4}, Driver:family(), nodelay()] ++ Opts, net_kernel:connecttime()) of - {ok, #sslsocket{pid = DistCtrl} = SslSocket} -> + {ok, #sslsocket{pid = [_, DistCtrl| _]} = SslSocket} -> _ = monitor_pid(DistCtrl), ok = ssl:controlling_process(SslSocket, self()), HSData0 = hs_data_common(SslSocket), diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 9679ea4687..17173d7c79 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -5,11 +5,13 @@ %% TLS/SSL tls_connection, tls_handshake, + tls_handshake_1_3, tls_record, tls_socket, tls_v1, ssl_v3, tls_connection_sup, + tls_sender, %% DTLS dtls_connection, dtls_handshake, @@ -21,8 +23,6 @@ dtls_listener_sup, %% API ssl, %% Main API - tls, %% TLS specific - dtls, %% DTLS specific ssl_session_cache_api, %% Both TLS/SSL and DTLS ssl_config, @@ -30,6 +30,7 @@ ssl_handshake, ssl_record, ssl_cipher, + ssl_cipher_format, ssl_srp_primes, ssl_alert, ssl_listen_tracker_sup, %% may be used by DTLS over SCTP diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index bfdd0c205b..ae4d60b6ed 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", - [ +[ + {<<"9\\..*">>, [{restart_application, ssl}]}, {<<"8\\..*">>, [{restart_application, ssl}]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, @@ -9,6 +10,7 @@ {<<"3\\..*">>, [{restart_application, ssl}]} ], [ + {<<"9\\..*">>, [{restart_application, ssl}]}, {<<"8\\..*">>, [{restart_application, ssl}]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index c7f1f36d5d..ef9aac34bf 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -241,7 +241,7 @@ handshake(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when catch Error = {error, _Reason} -> Error end; -handshake(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when +handshake(#sslsocket{pid = [Pid|_], fd = {_, _, _}} = Socket, SslOpts, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> try {ok, EmOpts, _} = dtls_packet_demux:get_all_opts(Pid), @@ -301,7 +301,7 @@ handshake_cancel(Socket) -> %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- -close(#sslsocket{pid = Pid}) when is_pid(Pid) -> +close(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> ssl_connection:close(Pid, {close, ?DEFAULT_TIMEOUT}); close(#sslsocket{pid = {dtls, #config{dtls_handler = {Pid, _}}}}) -> dtls_packet_demux:close(Pid); @@ -313,12 +313,12 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _} %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- -close(#sslsocket{pid = TLSPid}, +close(#sslsocket{pid = [TLSPid|_]}, {Pid, Timeout} = DownGrade) when is_pid(TLSPid), is_pid(Pid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:close(TLSPid, {close, DownGrade}); -close(#sslsocket{pid = TLSPid}, Timeout) when is_pid(TLSPid), +close(#sslsocket{pid = [TLSPid|_]}, Timeout) when is_pid(TLSPid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:close(TLSPid, {close, Timeout}); close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}, _) -> @@ -329,8 +329,10 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _} %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- -send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> +send(#sslsocket{pid = [Pid]}, Data) when is_pid(Pid) -> ssl_connection:send(Pid, Data); +send(#sslsocket{pid = [_, Pid]}, Data) when is_pid(Pid) -> + tls_sender:send_data(Pid, erlang:iolist_to_binary(Data)); send(#sslsocket{pid = {_, #config{transport_info={_, udp, _, _}}}}, _) -> {error,enotconn}; %% Emulate connection behaviour send(#sslsocket{pid = {dtls,_}}, _) -> @@ -346,7 +348,7 @@ send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _} %%-------------------------------------------------------------------- recv(Socket, Length) -> recv(Socket, Length, infinity). -recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid), +recv(#sslsocket{pid = [Pid|_]}, Length, Timeout) when is_pid(Pid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_connection:recv(Pid, Length, Timeout); recv(#sslsocket{pid = {dtls,_}}, _, _) -> @@ -361,7 +363,7 @@ recv(#sslsocket{pid = {Listen, %% Description: Changes process that receives the messages when active = true %% or once. %%-------------------------------------------------------------------- -controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> +controlling_process(#sslsocket{pid = [Pid|_]}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> ssl_connection:new_user(Pid, NewOwner); controlling_process(#sslsocket{pid = {dtls, _}}, NewOwner) when is_pid(NewOwner) -> @@ -379,7 +381,7 @@ controlling_process(#sslsocket{pid = {Listen, %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- -connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) -> +connection_information(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> case ssl_connection:connection_information(Pid, false) of {ok, Info} -> {ok, [Item || Item = {_Key, Value} <- Info, Value =/= undefined]}; @@ -396,7 +398,7 @@ connection_information(#sslsocket{pid = {dtls,_}}) -> %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- -connection_information(#sslsocket{pid = Pid}, Items) when is_pid(Pid) -> +connection_information(#sslsocket{pid = [Pid|_]}, Items) when is_pid(Pid) -> case ssl_connection:connection_information(Pid, include_security_info(Items)) of {ok, Info} -> {ok, [Item || Item = {Key, Value} <- Info, lists:member(Key, Items), @@ -410,9 +412,9 @@ connection_information(#sslsocket{pid = Pid}, Items) when is_pid(Pid) -> %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- -peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid)-> +peername(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _}}) when is_pid(Pid)-> dtls_socket:peername(Transport, Socket); -peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> +peername(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> tls_socket:peername(Transport, Socket); peername(#sslsocket{pid = {dtls, #config{dtls_handler = {_Pid, _}}}}) -> dtls_socket:peername(dtls, undefined); @@ -426,7 +428,7 @@ peername(#sslsocket{pid = {dtls,_}}) -> %% %% Description: Returns the peercert. %%-------------------------------------------------------------------- -peercert(#sslsocket{pid = Pid}) when is_pid(Pid) -> +peercert(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> case ssl_connection:peer_certificate(Pid) of {ok, undefined} -> {error, no_peercert}; @@ -444,33 +446,33 @@ peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> %% Description: Returns the protocol that has been negotiated. If no %% protocol has been negotiated will return {error, protocol_not_negotiated} %%-------------------------------------------------------------------- -negotiated_protocol(#sslsocket{pid = Pid}) -> +negotiated_protocol(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> ssl_connection:negotiated_protocol(Pid). %%-------------------------------------------------------------------- --spec cipher_suites() -> [ssl_cipher:old_erl_cipher_suite()] | [string()]. +-spec cipher_suites() -> [ssl_cipher_format:old_erl_cipher_suite()] | [string()]. %%-------------------------------------------------------------------- cipher_suites() -> cipher_suites(erlang). %%-------------------------------------------------------------------- -spec cipher_suites(erlang | openssl | all) -> - [ssl_cipher:old_erl_cipher_suite() | string()]. + [ssl_cipher_format:old_erl_cipher_suite() | string()]. %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- cipher_suites(erlang) -> - [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(default)]; + [ssl_cipher_format:erl_suite_definition(Suite) || Suite <- available_suites(default)]; cipher_suites(openssl) -> - [ssl_cipher:openssl_suite_name(Suite) || + [ssl_cipher_format:openssl_suite_name(Suite) || Suite <- available_suites(default)]; cipher_suites(all) -> - [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(all)]. + [ssl_cipher_format:erl_suite_definition(Suite) || Suite <- available_suites(all)]. %%-------------------------------------------------------------------- -spec cipher_suites(default | all | anonymous, tls_record:tls_version() | dtls_record:dtls_version() | tls_record:tls_atom_version() | dtls_record:dtls_atom_version()) -> - [ssl_cipher:erl_cipher_suite()]. + [ssl_cipher_format:erl_cipher_suite()]. %% Description: Returns all default and all supported cipher suites for a %% TLS/DTLS version %%-------------------------------------------------------------------- @@ -483,12 +485,12 @@ cipher_suites(Base, Version) when Version == 'dtlsv1.2'; Version == 'dtlsv1'-> cipher_suites(Base, dtls_record:protocol_version(Version)); cipher_suites(Base, Version) -> - [ssl_cipher:suite_definition(Suite) || Suite <- supported_suites(Base, Version)]. + [ssl_cipher_format:suite_definition(Suite) || Suite <- supported_suites(Base, Version)]. %%-------------------------------------------------------------------- --spec filter_cipher_suites([ssl_cipher:erl_cipher_suite()], +-spec filter_cipher_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()], [{key_exchange | cipher | mac | prf, fun()}] | []) -> - [ssl_cipher:erl_cipher_suite()]. + [ssl_cipher_format:erl_cipher_suite() ] | [ssl_cipher_format:cipher_suite()]. %% Description: Removes cipher suites if any of the filter functions returns false %% for any part of the cipher suite. This function also calls default filter functions %% to make sure the cipher suite are supported by crypto. @@ -505,10 +507,10 @@ filter_cipher_suites(Suites, Filters0) -> prf_filters => add_filter(proplists:get_value(prf, Filters0), PrfF)}, ssl_cipher:filter_suites(Suites, Filters). %%-------------------------------------------------------------------- --spec prepend_cipher_suites([ssl_cipher:erl_cipher_suite()] | +-spec prepend_cipher_suites([ssl_cipher_format:erl_cipher_suite()] | [{key_exchange | cipher | mac | prf, fun()}], - [ssl_cipher:erl_cipher_suite()]) -> - [ssl_cipher:erl_cipher_suite()]. + [ssl_cipher_format:erl_cipher_suite()]) -> + [ssl_cipher_format:erl_cipher_suite()]. %% Description: Make <Preferred> suites become the most prefered %% suites that is put them at the head of the cipher suite list %% and remove them from <Suites> if present. <Preferred> may be a @@ -523,10 +525,10 @@ prepend_cipher_suites(Filters, Suites) -> Preferred = filter_cipher_suites(Suites, Filters), Preferred ++ (Suites -- Preferred). %%-------------------------------------------------------------------- --spec append_cipher_suites(Deferred :: [ssl_cipher:erl_cipher_suite()] | +-spec append_cipher_suites(Deferred :: [ssl_cipher_format:erl_cipher_suite()] | [{key_exchange | cipher | mac | prf, fun()}], - [ssl_cipher:erl_cipher_suite()]) -> - [ssl_cipher:erl_cipher_suite()]. + [ssl_cipher_format:erl_cipher_suite()]) -> + [ssl_cipher_format:erl_cipher_suite()]. %% Description: Make <Deferred> suites suites become the %% least prefered suites that is put them at the end of the cipher suite list %% and removed them from <Suites> if present. @@ -581,7 +583,7 @@ eccs_filter_supported(Curves) -> %% %% Description: Gets options %%-------------------------------------------------------------------- -getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> +getopts(#sslsocket{pid = [Pid|_]}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); getopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> try dtls_socket:getopts(Transport, ListenSocket, OptionTags) of @@ -612,7 +614,7 @@ getopts(#sslsocket{}, OptionTags) -> %% %% Description: Sets options %%-------------------------------------------------------------------- -setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> +setopts(#sslsocket{pid = [Pid|_]}, Options0) when is_pid(Pid), is_list(Options0) -> try proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Options0) of Options -> @@ -667,7 +669,7 @@ getstat(Socket) -> getstat(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, Options) when is_port(Listen), is_list(Options) -> tls_socket:getstat(Transport, Listen, Options); -getstat(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}, Options) when is_pid(Pid), is_list(Options) -> +getstat(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}, Options) when is_pid(Pid), is_list(Options) -> tls_socket:getstat(Transport, Socket, Options). %%--------------------------------------------------------------- @@ -680,7 +682,7 @@ shutdown(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}} Transport:shutdown(Listen, How); shutdown(#sslsocket{pid = {dtls,_}},_) -> {error, enotconn}; -shutdown(#sslsocket{pid = Pid}, How) -> +shutdown(#sslsocket{pid = [Pid|_]}, How) when is_pid(Pid) -> ssl_connection:shutdown(Pid, How). %%-------------------------------------------------------------------- @@ -692,9 +694,9 @@ sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _ tls_socket:sockname(Transport, Listen); sockname(#sslsocket{pid = {dtls, #config{dtls_handler = {Pid, _}}}}) -> dtls_packet_demux:sockname(Pid); -sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _}}) when is_pid(Pid) -> dtls_socket:sockname(Transport, Socket); -sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = [Pid| _], fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> tls_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- @@ -723,7 +725,15 @@ versions() -> %% %% Description: Initiates a renegotiation. %%-------------------------------------------------------------------- -renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) -> +renegotiate(#sslsocket{pid = [Pid, Sender |_]}) when is_pid(Pid), + is_pid(Sender) -> + case tls_sender:renegotiate(Sender) of + {ok, Write} -> + tls_connection:renegotiation(Pid, Write); + Error -> + Error + end; +renegotiate(#sslsocket{pid = [Pid |_]}) when is_pid(Pid) -> ssl_connection:renegotiation(Pid); renegotiate(#sslsocket{pid = {dtls,_}}) -> {error, enotconn}; @@ -737,7 +747,7 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> %% %% Description: use a ssl sessions TLS PRF to generate key material %%-------------------------------------------------------------------- -prf(#sslsocket{pid = Pid}, +prf(#sslsocket{pid = [Pid|_]}, Secret, Label, Seed, WantedLength) when is_pid(Pid) -> ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength); prf(#sslsocket{pid = {dtls,_}}, _,_,_,_) -> @@ -794,12 +804,12 @@ tls_version({254, _} = Version) -> %%-------------------------------------------------------------------- --spec suite_to_str(ssl_cipher:erl_cipher_suite()) -> string(). +-spec suite_to_str(ssl_cipher_format:erl_cipher_suite()) -> string(). %% %% Description: Return the string representation of a cipher suite. %%-------------------------------------------------------------------- suite_to_str(Cipher) -> - ssl_cipher:suite_to_str(Cipher). + ssl_cipher_format:suite_to_str(Cipher). %%-------------------------------------------------------------------- @@ -887,9 +897,10 @@ handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, [] -> new_ssl_options(SslOpts1, NewVerifyOpts, RecordCB); Value -> - Versions = [RecordCB:protocol_version(Vsn) || Vsn <- Value], + Versions0 = [RecordCB:protocol_version(Vsn) || Vsn <- Value], + Versions1 = lists:sort(fun RecordCB:is_higher/2, Versions0), new_ssl_options(proplists:delete(versions, SslOpts1), - NewVerifyOpts#ssl_options{versions = Versions}, record_cb(Protocol)) + NewVerifyOpts#ssl_options{versions = Versions1}, record_cb(Protocol)) end; %% Handle all options in listen and connect @@ -908,12 +919,14 @@ handle_options(Opts0, Role, Host) -> CertFile = handle_option(certfile, Opts, <<>>), RecordCb = record_cb(Opts), - Versions = case handle_option(versions, Opts, []) of - [] -> - RecordCb:supported_protocol_versions(); - Vsns -> - [RecordCb:protocol_version(Vsn) || Vsn <- Vsns] - end, + [HighestVersion|_] = Versions = + case handle_option(versions, Opts, []) of + [] -> + RecordCb:supported_protocol_versions(); + Vsns -> + Versions0 = [RecordCb:protocol_version(Vsn) || Vsn <- Vsns], + lists:sort(fun RecordCb:is_higher/2, Versions0) + end, Protocol = handle_option(protocol, Opts, tls), @@ -945,13 +958,28 @@ handle_options(Opts0, Role, Host) -> psk_identity = handle_option(psk_identity, Opts, undefined), srp_identity = handle_option(srp_identity, Opts, undefined), ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []), - RecordCb:highest_protocol_version(Versions)), + HighestVersion), eccs = handle_eccs_option(proplists:get_value(eccs, Opts, eccs()), - RecordCb:highest_protocol_version(Versions)), - signature_algs = handle_hashsigns_option(proplists:get_value(signature_algs, Opts, - default_option_role(server, - tls_v1:default_signature_algs(Versions), Role)), - tls_version(RecordCb:highest_protocol_version(Versions))), + HighestVersion), + signature_algs = + handle_hashsigns_option( + proplists:get_value( + signature_algs, + Opts, + default_option_role(server, + tls_v1:default_signature_algs(HighestVersion), + Role)), + tls_version(HighestVersion)), + signature_algs_cert = + handle_signature_algorithms_option( + proplists:get_value( + signature_algs_cert, + Opts, + default_option_role(server, + tls_v1:default_signature_schemes(HighestVersion), + Role + )), + tls_version(HighestVersion)), %% Server side option reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), @@ -1288,6 +1316,21 @@ handle_hashsigns_option(_, Version) when Version >= {3, 3} -> handle_hashsigns_option(_, _Version) -> undefined. +handle_signature_algorithms_option(Value, Version) when is_list(Value) + andalso Version >= {3, 4} -> + case tls_v1:signature_schemes(Version, Value) of + [] -> + throw({error, {options, + no_supported_signature_schemes, + {signature_algs_cert, Value}}}); + _ -> + Value + end; +handle_signature_algorithms_option(_, Version) when Version >= {3, 4} -> + handle_signature_algorithms_option(tls_v1:default_signature_schemes(Version), Version); +handle_signature_algorithms_option(_, _Version) -> + undefined. + validate_options([]) -> []; validate_options([{Opt, Value} | Tail]) -> @@ -1311,7 +1354,8 @@ validate_binary_list(Opt, List) -> end, List). validate_versions([], Versions) -> Versions; -validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; +validate_versions([Version | Rest], Versions) when Version == 'tlsv1.3'; + Version == 'tlsv1.2'; Version == 'tlsv1.1'; Version == tlsv1; Version == sslv3 -> @@ -1324,10 +1368,11 @@ validate_versions([Ver| _], Versions) -> tls_validate_versions([], Versions) -> Versions; -tls_validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; - Version == 'tlsv1.1'; - Version == tlsv1; - Version == sslv3 -> +tls_validate_versions([Version | Rest], Versions) when Version == 'tlsv1.3'; + Version == 'tlsv1.2'; + Version == 'tlsv1.1'; + Version == tlsv1; + Version == sslv3 -> tls_validate_versions(Rest, Versions); tls_validate_versions([Ver| _], Versions) -> throw({error, {options, {Ver, {versions, Versions}}}}). @@ -1375,10 +1420,10 @@ binary_cipher_suites(Version, []) -> %% not require explicit configuration default_binary_suites(Version); binary_cipher_suites(Version, [Map|_] = Ciphers0) when is_map(Map) -> - Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:suite(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> - Ciphers = [ssl_cipher:suite(tuple_to_map(C)) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:suite(tuple_to_map(C)) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> All = ssl_cipher:all_suites(Version) ++ @@ -1393,11 +1438,11 @@ binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) end; binary_cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) -> %% Format: ["RC4-SHA","RC4-MD5"] - Ciphers = [ssl_cipher:openssl_suite(C) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:openssl_suite(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, Ciphers0) -> %% Format: "RC4-SHA:RC4-MD5" - Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:lexemes(Ciphers0, ":")], + Ciphers = [ssl_cipher_format:openssl_suite(C) || C <- string:lexemes(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). default_binary_suites(Version) -> diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 34e9797f1f..ed8156e0be 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -163,6 +163,8 @@ description_txt(?USER_CANCELED) -> "User Canceled"; description_txt(?NO_RENEGOTIATION) -> "No Renegotiation"; +description_txt(?MISSING_EXTENSION) -> + "Missing extension"; description_txt(?UNSUPPORTED_EXTENSION) -> "Unsupported Extension"; description_txt(?CERTIFICATE_UNOBTAINABLE) -> @@ -177,6 +179,8 @@ description_txt(?UNKNOWN_PSK_IDENTITY) -> "Unknown Psk Identity"; description_txt(?INAPPROPRIATE_FALLBACK) -> "Inappropriate Fallback"; +description_txt(?CERTIFICATE_REQUIRED) -> + "Certificate required"; description_txt(?NO_APPLICATION_PROTOCOL) -> "No application protocol"; description_txt(Enum) -> diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index b23123905e..9b2322da17 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -29,6 +29,9 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Alert protocol - RFC 2246 section 7.2 +%%% updated by RFC 8486 with +%%% missing_extension(109), +%%% certificate_required(116), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% AlertLevel @@ -100,12 +103,14 @@ -define(INAPPROPRIATE_FALLBACK, 86). -define(USER_CANCELED, 90). -define(NO_RENEGOTIATION, 100). +-define(MISSING_EXTENSION, 109). -define(UNSUPPORTED_EXTENSION, 110). -define(CERTIFICATE_UNOBTAINABLE, 111). -define(UNRECOGNISED_NAME, 112). -define(BAD_CERTIFICATE_STATUS_RESPONSE, 113). -define(BAD_CERTIFICATE_HASH_VALUE, 114). -define(UNKNOWN_PSK_IDENTITY, 115). +-define(CERTIFICATE_REQUIRED, 116). -define(NO_APPLICATION_PROTOCOL, 120). -define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}). diff --git a/lib/ssl/src/ssl_api.hrl b/lib/ssl/src/ssl_api.hrl index 2bd51cf91e..7579b56ab0 100644 --- a/lib/ssl/src/ssl_api.hrl +++ b/lib/ssl/src/ssl_api.hrl @@ -42,7 +42,8 @@ {verify, verify_type()} | {verify_fun, {fun(), InitialUserState::term()}} | {fail_if_no_peer_cert, boolean()} | {depth, integer()} | - {cert, Der::binary()} | {certfile, path()} | {key, Der::binary()} | + {cert, Der::binary()} | {certfile, path()} | + {key, {private_key_type(), Der::binary()}} | {keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} | {cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} | {user_lookup_fun, {fun(), InitialUserState::term()}} | @@ -57,7 +58,7 @@ -type verify_type() :: verify_none | verify_peer. -type path() :: string(). --type ciphers() :: [ssl_cipher:erl_cipher_suite()] | +-type ciphers() :: [ssl_cipher_format:erl_cipher_suite()] | string(). % (according to old API) -type ssl_imp() :: new | old. @@ -65,4 +66,11 @@ ClosedTag::atom(), ErrTag::atom()}}. -type prf_random() :: client_random | server_random. +-type private_key_type() :: rsa | %% Backwards compatibility + dsa | %% Backwards compatibility + 'RSAPrivateKey' | + 'DSAPrivateKey' | + 'ECPrivateKey' | + 'PrivateKeyInfo'. + -endif. % -ifdef(ssl_api). diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index c15e8a2138..017d18ee2c 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -69,7 +69,7 @@ trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) - case SignedAndIssuerID of {error, issuer_not_found} -> - %% The root CA was not sent and can not be found. + %% The root CA was not sent and cannot be found. handle_incomplete_chain(Path, PartialChainHandler); {self, _} when length(Path) == 1 -> {selfsigned_peer, Path}; diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 50dadd0903..9bb2beaebd 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -31,45 +31,27 @@ -include("ssl_cipher.hrl"). -include("ssl_handshake.hrl"). -include("ssl_alert.hrl"). +-include("tls_handshake_1_3.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([security_parameters/2, security_parameters/3, suite_definition/1, - erl_suite_definition/1, +-export([security_parameters/2, security_parameters/3, cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, - suite/1, suites/1, all_suites/1, crypto_support_filters/0, + suites/1, all_suites/1, crypto_support_filters/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, srp_suites/0, srp_suites_anon/0, - rc4_suites/1, des_suites/1, rsa_suites/1, openssl_suite/1, openssl_suite_name/1, + rc4_suites/1, des_suites/1, rsa_suites/1, filter/3, filter_suites/1, filter_suites/2, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, - is_stream_ciphersuite/1, suite_to_str/1]). - --export_type([cipher_suite/0, - erl_cipher_suite/0, old_erl_cipher_suite/0, openssl_cipher_suite/0, - hash/0, key_algo/0, sign_algo/0]). - --type cipher() :: null |rc4_128 | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. --type hash() :: null | md5 | sha | sha224 | sha256 | sha384 | sha512. --type sign_algo() :: rsa | dsa | ecdsa. --type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. --type erl_cipher_suite() :: #{key_exchange := key_algo(), - cipher := cipher(), - mac := hash() | aead, - prf := hash() | default_prf %% Old cipher suites, version dependent - }. --type old_erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 - %% TLS 1.2, internally PRE TLS 1.2 will use default_prf - | {key_algo(), cipher(), hash(), hash() | default_prf}. --type cipher_suite() :: binary(). --type cipher_enum() :: integer(). --type openssl_cipher_suite() :: string(). - + is_stream_ciphersuite/1, signature_scheme/1, + scheme_to_components/1]). -compile(inline). +-type cipher_enum() :: integer(). + %%-------------------------------------------------------------------- --spec security_parameters(cipher_suite(), #security_parameters{}) -> +-spec security_parameters(ssl_cipher_format:cipher_suite(), #security_parameters{}) -> #security_parameters{}. %% Only security_parameters/2 should call security_parameters/3 with undefined as %% first argument. @@ -79,7 +61,8 @@ security_parameters(?TLS_NULL_WITH_NULL_NULL = CipherSuite, SecParams) -> security_parameters(undefined, CipherSuite, SecParams). %%-------------------------------------------------------------------- --spec security_parameters(ssl_record:ssl_version() | undefined, cipher_suite(), #security_parameters{}) -> +-spec security_parameters(ssl_record:ssl_version() | undefined, + ssl_cipher_format:cipher_suite(), #security_parameters{}) -> #security_parameters{}. %% %% Description: Returns a security parameters record where the @@ -87,7 +70,7 @@ security_parameters(?TLS_NULL_WITH_NULL_NULL = CipherSuite, SecParams) -> %%------------------------------------------------------------------- security_parameters(Version, CipherSuite, SecParams) -> #{cipher := Cipher, mac := Hash, - prf := PrfHashAlg} = suite_definition(CipherSuite), + prf := PrfHashAlg} = ssl_cipher_format:suite_definition(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -187,7 +170,7 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, Mac, Fragment, {3, N}) - when N == 2; N == 3 -> + when N == 2; N == 3; N == 4 -> NextIV = random_iv(IV), L0 = build_cipher_block(BlockSz, Mac, Fragment), L = [NextIV|L0], @@ -309,7 +292,7 @@ aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState, end. %%-------------------------------------------------------------------- --spec suites(ssl_record:ssl_version()) -> [cipher_suite()]. +-spec suites(ssl_record:ssl_version()) -> [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of supported cipher suites. %%-------------------------------------------------------------------- @@ -332,7 +315,8 @@ all_suites({3, _} = Version) -> all_suites(Version) -> dtls_v1:all_suites(Version). %%-------------------------------------------------------------------- --spec chacha_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +-spec chacha_suites(ssl_record:ssl_version() | integer()) -> + [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns list of the chacha cipher suites, only supported %% if explicitly set by user for now due to interop problems, proably need @@ -346,7 +330,8 @@ chacha_suites(_) -> []. %%-------------------------------------------------------------------- --spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +-spec anonymous_suites(ssl_record:ssl_version() | integer()) -> + [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of the anonymous cipher suites, only supported %% if explicitly set by user. Intended only for testing. @@ -355,6 +340,8 @@ anonymous_suites({3, N}) -> srp_suites_anon() ++ anonymous_suites(N); anonymous_suites({254, _} = Version) -> dtls_v1:anonymous_suites(Version); +anonymous_suites(4) -> + []; %% Raw public key negotiation may be used instead anonymous_suites(N) when N >= 3 -> psk_suites_anon(N) ++ @@ -382,13 +369,15 @@ anonymous_suites(N) when N == 0; ]. %%-------------------------------------------------------------------- --spec psk_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +-spec psk_suites(ssl_record:ssl_version() | integer()) -> [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of the PSK cipher suites, only supported %% if explicitly set by user. %%-------------------------------------------------------------------- psk_suites({3, N}) -> psk_suites(N); +psk_suites(4) -> + []; %% TODO Add new PSK, PSK_(EC)DHE suites psk_suites(N) when N >= 3 -> [ @@ -404,7 +393,7 @@ psk_suites(_) -> ?TLS_RSA_PSK_WITH_RC4_128_SHA]. %%-------------------------------------------------------------------- --spec psk_suites_anon(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +-spec psk_suites_anon(ssl_record:ssl_version() | integer()) -> [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of the anonymous PSK cipher suites, only supported %% if explicitly set by user. @@ -439,7 +428,7 @@ psk_suites_anon(_) -> ?TLS_DHE_PSK_WITH_RC4_128_SHA, ?TLS_PSK_WITH_RC4_128_SHA]. %%-------------------------------------------------------------------- --spec srp_suites() -> [cipher_suite()]. +-spec srp_suites() -> [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of the SRP cipher suites, only supported %% if explicitly set by user. @@ -453,7 +442,7 @@ srp_suites() -> ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. %%-------------------------------------------------------------------- --spec srp_suites_anon() -> [cipher_suite()]. +-spec srp_suites_anon() -> [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of the SRP anonymous cipher suites, only supported %% if explicitly set by user. @@ -464,7 +453,8 @@ srp_suites_anon() -> ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA]. %%-------------------------------------------------------------------- --spec rc4_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +-spec rc4_suites(Version::ssl_record:ssl_version() | integer()) -> + [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of the RSA|(ECDH/RSA)| (ECDH/ECDSA) %% with RC4 cipher suites, only supported if explicitly set by user. @@ -478,13 +468,14 @@ rc4_suites({3, Minor}) -> rc4_suites(0) -> [?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5]; -rc4_suites(N) when N =< 3 -> +rc4_suites(N) when N =< 4 -> [?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDH_RSA_WITH_RC4_128_SHA]. + %%-------------------------------------------------------------------- --spec des_suites(Version::ssl_record:ssl_version()) -> [cipher_suite()]. +-spec des_suites(Version::ssl_record:ssl_version()) -> [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of the cipher suites %% with DES cipher, only supported if explicitly set by user. @@ -502,7 +493,7 @@ des_suites(_)-> ]. %%-------------------------------------------------------------------- --spec rsa_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +-spec rsa_suites(Version::ssl_record:ssl_version() | integer()) -> [ssl_cipher_format:cipher_suite()]. %% %% Description: Returns a list of the RSA key exchange %% cipher suites, only supported if explicitly set by user. @@ -517,1728 +508,17 @@ rsa_suites(0) -> ?TLS_RSA_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_3DES_EDE_CBC_SHA ]; -rsa_suites(N) when N =< 3 -> +rsa_suites(N) when N =< 4 -> [ ?TLS_RSA_WITH_AES_256_GCM_SHA384, ?TLS_RSA_WITH_AES_256_CBC_SHA256, ?TLS_RSA_WITH_AES_128_GCM_SHA256, ?TLS_RSA_WITH_AES_128_CBC_SHA256 ]. -%%-------------------------------------------------------------------- --spec suite_definition(cipher_suite()) -> erl_cipher_suite(). -%% -%% Description: Return erlang cipher suite definition. -%% Note: Currently not supported suites are commented away. -%% They should be supported or removed in the future. -%%------------------------------------------------------------------- -%% TLS v1.1 suites -suite_definition(?TLS_NULL_WITH_NULL_NULL) -> - #{key_exchange => null, - cipher => null, - mac => null, - prf => null}; -%% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension -%% to avoid handshake failure from old servers that do not ignore -%% hello extension data as they should. -suite_definition(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> - #{key_exchange => null, - cipher => null, - mac => null, - prf => null}; -suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> - #{key_exchange => rsa, - cipher => rc4_128, - mac => md5, - prf => default_prf}; -suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> - #{key_exchange => rsa, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> - #{key_exchange => rsa, - cipher => des_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => rsa, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> - #{key_exchange => dhe_dss, - cipher => des_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => dhe_dss, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> - #{key_exchange => dhe_rsa, - cipher => des_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => dhe_rsa, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -%%% TSL V1.1 AES suites -suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> - #{key_exchange => rsa, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> - #{key_exchange => dhe_dss, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> - #{key_exchange => dhe_rsa, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> - #{key_exchange => rsa, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> - #{key_exchange => dhe_dss, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> - #{key_exchange => dhe_rsa, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -%% TLS v1.2 suites -%% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> -%% {rsa, null, sha, default_prf}; -suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => rsa, - cipher => aes_128_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> - #{key_exchange => rsa, - cipher => aes_256_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => dhe_dss, - cipher => aes_128_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => dhe_rsa, - cipher => aes_128_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> - #{key_exchange => dhe_dss, - cipher => aes_256_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> - #{key_exchange => dhe_rsa, - cipher => aes_256_cbc, - mac => sha256, - prf => default_prf}; -%% not defined YET: -%% TLS_DH_DSS_WITH_AES_128_CBC_SHA256 DH_DSS AES_128_CBC SHA256 -%% TLS_DH_RSA_WITH_AES_128_CBC_SHA256 DH_RSA AES_128_CBC SHA256 -%% TLS_DH_DSS_WITH_AES_256_CBC_SHA256 DH_DSS AES_256_CBC SHA256 -%% TLS_DH_RSA_WITH_AES_256_CBC_SHA256 DH_RSA AES_256_CBC SHA256 -%%% DH-ANON deprecated by TLS spec and not available -%%% by default, but good for testing purposes. -suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) -> - #{key_exchange => dh_anon, - cipher => rc4_128, - mac => md5, - prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) -> - #{key_exchange => dh_anon, - cipher => des_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => dh_anon, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> - #{key_exchange => dh_anon, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> - #{key_exchange => dh_anon, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => dh_anon, - cipher => aes_128_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA256) -> - #{key_exchange => dh_anon, - cipher => aes_256_cbc, - mac => sha256, - prf => default_prf}; -%%% PSK Cipher Suites RFC 4279 -suite_definition(?TLS_PSK_WITH_RC4_128_SHA) -> - #{key_exchange => psk, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => psk, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA) -> - #{key_exchange => psk, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA) -> - #{key_exchange => psk, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_RC4_128_SHA) -> - #{key_exchange => dhe_psk, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => dhe_psk, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA) -> - #{key_exchange => dhe_psk, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA) -> - #{key_exchange => dhe_psk, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_RC4_128_SHA) -> - #{key_exchange => rsa_psk, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => rsa_psk, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA) -> - #{key_exchange => rsa_psk, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> - #{key_exchange => rsa_psk, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -%%% PSK NULL Cipher Suites RFC 4785 -suite_definition(?TLS_PSK_WITH_NULL_SHA) -> - #{key_exchange => psk, - cipher => null, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA) -> - #{key_exchange => dhe_psk, - cipher => null, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA) -> - #{key_exchange => rsa_psk, - cipher => null, - mac => sha, - prf => default_prf}; -%%% TLS 1.2 PSK Cipher Suites RFC 5487 -suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => psk, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => psk, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => dhe_psk, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => dhe_psk, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => rsa_psk, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => rsa_psk, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => psk, - cipher => aes_128_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> - #{key_exchange => psk, - cipher => aes_256_cbc, - mac => sha384, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => dhe_psk, - cipher => aes_128_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384) -> - #{key_exchange => dhe_psk, - cipher => aes_256_cbc, - mac => sha384, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => rsa_psk, - cipher => aes_128_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384) -> - #{key_exchange => rsa_psk, - cipher => aes_256_cbc, - mac => sha384, - prf => default_prf}; -suite_definition(?TLS_PSK_WITH_NULL_SHA256) -> - #{key_exchange => psk, - cipher => null, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_PSK_WITH_NULL_SHA384) -> - #{key_exchange => psk, - cipher => null, - mac => sha384, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA256) -> - #{key_exchange => dhe_psk, - cipher => null, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA384) -> - #{key_exchange => dhe_psk, - cipher => null, - mac => sha384, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA256) -> - #{key_exchange => rsa_psk, - cipher => null, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA384) -> - #{key_exchange => rsa_psk, - cipher => null, - mac => sha384, - prf => default_prf}; -%%% ECDHE PSK Cipher Suites RFC 5489 -suite_definition(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) -> - #{key_exchange => ecdhe_psk, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => ecdhe_psk, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) -> - #{key_exchange => ecdhe_psk, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) -> - #{key_exchange => ecdhe_psk, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => ecdhe_psk, - cipher => aes_128_cbc, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> - #{key_exchange => ecdhe_psk, - cipher => aes_256_cbc, - mac => sha384, - prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> - #{key_exchange => ecdhe_psk, - cipher => null, - mac => sha256, - prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> - #{key_exchange => ecdhe_psk, - cipher => null, mac => sha384, - prf => default_prf}; -%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => ecdhe_psk, - cipher => aes_128_gcm, - mac => null, - prf => sha256}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => ecdhe_psk, - cipher => aes_256_gcm, - mac => null, - prf => sha384}; -%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> -%% #{key_exchange => ecdhe_psk, -%% cipher => aes_128_ccm, -%% mac => null, -%% prf =>sha256}; -%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> -%% #{key_exchange => ecdhe_psk, -%% cipher => aes_256_ccm, -%% mac => null, -%% prf => sha256}; -%%% SRP Cipher Suites RFC 5054 -suite_definition(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => srp_anon, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => srp_rsa, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => srp_dss, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_SRP_SHA_WITH_AES_128_CBC_SHA) -> - #{key_exchange => srp_anon, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> - #{key_exchange => srp_rsa, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> - #{key_exchange => srp_dss, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_SRP_SHA_WITH_AES_256_CBC_SHA) -> - #{key_exchange => srp_anon, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> - #{key_exchange => srp_rsa, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> - #{key_exchange => srp_dss, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -%% RFC 4492 EC TLS suites -suite_definition(?TLS_ECDH_ECDSA_WITH_NULL_SHA) -> - #{key_exchange => ecdh_ecdsa, - cipher => null, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> - #{key_exchange => ecdh_ecdsa, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => ecdh_ecdsa, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> - #{key_exchange => ecdh_ecdsa, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> - #{key_exchange => ecdh_ecdsa, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_NULL_SHA) -> - #{key_exchange => ecdhe_ecdsa, - cipher => null, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> - #{key_exchange => ecdhe_ecdsa, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => ecdhe_ecdsa, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> - #{key_exchange => ecdhe_ecdsa, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> - #{key_exchange => ecdhe_ecdsa, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_NULL_SHA) -> - #{key_exchange => ecdh_rsa, - cipher => null, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> - #{key_exchange => ecdh_rsa, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => ecdh_rsa, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> - #{key_exchange => ecdh_rsa, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> - #{key_exchange => ecdh_rsa, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_NULL_SHA) -> - #{key_exchange => ecdhe_rsa, - cipher => null, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> - #{key_exchange => ecdhe_rsa, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => ecdhe_rsa, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> - #{key_exchange => ecdhe_rsa, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> - #{key_exchange => ecdhe_rsa, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_NULL_SHA) -> - #{key_exchange => ecdh_anon, - cipher => null, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_RC4_128_SHA) -> - #{key_exchange => ecdh_anon, - cipher => rc4_128, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA) -> - #{key_exchange => ecdh_anon, - cipher => '3des_ede_cbc', - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_AES_128_CBC_SHA) -> - #{key_exchange => ecdh_anon, - cipher => aes_128_cbc, - mac => sha, - prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_AES_256_CBC_SHA) -> - #{key_exchange => ecdh_anon, - cipher => aes_256_cbc, - mac => sha, - prf => default_prf}; -%% RFC 5289 EC TLS suites -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => ecdhe_ecdsa, - cipher => aes_128_cbc, - mac => sha256, - prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> - #{key_exchange => ecdhe_ecdsa, - cipher => aes_256_cbc, - mac => sha384, - prf => sha384}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => ecdh_ecdsa, - cipher => aes_128_cbc, - mac => sha256, - prf => sha256}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> - #{key_exchange => ecdh_ecdsa, - cipher => aes_256_cbc, - mac => sha384, - prf => sha384}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => ecdhe_rsa, - cipher => aes_128_cbc, - mac => sha256, - prf => sha256}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> - #{key_exchange => ecdhe_rsa, - cipher => aes_256_cbc, - mac => sha384, - prf => sha384}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> - #{key_exchange => ecdh_rsa, - cipher => aes_128_cbc, - mac => sha256, - prf => sha256}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> - #{key_exchange => ecdh_rsa, - cipher => aes_256_cbc, - mac => sha384, - prf => sha384}; -%% RFC 5288 AES-GCM Cipher Suites -suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => rsa, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => rsa, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => dhe_rsa, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => dhe_rsa, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => dh_rsa, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => dh_rsa, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => dhe_dss, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => dhe_dss, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => dh_dss, - cipher => aes_128_gcm, - mac => null, - prf => sha256}; -suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => dh_dss, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => dh_anon, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => dh_anon, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -%% RFC 5289 ECC AES-GCM Cipher Suites -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => ecdhe_ecdsa, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => ecdhe_ecdsa, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => ecdh_ecdsa, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => ecdh_ecdsa, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => ecdhe_rsa, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => ecdhe_rsa, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> - #{key_exchange => ecdh_rsa, - cipher => aes_128_gcm, - mac => aead, - prf => sha256}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> - #{key_exchange => ecdh_rsa, - cipher => aes_256_gcm, - mac => aead, - prf => sha384}; -%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> - #{key_exchange => ecdhe_rsa, - cipher => chacha20_poly1305, - mac => aead, - prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> - #{key_exchange => ecdhe_ecdsa, - cipher => chacha20_poly1305, - mac => aead, - prf => sha256}; -suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> - #{key_exchange => dhe_rsa, - cipher => chacha20_poly1305, - mac => aead, - prf => sha256}. %%-------------------------------------------------------------------- --spec erl_suite_definition(cipher_suite() | erl_cipher_suite()) -> old_erl_cipher_suite(). -%% -%% Description: Return erlang cipher suite definition. Filters last value -%% for now (compatibility reasons). -%%-------------------------------------------------------------------- -erl_suite_definition(Bin) when is_binary(Bin) -> - erl_suite_definition(suite_definition(Bin)); -erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher, - mac := Hash, prf := Prf}) -> - case Prf of - default_prf -> - {KeyExchange, Cipher, Hash}; - _ -> - {KeyExchange, Cipher, Hash, Prf} - end. - -%%-------------------------------------------------------------------- --spec suite(erl_cipher_suite()) -> cipher_suite(). -%% -%% Description: Return TLS cipher suite definition. -%%-------------------------------------------------------------------- -%% TLS v1.1 suites -suite(#{key_exchange := rsa, - cipher := rc4_128, - mac := md5}) -> - ?TLS_RSA_WITH_RC4_128_MD5; -suite(#{key_exchange := rsa, - cipher := rc4_128, - mac := sha}) -> - ?TLS_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := rsa, - cipher := des_cbc, - mac := sha}) -> - ?TLS_RSA_WITH_DES_CBC_SHA; -suite(#{key_exchange := rsa, - cipher :='3des_ede_cbc', - mac := sha}) -> - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_dss, - cipher:= des_cbc, - mac := sha}) -> - ?TLS_DHE_DSS_WITH_DES_CBC_SHA; -suite(#{key_exchange := dhe_dss, - cipher:= '3des_ede_cbc', - mac := sha}) -> - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_rsa, - cipher:= des_cbc, - mac := sha}) -> - ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -suite(#{key_exchange := dhe_rsa, - cipher:= '3des_ede_cbc', - mac := sha}) -> - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dh_anon, - cipher:= rc4_128, - mac := md5}) -> - ?TLS_DH_anon_WITH_RC4_128_MD5; -suite(#{key_exchange := dh_anon, - cipher:= des_cbc, - mac := sha}) -> - ?TLS_DH_anon_WITH_DES_CBC_SHA; -suite(#{key_exchange := dh_anon, - cipher:= '3des_ede_cbc', - mac := sha}) -> - ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; -%%% TSL V1.1 AES suites -suite(#{key_exchange := rsa, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_dss, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_rsa, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dh_anon, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_DH_anon_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := rsa, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_dss, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_rsa, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dh_anon, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_DH_anon_WITH_AES_256_CBC_SHA; -%% TLS v1.2 suites -suite(#{key_exchange := rsa, - cipher := aes_128_cbc, - mac := sha256}) -> - ?TLS_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := rsa, - cipher := aes_256_cbc, - mac := sha256}) -> - ?TLS_RSA_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dhe_dss, - cipher := aes_128_cbc, - mac := sha256}) -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_rsa, - cipher := aes_128_cbc, - mac := sha256}) -> - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_dss, - cipher := aes_256_cbc, - mac := sha256}) -> - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dhe_rsa, - cipher := aes_256_cbc, - mac := sha256}) -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dh_anon, - cipher := aes_128_cbc, - mac := sha256}) -> - ?TLS_DH_anon_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dh_anon, - cipher := aes_256_cbc, - mac := sha256}) -> - ?TLS_DH_anon_WITH_AES_256_CBC_SHA256; -%%% PSK Cipher Suites RFC 4279 -suite(#{key_exchange := psk, - cipher := rc4_128, - mac := sha}) -> - ?TLS_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := psk, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := psk, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := psk, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_psk, - cipher := rc4_128, - mac := sha}) -> - ?TLS_DHE_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := dhe_psk, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_psk, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_psk, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := rsa_psk, - cipher := rc4_128, - mac := sha}) -> - ?TLS_RSA_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := rsa_psk, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := rsa_psk, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := rsa_psk, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA; -%%% PSK NULL Cipher Suites RFC 4785 -suite(#{key_exchange := psk, - cipher := null, - mac := sha}) -> - ?TLS_PSK_WITH_NULL_SHA; -suite(#{key_exchange := dhe_psk, - cipher := null, - mac := sha}) -> - ?TLS_DHE_PSK_WITH_NULL_SHA; -suite(#{key_exchange := rsa_psk, - cipher := null, - mac := sha}) -> - ?TLS_RSA_PSK_WITH_NULL_SHA; -%%% TLS 1.2 PSK Cipher Suites RFC 5487 -suite(#{key_exchange := psk, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := psk, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_psk, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_psk, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := rsa_psk, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := rsa_psk, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := psk, - cipher := aes_128_cbc, - mac := sha256}) -> - ?TLS_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := psk, - cipher := aes_256_cbc, - mac := sha384}) -> - ?TLS_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := dhe_psk, - cipher := aes_128_cbc, - mac := sha256}) -> - ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_psk, - cipher := aes_256_cbc, - mac := sha384}) -> - ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := rsa_psk, - cipher := aes_128_cbc, - mac := sha256}) -> - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := rsa_psk, - cipher := aes_256_cbc, - mac := sha384}) -> - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := psk, - cipher := null, - mac := sha256}) -> - ?TLS_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := psk, - cipher := null, - mac := sha384}) -> - ?TLS_PSK_WITH_NULL_SHA384; -suite(#{key_exchange := dhe_psk, - cipher := null, - mac := sha256}) -> - ?TLS_DHE_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := dhe_psk, - cipher := null, - mac := sha384}) -> - ?TLS_DHE_PSK_WITH_NULL_SHA384; -suite(#{key_exchange := rsa_psk, - cipher := null, - mac := sha256}) -> - ?TLS_RSA_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := rsa_psk, - cipher := null, - mac := sha384}) -> - ?TLS_RSA_PSK_WITH_NULL_SHA384; -%%% ECDHE PSK Cipher Suites RFC 5489 -suite(#{key_exchange := ecdhe_psk, - cipher := rc4_128, - mac := sha}) -> - ?TLS_ECDHE_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_psk, - cipher :='3des_ede_cbc', - mac := sha}) -> - ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, - cipher := aes_128_cbc, - mac := sha256}) -> - ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_psk, - cipher := aes_256_cbc, - mac := sha384}) -> - ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdhe_psk, - cipher := null, - mac := sha256}) -> - ?TLS_ECDHE_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := ecdhe_psk, - cipher := null, - mac := sha384}) -> - ?TLS_ECDHE_PSK_WITH_NULL_SHA384; -%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 -suite(#{key_exchange := ecdhe_psk, - cipher := aes_128_gcm, - mac := null, - prf := sha256}) -> - ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_psk, - cipher := aes_256_gcm, - mac := null, - prf := sha384}) -> - ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384; - %% suite(#{key_exchange := ecdhe_psk, - %% cipher := aes_128_ccm, - %% mac := null, - %% prf := sha256}) -> - %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256; - %% suite(#{key_exchange := ecdhe_psk, - %% cipher := aes_256_ccm, - %% mac := null, - %% prf := sha256}) -> - %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256; -%%% SRP Cipher Suites RFC 5054 -suite(#{key_exchange := srp_anon, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_rsa, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_dss, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_anon, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_rsa, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_dss, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_anon, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := srp_rsa, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := srp_dss, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; -%%% RFC 4492 EC TLS suites -suite(#{key_exchange := ecdh_ecdsa, - cipher := null, - mac := sha}) -> - ?TLS_ECDH_ECDSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_ecdsa, - cipher := rc4_128, - mac := sha}) -> - ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_ecdsa, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_ecdsa, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_ecdsa, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, - cipher := null, - mac := sha}) -> - ?TLS_ECDHE_ECDSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdhe_ecdsa, - cipher := rc4_128, - mac := sha}) -> - ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_ecdsa, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, - cipher := null, - mac := sha}) -> - ?TLS_ECDH_RSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_rsa, - cipher := rc4_128, - mac := sha}) -> - ?TLS_ECDH_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_rsa, - cipher := '3des_ede_cbc', mac := sha}) -> - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, - cipher := null, - mac := sha}) -> - ?TLS_ECDHE_RSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdhe_rsa, - cipher := rc4_128, - mac := sha}) -> - ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_rsa, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdh_anon, - cipher := null, - mac := sha}) -> - ?TLS_ECDH_anon_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_anon, - cipher := rc4_128, - mac := sha}) -> - ?TLS_ECDH_anon_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_anon, - cipher := '3des_ede_cbc', - mac := sha}) -> - ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_anon, - cipher := aes_128_cbc, - mac := sha}) -> - ?TLS_ECDH_anon_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_anon, - cipher := aes_256_cbc, - mac := sha}) -> - ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA; -%%% RFC 5289 EC TLS suites -suite(#{key_exchange := ecdhe_ecdsa, - cipher := aes_128_cbc, - mac:= sha256, - prf := sha256}) -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, - cipher := aes_256_cbc, - mac := sha384, - prf := sha384}) -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdh_ecdsa, - cipher := aes_128_cbc, - mac := sha256, - prf := sha256}) -> - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdh_ecdsa, - cipher := aes_256_cbc, - mac := sha384, - prf := sha384}) -> - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdhe_rsa, - cipher := aes_128_cbc, - mac := sha256, - prf := sha256}) -> - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_rsa, - cipher := aes_256_cbc, - mac := sha384, - prf := sha384}) -> - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdh_rsa, - cipher := aes_128_cbc, - mac := sha256, - prf := sha256}) -> - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdh_rsa, - cipher := aes_256_cbc, - mac := sha384, - prf := sha384}) -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; -%% RFC 5288 AES-GCM Cipher Suites -suite(#{key_exchange := rsa, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := rsa, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_rsa, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_rsa, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_rsa, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_rsa, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_dss, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_dss, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_dss, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_dss, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_anon, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_anon, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; -%% RFC 5289 ECC AES-GCM Cipher Suites -suite(#{key_exchange := ecdhe_ecdsa, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdh_ecdsa, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdh_ecdsa, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdhe_rsa, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_rsa, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdh_rsa, - cipher := aes_128_gcm, - mac := aead, - prf := sha256}) -> - ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdh_rsa, - cipher := aes_256_gcm, - mac := aead, - prf := sha384}) -> - ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; -%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite(#{key_exchange := ecdhe_rsa, - cipher := chacha20_poly1305, - mac := aead, - prf := sha256}) -> - ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, - cipher := chacha20_poly1305, - mac := aead, - prf := sha256}) -> - ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; -suite(#{key_exchange := dhe_rsa, - cipher := chacha20_poly1305, - mac := aead, - prf := sha256}) -> - ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256. - - -%%-------------------------------------------------------------------- --spec suite_to_str(erl_cipher_suite()) -> string(). -%% -%% Description: Return the string representation of a cipher suite. -%%-------------------------------------------------------------------- -suite_to_str(#{key_exchange := null, - cipher := null, - mac := null, - prf := null}) -> - "TLS_EMPTY_RENEGOTIATION_INFO_SCSV"; -suite_to_str(#{key_exchange := Kex, - cipher := Cipher, - mac := aead, - prf := PRF}) -> - "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ - "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ - "_" ++ string:to_upper(atom_to_list(PRF)); -suite_to_str(#{key_exchange := Kex, - cipher := Cipher, - mac := Mac}) -> - "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ - "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ - "_" ++ string:to_upper(atom_to_list(Mac)). - - -%%-------------------------------------------------------------------- --spec openssl_suite(openssl_cipher_suite()) -> cipher_suite(). -%% -%% Description: Return TLS cipher suite definition. -%%-------------------------------------------------------------------- -%% translate constants <-> openssl-strings -openssl_suite("DHE-RSA-AES256-SHA256") -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; -openssl_suite("DHE-DSS-AES256-SHA256") -> - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; -openssl_suite("AES256-SHA256") -> - ?TLS_RSA_WITH_AES_256_CBC_SHA256; -openssl_suite("DHE-RSA-AES128-SHA256") -> - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("DHE-DSS-AES128-SHA256") -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; -openssl_suite("AES128-SHA256") -> - ?TLS_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("DHE-RSA-AES256-SHA") -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("DHE-DSS-AES256-SHA") -> - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -openssl_suite("AES256-SHA") -> - ?TLS_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("EDH-RSA-DES-CBC3-SHA") -> - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("EDH-DSS-DES-CBC3-SHA") -> - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -openssl_suite("DES-CBC3-SHA") -> - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("DHE-RSA-AES128-SHA") -> - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("DHE-DSS-AES128-SHA") -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -openssl_suite("AES128-SHA") -> - ?TLS_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("RC4-SHA") -> - ?TLS_RSA_WITH_RC4_128_SHA; -openssl_suite("RC4-MD5") -> - ?TLS_RSA_WITH_RC4_128_MD5; -openssl_suite("EDH-RSA-DES-CBC-SHA") -> - ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -openssl_suite("DES-CBC-SHA") -> - ?TLS_RSA_WITH_DES_CBC_SHA; - -%%% SRP Cipher Suites RFC 5054 - -openssl_suite("SRP-DSS-AES-256-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; -openssl_suite("SRP-RSA-AES-256-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("SRP-DSS-3DES-EDE-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; -openssl_suite("SRP-RSA-3DES-EDE-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("SRP-DSS-AES-128-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; -openssl_suite("SRP-RSA-AES-128-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; - -%% RFC 4492 EC TLS suites -openssl_suite("ECDH-ECDSA-RC4-SHA") -> - ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; -openssl_suite("ECDH-ECDSA-DES-CBC3-SHA") -> - ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDH-ECDSA-AES128-SHA") -> - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDH-ECDSA-AES256-SHA") -> - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; - -openssl_suite("ECDHE-ECDSA-RC4-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; -openssl_suite("ECDHE-ECDSA-DES-CBC3-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDHE-ECDSA-AES128-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDHE-ECDSA-AES256-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; - -openssl_suite("ECDHE-RSA-RC4-SHA") -> - ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; -openssl_suite("ECDHE-RSA-DES-CBC3-SHA") -> - ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDHE-RSA-AES128-SHA") -> - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDHE-RSA-AES256-SHA") -> - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; - -openssl_suite("ECDH-RSA-RC4-SHA") -> - ?TLS_ECDH_RSA_WITH_RC4_128_SHA; -openssl_suite("ECDH-RSA-DES-CBC3-SHA") -> - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDH-RSA-AES128-SHA") -> - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDH-RSA-AES256-SHA") -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; - -%% RFC 5289 EC TLS suites -openssl_suite("ECDHE-ECDSA-AES128-SHA256") -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDHE-ECDSA-AES256-SHA384") -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDH-ECDSA-AES128-SHA256") -> - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDH-ECDSA-AES256-SHA384") -> - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDHE-RSA-AES128-SHA256") -> - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDHE-RSA-AES256-SHA384") -> - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDH-RSA-AES128-SHA256") -> - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDH-RSA-AES256-SHA384") -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; - -%% RFC 5288 AES-GCM Cipher Suites -openssl_suite("AES128-GCM-SHA256") -> - ?TLS_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("AES256-GCM-SHA384") -> - ?TLS_RSA_WITH_AES_256_GCM_SHA384; -openssl_suite("DHE-RSA-AES128-GCM-SHA256") -> - ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("DHE-RSA-AES256-GCM-SHA384") -> - ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -openssl_suite("DH-RSA-AES128-GCM-SHA256") -> - ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("DH-RSA-AES256-GCM-SHA384") -> - ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -openssl_suite("DHE-DSS-AES128-GCM-SHA256") -> - ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -openssl_suite("DHE-DSS-AES256-GCM-SHA384") -> - ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -openssl_suite("DH-DSS-AES128-GCM-SHA256") -> - ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; -openssl_suite("DH-DSS-AES256-GCM-SHA384") -> - ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; - -%% RFC 5289 ECC AES-GCM Cipher Suites -openssl_suite("ECDHE-ECDSA-AES128-GCM-SHA256") -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; -openssl_suite("ECDHE-ECDSA-AES256-GCM-SHA384") -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; -openssl_suite("ECDH-ECDSA-AES128-GCM-SHA256") -> - ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; -openssl_suite("ECDH-ECDSA-AES256-GCM-SHA384") -> - ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; -openssl_suite("ECDHE-RSA-AES128-GCM-SHA256") -> - ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("ECDHE-RSA-AES256-GCM-SHA384") -> - ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; -openssl_suite("ECDH-RSA-AES128-GCM-SHA256") -> - ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("ECDH-RSA-AES256-GCM-SHA384") -> - ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384. - -%%-------------------------------------------------------------------- --spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | erl_cipher_suite(). -%% -%% Description: Return openssl cipher suite name if possible -%%------------------------------------------------------------------- -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> - "DHE-RSA-AES256-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> - "DHE-DSS-AES256-SHA"; -openssl_suite_name(?TLS_RSA_WITH_AES_256_CBC_SHA) -> - "AES256-SHA"; -openssl_suite_name(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - "EDH-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> - "EDH-DSS-DES-CBC3-SHA"; -openssl_suite_name(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> - "DES-CBC3-SHA"; -openssl_suite_name( ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> - "DHE-RSA-AES128-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> - "DHE-DSS-AES128-SHA"; -openssl_suite_name(?TLS_RSA_WITH_AES_128_CBC_SHA) -> - "AES128-SHA"; -openssl_suite_name(?TLS_RSA_WITH_RC4_128_SHA) -> - "RC4-SHA"; -openssl_suite_name(?TLS_RSA_WITH_RC4_128_MD5) -> - "RC4-MD5"; -openssl_suite_name(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> - "EDH-RSA-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_WITH_DES_CBC_SHA) -> - "DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_WITH_NULL_SHA256) -> - "NULL-SHA256"; -openssl_suite_name(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> - "AES128-SHA256"; -openssl_suite_name(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> - "AES256-SHA256"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_CBC_SHA256) -> - "DH-DSS-AES128-SHA256"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_CBC_SHA256) -> - "DH-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> - "DHE-DSS-AES128-SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> - "DHE-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_CBC_SHA256) -> - "DH-DSS-AES256-SHA256"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_CBC_SHA256) -> - "DH-RSA-AES256-SHA256"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> - "DHE-DSS-AES256-SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> - "DHE-RSA-AES256-SHA256"; - -%%% PSK Cipher Suites RFC 4279 - -openssl_suite_name(?TLS_PSK_WITH_AES_256_CBC_SHA) -> - "PSK-AES256-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> - "PSK-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_AES_128_CBC_SHA) -> - "PSK-AES128-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_RC4_128_SHA) -> - "PSK-RC4-SHA"; - -%%% SRP Cipher Suites RFC 5054 - -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> - "SRP-RSA-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> - "SRP-DSS-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> - "SRP-RSA-AES-128-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> - "SRP-DSS-AES-128-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> - "SRP-RSA-AES-256-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> - "SRP-DSS-AES-256-CBC-SHA"; - -%% RFC 4492 EC TLS suites -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> - "ECDH-ECDSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDH-ECDSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> - "ECDH-ECDSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> - "ECDH-ECDSA-AES256-SHA"; - -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> - "ECDHE-ECDSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDHE-ECDSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> - "ECDHE-ECDSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> - "ECDHE-ECDSA-AES256-SHA"; - -openssl_suite_name(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> - "ECDH-RSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDH-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> - "ECDH-RSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> - "ECDH-RSA-AES256-SHA"; - -openssl_suite_name(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> - "ECDHE-RSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDHE-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> - "ECDHE-RSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> - "ECDHE-RSA-AES256-SHA"; - -%% RFC 5289 EC TLS suites -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> - "ECDHE-ECDSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> - "ECDHE-ECDSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> - "ECDH-ECDSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> - "ECDH-ECDSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> - "ECDHE-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> - "ECDHE-RSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> - "ECDH-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> - "ECDH-RSA-AES256-SHA384"; - -%% RFC 5288 AES-GCM Cipher Suites -openssl_suite_name(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> - "AES128-GCM-SHA256"; -openssl_suite_name(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> - "AES256-GCM-SHA384"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> - "DHE-RSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> - "DHE-RSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> - "DH-RSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> - "DH-RSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> - "DHE-DSS-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> - "DHE-DSS-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> - "DH-DSS-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> - "DH-DSS-AES256-GCM-SHA384"; - -%% RFC 5289 ECC AES-GCM Cipher Suites -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> - "ECDHE-ECDSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> - "ECDHE-ECDSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> - "ECDH-ECDSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> - "ECDH-ECDSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> - "ECDHE-RSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> - "ECDHE-RSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> - "ECDH-RSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> - "ECDH-RSA-AES256-GCM-SHA384"; - -%% No oppenssl name -openssl_suite_name(Cipher) -> - suite_definition(Cipher). - -%%-------------------------------------------------------------------- --spec filter(undefined | binary(), [cipher_suite()], ssl_record:ssl_version()) -> [cipher_suite()]. +-spec filter(undefined | binary(), [ssl_cipher_format:cipher_suite()], + ssl_record:ssl_version()) -> [ssl_cipher_format:cipher_suite()]. %% %% Description: Select the cipher suites that can be used together with the %% supplied certificate. (Server side functionality) @@ -2258,8 +538,8 @@ filter(DerCert, Ciphers0, Version) -> filter_suites_signature(Sign, Ciphers, Version). %%-------------------------------------------------------------------- --spec filter_suites([erl_cipher_suite()] | [cipher_suite()], map()) -> - [erl_cipher_suite()] | [cipher_suite()]. +-spec filter_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()], map()) -> + [ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. %% %% Description: Filter suites using supplied filter funs %%------------------------------------------------------------------- @@ -2282,11 +562,11 @@ filter_suite(#{key_exchange := KeyExchange, all_filters(Hash, HashFilters) andalso all_filters(Prf, PrfFilters); filter_suite(Suite, Filters) -> - filter_suite(suite_definition(Suite), Filters). + filter_suite(ssl_cipher_format:suite_definition(Suite), Filters). %%-------------------------------------------------------------------- --spec filter_suites([erl_cipher_suite()] | [cipher_suite()]) -> - [erl_cipher_suite()] | [cipher_suite()]. +-spec filter_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]) -> + [ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. %% %% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- @@ -2430,7 +710,7 @@ mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type, mac_hash({3, 0}, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> ssl_v3:mac_hash(MacAlg, MacSecret, SeqNo, Type, Length, Fragment); mac_hash({3, N} = Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) - when N =:= 1; N =:= 2; N =:= 3 -> + when N =:= 1; N =:= 2; N =:= 3; N =:= 4 -> tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, Length, Fragment). @@ -2578,6 +858,61 @@ sign_algorithm(?ECDSA) -> ecdsa; sign_algorithm(Other) when is_integer(Other) andalso ((Other >= 4) and (Other =< 223)) -> unassigned; sign_algorithm(Other) when is_integer(Other) andalso ((Other >= 224) and (Other =< 255)) -> Other. + +signature_scheme(rsa_pkcs1_sha256) -> ?RSA_PKCS1_SHA256; +signature_scheme(rsa_pkcs1_sha384) -> ?RSA_PKCS1_SHA384; +signature_scheme(rsa_pkcs1_sha512) -> ?RSA_PKCS1_SHA512; +signature_scheme(ecdsa_secp256r1_sha256) -> ?ECDSA_SECP256R1_SHA256; +signature_scheme(ecdsa_secp384r1_sha384) -> ?ECDSA_SECP384R1_SHA384; +signature_scheme(ecdsa_secp521r1_sha512) -> ?ECDSA_SECP521R1_SHA512; +signature_scheme(rsa_pss_rsae_sha256) -> ?RSA_PSS_RSAE_SHA256; +signature_scheme(rsa_pss_rsae_sha384) -> ?RSA_PSS_RSAE_SHA384; +signature_scheme(rsa_pss_rsae_sha512) -> ?RSA_PSS_RSAE_SHA512; +signature_scheme(ed25519) -> ?ED25519; +signature_scheme(ed448) -> ?ED448; +signature_scheme(rsa_pss_pss_sha256) -> ?RSA_PSS_PSS_SHA256; +signature_scheme(rsa_pss_pss_sha384) -> ?RSA_PSS_PSS_SHA384; +signature_scheme(rsa_pss_pss_sha512) -> ?RSA_PSS_PSS_SHA512; +signature_scheme(rsa_pkcs1_sha1) -> ?RSA_PKCS1_SHA1; +signature_scheme(ecdsa_sha1) -> ?ECDSA_SHA1; +signature_scheme(?RSA_PKCS1_SHA256) -> rsa_pkcs1_sha256; +signature_scheme(?RSA_PKCS1_SHA384) -> rsa_pkcs1_sha384; +signature_scheme(?RSA_PKCS1_SHA512) -> rsa_pkcs1_sha512; +signature_scheme(?ECDSA_SECP256R1_SHA256) -> ecdsa_secp256r1_sha256; +signature_scheme(?ECDSA_SECP384R1_SHA384) -> ecdsa_secp384r1_sha384; +signature_scheme(?ECDSA_SECP521R1_SHA512) -> ecdsa_secp521r1_sha512; +signature_scheme(?RSA_PSS_RSAE_SHA256) -> rsa_pss_rsae_sha256; +signature_scheme(?RSA_PSS_RSAE_SHA384) -> rsa_pss_rsae_sha384; +signature_scheme(?RSA_PSS_RSAE_SHA512) -> rsa_pss_rsae_sha512; +signature_scheme(?ED25519) -> ed25519; +signature_scheme(?ED448) -> ed448; +signature_scheme(?RSA_PSS_PSS_SHA256) -> rsa_pss_pss_sha256; +signature_scheme(?RSA_PSS_PSS_SHA384) -> rsa_pss_pss_sha384; +signature_scheme(?RSA_PSS_PSS_SHA512) -> rsa_pss_pss_sha512; +signature_scheme(?RSA_PKCS1_SHA1) -> rsa_pkcs1_sha1; +signature_scheme(?ECDSA_SHA1) -> ecdsa_sha1; +signature_scheme(_) -> unassigned. +%% TODO: reserved code points? + +scheme_to_components(rsa_pkcs1_sha256) -> {sha256, rsa_pkcs1, undefined}; +scheme_to_components(rsa_pkcs1_sha384) -> {sha384, rsa_pkcs1, undefined}; +scheme_to_components(rsa_pkcs1_sha512) -> {sha512, rsa_pkcs1, undefined}; +scheme_to_components(ecdsa_secp256r1_sha256) -> {sha256, ecdsa, secp256r1}; +scheme_to_components(ecdsa_secp384r1_sha384) -> {sha384, ecdsa, secp384r1}; +scheme_to_components(ecdsa_secp521r1_sha512) -> {sha512, ecdsa, secp521r1}; +scheme_to_components(rsa_pss_rsae_sha256) -> {sha256, rsa_pss_rsae, undefined}; +scheme_to_components(rsa_pss_rsae_sha384) -> {sha384, rsa_pss_rsae, undefined}; +scheme_to_components(rsa_pss_rsae_sha512) -> {sha512, rsa_pss_rsae, undefined}; +%% scheme_to_components(ed25519) -> {undefined, undefined, undefined}; +%% scheme_to_components(ed448) -> {undefined, undefined, undefined}; +scheme_to_components(rsa_pss_pss_sha256) -> {sha256, rsa_pss_pss, undefined}; +scheme_to_components(rsa_pss_pss_sha384) -> {sha384, rsa_pss_pss, undefined}; +scheme_to_components(rsa_pss_pss_sha512) -> {sha512, rsa_pss_pss, undefined}; +scheme_to_components(rsa_pkcs1_sha1) -> {sha1, rsa_pkcs1, undefined}; +scheme_to_components(ecdsa_sha1) -> {sha1, ecdsa, undefined}. + + + hash_size(null) -> 0; %% The AEAD MAC hash size is not used in the context @@ -2635,7 +970,7 @@ generic_block_cipher_from_bin({3, N}, T, IV, HashSize) next_iv = IV}; generic_block_cipher_from_bin({3, N}, T, IV, HashSize) - when N == 2; N == 3 -> + when N == 2; N == 3; N == 4 -> Sz1 = byte_size(T) - 1, <<_:Sz1/binary, ?BYTE(PadLength)>> = T, IVLength = byte_size(IV), @@ -2777,6 +1112,8 @@ ecdsa_signed_suites(Ciphers, Version) -> rsa_keyed(dhe_rsa) -> true; +rsa_keyed(ecdhe_rsa) -> + true; rsa_keyed(rsa) -> true; rsa_keyed(rsa_psk) -> @@ -2840,6 +1177,8 @@ ec_keyed(ecdh_ecdsa) -> true; ec_keyed(ecdh_rsa) -> true; +ec_keyed(ecdhe_ecdsa) -> + true; ec_keyed(_) -> false. diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index ba6a98b92a..1febc52e43 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -610,4 +610,21 @@ %% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x15} -define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#15)>>). +%%% TLS 1.3 cipher suites RFC8446 + +%% TLS_AES_128_GCM_SHA256 = {0x13,0x01} +-define(TLS_AES_128_GCM_SHA256, <<?BYTE(16#13), ?BYTE(16#01)>>). + +%% TLS_AES_256_GCM_SHA384 = {0x13,0x02} +-define(TLS_AES_256_GCM_SHA384, <<?BYTE(16#13),?BYTE(16#02)>>). + +%% TLS_CHACHA20_POLY1305_SHA256 = {0x13,0x03} +-define(TLS_CHACHA20_POLY1305_SHA256, <<?BYTE(16#13),?BYTE(16#03)>>). + +%% %% TLS_AES_128_CCM_SHA256 = {0x13,0x04} +%% -define(TLS_AES_128_CCM_SHA256, <<?BYTE(16#13), ?BYTE(16#04)>>). + +%% %% TLS_AES_128_CCM_8_SHA256 = {0x13,0x05} +%% -define(TLS_AES_128_CCM_8_SHA256, <<?BYTE(16#13),?BYTE(16#05)>>). + -endif. % -ifdef(ssl_cipher). diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl new file mode 100644 index 0000000000..6e480eef45 --- /dev/null +++ b/lib/ssl/src/ssl_cipher_format.erl @@ -0,0 +1,1854 @@ +% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Convert between diffrent cipher suite representations +%% +%%---------------------------------------------------------------------- +-module(ssl_cipher_format). + +-include("ssl_cipher.hrl"). +-include("ssl_internal.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +-export_type([cipher_suite/0, + erl_cipher_suite/0, old_erl_cipher_suite/0, openssl_cipher_suite/0, + hash/0, key_algo/0, sign_algo/0]). + +-type cipher() :: null |rc4_128 | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. +-type hash() :: null | md5 | sha | sha224 | sha256 | sha384 | sha512. +-type sign_algo() :: rsa | dsa | ecdsa. +-type key_algo() :: null | + rsa | + dhe_rsa | dhe_dss | + ecdhe_ecdsa | ecdh_ecdsa | ecdh_rsa | + srp_rsa| srp_dss | + psk | dhe_psk | rsa_psk | + dh_anon | ecdh_anon | srp_anon | + any. %% TLS 1.3 +-type erl_cipher_suite() :: #{key_exchange := key_algo(), + cipher := cipher(), + mac := hash() | aead, + prf := hash() | default_prf %% Old cipher suites, version dependent + }. +-type old_erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 + %% TLS 1.2, internally PRE TLS 1.2 will use default_prf + | {key_algo(), cipher(), hash(), hash() | default_prf}. +-type cipher_suite() :: binary(). +-type openssl_cipher_suite() :: string(). + + +-export([suite_to_str/1, suite_definition/1, suite/1, erl_suite_definition/1, + openssl_suite/1, openssl_suite_name/1]). + +%%-------------------------------------------------------------------- +-spec suite_to_str(erl_cipher_suite()) -> string(). +%% +%% Description: Return the string representation of a cipher suite. +%%-------------------------------------------------------------------- +suite_to_str(#{key_exchange := null, + cipher := null, + mac := null, + prf := null}) -> + "TLS_EMPTY_RENEGOTIATION_INFO_SCSV"; +suite_to_str(#{key_exchange := any, + cipher := Cipher, + mac := aead, + prf := PRF}) -> + "TLS_" ++ string:to_upper(atom_to_list(Cipher)) ++ + "_" ++ string:to_upper(atom_to_list(PRF)); +suite_to_str(#{key_exchange := Kex, + cipher := Cipher, + mac := aead, + prf := PRF}) -> + "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ + "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ + "_" ++ string:to_upper(atom_to_list(PRF)); +suite_to_str(#{key_exchange := Kex, + cipher := Cipher, + mac := Mac}) -> + "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ + "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ + "_" ++ string:to_upper(atom_to_list(Mac)). + +%%-------------------------------------------------------------------- +-spec suite_definition(cipher_suite()) -> erl_cipher_suite(). +%% +%% Description: Return erlang cipher suite definition. +%% Note: Currently not supported suites are commented away. +%% They should be supported or removed in the future. +%%------------------------------------------------------------------- +%% TLS v1.1 suites +suite_definition(?TLS_NULL_WITH_NULL_NULL) -> + #{key_exchange => null, + cipher => null, + mac => null, + prf => null}; +%% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension +%% to avoid handshake failure from old servers that do not ignore +%% hello extension data as they should. +suite_definition(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> + #{key_exchange => null, + cipher => null, + mac => null, + prf => null}; +suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> + #{key_exchange => rsa, + cipher => rc4_128, + mac => md5, + prf => default_prf}; +suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> + #{key_exchange => rsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> + #{key_exchange => rsa, + cipher => des_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> + #{key_exchange => dhe_dss, + cipher => des_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => dhe_dss, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> + #{key_exchange => dhe_rsa, + cipher => des_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => dhe_rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +%%% TSL V1.1 AES suites +suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> + #{key_exchange => rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> + #{key_exchange => dhe_dss, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> + #{key_exchange => dhe_rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> + #{key_exchange => rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> + #{key_exchange => dhe_dss, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> + #{key_exchange => dhe_rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +%% TLS v1.2 suites +%% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> +%% {rsa, null, sha, default_prf}; +suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => rsa, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> + #{key_exchange => rsa, + cipher => aes_256_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => dhe_dss, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => dhe_rsa, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> + #{key_exchange => dhe_dss, + cipher => aes_256_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> + #{key_exchange => dhe_rsa, + cipher => aes_256_cbc, + mac => sha256, + prf => default_prf}; +%% not defined YET: +%% TLS_DH_DSS_WITH_AES_128_CBC_SHA256 DH_DSS AES_128_CBC SHA256 +%% TLS_DH_RSA_WITH_AES_128_CBC_SHA256 DH_RSA AES_128_CBC SHA256 +%% TLS_DH_DSS_WITH_AES_256_CBC_SHA256 DH_DSS AES_256_CBC SHA256 +%% TLS_DH_RSA_WITH_AES_256_CBC_SHA256 DH_RSA AES_256_CBC SHA256 +%%% DH-ANON deprecated by TLS spec and not available +%%% by default, but good for testing purposes. +suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) -> + #{key_exchange => dh_anon, + cipher => rc4_128, + mac => md5, + prf => default_prf}; +suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) -> + #{key_exchange => dh_anon, + cipher => des_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => dh_anon, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> + #{key_exchange => dh_anon, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> + #{key_exchange => dh_anon, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => dh_anon, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA256) -> + #{key_exchange => dh_anon, + cipher => aes_256_cbc, + mac => sha256, + prf => default_prf}; +%%% PSK Cipher Suites RFC 4279 +suite_definition(?TLS_PSK_WITH_RC4_128_SHA) -> + #{key_exchange => psk, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => psk, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA) -> + #{key_exchange => psk, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA) -> + #{key_exchange => psk, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_RC4_128_SHA) -> + #{key_exchange => dhe_psk, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => dhe_psk, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA) -> + #{key_exchange => dhe_psk, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA) -> + #{key_exchange => dhe_psk, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_RC4_128_SHA) -> + #{key_exchange => rsa_psk, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => rsa_psk, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA) -> + #{key_exchange => rsa_psk, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> + #{key_exchange => rsa_psk, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +%%% PSK NULL Cipher Suites RFC 4785 +suite_definition(?TLS_PSK_WITH_NULL_SHA) -> + #{key_exchange => psk, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA) -> + #{key_exchange => dhe_psk, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA) -> + #{key_exchange => rsa_psk, + cipher => null, + mac => sha, + prf => default_prf}; +%%% TLS 1.2 PSK Cipher Suites RFC 5487 +suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => psk, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => psk, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => dhe_psk, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => dhe_psk, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => rsa_psk, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => rsa_psk, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => psk, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => psk, + cipher => aes_256_cbc, + mac => sha384, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => dhe_psk, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => dhe_psk, + cipher => aes_256_cbc, + mac => sha384, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => rsa_psk, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => rsa_psk, + cipher => aes_256_cbc, + mac => sha384, + prf => default_prf}; +suite_definition(?TLS_PSK_WITH_NULL_SHA256) -> + #{key_exchange => psk, + cipher => null, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_PSK_WITH_NULL_SHA384) -> + #{key_exchange => psk, + cipher => null, + mac => sha384, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA256) -> + #{key_exchange => dhe_psk, + cipher => null, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA384) -> + #{key_exchange => dhe_psk, + cipher => null, + mac => sha384, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA256) -> + #{key_exchange => rsa_psk, + cipher => null, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA384) -> + #{key_exchange => rsa_psk, + cipher => null, + mac => sha384, + prf => default_prf}; +%%% ECDHE PSK Cipher Suites RFC 5489 +suite_definition(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) -> + #{key_exchange => ecdhe_psk, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => ecdhe_psk, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) -> + #{key_exchange => ecdhe_psk, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) -> + #{key_exchange => ecdhe_psk, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => ecdhe_psk, + cipher => aes_128_cbc, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => ecdhe_psk, + cipher => aes_256_cbc, + mac => sha384, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> + #{key_exchange => ecdhe_psk, + cipher => null, + mac => sha256, + prf => default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> + #{key_exchange => ecdhe_psk, + cipher => null, mac => sha384, + prf => default_prf}; +%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => ecdhe_psk, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => ecdhe_psk, + cipher => aes_256_gcm, + mac => null, + prf => sha384}; +%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> +%% #{key_exchange => ecdhe_psk, +%% cipher => aes_128_ccm, +%% mac => null, +%% prf =>sha256}; +%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> +%% #{key_exchange => ecdhe_psk, +%% cipher => aes_256_ccm, +%% mac => null, +%% prf => sha256}; +%%% SRP Cipher Suites RFC 5054 +suite_definition(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => srp_anon, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => srp_rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => srp_dss, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_SRP_SHA_WITH_AES_128_CBC_SHA) -> + #{key_exchange => srp_anon, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> + #{key_exchange => srp_rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> + #{key_exchange => srp_dss, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_SRP_SHA_WITH_AES_256_CBC_SHA) -> + #{key_exchange => srp_anon, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> + #{key_exchange => srp_rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> + #{key_exchange => srp_dss, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +%% RFC 4492 EC TLS suites +suite_definition(?TLS_ECDH_ECDSA_WITH_NULL_SHA) -> + #{key_exchange => ecdh_ecdsa, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> + #{key_exchange => ecdh_ecdsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => ecdh_ecdsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> + #{key_exchange => ecdh_ecdsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> + #{key_exchange => ecdh_ecdsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_NULL_SHA) -> + #{key_exchange => ecdhe_ecdsa, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> + #{key_exchange => ecdhe_ecdsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => ecdhe_ecdsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_NULL_SHA) -> + #{key_exchange => ecdh_rsa, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> + #{key_exchange => ecdh_rsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => ecdh_rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> + #{key_exchange => ecdh_rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> + #{key_exchange => ecdh_rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_NULL_SHA) -> + #{key_exchange => ecdhe_rsa, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> + #{key_exchange => ecdhe_rsa, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => ecdhe_rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> + #{key_exchange => ecdhe_rsa, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> + #{key_exchange => ecdhe_rsa, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_NULL_SHA) -> + #{key_exchange => ecdh_anon, + cipher => null, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_RC4_128_SHA) -> + #{key_exchange => ecdh_anon, + cipher => rc4_128, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA) -> + #{key_exchange => ecdh_anon, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_AES_128_CBC_SHA) -> + #{key_exchange => ecdh_anon, + cipher => aes_128_cbc, + mac => sha, + prf => default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_AES_256_CBC_SHA) -> + #{key_exchange => ecdh_anon, + cipher => aes_256_cbc, + mac => sha, + prf => default_prf}; +%% RFC 5289 EC TLS suites +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_128_cbc, + mac => sha256, + prf => sha256}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_256_cbc, + mac => sha384, + prf => sha384}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => ecdh_ecdsa, + cipher => aes_128_cbc, + mac => sha256, + prf => sha256}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => ecdh_ecdsa, + cipher => aes_256_cbc, + mac => sha384, + prf => sha384}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => ecdhe_rsa, + cipher => aes_128_cbc, + mac => sha256, + prf => sha256}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => ecdhe_rsa, + cipher => aes_256_cbc, + mac => sha384, + prf => sha384}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> + #{key_exchange => ecdh_rsa, + cipher => aes_128_cbc, + mac => sha256, + prf => sha256}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> + #{key_exchange => ecdh_rsa, + cipher => aes_256_cbc, + mac => sha384, + prf => sha384}; +%% RFC 5288 AES-GCM Cipher Suites +suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => rsa, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => rsa, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => dhe_rsa, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => dhe_rsa, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => dh_rsa, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => dh_rsa, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => dhe_dss, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => dhe_dss, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => dh_dss, + cipher => aes_128_gcm, + mac => null, + prf => sha256}; +suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => dh_dss, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => dh_anon, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => dh_anon, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +%% RFC 5289 ECC AES-GCM Cipher Suites +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => ecdh_ecdsa, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => ecdh_ecdsa, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => ecdhe_rsa, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => ecdhe_rsa, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> + #{key_exchange => ecdh_rsa, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> + #{key_exchange => ecdh_rsa, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites +suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> + #{key_exchange => ecdhe_rsa, + cipher => chacha20_poly1305, + mac => aead, + prf => sha256}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> + #{key_exchange => ecdhe_ecdsa, + cipher => chacha20_poly1305, + mac => aead, + prf => sha256}; +suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> + #{key_exchange => dhe_rsa, + cipher => chacha20_poly1305, + mac => aead, + prf => sha256}; +%% TLS 1.3 Cipher Suites RFC8446 +suite_definition(?TLS_AES_128_GCM_SHA256) -> + #{key_exchange => any, + cipher => aes_128_gcm, + mac => aead, + prf => sha256}; +suite_definition(?TLS_AES_256_GCM_SHA384) -> + #{key_exchange => any, + cipher => aes_256_gcm, + mac => aead, + prf => sha384}; +suite_definition(?TLS_CHACHA20_POLY1305_SHA256) -> + #{key_exchange => any, + cipher => chacha20_poly1305, + mac => aead, + prf => sha256}. +%% suite_definition(?TLS_AES_128_CCM_SHA256) -> +%% #{key_exchange => any, +%% cipher => aes_128_ccm, +%% mac => aead, +%% prf => sha256}; +%% suite_definition(?TLS_AES_128_CCM_8_SHA256) -> +%% #{key_exchange => any, +%% cipher => aes_128_ccm_8, +%% mac => aead, +%% prf => sha256}. + + +%%-------------------------------------------------------------------- +-spec erl_suite_definition(cipher_suite() | erl_cipher_suite()) -> old_erl_cipher_suite(). +%% +%% Description: Return erlang cipher suite definition. Filters last value +%% for now (compatibility reasons). +%%-------------------------------------------------------------------- +erl_suite_definition(Bin) when is_binary(Bin) -> + erl_suite_definition(suite_definition(Bin)); +erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher, + mac := Hash, prf := Prf}) -> + case Prf of + default_prf -> + {KeyExchange, Cipher, Hash}; + _ -> + {KeyExchange, Cipher, Hash, Prf} + end. + +%%-------------------------------------------------------------------- +-spec suite(erl_cipher_suite()) -> cipher_suite(). +%% +%% Description: Return TLS cipher suite definition. +%%-------------------------------------------------------------------- +%% TLS v1.1 suites +suite(#{key_exchange := rsa, + cipher := rc4_128, + mac := md5}) -> + ?TLS_RSA_WITH_RC4_128_MD5; +suite(#{key_exchange := rsa, + cipher := rc4_128, + mac := sha}) -> + ?TLS_RSA_WITH_RC4_128_SHA; +suite(#{key_exchange := rsa, + cipher := des_cbc, + mac := sha}) -> + ?TLS_RSA_WITH_DES_CBC_SHA; +suite(#{key_exchange := rsa, + cipher :='3des_ede_cbc', + mac := sha}) -> + ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := dhe_dss, + cipher:= des_cbc, + mac := sha}) -> + ?TLS_DHE_DSS_WITH_DES_CBC_SHA; +suite(#{key_exchange := dhe_dss, + cipher:= '3des_ede_cbc', + mac := sha}) -> + ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := dhe_rsa, + cipher:= des_cbc, + mac := sha}) -> + ?TLS_DHE_RSA_WITH_DES_CBC_SHA; +suite(#{key_exchange := dhe_rsa, + cipher:= '3des_ede_cbc', + mac := sha}) -> + ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := dh_anon, + cipher:= rc4_128, + mac := md5}) -> + ?TLS_DH_anon_WITH_RC4_128_MD5; +suite(#{key_exchange := dh_anon, + cipher:= des_cbc, + mac := sha}) -> + ?TLS_DH_anon_WITH_DES_CBC_SHA; +suite(#{key_exchange := dh_anon, + cipher:= '3des_ede_cbc', + mac := sha}) -> + ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; +%%% TSL V1.1 AES suites +suite(#{key_exchange := rsa, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_RSA_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := dhe_dss, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := dhe_rsa, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := dh_anon, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_DH_anon_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := rsa, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_RSA_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := dhe_dss, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := dhe_rsa, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := dh_anon, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_DH_anon_WITH_AES_256_CBC_SHA; +%% TLS v1.2 suites +suite(#{key_exchange := rsa, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_RSA_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := rsa, + cipher := aes_256_cbc, + mac := sha256}) -> + ?TLS_RSA_WITH_AES_256_CBC_SHA256; +suite(#{key_exchange := dhe_dss, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := dhe_rsa, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := dhe_dss, + cipher := aes_256_cbc, + mac := sha256}) -> + ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; +suite(#{key_exchange := dhe_rsa, + cipher := aes_256_cbc, + mac := sha256}) -> + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; +suite(#{key_exchange := dh_anon, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_DH_anon_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := dh_anon, + cipher := aes_256_cbc, + mac := sha256}) -> + ?TLS_DH_anon_WITH_AES_256_CBC_SHA256; +%%% PSK Cipher Suites RFC 4279 +suite(#{key_exchange := psk, + cipher := rc4_128, + mac := sha}) -> + ?TLS_PSK_WITH_RC4_128_SHA; +suite(#{key_exchange := psk, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_PSK_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := psk, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_PSK_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := psk, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_PSK_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := dhe_psk, + cipher := rc4_128, + mac := sha}) -> + ?TLS_DHE_PSK_WITH_RC4_128_SHA; +suite(#{key_exchange := dhe_psk, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := dhe_psk, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := dhe_psk, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := rsa_psk, + cipher := rc4_128, + mac := sha}) -> + ?TLS_RSA_PSK_WITH_RC4_128_SHA; +suite(#{key_exchange := rsa_psk, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := rsa_psk, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := rsa_psk, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA; +%%% PSK NULL Cipher Suites RFC 4785 +suite(#{key_exchange := psk, + cipher := null, + mac := sha}) -> + ?TLS_PSK_WITH_NULL_SHA; +suite(#{key_exchange := dhe_psk, + cipher := null, + mac := sha}) -> + ?TLS_DHE_PSK_WITH_NULL_SHA; +suite(#{key_exchange := rsa_psk, + cipher := null, + mac := sha}) -> + ?TLS_RSA_PSK_WITH_NULL_SHA; +%%% TLS 1.2 PSK Cipher Suites RFC 5487 +suite(#{key_exchange := psk, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_PSK_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := psk, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_PSK_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := dhe_psk, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := dhe_psk, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := rsa_psk, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := rsa_psk, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := psk, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_PSK_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := psk, + cipher := aes_256_cbc, + mac := sha384}) -> + ?TLS_PSK_WITH_AES_256_CBC_SHA384; +suite(#{key_exchange := dhe_psk, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := dhe_psk, + cipher := aes_256_cbc, + mac := sha384}) -> + ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384; +suite(#{key_exchange := rsa_psk, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := rsa_psk, + cipher := aes_256_cbc, + mac := sha384}) -> + ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384; +suite(#{key_exchange := psk, + cipher := null, + mac := sha256}) -> + ?TLS_PSK_WITH_NULL_SHA256; +suite(#{key_exchange := psk, + cipher := null, + mac := sha384}) -> + ?TLS_PSK_WITH_NULL_SHA384; +suite(#{key_exchange := dhe_psk, + cipher := null, + mac := sha256}) -> + ?TLS_DHE_PSK_WITH_NULL_SHA256; +suite(#{key_exchange := dhe_psk, + cipher := null, + mac := sha384}) -> + ?TLS_DHE_PSK_WITH_NULL_SHA384; +suite(#{key_exchange := rsa_psk, + cipher := null, + mac := sha256}) -> + ?TLS_RSA_PSK_WITH_NULL_SHA256; +suite(#{key_exchange := rsa_psk, + cipher := null, + mac := sha384}) -> + ?TLS_RSA_PSK_WITH_NULL_SHA384; +%%% ECDHE PSK Cipher Suites RFC 5489 +suite(#{key_exchange := ecdhe_psk, + cipher := rc4_128, + mac := sha}) -> + ?TLS_ECDHE_PSK_WITH_RC4_128_SHA; +suite(#{key_exchange := ecdhe_psk, + cipher :='3des_ede_cbc', + mac := sha}) -> + ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_128_cbc, + mac := sha256}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_256_cbc, + mac := sha384}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384; +suite(#{key_exchange := ecdhe_psk, + cipher := null, + mac := sha256}) -> + ?TLS_ECDHE_PSK_WITH_NULL_SHA256; +suite(#{key_exchange := ecdhe_psk, + cipher := null, + mac := sha384}) -> + ?TLS_ECDHE_PSK_WITH_NULL_SHA384; +%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 +suite(#{key_exchange := ecdhe_psk, + cipher := aes_128_gcm, + mac := null, + prf := sha256}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := ecdhe_psk, + cipher := aes_256_gcm, + mac := null, + prf := sha384}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384; + %% suite(#{key_exchange := ecdhe_psk, + %% cipher := aes_128_ccm, + %% mac := null, + %% prf := sha256}) -> + %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256; + %% suite(#{key_exchange := ecdhe_psk, + %% cipher := aes_256_ccm, + %% mac := null, + %% prf := sha256}) -> + %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256; +%%% SRP Cipher Suites RFC 5054 +suite(#{key_exchange := srp_anon, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := srp_rsa, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := srp_dss, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := srp_anon, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := srp_rsa, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := srp_dss, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := srp_anon, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := srp_rsa, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := srp_dss, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; +%%% RFC 4492 EC TLS suites +suite(#{key_exchange := ecdh_ecdsa, + cipher := null, + mac := sha}) -> + ?TLS_ECDH_ECDSA_WITH_NULL_SHA; +suite(#{key_exchange := ecdh_ecdsa, + cipher := rc4_128, + mac := sha}) -> + ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; +suite(#{key_exchange := ecdh_ecdsa, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := ecdhe_ecdsa, + cipher := null, + mac := sha}) -> + ?TLS_ECDHE_ECDSA_WITH_NULL_SHA; +suite(#{key_exchange := ecdhe_ecdsa, + cipher := rc4_128, + mac := sha}) -> + ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; +suite(#{key_exchange := ecdhe_ecdsa, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := ecdh_rsa, + cipher := null, + mac := sha}) -> + ?TLS_ECDH_RSA_WITH_NULL_SHA; +suite(#{key_exchange := ecdh_rsa, + cipher := rc4_128, + mac := sha}) -> + ?TLS_ECDH_RSA_WITH_RC4_128_SHA; +suite(#{key_exchange := ecdh_rsa, + cipher := '3des_ede_cbc', mac := sha}) -> + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := ecdh_rsa, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := ecdh_rsa, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := ecdhe_rsa, + cipher := null, + mac := sha}) -> + ?TLS_ECDHE_RSA_WITH_NULL_SHA; +suite(#{key_exchange := ecdhe_rsa, + cipher := rc4_128, + mac := sha}) -> + ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; +suite(#{key_exchange := ecdhe_rsa, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; +suite(#{key_exchange := ecdh_anon, + cipher := null, + mac := sha}) -> + ?TLS_ECDH_anon_WITH_NULL_SHA; +suite(#{key_exchange := ecdh_anon, + cipher := rc4_128, + mac := sha}) -> + ?TLS_ECDH_anon_WITH_RC4_128_SHA; +suite(#{key_exchange := ecdh_anon, + cipher := '3des_ede_cbc', + mac := sha}) -> + ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA; +suite(#{key_exchange := ecdh_anon, + cipher := aes_128_cbc, + mac := sha}) -> + ?TLS_ECDH_anon_WITH_AES_128_CBC_SHA; +suite(#{key_exchange := ecdh_anon, + cipher := aes_256_cbc, + mac := sha}) -> + ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA; +%%% RFC 5289 EC TLS suites +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_128_cbc, + mac:= sha256, + prf := sha256}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_256_cbc, + mac := sha384, + prf := sha384}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_128_cbc, + mac := sha256, + prf := sha256}) -> + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_256_cbc, + mac := sha384, + prf := sha384}) -> + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_128_cbc, + mac := sha256, + prf := sha256}) -> + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_256_cbc, + mac := sha384, + prf := sha384}) -> + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; +suite(#{key_exchange := ecdh_rsa, + cipher := aes_128_cbc, + mac := sha256, + prf := sha256}) -> + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; +suite(#{key_exchange := ecdh_rsa, + cipher := aes_256_cbc, + mac := sha384, + prf := sha384}) -> + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; +%% RFC 5288 AES-GCM Cipher Suites +suite(#{key_exchange := rsa, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_RSA_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := rsa, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_RSA_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := dhe_rsa, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := dhe_rsa, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := dh_rsa, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := dh_rsa, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := dhe_dss, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := dhe_dss, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := dh_dss, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := dh_dss, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := dh_anon, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := dh_anon, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; +%% RFC 5289 ECC AES-GCM Cipher Suites +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := ecdhe_ecdsa, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := ecdh_ecdsa, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := ecdhe_rsa, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; +suite(#{key_exchange := ecdh_rsa, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; +suite(#{key_exchange := ecdh_rsa, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; +%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites +suite(#{key_exchange := ecdhe_rsa, + cipher := chacha20_poly1305, + mac := aead, + prf := sha256}) -> + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; +suite(#{key_exchange := ecdhe_ecdsa, + cipher := chacha20_poly1305, + mac := aead, + prf := sha256}) -> + ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; +suite(#{key_exchange := dhe_rsa, + cipher := chacha20_poly1305, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256; +%% TLS 1.3 Cipher Suites RFC8446 +suite(#{key_exchange := any, + cipher := aes_128_gcm, + mac := aead, + prf := sha256}) -> + ?TLS_AES_128_GCM_SHA256; +suite(#{key_exchange := any, + cipher := aes_256_gcm, + mac := aead, + prf := sha384}) -> + ?TLS_AES_256_GCM_SHA384; +suite(#{key_exchange := any, + cipher := chacha20_poly1305, + mac := aead, + prf := sha256}) -> + ?TLS_CHACHA20_POLY1305_SHA256. +%% suite(#{key_exchange := any, +%% cipher := aes_128_ccm, +%% mac := aead, +%% prf := sha256}) -> +%% ?TLS_AES_128_CCM_SHA256; +%% suite(#{key_exchange := any, +%% cipher := aes_128_ccm_8, +%% mac := aead, +%% prf := sha256}) -> +%% ?TLS_AES_128_CCM_8_SHA256. +%%-------------------------------------------------------------------- +-spec openssl_suite(openssl_cipher_suite()) -> cipher_suite(). +%% +%% Description: Return TLS cipher suite definition. +%%-------------------------------------------------------------------- +%% translate constants <-> openssl-strings +openssl_suite("DHE-RSA-AES256-SHA256") -> + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; +openssl_suite("DHE-DSS-AES256-SHA256") -> + ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; +openssl_suite("AES256-SHA256") -> + ?TLS_RSA_WITH_AES_256_CBC_SHA256; +openssl_suite("DHE-RSA-AES128-SHA256") -> + ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; +openssl_suite("DHE-DSS-AES128-SHA256") -> + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; +openssl_suite("AES128-SHA256") -> + ?TLS_RSA_WITH_AES_128_CBC_SHA256; +openssl_suite("DHE-RSA-AES256-SHA") -> + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; +openssl_suite("DHE-DSS-AES256-SHA") -> + ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; +openssl_suite("AES256-SHA") -> + ?TLS_RSA_WITH_AES_256_CBC_SHA; +openssl_suite("EDH-RSA-DES-CBC3-SHA") -> + ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("EDH-DSS-DES-CBC3-SHA") -> + ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; +openssl_suite("DES-CBC3-SHA") -> + ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("DHE-RSA-AES128-SHA") -> + ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; +openssl_suite("DHE-DSS-AES128-SHA") -> + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; +openssl_suite("AES128-SHA") -> + ?TLS_RSA_WITH_AES_128_CBC_SHA; +openssl_suite("RC4-SHA") -> + ?TLS_RSA_WITH_RC4_128_SHA; +openssl_suite("RC4-MD5") -> + ?TLS_RSA_WITH_RC4_128_MD5; +openssl_suite("EDH-RSA-DES-CBC-SHA") -> + ?TLS_DHE_RSA_WITH_DES_CBC_SHA; +openssl_suite("DES-CBC-SHA") -> + ?TLS_RSA_WITH_DES_CBC_SHA; + +%%% SRP Cipher Suites RFC 5054 + +openssl_suite("SRP-DSS-AES-256-CBC-SHA") -> + ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; +openssl_suite("SRP-RSA-AES-256-CBC-SHA") -> + ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; +openssl_suite("SRP-DSS-3DES-EDE-CBC-SHA") -> + ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; +openssl_suite("SRP-RSA-3DES-EDE-CBC-SHA") -> + ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("SRP-DSS-AES-128-CBC-SHA") -> + ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; +openssl_suite("SRP-RSA-AES-128-CBC-SHA") -> + ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; + +%% RFC 4492 EC TLS suites +openssl_suite("ECDH-ECDSA-RC4-SHA") -> + ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; +openssl_suite("ECDH-ECDSA-DES-CBC3-SHA") -> + ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("ECDH-ECDSA-AES128-SHA") -> + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; +openssl_suite("ECDH-ECDSA-AES256-SHA") -> + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; + +openssl_suite("ECDHE-ECDSA-RC4-SHA") -> + ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; +openssl_suite("ECDHE-ECDSA-DES-CBC3-SHA") -> + ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("ECDHE-ECDSA-AES128-SHA") -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; +openssl_suite("ECDHE-ECDSA-AES256-SHA") -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; + +openssl_suite("ECDHE-RSA-RC4-SHA") -> + ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; +openssl_suite("ECDHE-RSA-DES-CBC3-SHA") -> + ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("ECDHE-RSA-AES128-SHA") -> + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; +openssl_suite("ECDHE-RSA-AES256-SHA") -> + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; + +openssl_suite("ECDH-RSA-RC4-SHA") -> + ?TLS_ECDH_RSA_WITH_RC4_128_SHA; +openssl_suite("ECDH-RSA-DES-CBC3-SHA") -> + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("ECDH-RSA-AES128-SHA") -> + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; +openssl_suite("ECDH-RSA-AES256-SHA") -> + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; + +%% RFC 5289 EC TLS suites +openssl_suite("ECDHE-ECDSA-AES128-SHA256") -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; +openssl_suite("ECDHE-ECDSA-AES256-SHA384") -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; +openssl_suite("ECDH-ECDSA-AES128-SHA256") -> + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; +openssl_suite("ECDH-ECDSA-AES256-SHA384") -> + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; +openssl_suite("ECDHE-RSA-AES128-SHA256") -> + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; +openssl_suite("ECDHE-RSA-AES256-SHA384") -> + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; +openssl_suite("ECDH-RSA-AES128-SHA256") -> + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; +openssl_suite("ECDH-RSA-AES256-SHA384") -> + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; + +%% RFC 5288 AES-GCM Cipher Suites +openssl_suite("AES128-GCM-SHA256") -> + ?TLS_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("AES256-GCM-SHA384") -> + ?TLS_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DHE-RSA-AES128-GCM-SHA256") -> + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("DHE-RSA-AES256-GCM-SHA384") -> + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DH-RSA-AES128-GCM-SHA256") -> + ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("DH-RSA-AES256-GCM-SHA384") -> + ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DHE-DSS-AES128-GCM-SHA256") -> + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; +openssl_suite("DHE-DSS-AES256-GCM-SHA384") -> + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; +openssl_suite("DH-DSS-AES128-GCM-SHA256") -> + ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; +openssl_suite("DH-DSS-AES256-GCM-SHA384") -> + ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; + +%% RFC 5289 ECC AES-GCM Cipher Suites +openssl_suite("ECDHE-ECDSA-AES128-GCM-SHA256") -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDHE-ECDSA-AES256-GCM-SHA384") -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDH-ECDSA-AES128-GCM-SHA256") -> + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDH-ECDSA-AES256-GCM-SHA384") -> + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDHE-RSA-AES128-GCM-SHA256") -> + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDHE-RSA-AES256-GCM-SHA384") -> + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDH-RSA-AES128-GCM-SHA256") -> + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDH-RSA-AES256-GCM-SHA384") -> + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; + +%% TLS 1.3 Cipher Suites RFC8446 +openssl_suite("TLS_AES_128_GCM_SHA256") -> + ?TLS_AES_128_GCM_SHA256; +openssl_suite("TLS_AES_256_GCM_SHA384") -> + ?TLS_AES_256_GCM_SHA384; +openssl_suite("TLS_CHACHA20_POLY1305_SHA256") -> + ?TLS_CHACHA20_POLY1305_SHA256. +%% openssl_suite("TLS_AES_128_CCM_SHA256") -> +%% ?TLS_AES_128_CCM_SHA256; +%% openssl_suite("TLS_AES_128_CCM_8_SHA256") -> +%% ?TLS_AES_128_CCM_8_SHA256. + + +%%-------------------------------------------------------------------- +-spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | erl_cipher_suite(). +%% +%% Description: Return openssl cipher suite name if possible +%%------------------------------------------------------------------- +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> + "DHE-RSA-AES256-SHA"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> + "DHE-DSS-AES256-SHA"; +openssl_suite_name(?TLS_RSA_WITH_AES_256_CBC_SHA) -> + "AES256-SHA"; +openssl_suite_name(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> + "EDH-RSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> + "EDH-DSS-DES-CBC3-SHA"; +openssl_suite_name(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> + "DES-CBC3-SHA"; +openssl_suite_name( ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> + "DHE-RSA-AES128-SHA"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> + "DHE-DSS-AES128-SHA"; +openssl_suite_name(?TLS_RSA_WITH_AES_128_CBC_SHA) -> + "AES128-SHA"; +openssl_suite_name(?TLS_RSA_WITH_RC4_128_SHA) -> + "RC4-SHA"; +openssl_suite_name(?TLS_RSA_WITH_RC4_128_MD5) -> + "RC4-MD5"; +openssl_suite_name(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> + "EDH-RSA-DES-CBC-SHA"; +openssl_suite_name(?TLS_RSA_WITH_DES_CBC_SHA) -> + "DES-CBC-SHA"; +openssl_suite_name(?TLS_RSA_WITH_NULL_SHA256) -> + "NULL-SHA256"; +openssl_suite_name(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> + "AES128-SHA256"; +openssl_suite_name(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> + "AES256-SHA256"; +openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_CBC_SHA256) -> + "DH-DSS-AES128-SHA256"; +openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_CBC_SHA256) -> + "DH-RSA-AES128-SHA256"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> + "DHE-DSS-AES128-SHA256"; +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> + "DHE-RSA-AES128-SHA256"; +openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_CBC_SHA256) -> + "DH-DSS-AES256-SHA256"; +openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_CBC_SHA256) -> + "DH-RSA-AES256-SHA256"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> + "DHE-DSS-AES256-SHA256"; +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> + "DHE-RSA-AES256-SHA256"; + +%%% PSK Cipher Suites RFC 4279 + +openssl_suite_name(?TLS_PSK_WITH_AES_256_CBC_SHA) -> + "PSK-AES256-CBC-SHA"; +openssl_suite_name(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> + "PSK-3DES-EDE-CBC-SHA"; +openssl_suite_name(?TLS_PSK_WITH_AES_128_CBC_SHA) -> + "PSK-AES128-CBC-SHA"; +openssl_suite_name(?TLS_PSK_WITH_RC4_128_SHA) -> + "PSK-RC4-SHA"; + +%%% SRP Cipher Suites RFC 5054 + +openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> + "SRP-RSA-3DES-EDE-CBC-SHA"; +openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> + "SRP-DSS-3DES-EDE-CBC-SHA"; +openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> + "SRP-RSA-AES-128-CBC-SHA"; +openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> + "SRP-DSS-AES-128-CBC-SHA"; +openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> + "SRP-RSA-AES-256-CBC-SHA"; +openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> + "SRP-DSS-AES-256-CBC-SHA"; + +%% RFC 4492 EC TLS suites +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> + "ECDH-ECDSA-RC4-SHA"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> + "ECDH-ECDSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> + "ECDH-ECDSA-AES128-SHA"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> + "ECDH-ECDSA-AES256-SHA"; + +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> + "ECDHE-ECDSA-RC4-SHA"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> + "ECDHE-ECDSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> + "ECDHE-ECDSA-AES128-SHA"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> + "ECDHE-ECDSA-AES256-SHA"; + +openssl_suite_name(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> + "ECDH-RSA-RC4-SHA"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> + "ECDH-RSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> + "ECDH-RSA-AES128-SHA"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> + "ECDH-RSA-AES256-SHA"; + +openssl_suite_name(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> + "ECDHE-RSA-RC4-SHA"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> + "ECDHE-RSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> + "ECDHE-RSA-AES128-SHA"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> + "ECDHE-RSA-AES256-SHA"; + +%% RFC 5289 EC TLS suites +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> + "ECDHE-ECDSA-AES128-SHA256"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> + "ECDHE-ECDSA-AES256-SHA384"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> + "ECDH-ECDSA-AES128-SHA256"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> + "ECDH-ECDSA-AES256-SHA384"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> + "ECDHE-RSA-AES128-SHA256"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> + "ECDHE-RSA-AES256-SHA384"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> + "ECDH-RSA-AES128-SHA256"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> + "ECDH-RSA-AES256-SHA384"; + +%% RFC 5288 AES-GCM Cipher Suites +openssl_suite_name(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> + "AES128-GCM-SHA256"; +openssl_suite_name(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> + "AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> + "DHE-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> + "DHE-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> + "DH-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> + "DH-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> + "DHE-DSS-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> + "DHE-DSS-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> + "DH-DSS-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> + "DH-DSS-AES256-GCM-SHA384"; + +%% RFC 5289 ECC AES-GCM Cipher Suites +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> + "ECDHE-ECDSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> + "ECDHE-ECDSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> + "ECDH-ECDSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> + "ECDH-ECDSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> + "ECDHE-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> + "ECDHE-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> + "ECDH-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> + "ECDH-RSA-AES256-GCM-SHA384"; + +%% TLS 1.3 Cipher Suites RFC8446 +openssl_suite_name(?TLS_AES_128_GCM_SHA256) -> + "TLS_AES_128_GCM_SHA256"; +openssl_suite_name(?TLS_AES_256_GCM_SHA384) -> + "TLS_AES_256_GCM_SHA384"; +openssl_suite_name(?TLS_CHACHA20_POLY1305_SHA256) -> + "TLS_CHACHA20_POLY1305_SHA256"; +%% openssl_suite(?TLS_AES_128_CCM_SHA256) -> +%% "TLS_AES_128_CCM_SHA256"; +%% openssl_suite(?TLS_AES_128_CCM_8_SHA256) -> +%% "TLS_AES_128_CCM_8_SHA256"; + +%% No oppenssl name +openssl_suite_name(Cipher) -> + suite_definition(Cipher). diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl index 63c0a416ef..1e6dab9276 100644 --- a/lib/ssl/src/ssl_config.erl +++ b/lib/ssl/src/ssl_config.erl @@ -91,9 +91,9 @@ init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, server end; init_certificates(Cert, Config, _, _) -> {ok, Config#{own_certificate => Cert}}. -init_private_key(_, #{algorithm := Alg} = Key, <<>>, _Password, _Client) when Alg == ecdsa; - Alg == rsa; - Alg == dss -> +init_private_key(_, #{algorithm := Alg} = Key, _, _Password, _Client) when Alg == ecdsa; + Alg == rsa; + Alg == dss -> case maps:is_key(engine, Key) andalso maps:is_key(key_id, Key) of true -> Key; diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index bd17f19d10..66e96f8da5 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -56,7 +56,7 @@ ]). %% Data handling --export([write_application_data/3, read_application_data/2]). +-export([read_application_data/2, internal_renegotiation/2]). %% Help functions for tls|dtls_connection.erl -export([handle_session/7, ssl_config/3, @@ -65,13 +65,13 @@ %% General gen_statem state functions with extra callback argument %% to determine if it is an SSL/TLS or DTLS gen_statem machine -export([init/4, error/4, hello/4, user_hello/4, abbreviated/4, certify/4, cipher/4, - connection/4, death_row/4, downgrade/4]). + connection/4, downgrade/4]). %% gen_statem callbacks -export([terminate/3, format_status/2]). %% Erlang Distribution export --export([get_sslsocket/1, handshake_complete/3]). +-export([get_sslsocket/1, dist_handshake_complete/2]). %%==================================================================== %% Setup @@ -119,7 +119,7 @@ handshake(Connection, Port, Socket, Opts, User, CbInfo, Timeout) -> %% %% Description: Starts ssl handshake. %%-------------------------------------------------------------------- -handshake(#sslsocket{pid = Pid} = Socket, Timeout) -> +handshake(#sslsocket{pid = [Pid|_]} = Socket, Timeout) -> case call(Pid, {start, Timeout}) of connected -> {ok, Socket}; @@ -135,7 +135,7 @@ handshake(#sslsocket{pid = Pid} = Socket, Timeout) -> %% %% Description: Starts ssl handshake with some new options %%-------------------------------------------------------------------- -handshake(#sslsocket{pid = Pid} = Socket, SslOptions, Timeout) -> +handshake(#sslsocket{pid = [Pid|_]} = Socket, SslOptions, Timeout) -> case call(Pid, {start, SslOptions, Timeout}) of connected -> {ok, Socket}; @@ -149,7 +149,7 @@ handshake(#sslsocket{pid = Pid} = Socket, SslOptions, Timeout) -> %% %% Description: Continues handshake with new options %%-------------------------------------------------------------------- -handshake_continue(#sslsocket{pid = Pid} = Socket, SslOptions, Timeout) -> +handshake_continue(#sslsocket{pid = [Pid|_]} = Socket, SslOptions, Timeout) -> case call(Pid, {handshake_continue, SslOptions, Timeout}) of connected -> {ok, Socket}; @@ -161,7 +161,7 @@ handshake_continue(#sslsocket{pid = Pid} = Socket, SslOptions, Timeout) -> %% %% Description: Cancels connection %%-------------------------------------------------------------------- -handshake_cancel(#sslsocket{pid = Pid}) -> +handshake_cancel(#sslsocket{pid = [Pid|_]}) -> case call(Pid, cancel) of closed -> ok; @@ -169,7 +169,7 @@ handshake_cancel(#sslsocket{pid = Pid}) -> Error end. %-------------------------------------------------------------------- --spec socket_control(tls_connection | dtls_connection, port(), pid(), atom()) -> +-spec socket_control(tls_connection | dtls_connection, port(), [pid()], atom()) -> {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Set the ssl process to own the accept socket @@ -178,24 +178,24 @@ socket_control(Connection, Socket, Pid, Transport) -> socket_control(Connection, Socket, Pid, Transport, undefined). %-------------------------------------------------------------------- --spec socket_control(tls_connection | dtls_connection, port(), pid(), atom(), pid()| undefined) -> +-spec socket_control(tls_connection | dtls_connection, port(), [pid()], atom(), pid()| atom()) -> {ok, #sslsocket{}} | {error, reason()}. %%-------------------------------------------------------------------- -socket_control(Connection, Socket, Pid, Transport, udp_listener) -> +socket_control(Connection, Socket, Pids, Transport, udp_listener) -> %% dtls listener process must have the socket control - {ok, Connection:socket(Pid, Transport, Socket, Connection, undefined)}; + {ok, Connection:socket(Pids, Transport, Socket, Connection, undefined)}; -socket_control(tls_connection = Connection, Socket, Pid, Transport, ListenTracker) -> +socket_control(tls_connection = Connection, Socket, [Pid|_] = Pids, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)}; + {ok, Connection:socket(Pids, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end; -socket_control(dtls_connection = Connection, {_, Socket}, Pid, Transport, ListenTracker) -> +socket_control(dtls_connection = Connection, {_, Socket}, [Pid|_] = Pids, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)}; + {ok, Connection:socket(Pids, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end. @@ -307,12 +307,20 @@ peer_certificate(ConnectionPid) -> renegotiation(ConnectionPid) -> call(ConnectionPid, renegotiate). +%%-------------------------------------------------------------------- +-spec internal_renegotiation(pid(), ssl_record:connection_states()) -> + ok. +%% +%% Description: Starts a renegotiation of the ssl session. +%%-------------------------------------------------------------------- +internal_renegotiation(ConnectionPid, #{current_write := WriteState}) -> + gen_statem:cast(ConnectionPid, {internal_renegotiate, WriteState}). get_sslsocket(ConnectionPid) -> call(ConnectionPid, get_sslsocket). -handshake_complete(ConnectionPid, Node, DHandle) -> - call(ConnectionPid, {handshake_complete, Node, DHandle}). +dist_handshake_complete(ConnectionPid, DHandle) -> + gen_statem:cast(ConnectionPid, {dist_handshake_complete, DHandle}). %%-------------------------------------------------------------------- -spec prf(pid(), binary() | 'master_secret', binary(), @@ -335,9 +343,9 @@ handle_own_alert(Alert, Version, StateName, connection_states = ConnectionStates, ssl_options = SslOpts} = State) -> try %% Try to tell the other side - {BinMsg, _} = + {BinMsg, _} = Connection:encode_alert(Alert, Version, ConnectionStates), - Connection:send(Transport, Socket, BinMsg), + Connection:send(Transport, Socket, BinMsg), Report = #{direction => outbound, protocol => 'tls_record', message => BinMsg}, @@ -360,8 +368,9 @@ handle_normal_shutdown(Alert, _, #state{socket = Socket, protocol_cb = Connection, start_or_recv_from = StartFrom, tracker = Tracker, - role = Role, renegotiation = {false, first}}) -> - alert_user(Transport, Tracker,Socket, StartFrom, Alert, Role, Connection); + role = Role, renegotiation = {false, first}} = State) -> + Pids = Connection:pids(State), + alert_user(Pids, Transport, Tracker,Socket, StartFrom, Alert, Role, Connection); handle_normal_shutdown(Alert, StateName, #state{socket = Socket, socket_options = Opts, @@ -369,20 +378,22 @@ handle_normal_shutdown(Alert, StateName, #state{socket = Socket, protocol_cb = Connection, user_application = {_Mon, Pid}, tracker = Tracker, - start_or_recv_from = RecvFrom, role = Role}) -> - alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, Connection). + start_or_recv_from = RecvFrom, role = Role} = State) -> + Pids = Connection:pids(State), + alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, Connection). handle_alert(#alert{level = ?FATAL} = Alert, StateName, #state{socket = Socket, transport_cb = Transport, protocol_cb = Connection, ssl_options = SslOpts, start_or_recv_from = From, host = Host, port = Port, session = Session, user_application = {_Mon, Pid}, - role = Role, socket_options = Opts, tracker = Tracker} = State) -> + role = Role, socket_options = Opts, + tracker = Tracker} = State) -> invalidate_session(Role, Host, Port, Session), - log_alert(SslOpts#ssl_options.log_level, Role, - Connection:protocol_name(), StateName, - Alert#alert{role = opposite_role(Role)}), - alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection), + log_alert(SslOpts#ssl_options.log_level, Role, Connection:protocol_name(), + StateName, Alert#alert{role = opposite_role(Role)}), + Pids = Connection:pids(State), + alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection), stop(normal, State); handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, @@ -391,13 +402,24 @@ handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, stop({shutdown, peer_close}, State); handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, - #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) -> - log_alert(SslOpts#ssl_options.log_level, Role, - Connection:protocol_name(), StateName, - Alert#alert{role = opposite_role(Role)}), + #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, + renegotiation = {true, internal}} = State) -> + log_alert(SslOpts#ssl_options.log_level, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), handle_normal_shutdown(Alert, StateName, State), stop({shutdown, peer_close}, State); +handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, connection = StateName, + #state{role = Role, + ssl_options = SslOpts, renegotiation = {true, From}, + protocol_cb = Connection} = State0) -> + log_alert(SslOpts#ssl_options.log_level, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + gen_statem:reply(From, {error, renegotiation_rejected}), + State1 = Connection:reinit_handshake_data(State0), + {Record, State} = Connection:next_record(State1#state{renegotiation = undefined}), + Connection:next_event(connection, Record, State); + handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, #state{role = Role, ssl_options = SslOpts, renegotiation = {true, From}, @@ -408,7 +430,7 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, gen_statem:reply(From, {error, renegotiation_rejected}), {Record, State1} = Connection:next_record(State0), %% Go back to connection! - State = Connection:reinit_handshake_data(State1#state{renegotiation = undefined}), + State = Connection:reinit(State1#state{renegotiation = undefined}), Connection:next_event(connection, Record, State); %% Gracefully log and ignore all other warning alerts @@ -423,41 +445,6 @@ handle_alert(#alert{level = ?WARNING} = Alert, StateName, %%==================================================================== %% Data handling %%==================================================================== -write_application_data(Data0, {FromPid, _} = From, - #state{socket = Socket, - negotiated_version = Version, - protocol_cb = Connection, - transport_cb = Transport, - connection_states = ConnectionStates0, - socket_options = SockOpts, - ssl_options = #ssl_options{renegotiate_at = RenegotiateAt} = SslOpts} = State) -> - Data = encode_packet(Data0, SockOpts), - - case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of - true -> - Connection:renegotiate(State#state{renegotiation = {true, internal}}, - [{next_event, {call, From}, {application_data, Data0}}]); - false -> - {Msgs, ConnectionStates} = - Connection:encode_data(Data, Version, ConnectionStates0), - NewState = State#state{connection_states = ConnectionStates}, - RetVal = case Connection:send(Transport, Socket, Msgs) of - ok when FromPid =:= self() -> - hibernate_after(connection, NewState, []); - Error when FromPid =:= self() -> - stop({shutdown, Error}, NewState); - ok -> - hibernate_after(connection, NewState, [{reply, From, ok}]); - Result -> - hibernate_after(connection, NewState, [{reply, From, Result}]) - end, - Report = #{direction => outbound, - protocol => 'tls_record', - message => Msgs}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), - RetVal - end. - read_application_data(Data, #state{user_application = {_Mon, Pid}, socket = Socket, protocol_cb = Connection, @@ -475,58 +462,74 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, end, case get_data(SOpts, BytesToRead, Buffer1) of {ok, ClientData, Buffer} -> % Send data - case State0 of - #state{ - ssl_options = #ssl_options{erl_dist = true}, - protocol_specific = #{d_handle := DHandle}} -> - State = - State0#state{ - user_data_buffer = Buffer, - bytes_to_read = undefined}, - try erlang:dist_ctrl_put_data(DHandle, ClientData) of - _ - when SOpts#socket_options.active =:= false; - Buffer =:= <<>> -> - %% Passive mode, wait for active once or recv - %% Active and empty, get more data - Connection:next_record_if_active(State); - _ -> %% We have more data - read_application_data(<<>>, State) - catch error:_ -> - death_row(State, disconnect) - end; - _ -> - SocketOpt = - deliver_app_data( - Transport, Socket, SOpts, - ClientData, Pid, RecvFrom, Tracker, Connection), - cancel_timer(Timer), - State = - State0#state{ - user_data_buffer = Buffer, + #state{ssl_options = #ssl_options{erl_dist = Dist}, + erl_dist_data = DistData} = State0, + case Dist andalso is_dist_up(DistData) of + true -> + dist_app_data(ClientData, State0#state{user_data_buffer = Buffer, + bytes_to_read = undefined}); + _ -> + SocketOpt = + deliver_app_data(Connection:pids(State0), + Transport, Socket, SOpts, + ClientData, Pid, RecvFrom, Tracker, Connection), + cancel_timer(Timer), + State = + State0#state{ + user_data_buffer = Buffer, start_or_recv_from = undefined, timer = undefined, bytes_to_read = undefined, socket_options = SocketOpt - }, - if - SocketOpt#socket_options.active =:= false; - Buffer =:= <<>> -> - %% Passive mode, wait for active once or recv + }, + if + SocketOpt#socket_options.active =:= false; + Buffer =:= <<>> -> + %% Passive mode, wait for active once or recv %% Active and empty, get more data - Connection:next_record_if_active(State); - true -> %% We have more data - read_application_data(<<>>, State) - end - end; + Connection:next_record_if_active(State); + true -> %% We have more data + read_application_data(<<>>, State) + end + end; {more, Buffer} -> % no reply, we need more data Connection:next_record(State0#state{user_data_buffer = Buffer}); {passive, Buffer} -> Connection:next_record_if_active(State0#state{user_data_buffer = Buffer}); {error,_Reason} -> %% Invalid packet in packet mode - deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker, Connection), + deliver_packet_error(Connection:pids(State0), + Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker, Connection), stop(normal, State0) end. + +dist_app_data(ClientData, #state{protocol_cb = Connection, + erl_dist_data = #{dist_handle := undefined, + dist_buffer := DistBuff} = DistData} = State) -> + Connection:next_record_if_active(State#state{erl_dist_data = DistData#{dist_buffer => [ClientData, DistBuff]}}); +dist_app_data(ClientData, #state{erl_dist_data = #{dist_handle := DHandle, + dist_buffer := DistBuff} = ErlDistData, + protocol_cb = Connection, + user_data_buffer = Buffer, + socket_options = SOpts} = State) -> + Data = merge_dist_data(DistBuff, ClientData), + try erlang:dist_ctrl_put_data(DHandle, Data) of + _ when SOpts#socket_options.active =:= false; + Buffer =:= <<>> -> + %% Passive mode, wait for active once or recv + %% Active and empty, get more data + Connection:next_record_if_active(State#state{erl_dist_data = ErlDistData#{dist_buffer => <<>>}}); + _ -> %% We have more data + read_application_data(<<>>, State) + catch error:_ -> + stop(State, disconnect) + end. + +merge_dist_data(<<>>, ClientData) -> + ClientData; +merge_dist_data(DistBuff, <<>>) -> + DistBuff; +merge_dist_data(DistBuff, ClientData) -> + [DistBuff, ClientData]. %%==================================================================== %% Help functions for tls|dtls_connection.erl %%==================================================================== @@ -542,7 +545,7 @@ handle_session(#server_hello{cipher_suite = CipherSuite, negotiated_version = ReqVersion, negotiated_protocol = CurrentProtocol} = State0) -> #{key_exchange := KeyAlgorithm} = - ssl_cipher:suite_definition(CipherSuite), + ssl_cipher_format:suite_definition(CipherSuite), PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), @@ -626,12 +629,6 @@ init({call, From}, {start, {Opts, EmOpts}, Timeout}, socket_options = SockOpts} = State0, Connection) -> try SslOpts = ssl:handle_options(Opts, OrigSSLOptions), - case SslOpts of - #ssl_options{erl_dist = true} -> - process_flag(priority, max); - _ -> - ok - end, State = ssl_config(SslOpts, Role, State0), init({call, From}, {start, Timeout}, State#state{ssl_options = SslOpts, @@ -650,6 +647,8 @@ init(_Type, _Event, _State, _Connection) -> tls_connection | dtls_connection) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- +error({call, From}, {close, _}, State, _Connection) -> + stop_and_reply(normal, {reply, From, ok}, State); error({call, From}, _Msg, State, _Connection) -> {next_state, ?FUNCTION_NAME, State, [{reply, From, {error, closed}}]}. @@ -742,8 +741,8 @@ abbreviated(internal, #next_protocol{selected_protocol = SelectedProtocol}, Connection:next_event(?FUNCTION_NAME, Record, State#state{expecting_next_protocol_negotiation = false}); abbreviated(internal, - #change_cipher_spec{type = <<1>>}, #state{connection_states = ConnectionStates0} = - State0, Connection) -> + #change_cipher_spec{type = <<1>>}, + #state{connection_states = ConnectionStates0} = State0, Connection) -> ConnectionStates1 = ssl_record:activate_pending_connection_state(ConnectionStates0, read, Connection), {Record, State} = Connection:next_record(State0#state{connection_states = @@ -1039,22 +1038,6 @@ cipher(Type, Msg, State, Connection) -> #state{}, tls_connection | dtls_connection) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- -connection({call, {FromPid, _} = From}, {application_data, Data}, - #state{protocol_cb = Connection} = State, Connection) -> - %% We should look into having a worker process to do this to - %% parallize send and receive decoding and not block the receiver - %% if sending is overloading the socket. - try - write_application_data(Data, From, State) - catch throw:Error -> - case self() of - FromPid -> - stop({shutdown, Error}, State); - _ -> - hibernate_after( - ?FUNCTION_NAME, State, [{reply, From, Error}]) - end - end; connection({call, RecvFrom}, {recv, N, Timeout}, #state{protocol_cb = Connection, socket_options = #socket_options{active = false}} = State0, Connection) -> @@ -1081,64 +1064,25 @@ connection({call, From}, negotiated_protocol, #state{negotiated_protocol = SelectedProtocol} = State, _) -> hibernate_after(?FUNCTION_NAME, State, [{reply, From, {ok, SelectedProtocol}}]); -connection( - {call, From}, {handshake_complete, _Node, DHandle}, - #state{ - ssl_options = #ssl_options{erl_dist = true}, - socket_options = SockOpts, - protocol_specific = ProtocolSpecific} = State, - Connection) -> - %% From now on we execute on normal priority - process_flag(priority, normal), - try erlang:dist_ctrl_get_data_notification(DHandle) of - _ -> - NewState = - State#state{ - socket_options = - SockOpts#socket_options{active = true}, - protocol_specific = - ProtocolSpecific#{d_handle => DHandle}}, - {Record, NewerState} = Connection:next_record_if_active(NewState), - Connection:next_event(connection, Record, NewerState, [{reply, From, ok}]) - catch error:_ -> - death_row(State, disconnect) - end; connection({call, From}, Msg, State, Connection) -> handle_call(Msg, From, ?FUNCTION_NAME, State, Connection); -connection( - info, dist_data = Msg, - #state{ - ssl_options = #ssl_options{erl_dist = true}, - protocol_specific = #{d_handle := DHandle}} = State, - _) -> - eat_msgs(Msg), - try send_dist_data(?FUNCTION_NAME, State, DHandle, []) - catch error:_ -> - death_row(State, disconnect) - end; -connection( - info, {send, From, Ref, Data}, - #state{ - ssl_options = #ssl_options{erl_dist = true}, - protocol_specific = #{d_handle := _}}, - _) -> - %% This is for testing only! - %% - %% Needed by some OTP distribution - %% test suites... - From ! {Ref, ok}, - {keep_state_and_data, - [{next_event, {call, {self(), undefined}}, - {application_data, iolist_to_binary(Data)}}]}; -connection( - info, tick = Msg, - #state{ - ssl_options = #ssl_options{erl_dist = true}, - protocol_specific = #{d_handle := _}}, - _) -> - eat_msgs(Msg), - {keep_state_and_data, - [{next_event, {call, {self(), undefined}}, {application_data, <<>>}}]}; +connection(cast, {internal_renegotiate, WriteState}, #state{protocol_cb = Connection, + connection_states = ConnectionStates} + = State, Connection) -> + Connection:renegotiate(State#state{renegotiation = {true, internal}, + connection_states = ConnectionStates#{current_write => WriteState}}, []); +connection(cast, {dist_handshake_complete, DHandle}, + #state{ssl_options = #ssl_options{erl_dist = true}, + erl_dist_data = ErlDistData, + socket_options = SockOpts} = State0, Connection) -> + process_flag(priority, normal), + State1 = + State0#state{ + socket_options = + SockOpts#socket_options{active = true}, + erl_dist_data = ErlDistData#{dist_handle => DHandle}}, + {Record, State} = dist_app_data(<<>>, State1), + Connection:next_event(connection, Record, State); connection(info, Msg, State, _) -> handle_info(Msg, ?FUNCTION_NAME, State); connection(internal, {recv, _}, State, Connection) -> @@ -1147,32 +1091,6 @@ connection(Type, Msg, State, Connection) -> handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). %%-------------------------------------------------------------------- --spec death_row(gen_statem:event_type(), term(), - #state{}, tls_connection | dtls_connection) -> - gen_statem:state_function_result(). -%%-------------------------------------------------------------------- -%% We just wait for the owner to die which triggers the monitor, -%% or the socket may die too -death_row( - info, {'DOWN', MonitorRef, _, _, Reason}, - #state{user_application={MonitorRef,_Pid}}, - _) -> - {stop, {shutdown, Reason}}; -death_row( - info, {'EXIT', Socket, Reason}, #state{socket = Socket}, _) -> - {stop, {shutdown, Reason}}; -death_row(state_timeout, Reason, _State, _Connection) -> - {stop, {shutdown,Reason}}; -death_row(_Type, _Msg, _State, _Connection) -> - %% Waste all other events - keep_state_and_data. - -%% State entry function -death_row(State, Reason) -> - {next_state, death_row, State, - [{state_timeout, 5000, Reason}]}. - -%%-------------------------------------------------------------------- -spec downgrade(gen_statem:event_type(), term(), #state{}, tls_connection | dtls_connection) -> gen_statem:state_function_result(). @@ -1222,7 +1140,14 @@ handle_common_event(internal, {application_data, Data}, StateName, State0, Conne {stop, _, _} = Stop-> Stop; {Record, State} -> - Connection:next_event(StateName, Record, State) + case Connection:next_event(StateName, Record, State) of + {next_state, StateName, State} -> + hibernate_after(StateName, State, []); + {next_state, StateName, State, Actions} -> + hibernate_after(StateName, State, Actions); + {stop, _, _} = Stop -> + Stop + end end; handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName, #state{negotiated_version = Version} = State, _) -> @@ -1308,12 +1233,8 @@ handle_call({set_opts, Opts0}, From, StateName, handle_call(renegotiate, From, StateName, _, _) when StateName =/= connection -> {keep_state_and_data, [{reply, From, {error, already_renegotiating}}]}; -handle_call( - get_sslsocket, From, _StateName, - #state{transport_cb = Transport, socket = Socket, tracker = Tracker}, - Connection) -> - SslSocket = - Connection:socket(self(), Transport, Socket, Connection, Tracker), +handle_call(get_sslsocket, From, _StateName, State, Connection) -> + SslSocket = Connection:socket(State), {keep_state_and_data, [{reply, From, SslSocket}]}; handle_call({prf, Secret, Label, Seed, WantedLength}, From, _, @@ -1350,7 +1271,8 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, start_or_recv_from = StartFrom, role = Role, error_tag = ErrorTag, tracker = Tracker} = State) when StateName =/= connection -> - alert_user(Transport, Tracker,Socket, + Pids = Connection:pids(State), + alert_user(Pids, Transport, Tracker,Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role, Connection), stop(normal, State); @@ -1361,23 +1283,18 @@ handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), stop(normal, State); -handle_info( - {'DOWN', MonitorRef, _, _, Reason}, _, - #state{ - user_application = {MonitorRef, _Pid}, - ssl_options = #ssl_options{erl_dist = true}}) -> +handle_info({'DOWN', MonitorRef, _, _, Reason}, _, + #state{user_application = {MonitorRef, _Pid}, + ssl_options = #ssl_options{erl_dist = true}}) -> {stop, {shutdown, Reason}}; -handle_info( - {'DOWN', MonitorRef, _, _, _}, _, - #state{user_application = {MonitorRef, _Pid}}) -> +handle_info({'DOWN', MonitorRef, _, _, _}, _, + #state{user_application = {MonitorRef, _Pid}}) -> {stop, normal}; -handle_info( - {'EXIT', Pid, _Reason}, StateName, - #state{user_application = {_MonitorRef, Pid}} = State) -> +handle_info({'EXIT', Pid, _Reason}, StateName, + #state{user_application = {_MonitorRef, Pid}} = State) -> %% It seems the user application has linked to us %% - ignore that and let the monitor handle this {next_state, StateName, State}; - %%% So that terminate will be run when supervisor issues shutdown handle_info({'EXIT', _Sup, shutdown}, _StateName, State) -> stop(shutdown, State); @@ -1425,7 +1342,7 @@ terminate({shutdown, transport_closed} = Reason, socket = Socket, transport_cb = Transport} = State) -> handle_trusted_certs_db(State), Connection:close(Reason, Socket, Transport, undefined, undefined); -terminate({shutdown, own_alert}, _StateName, #state{%%send_queue = SendQueue, +terminate({shutdown, own_alert}, _StateName, #state{ protocol_cb = Connection, socket = Socket, transport_cb = Transport} = State) -> @@ -1436,15 +1353,14 @@ terminate({shutdown, own_alert}, _StateName, #state{%%send_queue = SendQueue, _ -> Connection:close({timeout, ?DEFAULT_TIMEOUT}, Socket, Transport, undefined, undefined) end; -terminate(Reason, connection, #state{negotiated_version = Version, - protocol_cb = Connection, - connection_states = ConnectionStates0, +terminate(Reason, connection, #state{protocol_cb = Connection, + connection_states = ConnectionStates, ssl_options = #ssl_options{padding_check = Check}, transport_cb = Transport, socket = Socket } = State) -> handle_trusted_certs_db(State), - {BinAlert, ConnectionStates} = terminate_alert(Reason, Version, ConnectionStates0, Connection), - Connection:send(Transport, Socket, BinAlert), + Alert = terminate_alert(Reason), + ok = Connection:send_alert_in_connection(Alert, State), Connection:close(Reason, Socket, Transport, ConnectionStates, Check); terminate(Reason, _StateName, #state{transport_cb = Transport, protocol_cb = Connection, socket = Socket @@ -1488,7 +1404,7 @@ connection_info(#state{sni_hostname = SNIHostname, negotiated_version = {_,_} = Version, ssl_options = Opts}) -> RecordCB = record_cb(Connection), - CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher:suite_definition(CipherSuite), + CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher_format:suite_definition(CipherSuite), IsNamedCurveSuite = lists:member(KexAlg, [ecdh_ecdsa, ecdhe_ecdsa, ecdh_rsa, ecdhe_rsa, ecdh_anon]), CurveInfo = case ECCCurve of @@ -1499,7 +1415,7 @@ connection_info(#state{sni_hostname = SNIHostname, end, [{protocol, RecordCB:protocol_version(Version)}, {session_id, SessionId}, - {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuiteDef)}, + {cipher_suite, ssl_cipher_format:erl_suite_definition(CipherSuiteDef)}, {selected_cipher_suite, CipherSuiteDef}, {sni_hostname, SNIHostname} | CurveInfo] ++ ssl_options_list(Opts). @@ -1515,13 +1431,18 @@ do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocol ServerHelloExt, #state{negotiated_version = Version, session = #session{session_id = SessId}, - connection_states = ConnectionStates0} + connection_states = ConnectionStates0, + ssl_options = #ssl_options{versions = [HighestVersion|_]}} = State0, Connection) when is_atom(Type) -> - + %% TLS 1.3 - Section 4.1.3 + %% Override server random values for TLS 1.3 downgrade protection mechanism. + ConnectionStates1 = update_server_random(ConnectionStates0, Version, HighestVersion), + State1 = State0#state{connection_states = ConnectionStates1}, ServerHello = - ssl_handshake:server_hello(SessId, ssl:tls_version(Version), ConnectionStates0, ServerHelloExt), + ssl_handshake:server_hello(SessId, ssl:tls_version(Version), + ConnectionStates1, ServerHelloExt), State = server_hello(ServerHello, - State0#state{expecting_next_protocol_negotiation = + State1#state{expecting_next_protocol_negotiation = NextProtocols =/= undefined}, Connection), case Type of new -> @@ -1530,6 +1451,60 @@ do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocol resumed_server_hello(State, Connection) end. +update_server_random(#{pending_read := #{security_parameters := ReadSecParams0} = + ReadState0, + pending_write := #{security_parameters := WriteSecParams0} = + WriteState0} = ConnectionStates, + Version, HighestVersion) -> + ReadRandom = override_server_random( + ReadSecParams0#security_parameters.server_random, + Version, + HighestVersion), + WriteRandom = override_server_random( + WriteSecParams0#security_parameters.server_random, + Version, + HighestVersion), + ReadSecParams = ReadSecParams0#security_parameters{server_random = ReadRandom}, + WriteSecParams = WriteSecParams0#security_parameters{server_random = WriteRandom}, + ReadState = ReadState0#{security_parameters => ReadSecParams}, + WriteState = WriteState0#{security_parameters => WriteSecParams}, + + ConnectionStates#{pending_read => ReadState, pending_write => WriteState}. + +%% TLS 1.3 - Section 4.1.3 +%% +%% If negotiating TLS 1.2, TLS 1.3 servers MUST set the last eight bytes +%% of their Random value to the bytes: +%% +%% 44 4F 57 4E 47 52 44 01 +%% +%% If negotiating TLS 1.1 or below, TLS 1.3 servers MUST and TLS 1.2 +%% servers SHOULD set the last eight bytes of their Random value to the +%% bytes: +%% +%% 44 4F 57 4E 47 52 44 00 +override_server_random(<<Random0:24/binary,_:8/binary>> = Random, {M,N}, {Major,Minor}) + when Major > 3 orelse Major =:= 3 andalso Minor >= 4 -> %% TLS 1.3 or above + if M =:= 3 andalso N =:= 3 -> %% Negotating TLS 1.2 + Down = ?RANDOM_OVERRIDE_TLS12, + <<Random0/binary,Down/binary>>; + M =:= 3 andalso N < 3 -> %% Negotating TLS 1.1 or prior + Down = ?RANDOM_OVERRIDE_TLS11, + <<Random0/binary,Down/binary>>; + true -> + Random + end; +override_server_random(<<Random0:24/binary,_:8/binary>> = Random, {M,N}, {Major,Minor}) + when Major =:= 3 andalso Minor =:= 3 -> %% TLS 1.2 + if M =:= 3 andalso N < 3 -> %% Negotating TLS 1.1 or prior + Down = ?RANDOM_OVERRIDE_TLS11, + <<Random0/binary,Down/binary>>; + true -> + Random + end; +override_server_random(Random, _, _) -> + Random. + new_server_hello(#server_hello{cipher_suite = CipherSuite, compression_method = Compression, session_id = SessionId}, @@ -1568,7 +1543,7 @@ resumed_server_hello(#state{session = Session, server_hello(ServerHello, State0, Connection) -> CipherSuite = ServerHello#server_hello.cipher_suite, - #{key_exchange := KeyAlgorithm} = ssl_cipher:suite_definition(CipherSuite), + #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_definition(CipherSuite), State = Connection:queue_handshake(ServerHello, State0), State#state{key_algorithm = KeyAlgorithm}. @@ -1582,7 +1557,7 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo, State1 = State0#state{session = Session#session{peer_certificate = PeerCert}, public_key_info = PublicKeyInfo}, - #{key_exchange := KeyAlgorithm} = ssl_cipher:suite_definition(CipherSuite), + #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_definition(CipherSuite), State2 = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlgorithm, State1), {Record, State} = Connection:next_record(State2), @@ -2189,22 +2164,24 @@ generate_srp_server_keys(_SrpParams, 10) -> generate_srp_server_keys(SrpParams = #srp_user{generator = Generator, prime = Prime, verifier = Verifier}, N) -> - case crypto:generate_key(srp, {host, [Verifier, Generator, Prime, '6a']}) of - error -> - generate_srp_server_keys(SrpParams, N+1); + try crypto:generate_key(srp, {host, [Verifier, Generator, Prime, '6a']}) of Keys -> Keys + catch + error:_ -> + generate_srp_server_keys(SrpParams, N+1) end. generate_srp_client_keys(_Generator, _Prime, 10) -> ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); generate_srp_client_keys(Generator, Prime, N) -> - case crypto:generate_key(srp, {user, [Generator, Prime, '6a']}) of - error -> - generate_srp_client_keys(Generator, Prime, N+1); + try crypto:generate_key(srp, {user, [Generator, Prime, '6a']}) of Keys -> Keys + catch + error:_ -> + generate_srp_client_keys(Generator, Prime, N+1) end. handle_srp_identity(Username, {Fun, UserState}) -> @@ -2391,18 +2368,13 @@ map_extensions(#hello_extensions{renegotiation_info = RenegotiationInfo, elliptic_curves => ssl_handshake:extension_value(ECCCurves), sni => ssl_handshake:extension_value(SNI)}. -terminate_alert(normal, Version, ConnectionStates, Connection) -> - Connection:encode_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), - Version, ConnectionStates); -terminate_alert({Reason, _}, Version, ConnectionStates, Connection) when Reason == close; - Reason == shutdown -> - Connection:encode_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), - Version, ConnectionStates); - -terminate_alert(_, Version, ConnectionStates, Connection) -> - {BinAlert, _} = Connection:encode_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR), - Version, ConnectionStates), - BinAlert. +terminate_alert(normal) -> + ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY); +terminate_alert({Reason, _}) when Reason == close; + Reason == shutdown -> + ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY); +terminate_alert(_) -> + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR). handle_trusted_certs_db(#state{ssl_options = #ssl_options{cacertfile = <<>>, cacerts = []}}) -> @@ -2411,7 +2383,7 @@ handle_trusted_certs_db(#state{ssl_options = handle_trusted_certs_db(#state{cert_db_ref = Ref, cert_db = CertDb, ssl_options = #ssl_options{cacertfile = <<>>}}) when CertDb =/= undefined -> - %% Certs provided as DER directly can not be shared + %% Certs provided as DER directly cannot be shared %% with other connections and it is safe to delete them when the connection ends. ssl_pkix_db:remove_trusted_certs(Ref, CertDb); handle_trusted_certs_db(#state{file_ref_db = undefined}) -> @@ -2432,16 +2404,15 @@ prepare_connection(#state{renegotiation = Renegotiate, start_or_recv_from = RecvFrom} = State0, Connection) when Renegotiate =/= {false, first}, RecvFrom =/= undefined -> - State1 = Connection:reinit_handshake_data(State0), + State1 = Connection:reinit(State0), {Record, State} = Connection:next_record(State1), {Record, ack_connection(State)}; prepare_connection(State0, Connection) -> - State = Connection:reinit_handshake_data(State0), + State = Connection:reinit(State0), {no_record, ack_connection(State)}. -ack_connection(#state{renegotiation = {true, Initiater}} = State) - when Initiater == internal; - Initiater == peer -> +ack_connection(#state{renegotiation = {true, Initiater}} = State) when Initiater == peer; + Initiater == internal -> State#state{renegotiation = undefined}; ack_connection(#state{renegotiation = {true, From}} = State) -> gen_statem:reply(From, ok), @@ -2547,7 +2518,7 @@ ssl_options_list([ciphers = Key | Keys], [Value | Values], Acc) -> ssl_options_list(Keys, Values, [{Key, lists:map( fun(Suite) -> - ssl_cipher:suite_definition(Suite) + ssl_cipher_format:suite_definition(Suite) end, Value)} | Acc]); ssl_options_list([Key | Keys], [Value | Values], Acc) -> @@ -2590,35 +2561,6 @@ handle_active_option(_, StateName0, To, Reply, #state{protocol_cb = Connection} end end. -encode_packet(Data, #socket_options{packet=Packet}) -> - case Packet of - 1 -> encode_size_packet(Data, 8, (1 bsl 8) - 1); - 2 -> encode_size_packet(Data, 16, (1 bsl 16) - 1); - 4 -> encode_size_packet(Data, 32, (1 bsl 32) - 1); - _ -> Data - end. - -encode_size_packet(Bin, Size, Max) -> - Len = erlang:byte_size(Bin), - case Len > Max of - true -> throw({error, {badarg, {packet_to_large, Len, Max}}}); - false -> <<Len:Size, Bin/binary>> - end. - -time_to_renegotiate(_Data, - #{current_write := #{sequence_number := Num}}, - RenegotiateAt) -> - - %% We could do test: - %% is_time_to_renegotiate((erlang:byte_size(_Data) div ?MAX_PLAIN_TEXT_LENGTH) + 1, RenegotiateAt), - %% but we chose to have a some what lower renegotiateAt and a much cheaper test - is_time_to_renegotiate(Num, RenegotiateAt). - -is_time_to_renegotiate(N, M) when N < M-> - false; -is_time_to_renegotiate(_,_) -> - true. - %% Picks ClientData get_data(_, _, <<>>) -> @@ -2665,9 +2607,10 @@ decode_packet(Type, Buffer, PacketOpts) -> %% Note that if the user has explicitly configured the socket to expect %% HTTP headers using the {packet, httph} option, we don't do any automatic %% switching of states. -deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packet=Type}, +deliver_app_data(CPids, Transport, Socket, SOpts = #socket_options{active=Active, packet=Type}, Data, Pid, From, Tracker, Connection) -> - send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data, Tracker, Connection)), + send_or_reply(Active, Pid, From, + format_reply(CPids, Transport, Socket, SOpts, Data, Tracker, Connection)), SO = case Data of {P, _, _, _} when ((P =:= http_request) or (P =:= http_response)), ((Type =:= http) or (Type =:= http_bin)) -> @@ -2686,21 +2629,24 @@ deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packe SO end. -format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet, +format_reply(_, _, _,#socket_options{active = false, mode = Mode, packet = Packet, header = Header}, Data, _, _) -> {ok, do_format_reply(Mode, Packet, Header, Data)}; -format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, +format_reply(CPids, Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, header = Header}, Data, Tracker, Connection) -> - {ssl, Connection:socket(self(), Transport, Socket, Connection, Tracker), + {ssl, Connection:socket(CPids, Transport, Socket, Connection, Tracker), do_format_reply(Mode, Packet, Header, Data)}. -deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From, Tracker, Connection) -> - send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data, Tracker, Connection)). +deliver_packet_error(CPids, Transport, Socket, + SO= #socket_options{active = Active}, Data, Pid, From, Tracker, Connection) -> + send_or_reply(Active, Pid, From, format_packet_error(CPids, + Transport, Socket, SO, Data, Tracker, Connection)). -format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data, _, _) -> +format_packet_error(_, _, _,#socket_options{active = false, mode = Mode}, Data, _, _) -> {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; -format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data, Tracker, Connection) -> - {ssl_error, Connection:socket(self(), Transport, Socket, Connection, Tracker), +format_packet_error(CPids, Transport, Socket, #socket_options{active = _, mode = Mode}, + Data, Tracker, Connection) -> + {ssl_error, Connection:socket(CPids, Transport, Socket, Connection, Tracker), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode @@ -2738,29 +2684,29 @@ send_user(Pid, Msg) -> Pid ! Msg, ok. -alert_user(Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role, Connection) -> - alert_user(Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role, Connection); -alert_user(Transport, Tracker, Socket,_, _, _, From, Alert, Role, Connection) -> - alert_user(Transport, Tracker, Socket, From, Alert, Role, Connection). +alert_user(Pids, Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role, Connection) -> + alert_user(Pids, Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role, Connection); +alert_user(Pids, Transport, Tracker, Socket,_, _, _, From, Alert, Role, Connection) -> + alert_user(Pids, Transport, Tracker, Socket, From, Alert, Role, Connection). -alert_user(Transport, Tracker, Socket, From, Alert, Role, Connection) -> - alert_user(Transport, Tracker, Socket, false, no_pid, From, Alert, Role, Connection). +alert_user(Pids, Transport, Tracker, Socket, From, Alert, Role, Connection) -> + alert_user(Pids, Transport, Tracker, Socket, false, no_pid, From, Alert, Role, Connection). -alert_user(_, _, _, false = Active, Pid, From, Alert, Role, _) when From =/= undefined -> +alert_user(_, _, _, _, false = Active, Pid, From, Alert, Role, _) when From =/= undefined -> %% If there is an outstanding ssl_accept | recv %% From will be defined and send_or_reply will %% send the appropriate error message. ReasonCode = ssl_alert:reason_code(Alert, Role), send_or_reply(Active, Pid, From, {error, ReasonCode}); -alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connection) -> +alert_user(Pids, Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connection) -> case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, - {ssl_closed, Connection:socket(self(), + {ssl_closed, Connection:socket(Pids, Transport, Socket, Connection, Tracker)}); ReasonCode -> send_or_reply(Active, Pid, From, - {ssl_error, Connection:socket(self(), + {ssl_error, Connection:socket(Pids, Transport, Socket, Connection, Tracker), ReasonCode}) end. @@ -2829,42 +2775,14 @@ new_emulated([], EmOpts) -> EmOpts; new_emulated(NewEmOpts, _) -> NewEmOpts. -%%---------------Erlang distribution -------------------------------------- - -send_dist_data(StateName, State, DHandle, Acc) -> - case erlang:dist_ctrl_get_data(DHandle) of - none -> - erlang:dist_ctrl_get_data_notification(DHandle), - hibernate_after(StateName, State, lists:reverse(Acc)); - Data -> - send_dist_data( - StateName, State, DHandle, - [{next_event, {call, {self(), undefined}}, {application_data, Data}} - |Acc]) - end. - -%% Overload mitigation -eat_msgs(Msg) -> - receive Msg -> eat_msgs(Msg) - after 0 -> ok - end. -%% When acting as distribution controller map the exit reason -%% to follow the documented nodedown_reason for net_kernel stop(Reason, State) -> - {stop, erl_dist_stop_reason(Reason, State), State}. + {stop, Reason, State}. stop_and_reply(Reason, Replies, State) -> - {stop_and_reply, erl_dist_stop_reason(Reason, State), Replies, State}. - -erl_dist_stop_reason( - Reason, #state{ssl_options = #ssl_options{erl_dist = true}}) -> - case Reason of - normal -> - %% We can not exit with normal since that will not bring - %% down the rest of the distribution processes - {shutdown, normal}; - _ -> Reason - end; -erl_dist_stop_reason(Reason, _State) -> - Reason. + {stop_and_reply, Reason, Replies, State}. + +is_dist_up(#{dist_handle := Handle}) when Handle =/= undefined -> + true; +is_dist_up(_) -> + false. diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 811aa779d5..66e3182313 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -44,6 +44,7 @@ host :: string() | inet:ip_address(), port :: integer(), socket :: port() | tuple(), %% TODO: dtls socket + sender :: pid() | undefined, ssl_options :: #ssl_options{}, socket_options :: #socket_options{}, connection_states :: ssl_record:connection_states() | secret_printout(), @@ -59,7 +60,7 @@ negotiated_version :: ssl_record:ssl_version() | 'undefined', client_hello_version :: ssl_record:ssl_version() | 'undefined', client_certificate_requested = false :: boolean(), - key_algorithm :: ssl_cipher:key_algo(), + key_algorithm :: ssl_cipher_format:key_algo(), hashsign_algorithm = {undefined, undefined}, cert_hashsign_algorithm = {undefined, undefined}, public_key_info :: ssl_handshake:public_key_info() | 'undefined', @@ -74,6 +75,7 @@ cert_db_ref :: certdb_ref() | 'undefined', bytes_to_read :: undefined | integer(), %% bytes to read in passive mode user_data_buffer :: undefined | binary() | secret_printout(), + erl_dist_data = #{} :: map(), renegotiation :: undefined | {boolean(), From::term() | internal | peer}, start_or_recv_from :: term(), timer :: undefined | reference(), % start_or_recive_timer diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 4d0bdd6386..54197ea0f3 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -53,7 +53,7 @@ -export([certify/7, certificate_verify/6, verify_signature/5, master_secret/4, server_key_exchange_hash/2, verify_connection/6, init_handshake_history/0, update_handshake_history/2, verify_server_key/5, - select_version/3, extension_value/1 + select_version/3, select_supported_version/2, extension_value/1 ]). %% Encode @@ -169,14 +169,14 @@ client_certificate_verify(OwnCert, MasterSecret, Version, end. %%-------------------------------------------------------------------- --spec certificate_request(ssl_cipher:cipher_suite(), db_handle(), +-spec certificate_request(ssl_cipher_format:cipher_suite(), db_handle(), certdb_ref(), #hash_sign_algos{}, ssl_record:ssl_version()) -> #certificate_request{}. %% %% Description: Creates a certificate_request message, called by the server. %%-------------------------------------------------------------------- certificate_request(CipherSuite, CertDbHandle, CertDbRef, HashSigns, Version) -> - Types = certificate_types(ssl_cipher:suite_definition(CipherSuite), Version), + Types = certificate_types(ssl_cipher_format:suite_definition(CipherSuite), Version), Authorities = certificate_authorities(CertDbHandle, CertDbRef), #certificate_request{ certificate_types = Types, @@ -505,6 +505,21 @@ verify_server_key(#server_key_params{params_bin = EncParams, select_version(RecordCB, ClientVersion, Versions) -> do_select_version(RecordCB, ClientVersion, Versions). + +%% Called by TLS 1.2/1.3 Server when "supported_versions" is present +%% in ClientHello. +%% Input lists are ordered (highest first) +select_supported_version([], _ServerVersions) -> + undefined; +select_supported_version([ClientVersion|T], ServerVersions) -> + case lists:member(ClientVersion, ServerVersions) of + true -> + ClientVersion; + false -> + select_supported_version(T, ServerVersions) + end. + + %%==================================================================== %% Encode handshake %%==================================================================== @@ -621,6 +636,14 @@ encode_hello_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Res Len = ListLen + 2, encode_hello_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), ?UINT16(ListLen), SignAlgoList/binary, Acc/binary>>); +encode_hello_extensions([#signature_scheme_list{ + signature_scheme_list = SignatureSchemes} | Rest], Acc) -> + SignSchemeList = << <<(ssl_cipher:signature_scheme(SignatureScheme)):16 >> || + SignatureScheme <- SignatureSchemes >>, + ListLen = byte_size(SignSchemeList), + Len = ListLen + 2, + encode_hello_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_CERT_EXT), + ?UINT16(Len), ?UINT16(ListLen), SignSchemeList/binary, Acc/binary>>); encode_hello_extensions([#sni{hostname = Hostname} | Rest], Acc) -> HostLen = length(Hostname), HostnameBin = list_to_binary(Hostname), @@ -632,7 +655,20 @@ encode_hello_extensions([#sni{hostname = Hostname} | Rest], Acc) -> ?UINT16(ServerNameLength), ?BYTE(?SNI_NAMETYPE_HOST_NAME), ?UINT16(HostLen), HostnameBin/binary, - Acc/binary>>). + Acc/binary>>); +encode_hello_extensions([#client_hello_versions{versions = Versions0} | Rest], Acc) -> + Versions = encode_versions(Versions0), + VerLen = byte_size(Versions), + Len = VerLen + 2, + encode_hello_extensions(Rest, <<?UINT16(?SUPPORTED_VERSIONS_EXT), + ?UINT16(Len), ?UINT16(VerLen), Versions/binary, Acc/binary>>); +encode_hello_extensions([#server_hello_selected_version{selected_version = Version0} | Rest], Acc) -> + Version = encode_versions(Version0), + Len = byte_size(Version), %% 2 + encode_hello_extensions(Rest, <<?UINT16(?SUPPORTED_VERSIONS_EXT), + ?UINT16(Len), Version/binary, Acc/binary>>). + + encode_client_protocol_negotiation(undefined, _) -> undefined; @@ -730,7 +766,7 @@ decode_hello_extensions(Extensions) -> dec_hello_extensions(Extensions, #hello_extensions{}). %%-------------------------------------------------------------------- --spec decode_server_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) -> +-spec decode_server_key(binary(), ssl_cipher_format:key_algo(), ssl_record:ssl_version()) -> #server_key_params{}. %% %% Description: Decode server_key data and return appropriate type @@ -739,7 +775,7 @@ decode_server_key(ServerKey, Type, Version) -> dec_server_key(ServerKey, key_exchange_alg(Type), Version). %%-------------------------------------------------------------------- --spec decode_client_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) -> +-spec decode_client_key(binary(), ssl_cipher_format:key_algo(), ssl_record:ssl_version()) -> #encrypted_premaster_secret{} | #client_diffie_hellman_public{} | #client_ec_diffie_hellman_public{} @@ -777,7 +813,7 @@ available_suites(ServerCert, UserSuites, Version, undefined, Curve) -> filter_unavailable_ecc_suites(Curve, Suites); available_suites(ServerCert, UserSuites, Version, HashSigns, Curve) -> Suites = available_suites(ServerCert, UserSuites, Version, undefined, Curve), - filter_hashsigns(Suites, [ssl_cipher:suite_definition(Suite) || Suite <- Suites], HashSigns, + filter_hashsigns(Suites, [ssl_cipher_format:suite_definition(Suite) || Suite <- Suites], HashSigns, Version, []). available_signature_algs(undefined, _) -> @@ -859,22 +895,24 @@ premaster_secret(PublicDhKey, PrivateDhKey, #server_dh_params{dh_p = Prime, dh_g end; premaster_secret(#client_srp_public{srp_a = ClientPublicKey}, ServerKey, #srp_user{prime = Prime, verifier = Verifier}) -> - case crypto:compute_key(srp, ClientPublicKey, ServerKey, {host, [Verifier, Prime, '6a']}) of - error -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)); + try crypto:compute_key(srp, ClientPublicKey, ServerKey, {host, [Verifier, Prime, '6a']}) of PremasterSecret -> PremasterSecret + catch + error:_ -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) end; premaster_secret(#server_srp_params{srp_n = Prime, srp_g = Generator, srp_s = Salt, srp_b = Public}, ClientKeys, {Username, Password}) -> case ssl_srp_primes:check_srp_params(Generator, Prime) of ok -> DerivedKey = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]), - case crypto:compute_key(srp, Public, ClientKeys, {user, [DerivedKey, Prime, Generator, '6a']}) of - error -> - throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)); + try crypto:compute_key(srp, Public, ClientKeys, {user, [DerivedKey, Prime, Generator, '6a']}) of PremasterSecret -> PremasterSecret + catch + error -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) end; _ -> throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) @@ -930,9 +968,11 @@ premaster_secret(EncSecret, #'RSAPrivateKey'{} = RSAPrivateKey) -> %%==================================================================== client_hello_extensions(Version, CipherSuites, #ssl_options{signature_algs = SupportedHashSigns, - eccs = SupportedECCs} = SslOpts, ConnectionStates, Renegotiation) -> + signature_algs_cert = SignatureSchemes, + eccs = SupportedECCs, + versions = Versions} = SslOpts, ConnectionStates, Renegotiation) -> {EcPointFormats, EllipticCurves} = - case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of + case advertises_ec_ciphers(lists:map(fun ssl_cipher_format:suite_definition/1, CipherSuites)) of true -> client_ecc_extensions(SupportedECCs); false -> @@ -940,18 +980,31 @@ client_hello_extensions(Version, CipherSuites, end, SRP = srp_user(SslOpts), - #hello_extensions{ - renegotiation_info = renegotiation_info(tls_record, client, - ConnectionStates, Renegotiation), - srp = SRP, - signature_algs = available_signature_algs(SupportedHashSigns, Version), - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, - alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), - next_protocol_negotiation = - encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, - Renegotiation), - sni = sni(SslOpts#ssl_options.server_name_indication)}. + HelloExtensions = + #hello_extensions{ + renegotiation_info = renegotiation_info(tls_record, client, + ConnectionStates, Renegotiation), + srp = SRP, + signature_algs = available_signature_algs(SupportedHashSigns, Version), + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, + alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), + next_protocol_negotiation = + encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, + Renegotiation), + sni = sni(SslOpts#ssl_options.server_name_indication)}, + + %% Add "supported_versions" extension if TLS 1.3 + case Version of + {3,4} -> + HelloExtensions#hello_extensions{ + client_hello_versions = #client_hello_versions{ + versions = Versions}, + signature_algs_cert = #signature_scheme_list{ + signature_scheme_list = SignatureSchemes}}; + _Else -> + HelloExtensions + end. handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, #hello_extensions{renegotiation_info = Info, @@ -1056,7 +1109,9 @@ select_curve(undefined, _, _) -> select_hashsign(_, _, KeyExAlgo, _, _Version) when KeyExAlgo == dh_anon; KeyExAlgo == ecdh_anon; KeyExAlgo == srp_anon; - KeyExAlgo == psk -> + KeyExAlgo == psk; + KeyExAlgo == dhe_psk; + KeyExAlgo == ecdhe_psk -> {null, anon}; %% The signature_algorithms extension was introduced with TLS 1.2. Ignore it if we have %% negotiated a lower version. @@ -1722,16 +1777,31 @@ encode_alpn(undefined, _) -> encode_alpn(Protocols, _) -> #alpn{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. + +encode_versions(Versions) -> + encode_versions(lists:reverse(Versions), <<>>). +%% +encode_versions([], Acc) -> + Acc; +encode_versions([{M,N}|T], Acc) -> + encode_versions(T, <<?BYTE(M),?BYTE(N),Acc/binary>>). + + hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo, srp = SRP, signature_algs = HashSigns, + signature_algs_cert = SignatureSchemes, ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves, alpn = ALPN, next_protocol_negotiation = NextProtocolNegotiation, - sni = Sni}) -> - [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns, - EcPointFormats, EllipticCurves, ALPN, NextProtocolNegotiation, Sni], Ext =/= undefined]. + sni = Sni, + client_hello_versions = Versions, + server_hello_selected_version = Version}) -> + [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns, SignatureSchemes, + EcPointFormats, EllipticCurves, ALPN, + NextProtocolNegotiation, Sni, + Versions, Version], Ext =/= undefined]. %%-------------Decode handshakes--------------------------------- dec_server_key(<<?UINT16(PLen), P:PLen/binary, @@ -1906,6 +1976,16 @@ dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), dec_hello_extensions(Rest, Acc#hello_extensions{signature_algs = #hash_sign_algos{hash_sign_algos = HashSignAlgos}}); +dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_CERT_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Acc) -> + SignSchemeListLen = Len - 2, + <<?UINT16(SignSchemeListLen), SignSchemeList/binary>> = ExtData, + SignSchemes = [ssl_cipher:signature_scheme(SignScheme) || + <<?UINT16(SignScheme)>> <= SignSchemeList], + dec_hello_extensions(Rest, Acc#hello_extensions{signature_algs_cert = + #signature_scheme_list{ + signature_scheme_list = SignSchemes}}); + dec_hello_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), ExtData:Len/binary, Rest/binary>>, Acc) -> <<?UINT16(_), EllipticCurveList/binary>> = ExtData, @@ -1931,15 +2011,28 @@ dec_hello_extensions(<<?UINT16(?EC_POINT_FORMATS_EXT), ?UINT16(Len), ECPointFormats}}); dec_hello_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), Rest/binary>>, Acc) when Len == 0 -> - dec_hello_extensions(Rest, Acc#hello_extensions{sni = ""}); %% Server may send an empy SNI + dec_hello_extensions(Rest, Acc#hello_extensions{sni = #sni{hostname = ""}}); %% Server may send an empy SNI dec_hello_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), ExtData:Len/binary, Rest/binary>>, Acc) -> <<?UINT16(_), NameList/binary>> = ExtData, dec_hello_extensions(Rest, Acc#hello_extensions{sni = dec_sni(NameList)}); + +dec_hello_extensions(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Acc) when Len > 2 -> + <<?UINT16(_),Versions/binary>> = ExtData, + dec_hello_extensions(Rest, Acc#hello_extensions{ + client_hello_versions = + #client_hello_versions{versions = decode_versions(Versions)}}); + +dec_hello_extensions(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), + ?UINT16(Version), Rest/binary>>, Acc) when Len =:= 2, Version =:= 16#0304 -> + dec_hello_extensions(Rest, Acc#hello_extensions{ + server_hello_selected_version = + #server_hello_selected_version{selected_version = [{3,4}]}}); + %% Ignore data following the ClientHello (i.e., %% extensions) if not understood. - dec_hello_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len/binary, Rest/binary>>, Acc) -> dec_hello_extensions(Rest, Acc); %% This theoretically should not happen if the protocol is followed, but if it does it is ignored. @@ -1961,6 +2054,15 @@ decode_alpn(undefined) -> decode_alpn(#alpn{extension_data=Data}) -> decode_protocols(Data, []). +decode_versions(Versions) -> + decode_versions(Versions, []). +%% +decode_versions(<<>>, Acc) -> + lists:reverse(Acc); +decode_versions(<<?BYTE(M),?BYTE(N),Rest/binary>>, Acc) -> + decode_versions(Rest, [{M,N}|Acc]). + + decode_next_protocols({next_protocol_negotiation, Protocols}) -> decode_protocols(Protocols, []). @@ -2425,7 +2527,7 @@ handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> cert_curve(_, _, no_suite) -> {no_curve, no_suite}; cert_curve(Cert, ECCCurve0, CipherSuite) -> - case ssl_cipher:suite_definition(CipherSuite) of + case ssl_cipher_format:suite_definition(CipherSuite) of #{key_exchange := Kex} when Kex == ecdh_ecdsa; Kex == ecdh_rsa -> OtpCert = public_key:pkix_decode_cert(Cert, otp), diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index a191fcf766..36aefd5e22 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -105,7 +105,10 @@ srp, ec_point_formats, elliptic_curves, - sni + sni, + client_hello_versions, + server_hello_selected_version, + signature_algs_cert }). -record(server_hello, { @@ -318,7 +321,7 @@ }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Application-Layer Protocol Negotiation RFC 7301 +%% RFC 7301 Application-Layer Protocol Negotiation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -define(ALPN_EXT, 16). @@ -338,7 +341,7 @@ -record(next_protocol, {selected_protocol}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% ECC Extensions RFC 4492 section 4 and 5 +%% ECC Extensions RFC 8422 section 4 and 5 (RFC 7919 not supported) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -define(ELLIPTIC_CURVES_EXT, 10). @@ -365,10 +368,11 @@ -define(NAMED_CURVE, 3). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Server name indication RFC 6066 section 3 +%% RFC 6066 Server name indication %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --define(SNI_EXT, 16#0000). +%% section 3 +-define(SNI_EXT, 0). %% enum { host_name(0), (255) } NameType; -define(SNI_NAMETYPE_HOST_NAME, 0). @@ -377,4 +381,56 @@ hostname = undefined }). +%% Other possible values from RFC 6066, not supported +-define(MAX_FRAGMENT_LENGTH, 1). +-define(CLIENT_CERTIFICATE_URL, 2). +-define(TRUSTED_CA_KEYS, 3). +-define(TRUNCATED_HMAC, 4). +-define(STATUS_REQUEST, 5). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% RFC 7250 Using Raw Public Keys in Transport Layer Security (TLS) +%% and Datagram Transport Layer Security (DTLS) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Not supported +-define(CLIENT_CERTIFICATE_TYPE, 19). +-define(SERVER_CERTIFICATE_TYPE, 20). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% RFC 6520 Transport Layer Security (TLS) and +%% Datagram Transport Layer Security (DTLS) Heartbeat Extension +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Not supported +-define(HEARTBEAT, 15). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% RFC 6962 Certificate Transparency +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Not supported +-define(SIGNED_CERTIFICATE_TIMESTAMP, 18). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% RFC 7685 A Transport Layer Security (TLS) ClientHello Padding Extension +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Not supported +-define(PADDING, 21). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Supported Versions RFC 8446 (TLS 1.3) section 4.2.1 also affects TLS-1.2 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(SUPPORTED_VERSIONS_EXT, 43). + +-record(client_hello_versions, {versions}). +-record(server_hello_selected_version, {selected_version}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Signature Algorithms RFC 8446 (TLS 1.3) section 4.2.3 also affects TLS-1.2 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(SIGNATURE_ALGORITHMS_CERT_EXT, 50). + +-record(signature_scheme_list, {signature_scheme_list}). + -endif. % -ifdef(ssl_handshake). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index a98cbf8542..5a18f6aa99 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -72,14 +72,39 @@ -define(FALSE, 1). %% sslv3 is considered insecure due to lack of padding check (Poodle attack) -%% Keep as interop with legacy software but do not support as default --define(ALL_AVAILABLE_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1, sslv3]). +%% Keep as interop with legacy software but do not support as default +%% tlsv1.3 is under development (experimental). +-define(ALL_AVAILABLE_VERSIONS, ['tlsv1.3', 'tlsv1.2', 'tlsv1.1', tlsv1, sslv3]). -define(ALL_AVAILABLE_DATAGRAM_VERSIONS, ['dtlsv1.2', dtlsv1]). +%% Defines the default versions when not specified by an ssl option. -define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]). -define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1]). + +%% Versions allowed in TLSCiphertext.version (TLS 1.2 and prior) and +%% TLSCiphertext.legacy_record_version (TLS 1.3). +%% TLS 1.3 sets TLSCiphertext.legacy_record_version to 0x0303 for all records +%% generated other than an than an initial ClientHello, where it MAY also be 0x0301. +%% Thus, the allowed range is limited to 0x0300 - 0x0303. +-define(ALL_TLS_RECORD_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1, sslv3]). + -define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). -define(MIN_DATAGRAM_SUPPORTED_VERSIONS, [dtlsv1]). +%% TLS 1.3 - Section 4.1.3 +%% +%% If negotiating TLS 1.2, TLS 1.3 servers MUST set the last eight bytes +%% of their Random value to the bytes: +%% +%% 44 4F 57 4E 47 52 44 01 +%% +%% If negotiating TLS 1.1 or below, TLS 1.3 servers MUST and TLS 1.2 +%% servers SHOULD set the last eight bytes of their Random value to the +%% bytes: +%% +%% 44 4F 57 4E 47 52 44 00 +-define(RANDOM_OVERRIDE_TLS12, <<16#44,16#4F,16#57,16#4E,16#47,16#52,16#44,16#01>>). +-define(RANDOM_OVERRIDE_TLS11, <<16#44,16#4F,16#57,16#4E,16#47,16#52,16#44,16#00>>). + -define('24H_in_msec', 86400000). -define('24H_in_sec', 86400). @@ -121,7 +146,7 @@ %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation - hibernate_after :: timeout(), + hibernate_after :: timeout(), %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), alpn_advertised_protocols = undefined :: [binary()] | undefined , @@ -143,6 +168,7 @@ crl_check :: boolean() | peer | best_effort, crl_cache, signature_algs, + signature_algs_cert, eccs, honor_ecc_order :: boolean(), max_handshake_size :: integer(), diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index 23e9e096cc..35c8dcfd48 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -156,7 +156,9 @@ version({3,2}) -> version({3,1}) -> "TLS 1.0"; version({3,0}) -> - "SSL 3.0". + "SSL 3.0"; +version({M,N}) -> + io_lib:format("TLS [0x0~B0~B]", [M,N]). header_prefix(inbound) -> @@ -183,7 +185,6 @@ header_prefix_tls_record(outbound) -> "writing". - tls_record_version([<<?BYTE(B),?BYTE(3),?BYTE(3),_/binary>>|_]) -> io_lib:format("TLS 1.2 Record Protocol, ~s", [msg_type(B)]); tls_record_version([<<?BYTE(B),?BYTE(3),?BYTE(2),_/binary>>|_]) -> @@ -191,7 +192,9 @@ tls_record_version([<<?BYTE(B),?BYTE(3),?BYTE(2),_/binary>>|_]) -> tls_record_version([<<?BYTE(B),?BYTE(3),?BYTE(1),_/binary>>|_]) -> io_lib:format("TLS 1.0 Record Protocol, ~s", [msg_type(B)]); tls_record_version([<<?BYTE(B),?BYTE(3),?BYTE(0),_/binary>>|_]) -> - io_lib:format("SSL 3.0 Record Protocol, ~s", [msg_type(B)]). + io_lib:format("SSL 3.0 Record Protocol, ~s", [msg_type(B)]); +tls_record_version([<<?BYTE(B),?BYTE(M),?BYTE(N),_/binary>>|_]) -> + io_lib:format("TLS [0x0~B0~B] Record Protocol, ~s", [M, N, msg_type(B)]). msg_type(20) -> "change_cipher_spec"; diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index f44fe6a2bf..b3a425b2fe 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -127,7 +127,13 @@ cache_pem_file(File, DbHandle) -> [Content] -> {ok, Content}; undefined -> - ssl_pem_cache:insert(File) + case ssl_pkix_db:decode_pem_file(File) of + {ok, Content} -> + ssl_pem_cache:insert(File, Content), + {ok, Content}; + Error -> + Error + end end. %%-------------------------------------------------------------------- @@ -499,10 +505,10 @@ last_delay_timer({{_,_},_}, TRef, {LastServer, _}) -> last_delay_timer({_,_}, TRef, {_, LastClient}) -> {TRef, LastClient}. -%% If we can not generate a not allready in use session ID in +%% If we cannot generate a not allready in use session ID in %% ?GEN_UNIQUE_ID_MAX_TRIES we make the new session uncacheable The %% value of ?GEN_UNIQUE_ID_MAX_TRIES is stolen from open SSL which -%% states : "If we can not find a session id in +%% states : "If we cannot find a session id in %% ?GEN_UNIQUE_ID_MAX_TRIES either the RAND code is broken or someone %% is trying to open roughly very close to 2^128 (or 2^256) SSL %% sessions to our server" @@ -513,7 +519,7 @@ new_id(Port, Tries, Cache, CacheCb) -> case CacheCb:lookup(Cache, {Port, Id}) of undefined -> Now = erlang:monotonic_time(), - %% New sessions can not be set to resumable + %% New sessions cannot be set to resumable %% until handshake is compleate and the %% other session values are set. CacheCb:update(Cache, {Port, Id}, #session{session_id = Id, diff --git a/lib/ssl/src/ssl_pem_cache.erl b/lib/ssl/src/ssl_pem_cache.erl index 115ab4451d..a952e20133 100644 --- a/lib/ssl/src/ssl_pem_cache.erl +++ b/lib/ssl/src/ssl_pem_cache.erl @@ -29,7 +29,7 @@ -export([start_link/1, start_link_dist/1, name/1, - insert/1, + insert/2, clear/0]). % Spawn export @@ -90,19 +90,17 @@ start_link_dist(_) -> %%-------------------------------------------------------------------- --spec insert(binary()) -> {ok, term()} | {error, reason()}. +-spec insert(binary(), term()) -> ok | {error, reason()}. %% %% Description: Cache a pem file and return its content. %%-------------------------------------------------------------------- -insert(File) -> - {ok, PemBin} = file:read_file(File), - Content = public_key:pem_decode(PemBin), +insert(File, Content) -> case bypass_cache() of true -> - {ok, Content}; + ok; false -> cast({cache_pem, File, Content}), - {ok, Content} + ok end. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index 4132733ae0..e7e4af942a 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -158,7 +158,7 @@ extract_trusted_certs(File) -> {error, {badmatch, Error}} end. --spec decode_pem_file(binary()) -> {ok, term()}. +-spec decode_pem_file(binary()) -> {ok, term()} | {error, term()}. decode_pem_file(File) -> case file:read_file(File) of {ok, PemBin} -> @@ -317,11 +317,16 @@ decode_certs(Ref, Cert) -> end. new_trusted_cert_entry(File, [CertsDb, RefsDb, _ | _]) -> - Ref = make_ref(), - init_ref_db(Ref, File, RefsDb), - {ok, Content} = ssl_pem_cache:insert(File), - add_certs_from_pem(Content, Ref, CertsDb), - {ok, Ref}. + case decode_pem_file(File) of + {ok, Content} -> + Ref = make_ref(), + init_ref_db(Ref, File, RefsDb), + ok = ssl_pem_cache:insert(File, Content), + add_certs_from_pem(Content, Ref, CertsDb), + {ok, Ref}; + Error -> + Error + end. add_crls([_,_,_, {_, Mapping} | _], ?NO_DIST_POINT, CRLs) -> [add_crls(CRL, Mapping) || CRL <- CRLs]; diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 659e1485ac..446bb6c56a 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -278,13 +278,12 @@ compress(?NULL, Data, CS) -> {Data, CS}. %%-------------------------------------------------------------------- --spec compressions() -> [binary()]. +-spec compressions() -> [integer()]. %% %% Description: return a list of compressions supported (currently none) %%-------------------------------------------------------------------- compressions() -> - [?byte(?NULL)]. - + [?NULL]. %%==================================================================== %% Payload encryption/decryption diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index ed007f58d7..e8ce50040f 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -74,7 +74,7 @@ -define(INITIAL_BYTES, 5). -define(MAX_SEQENCE_NUMBER, 18446744073709551615). %% (1 bsl 64) - 1 = 18446744073709551615 -%% Sequence numbers can not wrap so when max is about to be reached we should renegotiate. +%% Sequence numbers cannot wrap so when max is about to be reached we should renegotiate. %% We will renegotiate a little before so that there will be sequence numbers left %% for the rehandshake and a little data. Currently we decided to renegotiate a little more %% often as we can have a cheaper test to check if it is time to renegotiate. It will still diff --git a/lib/ssl/src/ssl_v3.erl b/lib/ssl/src/ssl_v3.erl index 82d165f995..7eebb1d45f 100644 --- a/lib/ssl/src/ssl_v3.erl +++ b/lib/ssl/src/ssl_v3.erl @@ -131,7 +131,7 @@ setup_keys(MasterSecret, ServerRandom, ClientRandom, HS, KML, _EKML, IVS) -> {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}. --spec suites() -> [ssl_cipher:cipher_suite()]. +-spec suites() -> [ssl_cipher_format:cipher_suite()]. suites() -> [ diff --git a/lib/ssl/src/tls.erl b/lib/ssl/src/tls.erl deleted file mode 100644 index aa41cd1ba6..0000000000 --- a/lib/ssl/src/tls.erl +++ /dev/null @@ -1,112 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% 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. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%%% Purpose : Reflect TLS specific API options (fairly simple wrapper at the moment) - --module(tls). - --include("ssl_api.hrl"). --include("ssl_internal.hrl"). - --export([connect/2, connect/3, listen/2, accept/1, accept/2, - handshake/1, handshake/2, handshake/3]). - -%%-------------------------------------------------------------------- -%% -%% Description: Connect to an TLS server. -%%-------------------------------------------------------------------- - --spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | - {error, reason()}. - -connect(Socket, Options) when is_port(Socket) -> - connect(Socket, Options, infinity). - --spec connect(host() | port(), [connect_option()] | inet:port_number(), - timeout() | list()) -> - {ok, #sslsocket{}} | {error, reason()}. - -connect(Socket, SslOptions, Timeout) when is_port(Socket) -> - TLSOpts = [{protocol, tls} | SslOptions], - ssl:connect(Socket, TLSOpts, Timeout); -connect(Host, Port, Options) -> - connect(Host, Port, Options, infinity). - --spec connect(host() | port(), inet:port_number(), list(), timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. - -connect(Host, Port, Options, Timeout) -> - TLSOpts = [{protocol, tls} | Options], - ssl:connect(Host, Port, TLSOpts, Timeout). - -%%-------------------------------------------------------------------- --spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}. - -%% -%% Description: Creates an ssl listen socket. -%%-------------------------------------------------------------------- -listen(Port, Options) -> - TLSOpts = [{protocol, tls} | Options], - ssl:listen(Port, TLSOpts). - -%%-------------------------------------------------------------------- -%% -%% Description: Performs transport accept on an ssl listen socket -%%-------------------------------------------------------------------- --spec accept(#sslsocket{}) -> {ok, #sslsocket{}} | - {error, reason()}. -accept(ListenSocket) -> - accept(ListenSocket, infinity). - --spec accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {error, reason()}. -accept(Socket, Timeout) -> - ssl:transport_accept(Socket, Timeout). - -%%-------------------------------------------------------------------- -%% -%% Description: Performs accept on an ssl listen socket. e.i. performs -%% ssl handshake. -%%-------------------------------------------------------------------- - --spec handshake(#sslsocket{}) -> ok | {error, reason()}. - -handshake(ListenSocket) -> - handshake(ListenSocket, infinity). - - --spec handshake(#sslsocket{} | port(), timeout()| [ssl_option() - | transport_option()]) -> - ok | {ok, #sslsocket{}} | {error, reason()}. - -handshake(#sslsocket{} = Socket, Timeout) -> - ssl:ssl_accept(Socket, Timeout); - -handshake(ListenSocket, SslOptions) when is_port(ListenSocket) -> - handshake(ListenSocket, SslOptions, infinity). - - --spec handshake(port(), [ssl_option()| transport_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. - -handshake(Socket, SslOptions, Timeout) when is_port(Socket) -> - ssl:ssl_accept(Socket, SslOptions, Timeout). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 1a0a9b9275..f7eb79400e 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -44,30 +44,35 @@ %% Internal application API %% Setup --export([start_fsm/8, start_link/7, init/1]). +-export([start_fsm/8, start_link/8, init/1, pids/1]). %% State transition handling --export([next_record/1, next_event/3, next_event/4, handle_common_event/4]). +-export([next_record/1, next_event/3, next_event/4, + handle_common_event/4]). %% Handshake handling --export([renegotiate/2, send_handshake/2, +-export([renegotiation/2, renegotiate/2, send_handshake/2, queue_handshake/2, queue_change_cipher/2, - reinit_handshake_data/1, select_sni_extension/1, empty_connection_state/2]). + reinit/1, reinit_handshake_data/1, select_sni_extension/1, + empty_connection_state/2]). %% Alert and close handling --export([encode_alert/3, send_alert/2, close/5, protocol_name/0]). +-export([send_alert/2, send_alert_in_connection/2, encode_alert/3, close/5, protocol_name/0]). %% Data handling --export([encode_data/3, passive_receive/2, next_record_if_active/1, send/3, - socket/5, setopts/3, getopts/3]). +-export([encode_data/3, passive_receive/2, next_record_if_active/1, + send/3, socket/5, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states hello/3, user_hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states - connection/3, death_row/3]). + connection/3]). %% gen_statem callbacks -export([callback_mode/0, terminate/3, code_change/4, format_status/2]). + +-define(DIST_CNTRL_SPAWN_OPTS, [{priority, max}]). + %%==================================================================== %% Internal application API %%==================================================================== @@ -78,9 +83,10 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} User, {CbModule, _,_, _} = CbInfo, Timeout) -> try - {ok, Pid} = tls_connection_sup:start_child([Role, Host, Port, Socket, + {ok, Sender} = tls_sender:start(), + {ok, Pid} = tls_connection_sup:start_child([Role, Sender, Host, Port, Socket, Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, [Pid, Sender], CbModule, Tracker), ssl_connection:handshake(SslSocket, Timeout) catch error:{badmatch, {error, _} = Error} -> @@ -91,9 +97,10 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = User, {CbModule, _,_, _} = CbInfo, Timeout) -> try - {ok, Pid} = tls_connection_sup:start_child_dist([Role, Host, Port, Socket, + {ok, Sender} = tls_sender:start([{spawn_opt, ?DIST_CNTRL_SPAWN_OPTS}]), + {ok, Pid} = tls_connection_sup:start_child_dist([Role, Sender, Host, Port, Socket, Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, [Pid, Sender], CbModule, Tracker), ssl_connection:handshake(SslSocket, Timeout) catch error:{badmatch, {error, _} = Error} -> @@ -101,25 +108,37 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = end. %%-------------------------------------------------------------------- --spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> +-spec start_link(atom(), pid(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> {ok, pid()} | ignore | {error, reason()}. %% %% Description: Creates a gen_statem process which calls Module:init/1 to %% initialize. %%-------------------------------------------------------------------- -start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> - {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. +start_link(Role, Sender, Host, Port, Socket, Options, User, CbInfo) -> + {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Sender, Host, Port, Socket, Options, User, CbInfo]])}. -init([Role, Host, Port, Socket, Options, User, CbInfo]) -> +init([Role, Sender, Host, Port, Socket, {SslOpts, _, _} = Options, User, CbInfo]) -> process_flag(trap_exit, true), - State0 = #state{protocol_specific = Map} = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), + case SslOpts#ssl_options.erl_dist of + true -> + process_flag(priority, max); + _ -> + ok + end, + State0 = #state{protocol_specific = Map} = initial_state(Role, Sender, + Host, Port, Socket, Options, User, CbInfo), try State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), - gen_statem:enter_loop(?MODULE, [], init, State) + initialize_tls_sender(State), + gen_statem:enter_loop(?MODULE, [], init, State) catch throw:Error -> EState = State0#state{protocol_specific = Map#{error => Error}}, gen_statem:enter_loop(?MODULE, [], error, EState) end. + +pids(#state{protocol_specific = #{sender := Sender}}) -> + [self(), Sender]. + %%==================================================================== %% State transition handling %%==================================================================== @@ -237,13 +256,15 @@ handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> %%==================================================================== %% Handshake handling %%==================================================================== +renegotiation(Pid, WriteState) -> + gen_statem:call(Pid, {user_renegotiate, WriteState}). + renegotiate(#state{role = client} = State, Actions) -> %% Handle same way as if server requested %% the renegotiation Hs0 = ssl_handshake:init_handshake_history(), {next_state, connection, State#state{tls_handshake_history = Hs0}, [{next_event, internal, #hello_request{}} | Actions]}; - renegotiate(#state{role = server, socket = Socket, transport_cb = Transport, @@ -303,6 +324,12 @@ queue_change_cipher(Msg, #state{negotiated_version = Version, State0#state{connection_states = ConnectionStates, flight_buffer = Flight0 ++ [BinChangeCipher]}. +reinit(#state{protocol_specific = #{sender := Sender}, + negotiated_version = Version, + connection_states = #{current_write := Write}} = State) -> + tls_sender:update_connection_state(Sender, Write, Version), + reinit_handshake_data(State). + reinit_handshake_data(State) -> %% premaster_secret, public_key_info and tls_handshake_info %% are only needed during the handshake phase. @@ -324,20 +351,6 @@ empty_connection_state(ConnectionEnd, BeastMitigation) -> %%==================================================================== %% Alert and close handling %%==================================================================== -send_alert(Alert, #state{negotiated_version = Version, - socket = Socket, - transport_cb = Transport, - connection_states = ConnectionStates0, - ssl_options = SslOpts} = State0) -> - {BinMsg, ConnectionStates} = - encode_alert(Alert, Version, ConnectionStates0), - - send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), - State0#state{connection_states = ConnectionStates}. %%-------------------------------------------------------------------- -spec encode_alert(#alert{}, ssl_record:ssl_version(), ssl_record:connection_states()) -> @@ -347,6 +360,25 @@ send_alert(Alert, #state{negotiated_version = Version, %%-------------------------------------------------------------------- encode_alert(#alert{} = Alert, Version, ConnectionStates) -> tls_record:encode_alert_record(Alert, Version, ConnectionStates). + +send_alert(Alert, #state{negotiated_version = Version, + socket = Socket, + protocol_cb = Connection, + transport_cb = Transport, + connection_states = ConnectionStates0, + ssl_options = SslOpts} = StateData0) -> + {BinMsg, ConnectionStates} = + Connection:encode_alert(Alert, Version, ConnectionStates0), + Connection:send(Transport, Socket, BinMsg), + Report = #{direction => outbound, + protocol => 'tls_record', + message => BinMsg}, + ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + StateData0#state{connection_states = ConnectionStates}. + +send_alert_in_connection(Alert, #state{protocol_specific = #{sender := Sender}}) -> + tls_sender:send_alert(Sender, Alert). + %% User closes or recursive call! close({close, Timeout}, Socket, Transport = gen_tcp, _,_) -> tls_socket:setopts(Transport, Socket, [{active, false}]), @@ -401,8 +433,8 @@ next_record_if_active(State) -> send(Transport, Socket, Data) -> tls_socket:send(Transport, Socket, Data). -socket(Pid, Transport, Socket, Connection, Tracker) -> - tls_socket:socket(Pid, Transport, Socket, Connection, Tracker). +socket(Pids, Transport, Socket, Connection, Tracker) -> + tls_socket:socket(Pids, Transport, Socket, Connection, Tracker). setopts(Transport, Socket, Other) -> tls_socket:setopts(Transport, Socket, Other). @@ -479,15 +511,17 @@ error(_, _, _) -> #state{}) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- -hello(internal, #client_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello}, - start_or_recv_from = From} = State) -> - {next_state, user_hello, State#state{start_or_recv_from = undefined, +hello(internal, #client_hello{extensions = Extensions} = Hello, + #state{ssl_options = #ssl_options{handshake = hello}, + start_or_recv_from = From} = State) -> + {next_state, user_hello, State#state{start_or_recv_from = undefined, hello = Hello}, [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]}; -hello(internal, #server_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello}, - start_or_recv_from = From} = State) -> +hello(internal, #server_hello{extensions = Extensions} = Hello, + #state{ssl_options = #ssl_options{handshake = hello}, + start_or_recv_from = From} = State) -> {next_state, user_hello, State#state{start_or_recv_from = undefined, - hello = Hello}, + hello = Hello}, [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]}; hello(internal, #client_hello{client_version = ClientVersion} = Hello, #state{connection_states = ConnectionStates0, @@ -571,14 +605,19 @@ cipher(Type, Event, State) -> %%-------------------------------------------------------------------- connection(info, Event, State) -> gen_info(Event, ?FUNCTION_NAME, State); +connection({call, From}, {user_renegotiate, WriteState}, + #state{connection_states = ConnectionStates} = State) -> + {next_state, ?FUNCTION_NAME, State#state{connection_states = ConnectionStates#{current_write => WriteState}}, + [{next_event,{call, From}, renegotiate}]}; connection(internal, #hello_request{}, - #state{role = client, host = Host, port = Port, + #state{role = client, + renegotiation = {Renegotiation, _}, + host = Host, port = Port, session = #session{own_certificate = Cert} = Session0, session_cache = Cache, session_cache_cb = CacheCb, - ssl_options = SslOpts, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> - Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, + ssl_options = SslOpts, + connection_states = ConnectionStates} = State0) -> + Hello = tls_handshake:client_hello(Host, Port, ConnectionStates, SslOpts, Cache, CacheCb, Renegotiation, Cert), {State1, Actions} = send_handshake(Hello, State0), {Record, State} = @@ -587,7 +626,10 @@ connection(internal, #hello_request{}, = Hello#client_hello.session_id}}), next_event(hello, Record, State, Actions); connection(internal, #client_hello{} = Hello, - #state{role = server, allow_renegotiate = true} = State0) -> + #state{role = server, allow_renegotiate = true, connection_states = CS, + %%protocol_cb = Connection, + protocol_specific = #{sender := Sender} + } = State0) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html %% http://www.thc.org/thc-ssl-dos/ Rather than disabling client @@ -596,24 +638,21 @@ connection(internal, #client_hello{} = Hello, erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), {Record, State} = next_record(State0#state{allow_renegotiate = false, renegotiation = {true, peer}}), - next_event(hello, Record, State, [{next_event, internal, Hello}]); + {ok, Write} = tls_sender:renegotiate(Sender), + next_event(hello, Record, State#state{connection_states = CS#{current_write => Write}}, + [{next_event, internal, Hello}]); connection(internal, #client_hello{}, - #state{role = server, allow_renegotiate = false} = State0) -> + #state{role = server, allow_renegotiate = false, + protocol_cb = Connection} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), - State1 = send_alert(Alert, State0), - {Record, State} = ssl_connection:prepare_connection(State1, ?MODULE), + send_alert_in_connection(Alert, State0), + State1 = Connection:reinit_handshake_data(State0), + {Record, State} = next_record(State1), next_event(?FUNCTION_NAME, Record, State); connection(Type, Event, State) -> ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). %%-------------------------------------------------------------------- --spec death_row(gen_statem:event_type(), term(), #state{}) -> - gen_statem:state_function_result(). -%%-------------------------------------------------------------------- -death_row(Type, Event, State) -> - ssl_connection:death_row(Type, Event, State, ?MODULE). - -%%-------------------------------------------------------------------- -spec downgrade(gen_statem:event_type(), term(), #state{}) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- @@ -627,6 +666,7 @@ callback_mode() -> state_functions. terminate(Reason, StateName, State) -> + ensure_sender_terminate(Reason, State), catch ssl_connection:terminate(Reason, StateName, State). format_status(Type, Data) -> @@ -638,11 +678,13 @@ code_change(_OldVsn, StateName, State, _) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User, +initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User, {CbModule, DataTag, CloseTag, ErrorTag}) -> - #ssl_options{beast_mitigation = BeastMitigation} = SSLOptions, + #ssl_options{beast_mitigation = BeastMitigation, + erl_dist = IsErlDist} = SSLOptions, ConnectionStates = tls_record:init_connection_states(Role, BeastMitigation), + ErlDistData = erl_dist_data(IsErlDist), SessionCacheCb = case application:get_env(ssl, session_cb) of {ok, Cb} when is_atom(Cb) -> Cb; @@ -650,7 +692,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us ssl_session_cache end, - Monitor = erlang:monitor(process, User), + UserMonitor = erlang:monitor(process, User), #state{socket_options = SocketOptions, ssl_options = SSLOptions, @@ -663,9 +705,10 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us host = Host, port = Port, socket = Socket, + erl_dist_data = ErlDistData, connection_states = ConnectionStates, protocol_buffers = #protocol_buffers{}, - user_application = {Monitor, User}, + user_application = {UserMonitor, User}, user_data_buffer = <<>>, session_cache_cb = SessionCacheCb, renegotiation = {false, first}, @@ -673,14 +716,42 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us start_or_recv_from = undefined, protocol_cb = ?MODULE, tracker = Tracker, - flight_buffer = [] + flight_buffer = [], + protocol_specific = #{sender => Sender} }. +erl_dist_data(true) -> + #{dist_handle => undefined, + dist_buffer => <<>>}; +erl_dist_data(false) -> + #{}. + +initialize_tls_sender(#state{role = Role, + socket = Socket, + socket_options = SockOpts, + tracker = Tracker, + protocol_cb = Connection, + transport_cb = Transport, + negotiated_version = Version, + ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}, + connection_states = #{current_write := ConnectionWriteState}, + protocol_specific = #{sender := Sender}}) -> + Init = #{current_write => ConnectionWriteState, + role => Role, + socket => Socket, + socket_options => SockOpts, + tracker => Tracker, + protocol_cb => Connection, + transport_cb => Transport, + negotiated_version => Version, + renegotiate_at => RenegotiateAt}, + tls_sender:initialize(Sender, Init). + next_tls_record(Data, StateName, #state{protocol_buffers = #protocol_buffers{tls_record_buffer = Buf0, tls_cipher_texts = CT0} = Buffers, - ssl_options = SslOpts} = State0) -> - case tls_record:get_tls_records(Data, + ssl_options = SslOpts} = State0) -> + case tls_record:get_tls_records(Data, acceptable_record_versions(StateName, State0), Buf0, SslOpts) of {Records, Buf1} -> @@ -693,10 +764,18 @@ next_tls_record(Data, StateName, #state{protocol_buffers = end. +%% TLS 1.3 Client/Server +%% - Ignore TLSPlaintext.legacy_record_version +%% - Verify that TLSCiphertext.legacy_record_version is set to 0x0303 for all records +%% other than an initial ClientHello, where it MAY also be 0x0301. acceptable_record_versions(hello, _) -> - [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS]; + [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_TLS_RECORD_VERSIONS]; +acceptable_record_versions(_, #state{negotiated_version = {Major, Minor}}) + when Major > 3; Major =:= 3, Minor >= 4 -> + [{3, 3}]; acceptable_record_versions(_, #state{negotiated_version = Version}) -> [Version]. + handle_record_alert(Alert, _) -> Alert. @@ -747,6 +826,9 @@ handle_info({CloseTag, Socket}, StateName, %% and then receive the final message. next_event(StateName, no_record, State) end; +handle_info({'EXIT', Pid, Reason}, _, + #state{protocol_specific = Pid} = State) -> + {stop, {shutdown, sender_died, Reason}, State}; handle_info(Msg, StateName, State) -> ssl_connection:StateName(info, Msg, State, ?MODULE). @@ -815,7 +897,8 @@ unprocessed_events(Events) -> erlang:length(Events)-1. -assert_buffer_sanity(<<?BYTE(_Type), ?UINT24(Length), Rest/binary>>, #ssl_options{max_handshake_size = Max}) when +assert_buffer_sanity(<<?BYTE(_Type), ?UINT24(Length), Rest/binary>>, + #ssl_options{max_handshake_size = Max}) when Length =< Max -> case size(Rest) of N when N < Length -> @@ -835,3 +918,16 @@ assert_buffer_sanity(Bin, _) -> throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data)) end. + +ensure_sender_terminate(downgrade, _) -> + ok; %% Do not terminate sender during downgrade phase +ensure_sender_terminate(_, #state{protocol_specific = #{sender := Sender}}) -> + %% Make sure TLS sender dies when connection process is terminated normally + %% This is needed if the tls_sender is blocked in prim_inet:send + Kill = fun() -> + receive + after 5000 -> + catch (exit(Sender, kill)) + end + end, + spawn(Kill). diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 4e6bbb5061..82ed2e8d14 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -61,6 +61,18 @@ client_hello(Host, Port, ConnectionStates, } = SslOpts, Cache, CacheCb, Renegotiation, OwnCert) -> Version = tls_record:highest_protocol_version(Versions), + + %% In TLS 1.3, the client indicates its version preferences in the + %% "supported_versions" extension (Section 4.2.1) and the + %% legacy_version field MUST be set to 0x0303, which is the version + %% number for TLS 1.2. + LegacyVersion = + case tls_record:is_higher(Version, {3,2}) of + true -> + {3,3}; + false -> + Version + end, #{security_parameters := SecParams} = ssl_record:pending_connection_state(ConnectionStates, read), AvailableCipherSuites = ssl_handshake:available_suites(UserSuites, Version), @@ -71,7 +83,7 @@ client_hello(Host, Port, ConnectionStates, CipherSuites = ssl_handshake:cipher_suites(AvailableCipherSuites, Renegotiation, Fallback), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), #client_hello{session_id = Id, - client_version = Version, + client_version = LegacyVersion, cipher_suites = CipherSuites, compression_methods = ssl_record:compressions(), random = SecParams#security_parameters.client_random, @@ -82,17 +94,76 @@ client_hello(Host, Port, ConnectionStates, -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, ssl_record:connection_states() | {inet:port_number(), #session{}, db_handle(), atom(), ssl_record:connection_states(), - binary() | undefined, ssl_cipher:key_algo()}, + binary() | undefined, ssl_cipher_format:key_algo()}, boolean()) -> {tls_record:tls_version(), session_id(), ssl_record:connection_states(), alpn | npn, binary() | undefined}| {tls_record:tls_version(), {resumed | new, #session{}}, ssl_record:connection_states(), binary() | undefined, - #hello_extensions{}, {ssl_cipher:hash(), ssl_cipher:sign_algo()} | + #hello_extensions{}, {ssl_cipher_format:hash(), ssl_cipher_format:sign_algo()} | undefined} | #alert{}. %% %% Description: Handles a received hello message %%-------------------------------------------------------------------- + + +%% TLS 1.3 - Section 4.1.3 +%% TLS 1.3 clients receiving a ServerHello indicating TLS 1.2 or below +%% MUST check that the last eight bytes are not equal to either of these +%% values. +hello(#server_hello{server_version = {Major, Minor}, + random = <<_:24/binary,Down:8/binary>>}, + #ssl_options{versions = [{M,N}|_]}, _, _) + when (M > 3 orelse M =:= 3 andalso N >= 4) andalso %% TLS 1.3 client + (Major =:= 3 andalso Minor =:= 3 andalso %% Negotiating TLS 1.2 + Down =:= ?RANDOM_OVERRIDE_TLS12) orelse + + (M > 3 orelse M =:= 3 andalso N >= 4) andalso %% TLS 1.3 client + (Major =:= 3 andalso Minor < 3 andalso %% Negotiating TLS 1.1 or prior + Down =:= ?RANDOM_OVERRIDE_TLS11) -> + ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); + +%% TLS 1.2 clients SHOULD also check that the last eight bytes are not +%% equal to the second value if the ServerHello indicates TLS 1.1 or below. +hello(#server_hello{server_version = {Major, Minor}, + random = <<_:24/binary,Down:8/binary>>}, + #ssl_options{versions = [{M,N}|_]}, _, _) + when (M =:= 3 andalso N =:= 3) andalso %% TLS 1.2 client + (Major =:= 3 andalso Minor < 3 andalso %% Negotiating TLS 1.1 or prior + Down =:= ?RANDOM_OVERRIDE_TLS11) -> + ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); + + +%% TLS 1.3 - 4.2.1. Supported Versions +%% If the "supported_versions" extension in the ServerHello contains a +%% version not offered by the client or contains a version prior to TLS +%% 1.3, the client MUST abort the handshake with an "illegal_parameter" +%% alert. +%%-------------------------------------------------------------------- +%% TLS 1.2 Client +%% +%% - If "supported_version" is present (ServerHello): +%% - Abort handshake with an "illegal_parameter" alert +hello(#server_hello{server_version = Version, + extensions = #hello_extensions{ + server_hello_selected_version = + #server_hello_selected_version{selected_version = Version} + }}, + #ssl_options{versions = SupportedVersions}, + _ConnectionStates0, _Renegotiation) -> + case tls_record:is_higher({3,4}, Version) of + true -> + ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); + false -> + case tls_record:is_acceptable_version(Version, SupportedVersions) of + true -> + %% Implement TLS 1.3 statem ??? + ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION); + false -> + ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER) + end + end; + hello(#server_hello{server_version = Version, random = Random, cipher_suite = CipherSuite, compression_method = Compression, @@ -107,6 +178,37 @@ hello(#server_hello{server_version = Version, random = Random, false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) end; + + +%% TLS 1.2 Server +%% - If "supported_versions" is present (ClientHello): +%% - Select version from "supported_versions" (ignore ClientHello.legacy_version) +%% - If server only supports versions greater than "supported_versions": +%% - Abort handshake with a "protocol_version" alert (*) +%% - If "supported_versions" is absent (ClientHello): +%% - Negotiate the minimum of ClientHello.legacy_version and TLS 1.2 (**) +%% - If server only supports versions greater than ClientHello.legacy_version: +%% - Abort handshake with a "protocol_version" alert +%% +%% (*) Sends alert even if there is a gap in supported versions +%% e.g. Server 1.0,1.2 Client 1.1,1.3 +%% (**) Current implementation can negotiate a version not supported by the client +%% e.g. Server 1.0,1.2 Client 1.1 -> ServerHello 1.0 +hello(#client_hello{client_version = _ClientVersion, + cipher_suites = CipherSuites, + extensions = #hello_extensions{ + client_hello_versions = + #client_hello_versions{versions = ClientVersions} + }} = Hello, + #ssl_options{versions = Versions} = SslOpts, + Info, Renegotiation) -> + try + Version = ssl_handshake:select_supported_version(ClientVersions, Versions), + do_hello(Version, Versions, CipherSuites, Hello, SslOpts, Info, Renegotiation) + catch + _:_ -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data) + end; hello(#client_hello{client_version = ClientVersion, cipher_suites = CipherSuites} = Hello, @@ -114,19 +216,11 @@ hello(#client_hello{client_version = ClientVersion, Info, Renegotiation) -> try Version = ssl_handshake:select_version(tls_record, ClientVersion, Versions), - case ssl_cipher:is_fallback(CipherSuites) of - true -> - Highest = tls_record:highest_protocol_version(Versions), - case tls_record:is_higher(Highest, Version) of - true -> - ?ALERT_REC(?FATAL, ?INAPPROPRIATE_FALLBACK); - false -> - handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation) - end; - false -> - handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation) - end + do_hello(Version, Versions, CipherSuites, Hello, SslOpts, Info, Renegotiation) catch + error:{case_clause,{asn1, Asn1Reason}} -> + %% ASN-1 decode of certificate somehow failed + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {failed_to_decode_own_certificate, Asn1Reason}); _:_ -> ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data) end. @@ -197,7 +291,7 @@ handle_client_hello(Version, no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_ciphers); _ -> - #{key_exchange := KeyExAlg} = ssl_cipher:suite_definition(CipherSuite), + #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_definition(CipherSuite), case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, SupportedHashSigns, Version) of #alert{} = Alert -> @@ -242,8 +336,33 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, {ConnectionStates, ProtoExt, Protocol} -> {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. + + +do_hello(undefined, _Versions, _CipherSuites, _Hello, _SslOpts, _Info, _Renegotiation) -> + ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION); +do_hello(Version, Versions, CipherSuites, Hello, SslOpts, Info, Renegotiation) -> + case tls_record:is_higher({3,4}, Version) of + true -> %% TLS 1.2 and older + case ssl_cipher:is_fallback(CipherSuites) of + true -> + Highest = tls_record:highest_protocol_version(Versions), + case tls_record:is_higher(Highest, Version) of + true -> + ?ALERT_REC(?FATAL, ?INAPPROPRIATE_FALLBACK); + false -> + handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation) + end; + false -> + handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation) + end; + false -> + %% Implement TLS 1.3 statem ??? + ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) + end. + + %%-------------------------------------------------------------------- -enc_handshake(#hello_request{}, _Version) -> +enc_handshake(#hello_request{}, {3, N}) when N < 4 -> {?HELLO_REQUEST, <<>>}; enc_handshake(#client_hello{client_version = {Major, Minor}, random = Random, @@ -262,7 +381,8 @@ enc_handshake(#client_hello{client_version = {Major, Minor}, ?BYTE(SIDLength), SessionID/binary, ?UINT16(CsLength), BinCipherSuites/binary, ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; - +enc_handshake(HandshakeMsg, {3, 4}) -> + tls_handshake_1_3:encode_handshake(HandshakeMsg); enc_handshake(HandshakeMsg, Version) -> ssl_handshake:encode_handshake(HandshakeMsg, Version). @@ -285,7 +405,7 @@ get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length), get_tls_handshake_aux(_Version, Data, _, Acc) -> {lists:reverse(Acc), Data}. -decode_handshake(_, ?HELLO_REQUEST, <<>>) -> +decode_handshake({3, N}, ?HELLO_REQUEST, <<>>) when N < 4 -> #hello_request{}; decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, @@ -299,9 +419,11 @@ decode_handshake(_Version, ?CLIENT_HELLO, random = Random, session_id = Session_ID, cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites), - compression_methods = Comp_methods, + compression_methods = erlang:binary_to_list(Comp_methods), extensions = DecodedExtensions }; +decode_handshake({3, 4}, Tag, Msg) -> + tls_handshake_1_3:decode_handshake(Tag, Msg); decode_handshake(Version, Tag, Msg) -> ssl_handshake:decode_handshake(Version, Tag, Msg). diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl new file mode 100644 index 0000000000..2957e3a5b4 --- /dev/null +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -0,0 +1,149 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%---------------------------------------------------------------------- +%% Purpose: Help funtions for handling the TLS 1.3 (specific parts of) +%%% TLS handshake protocol +%%---------------------------------------------------------------------- + +-module(tls_handshake_1_3). + +-include("tls_handshake_1_3.hrl"). +-include("ssl_alert.hrl"). +-include("ssl_internal.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +%% Encode +-export([encode_handshake/1, decode_handshake/2]). + +encode_handshake(#certificate_request_1_3{ + certificate_request_context = Context, + extensions = Exts})-> + EncContext = encode_cert_req_context(Context), + BinExts = encode_extensions(Exts), + {?CERTIFICATE_REQUEST, <<EncContext/binary, BinExts/binary>>}; +encode_handshake(#certificate_1_3{ + certificate_request_context = Context, + entries = Entries}) -> + EncContext = encode_cert_req_context(Context), + EncEntries = encode_cert_entries(Entries), + {?CERTIFICATE, <<EncContext/binary, EncEntries/binary>>}; +encode_handshake(#encrypted_extensions{extensions = Exts})-> + {?ENCRYPTED_EXTENSIONS, encode_extensions(Exts)}; +encode_handshake(#new_session_ticket{ + ticket_lifetime = LifeTime, + ticket_age_add = Age, + ticket_nonce = Nonce, + ticket = Ticket, + extensions = Exts}) -> + TicketSize = byte_size(Ticket), + BinExts = encode_extensions(Exts), + {?NEW_SESSION_TICKET, <<?UINT32(LifeTime), ?UINT32(Age), + ?BYTE(Nonce), ?UINT16(TicketSize), Ticket/binary, + BinExts/binary>>}; +encode_handshake(#end_of_early_data{}) -> + {?END_OF_EARLY_DATA, <<>>}; +encode_handshake(#key_update{request_update = Update}) -> + {?KEY_UPDATE, <<?BYTE(Update)>>}; +encode_handshake(HandshakeMsg) -> + ssl_handshake:encode_handshake(HandshakeMsg, {3,4}). + +decode_handshake(?CERTIFICATE_REQUEST, <<?BYTE(0), ?UINT16(Size), EncExts:Size/binary>>) -> + Exts = decode_extensions(EncExts), + #certificate_request_1_3{ + certificate_request_context = <<>>, + extensions = Exts}; +decode_handshake(?CERTIFICATE_REQUEST, <<?BYTE(CSize), Context:CSize/binary, + ?UINT16(Size), EncExts:Size/binary>>) -> + Exts = decode_extensions(EncExts), + #certificate_request_1_3{ + certificate_request_context = Context, + extensions = Exts}; +decode_handshake(?CERTIFICATE, <<?BYTE(0), ?UINT24(Size), Certs:Size/binary>>) -> + CertList = decode_cert_entries(Certs), + #certificate_1_3{ + certificate_request_context = <<>>, + entries = CertList + }; +decode_handshake(?CERTIFICATE, <<?BYTE(CSize), Context:CSize/binary, + ?UINT24(Size), Certs:Size/binary>>) -> + CertList = decode_cert_entries(Certs), + #certificate_1_3{ + certificate_request_context = Context, + entries = CertList + }; +decode_handshake(?ENCRYPTED_EXTENSIONS, EncExts) -> + #encrypted_extensions{ + extensions = decode_extensions(EncExts) + }; +decode_handshake(?NEW_SESSION_TICKET, <<?UINT32(LifeTime), ?UINT32(Age), + ?BYTE(Nonce), ?UINT16(TicketSize), Ticket:TicketSize/binary, + BinExts/binary>>) -> + Exts = decode_extensions(BinExts), + #new_session_ticket{ticket_lifetime = LifeTime, + ticket_age_add = Age, + ticket_nonce = Nonce, + ticket = Ticket, + extensions = Exts}; +decode_handshake(?END_OF_EARLY_DATA, _) -> + #end_of_early_data{}; +decode_handshake(?KEY_UPDATE, <<?BYTE(Update)>>) -> + #key_update{request_update = Update}; +decode_handshake(Tag, HandshakeMsg) -> + ssl_handshake:decode_handshake({3,4}, Tag, HandshakeMsg). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +encode_cert_req_context(<<>>) -> + <<?BYTE(0)>>; +encode_cert_req_context(Bin) -> + Size = byte_size(Bin), + <<?BYTE(Size), Bin/binary>>. + +encode_cert_entries(Entries) -> + CertEntryList = encode_cert_entries(Entries, []), + Size = byte_size(CertEntryList), + <<?UINT24(Size), CertEntryList/binary>>. + +encode_cert_entries([], Acc) -> + iolist_to_binary(lists:reverse(Acc)); +encode_cert_entries([#certificate_entry{data = Data, + extensions = Exts} | Rest], Acc) -> + BinExts = encode_extensions(Exts), + Size = byte_size(Data), + encode_cert_entries(Rest, + [<<?UINT24(Size), Data/binary, BinExts/binary>> | Acc]). + +decode_cert_entries(Entries) -> + decode_cert_entries(Entries, []). + +decode_cert_entries(<<>>, Acc) -> + lists:reverse(Acc); +decode_cert_entries(<<?UINT24(DSize), Data:DSize/binary, ?UINT24(Esize), BinExts:Esize/binary, + Rest/binary>>, Acc) -> + Exts = decode_extensions(BinExts), + decode_cert_entries(Rest, [#certificate_entry{data = Data, + extensions = Exts} | Acc]). + +encode_extensions(Exts)-> + ssl_handshake:encode_hello_extensions(Exts). +decode_extensions(Exts) -> + ssl_handshake:decode_hello_extensions(Exts). diff --git a/lib/ssl/src/tls_handshake_1_3.hrl b/lib/ssl/src/tls_handshake_1_3.hrl new file mode 100644 index 0000000000..9ee0e0f845 --- /dev/null +++ b/lib/ssl/src/tls_handshake_1_3.hrl @@ -0,0 +1,226 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% +%%---------------------------------------------------------------------- +%% Purpose: Record and constant defenitions for the TLS-handshake protocol +%% see RFC 8446. Also includes supported hello extensions. +%%---------------------------------------------------------------------- + +-ifndef(tls_handshake_1_3). +-define(tls_handshake_1_3, true). + +%% Common to TLS-1.3 and previous TLS versions +%% Some defenitions may not exist in TLS-1.3 this is +%% handled elsewhere +-include("tls_handshake.hrl"). + +%% New handshake types in TLS-1.3 RFC 8446 B.3 +-define(NEW_SESSION_TICKET, 4). +-define(END_OF_EARLY_DATA, 5). +-define(ENCRYPTED_EXTENSIONS, 8). +-define(KEY_UPDATE, 24). +%% %% Not really a message but special way to handle handshake hashes +%% %% when a "hello-retry-request" (special server_hello) is sent +-define(MESSAGE_HASH, 254). + +%% %% RFC 8446 B.3.1. +%% %% New extension types in TLS-1.3 +-define(PRE_SHARED_KEY_EXT, 41). +-define(EARLY_DATA_EXT, 42). +%%-define(SUPPORTED_VERSIONS_EXT, 43). %% Updates TLS 1.2 so defined in ssl_handshake.hrl +-define(COOKIE_EXT, 44). +-define(PSK_KEY_EXCHANGE_MODES_EXT, 45). +-define(CERTIFICATE_AUTHORITIES_EXT, 47). +-define(OID_FILTERS_EXT, 48). +-define(POST_HANDSHAKE_AUTH_EXT, 49). +%% -define(SIGNATURE_ALGORITHMS_CERT_EXT, 50). %% Updates TLS 1.2 so defined in ssl_handshake.hrl +-define(KEY_SHARE_EXT, 51). + +%% RFC 8446 B.3.1 +-record(key_share_entry, { + group, %NamedGroup + key_exchange %key_exchange<1..2^16-1>; + }). +-record(key_share_client_hello, { + entries %% KeyShareEntry client_shares<0..2^16-1>; + }). +-record(key_share_hello_retry_request, { + selected_group %% NamedGroup + }). +-record(key_share_server_hello, { + server_share %% KeyShareEntry server_share; + }). + +-record(uncompressed_point_representation, { + legacy_form = 4, % uint8 legacy_form = 4; + x, % opaque X[coordinate_length]; + y % opaque Y[coordinate_length]; + }). + +-define(PSK_KE, 0). +-define(PSK_DHE_KE, 1). + +-record(psk_keyexchange_modes, { + ke_modes % ke_modes<1..255> + }). +-record(empty, { + }). +-record(early_data_indication, { + indication % uint32 max_early_data_size (new_session_ticket) | + %% #empty{} (client_hello, encrypted_extensions) + }). +-record(psk_identity, { + identity, % opaque identity<1..2^16-1> + obfuscated_ticket_age % uint32 + }). +-record(offered_psks, { + psk_identity, %identities<7..2^16-1>; + psk_binder_entry %binders<33..2^16-1>, opaque PskBinderEntry<32..255> + }). +-record(pre_shared_keyextension,{ + extension %OfferedPsks (client_hello) | uint16 selected_identity (server_hello) + }). + +%% RFC 8446 B.3.1.2. +-record(cookie, { + cookie %cookie<1..2^16-1>; + }). + +%%% RFC 8446 B.3.1.3. Signature Algorithm Extension +%% Signature Schemes +%% RSASSA-PKCS1-v1_5 algorithms +-define(RSA_PKCS1_SHA256, 16#0401). +-define(RSA_PKCS1_SHA384, 16#0501). +-define(RSA_PKCS1_SHA512, 16#0601). + +%% ECDSA algorithms +-define(ECDSA_SECP256R1_SHA256, 16#0403). +-define(ECDSA_SECP384R1_SHA384, 16#0503). +-define(ECDSA_SECP521R1_SHA512, 16#0603). + +%% RSASSA-PSS algorithms with public key OID rsaEncryption +-define(RSA_PSS_RSAE_SHA256, 16#0804). +-define(RSA_PSS_RSAE_SHA384, 16#0805). +-define(RSA_PSS_RSAE_SHA512, 16#0806). + +%% EdDSA algorithms +-define(ED25519, 16#0807). +-define(ED448, 16#0808). + +%% RSASSA-PSS algorithms with public key OID RSASSA-PSS +-define(RSA_PSS_PSS_SHA256, 16#0809). +-define(RSA_PSS_PSS_SHA384, 16#080a). +-define(RSA_PSS_PSS_SHA512, 16#080b). + +%% Legacy algorithms +-define(RSA_PKCS1_SHA1, 16#201). +-define(ECDSA_SHA1, 16#0203). + +%% RFC 8446 B.3.1.4. Supported Groups Extension +%% Elliptic Curve Groups (ECDHE) +-define(SECP256R1, 16#0017). +-define(SECP384R1, 16#0018). +-define(SECP521R1, 16#0019). +-define(X25519, 16#001D). +-define(X448, 16#001E). + +%% RFC 8446 Finite Field Groups (DHE) +-define(FFDHE2048, 16#0100). +-define(FFDHE3072, 16#0101). +-define(FFDHE4096, 16#0102). +-define(FFDHE6144, 16#0103). +-define(FFDHE8192 ,16#0104). + +-record(named_group_list, { + named_group_list %named_group_list<2..2^16-1>; + }). + +%% RFC 8446 B.3.2 Server Parameters Messages +%% opaque DistinguishedName<1..2^16-1>;XS +-record(certificate_authoritie_sextension, { + authorities %DistinguishedName authorities<3..2^16-1>; + }). + +-record(oid_filter, { + certificate_extension_oid, % opaque certificate_extension_oid<1..2^8-1>; + certificate_extension_values % opaque certificate_extension_values<0..2^16-1>; + }). + +-record(oid_filter_extension, { + filters %OIDFilter filters<0..2^16-1>; + }). +-record(post_handshake_auth, { + }). + +-record(encrypted_extensions, { + extensions %extensions<0..2^16-1>; + }). + +-record(certificate_request_1_3, { + certificate_request_context, % opaque certificate_request_context<0..2^8-1>; + extensions %Extension extensions<2..2^16-1>; + }). + +%% RFC 8446 B.3.3 Authentication Messages + +%% Certificate Type +-define(X509, 0). +-define(OpenPGP_RESERVED, 1). +-define(RawPublicKey, 2). + +-record(certificate_entry, { + data, + %% select (certificate_type) { + %% case RawPublicKey: + %% /* From RFC 7250 ASN.1_subjectPublicKeyInfo */ + %% opaque ASN1_subjectPublicKeyInfo<1..2^24-1>; + + %% case X509: + %% opaque cert_data<1..2^24-1>; + %% }; + extensions %% Extension extensions<0..2^16-1>; + }). + +-record(certificate_1_3, { + certificate_request_context, % opaque certificate_request_context<0..2^8-1>; + entries % CertificateEntry certificate_list<0..2^24-1>; + }). + +%% RFC 8446 B.3.4. Ticket Establishment +-record(new_session_ticket, { + ticket_lifetime, %unit32 + ticket_age_add, %unit32 + ticket_nonce, %opaque ticket_nonce<0..255>; + ticket, %opaque ticket<1..2^16-1> + extensions %extensions<0..2^16-2> + }). + +%% RFC 8446 B.3.5. Updating Keys +-record(end_of_early_data, { + }). + +-define(UPDATE_NOT_REQUESTED, 0). +-define(UPDATE_REQUESTED, 1). + +-record(key_update, { + request_update + }). + +-endif. % -ifdef(tls_handshake_1_3). diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 278d471fdb..444759aafa 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -230,6 +230,8 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, %% Description: Creates a protocol version record from a version atom %% or vice versa. %%-------------------------------------------------------------------- +protocol_version('tlsv1.3') -> + {3, 4}; protocol_version('tlsv1.2') -> {3, 3}; protocol_version('tlsv1.1') -> @@ -240,6 +242,8 @@ protocol_version(sslv3) -> {3, 0}; protocol_version(sslv2) -> %% Backwards compatibility {2, 0}; +protocol_version({3, 4}) -> + 'tlsv1.3'; protocol_version({3, 3}) -> 'tlsv1.2'; protocol_version({3, 2}) -> diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl new file mode 100644 index 0000000000..007fd345dd --- /dev/null +++ b/lib/ssl/src/tls_sender.erl @@ -0,0 +1,397 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018-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(tls_sender). + +-behaviour(gen_statem). + +-include("ssl_internal.hrl"). +-include("ssl_alert.hrl"). +-include("ssl_handshake.hrl"). +-include("ssl_api.hrl"). + +%% API +-export([start/0, start/1, initialize/2, send_data/2, send_alert/2, renegotiate/1, + update_connection_state/3, dist_tls_socket/1, dist_handshake_complete/3]). + +%% gen_statem callbacks +-export([callback_mode/0, init/1, terminate/3, code_change/4]). +-export([init/3, connection/3, handshake/3, death_row/3]). + +-define(SERVER, ?MODULE). + +-record(data, {connection_pid, + connection_states = #{}, + role, + socket, + socket_options, + tracker, + protocol_cb, + transport_cb, + negotiated_version, + renegotiate_at, + connection_monitor, + dist_handle + }). + +%%%=================================================================== +%%% API +%%%=================================================================== +%%-------------------------------------------------------------------- +-spec start() -> {ok, Pid :: pid()} | + ignore | + {error, Error :: term()}. +-spec start(list()) -> {ok, Pid :: pid()} | + ignore | + {error, Error :: term()}. + +%% Description: Start sender process to avoid dead lock that +%% may happen when a socket is busy (busy port) and the +%% same process is sending and receiving +%%-------------------------------------------------------------------- +start() -> + gen_statem:start_link(?MODULE, [], []). +start(SpawnOpts) -> + gen_statem:start_link(?MODULE, [], SpawnOpts). + +%%-------------------------------------------------------------------- +-spec initialize(pid(), map()) -> ok. +%% Description: So TLS connection process can initialize it sender +%% process. +%%-------------------------------------------------------------------- +initialize(Pid, InitMsg) -> + gen_statem:call(Pid, {self(), InitMsg}). + +%%-------------------------------------------------------------------- +-spec send_data(pid(), iodata()) -> ok. +%% Description: Send application data +%%-------------------------------------------------------------------- +send_data(Pid, AppData) -> + %% Needs error handling for external API + call(Pid, {application_data, AppData}). + +%%-------------------------------------------------------------------- +-spec send_alert(pid(), #alert{}) -> _. +%% Description: TLS connection process wants to end an Alert +%% in the connection state. +%%-------------------------------------------------------------------- +send_alert(Pid, Alert) -> + gen_statem:cast(Pid, Alert). + +%%-------------------------------------------------------------------- +-spec renegotiate(pid()) -> {ok, WriteState::map()} | {error, closed}. +%% Description: So TLS connection process can synchronize the +%% encryption state to be used when handshaking. +%%-------------------------------------------------------------------- +renegotiate(Pid) -> + %% Needs error handling for external API + call(Pid, renegotiate). +%%-------------------------------------------------------------------- +-spec update_connection_state(pid(), WriteState::map(), tls_record:tls_version()) -> ok. +%% Description: So TLS connection process can synchronize the +%% encryption state to be used when sending application data. +%%-------------------------------------------------------------------- +update_connection_state(Pid, NewState, Version) -> + gen_statem:cast(Pid, {new_write, NewState, Version}). +%%-------------------------------------------------------------------- +-spec dist_handshake_complete(pid(), node(), term()) -> ok. +%% Description: Erlang distribution callback +%%-------------------------------------------------------------------- +dist_handshake_complete(ConnectionPid, Node, DHandle) -> + gen_statem:call(ConnectionPid, {dist_handshake_complete, Node, DHandle}). +%%-------------------------------------------------------------------- +-spec dist_tls_socket(pid()) -> {ok, #sslsocket{}}. +%% Description: To enable distribution startup to get a proper "#sslsocket{}" +%%-------------------------------------------------------------------- +dist_tls_socket(Pid) -> + gen_statem:call(Pid, dist_get_tls_socket). + +%%%=================================================================== +%%% gen_statem callbacks +%%%=================================================================== +%%-------------------------------------------------------------------- +-spec callback_mode() -> gen_statem:callback_mode_result(). +%%-------------------------------------------------------------------- +callback_mode() -> + state_functions. + +%%-------------------------------------------------------------------- +-spec init(Args :: term()) -> + gen_statem:init_result(atom()). +%%-------------------------------------------------------------------- +init(_) -> + %% Note: Should not trap exits so that this process + %% will be terminated if tls_connection process is + %% killed brutally + {ok, init, #data{}}. + +%%-------------------------------------------------------------------- +-spec init(gen_statem:event_type(), + Msg :: term(), + StateData :: term()) -> + gen_statem:event_handler_result(atom()). +%%-------------------------------------------------------------------- +init({call, From}, {Pid, #{current_write := WriteState, + role := Role, + socket := Socket, + socket_options := SockOpts, + tracker := Tracker, + protocol_cb := Connection, + transport_cb := Transport, + negotiated_version := Version, + renegotiate_at := RenegotiateAt}}, + #data{connection_states = ConnectionStates} = StateData0) -> + Monitor = erlang:monitor(process, Pid), + StateData = + StateData0#data{connection_pid = Pid, + connection_monitor = Monitor, + connection_states = + ConnectionStates#{current_write => WriteState}, + role = Role, + socket = Socket, + socket_options = SockOpts, + tracker = Tracker, + protocol_cb = Connection, + transport_cb = Transport, + negotiated_version = Version, + renegotiate_at = RenegotiateAt}, + {next_state, handshake, StateData, [{reply, From, ok}]}; +init(info, Msg, StateData) -> + handle_info(Msg, ?FUNCTION_NAME, StateData). +%%-------------------------------------------------------------------- +-spec connection(gen_statem:event_type(), + Msg :: term(), + StateData :: term()) -> + gen_statem:event_handler_result(atom()). +%%-------------------------------------------------------------------- +connection({call, From}, renegotiate, + #data{connection_states = #{current_write := Write}} = StateData) -> + {next_state, handshake, StateData, [{reply, From, {ok, Write}}]}; +connection({call, From}, {application_data, AppData}, + #data{socket_options = SockOpts} = StateData) -> + case encode_packet(AppData, SockOpts) of + {error, _} = Error -> + {next_state, ?FUNCTION_NAME, StateData, [{reply, From, Error}]}; + Data -> + send_application_data(Data, From, ?FUNCTION_NAME, StateData) + end; +connection({call, From}, dist_get_tls_socket, + #data{protocol_cb = Connection, + transport_cb = Transport, + socket = Socket, + connection_pid = Pid, + tracker = Tracker} = StateData) -> + TLSSocket = Connection:socket([Pid, self()], Transport, Socket, Connection, Tracker), + {next_state, ?FUNCTION_NAME, StateData, [{reply, From, {ok, TLSSocket}}]}; +connection({call, From}, {dist_handshake_complete, _Node, DHandle}, #data{connection_pid = Pid} = StateData) -> + ok = erlang:dist_ctrl_input_handler(DHandle, Pid), + ok = ssl_connection:dist_handshake_complete(Pid, DHandle), + %% From now on we execute on normal priority + process_flag(priority, normal), + Events = dist_data_events(DHandle, []), + {next_state, ?FUNCTION_NAME, StateData#data{dist_handle = DHandle}, [{reply, From, ok} | Events]}; +connection(cast, #alert{} = Alert, StateData0) -> + StateData = send_tls_alert(Alert, StateData0), + {next_state, ?FUNCTION_NAME, StateData}; +connection(cast, {new_write, WritesState, Version}, + #data{connection_states = ConnectionStates0} = StateData) -> + {next_state, connection, + StateData#data{connection_states = + ConnectionStates0#{current_write => WritesState}, + negotiated_version = Version}}; +connection(info, dist_data, #data{dist_handle = DHandle} = StateData) -> + Events = dist_data_events(DHandle, []), + {next_state, ?FUNCTION_NAME, StateData, Events}; +connection(info, tick, StateData) -> + consume_ticks(), + {next_state, ?FUNCTION_NAME, StateData, + [{next_event, {call, {self(), undefined}}, + {application_data, <<>>}}]}; +connection(info, {send, From, Ref, Data}, _StateData) -> + %% This is for testing only! + %% + %% Needed by some OTP distribution + %% test suites... + From ! {Ref, ok}, + {keep_state_and_data, + [{next_event, {call, {self(), undefined}}, + {application_data, iolist_to_binary(Data)}}]}; +connection(info, Msg, StateData) -> + handle_info(Msg, ?FUNCTION_NAME, StateData). +%%-------------------------------------------------------------------- +-spec handshake(gen_statem:event_type(), + Msg :: term(), + StateData :: term()) -> + gen_statem:event_handler_result(atom()). +%%-------------------------------------------------------------------- +handshake({call, _}, _, _) -> + {keep_state_and_data, [postpone]}; +handshake(cast, {new_write, WritesState, Version}, + #data{connection_states = ConnectionStates0} = StateData) -> + {next_state, connection, + StateData#data{connection_states = + ConnectionStates0#{current_write => WritesState}, + negotiated_version = Version}}; +handshake(info, Msg, StateData) -> + handle_info(Msg, ?FUNCTION_NAME, StateData). + +%%-------------------------------------------------------------------- +-spec death_row(gen_statem:event_type(), + Msg :: term(), + StateData :: term()) -> + gen_statem:event_handler_result(atom()). +%%-------------------------------------------------------------------- +death_row(state_timeout, Reason, _State) -> + {stop, {shutdown, Reason}}; +death_row(_Type, _Msg, _State) -> + %% Waste all other events + keep_state_and_data. + +%%-------------------------------------------------------------------- +-spec terminate(Reason :: term(), State :: term(), Data :: term()) -> + any(). +%%-------------------------------------------------------------------- +terminate(_Reason, _State, _Data) -> + void. + +%%-------------------------------------------------------------------- +-spec code_change( + OldVsn :: term() | {down,term()}, + State :: term(), Data :: term(), Extra :: term()) -> + {ok, NewState :: term(), NewData :: term()} | + (Reason :: term()). +%% Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, Data, _Extra) -> + {ok, State, Data}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== +handle_info({'DOWN', Monitor, _, _, Reason}, _, + #data{connection_monitor = Monitor, + dist_handle = Handle} = StateData) when Handle =/= undefined-> + {next_state, death_row, StateData, [{state_timeout, 5000, Reason}]}; +handle_info({'DOWN', Monitor, _, _, _}, _, + #data{connection_monitor = Monitor} = StateData) -> + {stop, normal, StateData}; +handle_info(_,_,_) -> + {keep_state_and_data}. + +send_tls_alert(Alert, #data{negotiated_version = Version, + socket = Socket, + protocol_cb = Connection, + transport_cb = Transport, + connection_states = ConnectionStates0} = StateData0) -> + {BinMsg, ConnectionStates} = + Connection:encode_alert(Alert, Version, ConnectionStates0), + Connection:send(Transport, Socket, BinMsg), + StateData0#data{connection_states = ConnectionStates}. + +send_application_data(Data, From, StateName, + #data{connection_pid = Pid, + socket = Socket, + dist_handle = DistHandle, + negotiated_version = Version, + protocol_cb = Connection, + transport_cb = Transport, + connection_states = ConnectionStates0, + renegotiate_at = RenegotiateAt} = StateData0) -> + case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of + true -> + ssl_connection:internal_renegotiation(Pid, ConnectionStates0), + {next_state, handshake, StateData0, + [{next_event, {call, From}, {application_data, Data}}]}; + false -> + {Msgs, ConnectionStates} = + Connection:encode_data(Data, Version, ConnectionStates0), + StateData = StateData0#data{connection_states = ConnectionStates}, + case Connection:send(Transport, Socket, Msgs) of + ok when DistHandle =/= undefined -> + {next_state, StateName, StateData, []}; + Reason when DistHandle =/= undefined -> + {next_state, death_row, StateData, [{state_timeout, 5000, Reason}]}; + ok -> + {next_state, StateName, StateData, [{reply, From, ok}]}; + Result -> + {next_state, StateName, StateData, [{reply, From, Result}]} + end + end. + +encode_packet(Data, #socket_options{packet=Packet}) -> + case Packet of + 1 -> encode_size_packet(Data, 8, (1 bsl 8) - 1); + 2 -> encode_size_packet(Data, 16, (1 bsl 16) - 1); + 4 -> encode_size_packet(Data, 32, (1 bsl 32) - 1); + _ -> Data + end. + +encode_size_packet(Bin, Size, Max) -> + Len = erlang:byte_size(Bin), + case Len > Max of + true -> + {error, {badarg, {packet_to_large, Len, Max}}}; + false -> + <<Len:Size, Bin/binary>> + end. +time_to_renegotiate(_Data, + #{current_write := #{sequence_number := Num}}, + RenegotiateAt) -> + + %% We could do test: + %% is_time_to_renegotiate((erlang:byte_size(_Data) div + %% ?MAX_PLAIN_TEXT_LENGTH) + 1, RenegotiateAt), but we chose to + %% have a some what lower renegotiateAt and a much cheaper test + is_time_to_renegotiate(Num, RenegotiateAt). + +is_time_to_renegotiate(N, M) when N < M-> + false; +is_time_to_renegotiate(_,_) -> + true. + +call(FsmPid, Event) -> + try gen_statem:call(FsmPid, Event) + catch + exit:{noproc, _} -> + {error, closed}; + exit:{normal, _} -> + {error, closed}; + exit:{{shutdown, _},_} -> + {error, closed} + end. + +%%---------------Erlang distribution -------------------------------------- + +dist_data_events(DHandle, Events) -> + case erlang:dist_ctrl_get_data(DHandle) of + none -> + erlang:dist_ctrl_get_data_notification(DHandle), + lists:reverse(Events); + Data -> + Event = {next_event, {call, {self(), undefined}}, {application_data, Data}}, + dist_data_events(DHandle, [Event | Events]) + end. + +consume_ticks() -> + receive tick -> + consume_ticks() + after 0 -> + ok + end. diff --git a/lib/ssl/src/tls_socket.erl b/lib/ssl/src/tls_socket.erl index 154281f1c2..a391bc53de 100644 --- a/lib/ssl/src/tls_socket.erl +++ b/lib/ssl/src/tls_socket.erl @@ -64,11 +64,12 @@ accept(ListenSocket, #config{transport_info = {Transport,_,_,_} = CbInfo, {ok, Socket} -> {ok, EmOpts} = get_emulated_opts(Tracker), {ok, Port} = tls_socket:port(Transport, Socket), - ConnArgs = [server, "localhost", Port, Socket, + {ok, Sender} = tls_sender:start(), + ConnArgs = [server, Sender, "localhost", Port, Socket, {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), Tracker}, self(), CbInfo], case tls_connection_sup:start_child(ConnArgs) of {ok, Pid} -> - ssl_connection:socket_control(ConnectionCb, Socket, Pid, Transport, Tracker); + ssl_connection:socket_control(ConnectionCb, Socket, [Pid, Sender], Transport, Tracker); {error, Reason} -> {error, Reason} end; @@ -112,8 +113,8 @@ connect(Address, Port, {error, {options, {socket_options, UserOpts}}} end. -socket(Pid, Transport, Socket, ConnectionCb, Tracker) -> - #sslsocket{pid = Pid, +socket(Pids, Transport, Socket, ConnectionCb, Tracker) -> + #sslsocket{pid = Pids, %% "The name "fd" is keept for backwards compatibility fd = {Transport, Socket, ConnectionCb, Tracker}}. setopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) -> diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index d6b500748e..7d28962d2d 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -32,7 +32,8 @@ -export([master_secret/4, finished/5, certificate_verify/3, mac_hash/7, hmac_hash/3, setup_keys/8, suites/1, prf/5, ecc_curves/1, ecc_curves/2, oid_to_enum/1, enum_to_oid/1, - default_signature_algs/1, signature_algs/2]). + default_signature_algs/1, signature_algs/2, + default_signature_schemes/1, signature_schemes/2]). -type named_curve() :: sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 | sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 | @@ -74,7 +75,7 @@ finished(Role, Version, PrfAlgo, MasterSecret, Handshake) prf(?MD5SHA, MasterSecret, finished_label(Role), [MD5, SHA], 12); finished(Role, Version, PrfAlgo, MasterSecret, Handshake) - when Version == 3 -> + when Version == 3; Version == 4 -> %% RFC 5246 - 7.4.9. Finished %% struct { %% opaque verify_data[12]; @@ -85,6 +86,7 @@ finished(Role, Version, PrfAlgo, MasterSecret, Handshake) Hash = crypto:hash(mac_algo(PrfAlgo), Handshake), prf(PrfAlgo, MasterSecret, finished_label(Role), Hash, 12). + -spec certificate_verify(md5sha | sha, integer(), [binary()]) -> binary(). certificate_verify(md5sha, _Version, Handshake) -> @@ -154,7 +156,7 @@ setup_keys(Version, _PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize %% TLS v1.2 setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen, IVSize) - when Version == 3 -> + when Version == 3; Version == 4 -> %% RFC 5246 - 6.3. Key calculation %% key_block = PRF(SecurityParameters.master_secret, %% "key expansion", @@ -192,7 +194,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, Fragment]), Mac. --spec suites(1|2|3) -> [ssl_cipher:cipher_suite()]. +-spec suites(1|2|3|4) -> [ssl_cipher_format:cipher_suite()]. suites(Minor) when Minor == 1; Minor == 2 -> [ @@ -244,8 +246,19 @@ suites(3) -> %% ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384, %% ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256, %% ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256 - ] ++ suites(2). - + ] ++ suites(2); + +suites(4) -> + [?TLS_AES_256_GCM_SHA384, + ?TLS_AES_128_GCM_SHA256, + ?TLS_CHACHA20_POLY1305_SHA256 + %% Not supported + %% ?TLS_AES_128_CCM_SHA256, + %% ?TLS_AES_128_CCM_8_SHA256 + ] ++ suites(3). + +signature_algs({3, 4}, HashSigns) -> + signature_algs({3, 3}, HashSigns); signature_algs({3, 3}, HashSigns) -> CryptoSupports = crypto:supports(), Hashes = proplists:get_value(hashs, CryptoSupports), @@ -273,6 +286,8 @@ signature_algs({3, 3}, HashSigns) -> end, [], HashSigns), lists:reverse(Supported). +default_signature_algs({3, 4}) -> + default_signature_algs({3, 3}); default_signature_algs({3, 3} = Version) -> Default = [%% SHA2 {sha512, ecdsa}, @@ -291,6 +306,64 @@ default_signature_algs({3, 3} = Version) -> default_signature_algs(_) -> undefined. + +signature_schemes(Version, SignatureSchemes) when is_tuple(Version) + andalso Version >= {3, 3} -> + CryptoSupports = crypto:supports(), + Hashes = proplists:get_value(hashs, CryptoSupports), + PubKeys = proplists:get_value(public_keys, CryptoSupports), + Curves = proplists:get_value(curves, CryptoSupports), + Fun = fun (Scheme, Acc) -> + {Hash0, Sign0, Curve} = + ssl_cipher:scheme_to_components(Scheme), + Sign = case Sign0 of + rsa_pkcs1 -> rsa; + S -> S + end, + Hash = case Hash0 of + sha1 -> sha; + H -> H + end, + case proplists:get_bool(Sign, PubKeys) + andalso proplists:get_bool(Hash, Hashes) + andalso (Curve =:= undefined orelse + proplists:get_bool(Curve, Curves)) + andalso is_pair(Hash, Sign, Hashes) + of + true -> + [Scheme | Acc]; + false -> + Acc + end + end, + Supported = lists:foldl(Fun, [], SignatureSchemes), + lists:reverse(Supported); +signature_schemes(_, _) -> + []. + + +default_signature_schemes(Version) -> + Default = [ + rsa_pkcs1_sha256, + rsa_pkcs1_sha384, + rsa_pkcs1_sha512, + ecdsa_secp256r1_sha256, + ecdsa_secp384r1_sha384, + ecdsa_secp521r1_sha512, + rsa_pss_rsae_sha256, + rsa_pss_rsae_sha384, + rsa_pss_rsae_sha512, + %% ed25519, + %% ed448, + rsa_pss_pss_sha256, + rsa_pss_pss_sha384, + rsa_pss_pss_sha512, + rsa_pkcs1_sha1, + ecdsa_sha1 + ], + signature_schemes(Version, Default). + + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 9dfb2eba53..d5ba105478 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -61,6 +61,7 @@ MODULES = \ ssl_ECC\ ssl_upgrade_SUITE\ ssl_sni_SUITE \ + ssl_eqc_SUITE \ make_certs\ x509_test @@ -144,7 +145,7 @@ release_tests_spec: opt $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(HRL_FILES_NEEDED_IN_TEST) $(COVER_FILE) "$(RELSYSDIR)" $(INSTALL_DATA) ssl.spec ssl_bench.spec ssl.cover "$(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/lib/ssl/test/property_test/ssl_eqc_handshake.erl b/lib/ssl/test/property_test/ssl_eqc_handshake.erl new file mode 100644 index 0000000000..5303785b17 --- /dev/null +++ b/lib/ssl/test/property_test/ssl_eqc_handshake.erl @@ -0,0 +1,146 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2015. 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(ssl_eqc_handshake). + +-compile(export_all). + +-proptest(eqc). +-proptest([triq,proper]). + +-ifndef(EQC). +-ifndef(PROPER). +-ifndef(TRIQ). +-define(EQC,true). +-endif. +-endif. +-endif. + +-ifdef(EQC). +-include_lib("eqc/include/eqc.hrl"). +-define(MOD_eqc,eqc). + +-else. +-ifdef(PROPER). +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). + +-else. +-ifdef(TRIQ). +-define(MOD_eqc,triq). +-include_lib("triq/include/triq.hrl"). + +-endif. +-endif. +-endif. + +-include_lib("ssl/src/tls_handshake_1_3.hrl"). +-include_lib("ssl/src/tls_handshake.hrl"). +-include_lib("ssl/src/ssl_handshake.hrl"). +-include_lib("ssl/src/ssl_alert.hrl"). +-include_lib("ssl/src/ssl_internal.hrl"). + +-define('TLS_v1.3', {3,4}). +-define('TLS_v1.2', {3,3}). +-define('TLS_v1.1', {3,2}). +-define('TLS_v1', {3,1}). +-define('SSL_v3', {3,0}). + +%%-------------------------------------------------------------------- +%% Properties -------------------------------------------------------- +%%-------------------------------------------------------------------- + +prop_tls_hs_encode_decode() -> + ?FORALL({Handshake, TLSVersion}, ?LET(Version, tls_version(), {tls_msg(Version), Version}), + try + [Type, _Length, Data] = tls_handshake:encode_handshake(Handshake, TLSVersion), + case tls_handshake:decode_handshake(TLSVersion, Type, Data) of + Handshake -> + true; + _ -> + false + end + catch + throw:#alert{} -> + true + end + ). + +tls_version() -> + oneof([?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1', ?'SSL_v3']). + +tls_msg(?'TLS_v1.3'= Version) -> + oneof([client_hello(Version), + %%server_hello(Version) + %%new_session_ticket() + #end_of_early_data{}, + %%encrypted_extensions() + %%certificate_1_3(), + %%certificate_request() + %%certificate_verify() + %%finished() + key_update() + %%message_hash() + ]); +tls_msg(Version) -> + oneof([#hello_request{}, + client_hello(Version), + %%server_hello(Version) + %%certificate(), + %%server_key_exchange() + %%certificate_request() + #server_hello_done{} + %%certificate_verify() + %%client_key_exchange() + %%finished() + ]). + +client_hello(?'TLS_v1.3' = Version) -> + #client_hello{session_id = session_id(), + client_version = ?'TLS_v1.2', + cipher_suites = ssl_cipher:suites(Version), + compression_methods = compressions(Version), + random = client_random(Version), + extensions = client_extensions(Version) + }; +client_hello(Version) -> + #client_hello{session_id = session_id(), + client_version = Version, + cipher_suites = ssl_cipher:suites(Version), + compression_methods = compressions(Version), + random = client_random(Version), + extensions = client_extensions(Version) + }. +session_id() -> + crypto:strong_rand_bytes(?NUM_OF_SESSION_ID_BYTES). + +compressions(_) -> + ssl_record:compressions(). +client_random(_) -> + crypto:strong_rand_bytes(32). + +client_extensions(_) -> + #hello_extensions{}. + +key_update() -> + #key_update{request_update = request_update()}. + +request_update() -> + oneof([?UPDATE_NOT_REQUESTED, ?UPDATE_REQUESTED]). diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 0381d0d87d..1970c16f1d 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -243,7 +243,8 @@ error_handling_tests()-> recv_active, recv_active_once, recv_error_handling, - call_in_error_state + call_in_error_state, + close_in_error_state ]. error_handling_tests_tls()-> @@ -3269,7 +3270,7 @@ no_reuses_session_server_restart_new_cert(Config) when is_list(Config) -> ssl_test_lib:start_server([{node, ServerNode}, {port, Port}, {from, self()}, {mfa, {ssl_test_lib, no_result, []}}, - {options, DsaServerOpts}]), + {options, [{reuseaddr, true} | DsaServerOpts]}]), Client1 = ssl_test_lib:start_client([{node, ClientNode}, @@ -3330,7 +3331,7 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) -> ssl_test_lib:start_server([{node, ServerNode}, {port, Port}, {from, self()}, {mfa, {ssl_test_lib, no_result, []}}, - {options, NewServerOpts1}]), + {options, [{reuseaddr, true} | NewServerOpts1]}]), Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -3526,7 +3527,7 @@ honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) -> %%-------------------------------------------------------------------- tls_ciphersuite_vs_version() -> - [{doc,"Test a SSLv3 client can not negotiate a TLSv* cipher suite."}]. + [{doc,"Test a SSLv3 client cannot negotiate a TLSv* cipher suite."}]. tls_ciphersuite_vs_version(Config) when is_list(Config) -> {_ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -3673,7 +3674,7 @@ hibernate(Config) -> {mfa, {ssl_test_lib, send_recv_result_active, []}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - {Client, #sslsocket{pid=Pid}} = ssl_test_lib:start_client([return_socket, + {Client, #sslsocket{pid=[Pid|_]}} = ssl_test_lib:start_client([return_socket, {node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -3716,7 +3717,7 @@ hibernate_right_away(Config) -> Server1 = ssl_test_lib:start_server(StartServerOpts), Port1 = ssl_test_lib:inet_port(Server1), - {Client1, #sslsocket{pid = Pid1}} = ssl_test_lib:start_client(StartClientOpts ++ + {Client1, #sslsocket{pid = [Pid1|_]}} = ssl_test_lib:start_client(StartClientOpts ++ [{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]), ssl_test_lib:check_result(Server1, ok, Client1, ok), @@ -3728,7 +3729,7 @@ hibernate_right_away(Config) -> Server2 = ssl_test_lib:start_server(StartServerOpts), Port2 = ssl_test_lib:inet_port(Server2), - {Client2, #sslsocket{pid = Pid2}} = ssl_test_lib:start_client(StartClientOpts ++ + {Client2, #sslsocket{pid = [Pid2|_]}} = ssl_test_lib:start_client(StartClientOpts ++ [{port, Port2}, {options, [{hibernate_after, 1}|ClientOpts]}]), ssl_test_lib:check_result(Server2, ok, Client2, ok), @@ -3964,13 +3965,13 @@ tls_tcp_error_propagation_in_active_mode(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - {Client, #sslsocket{pid=Pid} = SslSocket} = ssl_test_lib:start_client([return_socket, - {node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, receive_msg, []}}, - {options, ClientOpts}]), - + {Client, #sslsocket{pid=[Pid|_]} = SslSocket} = ssl_test_lib:start_client([return_socket, + {node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, receive_msg, []}}, + {options, ClientOpts}]), + {status, _, _, StatusInfo} = sys:get_status(Pid), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), @@ -4036,6 +4037,33 @@ run_error_server([ Pid | Opts]) -> %%-------------------------------------------------------------------- +close_in_error_state() -> + [{doc,"Special case of closing socket in error state"}]. +close_in_error_state(Config) when is_list(Config) -> + ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts = [{cacertfile, "foo.pem"} | proplists:delete(cacertfile, ServerOpts0)], + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + _ = spawn_link(?MODULE, run_error_server_close, [[self() | ServerOpts]]), + receive + {_Pid, Port} -> + spawn_link(?MODULE, run_client_error, [[Port, ClientOpts]]) + end, + receive + ok -> + ok; + Other -> + ct:fail(Other) + end. + +run_error_server_close([Pid | Opts]) -> + {ok, Listen} = ssl:listen(0, Opts), + {ok,{_, Port}} = ssl:sockname(Listen), + Pid ! {self(), Port}, + {ok, Socket} = ssl:transport_accept(Listen), + Pid ! ssl:close(Socket). + +%%-------------------------------------------------------------------- + rizzo() -> [{doc, "Test that there is a 1/n-1-split for non RC4 in 'TLS < 1.1' as it is vunrable to Rizzo/Dungon attack"}]. @@ -4617,6 +4645,7 @@ renegotiate_rejected(Socket) -> ok; %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast {ssl, Socket, "H"} -> + receive {ssl, Socket, "ello world"} -> ok @@ -5004,20 +5033,24 @@ run_suites(Ciphers, Config, Type) -> [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]} end, - ct:pal("ssl_test_lib:filter_suites(~p ~p) -> ~p ", [Ciphers, Version, ssl_test_lib:filter_suites(Ciphers, Version)]), - Result = lists:map(fun(Cipher) -> - cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, - ssl_test_lib:filter_suites(Ciphers, Version)), - case lists:flatten(Result) of - [] -> - ok; - Error -> - ct:log("Cipher suite errors: ~p~n", [Error]), - ct:fail(cipher_suite_failed_see_test_case_log) - end. - + Suites = ssl_test_lib:filter_suites(Ciphers, Version), + ct:pal("ssl_test_lib:filter_suites(~p ~p) -> ~p ", [Ciphers, Version, Suites]), + Results0 = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, + ssl_test_lib:filter_suites(Ciphers, Version)), + Results = lists:flatten(Results0), + true = length(Results) == length(Suites), + check_cipher_result(Results). + +check_cipher_result([]) -> + ok; +check_cipher_result([ok | Rest]) -> + check_cipher_result(Rest); +check_cipher_result([_ |_] = Error) -> + ct:fail(Error). + erlang_cipher_suite(Suite) when is_list(Suite)-> - ssl_cipher:suite_definition(ssl_cipher:openssl_suite(Suite)); + ssl_cipher_format:suite_definition(ssl_cipher_format:openssl_suite(Suite)); erlang_cipher_suite(Suite) -> Suite. @@ -5052,7 +5085,7 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> case Result of ok -> - []; + [ok]; Error -> [{ErlangCipherSuite, Error}] end. diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 63e9d07d0b..c0981a9eaf 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -513,7 +513,7 @@ verify_fun_always_run_client(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(Server), %% If user verify fun is called correctly we fail the connection. - %% otherwise we can not tell this case apart form where we miss + %% otherwise we cannot tell this case apart form where we miss %% to call users verify fun FunAndState = {fun(_,{extension, _}, UserState) -> {unknown, UserState}; @@ -552,7 +552,7 @@ verify_fun_always_run_server(Config) when is_list(Config) -> {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), %% If user verify fun is called correctly we fail the connection. - %% otherwise we can not tell this case apart form where we miss + %% otherwise we cannot tell this case apart form where we miss %% to call users verify fun FunAndState = {fun(_,{extension, _}, UserState) -> {unknown, UserState}; diff --git a/lib/ssl/test/ssl_engine_SUITE.erl b/lib/ssl/test/ssl_engine_SUITE.erl index 7277dad012..1423c99dc2 100644 --- a/lib/ssl/test/ssl_engine_SUITE.erl +++ b/lib/ssl/test/ssl_engine_SUITE.erl @@ -117,8 +117,23 @@ private_key(Config) when is_list(Config) -> EngineServerConf = [{key, #{algorithm => rsa, engine => Engine, key_id => ServerKey}} | proplists:delete(key, ServerConf)], + + EngineFileClientConf = [{key, #{algorithm => rsa, + engine => Engine, + key_id => ClientKey}} | + proplists:delete(keyfile, FileClientConf)], + + EngineFileServerConf = [{key, #{algorithm => rsa, + engine => Engine, + key_id => ServerKey}} | + proplists:delete(keyfile, FileServerConf)], + %% Test with engine test_tls_connection(EngineServerConf, EngineClientConf, Config), + + %% Test with engine and present file arugments + test_tls_connection(EngineFileServerConf, EngineFileClientConf, Config), + %% Test that sofware fallback is available test_tls_connection(ServerConf, [{reuse_sessions, false} |ClientConf], Config). diff --git a/lib/ssl/test/ssl_eqc_SUITE.erl b/lib/ssl/test/ssl_eqc_SUITE.erl new file mode 100644 index 0000000000..bd36d35c02 --- /dev/null +++ b/lib/ssl/test/ssl_eqc_SUITE.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. 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(ssl_eqc_SUITE). + +-compile(export_all). +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +all() -> + [ + tls_handshake_encoding + ]. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). +end_per_suite(Config) -> + Config. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_,Config) -> + Config. + +init_per_testcase(_, Config0) -> + Config0. + +end_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +tls_handshake_encoding(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(ssl_eqc_handshake:prop_tls_hs_encode_decode()). + true = ct_property_test:quickcheck(ssl_eqc_handshake:prop_tls_hs_encode_decode(), + Config). diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 2c7c62407e..9ae04184e2 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -149,7 +149,7 @@ decode_single_hello_sni_extension_correctly(_Config) -> Exts = Decoded. decode_empty_server_sni_correctly(_Config) -> - Exts = #hello_extensions{sni = ""}, + Exts = #hello_extensions{sni = #sni{hostname = ""}}, SNI = <<?UINT16(?SNI_EXT),?UINT16(0)>>, Decoded = ssl_handshake:decode_hello_extensions(SNI), Exts = Decoded. diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl index 96b15d9b51..3b79780974 100644 --- a/lib/ssl/test/ssl_pem_cache_SUITE.erl +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -34,7 +34,7 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- all() -> - [pem_cleanup]. + [pem_cleanup, invalid_insert]. groups() -> []. @@ -68,6 +68,10 @@ init_per_testcase(pem_cleanup = Case, Config) -> application:set_env(ssl, ssl_pem_cache_clean, ?CLEANUP_INTERVAL), ssl:start(), ct:timetrap({minutes, 1}), + Config; +init_per_testcase(_, Config) -> + ssl:start(), + ct:timetrap({seconds, 5}), Config. end_per_testcase(_TestCase, Config) -> @@ -108,7 +112,34 @@ pem_cleanup(Config)when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client), false = Size == Size1. - + +invalid_insert() -> + [{doc, "Test that insert of invalid pem does not cause empty cache entry"}]. +invalid_insert(Config)when is_list(Config) -> + process_flag(trap_exit, true), + + ClientOpts = proplists:get_value(client_verification_opts, Config), + ServerOpts = proplists:get_value(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + BadClientOpts = [{cacertfile, "tmp/does_not_exist.pem"} | proplists:delete(cacertfile, ClientOpts)], + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + ssl_test_lib:start_client_error([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {from, self()}, {options, BadClientOpts}]), + ssl_test_lib:close(Server), + 1 = ssl_pkix_db:db_size(get_fileref_db()). + + + +%%-------------------------------------------------------------------- +%% Internal funcations +%%-------------------------------------------------------------------- + get_pem_cache() -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, @@ -120,6 +151,16 @@ get_pem_cache() -> undefined end. +get_fileref_db() -> + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = ssl_test_lib:state(Prop), + case element(6, State) of + [_CertDb, {FileRefDb,_} | _] -> + FileRefDb; + _ -> + undefined + end. later()-> DateTime = calendar:now_to_local_time(os:timestamp()), Gregorian = calendar:datetime_to_gregorian_seconds(DateTime), diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index 9862b3ce64..3b6e936a97 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -487,8 +487,8 @@ test_copts(_, 0, ClientOpts) -> ClientOpts; test_copts(max_table_size, N, ClientOpts) -> Version = tls_record:highest_protocol_version([]), - CipherSuites = %%lists:map(fun(X) -> ssl_cipher:suite_definition(X) end, ssl_cipher:filter_suites(ssl_cipher:suites(Version))), -[ Y|| Y = {Alg,_, _, _} <- lists:map(fun(X) -> ssl_cipher:suite_definition(X) end, ssl_cipher:filter_suites(ssl_cipher:suites(Version))), Alg =/= ecdhe_ecdsa, Alg =/= ecdh_ecdsa, Alg =/= ecdh_rsa, Alg =/= ecdhe_rsa, Alg =/= dhe_dss, Alg =/= dss], + CipherSuites = %%lists:map(fun(X) -> ssl_cipher_format:suite_definition(X) end, ssl_cipher:filter_suites(ssl_cipher:suites(Version))), +[ Y|| Y = {Alg,_, _, _} <- lists:map(fun(X) -> ssl_cipher_format:suite_definition(X) end, ssl_cipher:filter_suites(ssl_cipher:suites(Version))), Alg =/= ecdhe_ecdsa, Alg =/= ecdh_ecdsa, Alg =/= ecdh_rsa, Alg =/= ecdhe_rsa, Alg =/= dhe_dss, Alg =/= dss], case length(CipherSuites) of M when M >= N -> Cipher = lists:nth(N, CipherSuites), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 91a9c774a6..a391b52c1a 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1221,13 +1221,13 @@ common_ciphers(crypto) -> common_ciphers(openssl) -> OpenSslSuites = string:tokens(string:strip(os:cmd("openssl ciphers"), right, $\n), ":"), - [ssl_cipher:suite_definition(S) + [ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:suites(tls_record:highest_protocol_version([])), - lists:member(ssl_cipher:openssl_suite_name(S), OpenSslSuites) + lists:member(ssl_cipher_format:openssl_suite_name(S), OpenSslSuites) ]. available_suites(Version) -> - [ssl_cipher:suite_definition(Suite) || + [ssl_cipher_format:suite_definition(Suite) || Suite <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]. @@ -1300,7 +1300,7 @@ string_regex_filter(_Str, _Search) -> false. ecdh_dh_anonymous_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)], + ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)], [{key_exchange, fun(dh_anon) -> true; @@ -1310,7 +1310,7 @@ ecdh_dh_anonymous_suites(Version) -> false end}]). psk_suites({3,_} = Version) -> - ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:psk_suites(Version)], []); + ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:psk_suites(Version)], []); psk_suites(Version) -> ssl:filter_cipher_suites(psk_suites(dtls_v1:corresponding_tls_version(Version)), [{cipher, @@ -1321,11 +1321,13 @@ psk_suites(Version) -> end}]). psk_anon_suites({3,_} = Version) -> - ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:psk_suites_anon(Version)], + ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:psk_suites_anon(Version)], [{key_exchange, fun(psk) -> true; - (psk_dhe) -> + (dhe_psk) -> + true; + (ecdhe_psk) -> true; (_) -> false @@ -1342,7 +1344,7 @@ psk_anon_suites(Version) -> srp_suites() -> - ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites()], [{key_exchange, fun(srp_rsa) -> true; @@ -1350,10 +1352,10 @@ srp_suites() -> false end}]). srp_anon_suites() -> - ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites_anon()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites_anon()], []). srp_dss_suites() -> - ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites()], [{key_exchange, fun(srp_dss) -> true; @@ -1361,14 +1363,14 @@ srp_dss_suites() -> false end}]). chacha_suites(Version) -> - [ssl_cipher:suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. + [ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. rc4_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <-ssl_cipher:rc4_suites(Version)], []). + ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <-ssl_cipher:rc4_suites(Version)], []). des_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <-ssl_cipher:des_suites(Version)], []). + ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <-ssl_cipher:des_suites(Version)], []). tuple_to_map({Kex, Cipher, Mac}) -> #{key_exchange => Kex, @@ -1524,11 +1526,6 @@ v_1_2_check(ecdh_ecdsa, ecdh_rsa) -> true; v_1_2_check(ecdh_rsa, ecdh_ecdsa) -> true; -v_1_2_check(ecdhe_ecdsa, ecdhe_rsa) -> - true; -v_1_2_check(ecdhe_rsa, ecdhe_ecdsa) -> - true; - v_1_2_check(_, _) -> false. @@ -1767,10 +1764,10 @@ version_flag('dtlsv1') -> "-dtls1". filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_list(Cipher)-> - filter_suites([ssl_cipher:openssl_suite(S) || S <- Ciphers], + filter_suites([ssl_cipher_format:openssl_suite(S) || S <- Ciphers], AtomVersion); filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_binary(Cipher)-> - filter_suites([ssl_cipher:suite_definition(S) || S <- Ciphers], + filter_suites([ssl_cipher_format:suite_definition(S) || S <- Ciphers], AtomVersion); filter_suites(Ciphers0, AtomVersion) -> Version = tls_version(AtomVersion), @@ -1782,7 +1779,7 @@ filter_suites(Ciphers0, AtomVersion) -> ++ ssl_cipher:srp_suites_anon() ++ ssl_cipher:rc4_suites(Version), Supported1 = ssl_cipher:filter_suites(Supported0), - Supported2 = [ssl_cipher:suite_definition(S) || S <- Supported1], + Supported2 = [ssl_cipher_format:suite_definition(S) || S <- Supported1], [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. -define(OPENSSL_QUIT, "Q\n"). diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index ce19f70df0..36254c2d00 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -84,11 +84,6 @@ reject such filenames. </p></warning> </description> - <datatypes> - <datatype> - <name name="basedir_type"/> - </datatype> - </datatypes> <funcs> <func> @@ -149,18 +144,37 @@ </func> <func> - <name name="basedir" arity="2"/> - <fsummary>Equivalent to <c>basedir(<anno>Type</anno>,<anno>Application</anno>,#{})</c>.</fsummary> + <name name="basedir" arity="2" clause_i="1"/> + <name name="basedir" arity="2" clause_i="2"/> + <fsummary>Equivalent to <c>basedir(<anno>PathType</anno>, + <anno>Application</anno>,#{})</c> or + <c>basedir(<anno>PathsType</anno>, <anno>Application</anno>,#{})</c>. + </fsummary> + <type variable="PathType" name_i="1"/> + <type name="basedir_path_type"/> + <type variable="PathsType" name_i="2"/> + <type name="basedir_paths_type"/> + <type variable="Application"/> <desc> <p> - Equivalent to <seealso marker="#basedir-3"> - basedir(<anno>Type</anno>, <anno>Application</anno>, #{})</seealso>. + Equivalent to <seealso marker="#basedir_3_1"> + basedir(<anno>PathType</anno>, <anno>Application</anno>, #{})</seealso> + or <seealso marker="#basedir_3_2"> +basedir(<anno>PathsType</anno>, <anno>Application</anno>, #{})</seealso>. </p> </desc> </func> <func> - <name name="basedir" arity="3"/> + <name name="basedir" arity="3" clause_i="1" anchor="basedir_3_1"/> + <name name="basedir" arity="3" clause_i="2" anchor="basedir_3_2"/> <fsummary></fsummary> + <type variable="PathType" name_i="1"/> + <type name="basedir_path_type"/> + <type variable="PathsType" name_i="2"/> + <type name="basedir_paths_type"/> + <type variable="Application"/> + <type variable="Opts"/> + <type name="basedir_opts"/> <desc><marker id="basedir-3"/> <p> Returns a suitable path, or paths, for a given type. If diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index a808d3af55..eb0f7d24f0 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -722,7 +722,7 @@ handle_event(_, _, State, Data) -> right before entering the initial state even though this formally is not a state change. In this case <c>OldState</c> will be the same as <c>State</c>, - which can not happen for a subsequent state change, + which cannot happen for a subsequent state change, but will happen when repeating the state enter call. </p> </desc> @@ -1256,7 +1256,7 @@ handle_event(_, _, State, Data) -> <desc> <p> <c><anno>State</anno></c> is the current state - and it can not be changed since the state callback + and it cannot be changed since the state callback was called with a <seealso marker="#type-state_enter"><em>state enter call</em></seealso>. </p> @@ -1922,7 +1922,7 @@ handle_event(_, _, State, Data) -> <p> If the function returns a failure <c>Reason</c>, the ongoing upgrade fails and rolls back to the old release. - Note that <c>Reason</c> can not be an <c>{ok,_,_}</c> tuple + Note that <c>Reason</c> cannot be an <c>{ok,_,_}</c> tuple since that will be regarded as a <c>{ok,NewState,NewData}</c> tuple, and that a tuple matching <c>{ok,_}</c> @@ -2208,7 +2208,7 @@ init(Args) -> erlang:error(not_implemented, [Args]).</pre> <seealso marker="erts:erlang#throw/1"><c>throw</c></seealso> to return the result, which can be useful. For example to bail out with <c>throw(keep_state_and_data)</c> - from deep within complex code that can not + from deep within complex code that cannot return <c>{next_state,State,Data}</c> because <c>State</c> or <c>Data</c> is no longer in scope. </p> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index a225dea3b5..4c5199ca2b 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -35,9 +35,10 @@ <datatypes> <datatype> - <name name="iterator"/> + <name name="iterator" n_vars="2"/> <desc> - <p>An iterator representing the key value associations in a map.</p> + <p>An iterator representing the associations in a map with keys of type + <c><anno>Key</anno></c> and values of type <c><anno>Value</anno></c>.</p> <p>Created using <seealso marker="#iterator-1"><c>maps:iterator/1</c></seealso>.</p> <p>Consumed by <seealso marker="#next-1"><c>maps:next/1</c></seealso>, <seealso marker="#filter-2"><c>maps:filter/2</c></seealso>, @@ -45,6 +46,10 @@ <seealso marker="#map-2"><c>maps:map/2</c></seealso>.</p> </desc> </datatype> + + <datatype> + <name name="iterator" n_vars="0"/> + </datatype> </datatypes> <funcs> @@ -90,13 +95,13 @@ <name name="fold" arity="3"/> <fsummary></fsummary> <desc> - <p>Calls <c>F(K, V, AccIn)</c> for every <c><anno>K</anno></c> to value - <c><anno>V</anno></c> association in <c><anno>MapOrIter</anno></c> in - any order. Function <c>fun F/3</c> must return a new - accumulator, which is passed to the next successive call. - This function returns the final value of the accumulator. The initial - accumulator value <c><anno>Init</anno></c> is returned if the map is - empty.</p> + <p>Calls <c>F(Key, Value, AccIn)</c> for every <c><anno>Key</anno></c> + to value <c><anno>Value</anno></c> association in + <c><anno>MapOrIter</anno></c> in any order. Function <c>fun F/3</c> + must return a new accumulator, which is passed to the next successive + call. This function returns the final value of the accumulator. + The initial accumulator value <c><anno>Init</anno></c> is returned + if the map is empty.</p> <p>The call fails with a <c>{badmap,Map}</c> exception if <c><anno>MapOrIter</anno></c> is not a map or valid iterator, or with <c>badarg</c> if <c><anno>Fun</anno></c> is not a @@ -234,11 +239,12 @@ none</code> <fsummary></fsummary> <desc> <p>Produces a new map <c><anno>Map</anno></c> by calling function - <c>fun F(K, V1)</c> for every <c><anno>K</anno></c> to value - <c><anno>V1</anno></c> association in <c><anno>MapOrIter</anno></c> in - any order. Function <c>fun F/2</c> must return value - <c><anno>V2</anno></c> to be associated with key <c><anno>K</anno></c> - for the new map <c><anno>Map</anno></c>.</p> + <c>fun F(Key, Value1)</c> for every <c><anno>Key</anno></c> to value + <c><anno>Value1</anno></c> association in + <c><anno>MapOrIter</anno></c> in any order. Function <c>fun Fun/2</c> + must return value <c><anno>Value2</anno></c> to be associated with + key <c><anno>Key</anno></c> for the new map + <c><anno>Map</anno></c>.</p> <p>The call fails with a <c>{badmap,Map}</c> exception if <c><anno>MapOrIter</anno></c> is not a map or valid iterator, or with <c>badarg</c> if <c><anno>Fun</anno></c> is not a diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 712a474b0b..8b6de03f5f 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -3659,7 +3659,7 @@ you use erlang:halt/2 with an integer first argument and an option list containing {flush,false} as the second argument. Note that now is flushing not dependant of the - exit code, and you can not only flush async threads + exit code, and you cannot only flush async threads operations which we deemed as a strange behaviour anyway. </p> <p>Also, erlang:halt/1,2 has gotten a new feature: If the @@ -4173,9 +4173,9 @@ Supervisors should not save child-specs for temporary processes when they terminate as they should not be restarted. Saving the temporary child spec will result in - that you can not start a new temporary process with the + that you cannot start a new temporary process with the same child spec as an already terminated temporary - process. Since R14B02 you can not restart a temporary + process. Since R14B02 you cannot restart a temporary temporary process as arguments are no longer saved, it has however always been semantically incorrect to restart a temporary process. Thanks to Filipe David Manana for diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 6d5065ca02..0e8075a578 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -208,8 +208,16 @@ child_spec() = #{id => child_id(), % mandatory the child process is unconditionally terminated using <c>exit(Child,kill)</c>.</p> <p>If the child process is another supervisor, the shutdown time - is to be set to <c>infinity</c> to give the subtree ample - time to shut down. It is also allowed to set it to <c>infinity</c>, + must be set to <c>infinity</c> to give the subtree ample + time to shut down.</p> + <warning> + <p>Setting the shutdown time to anything other + than <c>infinity</c> for a child of type <c>supervisor</c> + can cause a race condition where the child in question + unlinks its own children, but fails to terminate them + before it is killed.</p> + </warning> + <p>It is also allowed to set it to <c>infinity</c>, if the child process is a worker.</p> <warning> <p>Be careful when setting the shutdown time to diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl index 2ec89e7d8a..28d25c6589 100644 --- a/lib/stdlib/include/assert.hrl +++ b/lib/stdlib/include/assert.hrl @@ -140,7 +140,7 @@ -endif. %% This is mostly a convenience which gives more detailed reports. -%% Note: Guard is a guarded pattern, and can not be used for value. +%% Note: Guard is a guarded pattern, and cannot be used for value. -ifdef(NOASSERT). -define(assertMatch(Guard, Expr), ok). -define(assertMatch(Guard, Expr, Comment), ok). @@ -289,7 +289,7 @@ end). -endif. -%% Note: Class and Term are patterns, and can not be used for value. +%% Note: Class and Term are patterns, and cannot be used for value. %% Term can be a guarded pattern, but Class cannot. -ifdef(NOASSERT). -define(assertException(Class, Term, Expr), ok). @@ -364,7 +364,7 @@ ?assertException(throw, Term, Expr, Comment)). %% This is the inverse case of assertException, for convenience. -%% Note: Class and Term are patterns, and can not be used for value. +%% Note: Class and Term are patterns, and cannot be used for value. %% Both Class and Term can be guarded patterns. -ifdef(NOASSERT). -define(assertNotException(Class, Term, Expr), ok). diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index e016d5a80e..0488c2bef2 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -616,12 +616,18 @@ next(Tab, Key) -> %% Assuming that a file already exists, open it with the %% parameters as already specified in the file itself. %% Return a ref leading to the file. -open_file(File) -> - case dets_server:open_file(to_list(File)) of - badarg -> % Should not happen. - erlang:error(dets_process_died, [File]); - Reply -> - einval(Reply, [File]) +open_file(File0) -> + File = to_list(File0), + case is_list(File) of + true -> + case dets_server:open_file(File) of + badarg -> % Should not happen. + erlang:error(dets_process_died, [File]); + Reply -> + einval(Reply, [File]) + end; + false -> + erlang:error(badarg, [File0]) end. -spec open_file(Name, Args) -> {'ok', Name} | {'error', Reason} when @@ -1088,6 +1094,7 @@ defaults(Tab, Args) -> debug = false}, Fun = fun repl/2, Defaults = lists:foldl(Fun, Defaults0, Args), + true = is_list(Defaults#open_args.file), is_comp_min_max(Defaults). to_list(T) when is_atom(T) -> atom_to_list(T); @@ -1112,9 +1119,7 @@ repl({delayed_write, {Delay,Size} = C}, Defs) Defs#open_args{delayed_write = C}; repl({estimated_no_objects, I}, Defs) -> repl({min_no_slots, I}, Defs); -repl({file, File}, Defs) when is_list(File) -> - Defs#open_args{file = File}; -repl({file, File}, Defs) when is_atom(File) -> +repl({file, File}, Defs) -> Defs#open_args{file = to_list(File)}; repl({keypos, P}, Defs) when is_integer(P), P > 0 -> Defs#open_args{keypos =P}; diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index b311a843c2..939abaff00 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -74,6 +74,7 @@ guard_bif(element, 2) -> true; guard_bif(float, 1) -> true; guard_bif(floor, 1) -> true; guard_bif(hd, 1) -> true; +guard_bif(is_map_key, 2) -> true; guard_bif(length, 1) -> true; guard_bif(map_size, 1) -> true; guard_bif(map_get, 2) -> true; @@ -109,7 +110,6 @@ new_type_test(is_function, 2) -> true; new_type_test(is_integer, 1) -> true; new_type_test(is_list, 1) -> true; new_type_test(is_map, 1) -> true; -new_type_test(is_map_key, 2) -> true; new_type_test(is_number, 1) -> true; new_type_test(is_pid, 1) -> true; new_type_test(is_port, 1) -> true; diff --git a/lib/stdlib/src/erl_posix_msg.erl b/lib/stdlib/src/erl_posix_msg.erl index 8959fea498..b9ed4a3a9d 100644 --- a/lib/stdlib/src/erl_posix_msg.erl +++ b/lib/stdlib/src/erl_posix_msg.erl @@ -81,9 +81,9 @@ message_1(el2hlt) -> <<"level 2 halted">>; message_1(el2nsync) -> <<"level 2 not synchronized">>; message_1(el3hlt) -> <<"level 3 halted">>; message_1(el3rst) -> <<"level 3 reset">>; -message_1(elibacc) -> <<"can not access a needed shared library">>; +message_1(elibacc) -> <<"cannot access a needed shared library">>; message_1(elibbad) -> <<"accessing a corrupted shared library">>; -message_1(elibexec) -> <<"can not exec a shared library directly">>; +message_1(elibexec) -> <<"cannot exec a shared library directly">>; message_1(elibmax) -> <<"attempting to link in more shared libraries than system limit">>; message_1(elibscn) -> <<".lib section in a.out corrupted">>; diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index a322bd002d..b7b7b562ab 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. @@ -1012,24 +1012,33 @@ filename_string_to_binary(List) -> %% basedir %% http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html --type basedir_type() :: 'user_cache' | 'user_config' | 'user_data' - | 'user_log' - | 'site_config' | 'site_data'. +-type basedir_path_type() :: 'user_cache' | 'user_config' | 'user_data' + | 'user_log'. +-type basedir_paths_type() :: 'site_config' | 'site_data'. --spec basedir(Type,Application) -> file:filename_all() when - Type :: basedir_type(), +-type basedir_opts() :: #{author => string() | binary(), + os => 'windows' | 'darwin' | 'linux', + version => string() | binary()}. + +-spec basedir(PathType,Application) -> file:filename_all() when + PathType :: basedir_path_type(), + Application :: string() | binary(); + (PathsType,Application) -> [file:filename_all()] when + PathsType :: basedir_paths_type(), Application :: string() | binary(). basedir(Type,Application) when is_atom(Type), is_list(Application) orelse is_binary(Application) -> basedir(Type, Application, #{}). --spec basedir(Type,Application,Opts) -> file:filename_all() when - Type :: basedir_type(), +-spec basedir(PathType,Application,Opts) -> file:filename_all() when + PathType :: basedir_path_type(), + Application :: string() | binary(), + Opts :: basedir_opts(); + (PathsType,Application,Opts) -> [file:filename_all()] when + PathsType :: basedir_paths_type(), Application :: string() | binary(), - Opts :: #{author => string() | binary(), - os => 'windows' | 'darwin' | 'linux', - version => string() | binary()}. + Opts :: basedir_opts(). basedir(Type,Application,Opts) when is_atom(Type), is_map(Opts), is_list(Application) orelse diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 3a5aba60b4..8223a52873 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -178,11 +178,11 @@ fread(Cont, Chars, Format) -> Data :: [term()]. format(Format, Args) -> - case catch io_lib_format:fwrite(Format, Args) of - {'EXIT',_} -> - erlang:error(badarg, [Format, Args]); - Other -> - Other + try io_lib_format:fwrite(Format, Args) + catch + C:R:S -> + test_modules_loaded(C, R, S), + erlang:error(badarg, [Format, Args]) end. -spec format(Format, Data, Options) -> chars() when @@ -193,11 +193,11 @@ format(Format, Args) -> CharsLimit :: chars_limit(). format(Format, Args, Options) -> - case catch io_lib_format:fwrite(Format, Args, Options) of - {'EXIT',_} -> - erlang:error(badarg, [Format, Args, Options]); - Other -> - Other + try io_lib_format:fwrite(Format, Args, Options) + catch + C:R:S -> + test_modules_loaded(C, R, S), + erlang:error(badarg, [Format, Args]) end. -spec scan_format(Format, Data) -> FormatList when @@ -208,7 +208,9 @@ format(Format, Args, Options) -> scan_format(Format, Args) -> try io_lib_format:scan(Format, Args) catch - _:_ -> erlang:error(badarg, [Format, Args]) + C:R:S -> + test_modules_loaded(C, R, S), + erlang:error(badarg, [Format, Args]) end. -spec unscan_format(FormatList) -> {Format, Data} when @@ -223,7 +225,12 @@ unscan_format(FormatList) -> FormatList :: [char() | format_spec()]. build_text(FormatList) -> - io_lib_format:build(FormatList). + try io_lib_format:build(FormatList) + catch + C:R:S -> + test_modules_loaded(C, R, S), + erlang:error(badarg, [FormatList]) + end. -spec build_text(FormatList, Options) -> chars() when FormatList :: [char() | format_spec()], @@ -232,7 +239,23 @@ build_text(FormatList) -> CharsLimit :: chars_limit(). build_text(FormatList, Options) -> - io_lib_format:build(FormatList, Options). + try io_lib_format:build(FormatList, Options) + catch + C:R:S -> + test_modules_loaded(C, R, S), + erlang:error(badarg, [FormatList, Options]) + end. + +%% Failure to load a module must not be labeled as badarg. +%% C, R, and S are included so that the original error, which could be +%% a bug in io_lib_format, can be found by tracing on +%% test_modules_loaded/3. +test_modules_loaded(_C, _R, _S) -> + Modules = [io_lib_format, io_lib_pretty, string, unicode], + case code:ensure_modules_loaded(Modules) of + ok -> ok; + Error -> erlang:error(Error) + end. -spec print(Term) -> chars() when Term :: term(). diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index c814ab50d4..e247b00a04 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -38,18 +38,16 @@ %% and it also splits the handling of the control characters into two %% parts. --spec fwrite(Format, Data) -> FormatList when +-spec fwrite(Format, Data) -> io_lib:chars() when Format :: io:format(), - Data :: [term()], - FormatList :: [char() | io_lib:format_spec()]. + Data :: [term()]. fwrite(Format, Args) -> build(scan(Format, Args)). --spec fwrite(Format, Data, Options) -> FormatList when +-spec fwrite(Format, Data, Options) -> io_lib:chars() when Format :: io:format(), Data :: [term()], - FormatList :: [char() | io_lib:format_spec()], Options :: [Option], Option :: {'chars_limit', CharsLimit}, CharsLimit :: io_lib:chars_limit(). diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index 60463feec2..51965ddb57 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -21,7 +21,7 @@ -module(maps). -export([get/3, filter/2,fold/3, - map/2, size/1, + map/2, size/1, new/0, update_with/3, update_with/4, without/2, with/2, iterator/1, next/1]). @@ -29,13 +29,15 @@ %% BIFs -export([get/2, find/2, from_list/1, is_key/2, keys/1, merge/2, - new/0, put/3, remove/2, take/2, + put/3, remove/2, take/2, to_list/1, update/3, values/1]). --opaque iterator() :: {term(), term(), iterator()} - | none | nonempty_improper_list(integer(),map()). +-opaque iterator(Key, Value) :: {Key, Value, iterator(Key, Value)} | none + | nonempty_improper_list(integer(), #{Key => Value}). --export_type([iterator/0]). +-type iterator() :: iterator(term(), term()). + +-export_type([iterator/2, iterator/0]). -dialyzer({no_improper_lists, iterator/1}). @@ -50,9 +52,7 @@ get(_,_) -> erlang:nif_error(undef). -spec find(Key,Map) -> {ok, Value} | error when - Key :: term(), - Map :: map(), - Value :: term(). + Map :: #{Key => Value, _ => _}. find(_,_) -> erlang:nif_error(undef). @@ -75,9 +75,8 @@ is_key(_,_) -> erlang:nif_error(undef). -spec keys(Map) -> Keys when - Map :: map(), - Keys :: [Key], - Key :: term(). + Map :: #{Key => _}, + Keys :: [Key]. keys(_) -> erlang:nif_error(undef). @@ -91,13 +90,6 @@ keys(_) -> erlang:nif_error(undef). merge(_,_) -> erlang:nif_error(undef). - --spec new() -> Map when - Map :: map(). - -new() -> erlang:nif_error(undef). - - %% Shadowed by erl_bif_types: maps:put/3 -spec put(Key,Value,Map1) -> Map2 when Key :: term(), @@ -116,17 +108,13 @@ put(_,_,_) -> erlang:nif_error(undef). remove(_,_) -> erlang:nif_error(undef). -spec take(Key,Map1) -> {Value,Map2} | error when - Key :: term(), - Map1 :: map(), - Value :: term(), - Map2 :: map(). + Map1 :: #{Key => Value, _ => _}, + Map2 :: #{_ => _}. take(_,_) -> erlang:nif_error(undef). -spec to_list(Map) -> [{Key,Value}] when - Map :: map(), - Key :: term(), - Value :: term(). + Map :: #{Key => Value}. to_list(Map) when is_map(Map) -> to_list_internal(erts_internal:map_next(0, Map, [])); @@ -140,79 +128,69 @@ to_list_internal(Acc) -> %% Shadowed by erl_bif_types: maps:update/3 -spec update(Key,Value,Map1) -> Map2 when - Key :: term(), - Value :: term(), - Map1 :: map(), - Map2 :: map(). + Map1 :: #{Key := _, _ => _}, + Map2 :: #{Key := Value, _ => _}. update(_,_,_) -> erlang:nif_error(undef). -spec values(Map) -> Values when - Map :: map(), - Values :: [Value], - Value :: term(). + Map :: #{_ => Value}, + Values :: [Value]. values(_) -> erlang:nif_error(undef). %% End of BIFs +-spec new() -> Map when + Map :: #{}. + +new() -> #{}. + -spec update_with(Key,Fun,Map1) -> Map2 when - Key :: term(), - Map1 :: map(), - Map2 :: map(), - Fun :: fun((Value1 :: term()) -> Value2 :: term()). + Map1 :: #{Key := Value1, _ => _}, + Map2 :: #{Key := Value2, _ => _}, + Fun :: fun((Value1) -> Value2). update_with(Key,Fun,Map) when is_function(Fun,1), is_map(Map) -> - try maps:get(Key,Map) of - Val -> maps:update(Key,Fun(Val),Map) - catch - error:{badkey,_} -> - erlang:error({badkey,Key},[Key,Fun,Map]) + case Map of + #{Key := Value} -> Map#{Key := Fun(Value)}; + #{} -> erlang:error({badkey,Key},[Key,Fun,Map]) end; update_with(Key,Fun,Map) -> erlang:error(error_type(Map),[Key,Fun,Map]). -spec update_with(Key,Fun,Init,Map1) -> Map2 when - Key :: term(), - Map1 :: Map1, - Map2 :: Map2, - Fun :: fun((Value1 :: term()) -> Value2 :: term()), - Init :: term(). + Map1 :: #{Key => Value1, _ => _}, + Map2 :: #{Key := Value2 | Init, _ => _}, + Fun :: fun((Value1) -> Value2). update_with(Key,Fun,Init,Map) when is_function(Fun,1), is_map(Map) -> - case maps:find(Key,Map) of - {ok,Val} -> maps:update(Key,Fun(Val),Map); - error -> maps:put(Key,Init,Map) + case Map of + #{Key := Value} -> Map#{Key := Fun(Value)}; + #{} -> Map#{Key => Init} end; update_with(Key,Fun,Init,Map) -> erlang:error(error_type(Map),[Key,Fun,Init,Map]). -spec get(Key, Map, Default) -> Value | Default when - Key :: term(), - Map :: map(), - Value :: term(), - Default :: term(). + Map :: #{Key => Value, _ => _}. get(Key,Map,Default) when is_map(Map) -> - case maps:find(Key, Map) of - {ok, Value} -> - Value; - error -> - Default + case Map of + #{Key := Value} -> Value; + #{} -> Default end; get(Key,Map,Default) -> erlang:error({badmap,Map},[Key,Map,Default]). --spec filter(Pred,MapOrIter) -> Map when +-spec filter(Pred, MapOrIter) -> Map when Pred :: fun((Key, Value) -> boolean()), - Key :: term(), - Value :: term(), - MapOrIter :: map() | iterator(), - Map :: map(). + MapOrIter :: #{Key => Value} | iterator(Key, Value), + Map :: #{Key => Value}. filter(Pred,Map) when is_function(Pred,2), is_map(Map) -> maps:from_list(filter_1(Pred, iterator(Map))); @@ -235,14 +213,11 @@ filter_1(Pred, Iter) -> end. -spec fold(Fun,Init,MapOrIter) -> Acc when - Fun :: fun((K, V, AccIn) -> AccOut), + Fun :: fun((Key, Value, AccIn) -> AccOut), Init :: term(), - Acc :: term(), - AccIn :: term(), - AccOut :: term(), - MapOrIter :: map() | iterator(), - K :: term(), - V :: term(). + Acc :: AccOut, + AccIn :: Init | AccOut, + MapOrIter :: #{Key => Value} | iterator(Key, Value). fold(Fun,Init,Map) when is_function(Fun,3), is_map(Map) -> fold_1(Fun,Init,iterator(Map)); @@ -260,12 +235,9 @@ fold_1(Fun, Acc, Iter) -> end. -spec map(Fun,MapOrIter) -> Map when - Fun :: fun((K, V1) -> V2), - MapOrIter :: map() | iterator(), - Map :: map(), - K :: term(), - V1 :: term(), - V2 :: term(). + Fun :: fun((Key, Value1) -> Value2), + MapOrIter :: #{Key => Value1} | iterator(Key, Value1), + Map :: #{Key => Value2}. map(Fun,Map) when is_function(Fun, 2), is_map(Map) -> maps:from_list(map_1(Fun, iterator(Map))); @@ -291,17 +263,15 @@ size(Val) -> erlang:error({badmap,Val},[Val]). -spec iterator(Map) -> Iterator when - Map :: map(), - Iterator :: iterator(). + Map :: #{Key => Value}, + Iterator :: iterator(Key, Value). iterator(M) when is_map(M) -> [0 | M]; iterator(M) -> erlang:error({badmap, M}, [M]). -spec next(Iterator) -> {Key, Value, NextIterator} | 'none' when - Iterator :: iterator(), - Key :: term(), - Value :: term(), - NextIterator :: iterator(). + Iterator :: iterator(Key, Value), + NextIterator :: iterator(Key, Value). next({K, V, I}) -> {K, V, I}; next([Path | Map]) when is_integer(Path), is_map(Map) -> @@ -318,29 +288,26 @@ next(Iter) -> K :: term(). without(Ks,M) when is_list(Ks), is_map(M) -> - lists:foldl(fun(K, M1) -> maps:remove(K, M1) end, M, Ks); + lists:foldl(fun maps:remove/2, M, Ks); without(Ks,M) -> erlang:error(error_type(M),[Ks,M]). -spec with(Ks, Map1) -> Map2 when Ks :: [K], - Map1 :: map(), - Map2 :: map(), - K :: term(). + Map1 :: #{K => V, _ => _}, + Map2 :: #{K => V}. with(Ks,Map1) when is_list(Ks), is_map(Map1) -> - Fun = fun(K, List) -> - case maps:find(K, Map1) of - {ok, V} -> - [{K, V} | List]; - error -> - List - end - end, - maps:from_list(lists:foldl(Fun, [], Ks)); + maps:from_list(with_1(Ks, Map1)); with(Ks,M) -> erlang:error(error_type(M),[Ks,M]). +with_1([K|Ks], Map) -> + case Map of + #{K := V} -> [{K,V}|with_1(Ks, Map)]; + #{} -> with_1(Ks, Map) + end; +with_1([], _Map) -> []. error_type(M) when is_map(M) -> badarg; error_type(V) -> {badmap, V}. diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index d117481d2e..3845e35e9b 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -224,10 +224,12 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) -> %% Called when translating during compiling %% --spec parse_transform(Forms, Options) -> Forms2 when +-spec parse_transform(Forms, Options) -> Forms2 | Errors | Warnings when Forms :: [erl_parse:abstract_form() | erl_parse:form_info()], Forms2 :: [erl_parse:abstract_form() | erl_parse:form_info()], - Options :: term(). + Options :: term(), + Errors :: {error, ErrInfo :: [tuple()], WarnInfo :: []}, + Warnings :: {warning, Forms2, WarnInfo :: [tuple()]}. parse_transform(Forms, _Options) -> SaveFilename = setup_filename(), diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 362e98006e..4951dc727b 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -486,7 +486,7 @@ uniform_real_s(Alg, Next, M0, BitNo, R1, V1, Bits) -> {M1 * math:pow(2.0, BitNo - 56), {Alg, R1}}; BitNo =:= -1008 -> %% Endgame - %% For the last round we can not have 14 zeros or more + %% For the last round we cannot have 14 zeros or more %% at the top of M1 because then we will underflow, %% so we need at least 43 bits if diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index fe324391af..65977a764a 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -3417,6 +3417,7 @@ otp_11709(Config) when is_list(Config) -> ok. %% OTP-13229. open_file() exits with badarg when given binary file name. +%% Also OTP-15253. otp_13229(_Config) -> F = <<"binfile.tab">>, try dets:open_file(name, [{file, F}]) of @@ -3425,6 +3426,20 @@ otp_13229(_Config) -> catch error:badarg -> ok + end, + try dets:open_file(F, []) of % OTP-15253 + R2 -> + exit({open_succeeded, R2}) + catch + error:badarg -> + ok + end, + try dets:open_file(F) of + R3 -> + exit({open_succeeded, R3}) + catch + error:badarg -> + ok end. %% OTP-13260. Race when opening a table. diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index a3e294ffea..10e1b75e0f 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -1372,7 +1372,7 @@ otp_8562(Config) when is_list(Config) -> otp_8911(Config) when is_list(Config) -> case test_server:is_cover() of true -> - {skip, "Testing cover, so can not run when cover is already running"}; + {skip, "Testing cover, so cannot run when cover is already running"}; false -> do_otp_8911(Config) end. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index f9ab83a120..c1613a7273 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2730,7 +2730,7 @@ bif_clash(Config) when is_list(Config) -> [], {errors,[{2,erl_lint,{call_to_redefined_old_bif,{size,1}}}],[]}}, - %% Verify that warnings can not be turned off in the old way. + %% Verify that warnings cannot be turned off in the old way. {clash2, <<"-export([t/1,size/1]). t(X) -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index fee8b204f4..29677ac67e 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -66,7 +66,7 @@ meta_lookup_named_read/1, meta_lookup_named_write/1, meta_newdel_unnamed/1, meta_newdel_named/1]). -export([smp_insert/1, smp_fixed_delete/1, smp_unfix_fix/1, smp_select_delete/1, - smp_select_replace/1, otp_8166/1, otp_8732/1]). + smp_select_replace/1, otp_8166/1, otp_8732/1, delete_unfix_race/1]). -export([exit_large_table_owner/1, exit_many_large_table_owner/1, exit_many_tables_owner/1, @@ -142,7 +142,8 @@ all() -> ets_all, massive_ets_all, take, - whereis_table]. + whereis_table, + delete_unfix_race]. groups() -> [{new, [], @@ -5489,6 +5490,46 @@ smp_fixed_delete_do() -> %%verify_table_load(T), ets:delete(T). +%% ERL-720 +%% Provoke race between ets:delete and table unfix (by select_count) +%% that caused ets_misc memory counter to indicate false leak. +delete_unfix_race(Config) when is_list(Config) -> + EtsMem = etsmem(), + Table = ets:new(t,[set,public,{write_concurrency,true}]), + InsertOp = + fun() -> + receive stop -> + false + after 0 -> + ets:insert(Table, {rand:uniform(10)}), + true + end + end, + DeleteOp = + fun() -> + receive stop -> + false + after 0 -> + ets:delete(Table, rand:uniform(10)), + true + end + end, + SelectOp = + fun() -> + ets:select_count(Table, ets:fun2ms(fun(X) -> true end)) + end, + Main = self(), + Ins = spawn(fun()-> repeat_while(InsertOp), Main ! self() end), + Del = spawn(fun()-> repeat_while(DeleteOp), Main ! self() end), + spawn(fun()-> + repeat(SelectOp, 10000), + Del ! stop, + Ins ! stop + end), + [receive Pid -> ok end || Pid <- [Ins,Del]], + ets:delete(Table), + verify_etsmem(EtsMem). + num_of_buckets(T) -> element(1,ets:info(T,stats)). diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 79cee54335..f097552e8c 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -31,7 +31,7 @@ otp_10836/1, io_lib_width_too_small/1, io_with_huge_message_queue/1, format_string/1, maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1, - otp_14285/1, limit_term/1, otp_14983/1, otp_15103/1, + otp_14285/1, limit_term/1, otp_14983/1, otp_15103/1, otp_15076/1, otp_15159/1]). -export([pretty/2, trf/3]). @@ -64,7 +64,7 @@ all() -> io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836, io_lib_width_too_small, io_with_huge_message_queue, format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175, - otp_14285, limit_term, otp_14983, otp_15103, otp_15159]. + otp_14285, limit_term, otp_14983, otp_15103, otp_15076, otp_15159]. %% Error cases for output. error_1(Config) when is_list(Config) -> @@ -2639,3 +2639,11 @@ otp_15159(_Config) -> "[atom]" = lists:flatten(io_lib:format("~p", [[atom]], [{chars_limit,5}])), ok. + +otp_15076(_Config) -> + {'EXIT', {badarg, _}} = (catch io_lib:format("~c", [a])), + L = io_lib:scan_format("~c", [a]), + {"~c", [a]} = io_lib:unscan_format(L), + {'EXIT', {badarg, _}} = (catch io_lib:build_text(L)), + {'EXIT', {badarg, _}} = (catch io_lib:build_text(L, [])), + ok. diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index 837ab4e97e..af94fc79bc 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -1679,7 +1679,7 @@ make_fun() -> receive {Pid, Fun} -> Fun end. make_fun(Pid) -> - Pid ! {self(), fun make_fun/1}. + Pid ! {self(), fun (X) -> {X, Pid} end}. fun_pid(Fun) -> erlang:fun_info(Fun, pid). diff --git a/lib/stdlib/test/re_SUITE_data/testoutput2 b/lib/stdlib/test/re_SUITE_data/testoutput2 index 811bbefc84..61ed8d9d4e 100644 --- a/lib/stdlib/test/re_SUITE_data/testoutput2 +++ b/lib/stdlib/test/re_SUITE_data/testoutput2 @@ -14705,4 +14705,20 @@ No options No first char No need char +"(?<=(a))\1?b" + ab + 0: b + 1: a + aaab + 0: ab + 1: a + +"(?=(a))\1?b" + ab + 0: ab + 1: a + aaab + 0: ab + 1: a + /-- End of testinput2 --/ diff --git a/lib/stdlib/test/re_SUITE_data/testoutput5 b/lib/stdlib/test/re_SUITE_data/testoutput5 index bab989ca7e..090e1e1c85 100644 --- a/lib/stdlib/test/re_SUITE_data/testoutput5 +++ b/lib/stdlib/test/re_SUITE_data/testoutput5 @@ -1942,4 +1942,12 @@ Need char = 'z' 0: \x{17f} 0+ +/\C[^\v]+\x80/8 + [Aá¿»BÅ€C] +No match + +/\C[^\d]+\x80/8 + [Aá¿»BÅ€C] +No match + /-- End of testinput5 --/ diff --git a/lib/stdlib/test/stdlib.spec b/lib/stdlib/test/stdlib.spec index 9c625091a8..4de7c1a0eb 100644 --- a/lib/stdlib/test/stdlib.spec +++ b/lib/stdlib/test/stdlib.spec @@ -1,4 +1,4 @@ {suites,"../stdlib_test",all}. {skip_groups,"../stdlib_test",stdlib_bench_SUITE, - [base64,gen_server,gen_statem,unicode], + [binary,base64,gen_server,gen_statem,unicode], "Benchmark only"}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE.erl b/lib/stdlib/test/stdlib_bench_SUITE.erl index 2364e8376f..b937eeb06a 100644 --- a/lib/stdlib/test/stdlib_bench_SUITE.erl +++ b/lib/stdlib/test/stdlib_bench_SUITE.erl @@ -29,7 +29,7 @@ suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. all() -> - [{group,unicode},{group,base64}, + [{group,unicode},{group,base64},{group,binary}, {group,gen_server},{group,gen_statem}, {group,gen_server_comparison},{group,gen_statem_comparison}]. @@ -38,6 +38,11 @@ groups() -> [norm_nfc_list, norm_nfc_deep_l, norm_nfc_binary, string_lexemes_list, string_lexemes_binary ]}, + {binary, [{repeat, 5}], + [match_single_pattern_no_match, + matches_single_pattern_no_match, + matches_single_pattern_eventual_match, + matches_single_pattern_frequent_match]}, {base64,[{repeat,5}], [decode_binary, decode_binary_to_string, decode_list, decode_list_to_string, @@ -157,41 +162,59 @@ norm_data(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +match_single_pattern_no_match(_Config) -> + Binary = binary:copy(<<"ugbcfuysabfuqyfikgfsdalpaskfhgjsdgfjwsalp">>, 1000000), + comment(test(binary, match, [Binary, <<"o">>])). + +matches_single_pattern_no_match(_Config) -> + Binary = binary:copy(<<"ugbcfuysabfuqyfikgfsdalpaskfhgjsdgfjwsalp">>, 1000000), + comment(test(binary, matches, [Binary, <<"o">>])). + +matches_single_pattern_eventual_match(_Config) -> + Binary = binary:copy(<<"ugbcfuysabfuqyfikgfsdalpaskfhgjsdgfjwsal\n">>, 1000000), + comment(test(binary, matches, [Binary, <<"\n">>])). + +matches_single_pattern_frequent_match(_Config) -> + Binary = binary:copy(<<"abc\n">>, 1000000), + comment(test(binary, matches, [Binary, <<"abc">>])). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + decode_binary(_Config) -> - comment(test(decode, encoded_binary())). + comment(test(base64, decode, [encoded_binary()])). decode_binary_to_string(_Config) -> - comment(test(decode_to_string, encoded_binary())). + comment(test(base64, decode_to_string, [encoded_binary()])). decode_list(_Config) -> - comment(test(decode, encoded_list())). + comment(test(base64, decode, [encoded_list()])). decode_list_to_string(_Config) -> - comment(test(decode_to_string, encoded_list())). + comment(test(base64, decode_to_string, [encoded_list()])). encode_binary(_Config) -> - comment(test(encode, binary())). + comment(test(base64, encode, [binary()])). encode_binary_to_string(_Config) -> - comment(test(encode_to_string, binary())). + comment(test(base64, encode_to_string, [binary()])). encode_list(_Config) -> - comment(test(encode, list())). + comment(test(base64, encode, [list()])). encode_list_to_string(_Config) -> - comment(test(encode_to_string, list())). + comment(test(base64, encode_to_string, [list()])). mime_binary_decode(_Config) -> - comment(test(mime_decode, encoded_binary())). + comment(test(base64, mime_decode, [encoded_binary()])). mime_binary_decode_to_string(_Config) -> - comment(test(mime_decode_to_string, encoded_binary())). + comment(test(base64, mime_decode_to_string, [encoded_binary()])). mime_list_decode(_Config) -> - comment(test(mime_decode, encoded_list())). + comment(test(base64, mime_decode, [encoded_list()])). mime_list_decode_to_string(_Config) -> - comment(test(mime_decode_to_string, encoded_list())). + comment(test(base64, mime_decode_to_string, [encoded_list()])). -define(SIZE, 10000). -define(N, 1000). @@ -209,15 +232,15 @@ binary() -> list() -> random_byte_list(?SIZE). -test(Func, Data) -> - F = fun() -> loop(?N, Func, Data) end, +test(Mod, Fun, Args) -> + F = fun() -> loop(?N, Mod, Fun, Args) end, {Time, ok} = timer:tc(fun() -> lspawn(F) end), - report_base64(Time). + report_mfa(Time, Mod). -loop(0, _F, _D) -> garbage_collect(), ok; -loop(N, F, D) -> - _ = base64:F(D), - loop(N - 1, F, D). +loop(0, _M, _F, _A) -> garbage_collect(), ok; +loop(N, M, F, A) -> + _ = apply(M, F, A), + loop(N - 1, M, F, A). lspawn(Fun) -> {Pid, Ref} = spawn_monitor(fun() -> exit(Fun()) end), @@ -225,10 +248,10 @@ lspawn(Fun) -> {'DOWN', Ref, process, Pid, Rep} -> Rep end. -report_base64(Time) -> +report_mfa(Time, Mod) -> Tps = round((?N*1000000)/Time), ct_event:notify(#event{name = benchmark_data, - data = [{suite, "stdlib_base64"}, + data = [{suite, "stdlib_" ++ atom_to_list(Mod)}, {value, Tps}]}), Tps. diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml index 76c2d6ecbd..44944e57c3 100644 --- a/lib/syntax_tools/doc/src/notes.xml +++ b/lib/syntax_tools/doc/src/notes.xml @@ -108,6 +108,20 @@ </section> +<section><title>Syntax_Tools 2.1.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix a bug regarding reverting map types. </p> + <p> + Own Id: OTP-15098 Aux Id: ERIERL-177 </p> + </item> + </list> + </section> + +</section> + <section><title>Syntax_Tools 2.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index ced0dba3e2..352165893f 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -1981,7 +1981,7 @@ analyze_application(Node) -> %% %% @see analyze_type_name/1 --type typeName() :: atom() | {module(), atom(), arity()} | {atom(), arity()}. +-type typeName() :: atom() | {module(), {atom(), arity()}} | {atom(), arity()}. -spec analyze_type_application(erl_syntax:syntaxTree()) -> typeName(). diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 16e3511734..b712b77e9f 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -660,7 +660,7 @@ merge_files1(Files, Opts) -> %% transitions), code replacement is expected to be detected. Then, if %% we in the merged code do not check at these points if the %% <em>target</em> module (the result of the merge) has been replaced, -%% we can not be sure in general that we will be able to do code +%% we cannot be sure in general that we will be able to do code %% replacement of the merged state machine - it could run forever %% without detecting the code change. Therefore, all such calls must %% remain remote-calls (detecting code changes), but may call the target diff --git a/lib/tftp/doc/src/tftp.xml b/lib/tftp/doc/src/tftp.xml index 481e5446ad..4ed54bc462 100644 --- a/lib/tftp/doc/src/tftp.xml +++ b/lib/tftp/doc/src/tftp.xml @@ -150,7 +150,7 @@ <tag><c>{logger, Module}</c></tag> <item> - <p><c>Module = module()()</c></p> + <p><c>Module = module()</c></p> <p>Callback module for customized logging of errors, warnings, and info messages. The callback module must implement the @@ -220,7 +220,7 @@ <name>info(daemons) -> [{Pid, Options}]</name> <fsummary>Returns information about all daemons.</fsummary> <type> - <v>Pid = [pid()()]</v> + <v>Pid = [pid()]</v> <v>Options = [option()]</v> <v>Reason = term()</v> </type> @@ -233,7 +233,7 @@ <name>info(servers) -> [{Pid, Options}]</name> <fsummary>Returns information about all servers.</fsummary> <type> - <v>Pid = [pid()()]</v> + <v>Pid = [pid()]</v> <v>Options = [option()]</v> <v>Reason = term()</v> </type> diff --git a/lib/tools/doc/src/cover.xml b/lib/tools/doc/src/cover.xml index 15cd784253..6c6b20aad8 100644 --- a/lib/tools/doc/src/cover.xml +++ b/lib/tools/doc/src/cover.xml @@ -234,7 +234,7 @@ <c>{already_cover_compiled,no_beam_found,Module}</c> is returned.</p> <p><c>{error,BeamFile}</c> is returned if the compiled code - can not be loaded on the node.</p> + cannot be loaded on the node.</p> <p>If a list of <c>ModFiles</c> is given as input, a list of <c>Result</c> will be returned. The order of the returned list is undefined.</p> @@ -470,7 +470,7 @@ <p>Exports the current coverage data for <c>Module</c> to the file <c>ExportFile</c>. It is recommended to name the <c>ExportFile</c> with the extension <c>.coverdata</c>, since - other filenames can not be read by the web based interface to + other filenames cannot be read by the web based interface to cover.</p> <p>If <c>Module</c> is not given, data for all Cover compiled or earlier imported modules is exported.</p> @@ -496,7 +496,7 @@ <p>Coverage data from several export files can be imported into one system. The coverage data is then added up when analysing.</p> - <p>Coverage data for a module can not be imported from the + <p>Coverage data for a module cannot be imported from the same file twice unless the module is first reset or compiled. The check is based on the filename, so you can easily fool the system by renaming your export file.</p> diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 3211132254..82e5c2222d 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -77,6 +77,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(require 'align) ;; Variables: @@ -1405,6 +1406,19 @@ Other commands: (add-function :before-until (local 'eldoc-documentation-function) #'erldoc-eldoc-function)) (run-hooks 'erlang-mode-hook) + + ;; Align maps. + (add-to-list 'align-rules-list + '(erlang-maps + (regexp . "\\(\\s-*\\)\\(=>\\)\\s-*") + (modes . '(erlang-mode)) + (repeat . t))) + ;; Align records and :: specs + (add-to-list 'align-rules-list + '(erlang-record-specs + (regexp . "\\(\\s-*\\)\\(=\\).*\\(::\\)*\\s-*") + (modes . '(erlang-mode)) + (repeat . t))) (if (zerop (buffer-size)) (run-hooks 'erlang-new-file-hook))) diff --git a/lib/tools/priv/styles.css b/lib/tools/priv/styles.css new file mode 100644 index 0000000000..e10e94e3ad --- /dev/null +++ b/lib/tools/priv/styles.css @@ -0,0 +1,91 @@ +body { + font: 14px/1.6 "Helvetica Neue", Helvetica, Arial, sans-serif; + margin: 0; + padding: 0; + color: #000; + border-top: 2px solid #ddd; + background-color: #fff; + + min-height: 100%; + display: flex; + flex-direction: column; +} + +h1 { + width: 100%; + border-bottom: 1px solid #eee; + margin-bottom: 0; + font-weight: 100; + font-size: 1.1em; + letter-spacing: 1px; +} + +h1 code { + font-size: 0.96em; +} + +code { + font: 12px monospace; +} + +footer { + background: #eee; + width: 100%; + padding: 10px 0; + text-align: right; + border-top: 1px solid #ddd; + display: flex; + flex: 1; + order: 2; + justify-content: center; +} + +table { + width: 100%; + margin-top: 10px; + border-collapse: collapse; + border: 1px solid #cbcbcb; + color: #000; + -webkit-border-radius: 3px; + -moz-border-radius: 3px; +} +table thead { + display: none; +} +table td.line, +table td.hits { + width: 20px; + background: #eaeaea; + text-align: center; + font-size: 11px; + padding: 0 10px; + color: #949494; +} +table td.hits { + width: 10px; + padding: 2px 5px; + color: rgba(0, 0, 0, 0.6); + background-color: #f0f0f0; +} +tr.miss td.line, +tr.miss td.hits { + background-color: #ffdce0; + border-color: #fdaeb7; +} +tr.miss td { + background-color: #ffeef0; +} +tr.hit td.line, +tr.hit td.hits { + background-color: #cdffd8; + border-color: #bef5cb; +} +tr.hit td { + background-color: #e6ffed; +} +td.source { + padding-left: 15px; + line-height: 15px; + white-space: pre; + font: 12px monospace; +} diff --git a/lib/tools/src/Makefile b/lib/tools/src/Makefile index 032bd612db..a869ae6a00 100644 --- a/lib/tools/src/Makefile +++ b/lib/tools/src/Makefile @@ -72,6 +72,9 @@ APP_TARGET = $(EBIN)/$(APP_FILE) APPUP_SRC = $(APPUP_FILE).src APPUP_TARGET = $(EBIN)/$(APPUP_FILE) +PRIVDIR = ../priv +CSS = $(PRIVDIR)/styles.css + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -110,5 +113,7 @@ release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/ebin" $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) \ "$(RELSYSDIR)/ebin" + $(INSTALL_DIR) "$(RELSYSDIR)/priv" + $(INSTALL_DATA) $(CSS) "$(RELSYSDIR)/priv" release_docs_spec: diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index bf5faa165d..337d9d637a 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -144,6 +144,8 @@ end). -define(SPAWN_DBG(Tag,Value),put(Tag,Value)). +-define(STYLESHEET, "styles.css"). +-define(TOOLS_APP, tools). -include_lib("stdlib/include/ms_transform.hrl"). @@ -2415,20 +2417,8 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) -> case file:open(OutFile, [write,raw,delayed_write]) of {ok, OutFd} -> Enc = encoding(ErlFile), - if HTML -> - Header = - ["<!DOCTYPE HTML PUBLIC " - "\"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<html>\n" - "<head>\n" - "<meta http-equiv=\"Content-Type\"" - " content=\"text/html; charset=", - html_encoding(Enc),"\"/>\n" - "<title>",OutFile,"</title>\n" - "</head>" - "<body style='background-color: white;" - " color: black'>\n" - "<pre>\n"], + if HTML -> + Header = create_header(OutFile, Enc), H1Bin = unicode:characters_to_binary(Header,Enc,Enc), ok = file:write(OutFd,H1Bin); true -> ok @@ -2445,14 +2435,19 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) -> string:pad(integer_to_list(Mi), 2, leading, $0), string:pad(integer_to_list(S), 2, leading, $0)]), - H2Bin = unicode:characters_to_binary( - ["File generated from ",ErlFile," by COVER ", - Timestamp,"\n\n" - "**************************************" - "**************************************" - "\n\n"], - Enc, Enc), - ok = file:write(OutFd, H2Bin), + OutFileInfo = + if HTML -> + create_footer(ErlFile, Timestamp); + true -> + ["File generated from ",ErlFile," by COVER ", + Timestamp, "\n\n", + "**************************************" + "**************************************" + "\n\n"] + end, + + H2Bin = unicode:characters_to_binary(OutFileInfo,Enc,Enc), + ok = file:write(OutFd, H2Bin), Pattern = {#bump{module=Module,line='$1',_='_'},'$2'}, MS = [{Pattern,[{is_integer,'$1'},{'>','$1',0}],[{{'$1','$2'}}]}], @@ -2462,7 +2457,7 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) -> print_lines(Module, CovLines, InFd, OutFd, 1, HTML), if HTML -> - ok = file:write(OutFd, "</pre>\n</body>\n</html>\n"); + ok = file:write(OutFd, close_html()); true -> ok end, @@ -2497,12 +2492,11 @@ print_lines(Module, CovLines, InFd, OutFd, L, HTML) -> case CovLines of [{L,N}|CovLines1] -> if N=:=0, HTML=:=true -> - LineNoNL = Line -- "\n", - Str = " 0", - %%Str = string:pad("0", 6, leading, $\s), - RedLine = ["<font color=red>",Str,fill1(), - LineNoNL,"</font>\n"], - ok = file:write(OutFd, RedLine); + MissedLine = table_row("miss", Line, L, N), + ok = file:write(OutFd, MissedLine); + HTML=:=true -> + HitLine = table_row("hit", Line, L, N), + ok = file:write(OutFd, HitLine); N < 1000000 -> Str = string:pad(integer_to_list(N), 6, leading, $\s), ok = file:write(OutFd, [Str,fill1(),Line]); @@ -2515,7 +2509,11 @@ print_lines(Module, CovLines, InFd, OutFd, L, HTML) -> end, print_lines(Module, CovLines1, InFd, OutFd, L+1, HTML); _ -> %Including comment lines - ok = file:write(OutFd, [tab(),Line]), + NonCoveredContent = + if HTML -> table_row(Line, L); + true -> [tab(),Line] + end, + ok = file:write(OutFd, NonCoveredContent), print_lines(Module, CovLines, InFd, OutFd, L+1, HTML) end end. @@ -2525,6 +2523,59 @@ fill1() -> "..| ". fill2() -> ".| ". fill3() -> "| ". +%% HTML sections +create_header(OutFile, Enc) -> + ["<!doctype html>\n" + "<html>\n" + "<head>\n" + "<meta charset=\"",html_encoding(Enc),"\">\n" + "<title>",OutFile,"</title>\n" + "<style>"] ++ + read_stylesheet() ++ + ["</style>\n", + "</head>\n" + "<body>\n" + "<h1><code>",OutFile,"</code></h1>\n"]. + +create_footer(ErlFile, Timestamp) -> + ["<footer><p>File generated from <code>",ErlFile, + "</code> by <a href=\"http://erlang.org/doc/man/cover.html\">cover</a> at ", + Timestamp,"</p></footer>\n<table>\n<tbody>\n"]. + +close_html() -> + ["</tbody>\n", + "<thead>\n", + "<tr>\n", + "<th>Line</th>\n", + "<th>Hits</th>\n", + "<th>Source</th>\n", + "</tr>\n", + "</thead>\n", + "</table>\n", + "</body>\n" + "</html>\n"]. + +table_row(CssClass, Line, L, N) -> + ["<tr class=\"",CssClass,"\">\n", table_data(Line, L, N)]. +table_row(Line, L) -> + ["<tr>\n", table_data(Line, L, "")]. + +table_data(Line, L, N) -> + LineNoNL = Line -- "\n", + ["<td class=\"line\" id=\"L",integer_to_list(L),"\">", + integer_to_list(L), + "</td>\n", + "<td class=\"hits\">",maybe_integer_to_list(N),"</td>\n", + "<td class=\"source\"><code>",LineNoNL,"</code></td>\n</tr>\n"]. + +maybe_integer_to_list(N) when is_integer(N) -> integer_to_list(N); +maybe_integer_to_list(_) -> "". + +read_stylesheet() -> + PrivDir = code:priv_dir(?TOOLS_APP), + {ok, Css} = file:read_file(filename:join(PrivDir, ?STYLESHEET)), + [Css]. + %%%--Export-------------------------------------------------------------- do_export(Module, OutFile, From, State) -> case file:open(OutFile,[write,binary,raw,delayed_write]) of diff --git a/lib/wx/c_src/wxe_driver.c b/lib/wx/c_src/wxe_driver.c index 8b8c625971..c9d299e0df 100644 --- a/lib/wx/c_src/wxe_driver.c +++ b/lib/wx/c_src/wxe_driver.c @@ -38,10 +38,8 @@ #define TEMP_BINARY_SIZE 512 -static ErlDrvData wxe_driver_start(ErlDrvPort port, char *buff); -static int wxe_driver_load(void); +static ErlDrvData wxe_driver_start(ErlDrvPort port, char *command); static void wxe_driver_stop(ErlDrvData handle); -static void wxe_driver_unload(void); static ErlDrvSSizeT wxe_driver_control(ErlDrvData handle, unsigned int command, char* buf, ErlDrvSizeT count, @@ -63,30 +61,30 @@ char * erl_wx_privdir; ** The driver struct */ static ErlDrvEntry wxe_driver_entry = { - wxe_driver_load, /* F_PTR init, called at loading */ - wxe_driver_start, /* L_PTR start, called when port is opened */ - wxe_driver_stop, /* F_PTR stop, called when port is closed */ - NULL, /* F_PTR output, called when erlang has sent */ - NULL, /* F_PTR ready_input, called when input descriptor - ready */ - NULL, /* F_PTR ready_output, called when output - descriptor ready */ - "wxe_driver", /* char *driver_name, the argument to open_port */ - wxe_driver_unload, /* F_PTR finish, called when unloaded */ - NULL, /* void * that is not used (BC) */ - wxe_driver_control, /* F_PTR control, port_control callback */ - NULL, /* F_PTR timeout, reserved */ - standard_outputv, /* F_PTR outputv, reserved */ - NULL, /* async */ - NULL, /* flush */ - wxe_driver_call, /* call */ - NULL, /* Event */ + NULL, /* F_PTR init, called at loading */ + wxe_driver_start, /* L_PTR start, called when port is opened */ + wxe_driver_stop, /* F_PTR stop, called when port is closed */ + NULL, /* F_PTR output, called when erlang has sent */ + NULL, /* F_PTR ready_input, called when + input descriptor ready */ + NULL, /* F_PTR ready_output, called when + output descriptor ready */ + "wxe_driver", /* char *driver_name, the argument to open_port */ + NULL, /* F_PTR finish, called when unloaded */ + NULL, /* void * that is not used (BC) */ + wxe_driver_control, /* F_PTR control, port_control callback */ + NULL, /* F_PTR timeout, reserved */ + standard_outputv, /* F_PTR outputv, reserved */ + NULL, /* async */ + NULL, /* flush */ + wxe_driver_call, /* call */ + NULL, /* Event */ ERL_DRV_EXTENDED_MARKER, ERL_DRV_EXTENDED_MAJOR_VERSION, ERL_DRV_EXTENDED_MINOR_VERSION, - ERL_DRV_FLAG_USE_PORT_LOCKING, /* Port lock */ - NULL, /* Reserved Handle */ - wxe_process_died, /* Process Exited */ + ERL_DRV_FLAG_USE_PORT_LOCKING, /* Port lock */ + NULL, /* Reserved Handle */ + wxe_process_died, /* Process Exited */ }; DRIVER_INIT(wxe_driver) @@ -94,60 +92,56 @@ DRIVER_INIT(wxe_driver) return &wxe_driver_entry; } -int wxe_driver_load() -{ - if(load_native_gui()) - return 0; - else - return -1; -} - ErlDrvPort WXE_DRV_PORT_HANDLE = 0; ErlDrvTermData WXE_DRV_PORT = 0; static ErlDrvData -wxe_driver_start(ErlDrvPort port, char *buff) -{ - wxe_data *data; - - data = (wxe_data *) malloc(sizeof(wxe_data)); - wxe_debug = 0; - - if (data == NULL) { - fprintf(stderr, " Couldn't alloc mem\r\n"); - return(ERL_DRV_ERROR_GENERAL); /* ENOMEM */ - } else { - ErlDrvTermData term_port = driver_mk_port(port); - set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); - data->driver_data = NULL; - data->bin = (WXEBinRef*) driver_alloc(sizeof(WXEBinRef)*DEF_BINS); - data->bin[0].from = 0; - data->bin[1].from = 0; - data->bin[2].from = 0; - data->max_bins = DEF_BINS; - data->port_handle = port; - data->port = term_port; - data->pdl = driver_pdl_create(port); - if(WXE_DRV_PORT_HANDLE == 0) { - for(; *buff != 32; buff++); - buff++; - erl_wx_privdir = strdup(buff); - - WXE_DRV_PORT_HANDLE = port; - WXE_DRV_PORT = term_port; - wxe_master = data; - if(!(start_native_gui(data) == 1)) - return(ERL_DRV_ERROR_GENERAL); /* ENOMEM */ - } else { - meta_command(CREATE_PORT,data); - } - return (ErlDrvData) data; - } +wxe_driver_start(ErlDrvPort port, char *command) +{ + wxe_data *data; + + data = (wxe_data *) malloc(sizeof(wxe_data)); + wxe_debug = 0; + + if (data == NULL) { + fprintf(stderr, " Couldn't alloc mem\r\n"); + return(ERL_DRV_ERROR_GENERAL); /* ENOMEM */ + } else { + ErlDrvTermData term_port = driver_mk_port(port); + set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); + data->driver_data = NULL; + data->bin = (WXEBinRef*) driver_alloc(sizeof(WXEBinRef)*DEF_BINS); + data->bin[0].from = 0; + data->bin[1].from = 0; + data->bin[2].from = 0; + data->max_bins = DEF_BINS; + data->port_handle = port; + data->port = term_port; + data->pdl = driver_pdl_create(port); + if(WXE_DRV_PORT_HANDLE == 0) { + char *first_space = strchr(command, ' '); + if (first_space) { + char *priv_dir = first_space + 1; + erl_wx_privdir = strdup(priv_dir); + + WXE_DRV_PORT_HANDLE = port; + WXE_DRV_PORT = term_port; + wxe_master = data; + if(start_native_gui(data) != 1) + return ERL_DRV_ERROR_GENERAL; /* ENOMEM */ + } else { + return ERL_DRV_ERROR_BADARG; + } + } else { + meta_command(CREATE_PORT, data); + } + return (ErlDrvData) data; + } } static void wxe_driver_stop(ErlDrvData handle) -{ +{ wxe_data *sd = ((wxe_data *)handle); if(sd->port_handle != WXE_DRV_PORT_HANDLE) { // fprintf(stderr, "%s:%d: STOP \r\n", __FILE__,__LINE__); @@ -155,18 +149,11 @@ wxe_driver_stop(ErlDrvData handle) } else { // fprintf(stderr, "%s:%d: STOP \r\n", __FILE__,__LINE__); stop_native_gui(wxe_master); - unload_native_gui(); free(wxe_master); wxe_master = NULL; } } -static void -wxe_driver_unload(void) -{ - // fprintf(stderr, "%s:%d: UNLOAD \r\n", __FILE__,__LINE__); -} - static ErlDrvSSizeT wxe_driver_control(ErlDrvData handle, unsigned op, char* buf, ErlDrvSizeT count, @@ -194,7 +181,7 @@ wxe_driver_call(ErlDrvData handle, unsigned int command, if (len > rlen) *res = driver_alloc(len); memcpy((void *) *res, (void *) buf, len); - return len; + return len; } @@ -219,20 +206,20 @@ standard_outputv(ErlDrvData drv_data, ErlIOVec* ev) int i, max; for(i = 0; i < sd->max_bins; i++) { - if(sd->bin[i].from == 0) { - binref = &sd->bin[i]; - break; - } + if(sd->bin[i].from == 0) { + binref = &sd->bin[i]; + break; + } } if(binref == NULL) { /* realloc */ - max = sd->max_bins + DEF_BINS; - driver_realloc(sd->bin, sizeof(WXEBinRef)*max); - for(i=sd->max_bins; i < max; i++) { - sd->bin[i].from = 0; - } - binref = &sd->bin[sd->max_bins]; - sd->max_bins = max; + max = sd->max_bins + DEF_BINS; + driver_realloc(sd->bin, sizeof(WXEBinRef)*max); + for(i=sd->max_bins; i < max; i++) { + sd->bin[i].from = 0; + } + binref = &sd->bin[sd->max_bins]; + sd->max_bins = max; } if(ev->size > 0) { diff --git a/lib/wx/c_src/wxe_driver.h b/lib/wx/c_src/wxe_driver.h index f9bca049c8..8b4ce2b804 100644 --- a/lib/wx/c_src/wxe_driver.h +++ b/lib/wx/c_src/wxe_driver.h @@ -56,10 +56,8 @@ typedef struct wxe_data_def { void init_glexts(wxe_data*); -int load_native_gui(); int start_native_gui(wxe_data *sd); void stop_native_gui(wxe_data *sd); -void unload_native_gui(); #define FUNC_CALL 13 #define CREATE_PORT 14 diff --git a/lib/wx/c_src/wxe_main.cpp b/lib/wx/c_src/wxe_main.cpp index c7565e33bd..5b65d8a59b 100644 --- a/lib/wx/c_src/wxe_main.cpp +++ b/lib/wx/c_src/wxe_main.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014-2016. All Rights Reserved. + * Copyright Ericsson AB 2014-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. @@ -59,15 +59,9 @@ void *wxe_main_loop(void * ); * START AND STOP of driver thread * ************************************************************/ -int load_native_gui() -{ - return 1; -} - int start_native_gui(wxe_data *sd) { int res; - ErlDrvThreadOpts *opts = NULL; wxe_status_m = erl_drv_mutex_create((char *) "wxe_status_m"); wxe_status_c = erl_drv_cond_create((char *)"wxe_status_c"); @@ -79,7 +73,7 @@ int start_native_gui(wxe_data *sd) res = erl_drv_steal_main_thread((char *)"wxwidgets", &wxe_thread,wxe_main_loop,(void *) sd->pdl,NULL); #else - opts = erl_drv_thread_opts_create((char *)"wx thread"); + ErlDrvThreadOpts *opts = erl_drv_thread_opts_create((char *)"wx thread"); opts->suggested_stack_size = 8192; res = erl_drv_thread_create((char *)"wxwidgets", &wxe_thread,wxe_main_loop,(void *) sd->pdl,opts); @@ -116,11 +110,6 @@ void stop_native_gui(wxe_data *sd) erl_drv_cond_destroy(wxe_batch_locker_c); } -void unload_native_gui() -{ - -} - /* ************************************************************ * wxWidgets Thread * ************************************************************/ diff --git a/lib/wx/doc/overview.edoc b/lib/wx/doc/overview.edoc index 054016f515..843a9c1320 100644 --- a/lib/wx/doc/overview.edoc +++ b/lib/wx/doc/overview.edoc @@ -218,7 +218,7 @@ the <em>fun</em> returns. The callbacks are always invoked by another process and have exclusive usage of the GUI when invoked. This means that a callback <em>fun</em> -can not use the process dictionary and should not make calls to other +cannot use the process dictionary and should not make calls to other processes. Calls to another process inside a callback <em>fun</em> may cause a deadlock if the other process is waiting on completion of his call to the GUI. diff --git a/lib/wx/examples/demo/ex_graphicsContext.erl b/lib/wx/examples/demo/ex_graphicsContext.erl index 1193578037..1e6ffce18d 100644 --- a/lib/wx/examples/demo/ex_graphicsContext.erl +++ b/lib/wx/examples/demo/ex_graphicsContext.erl @@ -74,7 +74,7 @@ do_init(Config) -> pen = Pen, brush = Brush, font = Font}}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Sync events i.e. from callbacks must return ok, it can not return a new state. +%% Sync events i.e. from callbacks must return ok, it cannot return a new state. %% Do the redrawing here. handle_sync_event(#wx{event = #wxPaint{}},_, #state{win=Win, pen = Pen, brush = Brush, font = Font}) -> diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 7ecd9b7283..1cc194d569 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -347,9 +347,9 @@ connect_in_callback(Config) -> %% such that new events are not fired until the previous %% callback have returned. - %% That means that a callback can not wait for other events + %% That means that a callback cannot wait for other events %% in receive since they will not come. - %% It also means that you can not attach a new callback directly from + %% It also means that you cannot attach a new callback directly from %% the callback since that callback will be removed when the temporary %% process that executes the outer callback (may) die(s) before the callback %% is invoked diff --git a/lib/wx/test/wxt b/lib/wx/test/wxt index e720ed94f4..1343542366 100755 --- a/lib/wx/test/wxt +++ b/lib/wx/test/wxt @@ -18,7 +18,7 @@ # # %CopyrightEnd% # -# Usage: mt <args to erlang startup script> +# Usage: wxt <args to erlang startup script> log=test_log_$$ latest=test_log_latest @@ -27,7 +27,7 @@ erlcmd="erl -sname test_server -smp -pa ../ebin $p $args -wx_test_verbose true - echo "Give the following command in order to see the outcome:" echo "" -echo " less test_log$$" +echo " less $log" rm "$latest" 2>/dev/null ln -s "$log" "$latest" diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index a1f6ad4e2c..a7538180e6 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -279,7 +279,7 @@ int_file_decl(F, Options,_ExtCharset) -> %% @spec string(Text::list()) -> {xmlElement(),Rest} %% Rest = list() -%% @equiv string(Test, []) +%% @equiv string(Text, []) string(Str) -> string(Str, []). diff --git a/lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml b/lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml index c2533248d1..0379c18214 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml +++ b/lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml @@ -276,7 +276,7 @@ </exception> <exception name="UpgradeNotPossibleException"> - <description>Before an upgrade is started it was found that the upgrade can not take place. A possible reason is that the upgrade package that is running in the node is not in the upgrade window of this upgrade package. </description> + <description>Before an upgrade is started it was found that the upgrade cannot take place. A possible reason is that the upgrade package that is running in the node is not in the upgrade window of this upgrade package. </description> <exceptionParameter name="message"> <dataType> <string/> @@ -1703,7 +1703,7 @@ Example: <exception name="NoSuchAttributeException"> <description>Exception thrown when an MO attribute is requested to be accessed but the access -method for the is not defined (the attribute can not be accessed)</description> +method for the is not defined (the attribute cannot be accessed)</description> </exception> <exception name="MoCardinalityViolationException"> @@ -3125,7 +3125,7 @@ active = Synchronization is used in system clock generation. <description>RefState can have the following values: failed = synchronization reference is not capable to perform its required tasks. degraded = capability of synchronization reference to perform its required tasks is degraded e.g. because of signal level degradation. This value is only applicable for traffic carrying (ET physical path termination) synchronization references. Note: attribute degradationIsFault controls whether synchronization reference degradation is interpreted as a synchronization reference fault or not. -lossOfTracking = system clock regulation algorithm on TU board can not follow the 8kHz synchronization reference signal either because of the poor quality of the signal or because of a HW fault at TU board. If all synchronization references repeatedly end up to state lossOfTracking, fault is likely in TU HW. +lossOfTracking = system clock regulation algorithm on TU board cannot follow the 8kHz synchronization reference signal either because of the poor quality of the signal or because of a HW fault at TU board. If all synchronization references repeatedly end up to state lossOfTracking, fault is likely in TU HW. ok = synchronization reference is capable of performing its required tasks. </description> <enumMember name="failed"> @@ -11270,7 +11270,7 @@ Note! This action requires a transaction.</description> The changing of the IP address with operation assignIpAddress might cause interruption of the communication if the network management tool is connected via the ethernet link. -Note: The EthernetLink MO can not be deleted! +Note: The EthernetLink MO cannot be deleted! Note: The performance monitoring counters in the EthernetLink MO has a "Wrap-around time" of approximately 2 hours. </description> @@ -11532,8 +11532,8 @@ Note! This action requires a transaction.</description> <description>This MO holds the IP routing table. The IpRoutingTable MO is automatically created when the Ip MO is created. -The IpRoutingTable MO can not be created manually. -The IpRoutingTable MO can not be deleted. +The IpRoutingTable MO cannot be created manually. +The IpRoutingTable MO cannot be deleted. </description> <systemCreated/> <attribute name="userLabel"> @@ -12967,7 +12967,7 @@ Note! When using fractional atm, timeslot 1 must be a part of the fraction. Note! ETM1 does not support EPD and PPD -Note! ETM1 does not have a proper buffer management. Thus fairness of UBR+ traffic can not be guaranteed and shaping on UBR+ traffic is not possible. +Note! ETM1 does not have a proper buffer management. Thus fairness of UBR+ traffic cannot be guaranteed and shaping on UBR+ traffic is not possible. Note! The number of VCC TP+VPC TP with performance monitoring enabled (i.e. PM mode <> off) is restricted to 1 per port. </description> @@ -13371,7 +13371,7 @@ Struct element description : -Date is in string format, max length is 40. Format for date is: weekday month date hour:min:seconds year. -Status is in string format, max length is 40. -Note! The identity can not be the same as name. Identity should contain the product identity. +Note! The identity cannot be the same as name. Identity should contain the product identity. </description> @@ -13562,7 +13562,7 @@ Note! For comment and operatorName spaces (' ') are also allowed within the stri This action does not require a transaction. -Note! The configurationVersionName and identity can not be the same. The identity should be the product identity. +Note! The configurationVersionName and identity cannot be the same. The identity should be the product identity. </description> <returnType> <void/> @@ -17367,7 +17367,7 @@ NOTE: There is a restriction of a maximum of 32 Mtp2Tp's per MP.</description> <attribute name="mtp2ProfileItuId"> <description>Reference to a Mtp2ProfileItu MO. -Note: The bitRate can not be changed.</description> +Note: The bitRate cannot be changed.</description> <mandatory/> <noNotification/> <dataType> @@ -17566,7 +17566,7 @@ NOTE: There is a restriction of a maximum of 32 Mtp2Tp's per MP.</description> <attribute name="mtp2ProfileAnsiId"> <description>Reference to a Mtp2ProfileAnsi MO. -Note: The bitRate can not be changed.</description> +Note: The bitRate cannot be changed.</description> <mandatory/> <noNotification/> <dataType> @@ -21777,7 +21777,7 @@ Each E1/DS1/J1 channel can suport up to 2 VP connections. The ET-MC41 board support one biderectional F4/F5 PM flow per E1 channel. -Note! The ETMC41 supports IMA. However the E1 ports being part of the same IMA group can not be selected randomly. +Note! The ETMC41 supports IMA. However the E1 ports being part of the same IMA group cannot be selected randomly. Note! The number of VCC TP+VPC TP with performance monitoring enabled (i.e. PM mode <> off) is restricted to 1 / port @@ -21883,7 +21883,7 @@ NOTE: There is a restriction of a maximum of 32 Mtp2Tp's per MP. <attribute name="mtp2ProfileChinaId"> <description>Reference to a Mtp2ProfileChina MO. -Note: The bitRate can not be changed.</description> +Note: The bitRate cannot be changed.</description> <mandatory/> <noNotification/> <dataType> diff --git a/lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml b/lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml index 3b5d8ae2ad..3b9ccac0f4 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml +++ b/lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml @@ -276,7 +276,7 @@ </exception>
<exception name="UpgradeNotPossibleException">
- <description>Before an upgrade is started it was found that the upgrade can not take place. A possible reason is that the upgrade package that is running in the node is not in the upgrade window of this upgrade package. </description>
+ <description>Before an upgrade is started it was found that the upgrade cannot take place. A possible reason is that the upgrade package that is running in the node is not in the upgrade window of this upgrade package. </description>
<exceptionParameter name="message">
<dataType>
<string/>
@@ -1703,7 +1703,7 @@ Example: <exception name="NoSuchAttributeException">
<description>Exception thrown when an MO attribute is requested to be accessed but the access
-method for the is not defined (the attribute can not be accessed)</description>
+method for the is not defined (the attribute cannot be accessed)</description>
</exception>
<exception name="MoCardinalityViolationException">
@@ -3125,7 +3125,7 @@ active = Synchronization is used in system clock generation. <description>RefState can have the following values:
failed = synchronization reference is not capable to perform its required tasks.
degraded = capability of synchronization reference to perform its required tasks is degraded e.g. because of signal level degradation. This value is only applicable for traffic carrying (ET physical path termination) synchronization references. Note: attribute degradationIsFault controls whether synchronization reference degradation is interpreted as a synchronization reference fault or not.
-lossOfTracking = system clock regulation algorithm on TU board can not follow the 8kHz synchronization reference signal either because of the poor quality of the signal or because of a HW fault at TU board. If all synchronization references repeatedly end up to state lossOfTracking, fault is likely in TU HW.
+lossOfTracking = system clock regulation algorithm on TU board cannot follow the 8kHz synchronization reference signal either because of the poor quality of the signal or because of a HW fault at TU board. If all synchronization references repeatedly end up to state lossOfTracking, fault is likely in TU HW.
ok = synchronization reference is capable of performing its required tasks.
</description>
<enumMember name="failed">
@@ -11270,7 +11270,7 @@ Note! This action requires a transaction.</description> The changing of the IP address with operation assignIpAddress might cause interruption of the communication if the network management tool is connected via the ethernet link.
-Note: The EthernetLink MO can not be deleted!
+Note: The EthernetLink MO cannot be deleted!
Note: The performance monitoring counters in the EthernetLink MO has a "Wrap-around time" of approximately 2 hours.
</description>
@@ -11532,8 +11532,8 @@ Note! This action requires a transaction.</description> <description>This MO holds the IP routing table.
The IpRoutingTable MO is automatically created when the Ip MO is created.
-The IpRoutingTable MO can not be created manually.
-The IpRoutingTable MO can not be deleted.
+The IpRoutingTable MO cannot be created manually.
+The IpRoutingTable MO cannot be deleted.
</description>
<systemCreated/>
<attribute name="userLabel">
@@ -12967,7 +12967,7 @@ Note! When using fractional atm, timeslot 1 must be a part of the fraction. Note! ETM1 does not support EPD and PPD
-Note! ETM1 does not have a proper buffer management. Thus fairness of UBR+ traffic can not be guaranteed and shaping on UBR+ traffic is not possible.
+Note! ETM1 does not have a proper buffer management. Thus fairness of UBR+ traffic cannot be guaranteed and shaping on UBR+ traffic is not possible.
Note! The number of VCC TP+VPC TP with performance monitoring enabled (i.e. PM mode <> off) is restricted to 1 per port.
</description>
@@ -13371,7 +13371,7 @@ Struct element description : -Date is in string format, max length is 40. Format for date is: weekday month date hour:min:seconds year.
-Status is in string format, max length is 40.
-Note! The identity can not be the same as name. Identity should contain the product identity.
+Note! The identity cannot be the same as name. Identity should contain the product identity.
</description>
@@ -13562,7 +13562,7 @@ Note! For comment and operatorName spaces (' ') are also allowed within the stri This action does not require a transaction.
-Note! The configurationVersionName and identity can not be the same. The identity should be the product identity.
+Note! The configurationVersionName and identity cannot be the same. The identity should be the product identity.
</description>
<returnType>
<void/>
@@ -17367,7 +17367,7 @@ NOTE: There is a restriction of a maximum of 32 Mtp2Tp's per MP.</description> <attribute name="mtp2ProfileItuId">
<description>Reference to a Mtp2ProfileItu MO.
-Note: The bitRate can not be changed.</description>
+Note: The bitRate cannot be changed.</description>
<mandatory/>
<noNotification/>
<dataType>
@@ -17566,7 +17566,7 @@ NOTE: There is a restriction of a maximum of 32 Mtp2Tp's per MP.</description> <attribute name="mtp2ProfileAnsiId">
<description>Reference to a Mtp2ProfileAnsi MO.
-Note: The bitRate can not be changed.</description>
+Note: The bitRate cannot be changed.</description>
<mandatory/>
<noNotification/>
<dataType>
@@ -21777,7 +21777,7 @@ Each E1/DS1/J1 channel can suport up to 2 VP connections. The ET-MC41 board support one biderectional F4/F5 PM flow per E1 channel.
-Note! The ETMC41 supports IMA. However the E1 ports being part of the same IMA group can not be selected randomly.
+Note! The ETMC41 supports IMA. However the E1 ports being part of the same IMA group cannot be selected randomly.
Note! The number of VCC TP+VPC TP with performance monitoring enabled (i.e. PM mode <> off) is restricted to 1 / port
@@ -21883,7 +21883,7 @@ NOTE: There is a restriction of a maximum of 32 Mtp2Tp's per MP. <attribute name="mtp2ProfileChinaId">
<description>Reference to a Mtp2ProfileChina MO.
-Note: The bitRate can not be changed.</description>
+Note: The bitRate cannot be changed.</description>
<mandatory/>
<noNotification/>
<dataType>
diff --git a/configure.in b/make/configure.in index 559049aca1..987e02ddc1 100644 --- a/configure.in +++ b/make/configure.in @@ -44,7 +44,7 @@ case "X$ERL_TOP" in X) ;; X/*) - test -f $ERL_TOP/erts/emulator/beam/beam_emu.c || { + test -f "$ERL_TOP/erts/emulator/beam/beam_emu.c" || { AC_MSG_ERROR([Invalid \$ERL_TOP]) } srcdir="$ERL_TOP";; @@ -93,6 +93,8 @@ dnl if test "X$host" != "Xfree_source" -a "X$host" != "Xwin32"; then AC_CANONICAL_HOST +else + host_os=$host fi TARGET=$host @@ -128,6 +130,8 @@ AC_PROG_CC AC_PROG_CXX AC_CHECK_TOOL(LD, [ld]) +LM_WINDOWS_ENVIRONMENT + _search_path=/bin:/usr/bin:/usr/local/bin:$PATH AC_PATH_PROG(ENV, [env], false, $_search_path) @@ -207,6 +211,9 @@ AC_MSG_CHECKING([OTP version]) AC_MSG_RESULT([$OTP_VSN]) AC_SUBST(OTP_VSN) +AC_ARG_ENABLE(parallel-configure, +AS_HELP_STRING([--disable-parallel-configure], [disable parallel execution of configure scripts])) + AC_ARG_ENABLE(dirty-schedulers, AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support])) @@ -412,77 +419,9 @@ if test $CROSS_COMPILING = no; then esac fi -rm -f $ERL_TOP/lib/SKIP-APPLICATIONS -for app in `cd lib && ls -d *`; do - var=`eval echo \\$with_$app` - if test X${var} = Xno; then - echo "$app" >> $ERL_TOP/lib/SKIP-APPLICATIONS - fi -done - -export ERL_TOP -AC_CONFIG_SUBDIRS(lib erts) +ERL_DED -AC_CONFIG_FILES([Makefile make/output.mk]) -AC_CONFIG_FILES([make/emd2exml], [chmod +x make/emd2exml]) +AC_CONFIG_FILES([../Makefile output.mk ../make/$host/otp_ded.mk:../make/otp_ded.mk.in]) +AC_CONFIG_FILES([emd2exml], [chmod +x emd2exml]) AC_OUTPUT - -pattern="lib/*/SKIP" -files=`echo $pattern` -if test "$files" != "$pattern" || test -f $ERL_TOP/lib/SKIP-APPLICATIONS; then - echo '*********************************************************************' - echo '********************** APPLICATIONS DISABLED **********************' - echo '*********************************************************************' - echo - if test "$files" != "$pattern"; then - for skipfile in $files; do - app=`dirname $skipfile`; app=`basename $app` - printf "%-15s: " $app; cat $skipfile - done - fi - if test -f $ERL_TOP/lib/SKIP-APPLICATIONS; then - for skipapp in `cat $ERL_TOP/lib/SKIP-APPLICATIONS`; do - printf "%-15s: User gave --without-%s option\n" $skipapp $skipapp - done - fi - echo - echo '*********************************************************************' -fi -pattern="lib/*/CONF_INFO" -files=`echo $pattern` -if test "$files" != "$pattern" || test -f erts/CONF_INFO; then - echo '*********************************************************************' - echo '********************** APPLICATIONS INFORMATION *******************' - echo '*********************************************************************' - echo - test "$files" != "$pattern" || files="" - test ! -f erts/CONF_INFO || files="$files erts/CONF_INFO" - for infofile in $files; do - app=`dirname $infofile`; app=`basename $app` - printf "%-15s: " $app; cat $infofile - done - echo - echo '*********************************************************************' -fi -if test -f "erts/doc/CONF_INFO"; then - echo '*********************************************************************' - echo '********************** DOCUMENTATION INFORMATION ******************' - echo '*********************************************************************' - echo - printf "%-15s: \n" documentation; - havexsltproc="yes" - for cmd in `cat erts/doc/CONF_INFO`; do - echo " $cmd is missing." - if test $cmd = "xsltproc"; then - havexsltproc="no" - fi - done - if test $havexsltproc = "no"; then - echo ' The documentation can not be built.' - else - echo ' Using fakefop to generate placeholder PDF files.' - fi - echo - echo '*********************************************************************' -fi diff --git a/make/emd2exml.in b/make/emd2exml.in index 57bcaba24d..24837696f4 100755 --- a/make/emd2exml.in +++ b/make/emd2exml.in @@ -1214,7 +1214,7 @@ complete_output(#state{out = Out} = S) -> complete_output(S, [], Out) -> S#state{delayed_array = [], - out = ["<?xml version=\"1.0\" encoding=\"utf8\" ?>", nl(), + out = ["<?xml version=\"1.0\" encoding=\"utf-8\" ?>", nl(), "<!DOCTYPE chapter SYSTEM \"chapter.dtd\">", nl(), Out]}; complete_output(S, [{delayed, IX}|Rest], Out) -> diff --git a/make/lazy_configure.mk b/make/lazy_configure.mk deleted file mode 100644 index c74f216de0..0000000000 --- a/make/lazy_configure.mk +++ /dev/null @@ -1,82 +0,0 @@ -# ``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. -# -# The Initial Developer of the Original Code is Ericsson Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# - -ifndef EXPECTED_AUTOCONF_VERSION -EXPECTED_AUTOCONF_VERSION=2.59 -endif -SAVE_ARGS=$(ERL_TOP)/make/save_args -CONFIG_STATUS=$(CONFIGURE_DIR)/$(TARGET)/config.status -SAVED_CONFIG_FLAGS_FILE=$(CONFIGURE_DIR)/$(TARGET)/lazy.config.flags -SAVED_CONFIG_LOG=$(CONFIGURE_DIR)/$(TARGET)/config.log -CONFIG_CACHE_FILE=$(CONFIGURE_DIR)/$(TARGET)/lazy.config.cache -ALL_CONFIG_FLAGS=$(CONFIGURE_FLAGS) --no-create --no-recursion --cache-file=$(CONFIG_CACHE_FILE) - -lazy_configure: save_config_flags $(CONFIG_STATUS) - rm -f $(CONFIGURE_DIR)/config.log - cd $(CONFIGURE_DIR) && $(CONFIG_STATUS) - cat $(CONFIGURE_DIR)/config.log >> $(SAVED_CONFIG_LOG) - rm -f $(CONFIGURE_DIR)/config.log - -save_config_flags: - $(SAVE_ARGS) $(SAVED_CONFIG_FLAGS_FILE) --- $(ALL_CONFIG_FLAGS) - -$(SAVED_CONFIG_FLAGS_FILE): save_config_flags - -$(CONFIGURE_DIR)/configure: $(CONFIGURE_DIR)/configure.in $(EXTRA_CONFIGURE_DEPENDENCIES) - rm -f $(CONFIG_CACHE_FILE) - @ exp_ac_vsn=$(EXPECTED_AUTOCONF_VERSION) ; \ - ac_vsn_blob=`autoconf --version` ; \ - ac_vsn=`echo x$$ac_vsn_blob | sed "s|[^0-9]*\([0-9][^ \t\n]*\).*|\1|"` ; \ - case "$$ac_vsn" in \ - $$exp_ac_vsn) \ - ;; \ - *) \ - echo "***************************************************" 1>&2 ; \ - echo "***************************************************" 1>&2 ; \ - echo "*** WARNING: System might fail to configure or" 1>&2 ; \ - echo "*** might be erroneously configured" 1>&2 ; \ - echo "*** since autoconf version $$ac_vsn is used" 1>&2 ; \ - echo "*** instead of version $$exp_ac_vsn!" 1>&2 ; \ - echo "***************************************************" 1>&2 ; \ - echo "***************************************************" 1>&2 ; \ - ;; \ - esac - cd $(CONFIGURE_DIR) && autoconf -f - -$(CONFIGURE_DIR)/config.h.in: $(CONFIGURE_DIR)/configure.in $(CONFIGURE_DIR)/aclocal.m4 - cd $(CONFIGURE_DIR) && autoheader ./configure.in > ./config.h.in - -$(CONFIG_STATUS): $(SAVED_CONFIG_FLAGS_FILE) $(CONFIGURE_DIR)/configure $(EXTRA_CONFIG_STATUS_DEPENDENCIES) - rm -f $(CONFIGURE_DIR)/config.log - cd $(CONFIGURE_DIR) && CONFIG_STATUS=$(CONFIG_STATUS) ./configure $(ALL_CONFIG_FLAGS) - rm -f $(SAVED_CONFIG_LOG) - mv $(CONFIGURE_DIR)/config.log $(SAVED_CONFIG_LOG) - -lazy_configure_target_clean: - rm -f $(CONFIG_STATUS) - rm -f $(CONFIG_CACHE_FILE) - rm -f $(SAVED_CONFIG_FLAGS_FILE) - rm -f $(SAVED_CONFIG_LOG) - -lazy_configure_clean: lazy_configure_target_clean - rm -f $(CONFIGURE_DIR)/configure - test ! -f $(CONFIGURE_DIR)/acconfig.h || rm -f $(CONFIGURE_DIR)/config.h.in - -.PHONY: lazy_configure save_config_flags lazy_configure_clean - diff --git a/make/otp_ded.mk.in b/make/otp_ded.mk.in index 0b5311d75e..9c8df265de 100644 --- a/make/otp_ded.mk.in +++ b/make/otp_ded.mk.in @@ -24,27 +24,26 @@ # explicitly expressed here. Some applications need to # be able to check this value *before* configure has # been run and generated otp_ded.mk -DED_MK_VSN = 1 +DED_MK_VSN = 2 # ---------------------------------------------------- # Variables needed for building Dynamic Erlang Drivers # ---------------------------------------------------- -DED_CC = @CC@ -DED_GCC = @GCC@ +DED_CC = @DED_CC@ +DED_GCC = @DED_GCC@ DED_LD = @DED_LD@ DED_LDFLAGS = @DED_LDFLAGS@ -DED__NOWARN_NOTHR_CFLAGS = @DED_CFLAGS@ -DED__NOTHR_CFLAGS = @WFLAGS@ @DED_CFLAGS@ -DED__NOWARN_CFLAGS = @DED_EMU_THR_DEFS@ @DED_CFLAGS@ +DED_BASIC_CFLAGS = @DED_CFLAGS@ DED_THR_DEFS = @DED_THR_DEFS@ -DED_EMU_THR_DEFS = @DED_EMU_THR_DEFS@ -DED_WARN_FLAGS = @WFLAGS@ -DED_CFLAGS = @WERRORFLAGS@ @WFLAGS@ @DED_EMU_THR_DEFS@ @DED_CFLAGS@ -DED_STATIC_CFLAGS = @WERRORFLAGS@ @WFLAGS@ @DED_EMU_THR_DEFS@ @DED_STATIC_CFLAGS@ -DED_LIBS = @LIBS@ +DED_WERRORFLAGS = @DED_WERRORFLAGS@ +DED_WARN_FLAGS = @DED_WARN_FLAGS@ +DED_CFLAGS = @DED_CFLAGS@ +DED_LD_FLAG_RUNTIME_LIBRARY_PATH = @DED_LD_FLAG_RUNTIME_LIBRARY_PATH@ +DED_STATIC_CFLAGS = @DED_STATIC_CFLAGS@ +DED_LIBS = @DED_LIBS@ DED_EXT = @DED_EXT@ -ERLANG_OSTYPE = @ERLANG_OSTYPE@ +DED_OSTYPE = @DED_OSTYPE@ PRIVDIR = ../priv OBJDIR = $(PRIVDIR)/obj/$(TARGET) LIBDIR = $(PRIVDIR)/lib/$(TARGET) DED_SYS_INCLUDE = @DED_SYS_INCLUDE@ -DED_INCLUDES = $(DED_SYS_INCLUDE) +DED_INCLUDES = @DED_INCLUDE@ @@ -21,11 +21,10 @@ # Global configuration variables # -# NOTE: lazy_configure depends on '.' always being last directory if [ -z "$ONLY_ERTS" ]; then AUTOCONF_SUBDIRS="lib lib/* lib/common_test/test_server" fi -AUTOCONF_SUBDIRS="$AUTOCONF_SUBDIRS erts ." +AUTOCONF_SUBDIRS="$AUTOCONF_SUBDIRS make erts" # `bootstrap_apps' should include application that are built, or # partly built in one of the bootstrap phases. Applications that @@ -212,55 +211,10 @@ set_config_flags () NL="\ " -create_lib_configure_in() -{ - cd $ERL_TOP - - # Multiple versions of autoconf generates code that - # don't work on all platforms (e.g. SunOS 5.8) if - # sub directories are soft links. Internally at Ericsson - # some OTP application directories are soft links. - # An added "/." solves this problem. - - sdirs= - for lib_app in $bootstrap_apps; do - case $lib_app in - lib/*) - if [ -f "$lib_app/configure.in" ]; then - app=`echo "$lib_app" | sed "s|lib/\(.*\)|\1|"` - sdirs="${sdirs}test ! -f $app/configure || AC_CONFIG_SUBDIRS($app/.)${NL}" - fi;; - *) - ;; - esac - done - - sed_bootstrap="s%@BOOTSTRAP_CONFIGURE_APPS@%$sdirs%g" - - sdirs= - for lib_app in lib/*; do - is_bapp=false - for bapp in $bootstrap_apps; do - test $bapp != $lib_app || { is_bapp=true; break; } - done - if [ $is_bapp = false ] && [ -f "$lib_app/configure.in" ]; then - app=`echo "$lib_app" | sed "s|lib/\(.*\)|\1|"` - sdirs="${sdirs} test ! -f $app/configure || AC_CONFIG_SUBDIRS($app/.)${NL}" - fi - done - - sed_non_bootstrap="s%@NON_BOOTSTRAP_CONFIGURE_APPS@%$sdirs%g" - - rm -f lib/configure.in - sed "$sed_bootstrap;$sed_non_bootstrap" > lib/configure.in < lib/configure.in.src || { - echo "Failed to create lib/configure.in" - exit 1 - } -} distribute_config_helpers () { - aclocal_dirs=". ./lib/erl_interface ./lib/odbc ./lib/wx ./lib/megaco" + aclocal_dirs="make ./lib/crypto ./lib/erl_interface ./lib/odbc ./lib/wx ./lib/megaco" autoconf_aux_dirs="./lib/common_test/priv/auxdir ./lib/erl_interface/src/auxdir ./lib/common_test/test_server ./lib/wx/autoconf" aclocal_master="./erts/aclocal.m4" @@ -282,7 +236,6 @@ distribute_config_helpers () do_autoconf () { - create_lib_configure_in distribute_config_helpers if [ ! -z "$OVERRIDE_CONFIGURE" ]; then @@ -323,6 +276,15 @@ do_autoconf () ( cd "$d" && autoheader ) || exit 1 done + echo "" + echo "=== creating ./configure" + otp_version=`cat "$ERL_TOP/OTP_VERSION"` + bootstrap_lib_apps=`echo $bootstrap_apps | sed "s|erts||g"` + cat "$ERL_TOP/configure.src" \ + | sed "s|@OTP_VERSION@|$otp_version|g;s|@BOOTSTRAP_LIB_APP_DIRS@|$bootstrap_lib_apps|" \ + > "$ERL_TOP/configure" + chmod +x "$ERL_TOP/configure" + restore_vars OVERRIDE_TARGET TARGET } @@ -385,8 +347,8 @@ try_cross_configure () test "X$build_value" != "X" || build_value="$BUILDSYS" - build_sys=`$ERL_TOP/erts/autoconf/config.sub "$build_value"` || exit 1 - host_sys=`$ERL_TOP/erts/autoconf/config.sub "$host_value"` || exit 1 + build_sys=`"$ERL_TOP/erts/autoconf/config.sub" "$build_value"` || exit 1 + host_sys=`"$ERL_TOP/erts/autoconf/config.sub" "$host_value"` || exit 1 test "$host_sys" = "$build_sys" || cross_configure=yes @@ -500,7 +462,7 @@ do_configure () case $TARGET in vxworks_*) ( cd erts/autoconf && \ - $ERL_TOP/erts/autoconf/configure.vxworks $TARGET ) + "$ERL_TOP/erts/autoconf/configure.vxworks" $TARGET ) echo "Configuring for build system too..." >&2 hide_vars OVERRIDE_TARGET TARGET TARGET=$BUILDSYS @@ -526,105 +488,6 @@ do_configure () fi } -do_lazy_configure () -{ - setup_make - if [ "x$OVERRIDE_TARGET" != "x" -a "x$OVERRIDE_TARGET" != "xwin32" ]; then - echo "Not supported for cross compilation" >&2 - exit 1 - fi - maybe_copy_static_cache - CONFIG_FLAGS= - set_config_flags "$@" - CONFIGURE_FLAGS="$@" - [ "$CONFIG_FLAGS" = "" ] || CONFIGURE_FLAGS="$CONFIG_FLAGS $CONFIGURE_FLAGS" - for c_dir in $AUTOCONF_SUBDIRS; do - if test -f $ERL_TOP/$c_dir/configure.in; then - dir=$ERL_TOP/$c_dir - echo "" - echo "=== Begin configuring $dir" - xc_dep= ; - xcs_dep= ; - test -d $dir/$TARGET || mkdir $dir/$TARGET - test -f $dir/aclocal.m4 && xc_dep="$xcs_dep $dir/aclocal.m4" - test -f $dir/acsite.m4 && xc_dep="$xcs_dep $dir/acsite.m4" - test x$c_dir = x"erts" && xcs_dep="$xcs_dep $dir/config.h.in" - $MAKE -f $ERL_TOP/make/lazy_configure.mk \ - MAKE="$MAKE" TARGET=$TARGET \ - ERL_TOP=$ERL_TOP \ - CONFIGURE_FLAGS="$CONFIGURE_FLAGS" \ - CONFIGURE_DIR=$dir \ - EXTRA_CONFIGURE_DEPENDENCIES=$xc_dep \ - EXTRA_CONFIG_STATUS_DEPENDENCIES=$xcs_dep \ - lazy_configure - echo "=== Done configuring $dir" - echo "" - fi - done -} - -do_lazy_configure_clean () -{ - setup_make - if [ "x$OVERRIDE_TARGET" != "x" -a "x$OVERRIDE_TARGET" != "xwin32" ]; then - echo "Not supported for cross compilation" >&2 - exit 1 - fi - for c_dir in $AUTOCONF_SUBDIRS; do - if test -f $ERL_TOP/$c_dir/configure.in; then - dir=$ERL_TOP/$c_dir - echo "" - echo "=== Begin cleaning configure in $dir" - xc_dep= ; - xcs_dep= ; - test -d $dir/$TARGET || mkdir $dir/$TARGET - test -f $dir/aclocal.m4 && xc_dep="$xcs_dep $dir/aclocal.m4" - test -f $dir/acsite.m4 && xc_dep="$xcs_dep $dir/acsite.m4" - test x$c_dir = x"erts" && xcs_dep="$xcs_dep $dir/config.h.in" - $MAKE -f $ERL_TOP/make/lazy_configure.mk \ - MAKE="$MAKE" TARGET=$TARGET \ - ERL_TOP=$ERL_TOP \ - CONFIGURE_DIR=$dir \ - lazy_configure_clean - echo "=== Done cleaning configure in $dir" - echo "" - fi - done - -} - -do_lazy_configure_target_clean () -{ - setup_make - if [ "x$OVERRIDE_TARGET" != "x" -a "x$OVERRIDE_TARGET" != "xwin32" ]; then - echo "Not supported for cross compilation" >&2 - exit 1 - fi - for c_dir in $AUTOCONF_SUBDIRS; do - if test -f $ERL_TOP/$c_dir/configure.in; then - dir=$ERL_TOP/$c_dir - echo "" - echo "=== Begin target cleaning configure in $dir" - xc_dep= ; - xcs_dep= ; - test -d $dir/$TARGET || mkdir $dir/$TARGET - test -f $dir/aclocal.m4 && xc_dep="$xcs_dep $dir/aclocal.m4" - test -f $dir/acsite.m4 && xc_dep="$xcs_dep $dir/acsite.m4" - test x$c_dir = x"erts" && xcs_dep="$xcs_dep $dir/config.h.in" - $MAKE -f $ERL_TOP/make/lazy_configure.mk \ - MAKE="$MAKE" TARGET=$TARGET \ - ERL_TOP=$ERL_TOP \ - CONFIGURE_DIR=$dir \ - lazy_configure_target_clean - echo "=== Done target cleaning configure in $dir" - echo "" - fi - done - -} - - - echo_setenv () { case "$DAILY_BUILD_SCRIPT$SHELL" in @@ -1075,11 +938,11 @@ do_update_prel_git () { get_do_commit $1 setup_make - (cd $ERL_TOP/erts/preloaded/src && $MAKE MAKE="$MAKE" BOOTSTRAP_ROOT=$BOOTSTRAP_ROOT TARGET=$TARGET clean) + (cd "$ERL_TOP/erts/preloaded/src" && $MAKE MAKE="$MAKE" BOOTSTRAP_ROOT=$BOOTSTRAP_ROOT TARGET=$TARGET clean) $MAKE MAKE="$MAKE" BOOTSTRAP_ROOT=$BOOTSTRAP_ROOT TARGET=$TARGET preloaded || exit 1 - (cd $ERL_TOP/erts/preloaded/src && $MAKE MAKE="$MAKE" BOOTSTRAP_ROOT=$BOOTSTRAP_ROOT TARGET=$TARGET copy) + (cd "$ERL_TOP/erts/preloaded/src" && $MAKE MAKE="$MAKE" BOOTSTRAP_ROOT=$BOOTSTRAP_ROOT TARGET=$TARGET copy) if [ $do_commit = true ]; then - git add -A $ERL_TOP/erts/preloaded/ebin/*.beam + git add -A "$ERL_TOP/erts/preloaded/ebin/*.beam" git commit -m 'Update preloaded modules' echo "Preloaded updated and commited." else @@ -1149,11 +1012,11 @@ do_debuginfo_win32 () (cd erts/emulator && $MAKE MAKE="$MAKE" TARGET=$TARGET FLAVOR=smp debug &&\ $MAKE MAKE="$MAKE" TARGET=$TARGET FLAVOR=plain debug) || exit 1 if [ -z "$1" ]; then - RELDIR=$ERL_TOP/release/$TARGET + RELDIR="$ERL_TOP/release/$TARGET" else RELDIR="$1" fi - BINDIR=$ERL_TOP/bin/$TARGET + BINDIR="$ERL_TOP/bin/$TARGET" EVSN=`grep '^VSN' erts/vsn.mk | sed 's,^VSN.*=[^0-9]*\([0-9].*\)$,@\1,g;s,^[^@].*,,g;s,^@,,g'` for f in beam.debug.dll beam.debug.smp.dll beam.pdb beam.smp.pdb erl.pdb werl.pdb erlexec.pdb; do if [ -f $BINDIR/$f ]; then @@ -1166,7 +1029,7 @@ do_debuginfo_win32 () do_installer_win32 () { setup_make - installer_dir=$ERL_TOP/erts/etc/win32/nsis + installer_dir="$ERL_TOP/erts/etc/win32/nsis" (cd $installer_dir; $MAKE MAKE="$MAKE" TARGET=$TARGET TESTROOT=$1 release) || exit 1 } @@ -1210,7 +1073,7 @@ do_copy_primary_bootstrap () cp -f $lib_src/compiler/ebin/*.beam $bootstrap/lib/compiler/ebin # bootstrap bin - if [ $bootstrap_src_top != $ERL_TOP ]; then + if [ $bootstrap_src_top != "$ERL_TOP" ]; then test -d $bootstrap/bin || mkdir -p $bootstrap/bin cp -f $bootstrap_src_top/bin/* $bootstrap/bin fi @@ -1219,22 +1082,22 @@ do_copy_primary_bootstrap () do_save_bootstrap () { - if [ ! -f $ERL_TOP/prebuilt.files ]; then + if [ ! -f "$ERL_TOP/prebuilt.files" ]; then echo "This is not a pre-built source distribution" 1>&2 exit 1 fi - if [ -d $ERL_TOP/bootstrap/lib ]; then + if [ -d "$ERL_TOP/bootstrap/lib" ]; then echo "Bootstrap already exist" 1>&2 exit 1 fi - do_copy_primary_bootstrap $ERL_TOP $ERL_TOP + do_copy_primary_bootstrap "$ERL_TOP" "$ERL_TOP" } do_remove_prebuilt_files () { do_save_bootstrap - for file in $ERL_TOP/`cat $ERL_TOP/prebuilt.files` ; do + for file in "$ERL_TOP"/`cat "$ERL_TOP/prebuilt.files"` ; do rm -f $file done } @@ -1243,7 +1106,7 @@ do_remove_prebuilt_files () check_erltop -cd $ERL_TOP +cd "$ERL_TOP" determine_version_controller @@ -1257,7 +1120,7 @@ unset ${erl_otp_flags} # Target first guess, won't necessarily hold, may be changed for # certain parameters. if [ X"$TARGET" = X"" ]; then - TARGET=`$ERL_TOP/erts/autoconf/config.guess` + TARGET=`"$ERL_TOP/erts/autoconf/config.guess"` fi BUILDSYS=$TARGET @@ -1335,27 +1198,11 @@ case "$1" in do_autoconf; do_configure "$@"; do_boot;; - lazy_setup) - shift; - if [ $minus_a_flag = true ]; then - shift - fi; - do_lazy_configure "$@"; - do_boot;; autoconf) do_autoconf;; configure) shift; do_configure "$@";; - lazy_configure) - shift; - do_lazy_configure "$@";; - lazy_configure_clean) - shift; - do_lazy_configure_clean;; - lazy_configure_target_clean) - shift; - do_lazy_configure_target_clean;; opt) do_boot;; plain|smp) diff --git a/otp_versions.table b/otp_versions.table index ccaa082a7a..c33bb63002 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,7 +1,18 @@ +OTP-21.0.8 : erts-10.0.7 kernel-6.0.1 # asn1-5.0.6 common_test-1.16 compiler-7.2.3 crypto-4.3.2 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0.1 jinterface-1.9 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6.1 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0.1 stdlib-3.5.1 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : +OTP-21.0.7 : erts-10.0.6 # asn1-5.0.6 common_test-1.16 compiler-7.2.3 crypto-4.3.2 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0.1 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6.1 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0.1 stdlib-3.5.1 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : +OTP-21.0.6 : crypto-4.3.2 inets-7.0.1 ssl-9.0.1 # asn1-5.0.6 common_test-1.16 compiler-7.2.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 erts-10.0.5 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6.1 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 stdlib-3.5.1 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : +OTP-21.0.5 : compiler-7.2.3 crypto-4.3.1 erts-10.0.5 # asn1-5.0.6 common_test-1.16 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6.1 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 stdlib-3.5.1 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : +OTP-21.0.4 : erts-10.0.4 # asn1-5.0.6 common_test-1.16 compiler-7.2.2 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6.1 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 stdlib-3.5.1 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : OTP-21.0.3 : erts-10.0.3 # asn1-5.0.6 common_test-1.16 compiler-7.2.2 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6.1 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 stdlib-3.5.1 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : OTP-21.0.2 : compiler-7.2.2 erts-10.0.2 public_key-1.6.1 stdlib-3.5.1 # asn1-5.0.6 common_test-1.16 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : OTP-21.0.1 : compiler-7.2.1 erts-10.0.1 # asn1-5.0.6 common_test-1.16 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 stdlib-3.5 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : OTP-21.0 : asn1-5.0.6 common_test-1.16 compiler-7.2 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 erts-10.0 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 mnesia-4.15.4 observer-2.8 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 ssh-4.7 ssl-9.0 stdlib-3.5 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 # megaco-3.18.3 odbc-2.12.1 snmp-5.2.11 : +OTP-20.3.8.8 : inets-6.5.2.4 # asn1-5.0.5.1 common_test-1.15.4 compiler-7.1.5.1 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.1 ssl-8.2.6.2 stdlib-3.4.5 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : +OTP-20.3.8.7 : crypto-4.2.2.2 mnesia-4.15.3.2 # asn1-5.0.5.1 common_test-1.15.4 compiler-7.1.5.1 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.3 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.1 ssl-8.2.6.2 stdlib-3.4.5 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : +OTP-20.3.8.6 : inets-6.5.2.3 # asn1-5.0.5.1 common_test-1.15.4 compiler-7.1.5.1 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.1 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.1 ssl-8.2.6.2 stdlib-3.4.5 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : +OTP-20.3.8.5 : compiler-7.1.5.1 crypto-4.2.2.1 erts-9.3.3.3 mnesia-4.15.3.1 ssl-8.2.6.2 # asn1-5.0.5.1 common_test-1.15.4 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.2 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.1 stdlib-3.4.5 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : +OTP-20.3.8.4 : asn1-5.0.5.1 # common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.2 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.2 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.1 ssl-8.2.6.1 stdlib-3.4.5 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : +OTP-20.3.8.3 : erts-9.3.3.2 ic-4.4.4.2 inets-6.5.2.2 kernel-5.4.3.2 ssl-8.2.6.1 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 jinterface-1.8.1 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.1 stdlib-3.4.5 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.8.2 : erl_interface-3.10.2.1 erts-9.3.3.1 ic-4.4.4.1 kernel-5.4.3.1 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 inets-6.5.2.1 jinterface-1.8.1 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.1 ssl-8.2.6 stdlib-3.4.5 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.8.1 : inets-6.5.2.1 ssh-4.6.9.1 syntax_tools-2.1.4.1 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 erl_interface-3.10.2 erts-9.3.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssl-8.2.6 stdlib-3.4.5 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.8 : erts-9.3.3 snmp-5.2.11 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.3 erl_interface-3.10.2 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4 inets-6.5.2 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 ssh-4.6.9 ssl-8.2.6 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : @@ -33,6 +44,7 @@ OTP-20.0.3 : asn1-5.0.2 compiler-7.1.1 erts-9.0.3 ssh-4.5.1 # common_test-1.15.1 OTP-20.0.2 : asn1-5.0.1 erts-9.0.2 kernel-5.3.1 # common_test-1.15.1 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 : OTP-20.0.1 : common_test-1.15.1 erts-9.0.1 runtime_tools-1.12.1 stdlib-3.4.1 tools-2.10.1 # asn1-5.0 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 syntax_tools-2.1.2 wx-1.8.1 xmerl-1.3.15 : OTP-20.0 : asn1-5.0 common_test-1.15 compiler-7.1 cosProperty-1.2.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 erl_docgen-0.7 erl_interface-3.10 erts-9.0 eunit-2.3.3 hipe-3.16 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 orber-3.8.3 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4 syntax_tools-2.1.2 tools-2.10 wx-1.8.1 xmerl-1.3.15 # cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 eldap-1.2.2 et-1.6 ic-4.4.2 odbc-2.12 os_mon-2.4.2 otp_mibs-1.1.1 : +OTP-19.3.6.10 : erts-8.3.5.5 syntax_tools-2.1.1.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.4 ssl-8.1.3.1.1 stdlib-3.3 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.9 : ssh-4.4.2.4 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.8 : ssh-4.4.2.3 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.7 : kernel-5.2.0.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.2 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : diff --git a/scripts/bundle-otp b/scripts/bundle-otp index 0ffe7d8c77..aa1f166732 100755 --- a/scripts/bundle-otp +++ b/scripts/bundle-otp @@ -13,6 +13,9 @@ REPOSITORIES="otp,$TRAVIS_TAG corba,.*" mkdir bundle +## Turn off * expansion, needed for the .* regexp to work +set -f + for repo in $REPOSITORIES; do OLD_IFS=$IFS IFS=',' @@ -22,13 +25,16 @@ for repo in $REPOSITORIES; do git clone https://github.com/erlang/$1 $1 cd $1 echo $1 $2 - TAG=`git tag -l | grep -P "$2" | sort -V | tail -1` + TAG=`git tag -l | grep -P "^$2$" | sort -V | tail -1` git checkout $TAG SHA=`git rev-parse --verify HEAD` rm -rf .git echo "$1 $TAG $SHA" >> $OTP_META_FILE done +## Turn on * expansion +set +f + cd $ERL_TOP/bundle/ tar czf $OTP_FILE * diff --git a/system/COPYRIGHT b/system/COPYRIGHT index 5d47e0ca38..ff5cc30793 100644 --- a/system/COPYRIGHT +++ b/system/COPYRIGHT @@ -41,12 +41,15 @@ PCRE LICENCE PCRE is a library of functions to support regular expressions whose syntax and semantics are as close as possible to those of the Perl 5 language. -Release 7 of PCRE is distributed under the terms of the "BSD" licence, as +Release 8 of PCRE is distributed under the terms of the "BSD" licence, as specified below. The documentation for PCRE, supplied in the "doc" -directory, is distributed under the same terms as the software itself. +directory, is distributed under the same terms as the software itself. The data +in the testdata directory is not copyrighted and is in the public domain. The basic library functions are written in C and are freestanding. Also -included in the distribution is a set of C++ wrapper functions. +included in the distribution is a set of C++ wrapper functions, and a +just-in-time compiler that can be used to optimize pattern matching. These +are both optional features that can be omitted when the library is built. THE BASIC LIBRARY FUNCTIONS @@ -59,7 +62,29 @@ Email domain: cam.ac.uk University of Cambridge Computing Service, Cambridge, England. -Copyright (c) 1997-2008 University of Cambridge +Copyright (c) 1997-2018 University of Cambridge +All rights reserved. + + +PCRE JUST-IN-TIME COMPILATION SUPPORT +------------------------------------- + +Written by: Zoltan Herczeg +Email local part: hzmester +Emain domain: freemail.hu + +Copyright(c) 2010-2018 Zoltan Herczeg +All rights reserved. + + +STACK-LESS JUST-IN-TIME COMPILER +-------------------------------- + +Written by: Zoltan Herczeg +Email local part: hzmester +Emain domain: freemail.hu + +Copyright(c) 2009-2018 Zoltan Herczeg All rights reserved. @@ -68,7 +93,7 @@ THE C++ WRAPPER FUNCTIONS Contributed by: Google Inc. -Copyright (c) 2007-2008, Google Inc. +Copyright (c) 2007-2012, Google Inc. All rights reserved. diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml index 16a901b3a5..98fd1fd69d 100644 --- a/system/doc/design_principles/statem.xml +++ b/system/doc/design_principles/statem.xml @@ -1410,7 +1410,7 @@ open(cast, {button,_}, Data) -> <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer/3,4</c></seealso>. Most time-out tasks can be performed with the time-out features in <c>gen_statem</c>, - but an example of one that can not is if you should need + but an example of one that cannot is if you should need the return value from <seealso marker="erts:erlang#cancel_timer/2"><c>erlang:cancel_timer(Tref)</c></seealso>, that is; the remaining time of the timer. </p> diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 06ca44a9f6..a2e0d95408 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -312,12 +312,17 @@ child_spec() = #{id => child_id(), % mandatory signal back. If no exit signal is received within the specified time, the child process is unconditionally terminated using <c>exit(Child, kill)</c>.</item> - <item>If the child process is another supervisor, it is to be + <item>If the child process is another supervisor, it must be set to <c>infinity</c> to give the subtree enough time to shut down. It is also allowed to set it to <c>infinity</c>, - if the child process is a worker. See the warning below:</item> + if the child process is a worker. See the warning below:</item> </list> <warning> + <p>Setting the shutdown time to anything other + than <c>infinity</c> for a child of type <c>supervisor</c> + can cause a race condition where the child in question + unlinks its own children, but fails to terminate them + before it is killed.</p> <p>Be careful when setting the shutdown time to <c>infinity</c> when the child process is a worker. Because, in this situation, the termination of the supervision tree depends on the diff --git a/system/doc/embedded/starting.xml b/system/doc/embedded/starting.xml index 11bf9b412a..6888f9c959 100644 --- a/system/doc/embedded/starting.xml +++ b/system/doc/embedded/starting.xml @@ -231,7 +231,7 @@ exec $BINDIR/erlexec -boot $RELDIR/$VSN/start -config $RELDIR/$VSN/sys $* < <p>If a diskless and/or read-only client node with the SASL configuration parameter <c>static_emulator</c> set to <c>true</c> is about to start the <c>-boot</c> and <c>-config</c> flags must be - changed. As such a client can not read a new <c>start_erl.data</c> + changed. As such a client cannot read a new <c>start_erl.data</c> file (the file is not possible to change dynamically) the boot and config files is always fetched from the same place (but with a new contents if a new release has been installed). The diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 94e40dd077..1f48233c39 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -567,6 +567,10 @@ Expr1 <input>op</input> Expr2</pre> order is defined:</p> <pre> number < atom < reference < fun < port < pid < tuple < map < nil < list < bit string</pre> + <p><c>nil</c> in the previous expression represents the empty list + (<c>[]</c>), which is regarded as a separate type from + <c>list/0</c>. That is why <c>nil < list</c>. + </p> <p>Lists are compared element by element. Tuples are ordered by size, two tuples with the same size are compared element by element.</p> @@ -574,6 +578,7 @@ number < atom < reference < fun < port < pid < tuple < map ascending term order and then by values in key order. In maps key order integers types are considered less than floats types. </p> + <p>Atoms are compared using their string value, codepoint by codepoint.</p> <p>When comparing an integer to a float, the term with the lesser precision is converted into the type of the other term, unless the operator is one of <c>=:=</c> or <c>=/=</c>. A float is more precise than diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index f6a19397c3..a8b7393cc8 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -113,8 +113,8 @@ | Erlang_Atom %% 'foo', 'bar', ... Bitstring :: <<>> - | <<_:M>> %% M is a positive integer - | <<_:_*N>> %% N is a positive integer + | <<_:M>> %% M is an Integer_Value that evaluates to a positive integer + | <<_:_*N>> %% N is an Integer_Value that evaluates to a positive integer | <<_:M, _:_*N>> Fun :: fun() %% any function @@ -123,8 +123,17 @@ | fun((TList) -> Type) Integer :: integer() - | Erlang_Integer %% ..., -1, 0, 1, ... 42 ... - | Erlang_Integer..Erlang_Integer %% specifies an integer range + | Integer_Value + | Integer_Value..Integer_Value %% specifies an integer range + + Integer_Value :: Erlang_Integer %% ..., -1, 0, 1, ... 42 ... + | Erlang_Character %% $a, $b ... + | Integer_Value BinaryOp Integer_Value + | UnaryOp Integer_Value + + BinaryOp :: '*' | 'div' | 'rem' | 'band' | '+' | '-' | 'bor' | 'bxor' | 'bsl' | 'bsr' + + UnaryOp :: '+' | '-' | 'bnot' List :: list(Type) %% Proper list ([]-terminated) | maybe_improper_list(Type1, Type2) %% Type1=contents, Type2=termination @@ -151,8 +160,13 @@ Union :: Type1 | Type2 ]]></pre> <p> + Integer values are either integer or character literals or expressions + consisting of possibily nested unary or binary operations that evaluate to + an integer. Such expressions can also be used in bit strings and ranges. + </p> + <p> The general form of bit strings is <c><<_:M, _:_*N>></c>, - where <c>M</c> and <c>N</c> are positive integers. It denotes a + where <c>M</c> and <c>N</c> must evaluate to positive integers. It denotes a bit string that is <c>M + (k*N)</c> bits long (that is, a bit string that starts with <c>M</c> bits and continues with <c>k</c> segments of <c>N</c> bits each, where <c>k</c> is also a positive integer). diff --git a/system/doc/system_principles/versions.xml b/system/doc/system_principles/versions.xml index 11dc9d5637..fbdcc6b2b0 100644 --- a/system/doc/system_principles/versions.xml +++ b/system/doc/system_principles/versions.xml @@ -181,7 +181,7 @@ goes for application versions.</p> <p>In general, versions can have more than three parts. The versions are then only partially ordered. Such - versions are only used in exceptional cases. When an extra + versions are only used when branching off from another branch. When an extra part (out of the normal three parts) is added to a version number, a new branch of versions is made. The new branch has a linear order against the base version. However, versions on different @@ -240,6 +240,33 @@ </section> <section> + <marker id="otp_versions_tree"/> + <title>OTP Versions Tree</title> + <p> + All released OTP versions can be found in the + <url href="http://www.erlang.org/download/otp_versions_tree.html">OTP + Versions Tree</url> which is automatically updated whenever + we release a new OTP version. Note that every version number as + such explicitly define its position in the version tree. Nothing + more than the version numbers are needed in order to construct + the tree. The root of the tree is OTP version 17.0 which is when + we introduced the new + <seealso marker="#version_scheme">version scheme</seealso>. The + green versions are normal versions released on the main track. + Old <seealso marker="#releases_and_patches">OTP releases</seealso> + will be maintained for a while on <c>maint</c> branches that have + branched off from the main track. Old <c>maint</c> branches always + branch off from the main track when the next OTP release is + introduced into the main track. Versions on these old <c>maint</c> + branches are marked blue. Besides the green and blue versions, + there are also gray versions. These are versions on branches + introduced in order to fix a specific problem for a specific + customer on a specific base version. Branches with gray versions + will typically become dead ends very quickly if not immediately. + </p> + </section> + + <section> <marker id="otp_17_0_app_versions"/> <title>OTP 17.0 Application Versions</title> <p>The following list details the application versions that |