diff options
585 files changed, 14913 insertions, 10263 deletions
diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000000..2b8f690c8d --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,14 @@ +;; Project-wide Emacs settings +( + (erlang-mode (indent-tabs-mode . nil)) + (autoconf-mode (indent-tabs-mode . nil)) + (java-mode (indent-tabs-mode . nil)) + (perl-mode (indent-tabs-mode . nil)) + (xml-mode (indent-tabs-mode . nil)) + ;; In C code indentation is 4 spaces and in C++ 2 spaces + (c++-mode + (indent-tabs-mode . nil) + (c-basic-offset . 2)) + (c-mode + (indent-tabs-mode . nil) + (c-basic-offset . 4))) diff --git a/.travis.yml b/.travis.yml index 43bf0c7fb5..42151a16d2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,11 +33,9 @@ script: after_success: - $ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools wx xmerl --statistics - - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts kernel stdlib --statistics - - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps asn1 crypto dialyzer --statistics - - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps hipe parsetools public_key --statistics - - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps runtime_tools sasl tools --statistics + - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts kernel stdlib asn1 crypto dialyzer hipe parsetools public_key runtime_tools sasl tools --statistics + - $ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc inets mnesia observer ssh ssl syntax_tools tools wx xmerl --statistics - ./otp_build tests && make release_docs after_script: - - cd $ERL_TOP/release/tests/test_server && $ERL_TOP/bin/erl -s ts install -s ts smoke_test batch -s init stop + - ./scripts/run-smoke-tests diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000000..328b9f7859 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,98 @@ +# Contributing to Erlang/OTP + +## Reporting a bug + +Report bugs at https://bugs.erlang.org. See [Bug reports](https://github.com/erlang/otp/wiki/Bug-reports) +for more information. + +## Submitting Pull Requests + +You can contribute to Erlang/OTP by opening a Pull Request. + +## Fixing a bug + +* In most cases, pull requests for bug fixes should be based on the `maint` branch. +There are exceptions, for example corrections to bugs that have been introduced in the `master` branch. + +* Include a test case to ensure that the bug is fixed **and that it stays fixed**. + +* TIP: Write the test case **before** fixing the bug so that you can know that it catches the bug. + +* For applications without a test suite in the git repository, it would be appreciated if you provide a +small code sample in the commit message or email a module that will provoke the failure. + +## Adding a new feature + +* In most cases, pull requests for new features should be based on the `master` branch. + +* It is recommended to discuss new features on +[the erlang-questions mailing list](http://erlang.org/mailman/listinfo/erlang-questions), +especially for major new features or any new features in ERTS, Kernel, or STDLIB. + +* It is important to write a good commit message explaining **why** the feature is needed. +We prefer that the information is in the commit message, so that anyone that want to know +two years later why a particular feature can easily find out. It does no harm to provide +the same information in the pull request (if the pull request consists of a single commit, +the commit message will be added to the pull request automatically). + +* With few exceptions, it is mandatory to write a new test case that tests the feature. +The test case is needed to ensure that the features does not stop working in the future. + +* Update the [Documentation](https://github.com/erlang/otp/wiki/Documentation) to describe the feature. + +* Make sure that the new feature builds and works on all major platforms. Exceptions are features +that only makes sense one some platforms, for example the `win32reg` module for accessing the Windows registry. + +* Make sure that your feature does not break backward compatibility. In general, we only break backward +compatibility in major releases and only for a very good reason. Usually we first deprecate the +feature one or two releases beforehand. + +* In general, language changes/extensions require an +[EEP (Erlang Enhancement Proposal)](https://github.com/erlang/eep) to be written and approved before they +can be included in OTP. Major changes or new features in ERTS, Kernel, or STDLIB will need an EEP or at least +a discussion on the mailing list. + +## Before you submit your pull request + +* Make sure existing test cases don't fail. It is not necessary to run all tests (that would take many hours), +but you should at least run the tests for the application you have changed. +See [Running tests](https://github.com/erlang/otp/wiki/Running-tests). + +Make sure that your branch contains clean commits: + +* Don't make the first line in the commit message longer than 72 characters. +**Don't end the first line with a period.** + +* Follow the guidelines for [Writing good commit messages](https://github.com/erlang/otp/wiki/Writing-good-commit-messages). + +* Don't merge `maint` or `master` into your branch. Use `git rebase` if you need to resolve merge +conflicts or include the latest changes. + +* To make it possible to use the powerful `git bisect` command, make sure that each commit can be +compiled and that it works. + +* Check for unnecessary whitespace before committing with `git diff --check`. + +Check your coding style: + +* Make sure your changes follow the coding and indentation style of the code surrounding your changes. + +* Do not commit commented-out code or files that are no longer needed. Remove the code or the files. + +* In most code (Erlang and C), indentation is 4 steps. Indentation using only spaces is **strongly recommended**. + +### Configuring Emacs + +If you use Emacs, use the Erlang mode, and add the following lines to `.emacs`: + + (setq-default indent-tabs-mode nil) + (setq c-basic-offset 4) + +If you want to change the setting only for the Erlang mode, you can use a hook like this: + +``` +(add-hook 'erlang-mode-hook 'my-erlang-hook) + +(defun my-erlang-hook () + (setq indent-tabs-mode nil)) +``` diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 4c0f9181b0..b7bcadace0 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 4c0f9181b0..b7bcadace0 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 12e0904316..8169505d78 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 95846cdda9..f7dfd8d707 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_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex f52d74d1dc..acba331476 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 ed0827953c..3d0d5112f8 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam Binary files differindex 0f85080a31..3428b2872e 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 f99e90ea72..56c0a7c05f 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_listing.beam b/bootstrap/lib/compiler/ebin/beam_listing.beam Binary files differindex 645440c85e..b80561b4dd 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_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam Binary files differindex f864c15ae1..bf80745ffe 100644 --- a/bootstrap/lib/compiler/ebin/beam_receive.beam +++ b/bootstrap/lib/compiler/ebin/beam_receive.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex f170552b8a..4d3b79a148 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 differindex 5435bcf26b..b4066184e3 100644 --- a/bootstrap/lib/compiler/ebin/beam_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex e45b4ef895..faa140278b 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 1b1e42b6b1..04ecddd284 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex a2c27861c4..49fe0727a8 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 721b86c92c..9837ed458b 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 237993f080..e91be8e4ad 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.0.2"}, + {vsn, "7.0.3"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex ece107faf7..64efd99314 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 e56ef9afd8..e0837207b9 100644 --- a/bootstrap/lib/compiler/ebin/core_scan.beam +++ b/bootstrap/lib/compiler/ebin/core_scan.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam Binary files differindex 47b804d61d..3d800738c9 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 180875b297..cd8fd5ac05 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_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam Binary files differindex 58dff1b796..eed59b6cfa 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 differindex 65f093a575..1db120e00e 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 9f5c4a45bf..1cc1a7e5dc 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 509ef4ffa0..e8c0466ddc 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam Binary files differindex 9ca23b0322..a9bc35fb04 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam Binary files differindex c88421ac14..12953c28d1 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 5a1bd059ae..f36399a927 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 cb1ac51ef2..70cb4e7eaa 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_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 5b3280c66d..37c844ec9b 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_distribution.beam b/bootstrap/lib/kernel/ebin/erl_distribution.beam Binary files differindex 198f23e14b..223cda0e59 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 0bd9f7e7c9..6da0de6b17 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex ac65edf298..75c94f8a9f 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 57587353aa..23da3a7982 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/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam Binary files differindex a76b19c23b..b5bb0806c8 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 ac0f44b7c8..078a0ffc9e 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/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam Binary files differindex dbcc995df7..a2ee6cd916 100644 --- a/bootstrap/lib/kernel/ebin/inet6_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex fc0c7b6bdc..1ffa8865ab 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_hosts.beam b/bootstrap/lib/kernel/ebin/inet_hosts.beam Binary files differindex 7278913418..958588c385 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 050773b052..2f941fff9e 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 6214372945..58c73842db 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_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam Binary files differindex b8fc4cfd74..4d23e1e876 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 60bb6e06ee..4af19d756e 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "5.1"}, + {vsn, "5.1.1"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam Binary files differindex f4b36af447..981eb737db 100644 --- a/bootstrap/lib/kernel/ebin/net_kernel.beam +++ b/bootstrap/lib/kernel/ebin/net_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam Binary files differindex d2527fe98c..a78e0e9c6e 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 86c3d7788e..aeb69e8fa3 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex 7a2e4901e9..a33e062d47 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex 865a9ac58c..481783bcd7 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 acd7620777..9bb16e070f 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 365ac16357..bda7aba167 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex 307940fb3d..81158b25b2 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_v8.beam b/bootstrap/lib/stdlib/ebin/dets_v8.beam Binary files differdeleted file mode 100644 index 2b6f3ac079..0000000000 --- a/bootstrap/lib/stdlib/ebin/dets_v8.beam +++ /dev/null diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex e77f609252..28997da899 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 f26c6e6bb1..a4e8f674f0 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 42ffaf8394..0bb6b7590a 100644 --- a/bootstrap/lib/stdlib/ebin/digraph.beam +++ b/bootstrap/lib/stdlib/ebin/digraph.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam Binary files differindex 0df86f15b4..459a98c959 100644 --- a/bootstrap/lib/stdlib/ebin/edlin.beam +++ b/bootstrap/lib/stdlib/ebin/edlin.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex d01cef0a9a..ae569ce9f8 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex e633572309..eff463adc0 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_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 665045daa8..4959f0d040 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 c7262358ec..9f241899e0 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_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex c8798a6094..9ebc1505f4 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_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam Binary files differindex d29dbf18fd..6dcc4fd3b2 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 b845a64248..181e44b3be 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 af784cf79d..a2a92d2960 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 096c28e969..2d04bab10c 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam Binary files differindex 01df81bb14..f7db5adc3e 100644 --- a/bootstrap/lib/stdlib/ebin/eval_bits.beam +++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 75fd7c7eed..996df071cf 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 65fa3a97ad..ea960fa1ab 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 3cb606350b..0c9c70a4d5 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 334e3649ae..a2627402ae 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_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 023366da29..80db66b438 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 0370d430b2..1b8d1a9bdc 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 ed71dcfeb7..665810bd7a 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 c795111f93..b2aed7e7ac 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_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam Binary files differindex c52bf42077..9378972324 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 0988b2c787..7877d2c73a 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/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex dd7a1f54ba..203ef5ba23 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 f04348f982..4624d2139a 100644 --- a/bootstrap/lib/stdlib/ebin/orddict.beam +++ b/bootstrap/lib/stdlib/ebin/orddict.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 0a69525558..27284851d1 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 25948e7878..865f549ac9 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 4bb2570dee..830a9ebb53 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 9ec7185f9e..c99b8d7bc1 100644 --- a/bootstrap/lib/stdlib/ebin/rand.beam +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam Binary files differindex fa0fa8c960..ae3d2d2f1f 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 88fa6f85a9..2122a5cd3b 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 0ac85cef0c..371ba299f0 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.1"}, + {vsn, "3.2"}, {modules, [array, base64, beam_lib, @@ -31,7 +31,6 @@ dets_server, dets_sup, dets_utils, - dets_v8, dets_v9, dict, digraph, diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex 582867f28a..2d044f637c 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam Binary files differindex c577b4f734..d0b805202e 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam Binary files differindex bd9b9751dd..7d7ad5e3b3 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 82b3907693..2fbaeba0b2 100644 --- a/bootstrap/lib/stdlib/include/assert.hrl +++ b/bootstrap/lib/stdlib/include/assert.hrl @@ -50,7 +50,8 @@ %% It is not possible to nest assert macros. -ifdef(NOASSERT). --define(assert(BoolExpr),ok). +-define(assert(BoolExpr), ok). +-define(assert(BoolExpr, Comment), ok). -else. %% The assert macro is written the way it is so as not to cause warnings %% for clauses that cannot match, even if the expression is a constant or @@ -73,11 +74,31 @@ end end)()) end). +-define(assert(BoolExpr, Comment), + begin + ((fun () -> + __T = is_process_alive(self()), % cheap source of truth + case (BoolExpr) of + __T -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??BoolExpr)}, + {expected, true}, + case not __T of + __V -> {value, false}; + _ -> {not_boolean, __V} + end]}) + end + end)()) + end). -endif. %% This is the inverse case of assert, for convenience. -ifdef(NOASSERT). -define(assertNot(BoolExpr),ok). +-define(assertNot(BoolExpr, Comment), ok). -else. -define(assertNot(BoolExpr), begin @@ -97,12 +118,32 @@ end end)()) end). +-define(assertNot(BoolExpr, Comment), + begin + ((fun () -> + __F = not is_process_alive(self()), + case (BoolExpr) of + __F -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??BoolExpr)}, + {expected, false}, + case not __F of + __V -> {value, true}; + _ -> {not_boolean, __V} + end]}) + end + end)()) + end). -endif. %% This is mostly a convenience which gives more detailed reports. %% Note: Guard is a guarded pattern, and can not be used for value. -ifdef(NOASSERT). -define(assertMatch(Guard, Expr), ok). +-define(assertMatch(Guard, Expr, Comment), ok). -else. -define(assertMatch(Guard, Expr), begin @@ -118,11 +159,27 @@ end end)()) end). +-define(assertMatch(Guard, Expr, Comment), + begin + ((fun () -> + case (Expr) of + Guard -> ok; + __V -> erlang:error({assertMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}) + end + end)()) + end). -endif. %% This is the inverse case of assertMatch, for convenience. -ifdef(NOASSERT). -define(assertNotMatch(Guard, Expr), ok). +-define(assertNotMatch(Guard, Expr, Comment), ok). -else. -define(assertNotMatch(Guard, Expr), begin @@ -139,12 +196,29 @@ end end)()) end). +-define(assertNotMatch(Guard, Expr, Comment), + begin + ((fun () -> + __V = (Expr), + case __V of + Guard -> erlang:error({assertNotMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}); + _ -> ok + end + end)()) + end). -endif. %% This is a convenience macro which gives more detailed reports when %% the expected LHS value is not a pattern, but a computed value -ifdef(NOASSERT). -define(assertEqual(Expect, Expr), ok). +-define(assertEqual(Expect, Expr, Comment), ok). -else. -define(assertEqual(Expect, Expr), begin @@ -161,11 +235,28 @@ end end)()) end). +-define(assertEqual(Expect, Expr, Comment), + begin + ((fun () -> + __X = (Expect), + case (Expr) of + __X -> ok; + __V -> erlang:error({assertEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {expected, __X}, + {value, __V}]}) + end + end)()) + end). -endif. %% This is the inverse case of assertEqual, for convenience. -ifdef(NOASSERT). -define(assertNotEqual(Unexpected, Expr), ok). +-define(assertNotEqual(Unexpected, Expr, Comment), ok). -else. -define(assertNotEqual(Unexpected, Expr), begin @@ -181,12 +272,28 @@ end end)()) end). +-define(assertNotEqual(Unexpected, Expr, Comment), + begin + ((fun () -> + __X = (Unexpected), + case (Expr) of + __X -> erlang:error({assertNotEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {value, __X}]}); + _ -> ok + end + end)()) + end). -endif. %% Note: Class and Term are patterns, and can not be used for value. %% Term can be a guarded pattern, but Class cannot. -ifdef(NOASSERT). -define(assertException(Class, Term, Expr), ok). +-define(assertException(Class, Term, Expr, Comment), ok). -else. -define(assertException(Class, Term, Expr), begin @@ -216,17 +323,54 @@ end end)()) end). +-define(assertException(Class, Term, Expr, Comment), + begin + ((fun () -> + try (Expr) of + __V -> erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_success, __V}]}) + catch + Class:Term -> ok; + __C:__T -> + erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace()}}]}) + end + end)()) + end). -endif. -define(assertError(Term, Expr), ?assertException(error, Term, Expr)). +-define(assertError(Term, Expr, Comment), + ?assertException(error, Term, Expr, Comment)). -define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). +-define(assertExit(Term, Expr, Comment), + ?assertException(exit, Term, Expr, Comment)). -define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). +-define(assertThrow(Term, Expr, Comment), + ?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. %% Both Class and Term can be guarded patterns. -ifdef(NOASSERT). -define(assertNotException(Class, Term, Expr), ok). +-define(assertNotException(Class, Term, Expr, Comment), ok). -else. -define(assertNotException(Class, Term, Expr), begin @@ -257,6 +401,36 @@ end end)()) end). +-define(assertNotException(Class, Term, Expr, Comment), + begin + ((fun () -> + try (Expr) of + _ -> ok + catch + __C:__T -> + case __C of + Class -> + case __T of + Term -> + erlang:error({assertNotException, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , " + ++(??Term)++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace() + }}]}); + _ -> ok + end; + _ -> ok + end + end + end)()) + end). -endif. -endif. % ASSERT_HRL diff --git a/erts/configure.in b/erts/configure.in index 98f3e6bcc5..e1233cee59 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -139,6 +139,13 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]), *) enable_dirty_schedulers=yes ;; esac ], enable_dirty_schedulers=default) +AC_ARG_ENABLE(dirty-schedulers-test, +AS_HELP_STRING([--enable-dirty-schedulers-test], [enable dirty scheduler test (for debugging purposes)]), +[ case "$enableval" in + yes) enable_dirty_schedulers_test=yes ;; + *) enable_dirty_schedulers_test=no ;; + esac ], enable_dirty_schedulers_test=no) + AC_ARG_ENABLE(smp-support, AS_HELP_STRING([--enable-smp-support], [enable smp support]) AS_HELP_STRING([--disable-smp-support], [disable smp support]), @@ -1050,6 +1057,22 @@ esac AC_MSG_RESULT($DIRTY_SCHEDULER_SUPPORT) AC_SUBST(DIRTY_SCHEDULER_SUPPORT) +DIRTY_SCHEDULER_TEST=$enable_dirty_schedulers_test +test $DIRTY_SCHEDULER_SUPPORT = yes || DIRTY_SCHEDULER_TEST=no +AC_SUBST(DIRTY_SCHEDULER_TEST) +test $DIRTY_SCHEDULER_TEST != yes || { + test -f "$ERL_TOP/erts/CONF_INFO" || echo "" > "$ERL_TOP/erts/CONF_INFO" + cat >> $ERL_TOP/erts/CONF_INFO <<EOF + + WARNING: + Dirty Scheduler Test has been enabled. This + feature is for debugging purposes only. + Poor performance as well as strange system + characteristics is expected! + +EOF +} + if test $ERTS_BUILD_SMP_EMU = yes; then if test $found_threads = no; then @@ -4285,8 +4308,7 @@ yes #include <stdio.h> #include <openssl/hmac.h>], [ - HMAC_CTX hc; - HMAC_CTX_init(&hc); + HMAC(0, 0, 0, 0, 0, 0, 0); ], [ssl_linkable=yes], [ssl_linkable=no]) @@ -4341,8 +4363,7 @@ dnl so it is - be adoptable #include <stdio.h> #include <openssl/hmac.h>], [ - HMAC_CTX hc; - HMAC_CTX_init(&hc); + HMAC(0, 0, 0, 0, 0, 0, 0); ], [ssl_dyn_linkable=yes], [ssl_dyn_linkable=no]) @@ -4447,12 +4468,14 @@ 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> -#ifndef OPENSSL_NO_KRB5 +#if OPENSSL_VERSION_NUMBER < 0x1010000fL && !defined(OPENSSL_NO_KRB5) yes #endif ],[ @@ -4603,8 +4626,7 @@ yes) # Use standard lib locations for ssl runtime library path #include <openssl/hmac.h> ], [ - HMAC_CTX hc; - HMAC_CTX_init(&hc); + HMAC(0, 0, 0, 0, 0, 0, 0); ], [rpath_success=yes], [rpath_success=no]) diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index ab00d47425..fe8e3b30e7 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -886,7 +886,7 @@ Rep(Fc) = <c>[Rep(C_1), ..., Rep(C_k)]</c>.</p> <list type="bulleted"> - <item>If C is a constraint <c>is_subtype(V, T)</c> or <c>V :: T</c>, + <item>If C is a constraint <c>V :: T</c>, where <c>V</c> is a type variable and <c>T</c> is a type, then Rep(C) = <c>{type,LINE,constraint,[{atom,LINE,is_subtype},[Rep(V),Rep(T)]]}</c>. diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index f2a55f6298..4e32118405 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -946,9 +946,7 @@ schedulers was allowed to be unlimited, dirty CPU bound jobs would potentially starve normal jobs.</p> <p>This option is ignored if the emulator does not have threading - support enabled. <em>This option is experimental</em> and - is supported only if the emulator was configured and built with - support for dirty schedulers enabled (it is disabled by default).</p> + support enabled.</p> </item> <tag><marker id="+SDPcpu"/><c><![CDATA[+SDPcpu DirtyCPUSchedulersPercentage:DirtyCPUSchedulersOnlinePercentage]]></c></tag> @@ -974,9 +972,7 @@ either order) results in 2 dirty CPU scheduler threads (50% of 4) and 1 dirty CPU scheduler thread online (25% of 4).</p> <p>This option is ignored if the emulator does not have threading - support enabled. <em>This option is experimental</em> and - is supported only if the emulator was configured and built with - support for dirty schedulers enabled (it is disabled by default).</p> + support enabled.</p> </item> <tag><marker id="+SDio"/><c><![CDATA[+SDio DirtyIOSchedulers]]></c></tag> <item> @@ -992,9 +988,7 @@ bound jobs on dirty I/O schedulers, these jobs might starve ordinary jobs executing on ordinary schedulers.</p> <p>This option is ignored if the emulator does not have threading - support enabled. <em>This option is experimental</em> and - is supported only if the emulator was configured and built with - support for dirty schedulers enabled (it is disabled by default).</p> + support enabled.</p> </item> <tag><c><![CDATA[+sFlag Value]]></c></tag> <item> @@ -1595,6 +1589,25 @@ </section> <section> + <marker id="signals"></marker> + <title>Signals</title> + <p>On Unix systems, the Erlang runtime will interpret two types of signals.</p> + <taglist> + <tag><c>SIGUSR1</c></tag> + <item> + <p>A <c>SIGUSR1</c> signal forces a crash dump.</p> + </item> + <tag><c>SIGTERM</c></tag> + <item> + <p>A <c>SIGTERM</c> will produce a <c>stop</c> message to the <c>init</c> process. + This is equivalent to a <c>init:stop/0</c> call.</p> + <p>Introduced in ERTS 8.3 (Erlang/OTP 19.3)</p> + </item> + </taglist> + <p>The signal <c>SIGUSR2</c> is reserved for internal usage. No other signals are handled.</p> + </section> + + <section> <marker id="configuration"></marker> <title>Configuration</title> <p>The standard Erlang/OTP system can be reconfigured to change the default diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 13b72863f3..8cdfc80879 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -123,7 +123,7 @@ ok "Hello world!"</code> <p>A better solution for a real module is to take advantage of the new - directive <c>on load</c> (see section + directive <c>on_load</c> (see section <seealso marker="doc/reference_manual:code_loading#on_load">Running a Function When a Module is Loaded</seealso> in the Erlang Reference Manual) to load the NIF library automatically when the module is @@ -135,27 +135,14 @@ ok away by the compiler, causing loading of the NIF library to fail.</p> </note> - <p>A loaded NIF library is tied to the Erlang module code version - that loaded it. If the module is upgraded with a new version, the - new Erlang code need to load its own NIF library (or maybe choose not - to). The new code version can, however, choose to load the - same NIF library as the old code if it wants to. Sharing the - dynamic library means that static data defined by the library - is shared as well. To avoid unintentionally shared static - data, each Erlang module code can keep its own private data. This - private data can be set when the NIF library is loaded and - then retrieved by calling <seealso marker="#enif_priv_data"> - <c>enif_priv_data</c></seealso>.</p> - - <p>A NIF library cannot be loaded explicitly. A library is - automatically unloaded when the module code that it belongs to is purged - by the code server.</p> + <p>Once loaded, a NIF library is persistent. It will not be unloaded + until the module code version that it belongs to is purged.</p> </description> <section> <title>Functionality</title> - <p>All functions that a NIF library needs to do with Erlang are - performed through the NIF API functions. Functions exist + <p>All interaction between NIF code and the Erlang runtime system is + performed by calling NIF API functions. Functions exist for the following functionality:</p> <taglist> @@ -286,6 +273,19 @@ return term;</code> library is postponed as long as there exist resource objects with a destructor function in the library.</p> </item> + <tag>Module upgrade and static data</tag> + <item> + <p>A loaded NIF library is tied to the Erlang module instance + that loaded it. If the module is upgraded, the new module instance + needs to load its own NIF library (or maybe choose not to). The new + module instance can, however, choose to load the exact same NIF library + as the old code if it wants to. Sharing the dynamic library means that + static data defined by the library is shared as well. To avoid + unintentionally shared static data between module instances, each Erlang + module version can keep its own private data. This private data can be + set when the NIF library is loaded and later retrieved by calling + <seealso marker="#enif_priv_data"><c>enif_priv_data</c></seealso>.</p> + </item> <tag>Threads and concurrency</tag> <item> <p>A NIF is thread-safe without any explicit synchronization as @@ -402,14 +402,14 @@ return term;</code> <tag><marker id="dirty_nifs"/>Dirty NIF</tag> <item> <note> - <p><em>The dirty NIF functionality described here - is experimental</em>. Dirty NIF support is available only when - the emulator is configured with dirty schedulers enabled. This - feature is disabled by default. The Erlang runtime - without SMP support does not support dirty schedulers even when - the dirty scheduler support is enabled. To check at runtime for - the presence of dirty scheduler threads, code can use the - <seealso marker="#enif_system_info"> + <p>Dirty NIF support is available only when the emulator is + configured with dirty scheduler support. As of ERTS version + 9.0, dirty scheduler support is enabled by default on the + runtime system with SMP support. The Erlang runtime without + SMP support does <em>not</em> support dirty schedulers even + when the dirty scheduler support is explicitly enabled. To + check at runtime for the presence of dirty scheduler threads, + code can use the <seealso marker="#enif_system_info"> <c>enif_system_info()</c></seealso> API function.</p> </note> <p>A NIF that cannot be split and cannot execute in a millisecond @@ -525,7 +525,7 @@ return term;</code> <p><c>load</c> is called when the NIF library is loaded and no previously loaded library exists for this module.</p> <p><c>*priv_data</c> can be set to point to some private data - that the library needs to keep a state between NIF + if the library needs to keep a state between NIF calls. <c>enif_priv_data</c> returns this pointer. <c>*priv_data</c> is initialized to <c>NULL</c> when <c>load</c> is called.</p> @@ -642,9 +642,6 @@ typedef struct { <p><c>flags</c> can be used to indicate that the NIF is a <seealso marker="#dirty_nifs">dirty NIF</seealso> that is to be executed on a dirty scheduler thread.</p> - <p><em>The dirty NIF functionality described here is - experimental.</em> You have to enable support for dirty - schedulers when building OTP to try out the functionality.</p> <p>If the dirty NIF is expected to be CPU-bound, its <c>flags</c> field is to be set to <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c> or <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c>.</p> @@ -2488,9 +2485,6 @@ enif_map_iterator_destroy(env, &iter);</code> application to break up long-running work into multiple regular NIF calls or to schedule a <seealso marker="#dirty_nifs"> dirty NIF</seealso> to execute on a dirty scheduler thread.</p> - <p><em>The dirty NIF functionality described here is - experimental.</em> You have to enable support for dirty - schedulers when building OTP to try out the functionality.</p> <taglist> <tag><c>fun_name</c></tag> <item> @@ -2501,7 +2495,7 @@ enif_map_iterator_destroy(env, &iter);</code> <tag><c>flags</c></tag> <item> <p>Must be set to <c>0</c> for a regular NIF. If the emulator was - built with the experimental dirty scheduler support enabled, + built with dirty scheduler support enabled, <c>flags</c> can be set to either <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c> if the job is expected to be CPU-bound, or <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c> for diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 3dad09365e..7815bfa510 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4933,7 +4933,9 @@ RealSystem = system + MissedSystem</code> <p>Returns the current call stack back-trace (<em>stacktrace</em>) of the process. The stack has the same format as returned by <seealso marker="#get_stacktrace/0"> - <c>erlang:get_stacktrace/0</c></seealso>.</p> + <c>erlang:get_stacktrace/0</c></seealso>. The depth of the + stacktrace is truncated according to the <c>backtrace_depth</c> + system flag setting.</p> </item> <tag><c>{dictionary, <anno>Dictionary</anno>}</c></tag> <item> @@ -6413,12 +6415,17 @@ lists:map( <c><anno>TotalTime</anno></c> is the total time duration since <seealso marker="#system_flag_scheduler_wall_time"> <c>scheduler_wall_time</c></seealso> - activation. The time unit is undefined and can be subject - to change between releases, OSs, and system restarts. - <c>scheduler_wall_time</c> is only to be used to - calculate relative values for scheduler-utilization. - <c><anno>ActiveTime</anno></c> can never exceed - <c><anno>TotalTime</anno></c>.</p> + activation for the specific scheduler. Note that + activation time can differ significantly between + schedulers. Currently dirty schedulers are activated + at system start while normal schedulers are activated + some time after the <c>scheduler_wall_time</c> + functionality is enabled. The time unit is undefined + and can be subject to change between releases, OSs, + and system restarts. <c>scheduler_wall_time</c> is only + to be used to calculate relative values for scheduler + utilization. <c><anno>ActiveTime</anno></c> can never + exceed <c><anno>TotalTime</anno></c>.</p> <p>The definition of a busy scheduler is when it is not idle and is not scheduling (selecting) a process or port, that is:</p> @@ -6436,15 +6443,37 @@ lists:map( <c>scheduler_wall_time</c></seealso> is turned off.</p> <p>The list of scheduler information is unsorted and can appear in different order between calls.</p> + <p>As of ERTS version 9.0, also dirty CPU schedulers will + be included in the result. That is, all scheduler threads + that are expected to handle CPU bound work. If you also + want information about dirty I/O schedulers, use + <seealso marker="#statistics_scheduler_wall_time_all"><c>statistics(scheduler_wall_time_all)</c></seealso> + instead.</p> + + <p>Normal schedulers will have scheduler identifiers in + the range <c>1 =< <anno>SchedulerId</anno> =< + </c><seealso marker="#system_info_schedulers"><c>erlang:system_info(schedulers)</c></seealso>. + Dirty CPU schedulers will have scheduler identifiers in + the range <c>erlang:system_info(schedulers) < + <anno>SchedulerId</anno> =< erlang:system_info(schedulers) + + + </c><seealso marker="#system_info_dirty_cpu_schedulers"><c>erlang:system_info(dirty_cpu_schedulers)</c></seealso>. + </p> + <note><p>The different types of schedulers handle + specific types of jobs. Every job is assigned to a specific + scheduler type. Jobs can migrate between different schedulers + of the same type, but never between schedulers of different + types. This fact has to be taken under consideration when + evaluating the result returned.</p></note> <p>Using <c>scheduler_wall_time</c> to calculate - scheduler-utilization:</p> + scheduler utilization:</p> <pre> > <input>erlang:system_flag(scheduler_wall_time, true).</input> false > <input>Ts0 = lists:sort(erlang:statistics(scheduler_wall_time)), ok.</input> ok</pre> <p>Some time later the user takes another snapshot and calculates - scheduler-utilization per scheduler, for example:</p> + scheduler utilization per scheduler, for example:</p> <pre> > <input>Ts1 = lists:sort(erlang:statistics(scheduler_wall_time)), ok.</input> ok @@ -6459,11 +6488,32 @@ ok {7,0.973237033077876}, {8,0.9741297293248656}]</pre> <p>Using the same snapshots to calculate a total - scheduler-utilization:</p> + scheduler utilization:</p> <pre> > <input>{A, T} = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}}, {Ai,Ti}) -> - {Ai + (A1 - A0), Ti + (T1 - T0)} end, {0, 0}, lists:zip(Ts0,Ts1)), A/T.</input> + {Ai + (A1 - A0), Ti + (T1 - T0)} end, {0, 0}, lists:zip(Ts0,Ts1)), + TotalSchedulerUtilization = A/T.</input> +0.9769136803764825</pre> + <p>Total scheduler utilization will equal <c>1.0</c> when + all schedulers have been active all the time between the + two measurements.</p> + <p>Another (probably more) useful value is to calculate + total scheduler utilization weighted against maximum amount + of available CPU time:</p> + <pre> +> <input>WeightedSchedulerUtilization = (TotalSchedulerUtilization + * (erlang:system_info(schedulers) + + erlang:system_info(dirty_cpu_schedulers))) + / erlang:system_info(logical_processors_available).</input> 0.9769136803764825</pre> + <p>This weighted scheduler utilization will reach <c>1.0</c> + when schedulers are active the same amount of time as + maximum available CPU time. If more schedulers exist + than available logical processors, this value may + be greater than <c>1.0</c>.</p> + <p>As of ERTS version 9.0, the Erlang runtime system + with SMP support will as default have more schedulers + than logical processors. This due to the dirty schedulers.</p> <note> <p><c>scheduler_wall_time</c> is by default disabled. To enable it, use @@ -6474,6 +6524,31 @@ ok <func> <name name="statistics" arity="1" clause_i="12"/> + <fsummary>Information about each schedulers work time.</fsummary> + <desc> + <marker id="statistics_scheduler_wall_time_all"></marker> + <p>The same as + <seealso marker="#statistics_scheduler_wall_time"><c>statistics(scheduler_wall_time)</c></seealso>, + except that it also include information about all dirty I/O + schedulers.</p> + <p>Dirty IO schedulers will have scheduler identifiers in + the range + <seealso marker="#system_info_schedulers"><c>erlang:system_info(schedulers)</c></seealso><c> + + + </c><seealso marker="#system_info_dirty_cpu_schedulers"><c>erlang:system_info(dirty_cpu_schedulers)</c></seealso><c> < + <anno>SchedulerId</anno> =< erlang:system_info(schedulers) + + erlang:system_info(dirty_cpu_schedulers) + + + </c><seealso marker="#system_info_dirty_io_schedulers"><c>erlang:system_info(dirty_io_schedulers)</c></seealso>.</p> + <note><p>Note that work executing on dirty I/O schedulers + are expected to mainly wait for I/O. That is, when you + get high scheduler utilization on dirty I/O schedulers, + CPU utilization is <em>not</em> expected to be high due to + this work.</p></note> + </desc> + </func> + <func> + <name name="statistics" arity="1" clause_i="13"/> <fsummary>Information about active processes and ports.</fsummary> <desc><marker id="statistics_total_active_tasks"></marker> <p>Returns the total amount of active processes and ports in @@ -6493,7 +6568,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="13"/> + <name name="statistics" arity="1" clause_i="14"/> <fsummary>Information about the run-queue lengths.</fsummary> <desc><marker id="statistics_total_run_queue_lengths"></marker> <p>Returns the total length of the run queues. That is, the number @@ -6513,7 +6588,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="14"/> + <name name="statistics" arity="1" clause_i="15"/> <fsummary>Information about wall clock.</fsummary> <desc> <p>Returns information about wall clock. <c>wall_clock</c> can @@ -6645,7 +6720,9 @@ ok <fsummary>Set system flag <c>backtrace_depth</c>.</fsummary> <desc> <p>Sets the maximum depth of call stack back-traces in the - exit reason element of <c>'EXIT'</c> tuples.</p> + exit reason element of <c>'EXIT'</c> tuples. The flag + also limits the stacktrace depth returned by <c>process_info</c> + item <c>current_stacktrace.</c></p> <p>Returns the old value of the flag.</p> </desc> </func> @@ -6717,11 +6794,6 @@ ok down to 3. Similarly, the number of dirty CPU schedulers online increases proportionally to increases in the number of schedulers online.</p> - <note> - <p>The dirty schedulers functionality is experimental. - Enable support for dirty schedulers when building OTP to - try out the functionality.</p> - </note> <p>For more information, see <seealso marker="#system_info_dirty_cpu_schedulers"> <c>erlang:system_info(dirty_cpu_schedulers)</c></seealso> and @@ -7224,8 +7296,8 @@ ok </func> <func> - <name name="system_info" arity="1" clause_i="11"/> <name name="system_info" arity="1" clause_i="12"/> + <name name="system_info" arity="1" clause_i="13"/> <fsummary>Information about the CPU topology of the system.</fsummary> <type name="cpu_topology"/> <type name="level_entry"/> @@ -7325,12 +7397,12 @@ ok </func> <func> - <name name="system_info" arity="1" clause_i="28"/> <name name="system_info" arity="1" clause_i="29"/> - <name name="system_info" arity="1" clause_i="37"/> + <name name="system_info" arity="1" clause_i="30"/> <name name="system_info" arity="1" clause_i="38"/> <name name="system_info" arity="1" clause_i="39"/> <name name="system_info" arity="1" clause_i="40"/> + <name name="system_info" arity="1" clause_i="41"/> <fsummary>Information about the default process heap settings.</fsummary> <type name="message_queue_data"/> <type name="max_heap_size"/> @@ -7408,7 +7480,7 @@ ok <name name="system_info" arity="1" clause_i="8"/> <name name="system_info" arity="1" clause_i="9"/> <name name="system_info" arity="1" clause_i="10"/> - <name name="system_info" arity="1" clause_i="13"/> + <name name="system_info" arity="1" clause_i="11"/> <name name="system_info" arity="1" clause_i="14"/> <name name="system_info" arity="1" clause_i="15"/> <name name="system_info" arity="1" clause_i="16"/> @@ -7423,14 +7495,14 @@ ok <name name="system_info" arity="1" clause_i="25"/> <name name="system_info" arity="1" clause_i="26"/> <name name="system_info" arity="1" clause_i="27"/> - <name name="system_info" arity="1" clause_i="30"/> + <name name="system_info" arity="1" clause_i="28"/> <name name="system_info" arity="1" clause_i="31"/> <name name="system_info" arity="1" clause_i="32"/> <name name="system_info" arity="1" clause_i="33"/> <name name="system_info" arity="1" clause_i="34"/> <name name="system_info" arity="1" clause_i="35"/> <name name="system_info" arity="1" clause_i="36"/> - <name name="system_info" arity="1" clause_i="41"/> + <name name="system_info" arity="1" clause_i="37"/> <name name="system_info" arity="1" clause_i="42"/> <name name="system_info" arity="1" clause_i="43"/> <name name="system_info" arity="1" clause_i="44"/> @@ -7460,11 +7532,18 @@ ok <name name="system_info" arity="1" clause_i="68"/> <name name="system_info" arity="1" clause_i="69"/> <name name="system_info" arity="1" clause_i="70"/> + <name name="system_info" arity="1" clause_i="71"/> <fsummary>Information about the system.</fsummary> <desc> <p>Returns various information about the current system (emulator) as specified by <c><anno>Item</anno></c>:</p> <taglist> + <tag><c>atom_count</c></tag> + <item> + <marker id="system_info_atom_count"></marker> + <p>Returns the number of atoms currently existing at the + local node. The value is given as an integer.</p> + </item> <tag><c>atom_limit</c></tag> <item> <marker id="system_info_atom_limit"></marker> @@ -7559,9 +7638,6 @@ ok <seealso marker="erts:erl#+SDcpu"><c>+SDcpu</c></seealso> or <seealso marker="erts:erl#+SDPcpu"><c>+SDPcpu</c></seealso> in <c>erl(1)</c>.</p> - <p>Notice that the dirty schedulers functionality is - experimental. Enable support for dirty schedulers when - building OTP to try out the functionality.</p> <p>See also <seealso marker="#system_flag_dirty_cpu_schedulers_online"> <c>erlang:system_flag(dirty_cpu_schedulers_online, @@ -7591,9 +7667,6 @@ ok startup by passing command-line flag <seealso marker="erts:erl#+SDcpu"><c>+SDcpu</c></seealso> in <c>erl(1)</c>.</p> - <p>Notice that the dirty schedulers functionality is - experimental. Enable support for dirty schedulers when - building OTP to try out the functionality.</p> <p>For more information, see <seealso marker="#system_info_dirty_cpu_schedulers"> <c>erlang:system_info(dirty_cpu_schedulers)</c></seealso>, @@ -7615,9 +7688,6 @@ ok <p>This value can be set at startup by passing command-line argument <seealso marker="erts:erl#+SDio"><c>+SDio</c></seealso> in <c>erl(1)</c>.</p> - <p>Notice that the dirty schedulers functionality is - experimental. Enable support for dirty schedulers when - building OTP to try out the functionality.</p> <p>For more information, see <seealso marker="#system_info_dirty_cpu_schedulers"> <c>erlang:system_info(dirty_cpu_schedulers)</c></seealso>, diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index dd260f2d1f..812538729d 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -32,6 +32,179 @@ <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 8.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix a quite rare bug causing VM crash during code loading + and the use of export funs (fun M:F/A) of not yet loaded + modules. Requires a very specfic timing of concurrent + scheduler threads. Has been seen on ARM but can probably + also occure on other architectures. Bug has existed since + OTP R16.</p> + <p> + Own Id: OTP-14144 Aux Id: seq13242 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 8.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed <c>configure</c> failures on MacOSX. Most important + <c>clock_gettime()</c> was detected when building for + MacOSX - El Capitan using XCode 8 despite it is not + available until MacOSX - Sierra.</p> + <p> + Own Id: OTP-13904 Aux Id: ERL-256 </p> + </item> + <item> + <p> + <c>code:add_pathsa/1</c> and command line option + <c>-pa</c> both revert the given list of directories when + adding it at the beginning of the code path. This is now + documented.</p> + <p> + Own Id: OTP-13920 Aux Id: ERL-267 </p> + </item> + <item> + <p> + Fix a compilation error of erts in OpenBSD related to the + usage of the __errno variable.</p> + <p> + Own Id: OTP-13927</p> + </item> + <item> + <p> + Fixed so that when enabling tracing on a process that had + an invalid tracer associated with it, the new tracer + overwrites the old tracer. Before this fix, calling + erlang:trace/3 would behave as if the tracer was still + alive and not apply the new trace.</p> + <p> + This fault was introduced in ERTS 8.0.</p> + <p> + Own Id: OTP-13928</p> + </item> + <item> + <p> + Fix parsing of <c>-profile_boot 'true' | 'false'</c></p> + <p> + Own Id: OTP-13955 Aux Id: ERL-280 </p> + </item> + <item> + <p> + A slight improvement of <c>erlang:get_stacktrace/0</c> + for exceptions raised in hipe compiled code. Beam + compiled functions in such stack trace was earlier + replaced by some unrelated function. They are now instead + omitted. This is an attempt to reduce the confusion in + the absence of a complete and correct stack trace for + mixed beam and hipe functions.</p> + <p> + Own Id: OTP-13992</p> + </item> + <item> + <p> Correct type declaration of match specification head. + </p> + <p> + Own Id: OTP-13996</p> + </item> + <item> + <p> + HiPE code loading failed for x86_64 if gcc was configured + with <c>--enable-default-pie</c>. Fixed by disabling PIE, + if needed for HiPE, when building the VM.</p> + <p> + Own Id: OTP-14031 Aux Id: ERL-294, PR-1239 </p> + </item> + <item> + <p> + Faulty arguments could be presented on exception from a + NIF that had rescheduled itself using + <c>enif_schedule_nif()</c>.</p> + <p> + Own Id: OTP-14048</p> + </item> + <item> + <p> + The runtime system could crash if a garbage collection on + a process was performed immediately after a NIF had been + rescheduled using <c>enif_schedule_nif()</c>.</p> + <p> + Own Id: OTP-14049</p> + </item> + <item> + <p> + A reference to purged code could be left undetected by + the purge operation if a process just had rescheduled a + NIF call using <c>enif_schedule_nif()</c> when the + process was checked. This could cause a runtime system + crash.</p> + <p> + Own Id: OTP-14050</p> + </item> + <item> + <p>Fixed a number of dirty scheduler related bugs:</p> + <list> <item><p>Process priority was not handled correct + when scheduling on a dirty scheduler.</p></item> + <item><p>The runtime system could crash when an exit + signal with a compound exit reason was sent to a process + executing on a dirty scheduler.</p></item> <item><p>The + runtime system crashed when call tracing a process + executing on a dirty scheduler.</p></item> <item><p>A + code purge operation could end up hanging forever when a + process executed on a dirty scheduler</p></item> </list> + <p> + Own Id: OTP-14051</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix minor soft purge race bug that could incorrectly + trigger code_server to load new code for the module if + the soft purge failed and no current version of the + module existed.</p> + <p> + Own Id: OTP-13925</p> + </item> + <item> + <p> + To ease troubleshooting, <c>erlang:load_nif/2</c> now + includes the return value from a failed call to + load/reload/upgrade in the text part of the error tuple. + The <c>crypto</c> NIF makes use of this feature by + returning the source line where/if the initialization + fails.</p> + <p> + Own Id: OTP-13951</p> + </item> + <item> + <p> + New environment variable <c>ERL_CRASH_DUMP_BYTES</c> can + be used to limit the size of crash dumps. If the limit is + reached, crash dump generation is aborted and the + generated file will be truncated.</p> + <p> + Own Id: OTP-14046</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 8.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index ce50022683..18fd7f320b 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -52,6 +52,7 @@ OMIT_OMIT_FP=no TYPE_LIBS= DIRTY_SCHEDULER_SUPPORT=@DIRTY_SCHEDULER_SUPPORT@ +DIRTY_SCHEDULER_TEST=@DIRTY_SCHEDULER_TEST@ ifeq ($(TYPE),debug) PURIFY = @@ -181,9 +182,24 @@ ENABLE_ALLOC_TYPE_VARS += smp nofrag M4FLAGS += -DERTS_SMP=1 ifeq ($(DIRTY_SCHEDULER_SUPPORT),yes) THR_DEFS += -DERTS_DIRTY_SCHEDULERS -endif +DS_SUPPORT=yes -else +ifeq ($(DIRTY_SCHEDULER_TEST),yes) +DS_TEST=yes +THR_DEFS += -DERTS_DIRTY_SCHEDULERS_TEST +else # DIRTY_SCHEDULER_TEST +DS_TEST=no +endif # DIRTY_SCHEDULER_TEST + +else # DIRTY_SCHEDULER_SUPPORT +DS_SUPPORT=no +DS_TEST=no +endif # DIRTY_SCHEDULER_SUPPORT + +else # FLAVOR + +DS_SUPPORT=no +DS_TEST=no # If flavor isn't one of the above, it *is* plain flavor... override FLAVOR=plain @@ -548,8 +564,10 @@ GENERATE += $(TTF_DIR)/OPCODES-GENERATED # bif and atom table ATOMS= beam/atom.names +DIRTY_BIFS = beam/erl_dirty_bif.tab BIFS = beam/bif.tab ifdef HIPE_ENABLED +HIPE=yes HIPE_ARCH64_TAB=hipe/hipe_bif64.tab HIPE_x86_TAB=hipe/hipe_x86.tab HIPE_amd64_TAB=hipe/hipe_amd64.tab $(HIPE_ARCH64_TAB) @@ -559,20 +577,26 @@ HIPE_ppc64_TAB=hipe/hipe_ppc64.tab $(HIPE_ARCH64_TAB) HIPE_arm_TAB=hipe/hipe_arm.tab HIPE_ARCH_TAB=$(HIPE_$(ARCH)_TAB) BIFS += hipe/hipe_bif0.tab hipe/hipe_bif1.tab hipe/hipe_bif2.tab $(HIPE_ARCH_TAB) -endif - -$(TARGET)/erl_bif_table.c \ -$(TARGET)/erl_bif_table.h \ -$(TARGET)/erl_bif_wrap.c \ -$(TARGET)/erl_bif_list.h \ -$(TARGET)/erl_gc_bifs.c \ -$(TARGET)/erl_atom_table.c \ -$(TARGET)/erl_atom_table.h \ - : $(TARGET)/TABLES-GENERATED -$(TARGET)/TABLES-GENERATED: $(ATOMS) $(BIFS) utils/make_tables - $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET)\ - $(ATOMS) $(BIFS) && echo $? >$(TARGET)/TABLES-GENERATED -GENERATE += $(TARGET)/TABLES-GENERATED +HIPE_NBIF_FILES=$(TTF_DIR)/hipe_nbif_impl.h $(TTF_DIR)/hipe_nbif_impl.c +else +HIPE=no +HIPE_NBIF_FILES= +endif + +$(TTF_DIR)/erl_bif_table.c \ +$(TTF_DIR)/erl_bif_table.h \ +$(TTF_DIR)/erl_bif_wrap.c \ +$(TTF_DIR)/erl_bif_list.h \ +$(TTF_DIR)/erl_atom_table.c \ +$(TTF_DIR)/erl_atom_table.h \ +$(TTF_DIR)/erl_guard_bifs.c \ +$(TTF_DIR)/erl_dirty_bif_wrap.c \ +$(HIPE_NBIF_FILES) \ + : $(TTF_DIR)/TABLES-GENERATED +$(TTF_DIR)/TABLES-GENERATED: $(ATOMS) $(DIRTY_BIFS) $(BIFS) utils/make_tables + $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TTF_DIR) -include $(TTF_DIR)\ + -ds $(DS_SUPPORT) -dst $(DS_TEST) -hipe $(HIPE) $(ATOMS) $(DIRTY_BIFS) $(BIFS) && echo $? >$(TTF_DIR)/TABLES-GENERATED +GENERATE += $(TTF_DIR)/TABLES-GENERATED $(TTF_DIR)/erl_alloc_types.h: beam/erl_alloc.types utils/make_alloc_types $(gen_verbose)LANG=C $(PERL) utils/make_alloc_types -src $< -dst $@ $(ENABLE_ALLOC_TYPE_VARS) @@ -750,8 +774,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_bif_info.o $(OBJDIR)/erl_bif_op.o \ $(OBJDIR)/erl_bif_os.o $(OBJDIR)/erl_bif_lists.o \ $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_unique.o \ - $(OBJDIR)/erl_bif_wrap.o \ - $(OBJDIR)/erl_gc_bifs.o \ + $(OBJDIR)/erl_bif_wrap.o $(OBJDIR)/erl_nfunc_sched.o \ + $(OBJDIR)/erl_guard_bifs.o $(OBJDIR)/erl_dirty_bif_wrap.o \ $(OBJDIR)/erl_trace.o $(OBJDIR)/copy.o \ $(OBJDIR)/utils.o $(OBJDIR)/bif.o \ $(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\ @@ -882,6 +906,7 @@ HIPE_noarch_OBJS= HIPE_ARCH_OBJS=$(HIPE_$(ARCH)_OBJS) HIPE_OBJS= \ + $(OBJDIR)/hipe_nbif_impl.o \ $(OBJDIR)/hipe_bif0.o \ $(OBJDIR)/hipe_bif1.o \ $(OBJDIR)/hipe_bif2.o \ @@ -917,7 +942,7 @@ $(OBJS): $(TTF_DIR)/GENERATED ######################################## # HiPE section -M4FLAGS += -DTARGET=$(TARGET) -DOPSYS=$(OPSYS) -DARCH=$(ARCH) +M4FLAGS += -DTARGET=$(TARGET) -DTTF_DIR=$(TTF_DIR) -DOPSYS=$(OPSYS) -DARCH=$(ARCH) $(TTF_DIR)/%.S: hipe/%.m4 $(m4_verbose)m4 $(M4FLAGS) $< > $@ @@ -938,7 +963,7 @@ $(BINDIR)/hipe_mkliterals$(TF_MARKER): $(OBJDIR)/hipe_mkliterals.o $(ld_verbose)$(CC) $(LDFLAGS) -o $@ $< $(TYPE_LIBS) $(OBJDIR)/hipe_mkliterals.o: $(HIPE_ASM) $(TTF_DIR)/erl_alloc_types.h $(DTRACE_HEADERS) \ - $(TTF_DIR)/OPCODES-GENERATED $(TARGET)/TABLES-GENERATED + $(TTF_DIR)/OPCODES-GENERATED $(TTF_DIR)/TABLES-GENERATED $(TTF_DIR)/hipe_literals.h: $(BINDIR)/hipe_mkliterals$(TF_MARKER) $(gen_verbose)$(BINDIR)/hipe_mkliterals$(TF_MARKER) -c > $@ @@ -947,7 +972,7 @@ $(OBJDIR)/hipe_x86_glue.o: hipe/hipe_x86_glue.S \ $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_literals.h \ hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_x86_bifs.S: hipe/hipe_x86_bifs.m4 hipe/hipe_x86_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_x86_bifs.o: $(TTF_DIR)/hipe_x86_bifs.S \ $(TTF_DIR)/hipe_literals.h @@ -955,7 +980,7 @@ $(OBJDIR)/hipe_amd64_glue.o: hipe/hipe_amd64_glue.S \ $(TTF_DIR)/hipe_amd64_asm.h $(TTF_DIR)/hipe_literals.h \ hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_amd64_bifs.S: hipe/hipe_amd64_bifs.m4 hipe/hipe_amd64_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_amd64_bifs.o: $(TTF_DIR)/hipe_amd64_bifs.S \ $(TTF_DIR)/hipe_literals.h @@ -963,21 +988,21 @@ $(OBJDIR)/hipe_sparc_glue.o: hipe/hipe_sparc_glue.S \ $(TTF_DIR)/hipe_sparc_asm.h hipe/hipe_mode_switch.h \ $(TTF_DIR)/hipe_literals.h $(TTF_DIR)/hipe_sparc_bifs.S: hipe/hipe_sparc_bifs.m4 hipe/hipe_sparc_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_sparc_bifs.o: $(TTF_DIR)/hipe_sparc_bifs.S \ $(TTF_DIR)/hipe_literals.h $(OBJDIR)/hipe_ppc_glue.o: hipe/hipe_ppc_glue.S $(TTF_DIR)/hipe_ppc_asm.h \ hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h $(TTF_DIR)/hipe_ppc_bifs.S: hipe/hipe_ppc_bifs.m4 hipe/hipe_ppc_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_ppc_bifs.o: $(TTF_DIR)/hipe_ppc_bifs.S \ $(TTF_DIR)/hipe_literals.h $(OBJDIR)/hipe_arm_glue.o: hipe/hipe_arm_glue.S $(TTF_DIR)/hipe_arm_asm.h \ hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h $(TTF_DIR)/hipe_arm_bifs.S: hipe/hipe_arm_bifs.m4 hipe/hipe_arm_asm.m4 \ - hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h + hipe/hipe_bif_list.m4 $(TTF_DIR)/erl_bif_list.h hipe/hipe_gbif_list.h $(OBJDIR)/hipe_arm_bifs.o: $(TTF_DIR)/hipe_arm_bifs.S \ $(TTF_DIR)/hipe_literals.h diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index b47739059b..2b5ad097a0 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -199,7 +199,7 @@ atom_alloc(Atom* tmpl) static void atom_free(Atom* obj) { - erts_free(ERTS_ALC_T_ATOM, (void*) obj); + ASSERT(obj->slot.index == atom_val(am_ErtsSecretAtom)); } static void latin1_to_utf8(byte* conv_buf, const byte** srcp, int* lenp) @@ -467,6 +467,9 @@ init_atom_table(void) atom_space -= a.len; atom_tab(ix)->name = (byte*)erl_atom_names[i]; } + + /* Hide am_ErtsSecretAtom */ + hash_erase(&erts_atom_table.htable, atom_tab(atom_val(am_ErtsSecretAtom))); } void diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h index f3b21e1687..abd3b44993 100644 --- a/erts/emulator/beam/atom.h +++ b/erts/emulator/beam/atom.h @@ -133,8 +133,6 @@ int atom_table_sz(void); /* table size in bytes, excluding stored objects */ Eterm am_atom_put(const char*, int); /* ONLY 7-bit ascii! */ Eterm erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc); -int atom_erase(byte*, int); -int atom_static_put(byte*, int); void init_atom_table(void); void atom_info(fmtfn_t, void *); void dump_atoms(fmtfn_t, void *); diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 66af05c1f2..dd0a42b5ba 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -59,6 +59,9 @@ atom nocatch atom undefined_function atom undefined_lambda +# Secret internal atom that can never be found by string lookup +# and should never leak out to be seen by the user. +atom ErtsSecretAtom='3RT$' # All other atoms. Try to keep the order alphabetic. # @@ -73,6 +76,7 @@ atom ac atom accessor atom active atom active_tasks +atom alive atom all atom all_but_first atom all_names @@ -196,10 +200,15 @@ atom dexit atom depth atom dgroup_leader atom dictionary +atom dirty_bif_exception +atom dirty_bif_result +atom dirty_bif_trap atom dirty_cpu atom dirty_cpu_schedulers_online atom dirty_execution atom dirty_io +atom dirty_nif_exception +atom dirty_nif_finalizer atom disable_trace atom disabled atom discard @@ -240,6 +249,7 @@ atom ERROR='ERROR' atom error_handler atom error_logger atom erts_code_purger +atom erts_debug atom erts_internal atom ets atom ETS_TRANSFER='ETS-TRANSFER' @@ -564,12 +574,15 @@ atom safe atom save_calls atom scheduler atom scheduler_id +atom scheduler_wall_time +atom scheduler_wall_time_all atom schedulers_online atom scheme atom scientific atom scope atom second atom seconds +atom send atom send_to_non_existing_process atom sensitive atom sequential_tracer @@ -662,11 +675,11 @@ atom value atom values atom version atom visible +atom wait atom waiting atom wall_clock atom warning atom warning_msg -atom scheduler_wall_time atom wordsize atom write_concurrency atom xor diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 5c3565f498..c8dde8caf8 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -36,6 +36,7 @@ #include "erl_nif.h" #include "erl_bits.h" #include "erl_thr_progress.h" +#include "erl_nfunc_sched.h" #ifdef HIPE # include "hipe_bif0.h" # define IF_HIPE(X) (X) @@ -670,7 +671,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1) } else if (modp->old.code_hdr) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, "Module %T must be purged before loading\n", + erts_dsprintf(dsbufp, "Module %T must be purged before deleting\n", BIF_ARG_1); erts_send_error_to_logger(BIF_P->group_leader, dsbufp); ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); @@ -806,7 +807,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) } if (BIF_ARG_2 == am_true) { - int i; + int i, num_exps; /* * Make the code with the on_load function current. @@ -822,7 +823,8 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) /* * The on_load function succeded. Fix up export entries. */ - for (i = 0; i < export_list_size(code_ix); i++) { + num_exps = export_list_size(code_ix); + for (i = 0; i < num_exps; i++) { Export *ep = export_list(i,code_ix); if (ep == NULL || ep->info.mfa.module != BIF_ARG_1) { continue; @@ -845,14 +847,15 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) hipe_redirect_to_module(modp); #endif } else if (BIF_ARG_2 == am_false) { - int i; + int i, num_exps; /* * The on_load function failed. Remove references to the * code that is about to be purged from the export entries. */ - for (i = 0; i < export_list_size(code_ix); i++) { + num_exps = export_list_size(code_ix); + for (i = 0; i < num_exps; i++) { Export *ep = export_list(i,code_ix); if (ep == NULL || ep->info.mfa.module != BIF_ARG_1) { continue; @@ -912,7 +915,7 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed la = ERTS_COPY_LITERAL_AREA(); if (!la) - return am_ok; + goto return_ok; oh = la->off_heap; literals = (char *) &la->start[0]; @@ -976,6 +979,11 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed * this is not completely certain). We go for * the GC directly instead of scanning everything * one more time... + * + * Also note that calling functions expect a + * major GC to be performed if gc_allowed is set + * to true. If you change this, you need to fix + * callers... */ goto literal_gc; } @@ -998,6 +1006,12 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed if (any_heap_refs(c_p->heap, c_p->htop, literals, lit_bsize)) goto literal_gc; *redsp += 1; + if (c_p->abandoned_heap) { + if (any_heap_refs(c_p->abandoned_heap, c_p->abandoned_heap + c_p->heap_sz, + literals, lit_bsize)) + goto literal_gc; + *redsp += 1; + } if (any_heap_refs(c_p->old_heap, c_p->old_htop, literals, lit_bsize)) goto literal_gc; @@ -1044,6 +1058,13 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed } } +return_ok: + +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p))) + c_p->flags &= ~F_DIRTY_CLA; +#endif + return am_ok; literal_gc: @@ -1054,13 +1075,13 @@ literal_gc: if (c_p->flags & F_DISABLE_GC) return THE_NON_VALUE; - FLAGS(c_p) |= F_NEED_FULLSWEEP; - - *redsp += erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, c_p->arity, fcalls); - - erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize, oh); + *redsp += erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize, + oh, fcalls); - *redsp += lit_bsize / 64; /* Need, better value... */ +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->flags & F_DIRTY_CLA) + return THE_NON_VALUE; +#endif return am_ok; } @@ -1099,6 +1120,11 @@ check_process_code(Process* rp, Module* modp, int *redsp, int fcalls) if (erts_check_nif_export_in_area(rp, mod_start, mod_size)) return am_true; + *redsp += 1; + + if (erts_check_nif_export_in_area(rp, mod_start, mod_size)) + return am_true; + *redsp += (STACK_START(rp) - rp->stop) / 32; /* @@ -1777,9 +1803,9 @@ delete_code(Module* modp) { ErtsCodeIndex code_ix = erts_staging_code_ix(); Eterm module = make_atom(modp->module); - int i; + int i, num_exps = export_list_size(code_ix); - for (i = 0; i < export_list_size(code_ix); i++) { + for (i = 0; i < num_exps; i++) { Export *ep = export_list(i, code_ix); if (ep != NULL && (ep->info.mfa.module == module)) { if (ep->addressv[code_ix] == ep->beam) { diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 73158205b3..27329a339e 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -32,6 +32,7 @@ #include "erl_binary.h" #include "beam_bp.h" #include "erl_term.h" +#include "erl_nfunc_sched.h" /* ************************************************************************* ** Macros @@ -74,6 +75,9 @@ extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ erts_smp_atomic32_t erts_active_bp_index; erts_smp_atomic32_t erts_staging_bp_index; +#ifdef ERTS_DIRTY_SCHEDULERS +erts_smp_mtx_t erts_dirty_bp_ix_mtx; +#endif /* * Inlined helpers @@ -85,6 +89,31 @@ get_mtime(Process *c_p) return erts_get_monotonic_time(erts_proc_sched_data(c_p)); } +static ERTS_INLINE Uint32 +acquire_bp_sched_ix(Process *c_p) +{ + ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); + ASSERT(esdp); +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx); + return (Uint32) erts_no_schedulers; + } +#endif + return (Uint32) esdp->no - 1; +} + +static ERTS_INLINE void +release_bp_sched_ix(Uint32 ix) +{ +#ifdef ERTS_DIRTY_SCHEDULERS + if (ix == (Uint32) erts_no_schedulers) + erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx); +#endif +} + + + /* ************************************************************************* ** Local prototypes */ @@ -135,6 +164,9 @@ void erts_bp_init(void) { erts_smp_atomic32_init_nob(&erts_active_bp_index, 0); erts_smp_atomic32_init_nob(&erts_staging_bp_index, 1); +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index"); +#endif } @@ -774,6 +806,30 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) result = func(p, args, I); + if (erts_nif_export_check_save_trace(p, result, + applying, ep, + cp, flags, + flags_meta, I, + meta_tracer)) { + /* + * erts_bif_trace_epilogue() will be called + * later when appropriate via the NIF export + * scheduling functionality... + */ + return result; + } + + return erts_bif_trace_epilogue(p, result, applying, ep, cp, + flags, flags_meta, I, + meta_tracer); +} + +Eterm +erts_bif_trace_epilogue(Process *p, Eterm result, int applying, + Export* ep, BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer) +{ if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) { BeamInstr i_return_trace = beam_return_trace[0]; BeamInstr i_return_to_trace = beam_return_to_trace[0]; @@ -983,6 +1039,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; BpDataTime *pbdt = NULL; + Uint32 six = acquire_bp_sched_ix(c_p); ASSERT(c_p); ASSERT(erts_smp_atomic32_read_acqb(&c_p->state) & (ERTS_PSFLG_RUNNING @@ -990,7 +1047,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) /* get previous timestamp and breakpoint * from the process psd */ - + pbt = ERTS_PROC_GET_CALL_TIME(c_p); time = get_mtime(c_p); @@ -1016,7 +1073,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) /* if null then the breakpoint was removed */ if (pbdt) { - h = &(pbdt->hash[bp_sched2ix_proc(c_p)]); + h = &(pbdt->hash[six]); ASSERT(h); ASSERT(h->item); @@ -1037,7 +1094,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) /* this breakpoint */ ASSERT(bdt); - h = &(bdt->hash[bp_sched2ix_proc(c_p)]); + h = &(bdt->hash[six]); ASSERT(h); ASSERT(h->item); @@ -1051,6 +1108,8 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt) pbt->ci = info; pbt->time = time; + + release_bp_sched_ix(six); } void @@ -1061,6 +1120,7 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci) bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; BpDataTime *pbdt = NULL; + Uint32 six = acquire_bp_sched_ix(p); ASSERT(p); ASSERT(erts_smp_atomic32_read_acqb(&p->state) & (ERTS_PSFLG_RUNNING @@ -1081,6 +1141,7 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci) */ if (pbt) { + /* might have been removed due to * trace_pattern(false) */ @@ -1095,7 +1156,8 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci) /* beware, the trace_pattern might have been removed */ if (pbdt) { - h = &(pbdt->hash[bp_sched2ix_proc(p)]); + + h = &(pbdt->hash[six]); ASSERT(h); ASSERT(h->item); @@ -1106,11 +1168,15 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci) } else { BP_TIME_ADD(item, &sitem); } + } pbt->ci = ci; pbt->time = time; + } + + release_bp_sched_ix(six); } int @@ -1362,6 +1428,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; BpDataTime *pbdt = NULL; + Uint32 six = acquire_bp_sched_ix(p); ASSERT(p); @@ -1384,7 +1451,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { sitem.pid = p->common.id; sitem.count = 0; - h = &(pbdt->hash[bp_sched2ix_proc(p)]); + h = &(pbdt->hash[six]); ASSERT(h); ASSERT(h->item); @@ -1410,6 +1477,8 @@ void erts_schedule_time_break(Process *p, Uint schedule) { break; } } /* pbt */ + + release_bp_sched_ix(six); } /* ************************************************************************* @@ -1526,7 +1595,11 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, ASSERT((bp->flags & ERTS_BPF_TIME_TRACE) == 0); bdt = Alloc(sizeof(BpDataTime)); erts_refc_init(&bdt->refc, 1); - bdt->n = erts_no_total_schedulers; +#ifdef ERTS_DIRTY_SCHEDULERS + bdt->n = erts_no_schedulers + 1; +#else + bdt->n = erts_no_schedulers; +#endif bdt->hash = Alloc(sizeof(bp_time_hash_t)*(bdt->n)); for (i = 0; i < bdt->n; i++) { bp_hash_init(&(bdt->hash[i]), 32); diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index 224b46407d..cccd395e0a 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -79,10 +79,8 @@ typedef struct generic_bp { #define ERTS_BP_CALL_TIME_SCHEDULE_OUT (1) #define ERTS_BP_CALL_TIME_SCHEDULE_EXITING (2) -#ifdef ERTS_SMP -#define bp_sched2ix_proc(p) (erts_proc_sched_data(p)->thr_id - 1) -#else -#define bp_sched2ix_proc(p) (0) +#ifdef ERTS_DIRTY_SCHEDULERS +extern erts_smp_mtx_t erts_dirty_bp_ix_mtx; #endif enum erts_break_op{ diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index e72d7f8de4..8326d348af 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -39,6 +39,7 @@ #include "beam_bp.h" #include "erl_binary.h" #include "erl_thr_progress.h" +#include "erl_nfunc_sched.h" #ifdef ARCH_64 # define HEXF "%016bpX" @@ -764,3 +765,356 @@ static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif) erts_print(to, to_arg, "%T/%u", name, arity); } } + +/* + * Dirty BIF testing. + * + * The erts_debug:dirty_cpu/2, erts_debug:dirty_io/1, and + * erts_debug:dirty/3 BIFs are used by the dirty_bif_SUITE + * test suite. + */ + +#ifdef ERTS_DIRTY_SCHEDULERS +static int ms_wait(Process *c_p, Eterm etimeout, int busy); +static int dirty_send_message(Process *c_p, Eterm to, Eterm tag); +#endif +static BIF_RETTYPE dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I); + +/* + * erts_debug:dirty_cpu/2 is statically determined to execute on + * a dirty CPU scheduler (see erts_dirty_bif.tab). + */ +BIF_RETTYPE +erts_debug_dirty_cpu_2(BIF_ALIST_2) +{ + return dirty_test(BIF_P, am_dirty_cpu, BIF_ARG_1, BIF_ARG_2, BIF_I); +} + +/* + * erts_debug:dirty_io/2 is statically determined to execute on + * a dirty I/O scheduler (see erts_dirty_bif.tab). + */ +BIF_RETTYPE +erts_debug_dirty_io_2(BIF_ALIST_2) +{ + return dirty_test(BIF_P, am_dirty_io, BIF_ARG_1, BIF_ARG_2, BIF_I); +} + +/* + * erts_debug:dirty/3 executes on a normal scheduler. + */ +BIF_RETTYPE +erts_debug_dirty_3(BIF_ALIST_3) +{ +#ifdef ERTS_DIRTY_SCHEDULERS + Eterm argv[2]; + switch (BIF_ARG_1) { + case am_normal: + return dirty_test(BIF_P, am_normal, BIF_ARG_2, BIF_ARG_3, BIF_I); + case am_dirty_cpu: + argv[0] = BIF_ARG_2; + argv[1] = BIF_ARG_3; + return erts_schedule_bif(BIF_P, + argv, + BIF_I, + erts_debug_dirty_cpu_2, + ERTS_SCHED_DIRTY_CPU, + am_erts_debug, + am_dirty_cpu, + 2); + case am_dirty_io: + argv[0] = BIF_ARG_2; + argv[1] = BIF_ARG_3; + return erts_schedule_bif(BIF_P, + argv, + BIF_I, + erts_debug_dirty_io_2, + ERTS_SCHED_DIRTY_IO, + am_erts_debug, + am_dirty_io, + 2); + default: + BIF_ERROR(BIF_P, EXC_BADARG); + } +#else + BIF_ERROR(BIF_P, EXC_UNDEF); +#endif +} + + +static BIF_RETTYPE +dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I) +{ + BIF_RETTYPE ret; +#ifdef ERTS_DIRTY_SCHEDULERS + if (am_scheduler == arg1) { + ErtsSchedulerData *esdp; + if (arg2 != am_type) + goto badarg; + esdp = erts_proc_sched_data(c_p); + if (!esdp) + ERTS_BIF_PREP_RET(ret, am_error); + else if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) + ERTS_BIF_PREP_RET(ret, am_normal); + else if (ERTS_SCHEDULER_IS_DIRTY_CPU(esdp)) + ERTS_BIF_PREP_RET(ret, am_dirty_cpu); + else if (ERTS_SCHEDULER_IS_DIRTY_IO(esdp)) + ERTS_BIF_PREP_RET(ret, am_dirty_io); + else + ERTS_BIF_PREP_RET(ret, am_error); + } + else if (am_error == arg1) { + switch (arg2) { + case am_notsup: + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOTSUP); + break; + case am_undef: + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF); + break; + case am_badarith: + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_BADARITH); + break; + case am_noproc: + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOPROC); + break; + case am_system_limit: + ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT); + break; + case am_badarg: + default: + goto badarg; + } + } + else if (am_copy == arg1) { + int i; + Eterm res; + + for (res = NIL, i = 0; i < 1000; i++) { + Eterm *hp, sz; + Eterm cpy; + /* We do not want this to be optimized, + but rather the oposite... */ + sz = size_object(arg2); + hp = HAlloc(c_p, sz); + cpy = copy_struct(arg2, sz, &hp, &c_p->off_heap); + hp = HAlloc(c_p, 2); + res = CONS(hp, cpy, res); + } + + ERTS_BIF_PREP_RET(ret, res); + } + else if (am_send == arg1) { + dirty_send_message(c_p, arg2, am_ok); + ERTS_BIF_PREP_RET(ret, am_ok); + } + else if (ERTS_IS_ATOM_STR("wait", arg1)) { + if (!ms_wait(c_p, arg2, type == am_dirty_cpu)) + goto badarg; + ERTS_BIF_PREP_RET(ret, am_ok); + } + else if (ERTS_IS_ATOM_STR("reschedule", arg1)) { + /* + * Reschedule operation after decrement of two until we reach + * zero. Switch between dirty scheduler types when 'n' is + * evenly divided by 4. If the initial value wasn't evenly + * dividable by 2, throw badarg exception. + */ + Eterm next_type; + Sint n; + if (!term_to_Sint(arg2, &n) || n < 0) + goto badarg; + if (n == 0) + ERTS_BIF_PREP_RET(ret, am_ok); + else { + Eterm argv[3]; + Eterm eint = erts_make_integer((Uint) (n - 2), c_p); + if (n % 4 != 0) + next_type = type; + else { + switch (type) { + case am_dirty_cpu: next_type = am_dirty_io; break; + case am_dirty_io: next_type = am_normal; break; + case am_normal: next_type = am_dirty_cpu; break; + default: goto badarg; + } + } + switch (next_type) { + case am_dirty_io: + argv[0] = arg1; + argv[1] = eint; + ret = erts_schedule_bif(c_p, + argv, + I, + erts_debug_dirty_io_2, + ERTS_SCHED_DIRTY_IO, + am_erts_debug, + am_dirty_io, + 2); + break; + case am_dirty_cpu: + argv[0] = arg1; + argv[1] = eint; + ret = erts_schedule_bif(c_p, + argv, + I, + erts_debug_dirty_cpu_2, + ERTS_SCHED_DIRTY_CPU, + am_erts_debug, + am_dirty_cpu, + 2); + break; + case am_normal: + argv[0] = am_normal; + argv[1] = arg1; + argv[2] = eint; + ret = erts_schedule_bif(c_p, + argv, + I, + erts_debug_dirty_3, + ERTS_SCHED_NORMAL, + am_erts_debug, + am_dirty, + 3); + break; + default: + goto badarg; + } + } + } + else if (ERTS_IS_ATOM_STR("ready_wait6_done", arg1)) { + ERTS_DECL_AM(ready); + ERTS_DECL_AM(done); + dirty_send_message(c_p, arg2, AM_ready); + ms_wait(c_p, make_small(6000), 0); + dirty_send_message(c_p, arg2, AM_done); + ERTS_BIF_PREP_RET(ret, am_ok); + } + else if (ERTS_IS_ATOM_STR("alive_waitexiting", arg1)) { + Process *real_c_p = erts_proc_shadow2real(c_p); + Eterm *hp, *hp2; + Uint sz; + int i; + ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); + int dirty_io = esdp->type == ERTS_SCHED_DIRTY_IO; + + if (ERTS_PROC_IS_EXITING(real_c_p)) + goto badarg; + dirty_send_message(c_p, arg2, am_alive); + + /* Wait until dead */ + while (!ERTS_PROC_IS_EXITING(real_c_p)) { + if (dirty_io) + ms_wait(c_p, make_small(100), 0); + else + erts_thr_yield(); + } + + ms_wait(c_p, make_small(1000), 0); + + /* Should still be able to allocate memory */ + hp = HAlloc(c_p, 3); /* Likely on heap */ + sz = 10000; + hp2 = HAlloc(c_p, sz); /* Likely in heap fragment */ + *hp2 = make_pos_bignum_header(sz); + for (i = 1; i < sz; i++) + hp2[i] = (Eterm) 4711; + ERTS_BIF_PREP_RET(ret, TUPLE2(hp, am_ok, make_big(hp2))); + } + else { + badarg: + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + } +#else + ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF); +#endif + return ret; +} + +#ifdef ERTS_DIRTY_SCHEDULERS + +static int +dirty_send_message(Process *c_p, Eterm to, Eterm tag) +{ + ErtsProcLocks c_p_locks, rp_locks; + Process *rp, *real_c_p; + Eterm msg, *hp; + ErlOffHeap *ohp; + ErtsMessage *mp; + + ASSERT(is_immed(tag)); + + real_c_p = erts_proc_shadow2real(c_p); + if (real_c_p != c_p) + c_p_locks = 0; + else + c_p_locks = ERTS_PROC_LOCK_MAIN; + + ASSERT(real_c_p->common.id == c_p->common.id); + + rp = erts_pid2proc_opt(real_c_p, c_p_locks, + to, 0, + ERTS_P2P_FLG_INC_REFC); + + if (!rp) + return 0; + + rp_locks = 0; + mp = erts_alloc_message_heap(rp, &rp_locks, 3, &hp, &ohp); + + msg = TUPLE2(hp, tag, c_p->common.id); + erts_queue_message(rp, rp_locks, mp, msg, c_p->common.id); + + if (rp == real_c_p) + rp_locks &= ~c_p_locks; + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + + erts_proc_dec_refc(rp); + + return 1; +} + +static int +ms_wait(Process *c_p, Eterm etimeout, int busy) +{ + ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); + ErtsMonotonicTime time, timeout_time; + Sint64 ms; + + if (!term_to_Sint64(etimeout, &ms)) + return 0; + + time = erts_get_monotonic_time(esdp); + + if (ms < 0) + timeout_time = time; + else + timeout_time = time + ERTS_MSEC_TO_MONOTONIC(ms); + + while (time < timeout_time) { + if (busy) + erts_thr_yield(); + else { + ErtsMonotonicTime timeout = timeout_time - time; + +#ifdef __WIN32__ + Sleep((DWORD) ERTS_MONOTONIC_TO_MSEC(timeout)); +#else + { + ErtsMonotonicTime to = ERTS_MONOTONIC_TO_USEC(timeout); + struct timeval tv; + + tv.tv_sec = (long) to / (1000*1000); + tv.tv_usec = (long) to % (1000*1000); + + select(0, NULL, NULL, NULL, &tv); + } +#endif + } + + time = erts_get_monotonic_time(esdp); + } + return 1; +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 613bd5c14e..85d92321b8 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -38,6 +38,7 @@ #include "beam_bp.h" #include "beam_catches.h" #include "erl_thr_progress.h" +#include "erl_nfunc_sched.h" #ifdef HIPE #include "hipe_mode_switch.h" #include "hipe_bif1.h" @@ -214,6 +215,7 @@ BeamInstr beam_continue_exit[1]; BeamInstr* em_call_error_handler; BeamInstr* em_apply_bif; BeamInstr* em_call_nif; +BeamInstr* em_call_bif_e; /* NOTE These should be the only variables containing trace instructions. @@ -633,21 +635,34 @@ void** beam_ops; y[4] = xt4; \ } while (0) +#define DispatchReturn \ +do { \ + if (FCALLS > 0 || FCALLS > neg_o_reds) { \ + FCALLS--; \ + Goto(*I); \ + } \ + else { \ + c_p->current = NULL; \ + c_p->arity = 1; \ + goto context_switch3; \ + } \ +} while (0) + #define MoveReturn(Src) \ x(0) = (Src); \ I = c_p->cp; \ ASSERT(VALID_INSTR(*c_p->cp)); \ c_p->cp = 0; \ CHECK_TERM(r(0)); \ - Goto(*I) + DispatchReturn #define DeallocateReturn(Deallocate) \ do { \ int words_to_pop = (Deallocate); \ - SET_I((BeamInstr *) cp_val(*E)); \ + SET_I((BeamInstr *) cp_val(*E)); \ E = ADD_BYTE_OFFSET(E, words_to_pop); \ CHECK_TERM(r(0)); \ - Goto(*I); \ + DispatchReturn; \ } while (0) #define MoveDeallocateReturn(Src, Deallocate) \ @@ -1042,14 +1057,17 @@ void** beam_ops; * The following functions are called directly by process_main(). * Don't inline them. */ -static BifFunction translate_gc_bif(void* gcf) NOINLINE; +static ErtsCodeMFA *ubif2mfa(void* uf) NOINLINE; +static ErtsCodeMFA *gcbif2mfa(void* gcf) NOINLINE; static BeamInstr* handle_error(Process* c_p, BeamInstr* pc, - Eterm* reg, BifFunction bf) NOINLINE; + Eterm* reg, ErtsCodeMFA* bif_mfa) NOINLINE; static BeamInstr* call_error_handler(Process* p, ErtsCodeMFA* mfa, Eterm* reg, Eterm func) NOINLINE; -static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity) NOINLINE; +static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity, + BeamInstr *I, Uint offs) NOINLINE; static BeamInstr* apply(Process* p, Eterm module, Eterm function, - Eterm args, Eterm* reg) NOINLINE; + Eterm args, Eterm* reg, + BeamInstr *I, Uint offs) NOINLINE; static BeamInstr* call_fun(Process* p, int arity, Eterm* reg, Eterm args) NOINLINE; static BeamInstr* apply_fun(Process* p, Eterm fun, @@ -1071,7 +1089,7 @@ static BeamInstr* next_catch(Process* c_p, Eterm *reg); static void terminate_proc(Process* c_p, Eterm Value); static Eterm add_stacktrace(Process* c_p, Eterm Value, Eterm exc); static void save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, - BifFunction bf, Eterm args); + ErtsCodeMFA *bif_mfa, Eterm args); static struct StackTrace * get_trace_from_exc(Eterm exc); static Eterm make_arglist(Process* c_p, Eterm* reg, int a); @@ -1679,7 +1697,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) c_p->cp = 0; CHECK_TERM(r(0)); HEAP_SPACE_VERIFIED(0); - Goto(*I); + DispatchReturn; } /* @@ -2566,7 +2584,7 @@ do { \ OpCase(bif1_fbsd): { - Eterm (*bf)(Process*, Eterm*); + ErtsBifFunc bf; Eterm tmp_reg[1]; Eterm result; @@ -2577,7 +2595,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg); + result = (*bf)(c_p, tmp_reg, I); ERTS_CHK_MBUF_SZ(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2598,19 +2616,19 @@ do { \ OpCase(bif1_body_bsd): { - Eterm (*bf)(Process*, Eterm*); + ErtsBifFunc bf; Eterm tmp_reg[1]; Eterm result; GetArg1(1, tmp_reg[0]); - bf = (BifFunction) Arg(0); + bf = (ErtsBifFunc) Arg(0); ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg); + result = (*bf)(c_p, tmp_reg, I); ERTS_CHK_MBUF_SZ(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2623,7 +2641,7 @@ do { \ } reg[0] = tmp_reg[0]; SWAPOUT; - I = handle_error(c_p, I, reg, bf); + I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); goto post_error_handling; } @@ -2659,7 +2677,7 @@ do { \ Goto(*I); } x(0) = x(live); - I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); goto post_error_handling; } @@ -2704,7 +2722,7 @@ do { \ live--; x(0) = x(live); x(1) = x(live+1); - I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); goto post_error_handling; } @@ -2750,7 +2768,7 @@ do { \ x(0) = x(live); x(1) = x(live+1); x(2) = x(live+2); - I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); goto post_error_handling; } @@ -2760,17 +2778,17 @@ do { \ OpCase(i_bif2_fbssd): { Eterm tmp_reg[2]; - Eterm (*bf)(Process*, Eterm*); + ErtsBifFunc bf; Eterm result; GetArg2(2, tmp_reg[0], tmp_reg[1]); - bf = (BifFunction) Arg(1); + bf = (ErtsBifFunc) Arg(1); ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg); + result = (*bf)(c_p, tmp_reg, I); ERTS_CHK_MBUF_SZ(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2791,15 +2809,15 @@ do { \ OpCase(i_bif2_body_bssd): { Eterm tmp_reg[2]; - Eterm (*bf)(Process*, Eterm*); + ErtsBifFunc bf; Eterm result; GetArg2(1, tmp_reg[0], tmp_reg[1]); - bf = (BifFunction) Arg(0); + bf = (ErtsBifFunc) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg); + result = (*bf)(c_p, tmp_reg, I); ERTS_CHK_MBUF_SZ(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2812,7 +2830,7 @@ do { \ reg[0] = tmp_reg[0]; reg[1] = tmp_reg[1]; SWAPOUT; - I = handle_error(c_p, I, reg, bf); + I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); goto post_error_handling; } @@ -2822,7 +2840,7 @@ do { \ */ OpCase(call_bif_e): { - Eterm (*bf)(Process*, Eterm*, BeamInstr*); + ErtsBifFunc bf; Eterm result; BeamInstr *next; ErlHeapFragment *live_hf_end; @@ -2889,7 +2907,7 @@ do { \ * Error handling. SWAPOUT is not needed because it was done above. */ ASSERT(c_p->stop == E); - I = handle_error(c_p, I, reg, bf); + I = handle_error(c_p, I, reg, &export->info.mfa); goto post_error_handling; } @@ -3186,21 +3204,21 @@ do { \ OpCase(i_apply): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, NULL, 0); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+1); SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } OpCase(i_apply_last_P): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, I, Arg(0)); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); @@ -3208,20 +3226,20 @@ do { \ SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } OpCase(i_apply_only): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, I, 0); HEAVY_SWAPIN; if (next != NULL) { SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } @@ -3229,14 +3247,14 @@ do { \ BeamInstr *next; HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0)); + next = fixed_apply(c_p, reg, Arg(0), NULL, 0); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+2); SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } @@ -3244,7 +3262,7 @@ do { \ BeamInstr *next; HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0)); + next = fixed_apply(c_p, reg, Arg(0), I, Arg(1)); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); @@ -3252,7 +3270,7 @@ do { \ SET_I(next); Dispatch(); } - I = handle_error(c_p, I, reg, apply_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); goto post_error_handling; } @@ -3547,12 +3565,6 @@ do { \ ErlHeapFragment *live_hf_end; ErtsCodeMFA *codemfa; - if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the nif */ - goto context_switch; - } - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); codemfa = erts_code_to_codemfa(I); @@ -3561,8 +3573,8 @@ do { \ DTRACE_NIF_ENTRY(c_p, codemfa); - SWAPOUT; - c_p->fcalls = FCALLS - 1; + HEAVY_SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); bif_nif_arity = codemfa->arity; ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); @@ -3635,7 +3647,7 @@ do { \ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); { - Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf; + ErtsBifFunc bf = vbf; ASSERT(!ERTS_PROC_IS_EXITING(c_p)); live_hf_end = c_p->mbuf; ERTS_CHK_MBUF_SZ(c_p); @@ -3679,7 +3691,7 @@ do { \ } Dispatch(); } - I = handle_error(c_p, c_p->cp, reg, vbf); + I = handle_error(c_p, c_p->cp, reg, c_p->current); goto post_error_handling; } } @@ -5034,7 +5046,7 @@ do { \ goto do_schedule; } else { HEAVY_SWAPIN; - I = handle_error(c_p, I, reg, hibernate_3); + I = handle_error(c_p, I, reg, &bif_export[BIF_hibernate_3]->info.mfa); goto post_error_handling; } } @@ -5128,6 +5140,7 @@ do { \ em_call_error_handler = OpCode(call_error_handler); em_apply_bif = OpCode(apply_bif); em_call_nif = OpCode(call_nif); + em_call_bif_e = OpCode(call_bif_e); beam_apply[0] = (BeamInstr) OpCode(i_apply); beam_apply[1] = (BeamInstr) OpCode(normal_exit); @@ -5314,10 +5327,25 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) ASSERT(!(c_p->flags & F_HIPE_MODE)); ERTS_MSACC_UPDATE_CACHE_X(); - reg = esdp->x_reg_array; - { + /* + * Set fcalls even though we ignore it, so we don't + * confuse code accessing it... + */ + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + c_p->fcalls = 0; + else + c_p->fcalls = CONTEXT_REDS; + + if (erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_DIRTY_RUNNING_SYS) { + erts_execute_dirty_system_task(c_p); + goto do_dirty_schedule; + } + else { + ErtsCodeMFA *codemfa; Eterm* argp; - int i; + int i, exiting; + + reg = esdp->x_reg_array; argp = c_p->arg_reg; for (i = c_p->arity - 1; i >= 0; i--) { @@ -5333,17 +5361,6 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) I = c_p->i; - ASSERT(em_call_nif == (BeamInstr *) *I); - - /* - * Set fcalls even though we ignore it, so we don't - * confuse code accessing it... - */ - if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) - c_p->fcalls = 0; - else - c_p->fcalls = CONTEXT_REDS; - SWAPIN; #ifdef USE_VM_PROBES @@ -5367,96 +5384,81 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) DTRACE2(process_scheduled, process_buf, fun_buf); } #endif - } - - { -#ifdef DEBUG - Eterm result; -#endif - Eterm arity; - { - /* - * call_nif is always first instruction in function: - * - * I[-3]: Module - * I[-2]: Function - * I[-1]: Arity - * I[0]: &&call_nif - * I[1]: Function pointer to NIF function - * I[2]: Pointer to erl_module_nif - * I[3]: Function pointer to dirty NIF - * - * This layout is determined by the NifExport struct - */ - BifFunction vbf; - ErtsCodeMFA *codemfa; - - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); + /* + * call_nif is always first instruction in function: + * + * I[-3]: Module + * I[-2]: Function + * I[-1]: Arity + * I[0]: &&call_nif + * I[1]: Function pointer to NIF function + * I[2]: Pointer to erl_module_nif + * I[3]: Function pointer to dirty NIF + * + * This layout is determined by the NifExport struct + */ - codemfa = erts_code_to_codemfa(I); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); - DTRACE_NIF_ENTRY(c_p, codemfa); - /* current and vbf set to please handle_error */ - c_p->current = codemfa; - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - arity = codemfa->arity; - ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + codemfa = erts_code_to_codemfa(I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - { - typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); - NifF* fp = vbf = (NifF*) I[1]; - struct enif_environment_t env; - ASSERT(!c_p->scheduler_data); - - erts_pre_dirty_nif(esdp, &env, c_p, - (struct erl_module_nif*)I[2]); - -#ifdef DEBUG - result = -#else - (void) -#endif - (*fp)(&env, arity, reg); + DTRACE_NIF_ENTRY(c_p, codemfa); + c_p->current = codemfa; + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - erts_post_dirty_nif(&env); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + if (em_apply_bif == (BeamInstr *) *I) { + exiting = erts_call_dirty_bif(esdp, c_p, I, reg); + } + else { + ASSERT(em_call_nif == (BeamInstr *) *I); + exiting = erts_call_dirty_nif(esdp, c_p, I, reg); + } - ASSERT(!is_value(result)); - ASSERT(c_p->freason == TRAP); - ASSERT(!(c_p->flags & F_HIBERNATE_SCHED)); + ASSERT(!(c_p->flags & F_HIBERNATE_SCHED)); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - if (env.exiting) - goto do_dirty_schedule; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - } + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + if (exiting) + goto do_dirty_schedule; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - DTRACE_NIF_RETURN(c_p, codemfa); - ERTS_HOLE_CHECK(c_p); - SWAPIN; - I = c_p->i; - goto context_switch; - } + DTRACE_NIF_RETURN(c_p, codemfa); + ERTS_HOLE_CHECK(c_p); + SWAPIN; + I = c_p->i; + goto context_switch; } #endif /* ERTS_DIRTY_SCHEDULERS */ } -static BifFunction -translate_gc_bif(void* gcf) +static ErtsCodeMFA * +gcbif2mfa(void* gcf) { - const ErtsGcBif* p; - - for (p = erts_gc_bifs; p->bif != 0; p++) { - if (p->gc_bif == gcf) { - return p->bif; - } + int i; + for (i = 0; erts_gc_bifs[i].bif; i++) { + if (erts_gc_bifs[i].gc_bif == gcf) + return &bif_export[erts_gc_bifs[i].exp_ix]->info.mfa; } erts_exit(ERTS_ERROR_EXIT, "bad gc bif"); + return NULL; +} + +static ErtsCodeMFA * +ubif2mfa(void* uf) +{ + int i; + for (i = 0; erts_u_bifs[i].bif; i++) { + if (erts_u_bifs[i].bif == uf) + return &bif_export[erts_u_bifs[i].exp_ix]->info.mfa; + } + erts_exit(ERTS_ERROR_EXIT, "bad u bif"); + return NULL; } /* @@ -5515,15 +5517,27 @@ Eterm error_atom[NUMBER_EXIT_CODES] = { */ static BeamInstr* -handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf) +handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, ErtsCodeMFA *bif_mfa) { Eterm* hp; Eterm Value = c_p->fvalue; Eterm Args = am_true; - c_p->i = pc; /* In case we call erts_exit(). */ ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */ + if (c_p->freason & EXF_RESTORE_NIF) + erts_nif_export_restore_error(c_p, &pc, reg, &bif_mfa); + +#ifdef DEBUG + if (bif_mfa) { + /* Verify that bif_mfa does not point into our nif export */ + NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + ASSERT(!nep || !ErtsInArea(bif_mfa, (char *)nep, sizeof(NifExport))); + } +#endif + + c_p->i = pc; /* In case we call erts_exit(). */ + /* * Check if we have an arglist for the top level call. If so, this * is encoded in Value, so we have to dig out the real Value as well @@ -5546,7 +5560,7 @@ handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf) * more modular. */ if (c_p->freason & EXF_SAVETRACE) { - save_stacktrace(c_p, pc, reg, bf, Args); + save_stacktrace(c_p, pc, reg, bif_mfa, Args); } /* @@ -5821,11 +5835,12 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) { */ static void -save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, - Eterm args) { +save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, + ErtsCodeMFA *bif_mfa, Eterm args) { struct StackTrace* s; int sz; int depth = erts_backtrace_depth; /* max depth (never negative) */ + if (depth > 0) { /* There will always be a current function */ depth --; @@ -5841,33 +5856,30 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, s->depth = 0; /* - * If the failure was in a BIF other than 'error', 'exit' or - * 'throw', find the bif-table index and save the argument + * If the failure was in a BIF other than 'error/1', 'error/2', + * 'exit/1' or 'throw/1', save BIF-MFA and save the argument * registers by consing up an arglist. */ - if (bf != NULL && bf != error_1 && bf != error_2 && - bf != exit_1 && bf != throw_1) { - int i; - int a = 0; - for (i = 0; i < BIF_SIZE; i++) { - if (bf == bif_table[i].f || bf == bif_table[i].traced) { - Export *ep = bif_export[i]; - s->current = &ep->info.mfa; - a = bif_table[i].arity; + if (bif_mfa) { + if (bif_mfa->module == am_erlang) { + switch (bif_mfa->function) { + case am_error: + if (bif_mfa->arity == 1 || bif_mfa->arity == 2) + goto non_bif_stacktrace; + break; + case am_exit: + if (bif_mfa->arity == 1) + goto non_bif_stacktrace; + break; + case am_throw: + if (bif_mfa->arity == 1) + goto non_bif_stacktrace; + break; + default: break; } } - if (i >= BIF_SIZE) { - /* - * The Bif does not really exist (no BIF entry). It is a - * TRAP and traps are called through apply_bif, which also - * sets c_p->current (luckily). - * OR it is a NIF called by call_nif where current is also set. - */ - ASSERT(c_p->current); - s->current = c_p->current; - a = s->current->arity; - } + s->current = bif_mfa; /* Save first stack entry */ ASSERT(pc); if (depth > 0) { @@ -5880,8 +5892,11 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, depth--; } s->pc = NULL; - args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */ + args = make_arglist(c_p, reg, bif_mfa->arity); /* Overwrite CAR(c_p->ftrace) */ } else { + + non_bif_stacktrace: + s->current = c_p->current; /* * For a function_clause error, the arguments are in the beam @@ -5942,12 +5957,30 @@ erts_save_stacktrace(Process* p, struct StackTrace* s, int depth) p->cp) { /* Cannot follow cp here - code may be unloaded */ BeamInstr *cpp = p->cp; + int trace_cp; if (cpp == beam_exception_trace || cpp == beam_return_trace) { /* Skip return_trace parameters */ ptr += 2; + trace_cp = 1; } else if (cpp == beam_return_to_trace) { /* Skip return_to_trace parameters */ ptr += 1; + trace_cp = 1; + } + else { + trace_cp = 0; + } + if (trace_cp && s->pc == cpp) { + /* + * If process 'cp' points to a return/exception trace + * instruction and 'cp' has been saved as 'pc' in + * stacktrace, we need to update 'pc' in stacktrace + * with the actual 'cp' located on the top of the + * stack; otherwise, we will lose the top stackframe + * when building the stack trace. + */ + ASSERT(is_CP(p->stop[0])); + s->pc = cp_val(p->stop[0]); } } while (ptr < STACK_START(p) && depth > 0) { @@ -6067,12 +6100,15 @@ build_stacktrace(Process* c_p, Eterm exc) { erts_set_current_function(&fi, s->current); } + depth = s->depth; /* - * If fi.current is still NULL, default to the initial function + * If fi.current is still NULL, and we have no + * stack at all, default to the initial function * (e.g. spawn_link(erlang, abs, [1])). */ if (fi.mfa == NULL) { - erts_set_current_function(&fi, &c_p->u.initial); + if (depth <= 0) + erts_set_current_function(&fi, &c_p->u.initial); args = am_true; /* Just in case */ } else { args = get_args_from_exc(exc); @@ -6082,10 +6118,9 @@ build_stacktrace(Process* c_p, Eterm exc) { * Look up all saved continuation pointers and calculate * needed heap space. */ - depth = s->depth; stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP, depth*sizeof(FunctionInfo)); - heap_size = fi.needed + 2; + heap_size = fi.mfa ? fi.needed + 2 : 0; for (i = 0; i < depth; i++) { erts_lookup_function_info(stkp, s->trace[i], 1); if (stkp->mfa) { @@ -6104,8 +6139,10 @@ build_stacktrace(Process* c_p, Eterm exc) { res = CONS(hp, mfa, res); hp += 2; } - hp = erts_build_mfa_item(&fi, hp, args, &mfa); - res = CONS(hp, mfa, res); + if (fi.mfa) { + hp = erts_build_mfa_item(&fi, hp, args, &mfa); + res = CONS(hp, mfa, res); + } erts_free(ERTS_ALC_T_TMP, (void *) stk); return res; @@ -6203,8 +6240,107 @@ apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity, return ep; } +static ERTS_INLINE void +apply_bif_error_adjustment(Process *p, Export *ep, + Eterm *reg, Uint arity, + BeamInstr *I, Uint stack_offset) +{ + /* + * I is only set when the apply is a tail call, i.e., + * from the instructions i_apply_only, i_apply_last_P, + * and apply_last_IP. + */ + if (I + && ep->beam[0] == (BeamInstr) em_apply_bif + && (ep == bif_export[BIF_error_1] + || ep == bif_export[BIF_error_2] + || ep == bif_export[BIF_exit_1] + || ep == bif_export[BIF_throw_1])) { + /* + * We are about to tail apply one of the BIFs + * erlang:error/1, erlang:error/2, erlang:exit/1, + * or erlang:throw/1. Error handling of these BIFs is + * special! + * + * We need 'p->cp' to point into the calling + * function when handling the error after the BIF has + * been applied. This in order to get the topmost + * stackframe correct. Without the following adjustment, + * 'p->cp' will point into the function that called + * current function when handling the error. We add a + * dummy stackframe in order to achive this. + * + * Note that these BIFs unconditionally will cause + * an exception to be raised. That is, our modifications + * of 'p->cp' as well as the stack will be corrected by + * the error handling code. + * + * If we find an exception/return-to trace continuation + * pointer as the topmost continuation pointer, we do not + * need to do anything since the information already will + * be available for generation of the stacktrace. + */ + int apply_only = stack_offset == 0; + BeamInstr *cpp; + + if (apply_only) { + ASSERT(p->cp != NULL); + cpp = p->cp; + } + else { + ASSERT(is_CP(p->stop[0])); + cpp = cp_val(p->stop[0]); + } + + if (cpp != beam_exception_trace + && cpp != beam_return_trace + && cpp != beam_return_to_trace) { + Uint need = stack_offset /* bytes */ / sizeof(Eterm); + if (need == 0) + need = 1; /* i_apply_only */ + if (p->stop - p->htop < need) + erts_garbage_collect(p, (int) need, reg, arity+1); + p->stop -= need; + + if (apply_only) { + /* + * Called from the i_apply_only instruction. + * + * 'p->cp' contains continuation pointer pointing + * into the function that called current function. + * We push that continuation pointer onto the stack, + * and set 'p->cp' to point into current function. + */ + + p->stop[0] = make_cp(p->cp); + p->cp = I; + } + else { + /* + * Called from an i_apply_last_p, or apply_last_IP, + * instruction. + * + * Calling instruction will after we return read + * a continuation pointer from the stack and write + * it to 'p->cp', and then remove the topmost + * stackframe of size 'stack_offset'. + * + * We have sized the dummy-stackframe so that it + * will be removed by the instruction we currently + * are executing, and leave the stackframe that + * normally would have been removed intact. + * + */ + p->stop[0] = make_cp(I); + } + } + } +} + static BeamInstr* -apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) +apply( +Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg, +BeamInstr *I, Uint stack_offset) { int arity; Export* ep; @@ -6229,21 +6365,54 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) return 0; } - /* The module argument may be either an atom or an abstract module - * (currently implemented using tuples, but this might change). - */ - this = THE_NON_VALUE; - if (is_not_atom(module)) { - Eterm* tp; + while (1) { + Eterm m, f, a; + /* The module argument may be either an atom or an abstract module + * (currently implemented using tuples, but this might change). + */ + this = THE_NON_VALUE; + if (is_not_atom(module)) { + Eterm* tp; + + if (is_not_tuple(module)) goto error; + tp = tuple_val(module); + if (arityval(tp[0]) < 1) goto error; + this = module; + module = tp[1]; + if (is_not_atom(module)) goto error; + } - if (is_not_tuple(module)) goto error; - tp = tuple_val(module); - if (arityval(tp[0]) < 1) goto error; - this = module; - module = tp[1]; - if (is_not_atom(module)) goto error; + if (module != am_erlang || function != am_apply) + break; + + /* Adjust for multiple apply of apply/3... */ + + a = args; + if (is_list(a)) { + Eterm *consp = list_val(a); + m = CAR(consp); + a = CDR(consp); + if (is_list(a)) { + consp = list_val(a); + f = CAR(consp); + a = CDR(consp); + if (is_list(a)) { + consp = list_val(a); + a = CAR(consp); + if (is_nil(CDR(consp))) { + /* erlang:apply/3 */ + module = m; + function = f; + args = a; + if (is_not_atom(f)) + goto error; + continue; + } + } + } + } + break; /* != erlang:apply/3 */ } - /* * Walk down the 3rd parameter of apply (the argument list) and copy * the parameters to the x registers (reg[]). If the module argument @@ -6281,12 +6450,14 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { save_calls(p, ep); } + apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset); DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep); return ep->addressv[erts_active_code_ix()]; } static BeamInstr* -fixed_apply(Process* p, Eterm* reg, Uint arity) +fixed_apply(Process* p, Eterm* reg, Uint arity, + BeamInstr *I, Uint stack_offset) { Export* ep; Eterm module; @@ -6316,6 +6487,10 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) if (is_not_atom(module)) goto error; ++arity; } + + /* Handle apply of apply/3... */ + if (module == am_erlang && function == am_apply && arity == 3) + return apply(p, reg[0], reg[1], reg[2], reg, I, stack_offset); /* * Get the index into the export table, or failing that the export @@ -6330,6 +6505,7 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { save_calls(p, ep); } + apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset); DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep); return ep->addressv[erts_active_code_ix()]; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 3cd395c2c1..309465bcd3 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -800,14 +800,14 @@ erts_finish_loading(Binary* magic, Process* c_p, } else { ErtsCodeIndex code_ix = erts_staging_code_ix(); Eterm module = stp->module; - int i; + int i, num_exps; /* * There is an -on_load() function. We will keep the current * code, but we must turn off any tracing. */ - - for (i = 0; i < export_list_size(code_ix); i++) { + num_exps = export_list_size(code_ix); + for (i = 0; i < num_exps; i++) { Export *ep = export_list(i, code_ix); if (ep == NULL || ep->info.mfa.module != module) { continue; @@ -2546,15 +2546,10 @@ load_code(LoaderState* stp) if (stp->may_load_nif) { const int finfo_ix = ci - FUNC_INFO_SZ; -#ifdef ERTS_DIRTY_SCHEDULERS - enum { MIN_FUNC_SZ = 4 }; -#else - enum { MIN_FUNC_SZ = 3 }; -#endif - if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) { + if (finfo_ix - last_func_start < BEAM_NIF_MIN_FUNC_SZ && last_func_start) { /* Must make room for call_nif op */ - int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start); - ASSERT(pad > 0 && pad < MIN_FUNC_SZ); + int pad = BEAM_NIF_MIN_FUNC_SZ - (finfo_ix - last_func_start); + ASSERT(pad > 0 && pad < BEAM_NIF_MIN_FUNC_SZ); CodeNeed(pad); sys_memmove(&code[finfo_ix+pad], &code[finfo_ix], FUNC_INFO_SZ*sizeof(BeamInstr)); @@ -5729,12 +5724,13 @@ exported_from_module(Process* p, /* Process whose heap to use. */ ErtsCodeIndex code_ix, Eterm mod) /* Tagged atom for module. */ { - int i; + int i, num_exps; Eterm* hp = NULL; Eterm* hend = NULL; Eterm result = NIL; - for (i = 0; i < export_list_size(code_ix); i++) { + num_exps = export_list_size(code_ix); + for (i = 0; i < num_exps; i++) { Export* ep = export_list(i,code_ix); if (ep->info.mfa.module == mod) { diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index d420a4346c..659b9c303f 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -111,6 +111,12 @@ typedef struct beam_code_header { }BeamCodeHeader; +#ifdef ERTS_DIRTY_SCHEDULERS +# define BEAM_NIF_MIN_FUNC_SZ 4 +#else +# define BEAM_NIF_MIN_FUNC_SZ 3 +#endif + void erts_release_literal_area(struct ErtsLiteralArea_* literal_area); int erts_is_module_native(BeamCodeHeader* code); void erts_beam_bif_load_init(void); diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index d886c2985e..65c370c55b 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -3865,13 +3865,6 @@ BIF_RETTYPE now_0(BIF_ALIST_0) /**********************************************************************/ -BIF_RETTYPE garbage_collect_0(BIF_ALIST_0) -{ - FLAGS(BIF_P) |= F_NEED_FULLSWEEP; - erts_garbage_collect(BIF_P, 0, NULL, 0); - return am_true; -} - /* * Pass atom 'minor' for relaxed generational GC run. This is only * recommendation, major run may still be chosen by VM. @@ -4324,7 +4317,7 @@ BIF_RETTYPE group_leader_2(BIF_ALIST_2) erts_smp_proc_unlock(new_member, ERTS_PROC_LOCK_STATUS); if (new_member == BIF_P || !(erts_smp_atomic32_read_nob(&new_member->state) - & (ERTS_PSFLG_DIRTY_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS))) { + & ERTS_PSFLG_DIRTY_RUNNING)) { new_member->group_leader = STORE_NC_IN_PROC(new_member, BIF_ARG_1); } @@ -4608,7 +4601,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) erts_aint32_t new = BIF_ARG_2 == am_true ? 1 : 0; erts_aint32_t old = erts_smp_atomic32_xchg_nob(&sched_wall_time, new); - Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new); + Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new, 0, 0); ASSERT(is_value(ref)); BIF_TRAP2(await_sched_wall_time_mod_trap, BIF_P, @@ -4958,7 +4951,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, Export bif_return_trap_export; void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a, - Eterm (*bif)(BIF_ALIST_0)) + Eterm (*bif)(BIF_ALIST)) { int i; sys_memset((void *) ep, 0, sizeof(Export)); @@ -5019,6 +5012,314 @@ void erts_init_bif(void) erts_smp_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED()); } +/* + * Scheduling of BIFs via NifExport... + */ +#define ERTS_WANT_NFUNC_SCHED_INTERNALS__ +#include "erl_nfunc_sched.h" + +#define ERTS_SCHED_BIF_TRAP_MARKER ((void *) (UWord) 1) + +static ERTS_INLINE void +schedule(Process *c_p, Process *dirty_shadow_proc, + ErtsCodeMFA *mfa, BeamInstr *pc, + ErtsBifFunc dfunc, void *ifunc, + Eterm module, Eterm function, + int argc, Eterm *argv) +{ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p)); + (void) erts_nif_export_schedule(c_p, dirty_shadow_proc, + mfa, pc, (BeamInstr) em_apply_bif, + dfunc, ifunc, + module, function, + argc, argv); +} + +#ifdef ERTS_DIRTY_SCHEDULERS + +static BIF_RETTYPE dirty_bif_result(BIF_ALIST_1) +{ + NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(BIF_P); + erts_nif_export_restore(BIF_P, nep, BIF_ARG_1); + BIF_RET(BIF_ARG_1); +} + +static BIF_RETTYPE dirty_bif_trap(BIF_ALIST) +{ + NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(BIF_P); + + /* + * Arity and argument registers already set + * correct by call to dirty_bif_trap()... + */ + + ASSERT(BIF_P->arity == nep->exp.info.mfa.arity); + + erts_nif_export_restore(BIF_P, nep, THE_NON_VALUE); + + BIF_P->i = (BeamInstr *) nep->func; + BIF_P->freason = TRAP; + return THE_NON_VALUE; +} + +static BIF_RETTYPE dirty_bif_exception(BIF_ALIST_2) +{ + Eterm freason; + + ASSERT(is_small(BIF_ARG_1)); + + freason = signed_val(BIF_ARG_1); + + /* Restore orig info for error and clear nif export in handle_error() */ + freason |= EXF_RESTORE_NIF; + + BIF_P->fvalue = BIF_ARG_2; + + BIF_ERROR(BIF_P, freason); +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ + +extern BeamInstr* em_call_bif_e; +static BIF_RETTYPE call_bif(Process *c_p, Eterm *reg, BeamInstr *I); + +BIF_RETTYPE +erts_schedule_bif(Process *proc, + Eterm *argv, + BeamInstr *i, + ErtsBifFunc bif, + ErtsSchedType sched_type, + Eterm mod, + Eterm func, + int argc) +{ + Process *c_p, *dirty_shadow_proc; + ErtsCodeMFA *mfa; + +#ifdef ERTS_DIRTY_SCHEDULERS + if (proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) { + dirty_shadow_proc = proc; + c_p = proc->next; + ASSERT(c_p->common.id == dirty_shadow_proc->common.id); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + } + else +#endif + { + dirty_shadow_proc = NULL; + c_p = proc; + } + + if (!ERTS_PROC_IS_EXITING(c_p)) { + Export *exp; + BifFunction dbif, ibif; + BeamInstr *pc; + + /* + * dbif - direct bif + * ibif - indirect bif + */ + +#ifdef ERTS_DIRTY_SCHEDULERS + erts_aint32_t set, mask; + mask = (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC); + switch (sched_type) { + case ERTS_SCHED_DIRTY_CPU: + set = ERTS_PSFLG_DIRTY_CPU_PROC; + dbif = bif; + ibif = NULL; + break; + case ERTS_SCHED_DIRTY_IO: + set = ERTS_PSFLG_DIRTY_IO_PROC; + dbif = bif; + ibif = NULL; + break; + case ERTS_SCHED_NORMAL: + default: + set = 0; + dbif = call_bif; + ibif = bif; + break; + } + + (void) erts_smp_atomic32_read_bset_nob(&c_p->state, mask, set); +#else + dbif = call_bif; + ibif = bif; +#endif + + if (i == NULL) { + ERTS_INTERNAL_ERROR("Missing instruction pointer"); + } +#ifdef HIPE + else if (proc->flags & F_HIPE_MODE) { + /* Pointer to bif export in i */ + exp = (Export *) i; + pc = c_p->cp; + mfa = &exp->info.mfa; + } +#endif + else if (em_call_bif_e == (BeamInstr *) *i) { + /* Pointer to bif export in i+1 */ + exp = (Export *) i[1]; + pc = i; + mfa = &exp->info.mfa; + } + else if (em_apply_bif == (BeamInstr *) *i) { + /* Pointer to bif in i+1, and mfa in i-3 */ + pc = c_p->cp; + mfa = erts_code_to_codemfa(i); + } + else { + ERTS_INTERNAL_ERROR("erts_schedule_bif() called " + "from unexpected instruction"); + } + ASSERT(bif); + + if (argc < 0) { /* reschedule original call */ + mod = mfa->module; + func = mfa->function; + argc = (int) mfa->arity; + } + + schedule(c_p, dirty_shadow_proc, mfa, pc, dbif, ibif, + mod, func, argc, argv); + } + + if (dirty_shadow_proc) + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + + return THE_NON_VALUE; +} + +static BIF_RETTYPE +call_bif(Process *c_p, Eterm *reg, BeamInstr *I) +{ + NifExport *nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I); + ErtsBifFunc bif = (ErtsBifFunc) nep->func; + BIF_RETTYPE ret; + + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); + + nep->func = ERTS_SCHED_BIF_TRAP_MARKER; + + ASSERT(bif); + + ret = (*bif)(c_p, reg, I); + + if (is_value(ret)) + erts_nif_export_restore(c_p, nep, ret); + else if (c_p->freason != TRAP) + c_p->freason |= EXF_RESTORE_NIF; /* restore in handle_error() */ + else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) { + /* BIF did an ordinary trap... */ + erts_nif_export_restore(c_p, nep, ret); + } + /* else: + * BIF rescheduled itself using erts_schedule_bif(). + */ + + return ret; +} + +#ifdef ERTS_DIRTY_SCHEDULERS + +int +erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *reg) +{ + BIF_RETTYPE result; + int exiting; + Process *dirty_shadow_proc; + ErtsBifFunc bf; + NifExport *nep; +#ifdef DEBUG + Eterm *c_p_htop; + erts_aint32_t state; + + ASSERT(!c_p->scheduler_data); + state = erts_smp_atomic32_read_nob(&c_p->state); + ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING) + && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))); + ASSERT(esdp); + +#endif + + nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I); + ASSERT(nep == ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p)); + + nep->func = ERTS_SCHED_BIF_TRAP_MARKER; + + bf = (ErtsBifFunc) I[1]; + + erts_smp_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC)); + + dirty_shadow_proc = erts_make_dirty_shadow_proc(esdp, c_p); + + dirty_shadow_proc->freason = c_p->freason; + dirty_shadow_proc->fvalue = c_p->fvalue; + dirty_shadow_proc->ftrace = c_p->ftrace; + dirty_shadow_proc->cp = c_p->cp; + dirty_shadow_proc->i = c_p->i; + +#ifdef DEBUG + c_p_htop = c_p->htop; +#endif + + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + + result = (*bf)(dirty_shadow_proc, reg, I); + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + + ASSERT(c_p_htop == c_p->htop); + ASSERT(dirty_shadow_proc->static_flags & ERTS_STC_FLG_SHADOW_PROC); + ASSERT(dirty_shadow_proc->next == c_p); + + exiting = ERTS_PROC_IS_EXITING(c_p); + + if (!exiting) { + if (is_value(result)) + schedule(c_p, dirty_shadow_proc, NULL, NULL, dirty_bif_result, + NULL, am_erts_internal, am_dirty_bif_result, 1, &result); + else if (dirty_shadow_proc->freason != TRAP) { + Eterm argv[2]; + ASSERT(dirty_shadow_proc->freason <= MAX_SMALL); + argv[0] = make_small(dirty_shadow_proc->freason); + argv[1] = dirty_shadow_proc->fvalue; + schedule(c_p, dirty_shadow_proc, NULL, NULL, + dirty_bif_exception, NULL, am_erts_internal, + am_dirty_bif_exception, 2, argv); + } + else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) { + /* Dirty BIF did an ordinary trap... */ + ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state) + & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC))); + schedule(c_p, dirty_shadow_proc, NULL, NULL, + dirty_bif_trap, (void *) dirty_shadow_proc->i, + am_erts_internal, am_dirty_bif_trap, + dirty_shadow_proc->arity, reg); + } + /* else: + * BIF rescheduled itself using erts_schedule_bif(). + */ + c_p->freason = dirty_shadow_proc->freason; + c_p->fvalue = dirty_shadow_proc->fvalue; + c_p->ftrace = dirty_shadow_proc->ftrace; + c_p->cp = dirty_shadow_proc->cp; + c_p->i = dirty_shadow_proc->i; + c_p->arity = dirty_shadow_proc->arity; + } + + erts_flush_dirty_shadow_proc(dirty_shadow_proc); + + return exiting; +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ + + #ifdef HARDDEBUG /* You'll need this line in bif.tab to be able to use this debug bif diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 0c85e19ef0..01cca90a7a 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -29,17 +29,35 @@ extern Export *erts_convert_time_unit_trap; #define BIF_P A__p -#define BIF_ALIST_0 Process* A__p, Eterm* BIF__ARGS -#define BIF_ALIST_1 Process* A__p, Eterm* BIF__ARGS -#define BIF_ALIST_2 Process* A__p, Eterm* BIF__ARGS -#define BIF_ALIST_3 Process* A__p, Eterm* BIF__ARGS -#define BIF_ALIST_4 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST Process* A__p, Eterm* BIF__ARGS, BeamInstr *A__I +#define BIF_CALL_ARGS A__p, BIF__ARGS, A__I + +#define BIF_ALIST_0 BIF_ALIST +#define BIF_ALIST_1 BIF_ALIST +#define BIF_ALIST_2 BIF_ALIST +#define BIF_ALIST_3 BIF_ALIST +#define BIF_ALIST_4 BIF_ALIST #define BIF_ARG_1 (BIF__ARGS[0]) #define BIF_ARG_2 (BIF__ARGS[1]) #define BIF_ARG_3 (BIF__ARGS[2]) #define BIF_ARG_4 (BIF__ARGS[3]) +#define BIF_I A__I + +/* NBIF_* is for bif calls from native code... */ + +#define NBIF_ALIST Process* A__p, Eterm* BIF__ARGS +#define NBIF_CALL_ARGS A__p, BIF__ARGS + +#define NBIF_ALIST_0 NBIF_ALIST +#define NBIF_ALIST_1 NBIF_ALIST +#define NBIF_ALIST_2 NBIF_ALIST +#define NBIF_ALIST_3 NBIF_ALIST +#define NBIF_ALIST_4 NBIF_ALIST + +typedef BIF_RETTYPE (*ErtsBifFunc)(BIF_ALIST); + #define ERTS_IS_PROC_OUT_OF_REDS(p) \ ((p)->fcalls > 0 \ ? 0 \ @@ -480,6 +498,43 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, Eterm args[], int nargs); +#ifdef ERTS_DIRTY_SCHEDULERS +int erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, + BeamInstr *I, Eterm *reg); +#endif + +BIF_RETTYPE +erts_schedule_bif(Process *proc, + Eterm *argv, + BeamInstr *i, + ErtsBifFunc dbf, + ErtsSchedType sched_type, + Eterm mod, + Eterm func, + int argc); + +ERTS_GLB_INLINE BIF_RETTYPE +erts_reschedule_bif(Process *proc, + Eterm *argv, + BeamInstr *i, + ErtsBifFunc dbf, + ErtsSchedType sched_type); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE BIF_RETTYPE +erts_reschedule_bif(Process *proc, + Eterm *argv, + BeamInstr *i, + ErtsBifFunc dbf, + ErtsSchedType sched_type) +{ + return erts_schedule_bif(proc, argv, i, dbf, sched_type, + THE_NON_VALUE, THE_NON_VALUE, -1); +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + #ifdef ERL_WANT_HIPE_BIF_WRAPPER__ #ifndef HIPE @@ -510,16 +565,16 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, #define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) \ -BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ - Eterm* args); \ -BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ - Eterm* args) \ +BIF_RETTYPE \ +nbif_impl_hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (NBIF_ALIST); \ +BIF_RETTYPE \ +nbif_impl_hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (NBIF_ALIST) \ { \ BIF_RETTYPE res; \ - hipe_reserve_beam_trap_frame(c_p, args, ARITY); \ - res = BIF_NAME ## _ ## ARITY (c_p, args); \ - if (is_value(res) || c_p->freason != TRAP) { \ - hipe_unreserve_beam_trap_frame(c_p); \ + hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, ARITY); \ + res = nbif_impl_ ## BIF_NAME ## _ ## ARITY (NBIF_CALL_ARGS); \ + if (is_value(res) || BIF_P->freason != TRAP) { \ + hipe_unreserve_beam_trap_frame(BIF_P); \ } \ return res; \ } diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 32600f4338..47fdcfa7a4 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -68,7 +68,6 @@ gcbif erlang:float/1 bif erlang:float_to_list/1 bif erlang:float_to_list/2 bif erlang:fun_info/2 -bif erlang:garbage_collect/0 bif erts_internal:garbage_collect/1 bif erlang:get/0 bif erlang:get/1 @@ -420,6 +419,9 @@ bif erts_debug:set_internal_state/2 bif erts_debug:display/1 bif erts_debug:dist_ext_to_term/2 bif erts_debug:instructions/0 +bif erts_debug:dirty_cpu/2 +bif erts_debug:dirty_io/2 +bif erts_debug:dirty/3 # # Monitor testing bif's... diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 3ddf7a53e2..43c22e2e7c 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -44,6 +44,7 @@ #include "erl_hl_timer.h" #include "erl_cpu_topology.h" #include "erl_thr_queue.h" +#include "erl_nfunc_sched.h" #if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE) #include "erl_check_io.h" #endif @@ -681,6 +682,8 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_ABIF_TIMER)] = erts_timer_type_size(ERTS_ALC_T_ABIF_TIMER); #endif + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NIF_EXP_TRACE)] + = sizeof(NifExportTrace); #ifdef HARD_DEBUG hdbg_init(); @@ -2439,6 +2442,10 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg) fi, ERTS_ALC_T_ABIF_TIMER); #endif + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_NIF_EXP_TRACE); } if (want.atom || want.atom_used) { diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 7ea8c98008..1f7e4400e1 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -376,7 +376,8 @@ type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data type LL_TEMP_TERM LONG_LIVED SYSTEM ll_temp_term -type NIF_TRAP_EXPORT STANDARD CODE nif_trap_export_entry +type NIF_TRAP_EXPORT STANDARD PROCESSES nif_trap_export_entry +type NIF_EXP_TRACE FIXED_SIZE PROCESSES nif_export_trace type EXPORT LONG_LIVED CODE export_entry type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh type NLINK_SH FIXED_SIZE PROCESSES nlink_sh diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 61cce224dd..d346f8c8b6 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -6134,18 +6134,18 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) #ifdef USE_THREADS if (init->ts) { allctr->thread_safe = 1; - + #ifdef ERTS_ENABLE_LOCK_COUNT erts_mtx_init_x_opt(&allctr->mutex, "alcu_allocator", make_small(allctr->alloc_no), - ERTS_LCNT_LT_ALLOC,1); + ERTS_LCNT_LT_ALLOC); #else erts_mtx_init_x(&allctr->mutex, "alcu_allocator", - make_small(allctr->alloc_no),1); + make_small(allctr->alloc_no)); #endif /*ERTS_ENABLE_LOCK_COUNT*/ - + #ifdef DEBUG allctr->debug.saved_tid = 0; #endif diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 0e0842e139..5ee19aead8 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -94,6 +94,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #if defined(ERTS_DIRTY_SCHEDULERS) && defined(ERTS_SMP) " [ds:%beu:%beu:%beu]" #endif +#if defined(ERTS_DIRTY_SCHEDULERS_TEST) + " [dirty-schedulers-TEST]" +#endif " [async-threads:%d]" #endif #ifdef HIPE @@ -1673,11 +1676,11 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp) Eterm mfa; Eterm res = NIL; - depth = 8; + depth = erts_backtrace_depth; sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth; s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz); s->depth = 0; - if (rp->i) { + if (depth > 0 && rp->i) { s->trace[s->depth++] = rp->i; depth--; } @@ -2677,20 +2680,30 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) erts_schedulers_state(NULL, NULL, &active, NULL, NULL, NULL, NULL, NULL); BIF_RET(make_small(active)); #endif -#if defined(ERTS_SMP) && defined(ERTS_DIRTY_SCHEDULERS) } else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers", BIF_ARG_1)) { Uint dirty_cpu; +#ifdef ERTS_DIRTY_SCHEDULERS erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, NULL, NULL); +#else + dirty_cpu = 0; +#endif BIF_RET(make_small(dirty_cpu)); } else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers_online", BIF_ARG_1)) { Uint dirty_cpu_onln; +#ifdef ERTS_DIRTY_SCHEDULERS erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, NULL, NULL); +#else + dirty_cpu_onln = 0; +#endif BIF_RET(make_small(dirty_cpu_onln)); } else if (ERTS_IS_ATOM_STR("dirty_io_schedulers", BIF_ARG_1)) { Uint dirty_io; +#ifdef ERTS_DIRTY_SCHEDULERS erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, NULL, &dirty_io, NULL); - BIF_RET(make_small(dirty_io)); +#else + dirty_io = 0; #endif + BIF_RET(make_small(dirty_io)); } else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) { res = make_small(erts_no_run_queues); BIF_RET(res); @@ -2863,6 +2876,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) else if (ERTS_IS_ATOM_STR("atom_limit",BIF_ARG_1)) { BIF_RET(make_small(erts_get_atom_limit())); } + else if (ERTS_IS_ATOM_STR("atom_count",BIF_ARG_1)) { + BIF_RET(make_small(atom_table_size())); + } else if (ERTS_IS_ATOM_STR("tolerant_timeofday",BIF_ARG_1)) { if (erts_has_time_correction() && erts_time_offset_state() == ERTS_TIME_OFFSET_FINAL) { @@ -3369,7 +3385,12 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) Eterm* hp; if (BIF_ARG_1 == am_scheduler_wall_time) { - res = erts_sched_wall_time_request(BIF_P, 0, 0); + res = erts_sched_wall_time_request(BIF_P, 0, 0, 1, 0); + if (is_non_value(res)) + BIF_RET(am_undefined); + BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res); + } else if (BIF_ARG_1 == am_scheduler_wall_time_all) { + res = erts_sched_wall_time_request(BIF_P, 0, 0, 1, 1); if (is_non_value(res)) BIF_RET(am_undefined); BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index b1c2c427b0..a480754bdb 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -1061,9 +1061,16 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) erts_smp_thr_progress_block(); } #endif +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx); +#endif + r = function_is_traced(p, mfa, &ms, &ms_meta, &meta, &count, &call_time); +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx); +#endif #ifdef ERTS_SMP if ( (key == am_call_time) || (key == am_all)) { erts_smp_thr_progress_unblock(); diff --git a/erts/emulator/beam/erl_dirty_bif.tab b/erts/emulator/beam/erl_dirty_bif.tab new file mode 100644 index 0000000000..69421dcfcc --- /dev/null +++ b/erts/emulator/beam/erl_dirty_bif.tab @@ -0,0 +1,82 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 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% +# + +# +# Static declaration of BIFs that should execute on dirty schedulers. +# +# <dirty-bif-decl> ::= <type> <bif> +# <bif> ::= <module> ":" <name> "/" <arity> +# <type> ::= dirty-cpu | dirty-io | dirty-cpu-test | dirty-io-test +# +# When dirty scheduler support is available, a BIF declared with the +# 'dirty-cpu' type will unconditionally execute on a dirty CPU scheduler, +# and a BIF declared with the type 'dirty-io' will unconditionally execute +# on a dirty IO scheduler. When dirty scheduler support is not available +# all BIFs will of course execute on normal schedulers. +# +# When the emulator has been configured with the debug option +# '--enable-dirty-schedulers-test', BIFs with the types 'dirty-cpu-test', +# and 'dirty-io-test' will unconditionally execute on dirty schedulers. +# When this debug option has not been enabled, these BIFs will be executed +# on normal schedulers. +# +# BIFs marked as 'ubif' in ./bif.tab will be ignored, i.e., will always +# execute on normal schedulers. +# + +# --- Dirty BIFs --- + +dirty-cpu erts_debug:dirty_cpu/2 +dirty-io erts_debug:dirty_io/2 + +# --- TEST of Dirty BIF functionality --- +# Functions below will execute on dirty schedulers when emulator has +# been configured for testing dirty schedulers. This is used for test +# and debug purposes only. We really do *not* want to execute these +# on dirty schedulers on a real system. + +dirty-cpu-test erlang:'++'/2 +dirty-cpu-test erlang:append/2 +dirty-cpu-test erlang:'--'/2 +dirty-cpu-test erlang:subtract/2 +dirty-cpu-test erlang:iolist_size/1 +dirty-cpu-test erlang:make_tuple/2 +dirty-cpu-test erlang:make_tuple/3 +dirty-cpu-test erlang:append_element/2 +dirty-cpu-test erlang:insert_element/3 +dirty-cpu-test erlang:delete_element/2 +dirty-cpu-test erlang:atom_to_list/1 +dirty-cpu-test erlang:list_to_atom/1 +dirty-cpu-test erlang:list_to_existing_atom/1 +dirty-cpu-test erlang:integer_to_list/1 +dirty-cpu-test erlang:string_to_integer/1 +dirty-cpu-test erlang:list_to_integer/1 +dirty-cpu-test erlang:list_to_integer/2 +dirty-cpu-test erlang:float_to_list/1 +dirty-cpu-test erlang:float_to_list/2 +dirty-cpu-test erlang:float_to_binary/1 +dirty-cpu-test erlang:float_to_binary/2 +dirty-cpu-test erlang:string_to_float/1 +dirty-cpu-test erlang:list_to_float/1 +dirty-cpu-test erlang:binary_to_float/1 +dirty-cpu-test erlang:tuple_to_list/1 +dirty-cpu-test erlang:list_to_tuple/1 +dirty-cpu-test erlang:display/1 +dirty-cpu-test erlang:display_string/1 diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c index 92edce5176..0e6aadf568 100644 --- a/erts/emulator/beam/erl_drv_thread.c +++ b/erts/emulator/beam/erl_drv_thread.c @@ -54,6 +54,9 @@ fatal_error(int err, char *func) struct ErlDrvMutex_ { ethr_mutex mtx; +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_t lcnt; +#endif char *name; }; @@ -64,6 +67,9 @@ struct ErlDrvCond_ { struct ErlDrvRWLock_ { ethr_rwmutex rwmtx; +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_t lcnt; +#endif char *name; }; @@ -161,14 +167,17 @@ erl_drv_mutex_create(char *name) opt.posix_compliant = 1; if (ethr_mutex_init_opt(&dmtx->mtx, &opt) != 0) { erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx); - dmtx = NULL; + return NULL; } - else if (!name) - dmtx->name = no_name; - else { + if (name) { dmtx->name = ((char *) dmtx) + sizeof(ErlDrvMutex); sys_strcpy(dmtx->name, name); + } else { + dmtx->name = no_name; } +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock(&dmtx->lcnt, dmtx->name, ERTS_LCNT_LT_MUTEX); +#endif } return dmtx; #else @@ -180,7 +189,11 @@ void erl_drv_mutex_destroy(ErlDrvMutex *dmtx) { #ifdef USE_THREADS - int res = dmtx ? ethr_mutex_destroy(&dmtx->mtx) : EINVAL; + int res; +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_destroy_lock(&dmtx->lcnt); +#endif + res = dmtx ? ethr_mutex_destroy(&dmtx->mtx) : EINVAL; if (res != 0) fatal_error(res, "erl_drv_mutex_destroy()"); erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx); @@ -202,9 +215,14 @@ int erl_drv_mutex_trylock(ErlDrvMutex *dmtx) { #ifdef USE_THREADS + int res; if (!dmtx) fatal_error(EINVAL, "erl_drv_mutex_trylock()"); - return ethr_mutex_trylock(&dmtx->mtx); + res = ethr_mutex_trylock(&dmtx->mtx); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_trylock(&dmtx->lcnt, res); +#endif + return res; #else return 0; #endif @@ -216,8 +234,14 @@ erl_drv_mutex_lock(ErlDrvMutex *dmtx) #ifdef USE_THREADS if (!dmtx) fatal_error(EINVAL, "erl_drv_mutex_lock()"); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock(&dmtx->lcnt); +#endif ethr_mutex_lock(&dmtx->mtx); #endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post(&dmtx->lcnt); +#endif } void @@ -226,6 +250,9 @@ erl_drv_mutex_unlock(ErlDrvMutex *dmtx) #ifdef USE_THREADS if (!dmtx) fatal_error(EINVAL, "erl_drv_mutex_unlock()"); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock(&dmtx->lcnt); +#endif ethr_mutex_unlock(&dmtx->mtx); #endif } @@ -306,10 +333,18 @@ erl_drv_cond_wait(ErlDrvCond *dcnd, ErlDrvMutex *dmtx) if (!dcnd || !dmtx) { fatal_error(EINVAL, "erl_drv_cond_wait()"); } +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock(&dmtx->lcnt); +#endif while (1) { int res = ethr_cond_wait(&dcnd->cnd, &dmtx->mtx); - if (res == 0) + if (res == 0) { +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock(&dmtx->lcnt); + erts_lcnt_lock_post(&dmtx->lcnt); +#endif break; + } } #endif } @@ -324,14 +359,17 @@ erl_drv_rwlock_create(char *name) if (drwlck) { if (ethr_rwmutex_init(&drwlck->rwmtx) != 0) { erts_free(ERTS_ALC_T_DRV_RWLCK, (void *) drwlck); - drwlck = NULL; + return NULL; } - else if (!name) - drwlck->name = no_name; - else { + if (name) { drwlck->name = ((char *) drwlck) + sizeof(ErlDrvRWLock); sys_strcpy(drwlck->name, name); + } else { + drwlck->name = no_name; } +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock(&drwlck->lcnt, drwlck->name, ERTS_LCNT_LT_RWMUTEX); +#endif } return drwlck; #else @@ -343,7 +381,11 @@ void erl_drv_rwlock_destroy(ErlDrvRWLock *drwlck) { #ifdef USE_THREADS - int res = drwlck ? ethr_rwmutex_destroy(&drwlck->rwmtx) : EINVAL; + int res; +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_destroy_lock(&drwlck->lcnt); +#endif + res = drwlck ? ethr_rwmutex_destroy(&drwlck->rwmtx) : EINVAL; if (res != 0) fatal_error(res, "erl_drv_rwlock_destroy()"); erts_free(ERTS_ALC_T_DRV_RWLCK, (void *) drwlck); @@ -364,9 +406,14 @@ int erl_drv_rwlock_tryrlock(ErlDrvRWLock *drwlck) { #ifdef USE_THREADS + int res; if (!drwlck) fatal_error(EINVAL, "erl_drv_rwlock_tryrlock()"); - return ethr_rwmutex_tryrlock(&drwlck->rwmtx); + res = ethr_rwmutex_tryrlock(&drwlck->rwmtx); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LCNT_LO_READ); +#endif + return res; #else return 0; #endif @@ -378,7 +425,13 @@ erl_drv_rwlock_rlock(ErlDrvRWLock *drwlck) #ifdef USE_THREADS if (!drwlck) fatal_error(EINVAL, "erl_drv_rwlock_rlock()"); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_opt(&drwlck->lcnt, ERTS_LCNT_LO_READ); +#endif ethr_rwmutex_rlock(&drwlck->rwmtx); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post(&drwlck->lcnt); +#endif #endif } @@ -388,6 +441,9 @@ erl_drv_rwlock_runlock(ErlDrvRWLock *drwlck) #ifdef USE_THREADS if (!drwlck) fatal_error(EINVAL, "erl_drv_rwlock_runlock()"); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LCNT_LO_READ); +#endif ethr_rwmutex_runlock(&drwlck->rwmtx); #endif } @@ -396,9 +452,14 @@ int erl_drv_rwlock_tryrwlock(ErlDrvRWLock *drwlck) { #ifdef USE_THREADS + int res; if (!drwlck) fatal_error(EINVAL, "erl_drv_rwlock_tryrwlock()"); - return ethr_rwmutex_tryrwlock(&drwlck->rwmtx); + res = ethr_rwmutex_tryrwlock(&drwlck->rwmtx); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LCNT_LO_READ_WRITE); +#endif + return res; #else return 0; #endif @@ -410,7 +471,13 @@ erl_drv_rwlock_rwlock(ErlDrvRWLock *drwlck) #ifdef USE_THREADS if (!drwlck) fatal_error(EINVAL, "erl_drv_rwlock_rwlock()"); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_opt(&drwlck->lcnt, ERTS_LCNT_LO_READ_WRITE); +#endif ethr_rwmutex_rwlock(&drwlck->rwmtx); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post(&drwlck->lcnt); +#endif #endif } @@ -420,6 +487,9 @@ erl_drv_rwlock_rwunlock(ErlDrvRWLock *drwlck) #ifdef USE_THREADS if (!drwlck) fatal_error(EINVAL, "erl_drv_rwlock_rwunlock()"); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LCNT_LO_READ_WRITE); +#endif ethr_rwmutex_rwunlock(&drwlck->rwmtx); #endif } diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 28b2b02914..6815d76776 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -42,6 +42,7 @@ #include "dtrace-wrapper.h" #include "erl_bif_unique.h" #include "dist.h" +#include "erl_nfunc_sched.h" #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 #define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20 @@ -59,6 +60,10 @@ # define ERTS_GC_ASSERT(B) ((void) 1) #endif +#if defined(DEBUG) && 0 +# define HARDDEBUG 1 +#endif + /* * Returns number of elements in an array. */ @@ -110,18 +115,20 @@ typedef struct { static Uint setup_rootset(Process*, Eterm*, int, Rootset*); static void cleanup_rootset(Rootset *rootset); -static void remove_message_buffers(Process* p); static Eterm *full_sweep_heaps(Process *p, int hibernate, Eterm *n_heap, Eterm* n_htop, char *oh, Uint oh_size, Eterm *objv, int nobj); static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, int fcalls); + int need, Eterm* objv, int nobj, int fcalls, + Uint max_young_gen_usage); static int major_collection(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, Uint *recl); + int need, Eterm* objv, int nobj, + Uint ygen_usage, Uint *recl); static int minor_collection(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, Uint *recl); + int need, Eterm* objv, int nobj, + Uint ygen_usage, Uint *recl); static void do_minor(Process *p, ErlHeapFragment *live_hf_end, char *mature, Uint mature_size, Uint new_sz, Eterm* objv, int nobj); @@ -153,7 +160,7 @@ static void init_gc_info(ErtsGCInfo *gcip); static Uint64 next_vheap_size(Process* p, Uint64 vheap, Uint64 vheap_sz); #ifdef HARDDEBUG -static void disallow_heap_frag_ref_in_heap(Process* p); +static void disallow_heap_frag_ref_in_heap(Process *p, Eterm *heap, Eterm *htop); static void disallow_heap_frag_ref_in_old_heap(Process* p); #endif @@ -176,6 +183,13 @@ typedef struct { erts_smp_atomic32_t refc; } ErtsGCInfoReq; +#ifdef ERTS_DIRTY_SCHEDULERS +static struct { + erts_mtx_t mtx; + ErtsGCInfo info; +} dirty_gc; +#endif + static ERTS_INLINE int gc_cost(Uint gc_moved_live_words, Uint resize_moved_words) { @@ -259,6 +273,11 @@ erts_init_gc(void) init_gc_info(&esdp->gc_info); } +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_init(&dirty_gc.mtx, "dirty_gc_info"); + init_gc_info(&dirty_gc.info); +#endif + init_gcireq_alloc(); } @@ -400,15 +419,15 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end, regs = erts_proc_sched_data(p)->x_reg_array; } #endif - cost = garbage_collect(p, live_hf_end, 0, regs, p->arity, p->fcalls); + cost = garbage_collect(p, live_hf_end, 0, regs, p->arity, p->fcalls, 0); } else { - cost = garbage_collect(p, live_hf_end, 0, regs, arity, p->fcalls); + cost = garbage_collect(p, live_hf_end, 0, regs, arity, p->fcalls, 0); } } else { Eterm val[1]; val[0] = result; - cost = garbage_collect(p, live_hf_end, 0, val, 1, p->fcalls); + cost = garbage_collect(p, live_hf_end, 0, val, 1, p->fcalls, 0); result = val[0]; } BUMP_REDS(p, cost); @@ -477,24 +496,26 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need, int hsz = ssz + need + ERTS_DELAY_GC_EXTRA_FREE; hfrag = new_message_buffer(hsz); - hfrag->next = p->mbuf; - p->mbuf = hfrag; - p->mbuf_sz += hsz; p->heap = p->htop = &hfrag->mem[0]; p->hend = hend = &hfrag->mem[hsz]; p->stop = stop = hend - ssz; sys_memcpy((void *) stop, (void *) orig_stop, ssz * sizeof(Eterm)); if (p->abandoned_heap) { - /* Active heap already in a fragment; adjust it... */ - ErlHeapFragment *hfrag = ((ErlHeapFragment *) - (((char *) orig_heap) - - offsetof(ErlHeapFragment, mem))); - Uint unused = orig_hend - orig_htop; - ASSERT(hfrag->used_size == hfrag->alloc_size); - ASSERT(hfrag->used_size >= unused); - hfrag->used_size -= unused; - p->mbuf_sz -= unused; + /* + * Active heap already in a fragment; adjust it and + * save it into mbuf list... + */ + ErlHeapFragment *hfrag = ((ErlHeapFragment *) + (((char *) orig_heap) + - offsetof(ErlHeapFragment, mem))); + Uint used = orig_htop - orig_heap; + hfrag->used_size = used; + p->mbuf_sz += used; + ASSERT(hfrag->used_size <= hfrag->alloc_size); + ASSERT(!hfrag->off_heap.first && !hfrag->off_heap.overhead); + hfrag->next = p->mbuf; + p->mbuf = hfrag; } else { /* Do not leave a hole in the abandoned heap... */ @@ -556,17 +577,14 @@ young_gen_usage(Process *p) } } + hsz += p->htop - p->heap; aheap = p->abandoned_heap; - if (!aheap) - hsz += p->htop - p->heap; - else { + if (aheap) { /* used in orig heap */ if (p->flags & F_ABANDONED_HEAP_USE) hsz += aheap[p->heap_sz-1]; else hsz += p->heap_sz; - /* Remove unused part in latest fragment */ - hsz -= p->hend - p->htop; } return hsz; } @@ -587,6 +605,32 @@ young_gen_usage(Process *p) } \ } while (0) +#ifdef ERTS_DIRTY_SCHEDULERS + +static ERTS_INLINE void +check_for_possibly_long_gc(Process *p, Uint ygen_usage) +{ + int major; + Uint sz; + + major = (p->flags & F_NEED_FULLSWEEP) || GEN_GCS(p) >= MAX_GEN_GCS(p); + + sz = ygen_usage; + sz += p->hend - p->stop; + if (p->flags & F_ON_HEAP_MSGQ) + sz += p->msg.len; + if (major) + sz += p->old_htop - p->old_heap; + + if (sz >= ERTS_POTENTIALLY_LONG_GC_HSIZE) { + ASSERT(!(p->flags & (F_DISABLE_GC|F_DELAY_GC))); + p->flags |= major ? F_DIRTY_MAJOR_GC : F_DIRTY_MINOR_GC; + erts_schedule_dirty_sys_execution(p); + } +} + +#endif + /* * Garbage collect a process. * @@ -597,28 +641,44 @@ young_gen_usage(Process *p) */ static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, int fcalls) + int need, Eterm* objv, int nobj, int fcalls, + Uint max_young_gen_usage) { Uint reclaimed_now = 0; + Uint ygen_usage; Eterm gc_trace_end_tag; int reds; - ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */ - ErtsSchedulerData *esdp; + ErtsMonotonicTime start_time; + ErtsSchedulerData *esdp = erts_proc_sched_data(p); erts_aint32_t state; ERTS_MSACC_PUSH_STATE_M(); #ifdef USE_VM_PROBES DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif + ERTS_UNDEF(start_time, 0); ERTS_CHK_MBUF_SZ(p); - ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) - >= erts_proc_sched_data(p)->virtual_reds); + ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) >= esdp->virtual_reds); state = erts_smp_atomic32_read_nob(&p->state); - if (p->flags & (F_DISABLE_GC|F_DELAY_GC) || state & ERTS_PSFLG_EXITING) + if ((p->flags & (F_DISABLE_GC|F_DELAY_GC)) || state & ERTS_PSFLG_EXITING) { +#ifdef ERTS_DIRTY_SCHEDULERS + delay_gc_before_start: +#endif return delay_garbage_collection(p, live_hf_end, need, fcalls); + } + + ygen_usage = max_young_gen_usage ? max_young_gen_usage : young_gen_usage(p); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + check_for_possibly_long_gc(p, ygen_usage); + if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) + goto delay_gc_before_start; + } +#endif if (p->abandoned_heap) live_hf_end = ERTS_INVALID_HFRAG_PTR; @@ -627,8 +687,6 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_GC); - esdp = erts_get_scheduler_data(); - erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); if (erts_system_monitor_long_gc != 0) start_time = erts_get_monotonic_time(esdp); @@ -655,14 +713,25 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, trace_gc(p, am_gc_minor_start, need, THE_NON_VALUE); } DTRACE2(gc_minor_start, pidbuf, need); - reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + reds = minor_collection(p, live_hf_end, need, objv, nobj, + ygen_usage, &reclaimed_now); DTRACE2(gc_minor_end, pidbuf, reclaimed_now); if (reds == -1) { if (IS_TRACED_FL(p, F_TRACE_GC)) { trace_gc(p, am_gc_minor_end, reclaimed_now, THE_NON_VALUE); } +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + p->flags |= F_NEED_FULLSWEEP; + check_for_possibly_long_gc(p, ygen_usage); + if (p->flags & F_DIRTY_MAJOR_GC) + goto delay_gc_after_start; + } +#endif goto do_major_collection; } + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + p->flags &= ~F_DIRTY_MINOR_GC; gc_trace_end_tag = am_gc_minor_end; } else { do_major_collection: @@ -671,7 +740,10 @@ do_major_collection: trace_gc(p, am_gc_major_start, need, THE_NON_VALUE); } DTRACE2(gc_major_start, pidbuf, need); - reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + reds = major_collection(p, live_hf_end, need, objv, nobj, + ygen_usage, &reclaimed_now); + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + p->flags &= ~(F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC); DTRACE2(gc_major_end, pidbuf, reclaimed_now); gc_trace_end_tag = am_gc_major_end; ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC); @@ -701,6 +773,9 @@ do_major_collection: am_kill, NIL, NULL, 0); erts_smp_proc_unlock(p, locks & ERTS_PROC_LOCKS_ALL_MINOR); +#ifdef ERTS_DIRTY_SCHEDULERS + delay_gc_after_start: +#endif /* erts_send_exit_signal looks for ERTS_PSFLG_GC, so we have to remove it after the signal is sent */ erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); @@ -735,8 +810,19 @@ do_major_collection: monitor_large_heap(p); } - esdp->gc_info.garbage_cols++; - esdp->gc_info.reclaimed += reclaimed_now; +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + erts_mtx_lock(&dirty_gc.mtx); + dirty_gc.info.garbage_cols++; + dirty_gc.info.reclaimed += reclaimed_now; + erts_mtx_unlock(&dirty_gc.mtx); + } + else +#endif + { + esdp->gc_info.garbage_cols++; + esdp->gc_info.reclaimed += reclaimed_now; + } FLAGS(p) &= ~F_FORCE_GC; p->live_hf_end = ERTS_INVALID_HFRAG_PTR; @@ -765,6 +851,7 @@ do_major_collection: ASSERT(!p->mbuf); ASSERT(!ERTS_IS_GC_DESIRED(p)); + ASSERT(need <= HEAP_LIMIT(p) - HEAP_TOP(p)); return reds; } @@ -772,7 +859,7 @@ do_major_collection: int erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fcalls) { - int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls, 0); int reds_left = ERTS_REDS_LEFT(p, fcalls); if (reds > reds_left) reds = reds_left; @@ -783,12 +870,13 @@ erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fca void erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) { - int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls, 0); BUMP_REDS(p, reds); ASSERT(CONTEXT_REDS - ERTS_BIF_REDS_LEFT(p) >= erts_proc_sched_data(p)->virtual_reds); } + /* * Place all living data on a the new heap; deallocate any old heap. * Meant to be used by hibernate/3. @@ -808,6 +896,20 @@ erts_garbage_collect_hibernate(Process* p) if (p->flags & F_DISABLE_GC) ERTS_INTERNAL_ERROR("GC disabled"); +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p))) + p->flags &= ~(F_DIRTY_GC_HIBERNATE|F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC); + else { + Uint flags = p->flags; + p->flags |= F_NEED_FULLSWEEP; + check_for_possibly_long_gc(p, (p->htop - p->heap) + p->mbuf_sz); + if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) { + p->flags = flags|F_DIRTY_GC_HIBERNATE; + return; + } + p->flags = flags; + } +#endif /* * Preliminaries. */ @@ -819,7 +921,6 @@ erts_garbage_collect_hibernate(Process* p) * Do it. */ - heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz; heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP, @@ -835,11 +936,11 @@ erts_garbage_collect_hibernate(Process* p) p->arg_reg, p->arity); - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (p->abandoned_heap - ? p->abandoned_heap - : p->heap), - p->heap_sz * sizeof(Eterm)); +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p, heap, htop); +#endif + + erts_deallocate_young_generation(p); p->heap = heap; p->high_water = htop; @@ -874,8 +975,6 @@ erts_garbage_collect_hibernate(Process* p) sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm)); ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm)); - remove_message_buffers(p); - p->stop = p->hend = heap + heap_size; offs = heap - p->heap; @@ -962,10 +1061,11 @@ static ERTS_INLINE void offset_nstack(Process* p, Sint offs, #endif /* HIPE */ -void +int erts_garbage_collect_literals(Process* p, Eterm* literals, Uint byte_lit_size, - struct erl_off_heap_header* oh) + struct erl_off_heap_header* oh, + int fcalls) { Uint lit_size = byte_lit_size / sizeof(Eterm); Uint old_heap_size; @@ -977,20 +1077,49 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint area_size; Eterm* old_htop; Uint n; + Uint ygen_usage = 0; struct erl_off_heap_header** prev = NULL; + Sint64 reds; + + if (p->flags & (F_DISABLE_GC|F_DELAY_GC)) + ERTS_INTERNAL_ERROR("GC disabled"); + + /* + * First an ordinary major collection... + */ + + p->flags |= F_NEED_FULLSWEEP; + +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p))) + p->flags &= ~F_DIRTY_CLA; + else { + ygen_usage = young_gen_usage(p); + check_for_possibly_long_gc(p, + (byte_lit_size/sizeof(Uint) + + 2*ygen_usage)); + if (p->flags & F_DIRTY_MAJOR_GC) { + p->flags |= F_DIRTY_CLA; + return 10; + } + } +#endif + + reds = (Sint64) garbage_collect(p, ERTS_INVALID_HFRAG_PTR, 0, + p->arg_reg, p->arity, fcalls, + ygen_usage); + + ASSERT(!(p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC))); - if (p->flags & F_DISABLE_GC) - return; /* * Set GC state. */ erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); /* - * We assume that the caller has already done a major collection - * (which has discarded the old heap), so that we don't have to cope - * with pointer to literals on the old heap. We will now allocate - * an old heap to contain the literals. + * Just did a major collection (which has discarded the old heap), + * so that we don't have to cope with pointer to literals on the + * old heap. We will now allocate an old heap to contain the literals. */ ASSERT(p->old_heap == 0); /* Must NOT have an old heap yet. */ @@ -1133,15 +1262,21 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, * Restore status. */ erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); + + reds += (Sint64) gc_cost((p->htop - p->heap) + byte_lit_size/sizeof(Uint), 0); + if (reds > INT_MAX) + return INT_MAX; + return (int) reds; } static int minor_collection(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, Uint *recl) + int need, Eterm* objv, int nobj, + Uint ygen_usage, Uint *recl) { Eterm *mature = p->abandoned_heap ? p->abandoned_heap : p->heap; Uint mature_size = p->high_water - mature; - Uint size_before = young_gen_usage(p); + Uint size_before = ygen_usage; /* * Check if we have gone past the max heap size limit @@ -1494,22 +1629,16 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end, } #endif - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (p->abandoned_heap - ? p->abandoned_heap - : HEAP_START(p)), - HEAP_SIZE(p) * sizeof(Eterm)); - p->abandoned_heap = NULL; - p->flags &= ~F_ABANDONED_HEAP_USE; +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p, n_heap, n_htop); +#endif + + erts_deallocate_young_generation(p); + HEAP_START(p) = n_heap; HEAP_TOP(p) = n_htop; HEAP_SIZE(p) = new_sz; HEAP_END(p) = n_heap + new_sz; - -#ifdef HARDDEBUG - disallow_heap_frag_ref_in_heap(p); -#endif - remove_message_buffers(p); } /* @@ -1518,7 +1647,8 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end, static int major_collection(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj, Uint *recl) + int need, Eterm* objv, int nobj, + Uint ygen_usage, Uint *recl) { Uint size_before, size_after, stack_size; Eterm* n_heap; @@ -1536,7 +1666,7 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, * to receive all live data. */ - size_before = young_gen_usage(p); + size_before = ygen_usage; size_before += p->old_htop - p->old_heap; stack_size = p->hend - p->stop; @@ -1598,13 +1728,12 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, } #endif - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (p->abandoned_heap - ? p->abandoned_heap - : HEAP_START(p)), - p->heap_sz * sizeof(Eterm)); - p->abandoned_heap = NULL; - p->flags &= ~F_ABANDONED_HEAP_USE; +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p, n_heap, n_htop); +#endif + + erts_deallocate_young_generation(p); + HEAP_START(p) = n_heap; HEAP_TOP(p) = n_htop; HEAP_SIZE(p) = new_sz; @@ -1613,11 +1742,6 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, HIGH_WATER(p) = HEAP_TOP(p); -#ifdef HARDDEBUG - disallow_heap_frag_ref_in_heap(p); -#endif - remove_message_buffers(p); - if (p->flags & F_ON_HEAP_MSGQ) move_msgq_to_heap(p); @@ -1770,22 +1894,56 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) return adjusted; } -/* - * Remove all message buffers. - */ -static void -remove_message_buffers(Process* p) +void +erts_deallocate_young_generation(Process *c_p) { - if (MBUF(p) != NULL) { - free_message_buffer(MBUF(p)); - MBUF(p) = NULL; + Eterm *orig_heap; + + if (!c_p->abandoned_heap) { + orig_heap = c_p->heap; + ASSERT(!(c_p->flags & F_ABANDONED_HEAP_USE)); + } + else { + ErlHeapFragment *hfrag; + + orig_heap = c_p->abandoned_heap; + c_p->abandoned_heap = NULL; + c_p->flags &= ~F_ABANDONED_HEAP_USE; + + /* + * Temporary heap located in heap fragment + * only referred to by 'c_p->heap'. Add it to + * 'c_p->mbuf' list and deallocate it as any + * other heap fragment... + */ + hfrag = ((ErlHeapFragment *) + (((char *) c_p->heap) + - offsetof(ErlHeapFragment, mem))); + + ASSERT(!hfrag->off_heap.first); + ASSERT(!hfrag->off_heap.overhead); + ASSERT(!hfrag->next); + ASSERT(c_p->htop - c_p->heap <= hfrag->alloc_size); + + hfrag->next = c_p->mbuf; + c_p->mbuf = hfrag; + } + + if (c_p->mbuf) { + free_message_buffer(c_p->mbuf); + c_p->mbuf = NULL; } - if (p->msg_frag) { - erts_cleanup_messages(p->msg_frag); - p->msg_frag = NULL; + if (c_p->msg_frag) { + erts_cleanup_messages(c_p->msg_frag); + c_p->msg_frag = NULL; } - MBUF_SIZE(p) = 0; + c_p->mbuf_sz = 0; + + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, + orig_heap, + c_p->heap_sz * sizeof(Eterm)); } + #ifdef HARDDEBUG /* @@ -1797,19 +1955,15 @@ remove_message_buffers(Process* p) */ static void -disallow_heap_frag_ref_in_heap(Process* p) +disallow_heap_frag_ref_in_heap(Process *p, Eterm *heap, Eterm *htop) { Eterm* hp; - Eterm* htop; - Eterm* heap; Uint heap_size; if (p->mbuf == 0) { return; } - htop = p->htop; - heap = p->heap; heap_size = (htop - heap)*sizeof(Eterm); hp = heap; @@ -2384,17 +2538,10 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) } /* - * If a NIF has saved arguments, they need to be added + * If a NIF or BIF has saved arguments, they need to be added */ - if (ERTS_PROC_GET_NIF_TRAP_EXPORT(p)) { - Eterm* argv; - int argc; - if (erts_setup_nif_gc(p, &argv, &argc)) { - roots[n].v = argv; - roots[n].sz = argc; - n++; - } - } + if (erts_setup_nif_export_rootset(p, &roots[n].v, &roots[n].sz)) + n++; ASSERT(n <= rootset->size); @@ -2946,6 +3093,8 @@ static void ERTS_INLINE offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, Eterm* objv, int nobj) { + Eterm *v; + Uint sz; if (p->dictionary) { offset_heap(ERTS_PD_START(p->dictionary), ERTS_PD_SIZE(p->dictionary), @@ -2966,12 +3115,8 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, offset_heap_ptr(objv, nobj, offs, area, area_size); } offset_off_heap(p, offs, area, area_size); - if (ERTS_PROC_GET_NIF_TRAP_EXPORT(p)) { - Eterm* argv; - int argc; - if (erts_setup_nif_gc(p, &argv, &argc)) - offset_heap_ptr(argv, argc, offs, area, area_size); - } + if (erts_setup_nif_export_rootset(p, &v, &sz)) + offset_heap_ptr(v, sz, offs, area, area_size); } static void @@ -3009,6 +3154,18 @@ reply_gc_info(void *vgcirp) reclaimed = esdp->gc_info.reclaimed; garbage_cols = esdp->gc_info.garbage_cols; +#ifdef ERTS_DIRTY_SCHEDULERS + /* + * Add dirty schedulers info on requesting + * schedulers info + */ + if (gcirp->req_sched == esdp->no) { + erts_mtx_lock(&dirty_gc.mtx); + reclaimed += dirty_gc.info.reclaimed; + garbage_cols += dirty_gc.info.garbage_cols; + erts_mtx_unlock(&dirty_gc.mtx); + } +#endif sz = 0; hpp = NULL; @@ -3289,13 +3446,15 @@ within2(Eterm *ptr, Process *p, Eterm *real_htop) ErtsMessage* mp; Eterm *htop, *heap; - if (p->abandoned_heap) + if (p->abandoned_heap) { ERTS_GET_ORIG_HEAP(p, heap, htop); - else { - heap = p->heap; - htop = real_htop ? real_htop : HEAP_TOP(p); + if (heap <= ptr && ptr < htop) + return 1; } + heap = p->heap; + htop = real_htop ? real_htop : HEAP_TOP(p); + if (OLD_HEAP(p) && (OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p))) { return 1; } diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index 54ea9ca3c0..f4cbe732ce 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -25,11 +25,9 @@ /* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */ -#include "erl_map.h" +#define ERTS_POTENTIALLY_LONG_GC_HSIZE (128*1024) /* Words */ -#if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF -# define HARDDEBUG 1 -#endif +#include "erl_map.h" #define IS_MOVED_BOXED(x) (!is_header((x))) #define IS_MOVED_CONS(x) (is_non_value((x))) @@ -145,9 +143,10 @@ void erts_garbage_collect_hibernate(struct process* p); Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end, Eterm result, Eterm* regs, Uint arity); Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity); -void erts_garbage_collect_literals(struct process* p, Eterm* literals, - Uint lit_size, - struct erl_off_heap_header* oh); +int erts_garbage_collect_literals(struct process* p, Eterm* literals, + Uint lit_size, + struct erl_off_heap_header* oh, + int fcalls); Uint erts_next_heap_size(Uint, Uint); Eterm erts_heap_sizes(struct process* p); @@ -157,5 +156,6 @@ void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); void erts_free_heap_frags(struct process* p); Eterm erts_max_heap_size_map(Sint, Uint, Eterm **, Uint *); int erts_max_heap_size(Eterm, Uint *, Uint *); +void erts_deallocate_young_generation(Process *c_p); #endif /* __ERL_GC_H__ */ diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index d29d079fc5..647fa26811 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -2666,7 +2666,7 @@ erts_start_timer_callback(ErtsMonotonicTime tmo, tmo); twt = tmo < ERTS_TIMER_WHEEL_MSEC; - if (esdp) + if (esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)) start_callback_timer(esdp, twt, timeout_pos, @@ -2865,7 +2865,8 @@ btm_print(ErtsHLTimer *tmr, void *vbtmp) if (tmr->timeout <= btmp->now) left = 0; - left = ERTS_CLKTCKS_TO_MSEC(tmr->timeout - btmp->now); + else + left = ERTS_CLKTCKS_TO_MSEC(tmr->timeout - btmp->now); receiver = ((tmr->head.roflgs & ERTS_TMR_ROFLG_REG_NAME) ? tmr->receiver.name diff --git a/erts/emulator/beam/erl_hl_timer.h b/erts/emulator/beam/erl_hl_timer.h index 705be94532..9cdcd581a0 100644 --- a/erts/emulator/beam/erl_hl_timer.h +++ b/erts/emulator/beam/erl_hl_timer.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2015. All Rights Reserved. + * Copyright Ericsson AB 2015-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. diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 356f5ca71e..08dcbed91c 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -127,6 +127,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "run_queue", "address" }, #ifdef ERTS_DIRTY_SCHEDULERS { "dirty_run_queue_sleep_list", "address" }, + { "dirty_gc_info", NULL }, + { "dirty_break_point_index", NULL }, #endif { "process_table", NULL }, { "cpu_info", NULL }, diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c index 481e92b2cd..6354fc8663 100644 --- a/erts/emulator/beam/erl_lock_count.c +++ b/erts/emulator/beam/erl_lock_count.c @@ -55,11 +55,11 @@ static erts_lcnt_thread_data_t *lcnt_thread_data[2048]; /* local functions */ static ERTS_INLINE void lcnt_lock(void) { - ethr_mutex_lock(&lcnt_data_lock); + ethr_mutex_lock(&lcnt_data_lock); } static ERTS_INLINE void lcnt_unlock(void) { - ethr_mutex_unlock(&lcnt_data_lock); + ethr_mutex_unlock(&lcnt_data_lock); } const int log2_tab64[64] = { @@ -159,7 +159,7 @@ static erts_lcnt_thread_data_t *lcnt_thread_data_alloc(void) { lcnt_thread_data[eltd->id] = eltd; return eltd; -} +} static erts_lcnt_thread_data_t *lcnt_get_thread_data(void) { return (erts_lcnt_thread_data_t *)ethr_tsd_get(lcnt_thr_data_key); @@ -254,9 +254,9 @@ void erts_lcnt_init() { /* init lock */ if (ethr_mutex_init(&lcnt_data_lock) != 0) abort(); - /* init tsd */ + /* init tsd */ lcnt_n_thr = 0; - ethr_tsd_key_create(&lcnt_thr_data_key,"lcnt_data"); + ethr_tsd_key_create(&lcnt_thr_data_key, "lcnt_data"); lcnt_lock(); @@ -352,11 +352,11 @@ void erts_lcnt_list_delete(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock) /* interface to erl_threads.h */ /* only lock on init and destroy, all others should use atomics */ -void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag ) { +void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag ) { erts_lcnt_init_lock_x(lock, name, flag, NIL); } -void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id) { +void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id) { int i; if (name == NULL) { ERTS_LCNT_CLEAR_FLAG(lock); return; } lcnt_lock(); @@ -382,7 +382,10 @@ void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eter erts_lcnt_list_insert(erts_lcnt_data->current_locks, lock); lcnt_unlock(); } -/* init empty, instead of zero struct */ + +/* init empty, instead of zero struct + * used by process locks probes + */ void erts_lcnt_init_lock_empty(erts_lcnt_lock_t *lock) { lock->next = NULL; lock->prev = NULL; @@ -444,7 +447,7 @@ void erts_lcnt_lock_opt(erts_lcnt_lock_t *lock, Uint16 option) { } /* we cannot acquire w_lock if either w or r are taken */ - /* we cannot acquire r_lock if w_lock is taken */ + /* we cannot acquire r_lock if w_lock is taken */ if ((w_state > 0) || (r_state > 0)) { eltd->lock_in_conflict = 1; @@ -561,7 +564,7 @@ void erts_lcnt_unlock(erts_lcnt_lock_t *lock) { if (ERTS_LCNT_IS_LOCK_INVALID(lock)) return; #ifdef DEBUG { - erts_aint_t w_state; + erts_aint_t w_state; erts_aint_t flowstate; /* flowstate */ @@ -647,7 +650,7 @@ Uint16 erts_lcnt_set_rt_opt(Uint16 opt) { return prev; } -Uint16 erts_lcnt_clear_rt_opt(Uint16 opt) { +Uint16 erts_lcnt_clear_rt_opt(Uint16 opt) { Uint16 prev; prev = (erts_lcnt_rt_options & opt); erts_lcnt_rt_options &= ~opt; diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h index 3e8dcefe69..4f838f7faa 100644 --- a/erts/emulator/beam/erl_lock_count.h +++ b/erts/emulator/beam/erl_lock_count.h @@ -148,13 +148,13 @@ typedef struct erts_lcnt_lock_stats_s { typedef struct erts_lcnt_lock_s { char *name; /* lock name */ Uint16 flag; /* lock type */ - Eterm id; /* id if possible */ + Eterm id; /* id if possible */ #ifdef DEBUG ethr_atomic_t flowstate; #endif - /* lock states */ + /* lock states */ ethr_atomic_t w_state; /* 0 not taken, otherwise n threads waiting */ ethr_atomic_t r_state; /* 0 not taken, > 0 -> writes will wait */ diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 118adc0c1b..792b69bb37 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -193,7 +193,7 @@ free_message_buffer(ErlHeapFragment* bp) erts_cleanup_offheap(&bp->off_heap); ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, (void *) bp, - ERTS_HEAP_FRAG_SIZE(bp->size)); + ERTS_HEAP_FRAG_SIZE(bp->alloc_size)); bp = next_bp; }while (bp != NULL); } diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c index 421445fbad..66bb55e6c8 100644 --- a/erts/emulator/beam/erl_msacc.c +++ b/erts/emulator/beam/erl_msacc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014-2015. All Rights Reserved. + * Copyright Ericsson AB 2014-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. @@ -137,8 +137,8 @@ void erts_msacc_init_thread(char *type, int id, int managed) { void erts_msacc_set_bif_state(ErtsMsAcc *__erts_msacc_cache, Eterm mod, void *fn) { #ifdef ERTS_MSACC_EXTENDED_BIFS -#define BIF_LIST(Mod,Func,Arity,FuncAddr,Num) \ - if (fn == &FuncAddr) { \ +#define BIF_LIST(Mod,Func,Arity,BifFuncAddr,FuncAddr,Num) \ + if (fn == &BifFuncAddr) { \ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATIC_STATE_COUNT + Num); \ } else #include "erl_bif_list.h" diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h index 7e02d8e101..d64ef8c8b9 100644 --- a/erts/emulator/beam/erl_msacc.h +++ b/erts/emulator/beam/erl_msacc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014-2015. All Rights Reserved. + * Copyright Ericsson AB 2014-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. @@ -122,7 +122,7 @@ static char *erts_msacc_states[] = { "sleep", "timers" #ifdef ERTS_MSACC_EXTENDED_BIFS -#define BIF_LIST(Mod,Func,Arity,FuncAddr,Num) \ +#define BIF_LIST(Mod,Func,Arity,BifFuncAddr,FuncAddr,Num) \ ,"bif_" #Mod "_" #Func "_" #Arity #include "erl_bif_list.h" #undef BIF_LIST diff --git a/erts/emulator/beam/erl_nfunc_sched.c b/erts/emulator/beam/erl_nfunc_sched.c new file mode 100644 index 0000000000..1bebc1eda4 --- /dev/null +++ b/erts/emulator/beam/erl_nfunc_sched.c @@ -0,0 +1,180 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERTS_WANT_NFUNC_SCHED_INTERNALS__ + +#include "global.h" +#include "erl_process.h" +#include "bif.h" +#include "erl_nfunc_sched.h" +#include "erl_trace.h" + +NifExport * +erts_new_proc_nif_export(Process *c_p, int argc) +{ + size_t size; + int i; + NifExport *nep, *old_nep; + + size = sizeof(NifExport) + (argc-1)*sizeof(Eterm); + nep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, size); + + for (i = 0; i < ERTS_NUM_CODE_IX; i++) + nep->exp.addressv[i] = &nep->exp.beam[0]; + + nep->argc = -1; /* unused marker */ + nep->argv_size = argc; + nep->trace = NULL; + old_nep = ERTS_PROC_SET_NIF_TRAP_EXPORT(c_p, nep); + if (old_nep) { + ASSERT(!nep->trace); + erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, old_nep); + } + return nep; +} + +void +erts_destroy_nif_export(Process *p) +{ + NifExport *nep = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL); + if (nep) { + if (nep->m) + erts_nif_export_cleanup_nif_mod(nep); + erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, nep); + } +} + +void +erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying, + Export* ep, BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer) +{ + NifExportTrace *netp; + ASSERT(nep && nep->argc >= 0); + ASSERT(!nep->trace); + netp = erts_alloc(ERTS_ALC_T_NIF_EXP_TRACE, + sizeof(NifExportTrace)); + netp->applying = applying; + netp->ep = ep; + netp->cp = cp; + netp->flags = flags; + netp->flags_meta = flags_meta; + netp->I = I; + netp->meta_tracer = NIL; + erts_tracer_update(&netp->meta_tracer, meta_tracer); + nep->trace = netp; +} + +void +erts_nif_export_restore_trace(Process *c_p, Eterm result, NifExport *nep) +{ + NifExportTrace *netp = nep->trace; + nep->trace = NULL; + erts_bif_trace_epilogue(c_p, result, netp->applying, netp->ep, + netp->cp, netp->flags, netp->flags_meta, + netp->I, netp->meta_tracer); + erts_tracer_update(&netp->meta_tracer, NIL); + erts_free(ERTS_ALC_T_NIF_EXP_TRACE, netp); +} + +NifExport * +erts_nif_export_schedule(Process *c_p, Process *dirty_shadow_proc, + ErtsCodeMFA *mfa, BeamInstr *pc, + BeamInstr instr, + void *dfunc, void *ifunc, + Eterm mod, Eterm func, + int argc, const Eterm *argv) +{ + Process *used_proc; + ErtsSchedulerData *esdp; + Eterm* reg; + NifExport* nep; + int i; + + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) + & ERTS_PROC_LOCK_MAIN); + + if (dirty_shadow_proc) { + esdp = erts_get_scheduler_data(); + ASSERT(esdp && ERTS_SCHEDULER_IS_DIRTY(esdp)); + + used_proc = dirty_shadow_proc; + } + else { + esdp = erts_proc_sched_data(c_p); + ASSERT(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)); + + used_proc = c_p; + ERTS_VBUMP_ALL_REDS(c_p); + } + + reg = esdp->x_reg_array; + + if (mfa) + nep = erts_get_proc_nif_export(c_p, (int) mfa->arity); + else { + /* If no mfa, this is not the first schedule... */ + nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + ASSERT(nep && nep->argc >= 0); + } + + if (nep->argc < 0) { + /* + * First schedule; save things that might + * need to be restored... + */ + for (i = 0; i < (int) mfa->arity; i++) + nep->argv[i] = reg[i]; + nep->pc = pc; + nep->cp = c_p->cp; + nep->mfa = mfa; + nep->current = c_p->current; + ASSERT(argc >= 0); + nep->argc = (int) mfa->arity; + nep->m = NULL; + + ASSERT(!erts_check_nif_export_in_area(c_p, + (char *) nep, + (sizeof(NifExport) + + (sizeof(Eterm) + *(nep->argc-1))))); + } + /* Copy new arguments into register array if necessary... */ + if (reg != argv) { + for (i = 0; i < argc; i++) + reg[i] = argv[i]; + } + ASSERT(is_atom(mod) && is_atom(func)); + nep->exp.info.mfa.module = mod; + nep->exp.info.mfa.function = func; + nep->exp.info.mfa.arity = (Uint) argc; + nep->exp.beam[0] = (BeamInstr) instr; /* call_nif || apply_bif */ + nep->exp.beam[1] = (BeamInstr) dfunc; + nep->func = ifunc; + used_proc->arity = argc; + used_proc->freason = TRAP; + used_proc->i = (BeamInstr*) nep->exp.addressv[0]; + return nep; +} diff --git a/erts/emulator/beam/erl_nfunc_sched.h b/erts/emulator/beam/erl_nfunc_sched.h new file mode 100644 index 0000000000..55a3a6dbf6 --- /dev/null +++ b/erts/emulator/beam/erl_nfunc_sched.h @@ -0,0 +1,332 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 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% + */ + +#ifndef ERL_NFUNC_SCHED_H__ +#define ERL_NFUNC_SCHED_H__ + +#include "erl_process.h" +#include "bif.h" +#include "error.h" + +typedef struct { + int applying; + Export* ep; + BeamInstr *cp; + Uint32 flags; + Uint32 flags_meta; + BeamInstr* I; + ErtsTracer meta_tracer; +} NifExportTrace; + +/* + * NIF exports need a few more items than the Export struct provides, + * including the erl_module_nif* and a NIF function pointer, so the + * NifExport below adds those. The Export member must be first in the + * struct. A number of values are stored for error handling purposes + * only. + * + * 'argc' is >= 0 when NifExport is in use, and < 0 when not. + */ + +typedef struct { + Export exp; + struct erl_module_nif* m; /* NIF module, or NULL if BIF */ + void *func; /* Indirect NIF or BIF to execute (may be unused) */ + ErtsCodeMFA *current;/* Current as set when originally called */ + NifExportTrace *trace; + /* --- The following is only used on error --- */ + BeamInstr *pc; /* Program counter */ + BeamInstr *cp; /* Continuation pointer */ + ErtsCodeMFA *mfa; /* MFA of original call */ + int argc; /* Number of arguments in original call */ + int argv_size; /* Allocated size of argv */ + Eterm argv[1]; /* Saved arguments from the original call */ +} NifExport; + +NifExport *erts_new_proc_nif_export(Process *c_p, int argc); +void erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying, + Export* ep, BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer); +void erts_nif_export_restore_trace(Process *c_p, Eterm result, NifExport *nep); +void erts_destroy_nif_export(Process *p); +NifExport *erts_nif_export_schedule(Process *c_p, Process *dirty_shadow_proc, + ErtsCodeMFA *mfa, BeamInstr *pc, + BeamInstr instr, + void *dfunc, void *ifunc, + Eterm mod, Eterm func, + int argc, const Eterm *argv); +void erts_nif_export_cleanup_nif_mod(NifExport *ep); /* erl_nif.c */ +ERTS_GLB_INLINE NifExport *erts_get_proc_nif_export(Process *c_p, int extra); +ERTS_GLB_INLINE int erts_setup_nif_export_rootset(Process* proc, Eterm** objv, + Uint* nobj); +ERTS_GLB_INLINE int erts_check_nif_export_in_area(Process *p, + char *start, Uint size); +ERTS_GLB_INLINE void erts_nif_export_restore(Process *c_p, NifExport *ep, + Eterm result); +ERTS_GLB_INLINE void erts_nif_export_restore_error(Process* c_p, BeamInstr **pc, + Eterm *reg, ErtsCodeMFA **nif_mfa); +ERTS_GLB_INLINE int erts_nif_export_check_save_trace(Process *c_p, Eterm result, + int applying, Export* ep, + BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer); +ERTS_GLB_INLINE Process *erts_proc_shadow2real(Process *c_p); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE NifExport * +erts_get_proc_nif_export(Process *c_p, int argc) +{ + NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + if (!nep || (nep->argc < 0 && nep->argv_size < argc)) + return erts_new_proc_nif_export(c_p, argc); + return nep; +} + +/* + * If a process has saved arguments, they need to be part of the GC + * rootset. The function below is called from setup_rootset() in + * erl_gc.c. Any exception term saved in the NifExport is also made + * part of the GC rootset here; it always resides in rootset[0]. + */ +ERTS_GLB_INLINE int +erts_setup_nif_export_rootset(Process* proc, Eterm** objv, Uint* nobj) +{ + NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + + if (!ep || ep->argc <= 0) + return 0; + + *objv = ep->argv; + *nobj = ep->argc; + return 1; +} + +/* + * Check if nif export points into code area... + */ +ERTS_GLB_INLINE int +erts_check_nif_export_in_area(Process *p, char *start, Uint size) +{ + NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(p); + if (!nep || nep->argc < 0) + return 0; + if (ErtsInArea(nep->pc, start, size)) + return 1; + if (ErtsInArea(nep->cp, start, size)) + return 1; + if (ErtsInArea(nep->mfa, start, size)) + return 1; + if (ErtsInArea(nep->current, start, size)) + return 1; + return 0; +} + +ERTS_GLB_INLINE void +erts_nif_export_restore(Process *c_p, NifExport *ep, Eterm result) +{ + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); + ERTS_SMP_LC_ASSERT(!(c_p->static_flags + & ERTS_STC_FLG_SHADOW_PROC)); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) + & ERTS_PROC_LOCK_MAIN); + + c_p->current = ep->current; + ep->argc = -1; /* Unused nif-export marker... */ + if (ep->trace) + erts_nif_export_restore_trace(c_p, result, ep); +} + +ERTS_GLB_INLINE void +erts_nif_export_restore_error(Process* c_p, BeamInstr **pc, + Eterm *reg, ErtsCodeMFA **nif_mfa) +{ + NifExport *nep = (NifExport *) ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + int ix; + + ASSERT(nep); + *pc = nep->pc; + c_p->cp = nep->cp; + *nif_mfa = nep->mfa; + for (ix = 0; ix < nep->argc; ix++) + reg[ix] = nep->argv[ix]; + erts_nif_export_restore(c_p, nep, THE_NON_VALUE); +} + +ERTS_GLB_INLINE int +erts_nif_export_check_save_trace(Process *c_p, Eterm result, + int applying, Export* ep, + BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer) +{ + if (is_non_value(result) && c_p->freason == TRAP) { + NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); + if (nep && nep->argc >= 0) { + erts_nif_export_save_trace(c_p, nep, applying, ep, + cp, flags, flags_meta, + I, meta_tracer); + return 1; + } + } + return 0; +} + +ERTS_GLB_INLINE Process * +erts_proc_shadow2real(Process *c_p) +{ +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->static_flags & ERTS_STC_FLG_SHADOW_PROC) { + Process *real_c_p = c_p->next; + ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); + ASSERT(real_c_p->common.id == c_p->common.id); + return real_c_p; + } + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); +#endif + return c_p; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERL_NFUNC_SCHED_H__ */ + +#if defined(ERTS_WANT_NFUNC_SCHED_INTERNALS__) && !defined(ERTS_NFUNC_SCHED_INTERNALS__) +#define ERTS_NFUNC_SCHED_INTERNALS__ + +#define ERTS_I_BEAM_OP_TO_NIF_EXPORT(I) \ + (ASSERT(BeamOp(op_apply_bif) == (BeamInstr *) (*(I)) \ + || BeamOp(op_call_nif) == (BeamInstr *) (*(I))), \ + ((NifExport *) (((char *) (I)) - offsetof(NifExport, exp.beam[0])))) + +#ifdef ERTS_DIRTY_SCHEDULERS + +#include "erl_message.h" +#include <stddef.h> + +ERTS_GLB_INLINE void erts_flush_dirty_shadow_proc(Process *sproc); +ERTS_GLB_INLINE void erts_cache_dirty_shadow_proc(Process *sproc); +ERTS_GLB_INLINE Process *erts_make_dirty_shadow_proc(ErtsSchedulerData *esdp, + Process *c_p); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_flush_dirty_shadow_proc(Process *sproc) +{ + Process *c_p = sproc->next; + + ASSERT(sproc->common.id == c_p->common.id); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) + & ERTS_PROC_LOCK_MAIN); + + ASSERT(c_p->stop == sproc->stop); + ASSERT(c_p->hend == sproc->hend); + ASSERT(c_p->heap == sproc->heap); + ASSERT(c_p->abandoned_heap == sproc->abandoned_heap); + ASSERT(c_p->heap_sz == sproc->heap_sz); + ASSERT(c_p->high_water == sproc->high_water); + ASSERT(c_p->old_heap == sproc->old_heap); + ASSERT(c_p->old_htop == sproc->old_htop); + ASSERT(c_p->old_hend == sproc->old_hend); + + ASSERT(c_p->htop <= sproc->htop && sproc->htop <= c_p->stop); + + c_p->htop = sproc->htop; + + if (!c_p->mbuf) + c_p->mbuf = sproc->mbuf; + else if (sproc->mbuf) { + ErlHeapFragment *bp; + for (bp = sproc->mbuf; bp->next; bp = bp->next) + ASSERT(!bp->off_heap.first); + bp->next = c_p->mbuf; + c_p->mbuf = sproc->mbuf; + } + + c_p->mbuf_sz += sproc->mbuf_sz; + + if (!c_p->off_heap.first) + c_p->off_heap.first = sproc->off_heap.first; + else if (sproc->off_heap.first) { + struct erl_off_heap_header *ohhp; + for (ohhp = sproc->off_heap.first; ohhp->next; ohhp = ohhp->next) + ; + ohhp->next = c_p->off_heap.first; + c_p->off_heap.first = sproc->off_heap.first; + } + + c_p->off_heap.overhead += sproc->off_heap.overhead; +} + +ERTS_GLB_INLINE void +erts_cache_dirty_shadow_proc(Process *sproc) +{ + Process *c_p = sproc->next; + ASSERT(c_p); + ASSERT(sproc->common.id == c_p->common.id); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) + & ERTS_PROC_LOCK_MAIN); + + sproc->htop = c_p->htop; + sproc->stop = c_p->stop; + sproc->hend = c_p->hend; + sproc->heap = c_p->heap; + sproc->abandoned_heap = c_p->abandoned_heap; + sproc->heap_sz = c_p->heap_sz; + sproc->high_water = c_p->high_water; + sproc->old_hend = c_p->old_hend; + sproc->old_htop = c_p->old_htop; + sproc->old_heap = c_p->old_heap; + sproc->mbuf = NULL; + sproc->mbuf_sz = 0; + ERTS_INIT_OFF_HEAP(&sproc->off_heap); +} + +ERTS_GLB_INLINE Process * +erts_make_dirty_shadow_proc(ErtsSchedulerData *esdp, Process *c_p) +{ + Process *sproc; + + ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp)); + + sproc = esdp->dirty_shadow_process; + ASSERT(sproc); + ASSERT(sproc->static_flags & ERTS_STC_FLG_SHADOW_PROC); + ASSERT(erts_smp_atomic32_read_nob(&sproc->state) + == (ERTS_PSFLG_ACTIVE + | ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_PROXY)); + + sproc->next = c_p; + sproc->common.id = c_p->common.id; + + erts_cache_dirty_shadow_proc(sproc); + + return sproc; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERTS_DIRTY_SCHEDULERS */ + +#endif /* defined(ERTS_WANT_NFUNC_SCHED_INTERNALS__) && !defined(ERTS_NFUNC_SCHED_INTERNALS__) */ + diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 4e41944ccb..85fa53a886 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -55,6 +55,9 @@ #include "dtrace-wrapper.h" #include "erl_process.h" #include "erl_bif_unique.h" +#undef ERTS_WANT_NFUNC_SCHED_INTERNALS__ +#define ERTS_WANT_NFUNC_SCHED_INTERNALS__ +#include "erl_nfunc_sched.h" #if defined(USE_DYNAMIC_TRACE) && (defined(USE_DTRACE) || defined(USE_SYSTEMTAP)) #define HAVE_USE_DTRACE 1 #endif @@ -79,8 +82,11 @@ struct erl_module_nif { ErlNifFunc _funcs_copy_[1]; /* only used for old libs */ }; +typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]); + #ifdef DEBUG # define READONLY_CHECK +# define ERTS_DBG_NIF_NOT_SCHED_MARKER ((void *) (UWord) 1) #endif #ifdef READONLY_CHECK # define ADD_READONLY_CHECK(ENV,PTR,SIZE) add_readonly_check(ENV,PTR,SIZE) @@ -219,38 +225,6 @@ static void cache_env(ErlNifEnv* env); static void full_flush_env(ErlNifEnv *env); static void flush_env(ErlNifEnv* env); -#ifdef ERTS_DIRTY_SCHEDULERS -void erts_pre_dirty_nif(ErtsSchedulerData *esdp, - ErlNifEnv* env, Process* p, - struct erl_module_nif* mod_nif) -{ - Process *sproc; -#ifdef DEBUG - erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state); - - ASSERT(!p->scheduler_data); - ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING) - && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))); - ASSERT(esdp); -#endif - - erts_pre_nif(env, p, mod_nif, NULL); - - sproc = esdp->dirty_shadow_process; - ASSERT(sproc); - ASSERT(sproc->static_flags & ERTS_STC_FLG_SHADOW_PROC); - ASSERT(erts_smp_atomic32_read_nob(&sproc->state) - == (ERTS_PSFLG_ACTIVE - | ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_PROXY)); - - sproc->next = p; - sproc->common.id = p->common.id; - env->proc = sproc; - full_cache_env(env); -} -#endif - /* Temporary object header, auto-deallocated when NIF returns * or when independent environment is cleared. */ @@ -278,115 +252,154 @@ void erts_post_nif(ErlNifEnv* env) env->exiting = ERTS_PROC_IS_EXITING(env->proc); } -#ifdef ERTS_DIRTY_SCHEDULERS -void erts_post_dirty_nif(ErlNifEnv* env) + +/* + * Initialize a NifExport struct. Create it if needed and store it in the + * proc. The direct_fp function is what will be invoked by op_call_nif, and + * the indirect_fp function, if not NULL, is what the direct_fp function + * will call. If the allocated NifExport isn't enough to hold all of argv, + * allocate a larger one. Save 'current' and registers if first time this + * call is scheduled. + */ + +static ERTS_INLINE ERL_NIF_TERM +schedule(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp, + Eterm mod, Eterm func_name, int argc, const ERL_NIF_TERM argv[]) { - Process *c_p; - ASSERT(env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC); - ASSERT(env->proc->next); - erts_unblock_fpe(env->fpe_was_unmasked); - full_flush_env(env); - free_tmp_objs(env); - c_p = env->proc->next; - env->exiting = ERTS_PROC_IS_EXITING(c_p); - ERTS_VBUMP_ALL_REDS(c_p); + NifExport *ep; + Process *c_p, *dirty_shadow_proc; + + execution_state(env, &c_p, NULL); + if (c_p == env->proc) + dirty_shadow_proc = NULL; + else + dirty_shadow_proc = env->proc; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p)); + + ep = erts_nif_export_schedule(c_p, dirty_shadow_proc, + c_p->current, + c_p->cp, + (BeamInstr) em_call_nif, + direct_fp, indirect_fp, + mod, func_name, + argc, (const Eterm *) argv); + if (!ep->m) { + /* First time this call is scheduled... */ + erts_refc_inc(&env->mod_nif->rt_dtor_cnt, 1); + ep->m = env->mod_nif; + } + return (ERL_NIF_TERM) THE_NON_VALUE; } -#endif -static void full_flush_env(ErlNifEnv* env) -{ #ifdef ERTS_DIRTY_SCHEDULERS - if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) { - /* Dirty nif call using shadow process struct */ - Process *c_p = env->proc->next; - - ASSERT(is_scheduler() < 0); - ASSERT(env->proc->common.id == c_p->common.id); - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) - & ERTS_PROC_LOCK_MAIN); - - if (!env->heap_frag) { - ASSERT(env->hp_end == HEAP_LIMIT(c_p)); - ASSERT(env->hp >= HEAP_TOP(c_p)); - ASSERT(env->hp <= HEAP_LIMIT(c_p)); - HEAP_TOP(c_p) = env->hp; + +static ERL_NIF_TERM dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +int +erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *reg) +{ + int exiting; + ERL_NIF_TERM *argv = (ERL_NIF_TERM *) reg; + NifExport *nep = ERTS_I_BEAM_OP_TO_NIF_EXPORT(I); + ErtsCodeMFA *codemfa = erts_code_to_codemfa(I); + NativeFunPtr dirty_nif = (NativeFunPtr) I[1]; + ErlNifEnv env; + ERL_NIF_TERM result; +#ifdef DEBUG + erts_aint32_t state = erts_smp_atomic32_read_nob(&c_p->state); + + ASSERT(nep == ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p)); + + ASSERT(!c_p->scheduler_data); + ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING) + && !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))); + ASSERT(esdp); + + nep->func = ERTS_DBG_NIF_NOT_SCHED_MARKER; +#endif + + erts_pre_nif(&env, c_p, nep->m, NULL); + + env.proc = erts_make_dirty_shadow_proc(esdp, c_p); + + env.proc->freason = EXC_NULL; + env.proc->fvalue = NIL; + env.proc->ftrace = NIL; + env.proc->i = c_p->i; + + ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p))); + + erts_smp_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC)); + + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + + result = (*dirty_nif)(&env, codemfa->arity, argv); /* Call dirty NIF */ + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + + ASSERT(env.proc->static_flags & ERTS_STC_FLG_SHADOW_PROC); + ASSERT(env.proc->next == c_p); + + exiting = ERTS_PROC_IS_EXITING(c_p); + + if (!exiting) { + if (env.exception_thrown) { + schedule_exception: + schedule(&env, dirty_nif_exception, NULL, + am_erts_internal, am_dirty_nif_exception, + 1, &env.proc->fvalue); + } + else if (is_value(result)) { + schedule(&env, dirty_nif_finalizer, NULL, + am_erts_internal, am_dirty_nif_finalizer, + 1, &result); + } + else if (env.proc->freason != TRAP) { /* user returned garbage... */ + ERTS_DECL_AM(badreturn); + (void) enif_raise_exception(&env, AM_badreturn); + goto schedule_exception; } else { - Uint usz; - ASSERT(env->hp_end != HEAP_LIMIT(c_p)); - ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size); - - HEAP_TOP(c_p) = HEAP_TOP(env->proc); - usz = env->hp - env->heap_frag->mem; - env->proc->mbuf_sz += usz - env->heap_frag->used_size; - env->heap_frag->used_size = usz; - - ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size); - - if (c_p->mbuf) { - ErlHeapFragment *bp; - for (bp = env->proc->mbuf; bp->next; bp = bp->next) - ; - bp->next = c_p->mbuf; - } + /* Rescheduled by dirty NIF call... */ + ASSERT(nep->func != ERTS_DBG_NIF_NOT_SCHED_MARKER); + } + c_p->i = env.proc->i; + c_p->arity = env.proc->arity; + } - c_p->mbuf = env->proc->mbuf; - c_p->mbuf_sz += env->proc->mbuf_sz; +#ifdef DEBUG + if (nep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER) + nep->func = NULL; +#endif - } + erts_unblock_fpe(env.fpe_was_unmasked); + full_flush_env(&env); + free_tmp_objs(&env); - if (!c_p->off_heap.first) - c_p->off_heap.first = env->proc->off_heap.first; - else if (env->proc->off_heap.first) { - struct erl_off_heap_header *ohhp; - for (ohhp = env->proc->off_heap.first; ohhp->next; ohhp = ohhp->next) - ; - ohhp->next = c_p->off_heap.first; - c_p->off_heap.first = env->proc->off_heap.first; - } - c_p->off_heap.overhead += env->proc->off_heap.overhead; + return exiting; +} - return; - } #endif +static void full_flush_env(ErlNifEnv* env) +{ flush_env(env); +#ifdef ERTS_DIRTY_SCHEDULERS + if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) + /* Dirty nif call using shadow process struct */ + erts_flush_dirty_shadow_proc(env->proc); +#endif } static void full_cache_env(ErlNifEnv* env) { #ifdef ERTS_DIRTY_SCHEDULERS - if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) { - /* Dirty nif call using shadow process struct */ - Process *sproc = env->proc; - Process *c_p = sproc->next; - ASSERT(c_p); - ASSERT(is_scheduler() < 0); - ASSERT(env->proc->common.id == c_p->common.id); - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) - & ERTS_PROC_LOCK_MAIN); - - sproc->htop = c_p->htop; - sproc->stop = c_p->stop; - sproc->hend = c_p->hend; - sproc->heap = c_p->heap; - sproc->abandoned_heap = c_p->abandoned_heap; - sproc->heap_sz = c_p->heap_sz; - sproc->high_water = c_p->high_water; - sproc->old_hend = c_p->old_hend; - sproc->old_htop = c_p->old_htop; - sproc->old_heap = c_p->old_heap; - sproc->mbuf = NULL; - sproc->mbuf_sz = 0; - ERTS_INIT_OFF_HEAP(&sproc->off_heap); - - env->hp_end = HEAP_LIMIT(c_p); - env->hp = HEAP_TOP(c_p); - env->heap_frag = NULL; - return; - } + if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) + erts_cache_dirty_shadow_proc(env->proc); #endif - cache_env(env); } @@ -1303,22 +1316,15 @@ Eterm enif_make_badarg(ErlNifEnv* env) Eterm enif_raise_exception(ErlNifEnv* env, ERL_NIF_TERM reason) { - Process *c_p; - - execution_state(env, &c_p, NULL); - env->exception_thrown = 1; - c_p->fvalue = reason; - BIF_ERROR(c_p, EXC_ERROR); + env->proc->fvalue = reason; + BIF_ERROR(env->proc, EXC_ERROR); } int enif_has_pending_exception(ErlNifEnv* env, ERL_NIF_TERM* reason) { - if (env->exception_thrown && reason != NULL) { - Process *c_p; - execution_state(env, &c_p, NULL); - *reason = c_p->fvalue; - } + if (env->exception_thrown && reason != NULL) + *reason = env->proc->fvalue; return env->exception_thrown; } @@ -2279,188 +2285,28 @@ int enif_consume_timeslice(ErlNifEnv* env, int percent) return ERTS_BIF_REDS_LEFT(proc) == 0; } -/* - * NIF exports need a few more items than the Export struct provides, - * including the erl_module_nif* and a NIF function pointer, so the - * NifExport below adds those. The Export member must be first in the - * struct. The saved_current, exception_thrown, saved_argc, rootset_extra, and - * rootset members are used to track the MFA, any pending exception, and - * arguments of the top NIF in case a chain of one or more - * enif_schedule_nif() calls results in an exception, since in that case - * the original MFA and registers have to be restored before returning to - * Erlang to ensure stacktrace information associated with the exception is - * correct. - */ -typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]); - -typedef struct { - Export exp; - struct erl_module_nif* m; - NativeFunPtr fp; - ErtsCodeMFA *saved_current; - int exception_thrown; - int saved_argc; - int rootset_extra; - Eterm rootset[1]; -} NifExport; - -/* - * If a process has saved arguments, they need to be part of the GC - * rootset. The function below is called from setup_rootset() in - * erl_gc.c. This function is declared in erl_process.h. Any exception term - * saved in the NifExport is also made part of the GC rootset here; it - * always resides in rootset[0]. - */ -int -erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj) -{ - NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - int gc = ep && (ep->saved_argc > 0 || ep->rootset[0] != NIL); - - if (gc) { - *objv = ep->rootset; - *nobj = 1 + ep->saved_argc; - } - return gc; -} - -int -erts_check_nif_export_in_area(Process *p, char *start, Uint size) -{ - NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(p); - if (!nep || !nep->saved_current) - return 0; - if (ErtsInArea(nep->saved_current, start, size)) - return 1; - return 0; -} - -/* - * Allocate a NifExport and set it in proc specific data - */ -static NifExport* -allocate_nif_sched_data(Process* proc, int argc) -{ - NifExport* ep; - size_t total; - int i; - - total = sizeof(NifExport) + argc*sizeof(Eterm); - ep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, total); - sys_memset((void*) ep, 0, total); - ep->rootset_extra = argc; - ep->rootset[0] = NIL; - for (i=0; i<ERTS_NUM_CODE_IX; i++) { - ep->exp.addressv[i] = &ep->exp.beam[0]; - } - ep->exp.beam[0] = (BeamInstr) em_call_nif; - (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ep); - return ep; -} - static ERTS_INLINE void -destroy_nif_export(NifExport *nif_export) +nif_export_cleanup_nif_mod(NifExport *ep) { - erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, (void *) nif_export); + if (erts_refc_dectest(&ep->m->rt_dtor_cnt, 0) == 0 && ep->m->mod == NULL) + close_lib(ep->m); + ep->m = NULL; } void -erts_destroy_nif_export(void *nif_export) +erts_nif_export_cleanup_nif_mod(NifExport *ep) { - destroy_nif_export((NifExport *) nif_export); + nif_export_cleanup_nif_mod(ep); } -/* - * Initialize a NifExport struct. Create it if needed and store it in the - * proc. The direct_fp function is what will be invoked by op_call_nif, and - * the indirect_fp function, if not NULL, is what the direct_fp function - * will call. If the allocated NifExport isn't enough to hold all of argv, - * allocate a larger one. Save MFA and registers only if the need_save - * parameter is true. - */ -static ERL_NIF_TERM -init_nif_sched_data(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp, - int need_save, int argc, const ERL_NIF_TERM argv[]) +static ERTS_INLINE void +nif_export_restore(Process *c_p, NifExport *ep, Eterm res) { - Process* proc; - Eterm* reg; - NifExport* ep; - int i, scheduler; - int orig_argc; - - execution_state(env, &proc, &scheduler); - - ASSERT(scheduler); - - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(proc) - & ERTS_PROC_LOCK_MAIN); - - reg = erts_proc_sched_data(proc)->x_reg_array; - - ASSERT(!need_save || proc->current); - orig_argc = need_save ? (int) proc->current->arity : 0; - - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - if (!ep) - ep = allocate_nif_sched_data(proc, orig_argc); - else if (need_save && ep->rootset_extra < orig_argc) { - NifExport* new_ep = allocate_nif_sched_data(proc, orig_argc); - destroy_nif_export(ep); - ep = new_ep; - } - if (env->exception_thrown) { - ep->exception_thrown = 1; - ep->rootset[0] = proc->fvalue; - } else { - ep->exception_thrown = 0; - ep->rootset[0] = NIL; - } - if (scheduler > 0) - ERTS_VBUMP_ALL_REDS(proc); - if (need_save) { - ep->saved_current = proc->current; - ep->saved_argc = orig_argc; - for (i = 0; i < orig_argc; i++) - ep->rootset[i+1] = reg[i]; - } - for (i = 0; i < argc; i++) - reg[i] = (Eterm) argv[i]; - proc->i = (BeamInstr*) ep->exp.addressv[0]; - ep->exp.info.mfa.module = proc->current->module; - ep->exp.info.mfa.function = proc->current->function; - ep->exp.info.mfa.arity = argc; - ep->exp.beam[1] = (BeamInstr) direct_fp; - ep->m = env->mod_nif; - ep->fp = indirect_fp; - proc->freason = TRAP; - proc->arity = argc; - return THE_NON_VALUE; + erts_nif_export_restore(c_p, ep, res); + ASSERT(ep->m); + nif_export_cleanup_nif_mod(ep); } -/* - * Restore saved MFA and registers. Registers are restored only when the - * exception flag is true. - */ -static void -restore_nif_mfa(Process* proc, NifExport* ep, int exception) -{ - int i; - - ERTS_SMP_LC_ASSERT(!(proc->static_flags - & ERTS_STC_FLG_SHADOW_PROC)); - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(proc) - & ERTS_PROC_LOCK_MAIN); - - ASSERT(ep->saved_current != &ep->exp.info.mfa); - proc->current = ep->saved_current; - ep->saved_current = NULL; - if (exception) { - Eterm* reg = erts_proc_sched_data(proc)->x_reg_array; - for (i = 0; i < ep->saved_argc; i++) - reg[i] = ep->rootset[i+1]; - } - ep->saved_argc = 0; -} #ifdef ERTS_DIRTY_SCHEDULERS @@ -2469,7 +2315,7 @@ restore_nif_mfa(Process* proc, NifExport* ep, int exception) * switch the process off a dirty scheduler thread and back onto a regular * scheduler thread, and then return the result from the dirty NIF. It also * restores the original NIF MFA when necessary based on the value of - * ep->fp set by execute_dirty_nif via init_nif_sched_data -- non-NULL + * ep->func set by execute_dirty_nif via init_nif_sched_data -- non-NULL * means restore, NULL means do not restore. */ static ERL_NIF_TERM @@ -2484,9 +2330,7 @@ dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(proc))); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); - ASSERT(!ep->exception_thrown); - if (ep->fp) - restore_nif_mfa(proc, ep, 0); + nif_export_restore(proc, ep, argv[0]); return argv[0]; } @@ -2496,148 +2340,100 @@ dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) static ERL_NIF_TERM dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM ret; Process* proc; NifExport* ep; + Eterm exception; execution_state(env, &proc, NULL); + ASSERT(argc == 1); ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(proc))); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); - ASSERT(ep->exception_thrown); - if (ep->fp) - restore_nif_mfa(proc, ep, 1); - return enif_raise_exception(env, ep->rootset[0]); + exception = argv[0]; /* argv overwritten by restore below... */ + nif_export_cleanup_nif_mod(ep); + ret = enif_raise_exception(env, exception); + + /* Restore orig info for error and clear nif export in handle_error() */ + proc->freason |= EXF_RESTORE_NIF; + return ret; } /* - * Dirty NIF execution wrapper function. Invoke an application's dirty NIF, - * then check the result and schedule the appropriate finalizer function - * where needed. Also restore the original NIF MFA when appropriate. + * Dirty NIF scheduling wrapper function. Schedule a dirty NIF to execute. + * The dirty scheduler thread type (CPU or I/O) is indicated in flags + * parameter. */ -static ERL_NIF_TERM -execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERTS_INLINE ERL_NIF_TERM +schedule_dirty_nif(ErlNifEnv* env, int flags, NativeFunPtr fp, + Eterm func_name, int argc, const ERL_NIF_TERM argv[]) { Process* proc; - NativeFunPtr fp; - NifExport* ep; - ERL_NIF_TERM result; - - execution_state(env, &proc, NULL); - - ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa); - fp = ep->fp; - ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(proc))); - - /* - * Set ep->fp to NULL before the native call so we know later whether it scheduled another NIF for execution - */ - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - ASSERT(ep && fp); - - ep->fp = NULL; - erts_smp_atomic32_read_band_mb(&proc->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC - | ERTS_PSFLG_DIRTY_IO_PROC)); + ASSERT(is_atom(func_name)); + ASSERT(fp); - erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + ASSERT(flags==ERL_NIF_DIRTY_JOB_IO_BOUND || flags==ERL_NIF_DIRTY_JOB_CPU_BOUND); - result = (*fp)(env, argc, argv); + execution_state(env, &proc, NULL); - erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); + (void) erts_smp_atomic32_read_bset_nob(&proc->state, + (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC), + (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND + ? ERTS_PSFLG_DIRTY_CPU_PROC + : ERTS_PSFLG_DIRTY_IO_PROC)); - if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL) - close_lib(env->mod_nif); - /* - * If no more NIFs were scheduled by the native call via - * enif_schedule_nif(), then ep->fp will still be NULL as set above, in - * which case we need to restore the original NIF calling - * context. Reuse fp essentially as a boolean for this, passing it to - * init_nif_sched_data below. Both dirty_nif_exception and - * dirty_nif_finalizer then check ep->fp to decide whether or not to - * restore the original calling context. - */ - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - ASSERT(ep); - if (ep->fp) - fp = NULL; - if (is_non_value(result) || env->exception_thrown) { - if (proc->freason != TRAP) { - return init_nif_sched_data(env, dirty_nif_exception, fp, 0, argc, argv); - } else { - if (ep->fp == NULL) - restore_nif_mfa(proc, ep, 1); - return THE_NON_VALUE; - } - } - else - return init_nif_sched_data(env, dirty_nif_finalizer, fp, 0, 1, &result); + return schedule(env, fp, NULL, proc->current->module, func_name, argc, argv); } -/* - * Dirty NIF scheduling wrapper function. Schedule a dirty NIF to execute - * via the execute_dirty_nif() wrapper function. The dirty scheduler thread - * type (CPU or I/O) is indicated in flags parameter. - */ static ERTS_INLINE ERL_NIF_TERM -schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[]) +static_schedule_dirty_nif(ErlNifEnv* env, erts_aint32_t dirty_psflg, + int argc, const ERL_NIF_TERM argv[]) { - ERL_NIF_TERM result; - erts_aint32_t act, dirty_flag; - Process* proc; + Process *proc; + NifExport *ep; + Eterm mod, func; NativeFunPtr fp; - NifExport* ep; - int need_save, scheduler; - execution_state(env, &proc, &scheduler); - if (scheduler <= 0) { - ASSERT(scheduler < 0); - erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); - } + execution_state(env, &proc, NULL); + + /* + * Called in order to schedule statically determined + * dirty NIF calls... + * + * Note that 'current' does not point into a NifExport + * structure; only a structure with similar + * parts (located in code). + */ ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa); - fp = ep->fp; + mod = proc->current->module; + func = proc->current->function; + fp = (NativeFunPtr) ep->func; + ASSERT(is_atom(mod) && is_atom(func)); ASSERT(fp); - ASSERT(flags==ERL_NIF_DIRTY_JOB_IO_BOUND || flags==ERL_NIF_DIRTY_JOB_CPU_BOUND); - - if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) - dirty_flag = ERTS_PSFLG_DIRTY_CPU_PROC; - else - dirty_flag = ERTS_PSFLG_DIRTY_IO_PROC; - - act = erts_smp_atomic32_read_bor_nob(&proc->state, dirty_flag); - if (!(act & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC))) - erts_refc_inc(&env->mod_nif->rt_dtor_cnt, 1); - else if ((act & (ERTS_PSFLG_DIRTY_CPU_PROC - | ERTS_PSFLG_DIRTY_IO_PROC)) & ~dirty_flag) { - /* clear other flag... */ - if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) - dirty_flag = ERTS_PSFLG_DIRTY_IO_PROC; - else - dirty_flag = ERTS_PSFLG_DIRTY_CPU_PROC; - erts_smp_atomic32_read_band_nob(&proc->state, ~dirty_flag); - } + (void) erts_smp_atomic32_read_bset_nob(&proc->state, + (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC), + dirty_psflg); - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - need_save = (ep == NULL || !ep->saved_current); - result = init_nif_sched_data(env, execute_dirty_nif, fp, need_save, argc, argv); - if (scheduler <= 0) - erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); - return result; + return schedule(env, fp, NULL, mod, func, argc, argv); } static ERL_NIF_TERM -schedule_dirty_io_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static_schedule_dirty_io_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - return schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_IO_BOUND, argc, argv); + return static_schedule_dirty_nif(env, ERTS_PSFLG_DIRTY_IO_PROC, argc, argv); } static ERL_NIF_TERM -schedule_dirty_cpu_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static_schedule_dirty_cpu_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - return schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, argc, argv); + return static_schedule_dirty_nif(env, ERTS_PSFLG_DIRTY_CPU_PROC, argc, argv); } #endif /* ERTS_DIRTY_SCHEDULERS */ @@ -2656,23 +2452,42 @@ execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ERL_NIF_TERM result; execution_state(env, &proc, NULL); - ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa); - fp = ep->fp; - ASSERT(!env->exception_thrown); - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ep = ErtsContainerStruct(proc->current, NifExport, exp.info.mfa); + fp = ep->func; ASSERT(ep); - ep->fp = NULL; + ASSERT(!env->exception_thrown); + + fp = (NativeFunPtr) ep->func; + +#ifdef DEBUG + ep->func = ERTS_DBG_NIF_NOT_SCHED_MARKER; +#endif + result = (*fp)(env, argc, argv); - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - ASSERT(ep); - /* - * If no NIFs were scheduled by the native call via - * enif_schedule_nif(), then ep->fp will still be NULL as set above, in - * which case we need to restore the original NIF MFA. - */ - if (ep->fp == NULL) - restore_nif_mfa(proc, ep, env->exception_thrown); + + ASSERT(ep == ERTS_PROC_GET_NIF_TRAP_EXPORT(proc)); + + if (is_value(result) || proc->freason != TRAP) { + /* Done (not rescheduled)... */ + ASSERT(ep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER); + if (!env->exception_thrown) + nif_export_restore(proc, ep, result); + else { + nif_export_cleanup_nif_mod(ep); + /* + * Restore orig info for error and clear nif + * export in handle_error() + */ + proc->freason |= EXF_RESTORE_NIF; + } + } + +#ifdef DEBUG + if (ep->func == ERTS_DBG_NIF_NOT_SCHED_MARKER) + ep->func = NULL; +#endif + return result; } @@ -2682,9 +2497,8 @@ enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags, int argc, const ERL_NIF_TERM argv[]) { Process* proc; - NifExport* ep; ERL_NIF_TERM fun_name_atom, result; - int need_save, scheduler; + int scheduler; if (argc > MAX_ARG) return enif_make_badarg(env); @@ -2699,35 +2513,16 @@ enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags, erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); } - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - need_save = (ep == NULL || !ep->saved_current); - - if (flags) { + if (flags == 0) + result = schedule(env, execute_nif, fp, proc->current->module, + fun_name_atom, argc, argv); #ifdef ERTS_DIRTY_SCHEDULERS - NativeFunPtr sched_fun; - int chkflgs = (flags & (ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND)); - if (chkflgs == ERL_NIF_DIRTY_JOB_IO_BOUND) - sched_fun = schedule_dirty_io_nif; - else if (chkflgs == ERL_NIF_DIRTY_JOB_CPU_BOUND) - sched_fun = schedule_dirty_cpu_nif; - else { - result = enif_make_badarg(env); - goto done; - } - result = init_nif_sched_data(env, sched_fun, fp, need_save, argc, argv); -#else - result = enif_make_badarg(env); + else if (!(flags & ~(ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND))) + result = schedule_dirty_nif(env, flags, fp, fun_name_atom, argc, argv); #endif - goto done; - } else - result = init_nif_sched_data(env, execute_nif, fp, need_save, argc, argv); - - ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - ASSERT(ep); - ep->exp.info.mfa.function = (BeamInstr) fun_name_atom; + result = enif_make_badarg(env); -done: if (scheduler < 0) erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); @@ -3356,11 +3151,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) mod_atom, f->name, f->arity); #endif } -#ifdef ERTS_DIRTY_SCHEDULERS - else if (erts_codeinfo_to_code(ci_pp[1]) - erts_codeinfo_to_code(ci_pp[0]) < (4)) -#else - else if (erts_codeinfo_to_code(ci_pp[1]) - erts_codeinfo_to_code(ci_pp[0]) < (3)) -#endif + else if (erts_codeinfo_to_code(ci_pp[1]) - erts_codeinfo_to_code(ci_pp[0]) + < BEAM_NIF_MIN_FUNC_SZ) { ret = load_nif_error(BIF_P,bad_lib,"No explicit call to load_nif" " in module (%T:%s/%u too small)", @@ -3434,8 +3226,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) if (f->flags) { code_ptr[3] = (BeamInstr) f->fptr; code_ptr[1] = (f->flags == ERL_NIF_DIRTY_JOB_IO_BOUND) ? - (BeamInstr) schedule_dirty_io_nif : - (BeamInstr) schedule_dirty_cpu_nif; + (BeamInstr) static_schedule_dirty_io_nif : + (BeamInstr) static_schedule_dirty_cpu_nif; } else #endif @@ -3546,8 +3338,8 @@ Eterm erts_nif_call_function(Process *p, Process *tracee, #endif if (p) { /* This is almost a normal nif call like in beam_emu, - except that any heap fragment created in the nif will be - discarded without checking if anything in it is live. + except that any heap consumed by the nif will be + released without checking if anything in it is live. This is because we cannot do a GC here as we don't know the number of live registers that have to be preserved. This means that any heap part of the returned term may diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 3102e44c11..4836b9e2d3 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -936,7 +936,7 @@ enqueue_port(ErtsRunQueue *runq, Port *pp) erts_smp_inc_runq_len(runq, &runq->ports.info, ERTS_PORT_PRIO_LEVEL); #ifdef ERTS_SMP - if (runq->halt_in_progress) + if (ERTS_RUNQ_FLGS_GET_NOB(runq) & ERTS_RUNQ_FLG_HALTING) erts_non_empty_runq(runq); #endif } diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h index 2a6bd165a3..e3550e878e 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -188,13 +188,11 @@ erts_port_task_init_sched(ErtsPortTaskSched *ptsp, Eterm instr_id) ptsp->taskq.in.last = NULL; erts_smp_atomic32_init_nob(&ptsp->flags, 0); #ifdef ERTS_SMP - erts_mtx_init_x(&ptsp->mtx, lock_str, instr_id, #ifdef ERTS_ENABLE_LOCK_COUNT - (erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK) -#else - 1 + if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK)) + lock_str = NULL; #endif - ); + erts_mtx_init_x(&ptsp->mtx, lock_str, instr_id); #endif } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 4fb0f9e975..f80ebdf31b 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -48,6 +48,7 @@ #include "erl_bif_unique.h" #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" +#include "erl_nfunc_sched.h" #define ERTS_CHECK_TIME_REDS CONTEXT_REDS #define ERTS_DELAYED_WAKEUP_INFINITY (~(Uint64) 0) @@ -106,9 +107,31 @@ #define LOW_BIT (1 << PRIORITY_LOW) #define PORT_BIT (1 << ERTS_PORT_PRIO_LEVEL) -#define ERTS_EMPTY_RUNQ(RQ) \ - ((ERTS_RUNQ_FLGS_GET_NOB((RQ)) & ERTS_RUNQ_FLGS_QMASK) == 0 \ - && (RQ)->misc.start == NULL) +#define ERTS_IS_RUNQ_EMPTY_FLGS(FLGS) \ + (!((FLGS) & (ERTS_RUNQ_FLGS_QMASK|ERTS_RUNQ_FLG_MISC_OP))) + +#define ERTS_IS_RUNQ_EMPTY_PORTS_FLGS(FLGS) \ + (!((FLGS) & (PORT_BIT|ERTS_RUNQ_FLG_MISC_OP))) + +#define ERTS_EMPTY_RUNQ(RQ) \ + ERTS_IS_RUNQ_EMPTY_FLGS(ERTS_RUNQ_FLGS_GET_NOB((RQ))) + +#define ERTS_EMPTY_RUNQ_PORTS(RQ) \ + ERTS_IS_RUNQ_EMPTY_FLGS(ERTS_RUNQ_FLGS_GET_NOB((RQ))) + +static ERTS_INLINE int +runq_got_work_to_execute_flags(Uint32 flags) +{ + if (flags & ERTS_RUNQ_FLG_HALTING) + return !ERTS_IS_RUNQ_EMPTY_PORTS_FLGS(flags); + return !ERTS_IS_RUNQ_EMPTY_FLGS(flags); +} + +static ERTS_INLINE int +runq_got_work_to_execute(ErtsRunQueue *rq) +{ + return runq_got_work_to_execute_flags(ERTS_RUNQ_FLGS_GET_NOB(rq)); +} #undef RUNQ_READ_RQ #undef RUNQ_SET_RQ @@ -140,9 +163,6 @@ do { \ # define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) #endif -#define ERTS_EMPTY_RUNQ_PORTS(RQ) \ - (RUNQ_READ_LEN(&(RQ)->ports.info.len) == 0 && (RQ)->misc.start == NULL) - const Process erts_invalid_process = {{ERTS_INVALID_PID}}; extern BeamInstr beam_apply[]; @@ -193,170 +213,145 @@ static ErtsAuxWorkData *aux_thread_aux_work_data; #define ERTS_SCHDLR_SSPND_CHNG_ONLN (((erts_aint32_t) 1) << 2) #define ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN (((erts_aint32_t) 1) << 3) -typedef enum { - ERTS_SCHED_NORMAL, - ERTS_SCHED_DIRTY_CPU, - ERTS_SCHED_DIRTY_IO -} ErtsSchedType; - typedef struct { int ongoing; ErtsProcList *blckrs; ErtsProcList *chngq; } ErtsMultiSchedulingBlock; +typedef struct { + Uint32 normal; +#ifdef ERTS_DIRTY_SCHEDULERS + Uint32 dirty_cpu; + Uint32 dirty_io; +#endif +} ErtsSchedTypeCounters; + static struct { erts_smp_mtx_t mtx; - Uint32 online; - Uint32 curr_online; - Uint32 active; + ErtsSchedTypeCounters online; + ErtsSchedTypeCounters curr_online; + ErtsSchedTypeCounters active; erts_smp_atomic32_t changing; ErtsProcList *chngq; Eterm changer; ErtsMultiSchedulingBlock nmsb; /* Normal multi Scheduling Block */ ErtsMultiSchedulingBlock msb; /* Multi Scheduling Block */ +#ifdef ERTS_DIRTY_SCHEDULERS + ErtsSchedType last_msb_dirty_type; +#endif } schdlr_sspnd; -#define ERTS_SCHDLR_SSPND_S_BITS 10 -#define ERTS_SCHDLR_SSPND_DCS_BITS 11 -#define ERTS_SCHDLR_SSPND_DIS_BITS 11 - -#define ERTS_SCHDLR_SSPND_S_MASK ((1 << ERTS_SCHDLR_SSPND_S_BITS)-1) -#define ERTS_SCHDLR_SSPND_DCS_MASK ((1 << ERTS_SCHDLR_SSPND_DCS_BITS)-1) -#define ERTS_SCHDLR_SSPND_DIS_MASK ((1 << ERTS_SCHDLR_SSPND_DIS_BITS)-1) - -#define ERTS_SCHDLR_SSPND_S_SHIFT 0 -#define ERTS_SCHDLR_SSPND_DCS_SHIFT (ERTS_SCHDLR_SSPND_S_SHIFT \ - + ERTS_SCHDLR_SSPND_S_BITS) -#define ERTS_SCHDLR_SSPND_DIS_SHIFT (ERTS_SCHDLR_SSPND_DCS_SHIFT \ - + ERTS_SCHDLR_SSPND_DCS_BITS) - -#if (ERTS_SCHDLR_SSPND_S_BITS \ - + ERTS_SCHDLR_SSPND_DCS_BITS \ - + ERTS_SCHDLR_SSPND_DIS_BITS) > 32 -# error Wont fit in Uint32 -#endif +static void init_scheduler_suspend(void); -#if (ERTS_MAX_NO_OF_SCHEDULERS-1) > ERTS_SCHDLR_SSPND_S_MASK -# error Max no schedulers wont fit in its bit-field -#endif -#if ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS > ERTS_SCHDLR_SSPND_DCS_MASK -# error Max no dirty cpu schedulers wont fit in its bit-field -#endif -#if ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS > ERTS_SCHDLR_SSPND_DIS_MASK -# error Max no dirty io schedulers wont fit in its bit-field +static ERTS_INLINE Uint32 +schdlr_sspnd_eq_nscheds(ErtsSchedTypeCounters *val1p, ErtsSchedTypeCounters *val2p) +{ + int res = val1p->normal == val2p->normal; +#ifdef ERTS_DIRTY_SCHEDULERS + res &= val1p->dirty_cpu == val2p->dirty_cpu; + res &= val1p->dirty_io == val2p->dirty_io; #endif - -#define ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(S, DCS, DIS) \ - ((((Uint32) (((S) & ERTS_SCHDLR_SSPND_S_MASK))-1) \ - << ERTS_SCHDLR_SSPND_S_SHIFT) \ - | ((((Uint32) ((DCS) & ERTS_SCHDLR_SSPND_DCS_MASK)) \ - << ERTS_SCHDLR_SSPND_DCS_SHIFT)) \ - | ((((Uint32) ((DIS) & ERTS_SCHDLR_SSPND_DIS_MASK)) \ - << ERTS_SCHDLR_SSPND_DIS_SHIFT))) - -static void init_scheduler_suspend(void); + return res; +} static ERTS_INLINE Uint32 -schdlr_sspnd_get_nscheds(Uint32 *valp, ErtsSchedType type) +schdlr_sspnd_get_nscheds(ErtsSchedTypeCounters *valp, + ErtsSchedType type) { - Uint32 res = (Uint32) (*valp); switch (type) { case ERTS_SCHED_NORMAL: - res >>= ERTS_SCHDLR_SSPND_S_SHIFT; - res &= (Uint32) ERTS_SCHDLR_SSPND_S_MASK; - res++; - break; + return valp->normal; +#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_SCHED_DIRTY_CPU: - res >>= ERTS_SCHDLR_SSPND_DCS_SHIFT; - res &= (Uint32) ERTS_SCHDLR_SSPND_DCS_MASK; - break; + return valp->dirty_cpu; case ERTS_SCHED_DIRTY_IO: - res >>= ERTS_SCHDLR_SSPND_DIS_SHIFT; - res &= (Uint32) ERTS_SCHDLR_SSPND_DIS_MASK; - break; + return valp->dirty_io; +#else + case ERTS_SCHED_DIRTY_CPU: + case ERTS_SCHED_DIRTY_IO: + return 0; +#endif default: ERTS_INTERNAL_ERROR("Invalid scheduler type"); return 0; } +} +static ERTS_INLINE Uint32 +schdlr_sspnd_get_nscheds_tot(ErtsSchedTypeCounters *valp) +{ + Uint32 res = valp->normal; +#ifdef ERTS_DIRTY_SCHEDULERS + res += valp->dirty_cpu; + res += valp->dirty_io; +#endif return res; } static ERTS_INLINE void -schdlr_sspnd_dec_nscheds(Uint32 *valp, ErtsSchedType type) +schdlr_sspnd_dec_nscheds(ErtsSchedTypeCounters *valp, + ErtsSchedType type) { ASSERT(schdlr_sspnd_get_nscheds(valp, type) > 0); switch (type) { case ERTS_SCHED_NORMAL: - *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_S_SHIFT; + valp->normal--; break; +#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_SCHED_DIRTY_CPU: - *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_DCS_SHIFT; + valp->dirty_cpu--; break; case ERTS_SCHED_DIRTY_IO: - *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_DIS_SHIFT; + valp->dirty_io--; break; +#endif default: ERTS_INTERNAL_ERROR("Invalid scheduler type"); } } static ERTS_INLINE void -schdlr_sspnd_inc_nscheds(Uint32 *valp, ErtsSchedType type) +schdlr_sspnd_inc_nscheds(ErtsSchedTypeCounters *valp, + ErtsSchedType type) { switch (type) { case ERTS_SCHED_NORMAL: - ASSERT(schdlr_sspnd_get_nscheds(valp, type) - < ERTS_MAX_NO_OF_SCHEDULERS-1); - *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_S_SHIFT; + valp->normal++; break; +#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_SCHED_DIRTY_CPU: - ASSERT(schdlr_sspnd_get_nscheds(valp, type) - < ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS); - *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_DCS_SHIFT; + valp->dirty_cpu++; break; case ERTS_SCHED_DIRTY_IO: - ASSERT(schdlr_sspnd_get_nscheds(valp, type) - < ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS); - *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_DIS_SHIFT; + valp->dirty_io++; break; +#endif default: ERTS_INTERNAL_ERROR("Invalid scheduler type"); } } static ERTS_INLINE void -schdlr_sspnd_set_nscheds(Uint32 *valp, ErtsSchedType type, Uint32 no) +schdlr_sspnd_set_nscheds(ErtsSchedTypeCounters *valp, + ErtsSchedType type, Uint32 no) { - Uint32 val = *valp; - switch (type) { case ERTS_SCHED_NORMAL: - ASSERT(no > 0); - val &= ~(((Uint32) ERTS_SCHDLR_SSPND_S_MASK) - << ERTS_SCHDLR_SSPND_S_SHIFT); - val |= (((no-1) & ((Uint32) ERTS_SCHDLR_SSPND_S_MASK)) - << ERTS_SCHDLR_SSPND_S_SHIFT); + valp->normal = no; break; +#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_SCHED_DIRTY_CPU: - val &= ~(((Uint32) ERTS_SCHDLR_SSPND_DCS_MASK) - << ERTS_SCHDLR_SSPND_DCS_SHIFT); - val |= ((no & ((Uint32) ERTS_SCHDLR_SSPND_DCS_MASK)) - << ERTS_SCHDLR_SSPND_DCS_SHIFT); + valp->dirty_cpu = no; break; case ERTS_SCHED_DIRTY_IO: - val &= ~(((Uint32) ERTS_SCHDLR_SSPND_DIS_MASK) - << ERTS_SCHDLR_SSPND_DIS_SHIFT); - val |= ((no & ((Uint32) ERTS_SCHDLR_SSPND_DIS_MASK)) - << ERTS_SCHDLR_SSPND_DIS_SHIFT); + valp->dirty_io = no; break; +#endif default: ERTS_INTERNAL_ERROR("Invalid scheduler type"); } - - *valp = val; } static struct { @@ -809,15 +804,28 @@ erts_late_init_process(void) } +#define ERTS_SCHED_WTIME_IDLE ~((Uint64) 0) + static void -init_sched_wall_time(ErtsSchedWallTime *swtp) +init_sched_wall_time(ErtsSchedulerData *esdp, Uint64 time_stamp) { - swtp->need = erts_sched_balance_util; - swtp->enabled = 0; - swtp->start = 0; - swtp->working.total = 0; - swtp->working.start = 0; - swtp->working.currently = 0; +#ifdef ERTS_DIRTY_SCHEDULERS + if (esdp->type != ERTS_SCHED_NORMAL) { + erts_atomic32_init_nob(&esdp->sched_wall_time.u.mod, 0); + esdp->sched_wall_time.enabled = 1; + esdp->sched_wall_time.start = time_stamp; + esdp->sched_wall_time.working.total = 0; + esdp->sched_wall_time.working.start = ERTS_SCHED_WTIME_IDLE; + } + else +#endif + { + esdp->sched_wall_time.u.need = erts_sched_balance_util; + esdp->sched_wall_time.enabled = 0; + esdp->sched_wall_time.start = 0; + esdp->sched_wall_time.working.total = 0; + esdp->sched_wall_time.working.start = 0; + } } static ERTS_INLINE Uint64 @@ -1008,31 +1016,145 @@ init_runq_sched_util(ErtsRunQueueSchedUtil *rqsu, int enabled) #endif /* ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT */ -static ERTS_INLINE void +#ifdef ERTS_DIRTY_SCHEDULERS + +typedef struct { + Uint64 working; + Uint64 total; +} ErtsDirtySchedWallTime; + +static void +read_dirty_sched_wall_time(ErtsSchedulerData *esdp, ErtsDirtySchedWallTime *info) +{ + erts_aint32_t mod1; + Uint64 working, start, ts; + + mod1 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod); + + while (1) { + erts_aint32_t mod2; + + /* Spin until values are not written... */ + while (1) { + if ((mod1 & 1) == 0) + break; + ERTS_SPIN_BODY; + mod1 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod); + } + + ERTS_THR_READ_MEMORY_BARRIER; + + working = esdp->sched_wall_time.working.total; + start = esdp->sched_wall_time.working.start; + + ERTS_THR_READ_MEMORY_BARRIER; + + mod2 = erts_atomic32_read_nob(&esdp->sched_wall_time.u.mod); + if (mod1 == mod2) + break; + mod1 = mod2; + } + + ts = sched_wall_time_ts(); + ts -= esdp->sched_wall_time.start; + + info->total = ts; + + if (start == ERTS_SCHED_WTIME_IDLE || ts < start) + info->working = working; + else + info->working = working + (ts - start); + + if (info->working > info->total) + info->working = info->total; +} + +#endif + +#ifdef ERTS_SMP + +static void +dirty_sched_wall_time_change(ErtsSchedulerData *esdp, int working) +{ + erts_aint32_t mod; + Uint64 ts = sched_wall_time_ts(); + + ts -= esdp->sched_wall_time.start; + + /* + * This thread is the only thread writing in + * this sched_wall_time struct. We set 'mod' to + * an odd value while writing... + */ + mod = erts_atomic32_read_dirty(&esdp->sched_wall_time.u.mod); + ASSERT((mod & 1) == 0); + mod++; + + erts_atomic32_set_nob(&esdp->sched_wall_time.u.mod, mod); + ERTS_THR_WRITE_MEMORY_BARRIER; + + if (working) { + ASSERT(esdp->sched_wall_time.working.start + == ERTS_SCHED_WTIME_IDLE); + + esdp->sched_wall_time.working.start = ts; + + } + else { + Uint64 total; + + ASSERT(esdp->sched_wall_time.working.start + != ERTS_SCHED_WTIME_IDLE); + + total = esdp->sched_wall_time.working.total; + total += ts - esdp->sched_wall_time.working.start; + + esdp->sched_wall_time.working.total = total; + esdp->sched_wall_time.working.start = ERTS_SCHED_WTIME_IDLE; + + + } + + ERTS_THR_WRITE_MEMORY_BARRIER; + mod++; + erts_atomic32_set_nob(&esdp->sched_wall_time.u.mod, mod); + +#if 0 + if (!working) { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT); + } else { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER); + } +#endif +} + +#endif /* ERTS_SMP */ + +static void sched_wall_time_change(ErtsSchedulerData *esdp, int working) { - if (esdp->sched_wall_time.need) { + if (esdp->sched_wall_time.u.need) { Uint64 ts = sched_wall_time_ts(); #if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT - update_avg_sched_util(esdp, ts, working); + update_avg_sched_util(esdp, ts, working); #endif if (esdp->sched_wall_time.enabled) { if (working) { -#ifdef DEBUG - ASSERT(!esdp->sched_wall_time.working.currently); - esdp->sched_wall_time.working.currently = 1; -#endif + ASSERT(esdp->sched_wall_time.working.start + == ERTS_SCHED_WTIME_IDLE); ts -= esdp->sched_wall_time.start; esdp->sched_wall_time.working.start = ts; } else { -#ifdef DEBUG - ASSERT(esdp->sched_wall_time.working.currently); - esdp->sched_wall_time.working.currently = 0; -#endif + ASSERT(esdp->sched_wall_time.working.start + != ERTS_SCHED_WTIME_IDLE); ts -= esdp->sched_wall_time.start; ts -= esdp->sched_wall_time.working.start; esdp->sched_wall_time.working.total += ts; +#ifdef DEBUG + esdp->sched_wall_time.working.start + = ERTS_SCHED_WTIME_IDLE; +#endif } } } @@ -1052,6 +1174,10 @@ typedef struct { Eterm ref_heap[REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; +#ifdef ERTS_DIRTY_SCHEDULERS + int want_dirty_cpu; + int want_dirty_io; +#endif } ErtsSchedWallTimeReq; typedef struct { @@ -1073,6 +1199,7 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(screq, 5, ERTS_ALC_T_SYS_CHECK_REQ) + static void reply_sched_wall_time(void *vswtrp) { @@ -1096,23 +1223,23 @@ reply_sched_wall_time(void *vswtrp) #endif if (swtrp->set) { if (!swtrp->enable && esdp->sched_wall_time.enabled) { - esdp->sched_wall_time.need = erts_sched_balance_util; + esdp->sched_wall_time.u.need = erts_sched_balance_util; esdp->sched_wall_time.enabled = 0; } else if (swtrp->enable && !esdp->sched_wall_time.enabled) { Uint64 ts = sched_wall_time_ts(); - esdp->sched_wall_time.need = 1; + esdp->sched_wall_time.u.need = 1; esdp->sched_wall_time.enabled = 1; esdp->sched_wall_time.start = ts; esdp->sched_wall_time.working.total = 0; esdp->sched_wall_time.working.start = 0; - esdp->sched_wall_time.working.currently = 1; } } if (esdp->sched_wall_time.enabled) { Uint64 ts = sched_wall_time_ts(); - ASSERT(esdp->sched_wall_time.working.currently); + ASSERT(esdp->sched_wall_time.working.start + != ERTS_SCHED_WTIME_IDLE); ts -= esdp->sched_wall_time.start; total = ts; ts -= esdp->sched_wall_time.working.start; @@ -1123,30 +1250,117 @@ reply_sched_wall_time(void *vswtrp) hpp = NULL; szp = &sz; - while (1) { - if (hpp) - ref_copy = STORE_NC(hpp, ohp, swtrp->ref); - else - *szp += REF_THING_SIZE; +#ifdef ERTS_DIRTY_SCHEDULERS + if (esdp->sched_wall_time.enabled + && swtrp->req_sched == esdp->no + && (swtrp->want_dirty_cpu || swtrp->want_dirty_io)) { + /* Reply with info about this scheduler and all dirty schedulers... */ + ErtsDirtySchedWallTime *dswt; + int ix, no_dirty_scheds, want_dcpu, want_dio, soffset; + + want_dcpu = swtrp->want_dirty_cpu; + want_dio = swtrp->want_dirty_io; + + no_dirty_scheds = 0; + if (want_dcpu) + no_dirty_scheds += erts_no_dirty_cpu_schedulers; + if (want_dio) + no_dirty_scheds += erts_no_dirty_io_schedulers; + + ASSERT(no_dirty_scheds); + + dswt = erts_alloc(ERTS_ALC_T_TMP, + sizeof(ErtsDirtySchedWallTime) + * no_dirty_scheds); + + for (ix = 0; ix < no_dirty_scheds; ix++) { + ErtsSchedulerData *esdp; + if (want_dcpu && ix < erts_no_dirty_cpu_schedulers) + esdp = &erts_aligned_dirty_cpu_scheduler_data[ix].esd; + else { + int dio_ix = ix - erts_no_dirty_cpu_schedulers; + esdp = &erts_aligned_dirty_io_scheduler_data[dio_ix].esd; + } + read_dirty_sched_wall_time(esdp, &dswt[ix]); + } - if (swtrp->set) - msg = ref_copy; - else { - msg = (!esdp->sched_wall_time.enabled - ? am_notsup - : erts_bld_tuple(hpp, szp, 3, - make_small(esdp->no), - erts_bld_uint64(hpp, szp, working), - erts_bld_uint64(hpp, szp, total))); + soffset = erts_no_schedulers + 1; - msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); - } - if (hpp) - break; + if (!want_dcpu) { + ASSERT(want_dio); + soffset += erts_no_dirty_cpu_schedulers; + } - mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); - szp = NULL; - hpp = &hp; + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, swtrp->ref); + else + *szp += REF_THING_SIZE; + + ASSERT(!swtrp->set); + + /* info about dirty schedulers... */ + msg = NIL; + for (ix = no_dirty_scheds-1; ix >= 0; ix--) { + msg = erts_bld_cons(hpp, szp, + erts_bld_tuple(hpp, szp, 3, + make_small(ix+soffset), + erts_bld_uint64(hpp, szp, + dswt[ix].working), + erts_bld_uint64(hpp, szp, + dswt[ix].total)), + msg); + } + /* info about this scheduler... */ + msg = erts_bld_cons(hpp, szp, + erts_bld_tuple(hpp, szp, 3, + make_small(esdp->no), + erts_bld_uint64(hpp, szp, working), + erts_bld_uint64(hpp, szp, total)), + msg); + + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + + if (hpp) + break; + + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + szp = NULL; + hpp = &hp; + } + + erts_free(ERTS_ALC_T_TMP, dswt); + } + else +#endif + { + /* Reply with info about this scheduler only... */ + + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, swtrp->ref); + else + *szp += REF_THING_SIZE; + + if (swtrp->set) + msg = ref_copy; + else { + msg = (!esdp->sched_wall_time.enabled + ? am_undefined + : erts_bld_tuple(hpp, szp, 3, + make_small(esdp->no), + erts_bld_uint64(hpp, szp, working), + erts_bld_uint64(hpp, szp, total))); + + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + } + if (hpp) + break; + + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + szp = NULL; + hpp = &hp; + } } erts_queue_message(rp, rp_locks, mp, msg, am_system); @@ -1164,7 +1378,8 @@ reply_sched_wall_time(void *vswtrp) } Eterm -erts_sched_wall_time_request(Process *c_p, int set, int enable) +erts_sched_wall_time_request(Process *c_p, int set, int enable, + int want_dirty_cpu, int want_dirty_io) { ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); Eterm ref; @@ -1186,6 +1401,10 @@ erts_sched_wall_time_request(Process *c_p, int set, int enable) swtrp->proc = c_p; swtrp->ref = STORE_NC(&hp, NULL, ref); swtrp->req_sched = esdp->no; +#ifdef ERTS_DIRTY_SCHEDULERS + swtrp->want_dirty_cpu = want_dirty_cpu; + swtrp->want_dirty_io = want_dirty_io; +#endif erts_smp_atomic32_init_nob(&swtrp->refc, (erts_aint32_t) erts_no_schedulers); @@ -2059,6 +2278,7 @@ handle_thr_prgr_later_op(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int wait #endif for (lops = 0; lops < ERTS_MAX_THR_PRGR_LATER_OPS; lops++) { ErtsThrPrgrLaterOp *lop = awdp->later_op.first; + if (!erts_thr_progress_has_reached_this(current, lop->later)) return aux_work & ~ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP; awdp->later_op.first = lop->next; @@ -2297,7 +2517,8 @@ static ERTS_INLINE erts_aint32_t handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) { unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_REAP_PORTS); - awdp->esdp->run_queue->halt_in_progress = 1; + ERTS_RUNQ_FLGS_SET(awdp->esdp->run_queue, ERTS_RUNQ_FLG_HALTING); + if (erts_smp_atomic32_dec_read_acqb(&erts_halt_progress) == 0) { int i, max = erts_ptab_max(&erts_port); erts_smp_atomic32_set_nob(&erts_halt_progress, 1); @@ -2837,11 +3058,12 @@ static erts_aint32_t sched_prep_spin_wait(ErtsSchedulerSleepInfo *ssi) { erts_aint32_t oflgs; - erts_aint32_t nflgs = (ERTS_SSI_FLG_SLEEPING - | ERTS_SSI_FLG_WAITING); + erts_aint32_t nflgs; erts_aint32_t xflgs = 0; do { + nflgs = (xflgs & ERTS_SSI_FLG_MSB_EXEC); + nflgs |= ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING; oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs); if (oflgs == xflgs) return nflgs; @@ -2863,7 +3085,7 @@ sched_prep_cont_spin_wait(ErtsSchedulerSleepInfo *ssi) if (oflgs == xflgs) return nflgs; xflgs = oflgs; - nflgs |= oflgs & ERTS_SSI_FLG_SUSPENDED; + nflgs |= oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC); } while (oflgs & ERTS_SSI_FLG_WAITING); return oflgs; } @@ -2913,7 +3135,7 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type) return oflgs; } xflgs = oflgs; - nflgs |= oflgs & ERTS_SSI_FLG_SUSPENDED; + nflgs |= oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC); } } @@ -3048,6 +3270,8 @@ aux_thread(void *unused) return NULL; } +static void suspend_scheduler(ErtsSchedulerData *esdp); + #endif /* ERTS_SMP */ static void @@ -3106,8 +3330,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) tse_wait: - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && thr_prgr_active != working) - sched_wall_time_change(esdp, thr_prgr_active); + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + dirty_sched_wall_time_change(esdp, working = 0); + else if (thr_prgr_active != working) + sched_wall_time_change(esdp, working = thr_prgr_active); while (1) { ErtsMonotonicTime current_time = 0; @@ -3213,13 +3439,17 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) } - if (flgs & ~ERTS_SSI_FLG_SUSPENDED) - erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) + erts_smp_atomic32_read_band_nob(&ssi->flags, + (ERTS_SSI_FLG_SUSPENDED + | ERTS_SSI_FLG_MSB_EXEC)); - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) { + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + dirty_sched_wall_time_change(esdp, working = 1); + else if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); sched_wall_time_change(esdp, 1); - } + } erts_smp_runq_lock(rq); sched_active(esdp->no, rq); @@ -3413,8 +3643,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_smp_runq_lock(rq); } clear_sys_scheduling(); - if (flgs & ~ERTS_SSI_FLG_SUSPENDED) - erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) + erts_smp_atomic32_read_band_nob(&ssi->flags, + (ERTS_SSI_FLG_SUSPENDED + | ERTS_SSI_FLG_MSB_EXEC)); #endif if (!working) sched_wall_time_change(esdp, working = 1); @@ -3437,17 +3669,54 @@ ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi) oflgs = erts_smp_atomic32_cmpxchg_relb(&ssi->flags, nflgs, xflgs); if (oflgs == xflgs) return oflgs; - nflgs = oflgs & ERTS_SSI_FLG_SUSPENDED; + nflgs = oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC); xflgs = oflgs; } } +static ERTS_INLINE void +ssi_wake(ErtsSchedulerSleepInfo *ssi) +{ + erts_sched_finish_poke(ssi, ssi_flags_set_wake(ssi)); +} + +#ifdef ERTS_DIRTY_SCHEDULERS + static void -wake_scheduler(ErtsRunQueue *rq) +dcpu_sched_ix_suspend_wake(Uint ix) { - ErtsSchedulerSleepInfo *ssi; - erts_aint32_t flgs; + ErtsSchedulerSleepInfo* ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + ssi_wake(ssi); +} + +static void +dio_sched_ix_suspend_wake(Uint ix) +{ + ErtsSchedulerSleepInfo* ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + ssi_wake(ssi); +} + +static void +dcpu_sched_ix_wake(Uint ix) +{ + ssi_wake(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix)); +} +#if 0 +static void +dio_sched_ix_wake(Uint ix) +{ + ssi_wake(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix)); +} +#endif + +#endif + +static void +wake_scheduler(ErtsRunQueue *rq) +{ /* * The unlocked run queue is not strictly necessary * from a thread safety or deadlock prevention @@ -3459,10 +3728,7 @@ wake_scheduler(ErtsRunQueue *rq) ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq) || ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); - ssi = rq->scheduler->ssi; - - flgs = ssi_flags_set_wake(ssi); - erts_sched_finish_poke(ssi, flgs); + ssi_wake(rq->scheduler->ssi); } #ifdef ERTS_DIRTY_SCHEDULERS @@ -3509,6 +3775,13 @@ wake_dirty_schedulers(ErtsRunQueue *rq, int one) } while (ssi); } } + +static void +wake_dirty_scheduler(ErtsRunQueue *rq) +{ + wake_dirty_schedulers(rq, 1); +} + #endif #define ERTS_NO_USED_RUNQS_SHIFT 16 @@ -3649,7 +3922,7 @@ smp_notify_inc_runq(ErtsRunQueue *runq) if (runq) { #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) - wake_dirty_schedulers(runq, 1); + wake_dirty_scheduler(runq); else #endif wake_scheduler(runq); @@ -3953,8 +4226,7 @@ suspend_run_queue(ErtsRunQueue *rq) wake_scheduler(rq); } -static void scheduler_ix_resume_wake(Uint ix); -static void scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi); +static void nrml_sched_ix_resume_wake(Uint ix); static ERTS_INLINE void resume_run_queue(ErtsRunQueue *rq) @@ -3962,16 +4234,19 @@ resume_run_queue(ErtsRunQueue *rq) int pix; Uint32 oflgs; + ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); + erts_smp_runq_lock(rq); oflgs = ERTS_RUNQ_FLGS_READ_BSET(rq, (ERTS_RUNQ_FLG_OUT_OF_WORK | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK - | ERTS_RUNQ_FLG_SUSPENDED), + | ERTS_RUNQ_FLG_SUSPENDED + | ERTS_RUNQ_FLG_MSB_EXEC), (ERTS_RUNQ_FLG_OUT_OF_WORK | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK)); - if (oflgs & ERTS_RUNQ_FLG_SUSPENDED) { + if (oflgs & (ERTS_RUNQ_FLG_SUSPENDED|ERTS_RUNQ_FLG_MSB_EXEC)) { erts_aint32_t len; rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS; @@ -3990,10 +4265,7 @@ resume_run_queue(ErtsRunQueue *rq) erts_smp_runq_unlock(rq); -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) -#endif - scheduler_ix_resume_wake(rq->ix); + nrml_sched_ix_resume_wake(rq->ix); } typedef struct { @@ -4051,28 +4323,22 @@ evacuate_run_queue(ErtsRunQueue *rq, int prio_q; ErtsRunQueue *to_rq; ErtsMigrationPaths *mps; - ErtsMigrationPath *mp = NULL; + ErtsMigrationPath *mp; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED); -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) -#endif - { - mps = erts_get_migration_paths_managed(); - mp = &mps->mpath[rq->ix]; - } + ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); + + mps = erts_get_migration_paths_managed(); + mp = &mps->mpath[rq->ix]; /* Evacuate scheduled misc ops */ if (rq->misc.start) { ErtsMiscOpList *start, *end; -#ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); -#endif to_rq = mp->misc_evac_runq; if (!to_rq) return; @@ -4081,6 +4347,7 @@ evacuate_run_queue(ErtsRunQueue *rq, end = rq->misc.end; rq->misc.start = NULL; rq->misc.end = NULL; + ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP); erts_smp_runq_unlock(rq); erts_smp_runq_lock(to_rq); @@ -4101,9 +4368,6 @@ evacuate_run_queue(ErtsRunQueue *rq, if (rq->ports.start) { Port *prt; -#ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); -#endif to_rq = mp->prio[ERTS_PORT_PRIO_LEVEL].runq; if (!to_rq) return; @@ -4141,15 +4405,10 @@ evacuate_run_queue(ErtsRunQueue *rq, int notify = 0; to_rq = NULL; -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) -#endif - { - if (!mp->prio[prio_q].runq) - return; - if (prio_q == PRIORITY_NORMAL && !mp->prio[PRIORITY_LOW].runq) - return; - } + if (!mp->prio[prio_q].runq) + return; + if (prio_q == PRIORITY_NORMAL && !mp->prio[PRIORITY_LOW].runq) + return; proc = dequeue_process(rq, prio_q, &state); while (proc) { @@ -4205,11 +4464,6 @@ evacuate_run_queue(ErtsRunQueue *rq, goto handle_next_proc; } -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - clear_proc_dirty_queue_bit(real_proc, rq, qbit); -#endif - if (ERTS_PSFLG_BOUND & real_state) { /* Bound processes get stuck here... */ proc->next = NULL; @@ -4223,16 +4477,7 @@ evacuate_run_queue(ErtsRunQueue *rq, int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state); erts_smp_runq_unlock(rq); -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - /* - * dirty run queues evacuate only to run - * queue 0 during multi-scheduling blocking - */ - to_rq = ERTS_RUNQ_IX(0); - else -#endif - to_rq = mp->prio[prio].runq; + to_rq = mp->prio[prio].runq; RUNQ_SET_RQ(&proc->run_queue, to_rq); erts_smp_runq_lock(to_rq); @@ -4267,7 +4512,7 @@ try_steal_task_from_victim(ErtsRunQueue *rq, int *rq_lockedp, ErtsRunQueue *vrq, erts_smp_runq_lock(vrq); - if (rq->halt_in_progress) + if (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_HALTING) goto no_procs; /* @@ -4366,8 +4611,7 @@ check_possible_steal_victim(ErtsRunQueue *rq, int *rq_lockedp, int vix) { ErtsRunQueue *vrq = ERTS_RUNQ_IX(vix); Uint32 flags = ERTS_RUNQ_FLGS_GET(vrq); - if ((flags & (ERTS_RUNQ_FLG_NONEMPTY - | ERTS_RUNQ_FLG_PROTECTED)) == ERTS_RUNQ_FLG_NONEMPTY) + if (runq_got_work_to_execute_flags(flags) & (!(flags & ERTS_RUNQ_FLG_PROTECTED))) return try_steal_task_from_victim(rq, rq_lockedp, vrq, flags); else return 0; @@ -4435,11 +4679,9 @@ try_steal_task(ErtsRunQueue *rq) if (!rq_locked) erts_smp_runq_lock(rq); - if (!res) - res = rq->halt_in_progress ? - !ERTS_EMPTY_RUNQ_PORTS(rq) : !ERTS_EMPTY_RUNQ(rq); - - return res; + if (res) + return res; + return runq_got_work_to_execute(rq); } /* Run queue balancing */ @@ -5351,7 +5593,7 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags) #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) { if (rq->waiting) { - wake_dirty_schedulers(rq, 1); + wake_dirty_scheduler(rq); } } else #endif @@ -5698,7 +5940,8 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, ErtsSchedulerSleepInfo* ssi, ErtsRunQueue* runq, char** daww_ptr, size_t daww_sz, - Process *shadow_proc) + Process *shadow_proc, + Uint64 time_stamp) { esdp->timer_wheel = NULL; #ifdef ERTS_SMP @@ -5714,13 +5957,29 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER, MAX_REG * sizeof(FloatDef)); #ifdef ERTS_DIRTY_SCHEDULERS + esdp->run_queue = runq; if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) { esdp->no = 0; + if (runq == ERTS_DIRTY_CPU_RUNQ) + esdp->type = ERTS_SCHED_DIRTY_CPU; + else { + ASSERT(runq == ERTS_DIRTY_IO_RUNQ); + esdp->type = ERTS_SCHED_DIRTY_IO; + } ERTS_DIRTY_SCHEDULER_NO(esdp) = (Uint) num; + if (num == 1) { + /* + * Multi-scheduling block functionality depends + * on finding dirty scheduler number 1 here... + */ + runq->scheduler = esdp; + } } else { + esdp->type = ERTS_SCHED_NORMAL; esdp->no = (Uint) num; ERTS_DIRTY_SCHEDULER_NO(esdp) = 0; + runq->scheduler = esdp; } esdp->dirty_shadow_process = shadow_proc; if (shadow_proc) { @@ -5732,6 +5991,8 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, shadow_proc->static_flags = ERTS_STC_FLG_SHADOW_PROC; } #else + runq->scheduler = esdp; + esdp->run_queue = runq; esdp->no = (Uint) num; #endif @@ -5744,9 +6005,6 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, erts_init_atom_cache_map(&esdp->atom_cache_map); - esdp->run_queue = runq; - esdp->run_queue->scheduler = esdp; - esdp->last_monotonic_time = 0; esdp->check_time_reds = 0; @@ -5765,7 +6023,7 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, esdp->reductions = 0; - init_sched_wall_time(&esdp->sched_wall_time); + init_sched_wall_time(esdp, time_stamp); erts_port_task_handle_init(&esdp->nosuspend_port_task_handle); } @@ -5862,7 +6120,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online erts_smp_atomic32_set_nob(&rq->len, 0); rq->wakeup_other = 0; rq->wakeup_other_reds = 0; - rq->halt_in_progress = 0; rq->procs.pending_exiters = NULL; rq->procs.context_switches = 0; @@ -5980,17 +6237,18 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online erts_aligned_scheduler_data = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA, - n*sizeof(ErtsAlignedSchedulerData)); + n*sizeof(ErtsAlignedSchedulerData)); for (ix = 0; ix < n; ix++) { ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix); init_scheduler_data(esdp, ix+1, ERTS_SCHED_SLEEP_INFO_IX(ix), ERTS_RUNQ_IX(ix), &daww_ptr, daww_sz, - NULL); + NULL, 0); } #ifdef ERTS_DIRTY_SCHEDULERS { + Uint64 ts = sched_wall_time_ts(); int dirty_scheds = no_dirty_cpu_schedulers + no_dirty_io_schedulers; int adspix = 0; ErtsAlignedDirtyShadowProcess *adsp = @@ -6010,13 +6268,13 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix); init_scheduler_data(esdp, ix+1, ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix), ERTS_DIRTY_CPU_RUNQ, NULL, 0, - &adsp[adspix++].dsp); + &adsp[adspix++].dsp, ts); } for (ix = 0; ix < no_dirty_io_schedulers; ix++) { ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix); init_scheduler_data(esdp, ix+1, ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix), ERTS_DIRTY_IO_RUNQ, NULL, 0, - &adsp[adspix++].dsp); + &adsp[adspix++].dsp, ts); } } #endif @@ -6233,6 +6491,12 @@ check_dirty_enqueue_in_prio_queue(Process *c_p, int queue; erts_aint32_t dact, max_qbit; + /* Do not enqueue free process... */ + if (actual & ERTS_PSFLG_FREE) { + *newp &= ~ERTS_PSFLGS_DIRTY_WORK; + return ERTS_ENQUEUE_NOT; + } + /* Termination should be done on an ordinary scheduler */ if ((*newp) & ERTS_PSFLG_EXITING) { *newp &= ~ERTS_PSFLGS_DIRTY_WORK; @@ -6425,6 +6689,9 @@ select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t st /* * schedule_out_process() return with c_rq locked. + * + * Return non-zero value if caller should decrease + * reference count on the process when done with it... */ static ERTS_INLINE int schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, @@ -6434,10 +6701,30 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, int enqueue; /* < 0 -> use proxy */ ErtsRunQueue* runq; - if (is_normal_sched) - running_flgs = ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS; - else + if (!is_normal_sched) running_flgs = ERTS_PSFLG_DIRTY_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS; + else { + running_flgs = ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS; +#ifdef ERTS_DIRTY_SCHEDULERS + if (state & ERTS_PSFLG_DIRTY_ACTIVE_SYS + && (p->flags & (F_DELAY_GC|F_DISABLE_GC))) { + /* + * Delay dirty GC; will be enabled automatically + * again by next GC... + */ + + /* + * No normal execution until dirty CLA or hibernat has + * been handled... + */ + ASSERT(!(p->flags & (F_DIRTY_CLA | F_DIRTY_GC_HIBERNATE))); + + state = erts_smp_atomic32_read_band_nob(&p->state, + ~ERTS_PSFLG_DIRTY_ACTIVE_SYS); + state &= ~ERTS_PSFLG_DIRTY_ACTIVE_SYS; + } +#endif + } a = state; @@ -6479,12 +6766,18 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(c_rq); - return 0; - +#if !defined(ERTS_SMP) + /* Decrement refc if process struct is free... */ + return !!(n & ERTS_PSFLG_FREE); +#else + /* Decrement refc if scheduled out from dirty scheduler... */ + return !is_normal_sched; +#endif } else { Process* sched_p; + ASSERT(!(n & ERTS_PSFLG_FREE)); ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS))); @@ -6500,11 +6793,14 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(runq); + if (is_normal_sched && sched_p == p && ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) + erts_proc_inc_refc(p); /* Needs to be done before enqueue_process() */ + /* Enqueue the process */ enqueue_process(runq, (int) enq_prio, sched_p); if (runq == c_rq) - return 1; + return 0; erts_smp_runq_unlock(runq); @@ -6512,9 +6808,15 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(c_rq); - return 1; + /* + * Decrement refc if process is scheduled out by a + * dirty scheduler, and we have not just scheduled + * the process using the ordinary process struct + * on a dirty run-queue again... + */ + return !is_normal_sched && (sched_p != p + || !ERTS_RUNQ_IX_IS_DIRTY(runq->ix)); } - } static ERTS_INLINE void @@ -6529,8 +6831,17 @@ add2runq(int enqueue, erts_aint32_t prio, if (runq) { Process *sched_p; - if (enqueue > 0) + if (enqueue > 0) { sched_p = proc; + /* + * Refc on process struct (i.e. true struct, + * not proxy-struct) increased while in a + * dirty run-queue or executing on a dirty + * scheduler. + */ + if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) + erts_proc_inc_refc(proc); + } else { Process *pxy; @@ -6925,15 +7236,8 @@ resume_process(Process *p, ErtsProcLocks locks) #ifdef ERTS_SMP -static void -scheduler_ix_resume_wake(Uint ix) -{ - ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); -} - -static void -scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi) +static ERTS_INLINE void +sched_resume_wake__(ErtsSchedulerSleepInfo *ssi) { erts_aint32_t xflgs = (ERTS_SSI_FLG_SLEEPING | ERTS_SSI_FLG_TSE_SLEEPING @@ -6947,9 +7251,31 @@ scheduler_ssi_resume_wake(ErtsSchedulerSleepInfo *ssi) break; } xflgs = oflgs; - } while (oflgs & ERTS_SSI_FLG_SUSPENDED); + } while (oflgs & (ERTS_SSI_FLG_MSB_EXEC|ERTS_SSI_FLG_SUSPENDED)); } +static void +nrml_sched_ix_resume_wake(Uint ix) +{ + sched_resume_wake__(ERTS_SCHED_SLEEP_INFO_IX(ix)); +} + +#ifdef ERTS_DIRTY_SCHEDULERS + +static void +dcpu_sched_ix_resume_wake(Uint ix) +{ + sched_resume_wake__(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix)); +} + +static void +dio_sched_ix_resume_wake(Uint ix) +{ + sched_resume_wake__(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix)); +} + +#endif + static erts_aint32_t sched_prep_spin_suspended(ErtsSchedulerSleepInfo *ssi, erts_aint32_t xpct) { @@ -7029,9 +7355,18 @@ static void init_scheduler_suspend(void) { erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd"); - schdlr_sspnd.online = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); - schdlr_sspnd.curr_online = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); - schdlr_sspnd.active = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); + schdlr_sspnd.online.normal = 1; + schdlr_sspnd.curr_online.normal = 1; + schdlr_sspnd.active.normal = 1; +#ifdef ERTS_DIRTY_SCHEDULERS + schdlr_sspnd.online.dirty_cpu = 0; + schdlr_sspnd.curr_online.dirty_cpu = 0; + schdlr_sspnd.active.dirty_cpu = 0; + schdlr_sspnd.online.dirty_io = 0; + schdlr_sspnd.curr_online.dirty_io = 0; + schdlr_sspnd.active.dirty_io = 0; + schdlr_sspnd.last_msb_dirty_type = ERTS_SCHED_DIRTY_IO; +#endif erts_smp_atomic32_init_nob(&schdlr_sspnd.changing, 0); schdlr_sspnd.chngq = NULL; schdlr_sspnd.changer = am_false; @@ -7054,12 +7389,18 @@ typedef struct { } ErtsSchdlrSspndResume; static void -schdlr_sspnd_resume_proc(Eterm pid) +schdlr_sspnd_resume_proc(ErtsSchedType sched_type, Eterm pid) { - Process *p = erts_pid2proc(NULL, 0, pid, ERTS_PROC_LOCK_STATUS); + Process *p; + p = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_STATUS, + (sched_type != ERTS_SCHED_NORMAL + ? ERTS_P2P_FLG_INC_REFC + : 0)); if (p) { resume_process(p, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (sched_type != ERTS_SCHED_NORMAL) + erts_proc_dec_refc(p); } } @@ -7068,21 +7409,270 @@ schdlr_sspnd_resume_procs(ErtsSchedType sched_type, ErtsSchdlrSspndResume *resume) { if (is_internal_pid(resume->onln.chngr)) { - schdlr_sspnd_resume_proc(resume->onln.chngr); + schdlr_sspnd_resume_proc(sched_type, + resume->onln.chngr); resume->onln.chngr = NIL; } if (is_internal_pid(resume->onln.nxt)) { - schdlr_sspnd_resume_proc(resume->onln.nxt); + schdlr_sspnd_resume_proc(sched_type, + resume->onln.nxt); resume->onln.nxt = NIL; } while (resume->msb.chngrs) { ErtsProcList *plp = resume->msb.chngrs; resume->msb.chngrs = plp->next; - schdlr_sspnd_resume_proc(plp->pid); + schdlr_sspnd_resume_proc(sched_type, + plp->pid); proclist_destroy(plp); } } +#ifdef ERTS_DIRTY_SCHEDULERS + +static ERTS_INLINE int +have_dirty_work(void) +{ + return !(ERTS_EMPTY_RUNQ(ERTS_DIRTY_CPU_RUNQ) + | ERTS_EMPTY_RUNQ(ERTS_DIRTY_IO_RUNQ)); +} + +#define ERTS_MSB_NONE_PRIO_BIT PORT_BIT + +static ERTS_INLINE Uint32 +msb_runq_prio_bit(Uint32 flgs) +{ + int pbit; + + pbit = (int) (flgs & ERTS_RUNQ_FLGS_PROCS_QMASK); + if (flgs & PORT_BIT) { + /* rate ports as proc prio high */ + pbit |= HIGH_BIT; + } + if (flgs & ERTS_RUNQ_FLG_MISC_OP) { + /* rate misc ops as proc prio normal */ + pbit |= NORMAL_BIT; + } + if (flgs & LOW_BIT) { + /* rate low prio as normal (avoid starvation) */ + pbit |= NORMAL_BIT; + } + if (!pbit) + pbit = (int) ERTS_MSB_NONE_PRIO_BIT; + else + pbit &= -pbit; /* least significant bit set... */ + ASSERT(pbit); + + /* High prio low value; low prio high value... */ + return (Uint32) pbit; +} + +static ERTS_INLINE void +msb_runq_prio_bits(Uint32 *nrmlp, Uint32 *dcpup, Uint32 *diop) +{ + Uint32 flgs = ERTS_RUNQ_FLGS_GET(ERTS_RUNQ_IX(0)); + if (flgs & ERTS_RUNQ_FLG_HALTING) { + /* + * Emulator is halting; only execute port jobs + * on normal scheduler. Ensure that we switch + * to the normal scheduler. + */ + *nrmlp = HIGH_BIT; + *dcpup = ERTS_MSB_NONE_PRIO_BIT; + *diop = ERTS_MSB_NONE_PRIO_BIT; + } + else { + *nrmlp = msb_runq_prio_bit(flgs); + + flgs = ERTS_RUNQ_FLGS_GET(ERTS_DIRTY_CPU_RUNQ); + *dcpup = msb_runq_prio_bit(flgs); + + flgs = ERTS_RUNQ_FLGS_GET(ERTS_DIRTY_IO_RUNQ); + *diop = msb_runq_prio_bit(flgs); + } +} + +static int +msb_scheduler_type_switch(ErtsSchedType sched_type, + ErtsSchedulerData *esdp, + long no) +{ + Uint32 nrml_prio, dcpu_prio, dio_prio; + ErtsSchedType exec_type; + ErtsRunQueue *exec_rq; +#ifdef DEBUG + erts_aint32_t dbg_val; +#endif + + ASSERT(schdlr_sspnd.msb.ongoing); + + /* + * This function determines how to switch + * between scheduler types when multi-scheduling + * is blocked. + * + * If no dirty work exist, we always select + * execution of normal scheduler. If nothing + * executes, normal scheduler 1 should be waiting + * in sys_schedule(), otherwise we cannot react + * on I/O events. + * + * We unconditionally switch back to normal + * scheduler after executing dirty in order to + * make sure we check for I/O... + */ + + msb_runq_prio_bits(&nrml_prio, &dcpu_prio, &dio_prio); + + exec_type = ERTS_SCHED_NORMAL; + if (sched_type == ERTS_SCHED_NORMAL) { + + /* + * Check priorities of work in the + * different run-queues and determine + * run-queue with highest prio job... + */ + + if ((dcpu_prio == ERTS_MSB_NONE_PRIO_BIT) + & (dio_prio == ERTS_MSB_NONE_PRIO_BIT)) { + /* + * No dirty work exist; continue on normal + * scheduler... + */ + return 0; + } + + if (dcpu_prio < nrml_prio) { + exec_type = ERTS_SCHED_DIRTY_CPU; + if (dio_prio < dcpu_prio) + exec_type = ERTS_SCHED_DIRTY_IO; + } + else { + if (dio_prio < nrml_prio) + exec_type = ERTS_SCHED_DIRTY_IO; + } + + /* + * Make sure to alternate between dirty types + * inbetween normal execution if highest + * priorities are equal. + */ + + if (exec_type == ERTS_SCHED_NORMAL) { + if (dcpu_prio == nrml_prio) + exec_type = ERTS_SCHED_DIRTY_CPU; + else if (dio_prio == nrml_prio) + exec_type = ERTS_SCHED_DIRTY_IO; + else { + /* + * Normal work has higher prio than + * dirty work; continue on normal + * scheduler... + */ + return 0; + } + } + + ASSERT(exec_type != ERTS_SCHED_NORMAL); + if (dio_prio == dcpu_prio) { + /* Alter between dirty types... */ + if (schdlr_sspnd.last_msb_dirty_type == ERTS_SCHED_DIRTY_IO) + exec_type = ERTS_SCHED_DIRTY_CPU; + else + exec_type = ERTS_SCHED_DIRTY_IO; + } + } + + ASSERT(sched_type != exec_type); + + if (exec_type != ERTS_SCHED_NORMAL) + schdlr_sspnd.last_msb_dirty_type = exec_type; + else { + erts_aint32_t calls; + /* + * Going back to normal scheduler after + * dirty execution; make sure it will check + * for I/O... + */ + if (ERTS_USE_MODIFIED_TIMING()) + calls = ERTS_MODIFIED_TIMING_INPUT_REDS + 1; + else + calls = INPUT_REDUCTIONS + 1; + erts_smp_atomic32_set_nob(&function_calls, calls); + + if ((nrml_prio == ERTS_MSB_NONE_PRIO_BIT) + & ((dcpu_prio != ERTS_MSB_NONE_PRIO_BIT) + | (dio_prio != ERTS_MSB_NONE_PRIO_BIT))) { + /* + * We have dirty work, but an empty + * normal run-queue. + * + * Since the normal run-queue is + * empty, the normal scheduler will + * go to sleep when selected for + * execution. We have dirty work to + * do, so we only want it to check + * I/O, and then come back here and + * switch to dirty execution. + * + * To prevent the scheduler from going + * to sleep we trick it into believing + * it has work to do... + */ + ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0), + ERTS_RUNQ_FLG_MISC_OP); + } + } + + /* + * Suspend this scheduler and wake up scheduler + * number one of another type... + */ +#ifdef DEBUG + dbg_val = +#else + (void) +#endif + erts_smp_atomic32_read_bset_mb(&esdp->ssi->flags, + (ERTS_SSI_FLG_SUSPENDED + | ERTS_SSI_FLG_MSB_EXEC), + ERTS_SSI_FLG_SUSPENDED); + ASSERT(dbg_val & ERTS_SSI_FLG_MSB_EXEC); + + switch (exec_type) { + case ERTS_SCHED_NORMAL: + exec_rq = ERTS_RUNQ_IX(0); + break; + case ERTS_SCHED_DIRTY_CPU: + exec_rq = ERTS_DIRTY_CPU_RUNQ; + break; + case ERTS_SCHED_DIRTY_IO: + exec_rq = ERTS_DIRTY_IO_RUNQ; + break; + default: + ERTS_INTERNAL_ERROR("Invalid scheduler type"); + exec_rq = NULL; + break; + } + +#ifdef DEBUG + dbg_val = +#else + (void) +#endif + erts_smp_atomic32_read_bset_mb(&exec_rq->scheduler->ssi->flags, + (ERTS_SSI_FLG_SUSPENDED + | ERTS_SSI_FLG_MSB_EXEC), + ERTS_SSI_FLG_MSB_EXEC); + ASSERT(dbg_val & ERTS_SSI_FLG_SUSPENDED); + + wake_scheduler(exec_rq); + + return 1; /* suspend this scheduler... */ + +} + +#endif + static void suspend_scheduler(ErtsSchedulerData *esdp) { @@ -7108,40 +7698,51 @@ suspend_scheduler(ErtsSchedulerData *esdp) * Regardless of why a scheduler is suspended, it ends up here. */ -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + +#if !defined(ERTS_DIRTY_SCHEDULERS) + + sched_type = ERTS_SCHED_NORMAL; + online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN; + no = esdp->no; + ASSERT(no != 1); + +#else + + sched_type = esdp->type; + switch (sched_type) { + case ERTS_SCHED_NORMAL: + online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN; + no = esdp->no; + break; + case ERTS_SCHED_DIRTY_CPU: + online_flag = ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN; + no = ERTS_DIRTY_SCHEDULER_NO(esdp); + break; + case ERTS_SCHED_DIRTY_IO: + online_flag = 0; no = ERTS_DIRTY_SCHEDULER_NO(esdp); - if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) { - online_flag = ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN; - sched_type = ERTS_SCHED_DIRTY_CPU; - } - else { - online_flag = 0; - sched_type = ERTS_SCHED_DIRTY_IO; - } + break; + default: + ERTS_INTERNAL_ERROR("Invalid scheduler type"); + return; } - else -#endif - { - online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN; - no = esdp->no; - sched_type = ERTS_SCHED_NORMAL; + + if (erts_smp_atomic32_read_nob(&ssi->flags) & ERTS_SSI_FLG_MSB_EXEC) { + ASSERT(no == 1); + if (!msb_scheduler_type_switch(sched_type, esdp, no)) + return; + /* Suspend and let scheduler 1 of another type execute... */ } - ASSERT(sched_type != ERTS_SCHED_NORMAL || no != 1); +#endif if (sched_type != ERTS_SCHED_NORMAL) { - if (erts_smp_mtx_trylock(&schdlr_sspnd.mtx) == EBUSY) { - erts_smp_runq_unlock(esdp->run_queue); - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - erts_smp_runq_lock(esdp->run_queue); - } - if (schdlr_sspnd.msb.ongoing) - evacuate_run_queue(esdp->run_queue, &sbp); erts_smp_runq_unlock(esdp->run_queue); + dirty_sched_wall_time_change(esdp, 0); } else { - evacuate_run_queue(esdp->run_queue, &sbp); + if (no != 1) + evacuate_run_queue(esdp->run_queue, &sbp); erts_smp_runq_unlock(esdp->run_queue); @@ -7149,20 +7750,15 @@ suspend_scheduler(ErtsSchedulerData *esdp) if (erts_system_profile_flags.scheduler) profile_scheduler(make_small(esdp->no), am_inactive); - - sched_wall_time_change(esdp, 0); - - erts_smp_mtx_lock(&schdlr_sspnd.mtx); } + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED); if (flgs & ERTS_SSI_FLG_SUSPENDED) { schdlr_sspnd_dec_nscheds(&schdlr_sspnd.active, sched_type); - ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_NORMAL) >= 1); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); while (1) { @@ -7184,9 +7780,13 @@ suspend_scheduler(ErtsSchedulerData *esdp) ERTS_SCHED_NORMAL) == 1) { clr_flg = ERTS_SCHDLR_SSPND_CHNG_NMSB; } - else if (schdlr_sspnd.active - == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0)) { - clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB; + else if (schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) == 1 + && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_CPU) == 0 + && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_IO) == 0) { + clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB; } if (clr_flg) { @@ -7197,15 +7797,18 @@ suspend_scheduler(ErtsSchedulerData *esdp) (void) erts_proclist_fetch(&msb[i]->chngq, &end_plp); /* resume processes that initiated the multi scheduling block... */ plp = msb[i]->chngq; - while (plp) { - erts_proclist_store_last(&msb[i]->blckrs, - proclist_copy(plp)); - plp = plp->next; - } - if (end_plp) + if (plp) { + ASSERT(end_plp); + ASSERT(msb[i]->ongoing); + do { + erts_proclist_store_last(&msb[i]->blckrs, + proclist_copy(plp)); + plp = plp->next; + } while (plp); end_plp->next = resume.msb.chngrs; - resume.msb.chngrs = msb[i]->chngq; - msb[i]->chngq = NULL; + resume.msb.chngrs = msb[i]->chngq; + msb[i]->chngq = NULL; + } } } } @@ -7255,10 +7858,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) } } - if (curr_online - && (sched_type == ERTS_SCHED_NORMAL - ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) - : !schdlr_sspnd.msb.ongoing)) { + if (curr_online) { flgs = erts_smp_atomic32_read_acqb(&ssi->flags); if (!(flgs & ERTS_SSI_FLG_SUSPENDED)) break; @@ -7269,28 +7869,16 @@ suspend_scheduler(ErtsSchedulerData *esdp) while (1) { ErtsMonotonicTime current_time; - erts_aint32_t qmask; erts_aint32_t flgs; - qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue) - & ERTS_RUNQ_FLGS_QMASK); - - if (sched_type != ERTS_SCHED_NORMAL) { - if (qmask) { - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - erts_smp_runq_lock(esdp->run_queue); - if (schdlr_sspnd.msb.ongoing) - evacuate_run_queue(esdp->run_queue, &sbp); - erts_smp_runq_unlock(esdp->run_queue); - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - } + if (sched_type != ERTS_SCHED_NORMAL) aux_work = 0; - } else { + int evacuate = no == 1 ? 0 : !ERTS_EMPTY_RUNQ(esdp->run_queue); aux_work = erts_atomic32_read_acqb(&ssi->aux_work); - if (aux_work|qmask) { + if (aux_work|evacuate) { if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); sched_wall_time_change(esdp, 1); @@ -7302,7 +7890,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); - if (qmask) { + if (evacuate) { erts_smp_runq_lock(esdp->run_queue); evacuate_run_queue(esdp->run_queue, &sbp); erts_smp_runq_unlock(esdp->run_queue); @@ -7414,37 +8002,46 @@ suspend_scheduler(ErtsSchedulerData *esdp) schdlr_sspnd_inc_nscheds(&schdlr_sspnd.active, sched_type); changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) - && schdlr_sspnd.online == schdlr_sspnd.active) { - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_MSB); - } - + if (changing) { + if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) + && !schdlr_sspnd.msb.ongoing + && schdlr_sspnd_eq_nscheds(&schdlr_sspnd.online, + &schdlr_sspnd.active)) { + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~ERTS_SCHDLR_SSPND_CHNG_MSB); + } + if ((changing & ERTS_SCHDLR_SSPND_CHNG_NMSB) + && !schdlr_sspnd.nmsb.ongoing + && (schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL) + == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL))) { + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~ERTS_SCHDLR_SSPND_CHNG_NMSB); + } + } ASSERT(no <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, sched_type)); - ASSERT((sched_type == ERTS_SCHED_NORMAL - ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) - : !schdlr_sspnd.msb.ongoing)); } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - ASSERT(!resume.msb.chngrs); schdlr_sspnd_resume_procs(sched_type, &resume); ASSERT(curr_online); - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { - if (erts_system_profile_flags.scheduler) - profile_scheduler(make_small(esdp->no), am_active); + if (sched_type != ERTS_SCHED_NORMAL) + dirty_sched_wall_time_change(esdp, 1); + else { + (void) erts_get_monotonic_time(esdp); + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(esdp->no), am_active); - if (!thr_prgr_active) { - erts_thr_progress_active(esdp, thr_prgr_active = 1); - sched_wall_time_change(esdp, 1); - } + if (!thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } } - if (sched_type == ERTS_SCHED_NORMAL) - (void) erts_get_monotonic_time(esdp); erts_smp_runq_lock(esdp->run_queue); non_empty_runq(esdp->run_queue); @@ -7552,7 +8149,7 @@ abort_sched_onln_chng_waitq(Process *p) erts_smp_mtx_unlock(&schdlr_sspnd.mtx); if (is_internal_pid(resume)) - schdlr_sspnd_resume_proc(resume); + schdlr_sspnd_resume_proc(ERTS_SCHED_NORMAL, resume); } ErtsSchedSuspendResult @@ -7714,10 +8311,8 @@ erts_set_schedulers_online(Process *p, erts_sched_poke(ssi); } } else { - for (ix = dirty_online; ix < dirty_no; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - } + for (ix = dirty_online; ix < dirty_no; ix++) + dcpu_sched_ix_resume_wake(ix); } } if (!dirty_only) @@ -7745,19 +8340,19 @@ erts_set_schedulers_online(Process *p, else /* if decrease */ { #ifdef ERTS_DIRTY_SCHEDULERS if (change_dirty) { - ErtsSchedulerSleepInfo* ssi; if (schdlr_sspnd.msb.ongoing) { - for (ix = dirty_no; ix < dirty_online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_sched_poke(ssi); - } - } else { - for (ix = dirty_no; ix < dirty_online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + for (ix = dirty_no; ix < dirty_online; ix++) + erts_sched_poke(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix)); + } + else { + for (ix = dirty_no; ix < dirty_online; ix++) + dcpu_sched_ix_suspend_wake(ix); + /* + * Newly suspended scheduler may have just been + * about to handle a task. Make sure someone takes + * care of such a task... + */ + dcpu_sched_ix_wake(0); } } if (!dirty_only) @@ -7820,9 +8415,6 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal { int resume_proc, ix, res, have_unlocked_plocks = 0; ErtsProcList *plp; -#ifdef ERTS_DIRTY_SCHEDULERS - ErtsSchedulerSleepInfo* ssi; -#endif ErtsMultiSchedulingBlock *msbp; erts_aint32_t chng_flg; int have_blckd_flg; @@ -7869,8 +8461,9 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal erts_proclist_store_last(&msbp->blckrs, plp); p->flags |= have_blckd_flg; ASSERT(normal - ? 1 == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, ERTS_SCHED_NORMAL) - : schdlr_sspnd.active == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0)); + ? 1 == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) + : schdlr_sspnd_get_nscheds_tot(&schdlr_sspnd.active) == 1); ASSERT(erts_proc_sched_data(p)->no == 1); if (schdlr_sspnd.msb.ongoing) res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; @@ -7888,59 +8481,41 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal } ASSERT(!msbp->ongoing); msbp->ongoing = 1; - if (schdlr_sspnd.active == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0) - || (normal && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_NORMAL) == 1)) { - ASSERT(erts_proc_sched_data(p)->no == 1); - plp = proclist_create(p); - erts_proclist_store_last(&msbp->blckrs, plp); - if (schdlr_sspnd.msb.ongoing) - res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; - else - res = ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED; - } - else { - erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, - chng_flg); - change_no_used_runqs(1); - for (ix = 1; ix < erts_no_run_queues; ix++) - suspend_run_queue(ERTS_RUNQ_IX(ix)); - for (ix = 1; ix < online; ix++) { - ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); - wake_scheduler(rq); - } + erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, + chng_flg); + change_no_used_runqs(1); + for (ix = 1; ix < erts_no_run_queues; ix++) + suspend_run_queue(ERTS_RUNQ_IX(ix)); -#ifdef ERTS_DIRTY_SCHEDULERS - if (!normal) { - for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); + for (ix = 1; ix < online; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + wake_scheduler(rq); + } - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { - ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); - } +#ifdef ERTS_DIRTY_SCHEDULERS + if (!normal) { + ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0), ERTS_RUNQ_FLG_MSB_EXEC); + erts_smp_atomic32_read_bor_nob(&ERTS_RUNQ_IX(0)->scheduler->ssi->flags, + ERTS_SSI_FLG_MSB_EXEC); + for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) + dcpu_sched_ix_suspend_wake(ix); + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) + dio_sched_ix_suspend_wake(ix); + } #endif - wait_until_msb: + wait_until_msb: - ASSERT(chng_flg & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)); + ASSERT(chng_flg & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)); - plp = proclist_create(p); - erts_proclist_store_last(&msbp->chngq, plp); - resume_proc = 0; - if (schdlr_sspnd.msb.ongoing) - res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED; - else - res = ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED; - } + plp = proclist_create(p); + erts_proclist_store_last(&msbp->chngq, plp); + resume_proc = 0; + if (schdlr_sspnd.msb.ongoing) + res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED; + else + res = ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED; ASSERT(erts_proc_sched_data(p)); } } @@ -7950,21 +8525,20 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal } else { /* ------ UNBLOCK ------ */ if (p->flags & have_blckd_flg) { - ErtsProcList *plps[2]; + ErtsProcList **plpps[3] = {0}; ErtsProcList *plp; - int limit = 0; - plps[limit++] = erts_proclist_peek_first(msbp->blckrs); - if (all) - plps[limit++] = erts_proclist_peek_first(msbp->chngq); + plpps[0] = &msbp->blckrs; + if (all) + plpps[1] = &msbp->chngq; - for (ix = 0; ix < limit; ix++) { - plp = plps[ix]; + for (ix = 0; plpps[ix]; ix++) { + plp = erts_proclist_peek_first(*plpps[ix]); while (plp) { ErtsProcList *tmp_plp = plp; - plp = erts_proclist_peek_next(msbp->blckrs, plp); + plp = erts_proclist_peek_next(*plpps[ix], plp); if (erts_proclist_same(tmp_plp, p)) { - erts_proclist_remove(&msbp->blckrs, tmp_plp); + erts_proclist_remove(plpps[ix], tmp_plp); proclist_destroy(tmp_plp); if (!all) break; @@ -7973,27 +8547,19 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal } } if (!msbp->blckrs && !msbp->chngq) { - int online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, - ERTS_SCHED_NORMAL); + int online; erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, chng_flg); p->flags &= ~have_blckd_flg; msbp->ongoing = 0; - if (online == 1) { - /* No normal schedulers to resume */ - ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, - ERTS_SCHED_NORMAL) == 1); -#ifndef ERTS_DIRTY_SCHEDULERS - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~chng_flg); -#endif - } - else if (!(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)) { - if (plocks) { + if (!(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)) { + if (plocks) { have_unlocked_plocks = 1; erts_smp_proc_unlock(p, plocks); } + online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL); change_no_used_runqs(online); /* Resume all online run queues */ @@ -8004,19 +8570,15 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal suspend_run_queue(ERTS_RUNQ_IX(ix)); } #ifdef ERTS_DIRTY_SCHEDULERS - if (!normal) { - ASSERT(!schdlr_sspnd.msb.ongoing); + if (!schdlr_sspnd.msb.ongoing) { + /* Get rid of msb-exec flag in run-queue of scheduler 1 */ + resume_run_queue(ERTS_RUNQ_IX(0)); online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, ERTS_SCHED_DIRTY_CPU); - for (ix = 0; ix < online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - } - - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { - ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - } + for (ix = 0; ix < online; ix++) + dcpu_sched_ix_resume_wake(ix); + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) + dio_sched_ix_resume_wake(ix); } #endif } @@ -8190,6 +8752,8 @@ sched_dirty_cpu_thread_func(void *vesdp) callbacks.wait = NULL; callbacks.finalize_wait = NULL; + dirty_sched_wall_time_change(esdp, 1); + esdp->thr_id += erts_no_schedulers; erts_msacc_init_thread("dirty_cpu_scheduler", no, 0); @@ -8237,6 +8801,8 @@ sched_dirty_io_thread_func(void *vesdp) callbacks.wait = NULL; callbacks.finalize_wait = NULL; + dirty_sched_wall_time_change(esdp, 1); + esdp->thr_id += erts_no_schedulers + erts_no_dirty_cpu_schedulers; erts_msacc_init_thread("dirty_io_scheduler", no, 0); @@ -8604,8 +9170,14 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, * from being selected for normal execution regardless * of locks held or not held on it... */ - ASSERT(!((ERTS_PSFLG_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS) - & erts_smp_atomic32_read_nob(&rp->state))); +#ifdef DEBUG + { + erts_aint32_t state; + state = erts_smp_atomic32_read_nob(&rp->state); + ASSERT((state & ERTS_PSFLG_PENDING_EXIT) + || !(state & ERTS_PSFLG_RUNNING)); + } +#endif if (!suspend) resume_process(rp, pid_locks|ERTS_PROC_LOCK_STATUS); @@ -9587,40 +10159,45 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) esdp->reductions += reds; - /* schedule_out_process() returns with rq locked! */ - schedule_out_process(rq, state, p, proxy_p, is_normal_sched); - proxy_p = NULL; + { + int dec_refc; - ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq, - (int) ERTS_PSFLGS_GET_USR_PRIO(state), - reds, - actual_reds); + /* schedule_out_process() returns with rq locked! */ + dec_refc = schedule_out_process(rq, state, p, + proxy_p, is_normal_sched); + proxy_p = NULL; - esdp->current_process = NULL; + ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq, + (int) ERTS_PSFLGS_GET_USR_PRIO(state), + reds, + actual_reds); + + esdp->current_process = NULL; #ifdef ERTS_SMP - p->scheduler_data = NULL; + p->scheduler_data = NULL; #endif - erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCK_STATUS - | ERTS_PROC_LOCK_TRACE)); + erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN + | ERTS_PROC_LOCK_STATUS + | ERTS_PROC_LOCK_TRACE)); - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); - if (state & ERTS_PSFLG_FREE) { - if (!is_normal_sched) { - ASSERT(p->flags & F_DELAYED_DEL_PROC); - erts_proc_dec_refc(p); - } - else { #ifdef ERTS_SMP - ASSERT(esdp->free_process == p); - esdp->free_process = NULL; -#else - erts_proc_dec_refc(p); + if (state & ERTS_PSFLG_FREE) { + if (!is_normal_sched) { + ASSERT(p->flags & F_DELAYED_DEL_PROC); + } + else { + ASSERT(esdp->free_process == p); + esdp->free_process = NULL; + } + } #endif - } - } + + if (dec_refc) + erts_proc_dec_refc(p); + } #ifdef ERTS_SMP ASSERT(!esdp->free_process); @@ -9670,7 +10247,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (!is_normal_sched) { if (erts_smp_atomic32_read_acqb(&esdp->ssi->flags) - & ERTS_SSI_FLG_SUSPENDED) { + & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) { suspend_scheduler(esdp); } } @@ -9680,8 +10257,10 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) ASSERT(is_normal_sched); - if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND|ERTS_RUNQ_FLG_SUSPENDED)) { - if (flags & ERTS_RUNQ_FLG_SUSPENDED) { + if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND + | ERTS_RUNQ_FLG_SUSPENDED + | ERTS_RUNQ_FLG_MSB_EXEC)) { + if (flags & (ERTS_RUNQ_FLG_SUSPENDED|ERTS_RUNQ_FLG_MSB_EXEC)) { (void) ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_EXEC); suspend_scheduler(esdp); flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC); @@ -9720,13 +10299,12 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) flags = ERTS_RUNQ_FLGS_GET_NOB(rq); - if (!is_normal_sched && rq->halt_in_progress) { + if (!is_normal_sched & !!(flags & ERTS_RUNQ_FLG_HALTING)) { /* Wait for emulator to terminate... */ while (1) erts_milli_sleep(1000*1000); } - else if ((!(flags & ERTS_RUNQ_FLGS_QMASK) && !rq->misc.start) - || (rq->halt_in_progress && ERTS_EMPTY_RUNQ_PORTS(rq))) { + else if (!runq_got_work_to_execute_flags(flags)) { /* Prepare for scheduler wait */ #ifdef ERTS_SMP ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); @@ -9740,21 +10318,44 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (flags & ERTS_RUNQ_FLG_INACTIVE) empty_runq(rq); else { - if (is_normal_sched && try_steal_task(rq)) - goto continue_check_activities_to_run; - - empty_runq(rq); - - /* - * Check for ERTS_RUNQ_FLG_SUSPENDED has to be done - * after trying to steal a task. - */ - flags = ERTS_RUNQ_FLGS_GET_NOB(rq); - if (flags & ERTS_RUNQ_FLG_SUSPENDED) { - non_empty_runq(rq); - flags |= ERTS_RUNQ_FLG_NONEMPTY; - goto continue_check_activities_to_run_known_flags; + ASSERT(!runq_got_work_to_execute(rq)); + if (!is_normal_sched) { + /* Dirty scheduler */ + if (erts_smp_atomic32_read_acqb(&esdp->ssi->flags) + & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) { + /* Go suspend... */ + goto continue_check_activities_to_run_known_flags; + } + } + else { + /* Normal scheduler */ + if (try_steal_task(rq)) + goto continue_check_activities_to_run; + /* + * Check for suspend has to be done after trying + * to steal a task... + */ + flags = ERTS_RUNQ_FLGS_GET_NOB(rq); + if ((flags & ERTS_RUNQ_FLG_SUSPENDED) +#ifdef ERTS_DIRTY_SCHEDULERS + /* If multi scheduling block and we have + * dirty work, suspend and let dirty + * scheduler handle work... */ + || ((((flags & (ERTS_RUNQ_FLG_HALTING + | ERTS_RUNQ_FLG_MSB_EXEC)) + == ERTS_RUNQ_FLG_MSB_EXEC)) + && have_dirty_work()) +#endif + ) { + non_empty_runq(rq); + flags |= ERTS_RUNQ_FLG_NONEMPTY; + /* + * Go suspend... + */ + goto continue_check_activities_to_run_known_flags; + } } + empty_runq(rq); } #endif @@ -9806,7 +10407,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) #endif } - if (rq->misc.start) + if (flags & ERTS_RUNQ_FLG_MISC_OP) exec_misc_ops(rq); #ifdef ERTS_SMP @@ -9817,13 +10418,15 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) * Find a new port to run. */ - if (RUNQ_READ_LEN(&rq->ports.info.len)) { + flags = ERTS_RUNQ_FLGS_GET_NOB(rq); + + if (flags & PORT_BIT) { int have_outstanding_io; have_outstanding_io = erts_port_task_execute(rq, &esdp->current_port); if ((!erts_eager_check_io && have_outstanding_io && fcalls > 2*input_reductions) - || rq->halt_in_progress) { + || (flags & ERTS_RUNQ_FLG_HALTING)) { /* * If we have performed more than 2*INPUT_REDUCTIONS since * last call to erl_sys_schedule() and we still haven't @@ -9896,8 +10499,12 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (!(state & ERTS_PSFLG_PROXY)) psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ; else { + Eterm pid = p->common.id; proxy_p = p; - p = erts_proc_lookup_raw(proxy_p->common.id); + p = (is_normal_sched + ? erts_proc_lookup_raw(pid) + : erts_pid2proc_opt(NULL, 0, pid, 0, + ERTS_P2P_FLG_INC_REFC)); if (!p) { free_proxy_proc(proxy_p); proxy_p = NULL; @@ -9929,8 +10536,10 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) | ERTS_PSFLG_FREE))) #ifdef ERTS_DIRTY_SCHEDULERS | (((state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_FREE | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING_SYS | ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) & (!!is_normal_sched)) @@ -9942,7 +10551,14 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) | ERTS_PSFLG_PENDING_EXIT | ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) - != ERTS_PSFLG_SUSPENDED)); + != ERTS_PSFLG_SUSPENDED) +#ifdef ERTS_DIRTY_SCHEDULERS + & (!(state & (ERTS_PSFLG_EXITING + | ERTS_PSFLG_PENDING_EXIT)) + | (!!is_normal_sched)) +#endif + ); + if (run_process) { if (state & (ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) @@ -9961,6 +10577,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) /* free and not queued by proxy */ erts_proc_dec_refc(p); } + if (!is_normal_sched) + erts_proc_dec_refc(p); goto pick_next_process; } state = new; @@ -10045,9 +10663,6 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) goto sunlock_sched_out_proc; } - ASSERT((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS) - || *p->i == (BeamInstr) em_call_nif); - ASSERT(rq == ERTS_DIRTY_CPU_RUNQ ? (state & (ERTS_PSFLG_DIRTY_CPU_PROC | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) @@ -10084,65 +10699,70 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) } } - if (state & (ERTS_PSFLG_RUNNING_SYS - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { - /* - * GC is normally never delayed when a process - * is scheduled out, but might be when executing - * hand written beam assembly in - * prim_eval:'receive'. If GC is delayed we are - * not allowed to execute system tasks. - */ - if (!(p->flags & F_DELAY_GC)) { - int cost = execute_sys_tasks(p, &state, reds); - calls += cost; - reds -= cost; - if (reds <= 0 + if (is_normal_sched) { + + if (state & ERTS_PSFLG_RUNNING_SYS) { + /* + * GC is normally never delayed when a process + * is scheduled out, but might be when executing + * hand written beam assembly in + * prim_eval:'receive'. If GC is delayed we are + * not allowed to execute system tasks. + */ + if (!(p->flags & F_DELAY_GC)) { + int cost = execute_sys_tasks(p, &state, reds); + calls += cost; + reds -= cost; + if (reds <= 0) + goto sched_out_proc; #ifdef ERTS_DIRTY_SCHEDULERS - || !is_normal_sched - || (state & ERTS_PSFLGS_DIRTY_WORK) + if (state & ERTS_PSFLGS_DIRTY_WORK) + goto sched_out_proc; #endif - ) { - goto sched_out_proc; - } - } + } - ASSERT(state & psflg_running_sys); - ASSERT(!(state & psflg_running)); + ASSERT(state & psflg_running_sys); + ASSERT(!(state & psflg_running)); - while (1) { - erts_aint32_t n, e; + while (1) { + erts_aint32_t n, e; - if (((state & (ERTS_PSFLG_SUSPENDED - | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE) - && !(state & ERTS_PSFLG_EXITING)) { - goto sched_out_proc; - } + if (((state & (ERTS_PSFLG_SUSPENDED + | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE) + && !(state & ERTS_PSFLG_EXITING)) { + goto sched_out_proc; + } - n = e = state; - n &= ~psflg_running_sys; - n |= psflg_running; + n = e = state; + n &= ~psflg_running_sys; + n |= psflg_running; - state = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e); - if (state == e) { - state = n; - break; - } + state = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e); + if (state == e) { + state = n; + break; + } - ASSERT(state & psflg_running_sys); - ASSERT(!(state & psflg_running)); - } - } + ASSERT(state & psflg_running_sys); + ASSERT(!(state & psflg_running)); + } + } - if (ERTS_IS_GC_DESIRED(p) && !ERTS_SCHEDULER_IS_DIRTY_IO(esdp)) { - if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & (F_DELAY_GC|F_DISABLE_GC))) { - int cost = scheduler_gc_proc(p, reds); - calls += cost; - reds -= cost; - if (reds <= 0) - goto sched_out_proc; - } - } + if (ERTS_IS_GC_DESIRED(p)) { + if (!(state & ERTS_PSFLG_EXITING) + && !(p->flags & (F_DELAY_GC|F_DISABLE_GC))) { + int cost = scheduler_gc_proc(p, reds); + calls += cost; + reds -= cost; + if (reds <= 0) + goto sched_out_proc; +#ifdef ERTS_DIRTY_SCHEDULERS + if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) + goto sched_out_proc; +#endif + } + } + } if (proxy_p) { free_proxy_proc(proxy_p); @@ -10154,7 +10774,13 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); /* Never run a suspended process */ - ASSERT(!(ERTS_PSFLG_SUSPENDED & erts_smp_atomic32_read_nob(&p->state))); +#ifdef DEBUG + { + erts_aint32_t dstate = erts_smp_atomic32_read_nob(&p->state); + ASSERT(!(ERTS_PSFLG_SUSPENDED & dstate) + || (ERTS_PSFLG_DIRTY_RUNNING_SYS & dstate)); + } +#endif ASSERT(erts_proc_read_refc(p) > 0); @@ -10175,9 +10801,18 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) } static int -notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) +notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, + Eterm st_result, int normal_sched) { - Process *rp = erts_proc_lookup(st->requester); + Process *rp; +#ifdef ERTS_DIRTY_SCHEDULERS + if (!normal_sched) + rp = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, + st->requester, 0, + ERTS_P2P_FLG_INC_REFC); + else +#endif + rp = erts_proc_lookup(st->requester); if (rp) { ErtsProcLocks rp_locks; ErlOffHeap *ohp; @@ -10225,6 +10860,11 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!normal_sched) + erts_proc_dec_refc(rp); +#endif } erts_cleanup_offheap(&st->off_heap); @@ -10380,18 +11020,23 @@ done: } static void save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio); +#ifdef ERTS_DIRTY_SCHEDULERS +static void save_dirty_task(Process *c_p, ErtsProcSysTask *st); +#endif static int execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) { - int garbage_collected = 0; + int minor_gc = 0, major_gc = 0; erts_aint32_t state = *statep; int reds = in_reds; int qmask = 0; + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p))); ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN); do { + ErtsProcSysTaskType type; ErtsProcSysTask *st; int st_prio; Eterm st_res; @@ -10409,7 +11054,9 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) if (!st) break; - switch (st->type) { + type = st->type; + + switch (type) { case ERTS_PSTT_GC_MAJOR: case ERTS_PSTT_GC_MINOR: if (c_p->flags & F_DISABLE_GC) { @@ -10418,12 +11065,23 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) reds--; } else { - if (!garbage_collected) { - if (st->type == ERTS_PSTT_GC_MAJOR) { + if (!minor_gc + || (!major_gc && type == ERTS_PSTT_GC_MAJOR)) { + if (type == ERTS_PSTT_GC_MAJOR) { FLAGS(c_p) |= F_NEED_FULLSWEEP; } reds -= scheduler_gc_proc(c_p, reds); - garbage_collected = 1; +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) { + save_dirty_task(c_p, st); + st = NULL; + break; + } +#endif + if (type == ERTS_PSTT_GC_MAJOR) + minor_gc = major_gc = 1; + else + minor_gc = 1; } st_res = am_true; } @@ -10450,20 +11108,31 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) case ERTS_PSTT_CLA: { int fcalls; int cla_reds = 0; + int do_gc; + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) fcalls = reds; else fcalls = reds - CONTEXT_REDS; - st_res = erts_proc_copy_literal_area(c_p, - &cla_reds, - fcalls, - st->arg[0] == am_true); + do_gc = st->arg[0] == am_true; + st_res = erts_proc_copy_literal_area(c_p, &cla_reds, + fcalls, do_gc); reds -= cla_reds; if (is_non_value(st_res)) { +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->flags & F_DIRTY_CLA) { + save_dirty_task(c_p, st); + st = NULL; + break; + } +#endif /* Needed gc, but gc was disabled */ save_gc_task(c_p, st, st_prio); st = NULL; + break; } + if (do_gc) /* We did a major gc */ + minor_gc = major_gc = 1; break; } case ERTS_PSTT_COHMQ: @@ -10482,7 +11151,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) } if (st) - reds += notify_sys_task_executed(c_p, st, st_res); + reds += notify_sys_task_executed(c_p, st, st_res, 1); state = erts_smp_atomic32_read_acqb(&c_p->state); } while (qmask && reds > 0); @@ -10510,9 +11179,18 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) Eterm st_res; int st_prio; - st = fetch_sys_task(c_p, state, &qmask, &st_prio); - if (!st) - break; +#ifdef ERTS_DIRTY_SCHEDULERS + if (c_p->dirty_sys_tasks) { + st = c_p->dirty_sys_tasks; + c_p->dirty_sys_tasks = st->next; + } + else +#endif + { + st = fetch_sys_task(c_p, state, &qmask, &st_prio); + if (!st) + break; + } switch (st->type) { case ERTS_PSTT_GC_MAJOR: @@ -10536,7 +11214,7 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) break; } - reds += notify_sys_task_executed(c_p, st, st_res); + reds += notify_sys_task_executed(c_p, st, st_res, 1); state = erts_smp_atomic32_read_acqb(&c_p->state); } while (qmask && reds < max_reds); @@ -10546,6 +11224,92 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) #ifdef ERTS_DIRTY_SCHEDULERS +void +erts_execute_dirty_system_task(Process *c_p) +{ + Eterm cla_res = THE_NON_VALUE; + ErtsProcSysTask *stasks; + + /* + * If multiple operations, perform them in the following + * order (in order to avoid unnecessary GC): + * 1. Copy Literal Area (implies major GC). + * 2. GC Hibernate (implies major GC if not woken). + * 3. Major GC (implies minor GC). + * 4. Minor GC. + * + * System task requests are handled after the actual + * operations have been performed... + */ + + ASSERT(!(c_p->flags & (F_DELAY_GC|F_DISABLE_GC))); + + if (c_p->flags & F_DIRTY_CLA) { + int cla_reds = 0; + cla_res = erts_proc_copy_literal_area(c_p, &cla_reds, c_p->fcalls, 1); + ASSERT(is_value(cla_res)); + } + + if (c_p->flags & F_DIRTY_GC_HIBERNATE) { + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + if (c_p->msg.len) + c_p->flags &= ~F_DIRTY_GC_HIBERNATE; /* operation aborted... */ + else { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + c_p->fvalue = NIL; + erts_garbage_collect_hibernate(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + } + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + } + + if (c_p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) { + if (c_p->flags & F_DIRTY_MAJOR_GC) + c_p->flags |= F_NEED_FULLSWEEP; + (void) erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, + c_p->arity, c_p->fcalls); + } + + ASSERT(!(c_p->flags & (F_DIRTY_CLA + | F_DIRTY_GC_HIBERNATE + | F_DIRTY_MAJOR_GC + | F_DIRTY_MINOR_GC))); + + stasks = c_p->dirty_sys_tasks; + c_p->dirty_sys_tasks = NULL; + + while (stasks) { + Eterm st_res; + ErtsProcSysTask *st = stasks; + stasks = st->next; + + switch (st->type) { + case ERTS_PSTT_CLA: + ASSERT(is_value(st_res)); + st_res = cla_res; + break; + case ERTS_PSTT_GC_MAJOR: + st_res = am_true; + break; + case ERTS_PSTT_GC_MINOR: + st_res = am_true; + break; + + default: + ERTS_INTERNAL_ERROR("Not supported dirty system task"); + break; + } + + (void) notify_sys_task_executed(c_p, st, st_res, 0); + + } + + erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_DIRTY_ACTIVE_SYS); +} + static BIF_RETTYPE dispatch_system_task(Process *c_p, erts_aint_t fail_state, ErtsProcSysTask *st, Eterm target, @@ -10748,7 +11512,7 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, ERTS_INTERNAL_ERROR("Unknown failure schedule_process_sys_task()"); failure = am_internal_error; } - notify_sys_task_executed(c_p, st, failure); + notify_sys_task_executed(c_p, st, failure, 1); } ERTS_BIF_PREP_RET(ret, am_ok); @@ -10963,6 +11727,15 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio) } } +#ifdef ERTS_DIRTY_SCHEDULERS +static void +save_dirty_task(Process *c_p, ErtsProcSysTask *st) +{ + st->next = c_p->dirty_sys_tasks; + c_p->dirty_sys_tasks = st; +} +#endif + int erts_set_gc_state(Process *c_p, int enable) { @@ -11185,6 +11958,8 @@ erts_schedule_misc_op(void (*func)(void *), void *arg) non_empty_runq(rq); #endif + ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP); + erts_smp_runq_unlock(rq); smp_notify_inc_runq(rq); @@ -11215,6 +11990,9 @@ exec_misc_ops(ErtsRunQueue *rq) rq->misc.end = NULL; } + if (!rq->misc.start) + ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP); + erts_smp_runq_unlock(rq); while (molp) { @@ -11299,6 +12077,7 @@ static void early_init_process_struct(void *varg, Eterm data) proc->common.id = make_internal_pid(data); #ifdef ERTS_DIRTY_SCHEDULERS erts_smp_atomic32_init_nob(&proc->dirty_state, 0); + proc->dirty_sys_tasks = NULL; #endif erts_smp_atomic32_init_relb(&proc->state, arg->state); @@ -11807,6 +12586,7 @@ void erts_init_empty_process(Process *p) #ifdef ERTS_DIRTY_SCHEDULERS erts_smp_atomic32_init_nob(&p->dirty_state, 0); + p->dirty_sys_tasks = NULL; #endif erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL); @@ -11915,11 +12695,9 @@ erts_cleanup_empty_process(Process* p) static void delete_process(Process* p) { - Eterm *heap; ErtsPSD *psd; struct saved_calls *scb; process_breakpoint_time_t *pbt; - void *nif_export; VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); VERBOSE(DEBUG_SHCOPY, ("[pid=%T] delete process: %p %p %p %p\n", p->common.id, @@ -11936,9 +12714,7 @@ delete_process(Process* p) if (pbt) erts_free(ERTS_ALC_T_BPD, (void *) pbt); - nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL); - if (nif_export) - erts_destroy_nif_export(nif_export); + erts_destroy_nif_export(p); /* Cleanup psd */ @@ -11970,13 +12746,8 @@ delete_process(Process* p) hipe_delete_process(&p->hipe); #endif - heap = p->abandoned_heap ? p->abandoned_heap : p->heap; + erts_deallocate_young_generation(p); -#ifdef DEBUG - sys_memset(heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm)); -#endif - - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) heap, p->heap_sz*sizeof(Eterm)); if (p->old_heap != NULL) { #ifdef DEBUG @@ -11988,16 +12759,6 @@ delete_process(Process* p) (p->old_hend-p->old_heap)*sizeof(Eterm)); } - /* - * Free all pending message buffers. - */ - if (p->mbuf != NULL) { - free_message_buffer(p->mbuf); - } - - if (p->msg_frag) - erts_cleanup_messages(p->msg_frag); - erts_erase_dicts(p); /* free all pending messages */ @@ -12397,7 +13158,9 @@ send_exit_signal(Process *c_p, /* current process if and only } set_proc_exiting(c_p, state, rsn, NULL); } - else if (!(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))) { + else if (!(state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING_SYS))) { /* Process not running ... */ ErtsProcLocks need_locks = ~(*rp_locks) & ERTS_PROC_LOCKS_ALL; ErlHeapFragment *bp = NULL; @@ -12424,8 +13187,7 @@ send_exit_signal(Process *c_p, /* current process if and only ErlOffHeap *ohp; Uint rsn_sz = size_object(rsn); #ifdef ERTS_DIRTY_SCHEDULERS - if (state & (ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { + if (state & ERTS_PSFLG_DIRTY_RUNNING) { bp = new_message_buffer(rsn_sz); ohp = &bp->off_heap; hp = &bp->mem[0]; @@ -12442,7 +13204,7 @@ send_exit_signal(Process *c_p, /* current process if and only set_proc_exiting(rp, state, rsn_cpy, bp); } else { /* Process running... */ - + /* * The pending exit will be discovered when the process * is scheduled out if not discovered earlier. @@ -12464,8 +13226,35 @@ send_exit_signal(Process *c_p, /* current process if and only &bp->off_heap); rp->pending_exit.bp = bp; } - erts_smp_atomic32_read_bor_relb(&rp->state, - ERTS_PSFLG_PENDING_EXIT); + + /* + * If no dirty work has been scheduled, pending exit will + * be discovered when the process is scheduled. If dirty work + * has been scheduled, we may need to add it to a normal run + * queue... + */ +#ifndef ERTS_DIRTY_SCHEDULERS + (void) erts_smp_atomic32_read_bor_relb(&rp->state, + ERTS_PSFLG_PENDING_EXIT); +#else + { + erts_aint32_t a = erts_smp_atomic32_read_nob(&rp->state); + while (1) { + erts_aint32_t n, e; + int dwork; + n = e = a; + n |= ERTS_PSFLG_PENDING_EXIT; + dwork = !!(n & ERTS_PSFLGS_DIRTY_WORK); + n &= ~ERTS_PSFLGS_DIRTY_WORK; + a = erts_smp_atomic32_cmpxchg_mb(&rp->state, n, e); + if (a == e) { + if (dwork) + erts_schedule_process(rp, n, *rp_locks); + break; + } + } + } +#endif } } /* else: @@ -13094,15 +13883,14 @@ erts_continue_exit_process(Process *p) } #ifdef ERTS_DIRTY_SCHEDULERS - if (a & (ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { + if (a & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { p->flags |= F_DELAYED_DEL_PROC; delay_del_proc = 1; /* - * The dirty scheduler will also decrease - * refc when done... + * The dirty scheduler decrease refc + * when done with the process... */ - erts_proc_inc_refc(p); } #endif @@ -13316,6 +14104,8 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp) { erts_print(to, to_arg, "WAITING"); break; case ERTS_SSI_FLG_SUSPENDED: erts_print(to, to_arg, "SUSPENDED"); break; + case ERTS_SSI_FLG_MSB_EXEC: + erts_print(to, to_arg, "MSB_EXEC"); break; default: erts_print(to, to_arg, "UNKNOWN(%d)", flg); break; } @@ -13425,6 +14215,12 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp) { erts_print(to, to_arg, "NONEMPTY"); break; case ERTS_RUNQ_FLG_PROTECTED: erts_print(to, to_arg, "PROTECTED"); break; + case ERTS_RUNQ_FLG_EXEC: + erts_print(to, to_arg, "EXEC"); break; + case ERTS_RUNQ_FLG_MSB_EXEC: + erts_print(to, to_arg, "MSB_EXEC"); break; + case ERTS_RUNQ_FLG_MISC_OP: + erts_print(to, to_arg, "MISC_OP"); break; default: erts_print(to, to_arg, "UNKNOWN(%d)", flg); break; } @@ -13474,11 +14270,11 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp) { * A nice system halt closing all open port goes as follows: * 1) This function schedules the aux work ERTS_SSI_AUX_WORK_REAP_PORTS * on all schedulers, then schedules itself out. - * 2) All shedulers detect this and set the flag halt_in_progress + * 2) All shedulers detect this and set the flag ERTS_RUNQ_FLG_HALTING * on their run queue. The last scheduler sets all non-closed ports * ERTS_PORT_SFLG_HALT. Global atomic erts_halt_progress is used * as refcount to determine which is last. - * 3) While the run ques has flag halt_in_progress no processes + * 3) While the run queues has flag ERTS_RUNQ_FLG_HALTING no processes * will be scheduled, only ports. * 4) When the last port closes that scheduler calls erlang:halt/1. * The same global atomic is used as refcount. @@ -13493,8 +14289,8 @@ void erts_halt(int code) erts_no_schedulers, -1)) { #ifdef ERTS_DIRTY_SCHEDULERS - ERTS_DIRTY_CPU_RUNQ->halt_in_progress = 1; - ERTS_DIRTY_IO_RUNQ->halt_in_progress = 1; + ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_CPU_RUNQ, ERTS_RUNQ_FLG_HALTING); + ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_IO_RUNQ, ERTS_RUNQ_FLG_HALTING); #endif erts_halt_code = code; notify_reap_ports_relb(); @@ -13508,6 +14304,9 @@ erts_dbg_check_halloc_lock(Process *p) ErtsSchedulerData *esdp; if (ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)) return 1; + if ((p->static_flags & ERTS_STC_FLG_SHADOW_PROC) + && ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())) + return 1; if (p->common.id == ERTS_INVALID_PID) return 1; esdp = erts_proc_sched_data(p); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 1c4b9f149d..ce0989883c 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -170,8 +170,14 @@ extern int erts_sched_thread_suggested_stack_size; (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 6)) #define ERTS_RUNQ_FLG_EXEC \ (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 7)) +#define ERTS_RUNQ_FLG_MSB_EXEC \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 8)) +#define ERTS_RUNQ_FLG_MISC_OP \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 9)) +#define ERTS_RUNQ_FLG_HALTING \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 10)) -#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 8) +#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 11) #define ERTS_RUNQ_FLGS_MIGRATION_QMASKS \ (ERTS_RUNQ_FLGS_EMIGRATE_QMASK \ @@ -262,8 +268,9 @@ typedef enum { #define ERTS_SSI_FLG_TSE_SLEEPING (((erts_aint32_t) 1) << 2) #define ERTS_SSI_FLG_WAITING (((erts_aint32_t) 1) << 3) #define ERTS_SSI_FLG_SUSPENDED (((erts_aint32_t) 1) << 4) +#define ERTS_SSI_FLG_MSB_EXEC (((erts_aint32_t) 1) << 5) -#define ERTS_SSI_FLGS_MAX 5 +#define ERTS_SSI_FLGS_MAX 6 #define ERTS_SSI_FLGS_SLEEP_TYPE \ (ERTS_SSI_FLG_TSE_SLEEPING|ERTS_SSI_FLG_POLL_SLEEPING) @@ -274,7 +281,8 @@ typedef enum { #define ERTS_SSI_FLGS_ALL \ (ERTS_SSI_FLGS_SLEEP \ | ERTS_SSI_FLG_WAITING \ - | ERTS_SSI_FLG_SUSPENDED) + | ERTS_SSI_FLG_SUSPENDED \ + | ERTS_SSI_FLG_MSB_EXEC) /* * Keep ERTS_SSI_AUX_WORK flags ordered in expected frequency @@ -393,6 +401,12 @@ typedef struct { Process* last; } ErtsRunPrioQueue; +typedef enum { + ERTS_SCHED_NORMAL, + ERTS_SCHED_DIRTY_CPU, + ERTS_SCHED_DIRTY_IO +} ErtsSchedType; + typedef struct ErtsSchedulerData_ ErtsSchedulerData; typedef struct ErtsRunQueue_ ErtsRunQueue; @@ -478,7 +492,6 @@ struct ErtsRunQueue_ { erts_smp_atomic32_t len; int wakeup_other; int wakeup_other_reds; - int halt_in_progress; struct { ErtsProcList *pending_exiters; @@ -537,13 +550,15 @@ do { \ } while (0) typedef struct { - int need; /* "+sbu true" or scheduler_wall_time enabled */ + union { + erts_atomic32_t mod; /* on dirty schedulers */ + int need; /* "+sbu true" or scheduler_wall_time enabled */ + } u; int enabled; Uint64 start; struct { Uint64 total; Uint64 start; - int currently; } working; } ErtsSchedWallTime; @@ -642,6 +657,7 @@ struct ErtsSchedulerData_ { #endif ErtsSchedulerSleepInfo *ssi; Process *current_process; + ErtsSchedType type; Uint no; /* Scheduler number for normal schedulers */ #ifdef ERTS_DIRTY_SCHEDULERS ErtsDirtySchedId dirty_no; /* Scheduler number for dirty schedulers */ @@ -838,8 +854,8 @@ typedef struct { #define ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ((ErtsProcLocks) 0) -#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ((ErtsProcLocks) 0) +#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN typedef struct { ErtsProcLocks get_locks; @@ -1060,6 +1076,9 @@ struct process { Uint64 bin_old_vheap; /* Virtual old heap size for binaries */ ErtsProcSysTaskQs *sys_task_qs; +#ifdef ERTS_DIRTY_SCHEDULERS + ErtsProcSysTask *dirty_sys_tasks; +#endif erts_smp_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */ #ifdef ERTS_DIRTY_SCHEDULERS @@ -1384,14 +1403,18 @@ extern int erts_system_profile_ts_type; #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ #define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */ #define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */ -#define F_ON_HEAP_MSGQ (1 << 13) /* Off heap msg queue */ +#define F_ON_HEAP_MSGQ (1 << 13) /* On heap msg queue */ #define F_OFF_HEAP_MSGQ_CHNG (1 << 14) /* Off heap msg queue changing */ #define F_ABANDONED_HEAP_USE (1 << 15) /* Have usage of abandoned heap */ #define F_DELAY_GC (1 << 16) /* Similar to disable GC (see below) */ #define F_SCHDLR_ONLN_WAITQ (1 << 17) /* Process enqueued waiting to change schedulers online */ #define F_HAVE_BLCKD_NMSCHED (1 << 18) /* Process has blocked normal multi-scheduling */ -#define F_HIPE_MODE (1 << 19) +#define F_HIPE_MODE (1 << 19) /* Process is executing in HiPE mode */ #define F_DELAYED_DEL_PROC (1 << 20) /* Delay delete process (dirty proc exit case) */ +#define F_DIRTY_CLA (1 << 21) /* Dirty copy literal area scheduled */ +#define F_DIRTY_GC_HIBERNATE (1 << 22) /* Dirty GC hibernate scheduled */ +#define F_DIRTY_MAJOR_GC (1 << 23) /* Dirty major GC scheduled */ +#define F_DIRTY_MINOR_GC (1 << 24) /* Dirty minor GC scheduled */ /* * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent @@ -1573,19 +1596,18 @@ void erts_init_scheduling(int, int , int, int, int #endif ); - +#ifdef ERTS_DIRTY_SCHEDULERS +void erts_execute_dirty_system_task(Process *c_p); +#endif int erts_set_gc_state(Process *c_p, int enable); -Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable); +Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable, + int dirty_cpu, int want_dirty_io); Eterm erts_system_check_request(Process *c_p); Eterm erts_gc_info_request(Process *c_p); Uint64 erts_get_proc_interval(void); Uint64 erts_ensure_later_proc_interval(Uint64); Uint64 erts_step_proc_interval(void); -int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj); /* see erl_nif.c */ -void erts_destroy_nif_export(void *); /* see erl_nif.c */ -int erts_check_nif_export_in_area(Process *p, char *start, Uint size); - ErtsProcList *erts_proclist_create(Process *); ErtsProcList *erts_proclist_copy(ErtsProcList *); void erts_proclist_destroy(ErtsProcList *); @@ -1681,7 +1703,7 @@ ERTS_GLB_INLINE ErtsProcList *erts_proclist_fetch_first(ErtsProcList **list) return NULL; else { ErtsProcList *res = *list; - if (res == *list) + if (res->next == *list) *list = NULL; else *list = res->next; @@ -1922,6 +1944,8 @@ ErtsSchedulerData *erts_get_scheduler_data(void) void erts_schedule_process(Process *, erts_aint32_t, ErtsProcLocks); ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks); +ERTS_GLB_INLINE void erts_schedule_dirty_sys_execution(Process *c_p); + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks) @@ -1931,6 +1955,34 @@ erts_proc_notify_new_message(Process *p, ErtsProcLocks locks) if (!(state & ERTS_PSFLG_ACTIVE)) erts_schedule_process(p, state, locks); } + +ERTS_GLB_INLINE void +erts_schedule_dirty_sys_execution(Process *c_p) +{ + erts_aint32_t a, n, e; + + a = erts_smp_atomic32_read_nob(&c_p->state); + + /* + * Only a currently executing process schedules + * itself for dirty-sys execution... + */ + + ASSERT(a & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)); + + /* Don't set dirty-active-sys if we are about to exit... */ + + while (!(a & (ERTS_PSFLG_DIRTY_ACTIVE_SYS + | ERTS_PSFLG_EXITING + | ERTS_PSFLG_PENDING_EXIT))) { + e = a; + n = a | ERTS_PSFLG_DIRTY_ACTIVE_SYS; + a = erts_smp_atomic32_cmpxchg_mb(&c_p->state, n, e); + if (a == e) + break; /* dirty-active-sys set */ + } +} + #endif #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index e534c33637..7c23b5c76a 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -90,9 +90,12 @@ Uint erts_process_memory(Process *p, int incl_msg_inq) { erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size); erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size); size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm); + if (p->abandoned_heap) + size += (p->hend - p->heap) * sizeof(Eterm); if (p->old_hend && p->old_heap) size += (p->old_hend - p->old_heap) * sizeof(Eterm); + size += p->msg.len * sizeof(ErtsMessage); for (mp = p->msg.first; mp; mp = mp->next) diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index a69185bc5c..a93f1755c8 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -123,7 +123,7 @@ erts_init_proc_lock(int cpus) for (i = 0; i < ERTS_NO_OF_PIX_LOCKS; i++) { #ifdef ERTS_ENABLE_LOCK_COUNT erts_mtx_init_x(&erts_pix_locks[i].u.mtx, - "pix_lock", make_small(i), 1); + "pix_lock", make_small(i)); #else erts_mtx_init(&erts_pix_locks[i].u.mtx, "pix_lock"); #endif @@ -1006,6 +1006,41 @@ erts_pid2proc_opt(Process *c_p, return proc; } +static ERTS_INLINE +Process *proc_lookup_inc_refc(Eterm pid, int allow_exit) +{ + Process *proc; +#ifdef ERTS_SMP + ErtsThrPrgrDelayHandle dhndl; + + dhndl = erts_thr_progress_unmanaged_delay(); +#endif + + proc = erts_proc_lookup_raw(pid); + if (proc) { + if (!allow_exit && ERTS_PROC_IS_EXITING(proc)) + proc = NULL; + else + erts_proc_inc_refc(proc); + } + +#ifdef ERTS_SMP + erts_thr_progress_unmanaged_continue(dhndl); +#endif + + return proc; +} + +Process *erts_proc_lookup_inc_refc(Eterm pid) +{ + return proc_lookup_inc_refc(pid, 0); +} + +Process *erts_proc_lookup_raw_inc_refc(Eterm pid) +{ + return proc_lookup_inc_refc(pid, 1); +} + void erts_proc_lock_init(Process *p) { @@ -1027,39 +1062,32 @@ erts_proc_lock_init(Process *p) #endif #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL -#ifdef ERTS_ENABLE_LOCK_COUNT - int do_lock_count = 1; -#else - int do_lock_count = 0; -#endif - - erts_mtx_init_x(&p->lock.main, "proc_main", p->common.id, do_lock_count); + erts_mtx_init_x(&p->lock.main, "proc_main", p->common.id); ethr_mutex_lock(&p->lock.main.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.main.lc); #endif - erts_mtx_init_x(&p->lock.link, "proc_link", p->common.id, do_lock_count); + erts_mtx_init_x(&p->lock.link, "proc_link", p->common.id); ethr_mutex_lock(&p->lock.link.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.link.lc); #endif - erts_mtx_init_x(&p->lock.msgq, "proc_msgq", p->common.id, do_lock_count); + erts_mtx_init_x(&p->lock.msgq, "proc_msgq", p->common.id); ethr_mutex_lock(&p->lock.msgq.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.msgq.lc); #endif - erts_mtx_init_x(&p->lock.btm, "proc_btm", p->common.id, do_lock_count); + erts_mtx_init_x(&p->lock.btm, "proc_btm", p->common.id); ethr_mutex_lock(&p->lock.btm.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.btm.lc); #endif - erts_mtx_init_x(&p->lock.status, "proc_status", p->common.id, - do_lock_count); + erts_mtx_init_x(&p->lock.status, "proc_status", p->common.id); ethr_mutex_lock(&p->lock.status.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.status.lc); #endif - erts_mtx_init_x(&p->lock.trace, "proc_trace", p->common.id, do_lock_count); + erts_mtx_init_x(&p->lock.trace, "proc_trace", p->common.id); ethr_mutex_lock(&p->lock.trace.mtx); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.trace.lc); diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index 2cccf0697a..773529384f 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -940,6 +940,8 @@ void erts_proc_safelock(Process *a_proc, #define erts_pid2proc(PROC, HL, PID, NL) \ erts_pid2proc_opt((PROC), (HL), (PID), (NL), 0) +Process *erts_proc_lookup_inc_refc(Eterm pid); +Process *erts_proc_lookup_raw_inc_refc(Eterm pid); ERTS_GLB_INLINE Process *erts_pix2proc(int ix); ERTS_GLB_INLINE Process *erts_proc_lookup_raw(Eterm pid); diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h index 713ed50b86..14be511f86 100644 --- a/erts/emulator/beam/erl_smp.h +++ b/erts/emulator/beam/erl_smp.h @@ -1065,7 +1065,7 @@ ERTS_GLB_INLINE void erts_smp_mtx_init_x(erts_smp_mtx_t *mtx, char *name, Eterm extra) { #ifdef ERTS_SMP - erts_mtx_init_x(mtx, name, extra, 1); + erts_mtx_init_x(mtx, name, extra); #endif } @@ -1073,7 +1073,7 @@ ERTS_GLB_INLINE void erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx, char *name, Eterm extra) { #ifdef ERTS_SMP - erts_mtx_init_locked_x(mtx, name, extra, 1); + erts_mtx_init_locked_x(mtx, name, extra); #endif } diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index eccd49f2a9..9e75f6fee5 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -479,14 +479,9 @@ ERTS_GLB_INLINE void erts_thr_install_exit_handler(void (*exit_handler)(void)); ERTS_GLB_INLINE erts_tid_t erts_thr_self(void); ERTS_GLB_INLINE int erts_thr_getname(erts_tid_t tid, char *buf, size_t len); ERTS_GLB_INLINE int erts_equal_tids(erts_tid_t x, erts_tid_t y); -ERTS_GLB_INLINE void erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra, - int enable_lcnt); -ERTS_GLB_INLINE void erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, - Uint16 opt, int enable_lcnt); -ERTS_GLB_INLINE void erts_mtx_init_locked_x(erts_mtx_t *mtx, - char *name, - Eterm extra, - int enable_lcnt); +ERTS_GLB_INLINE void erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra); +ERTS_GLB_INLINE void erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt); +ERTS_GLB_INLINE void erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra); ERTS_GLB_INLINE void erts_mtx_init(erts_mtx_t *mtx, char *name); ERTS_GLB_INLINE void erts_mtx_init_locked(erts_mtx_t *mtx, char *name); ERTS_GLB_INLINE void erts_mtx_destroy(erts_mtx_t *mtx); @@ -2164,7 +2159,7 @@ erts_equal_tids(erts_tid_t x, erts_tid_t y) } ERTS_GLB_INLINE void -erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt) +erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra) { #ifdef USE_THREADS int res = ethr_mutex_init(&mtx->mtx); @@ -2174,17 +2169,13 @@ erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt) erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); #endif #ifdef ERTS_ENABLE_LOCK_COUNT - if (enable_lcnt) - erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); - else - erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX, extra); + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); #endif #endif } ERTS_GLB_INLINE void -erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt, - int enable_lcnt) +erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt) { #ifdef USE_THREADS int res = ethr_mutex_init(&mtx->mtx); @@ -2194,17 +2185,14 @@ erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt, erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); #endif #ifdef ERTS_ENABLE_LOCK_COUNT - if (enable_lcnt) - erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX | opt, extra); - else - erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX | opt, extra); + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX | opt, extra); #endif #endif } ERTS_GLB_INLINE void -erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt) +erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra) { #ifdef USE_THREADS int res = ethr_mutex_init(&mtx->mtx); @@ -2214,10 +2202,7 @@ erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra, int enable_lcnt erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); #endif #ifdef ERTS_ENABLE_LOCK_COUNT - if (enable_lcnt) - erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); - else - erts_lcnt_init_lock_x(&mtx->lcnt, NULL, ERTS_LCNT_LT_MUTEX, extra); + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); #endif ethr_mutex_lock(&mtx->mtx); #ifdef ERTS_ENABLE_LOCK_CHECK diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 9be4741ec8..04f3160d42 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1435,6 +1435,7 @@ void trace_gc(Process *p, Eterm what, Uint size, Eterm msg) { ErtsTracerNif *tnif = NULL; + Eterm* o_hp = NULL; Eterm* hp; Uint sz = 0; Eterm tup; @@ -1445,7 +1446,7 @@ trace_gc(Process *p, Eterm what, Uint size, Eterm msg) if (is_non_value(msg)) { (void) erts_process_gc_info(p, &sz, NULL, 0, 0); - hp = HAlloc(p, sz + 3 + 2); + o_hp = hp = erts_alloc(ERTS_ALC_T_TMP, (sz + 3 + 2) * sizeof(Eterm)); msg = erts_process_gc_info(p, NULL, &hp, 0, 0); tup = TUPLE2(hp, am_wordsize, make_small(size)); hp += 3; @@ -1454,6 +1455,8 @@ trace_gc(Process *p, Eterm what, Uint size, Eterm msg) send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_GC, what, msg, THE_NON_VALUE, am_true); + if (o_hp) + erts_free(ERTS_ALC_T_TMP, o_hp); } } diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 378b6de49c..01fe1e5e23 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -143,6 +143,11 @@ Uint erts_trace_flag2bit(Eterm flag); int erts_trace_flags(Eterm List, Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp); Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I); +Eterm +erts_bif_trace_epilogue(Process *p, Eterm result, int applying, + Export* ep, BeamInstr *cp, Uint32 flags, + Uint32 flags_meta, BeamInstr* I, + ErtsTracer meta_tracer); #ifdef ERTS_SMP void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp); diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 93cfe08105..d88cafc5bf 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -36,7 +36,7 @@ #define EMULATOR "BEAM" #define SEQ_TRACE 1 -#define CONTEXT_REDS 2000 /* Swap process out after this number */ +#define CONTEXT_REDS 4000 /* Swap process out after this number */ #define MAX_ARG 255 /* Max number of arguments allowed */ #define MAX_REG 1024 /* Max number of x(N) registers used */ diff --git a/erts/emulator/beam/error.h b/erts/emulator/beam/error.h index e431c3051b..64c08b1570 100644 --- a/erts/emulator/beam/error.h +++ b/erts/emulator/beam/error.h @@ -39,14 +39,11 @@ */ /* - * Bits 0-1 index the 'exception class tag' table. - */ -#define EXC_CLASSBITS 3 -#define GET_EXC_CLASS(x) ((x) & EXC_CLASSBITS) - -/* * Exception class tags (indices into the 'exception_tag' array) */ +#define EXTAG_OFFSET 0 +#define EXTAG_BITS 2 + #define EXTAG_ERROR 0 #define EXTAG_EXIT 1 #define EXTAG_THROWN 2 @@ -54,20 +51,31 @@ #define NUMBER_EXC_TAGS 3 /* The number of exception class tags */ /* - * Exit code flags (bits 2-7) + * Index to the 'exception class tag' table. + */ +#define EXC_CLASSBITS ((1<<EXTAG_BITS)-1) +#define GET_EXC_CLASS(x) ((x) & EXC_CLASSBITS) + +/* + * Exit code flags * * These flags make is easier and quicker to decide what to do with the * exception in the early stages, before a handler is found, and also * maintains some separation between the class tag and the actions. */ -#define EXF_PANIC (1<<2) /* ignore catches */ -#define EXF_THROWN (1<<3) /* nonlocal return */ -#define EXF_LOG (1<<4) /* write to logger on termination */ -#define EXF_NATIVE (1<<5) /* occurred in native code */ -#define EXF_SAVETRACE (1<<6) /* save stack trace in internal form */ -#define EXF_ARGLIST (1<<7) /* has arglist for top of trace */ +#define EXF_OFFSET EXTAG_BITS +#define EXF_BITS 7 -#define EXC_FLAGBITS 0x00fc +#define EXF_PANIC (1<<(0+EXF_OFFSET)) /* ignore catches */ +#define EXF_THROWN (1<<(1+EXF_OFFSET)) /* nonlocal return */ +#define EXF_LOG (1<<(2+EXF_OFFSET)) /* write to logger on termination */ +#define EXF_NATIVE (1<<(3+EXF_OFFSET)) /* occurred in native code */ +#define EXF_SAVETRACE (1<<(4+EXF_OFFSET)) /* save stack trace in internal form */ +#define EXF_ARGLIST (1<<(5+EXF_OFFSET)) /* has arglist for top of trace */ +#define EXF_RESTORE_NIF (1<<(6+EXF_OFFSET)) /* restore original bif/nif */ + +#define EXC_FLAGBITS (((1<<(EXF_BITS+EXF_OFFSET))-1) \ + & ~((1<<(EXF_OFFSET))-1)) /* * The primary fields of an exception code @@ -77,11 +85,16 @@ #define NATIVE_EXCEPTION(x) ((x) | EXF_NATIVE) /* - * Bits 8-12 of the error code are used for indexing into + * Error code used for indexing into * the short-hand error descriptor table. */ -#define EXC_INDEXBITS 0x1f00 -#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> 8) +#define EXC_OFFSET (EXF_OFFSET+EXF_BITS) +#define EXC_BITS 5 + +#define EXC_INDEXBITS (((1<<(EXC_BITS+EXC_OFFSET))-1) \ + & ~((1<<(EXC_OFFSET))-1)) + +#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> EXC_OFFSET) /* * Exit codes used for raising a fresh exception. The primary exceptions @@ -107,46 +120,46 @@ /* Error with given arglist term * (exit reason in p->fvalue) */ -#define EXC_NORMAL ((1 << 8) | EXC_EXIT) +#define EXC_NORMAL ((1 << EXC_OFFSET) | EXC_EXIT) /* Normal exit (reason 'normal') */ -#define EXC_INTERNAL_ERROR ((2 << 8) | EXC_ERROR | EXF_PANIC) +#define EXC_INTERNAL_ERROR ((2 << EXC_OFFSET) | EXC_ERROR | EXF_PANIC) /* Things that shouldn't happen */ -#define EXC_BADARG ((3 << 8) | EXC_ERROR) +#define EXC_BADARG ((3 << EXC_OFFSET) | EXC_ERROR) /* Bad argument to a BIF */ -#define EXC_BADARITH ((4 << 8) | EXC_ERROR) +#define EXC_BADARITH ((4 << EXC_OFFSET) | EXC_ERROR) /* Bad arithmetic */ -#define EXC_BADMATCH ((5 << 8) | EXC_ERROR) +#define EXC_BADMATCH ((5 << EXC_OFFSET) | EXC_ERROR) /* Bad match in function body */ -#define EXC_FUNCTION_CLAUSE ((6 << 8) | EXC_ERROR) +#define EXC_FUNCTION_CLAUSE ((6 << EXC_OFFSET) | EXC_ERROR) /* No matching function head */ -#define EXC_CASE_CLAUSE ((7 << 8) | EXC_ERROR) +#define EXC_CASE_CLAUSE ((7 << EXC_OFFSET) | EXC_ERROR) /* No matching case clause */ -#define EXC_IF_CLAUSE ((8 << 8) | EXC_ERROR) +#define EXC_IF_CLAUSE ((8 << EXC_OFFSET) | EXC_ERROR) /* No matching if clause */ -#define EXC_UNDEF ((9 << 8) | EXC_ERROR) +#define EXC_UNDEF ((9 << EXC_OFFSET) | EXC_ERROR) /* No farity that matches */ -#define EXC_BADFUN ((10 << 8) | EXC_ERROR) +#define EXC_BADFUN ((10 << EXC_OFFSET) | EXC_ERROR) /* Not an existing fun */ -#define EXC_BADARITY ((11 << 8) | EXC_ERROR) +#define EXC_BADARITY ((11 << EXC_OFFSET) | EXC_ERROR) /* Attempt to call fun with * wrong number of arguments. */ -#define EXC_TIMEOUT_VALUE ((12 << 8) | EXC_ERROR) +#define EXC_TIMEOUT_VALUE ((12 << EXC_OFFSET) | EXC_ERROR) /* Bad time out value */ -#define EXC_NOPROC ((13 << 8) | EXC_ERROR) +#define EXC_NOPROC ((13 << EXC_OFFSET) | EXC_ERROR) /* No process or port */ -#define EXC_NOTALIVE ((14 << 8) | EXC_ERROR) +#define EXC_NOTALIVE ((14 << EXC_OFFSET) | EXC_ERROR) /* Not distributed */ -#define EXC_SYSTEM_LIMIT ((15 << 8) | EXC_ERROR) +#define EXC_SYSTEM_LIMIT ((15 << EXC_OFFSET) | EXC_ERROR) /* Ran out of something */ -#define EXC_TRY_CLAUSE ((16 << 8) | EXC_ERROR) +#define EXC_TRY_CLAUSE ((16 << EXC_OFFSET) | EXC_ERROR) /* No matching try clause */ -#define EXC_NOTSUP ((17 << 8) | EXC_ERROR) +#define EXC_NOTSUP ((17 << EXC_OFFSET) | EXC_ERROR) /* Not supported */ -#define EXC_BADMAP ((18 << 8) | EXC_ERROR) +#define EXC_BADMAP ((18 << EXC_OFFSET) | EXC_ERROR) /* Bad map */ -#define EXC_BADKEY ((19 << 8) | EXC_ERROR) +#define EXC_BADKEY ((19 << EXC_OFFSET) | EXC_ERROR) /* Bad key in map */ #define NUMBER_EXIT_CODES 20 /* The number of exit code indices */ @@ -154,7 +167,7 @@ /* * Internal pseudo-error codes. */ -#define TRAP (1 << 8) /* BIF Trap to erlang code */ +#define TRAP (1 << EXC_OFFSET) /* BIF Trap to erlang code */ /* * Aliases for some common exit codes. diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c index f397ab6b00..33ed6d7ec1 100644 --- a/erts/emulator/beam/export.c +++ b/erts/emulator/beam/export.c @@ -356,7 +356,7 @@ Export *export_list(int i, ErtsCodeIndex code_ix) int export_list_size(ErtsCodeIndex code_ix) { - return export_tables[code_ix].entries; + return erts_index_num_entries(&export_tables[code_ix]); } int export_table_sz(void) diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index a49b242d7c..10e452fa25 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -2163,12 +2163,8 @@ enc_atom(ErtsAtomCacheMap *acmp, Eterm atom, byte *ep, Uint32 dflags) * We use this atom as sysname in local pid/port/refs * for the ETS compressed format (DFLAG_INTERNAL_TAGS). * - * We used atom '' earlier but that turned out to cause problems - * for buggy erl_interface/ic usage of c-nodes with empty node names. - * A long atom reduces risk of nodes actually called this and the length - * does not matter anyway as it's encoded with atom index (ATOM_INTERNAL_REF2). */ -#define INTERNAL_LOCAL_SYSNAME am_await_microstate_accounting_modifications +#define INTERNAL_LOCAL_SYSNAME am_ErtsSecretAtom static byte* enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 2decb56544..2158f54a49 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -89,12 +89,6 @@ typedef struct enif_resource_t extern void erts_pre_nif(struct enif_environment_t*, Process*, struct erl_module_nif*, Process* tracee); extern void erts_post_nif(struct enif_environment_t* env); -#ifdef ERTS_DIRTY_SCHEDULERS -extern void erts_pre_dirty_nif(ErtsSchedulerData *, - struct enif_environment_t*, Process*, - struct erl_module_nif*); -extern void erts_post_dirty_nif(struct enif_environment_t* env); -#endif extern void erts_resource_stop(ErlNifResource*, ErlNifEvent, int is_direct_call); extern Eterm erts_nif_taints(Process* p); extern void erts_print_nif_taints(fmtfn_t to, void* to_arg); @@ -107,6 +101,12 @@ extern Eterm erts_nif_call_function(Process *p, Process *tracee, struct enif_func_t *, int argc, Eterm *argv); +#ifdef ERTS_DIRTY_SCHEDULERS +int erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, + BeamInstr *I, Eterm *reg); +#endif /* ERTS_DIRTY_SCHEDULERS */ + + /* Driver handle (wrapper for old plain handle) */ #define ERL_DE_OK 0 #define ERL_DE_UNLOAD 1 @@ -1022,7 +1022,7 @@ void erts_queue_monitor_message(Process *, Eterm, Eterm); void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a, - Eterm (*bif)(Process*,Eterm*)); + Eterm (*bif)(Process*, Eterm*, BeamInstr*)); void erts_init_bif(void); Eterm erl_send(Process *p, Eterm to, Eterm msg); diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c index c86a2122f6..cd834e2c12 100644 --- a/erts/emulator/beam/index.c +++ b/erts/emulator/beam/index.c @@ -91,9 +91,16 @@ index_put_entry(IndexTable* t, void* tmpl) t->seg_table[ix>>INDEX_PAGE_SHIFT] = erts_alloc(t->type, sz); t->size += INDEX_PAGE_SIZE; } - t->entries++; p->index = ix; t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK] = p; + + /* + * Do a write barrier here to allow readers to do lock free iteration. + * erts_index_num_entries() does matching read barrier. + */ + ERTS_SMP_WRITE_MEMORY_BARRIER; + t->entries++; + return p; } diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h index b2e3c0eab5..10f5d1eb39 100644 --- a/erts/emulator/beam/index.h +++ b/erts/emulator/beam/index.h @@ -65,6 +65,7 @@ void index_erase_latest_from(IndexTable*, Uint ix); ERTS_GLB_INLINE int index_put(IndexTable*, void*); ERTS_GLB_INLINE IndexSlot* erts_index_lookup(IndexTable*, Uint); +ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -78,6 +79,19 @@ erts_index_lookup(IndexTable* t, Uint ix) { return t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK]; } + +ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t) +{ + int ret = t->entries; + /* + * Do a read barrier here to allow lock free iteration + * on tables where entries are never erased. + * index_put_entry() does matching write barrier. + */ + ERTS_SMP_READ_MEMORY_BARRIER; + return ret; +} + #endif #endif diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 4f131c74de..33b74f30b7 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -259,13 +259,11 @@ static ERTS_INLINE void port_init_instr(Port *prt ASSERT(prt->drv_ptr && prt->lock); if (!prt->drv_ptr->lock) { char *lock_str = "port_lock"; - erts_mtx_init_locked_x(prt->lock, lock_str, id, #ifdef ERTS_ENABLE_LOCK_COUNT - (erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK) -#else - 0 + if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PORTLOCK)) + lock_str = NULL; #endif - ); + erts_mtx_init_locked_x(prt->lock, lock_str, id); } #endif erts_port_task_init_sched(&prt->sched, id); @@ -7107,7 +7105,7 @@ driver_pdl_create(ErlDrvPort dp) return NULL; pdl = erts_alloc(ERTS_ALC_T_PORT_DATA_LOCK, sizeof(struct erl_drv_port_data_lock)); - erts_mtx_init_x(&pdl->mtx, "port_data_lock", pp->common.id, 1); + erts_mtx_init_x(&pdl->mtx, "port_data_lock", pp->common.id); pdl_init_refc(pdl); erts_port_inc_refc(pp); pdl->prt = pp; @@ -8290,14 +8288,13 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle) erts_mtx_init_x(drv->lock, "driver_lock", #if defined(ERTS_ENABLE_LOCK_CHECK) || defined(ERTS_ENABLE_LOCK_COUNT) - erts_atom_put((byte *) drv->name, - sys_strlen(drv->name), - ERTS_ATOM_ENC_LATIN1, - 1), + erts_atom_put((byte *) drv->name, + sys_strlen(drv->name), + ERTS_ATOM_ENC_LATIN1, + 1) #else - NIL, + NIL #endif - 1 ); } #endif diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 4ef04d020a..ec36b23059 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -802,15 +802,10 @@ call_ext_last u==1 Bif=u$bif:erts_internal:check_process_code/1 D => i_call_ext_ call_ext_only u==1 Bif=u$bif:erts_internal:check_process_code/1 => i_call_ext_only Bif # -# The BIFs erlang:garbage_collect/0 must be called like a function, +# The BIFs erts_internal:garbage_collect/1 must be called like a function, # to allow them to invoke the garbage collector. (The stack pointer must # be saved and p->arity must be zeroed, which is not done on ordinary BIF calls.) # - -call_ext u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext Bif -call_ext_last u==0 Bif=u$bif:erlang:garbage_collect/0 D => i_call_ext_last Bif D -call_ext_only u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext_only Bif - call_ext u==1 Bif=u$bif:erts_internal:garbage_collect/1 => i_call_ext Bif call_ext_last u==1 Bif=u$bif:erts_internal:garbage_collect/1 D => i_call_ext_last Bif D call_ext_only u==1 Bif=u$bif:erts_internal:garbage_collect/1 => i_call_ext_only Bif diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index ec502d5a78..3fa48da1ec 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -56,6 +56,8 @@ #ifdef HIPE # include "hipe_mode_switch.h" #endif +#define ERTS_WANT_NFUNC_SCHED_INTERNALS__ +#include "erl_nfunc_sched.h" #undef M_TRIM_THRESHOLD #undef M_TOP_PAD diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 3adb8db661..d64f015a6a 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1937,7 +1937,8 @@ static void free_sendfile(void *data) { MUTEX_LOCK(d->c.sendfile.q_mtx); driver_deq(d->c.sendfile.port,1); MUTEX_UNLOCK(d->c.sendfile.q_mtx); - driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0); + driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, + ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0); } EF_FREE(data); } @@ -2555,7 +2556,7 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) desc->sendfile_state = sending; desc->d = d; driver_select(desc->port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, - ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 1); + ERL_DRV_USE|ERL_DRV_WRITE, 1); } break; #endif diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index 21739726bb..dca3887564 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -41,11 +41,11 @@ define(HANDLE_GOT_MBUF,` `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) # define CALL_BIF(F) \ - movq CSYM(F)@GOTPCREL(%rip), %r11; \ + movq CSYM(nbif_impl_##F)@GOTPCREL(%rip), %r11; \ movq %r11, P_BIF_CALLEE(P); \ call CSYM(hipe_debug_bif_wrapper) #else -# define CALL_BIF(F) call CSYM(F) +# define CALL_BIF(F) call CSYM(nbif_impl_##F) #endif' /* @@ -595,13 +595,9 @@ noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu) #endif /* NO_FPE_SIGNALS */ /* - * Implement gc_bif_interface_0 as nofail_primop_interface_0. - */ -define(gc_bif_interface_0,`nofail_primop_interface_0($1, $2)') - -/* - * Implement gc_bif_interface_N as standard_bif_interface_N (N=1,2,3). + * Implement gc_bif_interface_N as standard_bif_interface_N. */ +define(gc_bif_interface_0,`standard_bif_interface_0($1, $2)') define(gc_bif_interface_1,`standard_bif_interface_1($1, $2)') define(gc_bif_interface_2,`standard_bif_interface_2($1, $2)') define(gc_bif_interface_3,`standard_bif_interface_3($1, $2)') diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index d7a2fec04a..a9097dabde 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -30,9 +30,9 @@ include(`hipe/hipe_arm_asm.m4') .arm `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) ldr r14, =F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper +# define CALL_BIF(F) ldr r14, =nbif_impl_##F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper #else -# define CALL_BIF(F) bl F +# define CALL_BIF(F) bl nbif_impl_##F #endif' define(TEST_GOT_MBUF,`ldr r1, [P, #P_MBUF] /* `TEST_GOT_MBUF' */ diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 57fbbd9403..9c6ac4bd9c 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -732,7 +732,7 @@ struct nbif { }; static struct nbif nbifs[BIF_SIZE] = { -#define BIF_LIST(MOD,FUN,ARY,CFUN,IX) \ +#define BIF_LIST(MOD,FUN,ARY,BIF,CFUN,IX) \ { {0,0}, MOD, FUN, ARY, &nbif_##CFUN }, #include "erl_bif_list.h" #undef BIF_LIST @@ -905,7 +905,8 @@ BIF_RETTYPE hipe_bifs_term_to_word_1(BIF_ALIST_1) } /* XXX: this is really a primop, not a BIF */ -BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1) +/* Called via standard_bif_interface_1 */ +BIF_RETTYPE nbif_impl_hipe_conv_big_to_float(NBIF_ALIST_1) { Eterm res; Eterm *hp; @@ -1121,7 +1122,7 @@ static struct hipe_mfa_info* mod2mfa_put(struct hipe_mfa_info* mfa) struct hipe_ref { struct hipe_ref_head head; /* list of refs to same calleee */ void *address; -#if defined(arm) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) void *trampoline; #endif unsigned int flags; @@ -1432,7 +1433,8 @@ void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a) } /* primop, but called like a BIF for error handling purposes */ -BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3) +/* Called via standard_bif_interface_3 */ +BIF_RETTYPE nbif_impl_hipe_find_na_or_make_stub(NBIF_ALIST_3) { Uint arity; void *address; @@ -1457,7 +1459,8 @@ BIF_RETTYPE hipe_bifs_find_na_or_make_stub_1(BIF_ALIST_1) } /* primop, but called like a BIF for error handling purposes */ -BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2) +/* Called via standard_bif_interface_2 */ +BIF_RETTYPE nbif_impl_hipe_nonclosure_address(NBIF_ALIST_2) { Eterm hdr, m, f; void *address; @@ -1549,7 +1552,7 @@ BIF_RETTYPE hipe_bifs_add_ref_2(BIF_ALIST_2) ref = erts_alloc(ERTS_ALC_T_HIPE, sizeof(struct hipe_ref)); ref->address = address; -#if defined(arm) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) ref->trampoline = trampoline; #endif ref->flags = flags; @@ -1864,7 +1867,7 @@ void hipe_redirect_to_module(Module* modp) if (ref->flags & REF_FLAG_IS_LOAD_MFA) res = hipe_patch_insn(ref->address, (Uint)p->remote_address, am_load_mfa); else { -#if defined(arm) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) void* trampoline = ref->trampoline; #else void* trampoline = NULL; diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h index 4a59bacc6e..811c3801c1 100644 --- a/erts/emulator/hipe/hipe_bif0.h +++ b/erts/emulator/hipe/hipe_bif0.h @@ -30,7 +30,7 @@ extern Uint *hipe_bifs_find_pc_from_mfa(Eterm mfa); extern void hipe_mfa_info_table_init(void); extern void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a); -extern BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3); +extern BIF_RETTYPE nbif_impl_hipe_find_na_or_make_stub(NBIF_ALIST_3); extern int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a); /* needed in beam_load.c */ diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index dfd34e31d4..e04d3d32d1 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -155,7 +155,7 @@ BIF_RETTYPE hipe_bifs_modeswitch_debug_off_0(BIF_ALIST_0) #if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1); +BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1); # define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\ @@ -163,13 +163,13 @@ BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1); # define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) -BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1) +BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1) { - typedef BIF_RETTYPE Bif(BIF_ALIST_1); - Bif* fp = (Bif*) (BIF_P->hipe.bif_callee); + typedef BIF_RETTYPE nBif(NBIF_ALIST_1); + nBif* fp = (nBif*) (BIF_P->hipe.bif_callee); BIF_RETTYPE res; ERTS_SMP_UNREQ_PROC_MAIN_LOCK(BIF_P); - res = (*fp)(BIF_P, BIF__ARGS); + res = (*fp)(NBIF_CALL_ARGS); ERTS_SMP_REQ_PROC_MAIN_LOCK(BIF_P); return res; } diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index bb328b5915..f034c4700c 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -71,6 +71,32 @@ ****************************************************************/ /* + * NOTE: + * Beam BIFs have the prototype: + * Eterm (*BIF)(Process *c_p, Eterm *regs, UWord *I) + * Native BIFs have the prototype: + * Eterm (*BIF)(Process *c_p, Eterm *regs) + * + * Beam BIFs expect 'I' to contain current instruction + * pointer when called from beam, and expect 'I' to + * contain a pointer to the export entry of the BIF + * when called from native code. In order to facilitate + * this, beam BIFs are called via wrapper functions + * when called from native code. These wrapper functions + * are auto-generated (by utils/make_tables) and have + * the function names nbif_impl_<BIF>. + * + * The standard_bif_interface_*() and + * gc_bif_interface_*() will add the prefix and + * thus call nbif_impl_<cbif_name>. That is, all + * functions (true BIFs as well as other c-functions) + * called via these interfaces have to be named + * nbif_impl_<FUNC>. + */ + +/* + * See NOTE above! + * * standard_bif_interface_0(nbif_name, cbif_name) * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) @@ -93,6 +119,8 @@ */ /* + * See NOTE above! + * * gc_bif_interface_0(nbif_name, cbif_name) * gc_bif_interface_1(nbif_name, cbif_name) * gc_bif_interface_2(nbif_name, cbif_name) @@ -155,7 +183,7 @@ standard_bif_interface_0(nbif_ports_0, ports_0) */ gc_bif_interface_1(nbif_erts_internal_check_process_code_1, hipe_erts_internal_check_process_code_1) gc_bif_interface_1(nbif_erase_1, erase_1) -gc_bif_interface_0(nbif_garbage_collect_0, garbage_collect_0) +gc_bif_interface_1(nbif_erts_internal_garbage_collect_1, erts_internal_garbage_collect_1) gc_nofail_primop_interface_1(nbif_gc_1, hipe_gc) gc_bif_interface_2(nbif_put_2, put_2) @@ -247,7 +275,7 @@ nocons_nofail_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_intege noproc_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_integer) ')dnl -gc_bif_interface_0(nbif_check_get_msg, hipe_check_get_msg) +nofail_primop_interface_0(nbif_check_get_msg, hipe_check_get_msg) #`ifdef' NO_FPE_SIGNALS nocons_nofail_primop_interface_0(nbif_emulate_fpe, hipe_emulate_fpe) @@ -291,8 +319,8 @@ gc_bif_interface_2(nbif_maps_merge_2, hipe_wrapper_maps_merge_2) * BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index) */ -define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, $4)') -include(TARGET/`erl_bif_list.h') +define(BIF_LIST,`standard_bif_interface_$3(nbif_$5, $5)') +include(TTF_DIR/`erl_bif_list.h') /* * Guard BIFs. diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 9439b823ab..9a9252e8b8 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -42,8 +42,8 @@ */ /* for -Wmissing-prototypes :-( */ -extern Eterm hipe_erts_internal_check_process_code_1(BIF_ALIST_1); -extern Eterm hipe_show_nstack_1(BIF_ALIST_1); +extern Eterm nbif_impl_hipe_erts_internal_check_process_code_1(NBIF_ALIST_1); +extern Eterm nbif_impl_hipe_show_nstack_1(NBIF_ALIST_1); /* Used when a BIF can trigger a stack walk. */ static __inline__ void hipe_set_narity(Process *p, unsigned int arity) @@ -51,22 +51,24 @@ static __inline__ void hipe_set_narity(Process *p, unsigned int arity) p->hipe.narity = arity; } -Eterm hipe_erts_internal_check_process_code_1(BIF_ALIST_1) +/* Called via standard_bif_interface_2 */ +Eterm nbif_impl_hipe_erts_internal_check_process_code_1(NBIF_ALIST_1) { Eterm ret; hipe_set_narity(BIF_P, 1); - ret = erts_internal_check_process_code_1(BIF_P, BIF__ARGS); + ret = nbif_impl_erts_internal_check_process_code_1(NBIF_CALL_ARGS); hipe_set_narity(BIF_P, 0); return ret; } -Eterm hipe_show_nstack_1(BIF_ALIST_1) +/* Called via standard_bif_interface_1 */ +Eterm nbif_impl_hipe_show_nstack_1(NBIF_ALIST_1) { Eterm ret; hipe_set_narity(BIF_P, 1); - ret = hipe_bifs_show_nstack_1(BIF_P, BIF__ARGS); + ret = nbif_impl_hipe_bifs_show_nstack_1(NBIF_CALL_ARGS); hipe_set_narity(BIF_P, 0); return ret; } @@ -89,7 +91,7 @@ void hipe_gc(Process *p, Eterm need) * has begun. * XXX: BUG: native code should check return status */ -BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1) +BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1) { Process* p = BIF_P; Eterm timeout_value = BIF_ARG_1; @@ -226,11 +228,6 @@ void hipe_handle_exception(Process *c_p) ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */ - if (c_p->mbuf) { - erts_printf("%s line %u: p==%p, p->mbuf==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf); - /* erts_garbage_collect(c_p, 0, NULL, 0); */ - } - /* * Check if we have an arglist for the top level call. If so, this * is encoded in Value, so we have to dig out the real Value as well @@ -259,11 +256,6 @@ void hipe_handle_exception(Process *c_p) /* Synthesized to avoid having to generate code for it. */ c_p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(c_p->freason)]; - if (c_p->mbuf) { - /* erts_printf("%s line %u: p==%p, p->mbuf==%p, p->lastbif==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf, c_p->hipe.lastbif); */ - erts_garbage_collect(c_p, 0, NULL, 0); - } - hipe_find_handler(c_p); } @@ -280,10 +272,10 @@ static struct StackTrace *get_trace_from_exc(Eterm exc) * This does what the (misnamed) Beam instruction 'raise_ss' does, * namely, a proper re-throw of an exception that was caught by 'try'. */ - -BIF_RETTYPE hipe_rethrow(BIF_ALIST_2) +/* Called via standard_bif_interface_2 */ +BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2) { - Process* c_p = BIF_P; + Process *c_p = BIF_P; Eterm exc = BIF_ARG_1; Eterm value = BIF_ARG_2; @@ -407,7 +399,7 @@ Eterm hipe_bs_utf8_size(Eterm arg) return make_small(4); } -BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3) +BIF_RETTYPE nbif_impl_hipe_bs_put_utf8(NBIF_ALIST_3) { Process* p = BIF_P; Eterm arg = BIF_ARG_1; @@ -468,7 +460,7 @@ Eterm hipe_bs_put_utf16(Process *p, Eterm arg, byte *base, unsigned int offset, return new_offset; } -BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3) +BIF_RETTYPE nbif_impl_hipe_bs_put_utf16be(NBIF_ALIST_3) { Process *p = BIF_P; Eterm arg = BIF_ARG_1; @@ -477,7 +469,7 @@ BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3) return hipe_bs_put_utf16(p, arg, base, offset, 0); } -BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3) +BIF_RETTYPE nbif_impl_hipe_bs_put_utf16le(NBIF_ALIST_3) { Process *p = BIF_P; Eterm arg = BIF_ARG_1; @@ -495,7 +487,7 @@ static int validate_unicode(Eterm arg) return 1; } -BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1) +BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1) { Process *p = BIF_P; Eterm arg = BIF_ARG_1; @@ -513,7 +505,8 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg) return 1; } -BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2) +/* Called via standard_bif_interface_2 */ +BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2) { /* Arguments are Eterm-sized unsigned integers */ Uint dividend = BIF_ARG_1; diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index a02d26087b..38f874888b 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -74,27 +74,27 @@ AEXTERN(void,nbif_select_msg,(Process*)); AEXTERN(Eterm,nbif_cmp_2,(void)); AEXTERN(Eterm,nbif_eq_2,(void)); -BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2); -BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1); +BIF_RETTYPE nbif_impl_hipe_nonclosure_address(NBIF_ALIST_2); +BIF_RETTYPE nbif_impl_hipe_conv_big_to_float(NBIF_ALIST_1); void hipe_fclearerror_error(Process*); void hipe_select_msg(Process*); void hipe_gc(Process*, Eterm); -BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1); +BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1); void hipe_handle_exception(Process*); -BIF_RETTYPE hipe_rethrow(BIF_ALIST_2); +BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2); char *hipe_bs_allocate(int); Binary *hipe_bs_reallocate(Binary*, int); int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned); void hipe_bs_put_bits(Eterm, Uint, byte*, unsigned, unsigned); Eterm hipe_bs_utf8_size(Eterm); -BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3); +BIF_RETTYPE nbif_impl_hipe_bs_put_utf8(NBIF_ALIST_3); Eterm hipe_bs_utf16_size(Eterm); -BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3); -BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3); -BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1); +BIF_RETTYPE nbif_impl_hipe_bs_put_utf16be(NBIF_ALIST_3); +BIF_RETTYPE nbif_impl_hipe_bs_put_utf16le(NBIF_ALIST_3); +BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1); struct erl_bin_match_buffer; int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm); -BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2); +BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2); #ifdef NO_FPE_SIGNALS AEXTERN(void,nbif_emulate_fpe,(Process*)); @@ -129,7 +129,7 @@ void hipe_atomic_inc(int*); void hipe_clear_timeout(Process*); #endif -#define BIF_LIST(M,F,A,C,I) AEXTERN(Eterm,nbif_##C,(void)); +#define BIF_LIST(M,F,A,B,C,I) AEXTERN(Eterm,nbif_##C,(void)); #include "erl_bif_list.h" #undef BIF_LIST diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index b540562185..79a8bef77d 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -26,9 +26,9 @@ include(`hipe/hipe_ppc_asm.m4') #`include' "hipe_literals.h" `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) STORE_IA(CSYM(F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper) +# define CALL_BIF(F) STORE_IA(CSYM(nbif_impl_##F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper) #else -# define CALL_BIF(F) bl CSYM(F) +# define CALL_BIF(F) bl CSYM(nbif_impl_##F) #endif' .text diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index 1389beaa61..14330c2f1c 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -29,9 +29,9 @@ include(`hipe/hipe_sparc_asm.m4') .align 4 `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) set F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper +# define CALL_BIF(F) set nbif_impl_##F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper #else -# define CALL_BIF(F) call F +# define CALL_BIF(F) call nbif_impl_##F #endif' /* diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index c0c149733c..aecf67dc1b 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -32,9 +32,9 @@ include(`hipe/hipe_x86_asm.m4') #endif' `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) movl $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) +# define CALL_BIF(F) movl $CSYM(nbif_impl_##F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) #else -# define CALL_BIF(F) call CSYM(F) +# define CALL_BIF(F) call CSYM(nbif_impl_##F) #endif' define(TEST_GOT_MBUF,`movl P_MBUF(P), %edx /* `TEST_GOT_MBUF' */ @@ -666,13 +666,9 @@ noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu) #endif /* NO_FPE_SIGNALS */ /* - * Implement gc_bif_interface_0 as nofail_primop_interface_0. - */ -define(gc_bif_interface_0,`nofail_primop_interface_0($1, $2)') - -/* - * Implement gc_bif_interface_N as standard_bif_interface_N (N=1,2,3). + * Implement gc_bif_interface_N as standard_bif_interface_N. */ +define(gc_bif_interface_0,`standard_bif_interface_0($1, $2)') define(gc_bif_interface_1,`standard_bif_interface_1($1, $2)') define(gc_bif_interface_2,`standard_bif_interface_2($1, $2)') define(gc_bif_interface_3,`standard_bif_interface_3($1, $2)') diff --git a/erts/emulator/nifs/common/erl_tracer_nif.c b/erts/emulator/nifs/common/erl_tracer_nif.c index c0cc48ff42..0bde60d057 100644 --- a/erts/emulator/nifs/common/erl_tracer_nif.c +++ b/erts/emulator/nifs/common/erl_tracer_nif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson 2015. All Rights Reserved. + * Copyright Ericsson 2015-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. diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 5ce57b7b1b..a852550915 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -417,6 +417,7 @@ erts_sys_pre_init(void) #ifdef ERTS_THR_HAVE_SIG_FUNCS sigemptyset(&thr_create_sigmask); sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */ + sigaddset(&thr_create_sigmask, SIGTERM); /* block terminate signal */ sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */ #endif @@ -665,6 +666,40 @@ static RETSIGTYPE request_break(int signum) #endif } +static void stop_requested(void) { + Process* p = NULL; + Eterm msg, *hp; + ErtsProcLocks locks = 0; + ErlOffHeap *ohp; + Eterm id = erts_whereis_name_to_id(NULL, am_init); + + if ((p = (erts_pid2proc_opt(NULL, 0, id, 0, ERTS_P2P_FLG_INC_REFC))) != NULL) { + ErtsMessage *msgp = erts_alloc_message_heap(p, &locks, 3, &hp, &ohp); + + /* init ! {stop,stop} */ + msg = TUPLE2(hp, am_stop, am_stop); + erts_queue_message(p, locks, msgp, msg, am_system); + + if (locks) + erts_smp_proc_unlock(p, locks); + erts_proc_dec_refc(p); + } +} + +#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) +static RETSIGTYPE request_stop(void) +#else +static RETSIGTYPE request_stop(int signum) +#endif +{ +#ifdef ERTS_SMP + smp_sig_notify('S'); +#else + stop_requested(); +#endif +} + + static ERTS_INLINE void sigusr1_exit(void) { @@ -761,6 +796,7 @@ static RETSIGTYPE do_quit(int signum) /* Disable break */ void erts_set_ignore_break(void) { sys_signal(SIGINT, SIG_IGN); + sys_signal(SIGTERM, SIG_IGN); sys_signal(SIGQUIT, SIG_IGN); sys_signal(SIGTSTP, SIG_IGN); } @@ -786,6 +822,7 @@ void erts_replace_intr(void) { void init_break_handler(void) { sys_signal(SIGINT, request_break); + sys_signal(SIGTERM, request_stop); #ifndef ETHR_UNUSABLE_SIGUSRX sys_signal(SIGUSR1, user_signal1); #endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ @@ -1299,6 +1336,9 @@ signal_dispatcher_thread_func(void *unused) switch (buf[i]) { case 0: /* Emulator initialized */ break; + case 'S': /* SIGTERM */ + stop_requested(); + break; case 'I': /* SIGINT */ break_requested(); break; diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 2e48c475d5..7c9927c4f3 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -53,6 +53,7 @@ MODULES= \ crypto_SUITE \ ddll_SUITE \ decode_packet_SUITE \ + dirty_bif_SUITE \ dirty_nif_SUITE \ distribution_SUITE \ driver_SUITE \ diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index b8d89126fe..f70fb0e501 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -32,7 +32,8 @@ binary_to_atom/1,binary_to_existing_atom/1, atom_to_binary/1,min_max/1, erlang_halt/1, erl_crash_dump_bytes/1, - is_builtin/1]). + is_builtin/1, error_stacktrace/1, + error_stacktrace_during_call_trace/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -44,8 +45,8 @@ all() -> t_list_to_existing_atom, os_env, otp_7526, display, atom_to_binary, binary_to_atom, binary_to_existing_atom, - erl_crash_dump_bytes, - min_max, erlang_halt, is_builtin]. + erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, + error_stacktrace, error_stacktrace_during_call_trace]. %% Uses erlang:display to test that erts_printf does not do deep recursion display(Config) when is_list(Config) -> @@ -727,6 +728,172 @@ is_builtin(_Config) -> ok. +error_stacktrace(Config) when is_list(Config) -> + error_stacktrace_test(). + +error_stacktrace_during_call_trace(Config) when is_list(Config) -> + Tracer = spawn_link(fun () -> + receive after infinity -> ok end + end), + Mprog = [{'_',[],[{exception_trace}]}], + erlang:trace_pattern({?MODULE,'_','_'}, Mprog, [local]), + 1 = erlang:trace_pattern({erlang,error,2}, Mprog, [local]), + 1 = erlang:trace_pattern({erlang,error,1}, Mprog, [local]), + erlang:trace(all, true, [call,return_to,timestamp,{tracer, Tracer}]), + try + error_stacktrace_test() + after + erlang:trace(all, false, [call,return_to,timestamp,{tracer, Tracer}]), + erlang:trace_pattern({erlang,error,2}, false, [local]), + erlang:trace_pattern({erlang,error,1}, false, [local]), + erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), + unlink(Tracer), + exit(Tracer, kill), + Mon = erlang:monitor(process, Tracer), + receive + {'DOWN', Mon, process, Tracer, _} -> ok + end + end, + ok. + + +error_stacktrace_test() -> + Types = [apply_const_last, apply_const, apply_last, + apply, double_apply_const_last, double_apply_const, + double_apply_last, double_apply, multi_apply_const_last, + multi_apply_const, multi_apply_last, multi_apply, + call_const_last, call_last, call_const, call], + lists:foreach(fun (Type) -> + {Pid, Mon} = spawn_monitor( + fun () -> + stk([a,b,c,d], Type, error_2) + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + {oops, Stack} = Reason, +%% io:format("Type: ~p Stack: ~p~n", +%% [Type, Stack]), + [{?MODULE, do_error_2, [Type], _}, + {?MODULE, stk, 3, _}, + {?MODULE, stk, 3, _}] = Stack + end + end, + Types), + lists:foreach(fun (Type) -> + {Pid, Mon} = spawn_monitor( + fun () -> + stk([a,b,c,d], Type, error_1) + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + {oops, Stack} = Reason, +%% io:format("Type: ~p Stack: ~p~n", +%% [Type, Stack]), + [{?MODULE, do_error_1, 1, _}, + {?MODULE, stk, 3, _}, + {?MODULE, stk, 3, _}] = Stack + end + end, + Types), + ok. + +stk([], Type, Func) -> + tail(Type, Func, jump), + ok; +stk([_|L], Type, Func) -> + stk(L, Type, Func), + ok. + +tail(Type, Func, jump) -> + tail(Type, Func, do); +tail(Type, error_1, do) -> + do_error_1(Type); +tail(Type, error_2, do) -> + do_error_2(Type). + +do_error_2(apply_const_last) -> + erlang:apply(erlang, error, [oops, [apply_const_last]]); +do_error_2(apply_const) -> + erlang:apply(erlang, error, [oops, [apply_const]]), + ok; +do_error_2(apply_last) -> + erlang:apply(id(erlang), id(error), id([oops, [apply_last]])); +do_error_2(apply) -> + erlang:apply(id(erlang), id(error), id([oops, [apply]])), + ok; +do_error_2(double_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const_last]]]); +do_error_2(double_apply_const) -> + erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const]]]), + ok; +do_error_2(double_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply_last]])]); +do_error_2(double_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply]])]), + ok; +do_error_2(multi_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const_last]]]]]); +do_error_2(multi_apply_const) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const]]]]]), + ok; +do_error_2(multi_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply_last]])]]]); +do_error_2(multi_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply]])]]]), + ok; +do_error_2(call_const_last) -> + erlang:error(oops, [call_const_last]); +do_error_2(call_last) -> + erlang:error(id(oops), id([call_last])); +do_error_2(call_const) -> + erlang:error(oops, [call_const]), + ok; +do_error_2(call) -> + erlang:error(id(oops), id([call])). + + +do_error_1(apply_const_last) -> + erlang:apply(erlang, error, [oops]); +do_error_1(apply_const) -> + erlang:apply(erlang, error, [oops]), + ok; +do_error_1(apply_last) -> + erlang:apply(id(erlang), id(error), id([oops])); +do_error_1(apply) -> + erlang:apply(id(erlang), id(error), id([oops])), + ok; +do_error_1(double_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, error, [oops]]); +do_error_1(double_apply_const) -> + erlang:apply(erlang, apply, [erlang, error, [oops]]), + ok; +do_error_1(double_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]); +do_error_1(double_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]), + ok; +do_error_1(multi_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]); +do_error_1(multi_apply_const) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]), + ok; +do_error_1(multi_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]); +do_error_1(multi_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]), + ok; +do_error_1(call_const_last) -> + erlang:error(oops); +do_error_1(call_last) -> + erlang:error(id(oops)); +do_error_1(call_const) -> + erlang:error(oops), + ok; +do_error_1(call) -> + erlang:error(id(oops)). + + + %% Helpers diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 6ba6301c7c..2e303ba9a8 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -45,7 +45,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {seconds, 30}}]. -all() -> +all() -> Common = [errors, on_load], NotHipe = [process_specs, basic, flags, pam, change_pam, upgrade, @@ -1090,8 +1090,7 @@ exception_nocatch() -> {trace,t2,exception_from,{erlang,throw,1}, {error,{nocatch,Q2}}}], exception_from, {error,{nocatch,Q2}}), - expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, - {?MODULE,deep_4,1, + expect({trace,T2,exit,{{nocatch,Q2},[{?MODULE,deep_4,1, Deep4LocThrow}]}}), Q3 = {dump,[dump,{dump}]}, T3 = @@ -1100,8 +1099,7 @@ exception_nocatch() -> {trace,t3,exception_from,{erlang,error,1}, {error,Q3}}], exception_from, {error,Q3}), - expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, - {?MODULE,deep_4,1,Deep4LocError}]}}), + expect({trace,T3,exit,{Q3,[{?MODULE,deep_4,1,Deep4LocError}]}}), T4 = exception_nocatch(?LINE, '=', [17,4711], 5, [], exception_from, {error,{badmatch,4711}}), diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 774461c525..b29520ab9f 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -65,9 +65,9 @@ versions(Config) when is_list(Config) -> 2 = versions:version(), %% Kill processes, unload code. - P1 ! P2 ! done, _ = monitor(process, P1), _ = monitor(process, P2), + P1 ! P2 ! done, receive {'DOWN',_,process,P1,normal} -> ok end, @@ -155,7 +155,7 @@ call_purged_fun_code_there(Config) when is_list(Config) -> call_purged_fun_test(Priv, Data, Type) -> OptsList = case erlang:system_info(hipe_architecture) of undefined -> [[]]; - _ -> [[], [native]] + _ -> [[], [native,{d,hipe}]] end, [call_purged_fun_test_do(Priv, Data, Type, CO, FO) || CO <- OptsList, FO <- OptsList]. diff --git a/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl index 5e031abca8..699f0c1161 100644 --- a/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl +++ b/erts/emulator/test/code_SUITE_data/call_purged_fun_tester.erl @@ -2,7 +2,27 @@ -export([do/4]). +%% Resurrect line macro when hipe compiled +-ifdef(hipe). +-define(line, put(the_line,?LINE),). do(Priv, Data, Type, Opts) -> + try do_it(Priv, Data, Type, Opts) + catch + C:E -> + ST = erlang:get_stacktrace(), + io:format("Caught exception from line ~p:\n~p\n", + [get(the_line), ST]), + io:format("Message queue: ~p\n", [process_info(self(), messages)]), + erlang:raise(C, E, ST) + end. +-else. +-define(line,). +do(P,D,T,O) -> + do_it(P,D,T,O). +-endif. + + +do_it(Priv, Data, Type, Opts) -> File = filename:join(Data, "my_code_test2"), Code = filename:join(Priv, "my_code_test2"), @@ -10,25 +30,27 @@ do(Priv, Data, Type, Opts) -> catch erlang:delete_module(my_code_test2), catch erlang:purge_module(my_code_test2), - {ok,my_code_test2} = c:c(File, [{outdir,Priv} | Opts]), + ?line {ok,my_code_test2} = c:c(File, [{outdir,Priv} | Opts]), - IsNative = lists:member(native,Opts), - IsNative = code:is_module_native(my_code_test2), + ?line IsNative = lists:member(native,Opts), + ?line IsNative = code:is_module_native(my_code_test2), - T = ets:new(my_code_test2_fun_table, []), + ?line T = ets:new(my_code_test2_fun_table, []), ets:insert(T, {my_fun,my_code_test2:make_fun(4711)}), ets:insert(T, {my_fun2,my_code_test2:make_fun2()}), - spawn(fun () -> - [{my_fun2,F2}] = ets:lookup(T, my_fun2), - F2(fun () -> - receive after infinity -> ok end - end, - fun () -> ok end), - exit(completed) - end), - - PurgeType = case Type of + Papa = self(), + {P0,M0} = spawn_monitor(fun () -> + [{my_fun2,F2}] = ets:lookup(T, my_fun2), + F2(fun () -> + Papa ! {self(),"going to sleep"}, + receive {Papa,"wake up"} -> ok end + end, + fun () -> ok end), + exit(completed) + end), + + ?line PurgeType = case Type of code_gone -> ok = file:delete(Code++".beam"), true; @@ -38,98 +60,95 @@ do(Priv, Data, Type, Opts) -> false end, - true = erlang:delete_module(my_code_test2), + ?line true = erlang:delete_module(my_code_test2), + + ?line ok = receive {P0, "going to sleep"} -> ok + after 1000 -> timeout + end, - Purge = start_purge(my_code_test2, PurgeType), + ?line Purge = start_purge(my_code_test2, PurgeType), - {P0, M0} = spawn_monitor(fun () -> - [{my_fun,F}] = ets:lookup(T, my_fun), - 4712 = F(1), - exit(completed) + ?line {P1, M1} = spawn_monitor(fun () -> + ?line [{my_fun,F}] = ets:lookup(T, my_fun), + ?line 4712 = F(1), + exit(completed) end), - wait_until(fun () -> - {status, suspended} - == process_info(P0, status) - end), + ?line ok = wait_until(fun () -> + {status, suspended} + == process_info(P1, status) + end), - ok = continue_purge(Purge), + ?line ok = continue_purge(Purge), - {P1, M1} = spawn_monitor(fun () -> - [{my_fun,F}] = ets:lookup(T, my_fun), - 4713 = F(2), - exit(completed) + ?line {P2, M2} = spawn_monitor(fun () -> + ?line [{my_fun,F}] = ets:lookup(T, my_fun), + ?line 4713 = F(2), + exit(completed) end), - {P2, M2} = spawn_monitor(fun () -> - [{my_fun,F}] = ets:lookup(T, my_fun), - 4714 = F(3), - exit(completed) + ?line {P3, M3} = spawn_monitor(fun () -> + ?line [{my_fun,F}] = ets:lookup(T, my_fun), + ?line 4714 = F(3), + exit(completed) end), - wait_until(fun () -> - {status, suspended} - == process_info(P1, status) - end), - wait_until(fun () -> - {status, suspended} - == process_info(P2, status) - end), + ?line ok = wait_until(fun () -> + {status, suspended} + == process_info(P2, status) + end), + ?line ok = wait_until(fun () -> + {status, suspended} + == process_info(P3, status) + end), - {current_function, - {erts_code_purger, - pending_purge_lambda, - 3}} = process_info(P0, current_function), - {current_function, + ?line {current_function, {erts_code_purger, pending_purge_lambda, 3}} = process_info(P1, current_function), - {current_function, + ?line {current_function, {erts_code_purger, pending_purge_lambda, 3}} = process_info(P2, current_function), + ?line {current_function, + {erts_code_purger, + pending_purge_lambda, + 3}} = process_info(P3, current_function), case Type of code_there -> - false = complete_purge(Purge); + ?line false = complete_purge(Purge), + P0 ! {self(), "wake up"}, + ?line completed = wait_for_down(P0,M0); _ -> - {true, true} = complete_purge(Purge) + ?line {true, true} = complete_purge(Purge), + ?line killed = wait_for_down(P0,M0) end, case Type of code_gone -> - receive - {'DOWN', M0, process, P0, Reason0} -> - {undef, _} = Reason0 - end, - receive - {'DOWN', M1, process, P1, Reason1} -> - {undef, _} = Reason1 - end, - receive - {'DOWN', M2, process, P2, Reason2} -> - {undef, _} = Reason2 - end; + ?line {undef, _} = wait_for_down(P1,M1), + ?line {undef, _} = wait_for_down(P2,M2), + ?line {undef, _} = wait_for_down(P3,M3); _ -> - receive - {'DOWN', M0, process, P0, Reason0} -> - completed = Reason0 - end, - receive - {'DOWN', M1, process, P1, Reason1} -> - completed = Reason1 - end, - receive - {'DOWN', M2, process, P2, Reason2} -> - completed = Reason2 - end, + ?line completed = wait_for_down(P1,M1), + ?line completed = wait_for_down(P2,M2), + ?line completed = wait_for_down(P3,M3), catch erlang:purge_module(my_code_test2), catch erlang:delete_module(my_code_test2), catch erlang:purge_module(my_code_test2) end, ok. +wait_for_down(P,M) -> + receive + {'DOWN', M, process, P, Reason} -> + Reason + after 1000 -> + timeout + end. + wait_until(Fun) -> - ok = wait_until(Fun, 20). + wait_until(Fun, 20). wait_until(Fun, N) -> case {Fun(),N} of diff --git a/erts/emulator/test/dirty_bif_SUITE.erl b/erts/emulator/test/dirty_bif_SUITE.erl new file mode 100644 index 0000000000..308323594d --- /dev/null +++ b/erts/emulator/test/dirty_bif_SUITE.erl @@ -0,0 +1,583 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2014. 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(dirty_bif_SUITE). + +%%-define(line_trace,true). +-define(CHECK(Exp,Got), check(Exp,Got,?LINE)). +%%-define(CHECK(Exp,Got), Exp = Got). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2, + dirty_bif/1, dirty_bif_exception/1, + dirty_bif_multischedule/1, + dirty_bif_multischedule_exception/1, + dirty_scheduler_exit/1, + dirty_call_while_terminated/1, + dirty_heap_access/1, + dirty_process_info/1, + dirty_process_register/1, + dirty_process_trace/1, + code_purge/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +%% +%% All these tests utilize the debug BIFs: +%% - erts_debug:dirty_cpu/2 - Statically determined +%% to (begin to) execute on a dirty CPU scheduler. +%% - erts_debug:dirty_io/2 - Statically determined +%% to (begin to) execute on a dirty IO scheduler. +%% - erts_debug:dirty/3 +%% Their implementations are located in +%% $ERL_TOP/erts/emulator/beam/beam_debug.c +%% + +all() -> + [dirty_bif, + dirty_bif_multischedule, + dirty_bif_exception, + dirty_bif_multischedule_exception, + dirty_scheduler_exit, + dirty_call_while_terminated, + dirty_heap_access, + dirty_process_info, + dirty_process_register, + dirty_process_trace, + code_purge]. + +init_per_suite(Config) -> + case erlang:system_info(dirty_cpu_schedulers) of + N when N > 0 -> + Config; + _ -> + {skipped, "No dirty scheduler support"} + end. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Case, Config) -> + [{testcase, Case} | Config]. + +end_per_testcase(_Case, _Config) -> + ok. + +dirty_bif(Config) when is_list(Config) -> + dirty_cpu = erts_debug:dirty_cpu(scheduler,type), + dirty_io = erts_debug:dirty_io(scheduler,type), + normal = erts_debug:dirty(normal,scheduler,type), + dirty_cpu = erts_debug:dirty(dirty_cpu,scheduler,type), + dirty_io = erts_debug:dirty(dirty_io,scheduler,type), + ok. + +dirty_bif_multischedule(Config) when is_list(Config) -> + ok = erts_debug:dirty_cpu(reschedule,1000), + ok = erts_debug:dirty_io(reschedule,1000), + ok = erts_debug:dirty(normal,reschedule,1000), + ok. + + +dirty_bif_exception(Config) when is_list(Config) -> + lists:foreach(fun (Error) -> + ErrorType = case Error of + _ when is_atom(Error) -> Error; + _ -> badarg + end, + try + erts_debug:dirty_cpu(error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_cpu,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty_cpu,[error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_cpu,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty_io(error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_io,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty_io,[error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty_io,[error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(normal, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[normal, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[normal, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[normal, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(dirty_cpu, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[dirty_cpu, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(dirty_io, error, Error), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_io, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + apply(erts_debug,dirty,[dirty_io, error, Error]), + ct:fail(expected_exception) + catch + error:ErrorType -> + [{erts_debug,dirty,[dirty_io, error, Error],_}|_] + = erlang:get_stacktrace(), + ok + end + end, + [badarg, undef, badarith, system_limit, noproc, + make_ref(), {another, "heap", term_to_binary("term")}]), + ok. + + +dirty_bif_multischedule_exception(Config) when is_list(Config) -> + try + erts_debug:dirty_cpu(reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty_cpu,[reschedule, 1001],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty_io(reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty_io,[reschedule, 1001],_}|_] + = erlang:get_stacktrace(), + ok + end, + try + erts_debug:dirty(normal,reschedule,1001) + catch + error:badarg -> + [{erts_debug,dirty,[normal,reschedule,1001],_}|_] + = erlang:get_stacktrace(), + ok + end. + +dirty_scheduler_exit(Config) when is_list(Config) -> + {ok, Node} = start_node(Config, "+SDio 1"), + [ok] = mcall(Node, + [fun() -> + Start = erlang:monotonic_time(millisecond), + ok = test_dirty_scheduler_exit(), + End = erlang:monotonic_time(millisecond), + io:format("Time=~p ms~n", [End-Start]), + ok + end]), + stop_node(Node), + ok. + +test_dirty_scheduler_exit() -> + process_flag(trap_exit,true), + test_dse(10,[]). +test_dse(0,Pids) -> + timer:sleep(100), + kill_dse(Pids,[]); +test_dse(N,Pids) -> + Pid = spawn_link(fun () -> erts_debug:dirty_io(wait, 5000) end), + test_dse(N-1,[Pid|Pids]). + +kill_dse([],Killed) -> + wait_dse(Killed); +kill_dse([Pid|Pids],AlreadyKilled) -> + exit(Pid,kill), + kill_dse(Pids,[Pid|AlreadyKilled]). + +wait_dse([]) -> + ok; +wait_dse([Pid|Pids]) -> + receive + {'EXIT',Pid,Reason} -> + killed = Reason + end, + wait_dse(Pids). + +dirty_call_while_terminated(Config) when is_list(Config) -> + Me = self(), + Bin = list_to_binary(lists:duplicate(4711, $r)), + {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + {Dirty, DM} = spawn_opt(fun () -> + erts_debug:dirty_cpu(alive_waitexiting, Me), + blipp:blupp(Bin) + end, + [monitor,link]), + receive {alive, Dirty} -> ok end, + {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + Reason = die_dirty_process, + OT = process_flag(trap_exit, true), + exit(Dirty, Reason), + receive + {'DOWN', DM, process, Dirty, R0} -> + R0 = Reason + end, + receive + {'EXIT', Dirty, R1} -> + R1 = Reason + end, + undefined = process_info(Dirty), + undefined = process_info(Dirty, status), + false = erlang:is_process_alive(Dirty), + false = lists:member(Dirty, processes()), + %% Binary still refered by Dirty process not yet cleaned up + %% since the dirty bif has not yet returned... + {value, {BinAddr, 4711, 2}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + receive after 2000 -> ok end, + receive + Msg -> + ct:fail({unexpected_message, Msg}) + after + 0 -> + ok + end, + {value, {BinAddr, 4711, 1}} = lists:keysearch(4711, 2, + element(2, + process_info(self(), + binary))), + process_flag(trap_exit, OT), + try + blipp:blupp(Bin) + catch + _ : _ -> ok + end. + +dirty_heap_access(Config) when is_list(Config) -> + {ok, Node} = start_node(Config), + Me = self(), + RGL = rpc:call(Node,erlang,whereis,[init]), + Ref = rpc:call(Node,erlang,make_ref,[]), + Dirty = spawn_link(fun () -> + Res = erts_debug:dirty_cpu(copy, Ref), + garbage_collect(), + Me ! {self(), Res}, + receive after infinity -> ok end + end), + {N, R} = access_dirty_heap(Dirty, RGL, 0, 0), + receive + {_Pid, Res} -> + 1000 = length(Res), + lists:foreach(fun (X) -> Ref = X end, Res) + end, + unlink(Dirty), + exit(Dirty, kill), + stop_node(Node), + {comment, integer_to_list(N) ++ " GL change loops; " + ++ integer_to_list(R) ++ " while running dirty"}. + +access_dirty_heap(Dirty, RGL, N, R) -> + case process_info(Dirty, status) of + {status, waiting} -> + {N, R}; + {status, Status} -> + {group_leader, GL} = process_info(Dirty, group_leader), + true = group_leader(RGL, Dirty), + {group_leader, RGL} = process_info(Dirty, group_leader), + true = group_leader(GL, Dirty), + {group_leader, GL} = process_info(Dirty, group_leader), + access_dirty_heap(Dirty, RGL, N+1, case Status of + running -> + R+1; + _ -> + R + end) + end. + +%% These tests verify that processes that access a process executing a +%% dirty BIF where the main lock is needed for that access do not get +%% blocked. Each test passes its pid to dirty_sleeper, which sends an +%% 'alive' message when it's running on a dirty scheduler and just before +%% it starts a 6 second sleep. When it receives the message, it verifies +%% that access to the dirty process is as it expects. After the dirty +%% process finishes its 6 second sleep but before it returns from the dirty +%% scheduler, it sends a 'done' message. If the tester already received +%% that message, the test fails because it means attempting to access the +%% dirty process waited for that process to return to a regular scheduler, +%% so verify that we haven't received that message, and also verify that +%% the dirty process is still alive immediately after accessing it. +dirty_process_info(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(BifPid) -> + PI = process_info(BifPid), + {current_function,{erts_debug,dirty_io,2}} = + lists:keyfind(current_function, 1, PI), + ok + end, + fun(_) -> ok end). + +dirty_process_register(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> ok end, + fun(BifPid) -> + register(test_dirty_process_register, BifPid), + BifPid = whereis(test_dirty_process_register), + unregister(test_dirty_process_register), + false = lists:member(test_dirty_process_register, + registered()), + ok + end, + fun(_) -> ok end). + +dirty_process_trace(Config) when is_list(Config) -> + access_dirty_process( + Config, + fun() -> + erlang:trace_pattern({erts_debug,dirty_io,2}, + [{'_',[],[{return_trace}]}], + [local,meta]), + ok + end, + fun(BifPid) -> + erlang:trace(BifPid, true, [call,timestamp]), + ok + end, + fun(BifPid) -> + receive + {done, BifPid} -> + receive + {trace_ts,BifPid,call,{erts_debug,dirty_io,_},_} -> + ok + after + 0 -> + error(missing_trace_call_message) + end %%, + %% receive + %% {trace_ts,BifPid,return_from,{erts_debug,dirty_io,2}, + %% ok,_} -> + %% ok + %% after + %% 100 -> + %% error(missing_trace_return_message) + %% end + after + 6500 -> + error(missing_done_message) + end, + ok + end). + +dirty_code_test_code() -> + " +-module(dirty_code_test). + +-export([func/1]). + +func(Fun) -> + Fun(), + blipp:blapp(). + +". + +code_purge(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + File = filename:join(Path, "dirty_code_test.erl"), + ok = file:write_file(File, dirty_code_test_code()), + {ok, dirty_code_test, Bin} = compile:file(File, [binary]), + {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin), + Start = erlang:monotonic_time(), + {Pid1, Mon1} = spawn_monitor(fun () -> + dirty_code_test:func(fun () -> + %% Sleep for 6 seconds + %% in dirty bif... + erts_debug:dirty_io(wait,6000) + end) + end), + {module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin), + {Pid2, Mon2} = spawn_monitor(fun () -> + dirty_code_test:func(fun () -> + %% Sleep for 6 seconds + %% in dirty bif... + erts_debug:dirty_io(wait,6000) + end) + end), + receive + {'DOWN', Mon1, process, Pid1, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:purge_module(dirty_code_test), + receive + {'DOWN', Mon1, process, Pid1, Reason1} -> + killed = Reason1 + end, + receive + {'DOWN', Mon2, process, Pid2, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:delete_module(dirty_code_test), + receive + {'DOWN', Mon2, process, Pid2, _} -> + ct:fail(premature_death) + after 100 -> + ok + end, + true = erlang:purge_module(dirty_code_test), + receive + {'DOWN', Mon2, process, Pid2, Reason2} -> + killed = Reason2 + end, + End = erlang:monotonic_time(), + Time = erlang:convert_time_unit(End-Start, native, milli_seconds), + io:format("Time=~p~n", [Time]), + true = Time =< 1000, + ok. + +%% +%% Internal... +%% + +access_dirty_process(Config, Start, Test, Finish) -> + {ok, Node} = start_node(Config, ""), + [ok] = mcall(Node, + [fun() -> + ok = test_dirty_process_access(Start, Test, Finish) + end]), + stop_node(Node), + ok. + +test_dirty_process_access(Start, Test, Finish) -> + ok = Start(), + Self = self(), + BifPid = spawn_link(fun() -> + ok = erts_debug:dirty_io(ready_wait6_done, Self) + end), + ok = receive + {ready, BifPid} -> + ok = Test(BifPid), + receive + {done, BifPid} -> + error(dirty_process_info_blocked) + after + 0 -> + true = erlang:is_process_alive(BifPid), + ok + end + after + 3000 -> + error(timeout) + end, + ok = Finish(BifPid). + +receive_any() -> + receive M -> M end. + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) when is_list(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + +stop_node(Node) -> + test_server:stop_node(Node). + +mcall(Node, Funs) -> + Parent = self(), + Refs = lists:map(fun (Fun) -> + Ref = make_ref(), + spawn_link(Node, + fun () -> + Res = Fun(), + unlink(Parent), + Parent ! {Ref, Res} + end), + Ref + end, Funs), + lists:map(fun (Ref) -> + receive + {Ref, Res} -> + Res + end + end, Refs). diff --git a/erts/emulator/test/dirty_bif_SUITE_data/.gitignore b/erts/emulator/test/dirty_bif_SUITE_data/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/erts/emulator/test/dirty_bif_SUITE_data/.gitignore diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl index 658bdc41b6..991ba0acc8 100644 --- a/erts/emulator/test/dirty_nif_SUITE.erl +++ b/erts/emulator/test/dirty_nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -54,8 +54,8 @@ all() -> dirty_nif_send_traced]. init_per_suite(Config) -> - try erlang:system_info(dirty_cpu_schedulers) of - N when is_integer(N), N > 0 -> + case erlang:system_info(dirty_cpu_schedulers) of + N when N > 0 -> case lib_loaded() of false -> ok = erlang:load_nif( @@ -64,8 +64,8 @@ init_per_suite(Config) -> true -> ok end, - Config - catch _:_ -> + Config; + _ -> {skipped, "No dirty scheduler support"} end. diff --git a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c index daaff955bc..caf99c952f 100644 --- a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c +++ b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-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. diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c index 614b68e865..8e5e81665c 100644 --- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -1397,10 +1397,18 @@ static void assert_print(char* str, int line) static void assert_failed(ErlDrvPort port, char* str, int line) { char buf[30]; + size_t bufsz = sizeof(buf); + assert_print(str,line); - snprintf(buf,sizeof(buf),"failed_at_line_%d",line); - driver_failure_atom(port,buf); - /*abort();*/ + + if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + && (strcmp("true", buf) == 0 || strcmp("yes", buf) == 0)) { + abort(); + } + else { + snprintf(buf,sizeof(buf),"failed_at_line_%d",line); + driver_failure_atom(port,buf); + } } #define my_driver_select(PORT,FD,MODE,ON) \ diff --git a/erts/emulator/test/emulator_smoke.spec b/erts/emulator/test/emulator_smoke.spec index 3219aeb823..b2d0de8835 100644 --- a/erts/emulator/test/emulator_smoke.spec +++ b/erts/emulator/test/emulator_smoke.spec @@ -1,3 +1,9 @@ -{suites,"../emulator_test",[smoke_test_SUITE,time_SUITE]}. -{cases,"../emulator_test",crypto_SUITE,[t_md5]}. -{cases,"../emulator_test",float_SUITE,[fpe,cmp_integer]}.
\ No newline at end of file +{define,'Dir',"../emulator_test"}. +{suites,'Dir',[smoke_test_SUITE]}. +{suites,'Dir',[time_SUITE]}. +{skip_cases,'Dir',time_SUITE, + [univ_to_local,local_to_univ],"Depends on CET timezone"}. +{skip_cases,'Dir',time_SUITE, + [consistency],"Not reliable in October and March"}. +{cases,'Dir',crypto_SUITE,[t_md5]}. +{cases,'Dir',float_SUITE,[fpe,cmp_integer]}. diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl index 6b7ad836f5..c12f63706a 100644 --- a/erts/emulator/test/lttng_SUITE.erl +++ b/erts/emulator/test/lttng_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 7739a0bc22..27276e6646 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1814,7 +1814,7 @@ consume_timeslice(Config) when is_list(Config) -> consume_timeslice_test(Config) when is_list(Config) -> ensure_lib_loaded(Config), - CONTEXT_REDS = 2000, + CONTEXT_REDS = 4000, Me = self(), Go = make_ref(), RedDiff = make_ref(), diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl index ffe7d40139..8515a87df8 100644 --- a/erts/emulator/test/old_scheduler_SUITE.erl +++ b/erts/emulator/test/old_scheduler_SUITE.erl @@ -64,11 +64,11 @@ all() -> init_per_testcase(_Case, Config) -> %% main test process needs max prio Prio = process_flag(priority, max), - MS = erlang:system_flag(multi_scheduling, block), + MS = erlang:system_flag(multi_scheduling, block_normal), [{prio,Prio},{multi_scheduling, MS}|Config]. end_per_testcase(_Case, Config) -> - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), Prio=proplists:get_value(prio, Config), process_flag(priority, Prio), ok. diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index d4e77d634a..2a13b2d2f4 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -2066,13 +2066,13 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> StartedTime = (erlang:monotonic_time(microsecond) - Start)/1000000, io:format("StartedTime = ~p~n", [StartedTime]), true = StartedTime < SleepSecs, - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs), DoneTime = (erlang:monotonic_time(microsecond) - Start)/1000000, io:format("DoneTime = ~p~n", [DoneTime]), true = DoneTime > SleepSecs, ok = verify_multi_scheduling_blocked(), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), case {length(lists:usort(lists:flatten(SIds))), NoSchedsOnln} of {N, N} -> ok; @@ -2292,7 +2292,7 @@ maybe_to_list(List) -> List. format({Eol,List}) -> - io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]); + io_lib:format("tuple<~w,~w>",[Eol, maybe_to_list(List)]); format(List) when is_list(List) -> case list_at_least(50, List) of true -> diff --git a/erts/emulator/test/port_SUITE_data/Makefile.src b/erts/emulator/test/port_SUITE_data/Makefile.src index fb7685c4b6..3a343e6d17 100644 --- a/erts/emulator/test/port_SUITE_data/Makefile.src +++ b/erts/emulator/test/port_SUITE_data/Makefile.src @@ -20,6 +20,12 @@ echo_args@exe@: echo_args@obj@ echo_args@obj@: echo_args.c $(CC) -c -o echo_args@obj@ $(CFLAGS) echo_args.c +dead_port@exe@: dead_port@obj@ + $(LD) $(CROSSLDFLAGS) -o dead_port dead_port@obj@ @LIBS@ + +dead_port@obj@: dead_port.c + $(CC) -c -o dead_port@obj@ $(CFLAGS) dead_port.c + port_test.@EMULATOR@: port_test.erl @erl_name@ -compile port_test diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c index cc3ebdf0f8..e199a0fc13 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.c +++ b/erts/emulator/test/port_SUITE_data/port_test.c @@ -10,6 +10,7 @@ #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> +#include <ctype.h> #ifndef __WIN32__ #include <unistd.h> @@ -33,7 +34,7 @@ exit(1); \ } -#define MAIN(argc, argv) main(argc, argv) +#define ASSERT(e) ((void) ((e) ? 1 : abort())) extern int errno; @@ -105,9 +106,7 @@ int err; #endif -MAIN(argc, argv) -int argc; -char *argv[]; +int main(int argc, char *argv[]) { int ret, fd_count; if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { @@ -377,9 +376,11 @@ write_reply(buf, size) int size; /* Size of buffer to send. */ { int n; /* Temporary to hold size. */ + int rv; if (port_data->slow_writes <= 0) { /* Normal, "fast", write. */ - write(port_data->fd_to_erl, buf, size); + rv = write(port_data->fd_to_erl, buf, size); + ASSERT(rv == size); } else { /* * Write chunks with delays in between. @@ -387,7 +388,8 @@ write_reply(buf, size) while (size > 0) { n = size > port_data->slow_writes ? port_data->slow_writes : size; - write(port_data->fd_to_erl, buf, n); + rv = write(port_data->fd_to_erl, buf, n); + ASSERT(rv == n); size -= n; buf += n; if (size) @@ -558,7 +560,7 @@ char* spec; /* Specification for reply. */ buf = (char *) malloc(total_size); if (buf == NULL) { fprintf(stderr, "%s: insufficent memory for reply buffer of size %d\n", - port_data->progname, total_size); + port_data->progname, (int)total_size); exit(1); } diff --git a/erts/emulator/test/port_trace_SUITE.erl b/erts/emulator/test/port_trace_SUITE.erl index 5d9a75bcd3..03efdc15db 100644 --- a/erts/emulator/test/port_trace_SUITE.erl +++ b/erts/emulator/test/port_trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index e035fc64fe..e14185e881 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -437,11 +437,22 @@ t_process_info(Config) when is_list(Config) -> verify_loc(Line2, Res2), pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]), + verify_stacktrace_depth(), + Gleader = group_leader(), {group_leader, Gleader} = process_info(self(), group_leader), {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), ok. +verify_stacktrace_depth() -> + CS = current_stacktrace, + OldDepth = erlang:system_flag(backtrace_depth, 0), + {CS,[]} = erlang:process_info(self(), CS), + _ = erlang:system_flag(backtrace_depth, 8), + {CS,[{?MODULE,verify_stacktrace_depth,0,_},_|_]} = + erlang:process_info(self(), CS), + _ = erlang:system_flag(backtrace_depth, OldDepth). + pi_stacktrace(Expected0) -> {Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)}, {current_stacktrace,Stack} = Res, @@ -1017,9 +1028,9 @@ low_prio(Config) when is_list(Config) -> 1 -> ok = low_prio_test(Config); _ -> - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), ok = low_prio_test(Config), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), {comment, "Test not written for SMP runtime system. " "Multi scheduling blocked during test."} @@ -1086,9 +1097,9 @@ yield(Config) when is_list(Config) -> ++ ") is enabled. Testcase gets messed up by modfied " "timing."}; _ -> - MS = erlang:system_flag(multi_scheduling, block), + MS = erlang:system_flag(multi_scheduling, block_normal), yield_test(), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), case MS of blocked -> {comment, @@ -1611,6 +1622,7 @@ spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max -> {Len, HAs}; spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> Skip = 30, + wait_for_proc_slots(Skip+3), HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], [{priority, low}]), HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], @@ -1620,6 +1632,15 @@ spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> spawn_drop(Skip), spawn_initial_hangarounds(Cleaner, NP+Skip, Max, Len+3, [HA1,HA2,HA3|HAs]). +wait_for_proc_slots(MinFreeSlots) -> + case erlang:system_info(process_limit) - erlang:system_info(process_count) of + FreeSlots when FreeSlots < MinFreeSlots -> + receive after 10 -> ok end, + wait_for_proc_slots(MinFreeSlots); + _FreeSlots -> + ok + end. + spawn_drop(N) when N =< 0 -> ok; spawn_drop(N) -> @@ -1658,7 +1679,7 @@ processes_bif_test() -> true -> %% Do it again with a process suspended while %% in the processes/0 bif. - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Suspendee = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -1671,7 +1692,7 @@ processes_bif_test() -> end), receive {suspend_me, Suspendee} -> ok end, erlang:suspend_process(Suspendee), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended},{current_function,{erlang,ptab_list_continue,2}}] = process_info(Suspendee, [status, current_function]), @@ -1711,10 +1732,10 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> Splt = NoTestProcs div 10, {TP1, TP23} = lists:split(Splt, TestProcs), {TP2, TP3} = lists:split(Splt, TP23), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Tester ! DoIt, receive GetGoing -> ok end, - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), SpawnProcesses(high), lists:foreach( fun (P) -> SpawnHangAround(), @@ -1923,7 +1944,7 @@ processes_gc_trap(Config) when is_list(Config) -> processes() end, - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Suspendee = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -1933,7 +1954,7 @@ processes_gc_trap(Config) when is_list(Config) -> end), receive {suspend_me, Suspendee} -> ok end, erlang:suspend_process(Suspendee), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}] = process_info(Suspendee, [status, current_function]), @@ -2140,7 +2161,7 @@ processes_term_proc_list_test(MustChk) -> end) end, SpawnSuspendProcessesProc = fun () -> - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), P = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), @@ -2150,7 +2171,7 @@ processes_term_proc_list_test(MustChk) -> end), receive {suspend_me, P} -> ok end, erlang:suspend_process(P), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), [{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}] = process_info(P, [status, current_function]), @@ -2211,7 +2232,7 @@ processes_term_proc_list_test(MustChk) -> S8 = SpawnSuspendProcessesProc(), ?CHK_TERM_PROC_LIST(MustChk, 7), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), Exit(S8), ?CHK_TERM_PROC_LIST(MustChk, 7), Exit(S5), @@ -2220,7 +2241,7 @@ processes_term_proc_list_test(MustChk) -> ?CHK_TERM_PROC_LIST(MustChk, 6), Exit(S6), ?CHK_TERM_PROC_LIST(MustChk, 0), - erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(multi_scheduling, unblock_normal), as_expected. diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 3aee15a8fc..b178dede5b 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1095,16 +1095,13 @@ scheduler_threads(Config) when is_list(Config) -> end. dirty_scheduler_threads(Config) when is_list(Config) -> - SmpSupport = erlang:system_info(smp_support), - try - erlang:system_info(dirty_cpu_schedulers), - dirty_scheduler_threads_test(Config, SmpSupport) - catch - error:badarg -> - {skipped, "No dirty scheduler support"} + case erlang:system_info(dirty_cpu_schedulers) of + 0 -> {skipped, "No dirty scheduler support"}; + _ -> dirty_scheduler_threads_test(Config) end. -dirty_scheduler_threads_test(Config, SmpSupport) -> +dirty_scheduler_threads_test(Config) -> + SmpSupport = erlang:system_info(smp_support), {Sched, SchedOnln, _} = get_dsstate(Config, ""), {HalfSched, HalfSchedOnln} = case SmpSupport of false -> {1,1}; @@ -1374,12 +1371,9 @@ sst2_loop(N) -> sst2_loop(N-1). sst3_loop(S, N) -> - try erlang:system_info(dirty_cpu_schedulers) of - DS -> - sst3_loop_with_dirty_schedulers(S, DS, N) - catch - error:badarg -> - sst3_loop_normal_schedulers_only(S, N) + case erlang:system_info(dirty_cpu_schedulers) of + 0 -> sst3_loop_normal_schedulers_only(S, N); + DS -> sst3_loop_with_dirty_schedulers(S, DS, N) end. sst3_loop_normal_schedulers_only(_S, 0) -> diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index a1f12ba93c..f51244485b 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -28,6 +28,8 @@ runtime_update/1, runtime_diff/1, run_queue_one/1, scheduler_wall_time/1, + scheduler_wall_time_all/1, + msb_scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, badarg/1, run_queues_lengths_active_tasks/1, msacc/1]). @@ -43,7 +45,9 @@ suite() -> all() -> [{group, wall_clock}, {group, runtime}, reductions, - reductions_big, {group, run_queue}, scheduler_wall_time, + reductions_big, {group, run_queue}, + scheduler_wall_time, scheduler_wall_time_all, + msb_scheduler_wall_time, garbage_collection, io, badarg, run_queues_lengths_active_tasks, msacc]. @@ -271,35 +275,64 @@ hog_iter(0, Mon) -> %% Tests that statistics(scheduler_wall_time) works as intended scheduler_wall_time(Config) when is_list(Config) -> + scheduler_wall_time_test(scheduler_wall_time). + +%% Tests that statistics(scheduler_wall_time_all) works as intended +scheduler_wall_time_all(Config) when is_list(Config) -> + scheduler_wall_time_test(scheduler_wall_time_all). + +scheduler_wall_time_test(Type) -> %% Should return undefined if system_flag is not turned on yet - undefined = statistics(scheduler_wall_time), + undefined = statistics(Type), %% Turn on statistics false = erlang:system_flag(scheduler_wall_time, true), try Schedulers = erlang:system_info(schedulers_online), + DirtyCPUSchedulers = erlang:system_info(dirty_cpu_schedulers_online), + DirtyIOSchedulers = erlang:system_info(dirty_io_schedulers), + TotLoadSchedulers = case Type of + scheduler_wall_time_all -> + Schedulers + DirtyCPUSchedulers + DirtyIOSchedulers; + scheduler_wall_time -> + Schedulers + DirtyCPUSchedulers + end, + %% Let testserver and everyone else finish their work timer:sleep(1500), %% Empty load - EmptyLoad = get_load(), + EmptyLoad = get_load(Type), {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad}, MeMySelfAndI = self(), StartHog = fun() -> - Pid = spawn(?MODULE, hog, [self()]), + Pid = spawn_link(?MODULE, hog, [self()]), receive hog_started -> MeMySelfAndI ! go end, Pid end, + StartDirtyHog = fun(Func) -> + F = fun () -> + erts_debug:Func(alive_waitexiting, + MeMySelfAndI) + end, + Pid = spawn_link(F), + receive {alive, Pid} -> ok end, + Pid + end, P1 = StartHog(), %% Max on one, the other schedulers empty (hopefully) %% Be generous the process can jump between schedulers %% which is ok and we don't want the test to fail for wrong reasons - _L1 = [S1Load|EmptyScheds1] = get_load(), + _L1 = [S1Load|EmptyScheds1] = get_load(Type), {true,_} = {S1Load > 50,S1Load}, {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1}, {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1}, %% 50% load HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)], - HalfLoad = lists:sum(get_load()) div Schedulers, + HalfDirtyCPUHogs = [StartDirtyHog(dirty_cpu) + || _ <- lists:seq(1, DirtyCPUSchedulers div 2)], + HalfDirtyIOHogs = [StartDirtyHog(dirty_io) + || _ <- lists:seq(1, DirtyIOSchedulers div 2)], + HalfLoad = lists:sum(get_load(Type)) div TotLoadSchedulers, if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog %% We want roughly 50% load HalfLoad > 40, HalfLoad < 60 -> ok; @@ -308,23 +341,30 @@ scheduler_wall_time(Config) when is_list(Config) -> %% 100% load LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)], - FullScheds = get_load(), + LastDirtyCPUHogs = [StartDirtyHog(dirty_cpu) + || _ <- lists:seq(1, DirtyCPUSchedulers div 2)], + LastDirtyIOHogs = [StartDirtyHog(dirty_io) + || _ <- lists:seq(1, DirtyIOSchedulers div 2)], + FullScheds = get_load(Type), {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds}, - FullLoad = lists:sum(FullScheds) div Schedulers, + FullLoad = lists:sum(FullScheds) div TotLoadSchedulers, if FullLoad > 90 -> ok; true -> exit({fullload, FullLoad}) end, KillHog = fun (HP) -> HPM = erlang:monitor(process, HP), + unlink(HP), exit(HP, kill), receive {'DOWN', HPM, process, HP, killed} -> ok end end, - [KillHog(Pid) || Pid <- [P1|HalfHogs++LastHogs]], - AfterLoad = get_load(), + [KillHog(Pid) || Pid <- [P1|HalfHogs++HalfDirtyCPUHogs++HalfDirtyIOHogs + ++LastHogs++LastDirtyCPUHogs++LastDirtyIOHogs]], + receive after 2000 -> ok end, %% Give dirty schedulers time to complete... + AfterLoad = get_load(Type), io:format("AfterLoad=~p~n", [AfterLoad]), {false,_} = {lists:any(fun(Load) -> Load > 25 end, AfterLoad),AfterLoad}, true = erlang:system_flag(scheduler_wall_time, false) @@ -332,16 +372,81 @@ scheduler_wall_time(Config) when is_list(Config) -> erlang:system_flag(scheduler_wall_time, false) end. -get_load() -> - Start = erlang:statistics(scheduler_wall_time), +get_load(Type) -> + Start = erlang:statistics(Type), timer:sleep(1500), - End = erlang:statistics(scheduler_wall_time), + End = erlang:statistics(Type), lists:reverse(lists:sort(load_percentage(lists:sort(Start),lists:sort(End)))). load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> [100*(WN-WP) div (TN-TP)|load_percentage(Ss, Ps)]; load_percentage([], []) -> []. +count(0) -> + ok; +count(N) -> + count(N-1). + +msb_swt_hog(true) -> + count(1000000), + erts_debug:dirty_cpu(wait, 10), + erts_debug:dirty_io(wait, 10), + msb_swt_hog(true); +msb_swt_hog(false) -> + count(1000000), + msb_swt_hog(false). + +msb_scheduler_wall_time(Config) -> + erlang:system_flag(scheduler_wall_time, true), + Dirty = erlang:system_info(dirty_cpu_schedulers) /= 0, + Hogs = lists:map(fun (_) -> + spawn_opt(fun () -> + msb_swt_hog(Dirty) + end, [{priority,low}, link, monitor]) + end, lists:seq(1,10)), + erlang:system_flag(multi_scheduling, block), + try + SWT1 = lists:sort(statistics(scheduler_wall_time_all)), + %% io:format("SWT1 = ~p~n", [SWT1]), + receive after 4000 -> ok end, + SWT2 = lists:sort(statistics(scheduler_wall_time_all)), + %% io:format("SWT2 = ~p~n", [SWT2]), + SWT = lists:zip(SWT1, SWT2), + io:format("SU = ~p~n", [lists:map(fun({{I, A0, T0}, {I, A1, T1}}) -> + {I, (A1 - A0)/(T1 - T0)} end, + SWT)]), + {A, T} = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}}, {Ai,Ti}) -> + {Ai + (A1 - A0), Ti + (T1 - T0)} + end, + {0, 0}, + SWT), + TSU = A/T, + WSU = ((TSU * (erlang:system_info(schedulers) + + erlang:system_info(dirty_cpu_schedulers) + + erlang:system_info(dirty_io_schedulers))) + / 1), + %% Weighted scheduler utilization should be + %% very close to 1.0, i.e., we execute the + %% same time as one thread executing all + %% the time... + io:format("WSU = ~p~n", [WSU]), + true = 0.9 < WSU andalso WSU < 1.1, + ok + after + erlang:system_flag(multi_scheduling, unblock), + erlang:system_flag(scheduler_wall_time, false), + lists:foreach(fun ({HP, _HM}) -> + unlink(HP), + exit(HP, kill) + end, Hogs), + lists:foreach(fun ({HP, HM}) -> + receive + {'DOWN', HM, process, HP, _} -> + ok + end + end, Hogs), + ok + end. %% Tests that statistics(garbage_collection) is callable. %% It is not clear how to test anything more. diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 3d9e74472b..6a772bf7c9 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -36,7 +36,8 @@ -export([all/0, suite/0]). -export([process_count/1, system_version/1, misc_smoke_tests/1, - heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1]). + heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1, + atom_count/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -44,7 +45,7 @@ suite() -> all() -> [process_count, system_version, misc_smoke_tests, - heap_size, wordsize, memory, ets_limit, atom_limit]. + heap_size, wordsize, memory, ets_limit, atom_limit, atom_count]. %%% %%% The test cases ------------------------------------------------------------- @@ -550,3 +551,13 @@ get_atom_limit(Config, AtomsMax) -> end, stop_node(Node), Res. + +%% Verify that system_info(atom_count) works. +atom_count(Config) when is_list(Config) -> + Limit = erlang:system_info(atom_limit), + Count1 = erlang:system_info(atom_count), + list_to_atom(integer_to_list(erlang:unique_integer())), + Count2 = erlang:system_info(atom_count), + true = Limit >= Count2, + true = Count2 > Count1, + ok. diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl index 9eb55c9af3..730c43d8c2 100644 --- a/erts/emulator/test/tracer_SUITE.erl +++ b/erts/emulator/test/tracer_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. diff --git a/erts/emulator/test/tracer_SUITE_data/tracer_test.c b/erts/emulator/test/tracer_SUITE_data/tracer_test.c index b68e480215..1555a95d9a 100644 --- a/erts/emulator/test/tracer_SUITE_data/tracer_test.c +++ b/erts/emulator/test/tracer_SUITE_data/tracer_test.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-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. diff --git a/erts/emulator/test/tracer_test.erl b/erts/emulator/test/tracer_test.erl index 1da80bfe31..a82fd04d2e 100644 --- a/erts/emulator/test/tracer_test.erl +++ b/erts/emulator/test/tracer_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index ab56018373..d663cc548c 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -68,8 +68,8 @@ schedulers_alive(Config) when is_list(Config) -> enabled -> io:format("Testing blocking process exit~n"), BF = fun () -> - blocked = erlang:system_flag(multi_scheduling, - block), + blocked_normal = erlang:system_flag(multi_scheduling, + block_normal), Master ! {self(), blocking}, receive after infinity -> ok end end, @@ -77,21 +77,21 @@ schedulers_alive(Config) when is_list(Config) -> Mon = erlang:monitor(process, Blocker), receive {Blocker, blocking} -> ok end, [Blocker] - = erlang:system_info(multi_scheduling_blockers), + = erlang:system_info(normal_multi_scheduling_blockers), unlink(Blocker), exit(Blocker, kill), receive {'DOWN', Mon, _, _, _} -> ok end, enabled = erlang:system_info(multi_scheduling), - [] = erlang:system_info(multi_scheduling_blockers), + [] = erlang:system_info(normal_multi_scheduling_blockers), ok end, io:format("Testing blocked~n"), - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), case erlang:system_info(multi_scheduling) of enabled -> ct:fail(multi_scheduling_enabled); - blocked -> - [Master] = erlang:system_info(multi_scheduling_blockers); + blocked_normal -> + [Master] = erlang:system_info(normal_multi_scheduling_blockers); disabled -> ok end, Ps = lists:map( @@ -109,8 +109,8 @@ schedulers_alive(Config) when is_list(Config) -> unlink(P), exit(P, bang) end, Ps), - case erlang:system_flag(multi_scheduling, unblock) of - blocked -> ct:fail(multi_scheduling_blocked); + case erlang:system_flag(multi_scheduling, unblock_normal) of + blocked_normal -> ct:fail(multi_scheduling_blocked); disabled -> ok; enabled -> ok end, diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables index 27f9dcc878..47e1528958 100755 --- a/erts/emulator/utils/make_tables +++ b/erts/emulator/utils/make_tables @@ -36,6 +36,10 @@ use File::Basename; # <-src>/erl_am.c # <-src>/erl_bif_table.c # <-src>/erl_bif_wrap.c +# <-src>/erl_dirty_bif_wrap.c +# <-src>/erl_guard_bifs.c +# <-src>/hipe_nbif_impl.c +# <-include>/hipe_nbif_impl.h # <-include>/erl_atom_table.h # <-include>/erl_bif_table.h # @@ -51,9 +55,13 @@ my %atom; my %atom_alias; my %aliases; my $auto_alias_num = 0; +my %dirty_bif_tab; my @bif; -my @bif_type; +my @bif_info; +my $dirty_schedulers = 'no'; +my $dirty_schedulers_test = 'no'; +my $hipe = 'no'; while (@ARGV && $ARGV[0] =~ /^-(\w+)/) { my $opt = shift; @@ -65,6 +73,18 @@ while (@ARGV && $ARGV[0] =~ /^-(\w+)/) { $include = shift; die "No directory for -include argument specified" unless defined $include; + } elsif($opt eq '-ds') { + $dirty_schedulers = shift; + die "No -ds argument specified" + unless defined $dirty_schedulers; + } elsif($opt eq '-dst') { + $dirty_schedulers_test = shift; + die "No -dst argument specified" + unless defined $dirty_schedulers_test; + } elsif($opt eq '-hipe') { + $hipe = shift; + die "No -hipe argument specified" + unless defined $hipe; } else { usage("bad option: $opt"); } @@ -84,12 +104,31 @@ while (<>) { my($bif,$alias) = (@args); $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF"); my($mod,$name,$arity) = ($1,$2,$3); + my $mfa = "$mod:$name/$arity"; save_atoms($mod, $name); unless (defined $alias) { $alias = ""; $alias = "${mod}_" unless $mod eq 'erlang'; $alias .= "${name}_$arity"; } + my $sched_type; + my $alias3 = $alias; + + $sched_type = $dirty_bif_tab{$mfa}; + + if (!$sched_type or ($type eq 'ubif')) { + $sched_type = 'normal'; + } + elsif ($sched_type eq 'dirty_cpu') { + $alias3 = "schedule_dirty_cpu_$alias" + } + elsif ($sched_type eq 'dirty_io') { + $alias3 = "schedule_dirty_io_$alias" + } + else { + error("invalid sched_type: $sched_type"); + } + my $wrapper; if ($type eq 'bif') { $wrapper = "wrap_$alias"; @@ -97,8 +136,25 @@ while (<>) { $wrapper = $alias; } push(@bif, ["am_$atom_alias{$mod}","am_$atom_alias{$name}",$arity, - $alias,$wrapper]); - push(@bif_type, $type); + $alias3,$wrapper,$alias]); + push(@bif_info, [$type, $sched_type, $alias3, $alias]); + } elsif ($type eq 'dirty-cpu' or $type eq 'dirty-io' + or $type eq 'dirty-cpu-test' or $type eq 'dirty-io-test') { + if ($dirty_schedulers eq 'yes') { + my($bif,$other) = (@args); + $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF"); + my($mod,$name,$arity) = ($1,$2,$3); + my $mfa = "$mod:$name/$arity"; + if (($type eq 'dirty-cpu') + or (($dirty_schedulers_test eq 'yes') + and ($type eq 'dirty-cpu-test'))) { + $dirty_bif_tab{$mfa} = 'dirty_cpu'; + } elsif (($type eq 'dirty-io') + or (($dirty_schedulers_test eq 'yes') + and ($type eq 'dirty-io-test'))) { + $dirty_bif_tab{$mfa} = 'dirty_io'; + } + } } else { error("invalid line"); } @@ -147,7 +203,7 @@ open_file("$include/erl_bif_list.h"); my $i; for ($i = 0; $i < @bif; $i++) { # module atom, function atom, arity, C function, table index - print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$i)\n"; + print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$bif[$i]->[5],$i)\n"; } # @@ -167,16 +223,24 @@ typedef struct bif_entry { int arity; BifFunction f; BifFunction traced; + BifFunction impl; } BifEntry; typedef struct erts_gc_bif { BifFunction bif; BifFunction gc_bif; + int exp_ix; } ErtsGcBif; +typedef struct erts_u_bif { + BifFunction bif; + int exp_ix; +} ErtsUBif; + extern BifEntry bif_table[]; extern Export* bif_export[]; extern const ErtsGcBif erts_gc_bifs[]; +extern const ErtsUBif erts_u_bifs[]; #define BIF_SIZE $bif_size @@ -184,21 +248,28 @@ EOF my $i; for ($i = 0; $i < @bif; $i++) { - print "#define BIF_$bif[$i]->[3] $i\n"; + print "#define BIF_$bif_info[$i]->[3] $i\n"; } print "\n"; for ($i = 0; $i < @bif; $i++) { - my $args = join(', ', 'Process*', 'Eterm*'); - my $name = $bif[$i]->[3]; + my $args = join(', ', 'Process*', 'Eterm*', 'UWord*'); + my $name = $bif_info[$i]->[3]; print "Eterm $name($args);\n"; - print "Eterm wrap_$name($args, UWord *I);\n"; + print "Eterm wrap_$name($args);\n"; print "Eterm erts_gc_$name(Process* p, Eterm* reg, Uint live);\n" - if $bif_type[$i] eq 'gcbif'; + if $bif_info[$i]->[0] eq 'gcbif'; + print "Eterm $bif_info[$i]->[2]($args);\n" + unless $bif_info[$i]->[1] eq 'normal'; print "\n"; } -print "#endif\n"; + +if ($hipe eq 'yes') { + print "\n#include \"hipe_nbif_impl.h\"\n"; +} + +print "\n#endif\n"; # # Generate the bif table file. @@ -229,7 +300,7 @@ includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h", for ($i = 0; $i < @bif; $i++) { next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs my $arity = $bif[$i]->[2]; - my $func = $bif[$i]->[3]; + my $func = $bif_info[$i]->[3]; print "Eterm\n"; print "wrap_$func(Process* p, Eterm* args, UWord* I)\n"; print "{\n"; @@ -241,21 +312,101 @@ for ($i = 0; $i < @bif; $i++) { # Generate erl_gc_bifs.c. # -open_file("$src/erl_gc_bifs.c"); +open_file("$src/erl_guard_bifs.c"); my $i; includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h", "erl_bif_table.h"); print "const ErtsGcBif erts_gc_bifs[] = {\n"; for ($i = 0; $i < @bif; $i++) { - next unless $bif_type[$i] eq 'gcbif'; - my $arity = $bif[$i]->[2]; - my $func = $bif[$i]->[3]; - print " {$func, erts_gc_$func},\n"; + next unless $bif_info[$i]->[0] eq 'gcbif'; + print " {$bif[$i]->[3], erts_gc_$bif[$i]->[3], BIF_$bif[$i]->[5]},\n"; +} +print " {NULL, NULL, -1}\n"; +print "};\n"; + +print "const ErtsUBif erts_u_bifs[] = {\n"; +for ($i = 0; $i < @bif; $i++) { + next unless $bif_info[$i]->[0] eq 'ubif'; + print " {$bif[$i]->[3], BIF_$bif[$i]->[5]},\n"; } -print " {0, 0}\n"; +print " {NULL, -1}\n"; print "};\n"; # +# Generate the dirty bif wrappers file. +# + +open_file("$src/erl_dirty_bif_wrap.c"); +my $i; +includes("erl_process.h", "erl_nfunc_sched.h", "erl_bif_table.h", "erl_atom_table.h"); +for ($i = 0; $i < @bif_info; $i++) { + next if $bif_info[$i]->[1] eq 'normal'; + my $dtype; + if ($bif_info[$i]->[1] eq 'dirty_cpu') { + $dtype = "ERTS_SCHED_DIRTY_CPU"; + } + else { + $dtype = "ERTS_SCHED_DIRTY_IO"; + } +print <<EOF; +Eterm $bif_info[$i]->[2](Process *c_p, Eterm *regs, BeamInstr *I) +{ + return erts_reschedule_bif(c_p, regs, I, $bif_info[$i]->[3], $dtype); +} + +EOF + +} + +if ($hipe eq 'yes') { + + # + # Generate the nbif_impl bif wrappers file. + # + + open_file("$src/hipe_nbif_impl.h"); + print <<EOF; + +#ifndef HIPE_NBIF_IMPL_H__ +#define HIPE_NBIF_IMPL_H__ + +EOF + + my $i; + for ($i = 0; $i < @bif; $i++) { + print <<EOF; +Eterm nbif_impl_$bif[$i]->[5](Process *c_p, Eterm *regs); +EOF + } + + print <<EOF; + +#endif /* ERL_HIPE_NBIF_IMPL_H__ */ + +EOF + + # + # Generate the nbif_impl bif wrappers file. + # + + open_file("$src/hipe_nbif_impl.c"); + my $i; + includes("erl_process.h", "erl_nfunc_sched.h", "erl_bif_table.h", "erl_atom_table.h"); + for ($i = 0; $i < @bif; $i++) { + + print <<EOF; +Eterm nbif_impl_$bif[$i]->[5](Process *c_p, Eterm *regs) +{ + return $bif[$i]->[3](c_p, regs, (UWord *) bif_export\[BIF_$bif[$i]->[5]\]); +} + +EOF + + } + +} # hipe + +# # Utilities follow. # diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c index d67b997d6d..bc353e384e 100644 --- a/erts/etc/common/heart.c +++ b/erts/etc/common/heart.c @@ -48,13 +48,10 @@ * * HEART_BEATING * - * This program expects a heart beat messages. If it does not receive a - * heart beat message from Erlang within heart_beat_timeout seconds, it - * reboots the system. The variable heart_beat_timeout is exported (so - * that it can be set from the shell in VxWorks, as is the variable - * heart_beat_report_delay). When using Solaris, the system is rebooted - * by executing the command stored in the environment variable - * HEART_COMMAND. + * This program expects a heart beat message. If it does not receive a + * heart beat message from Erlang within heart_beat_timeout seconds, it + * reboots the system. The system is rebooted by executing the command + * stored in the environment variable HEART_COMMAND. * * BLOCKING DESCRIPTORS * @@ -149,27 +146,17 @@ struct msg { /* Maybe interesting to change */ /* Times in seconds */ -#define HEART_BEAT_BOOT_DELAY 60 /* 1 minute */ #define SELECT_TIMEOUT 5 /* Every 5 seconds we reset the watchdog timer */ /* heart_beat_timeout is the maximum gap in seconds between two - consecutive heart beat messages from Erlang, and HEART_BEAT_BOOT_DELAY - is the the extra delay that wd_keeper allows for, to give heart a - chance to reboot in the "normal" way before the hardware watchdog - enters the scene. heart_beat_report_delay is the time allowed for reporting - before rebooting under VxWorks. */ + consecutive heart beat messages from Erlang. */ int heart_beat_timeout = 60; -int heart_beat_report_delay = 30; -int heart_beat_boot_delay = HEART_BEAT_BOOT_DELAY; /* All current platforms have a process identifier that fits in an unsigned long and where 0 is an impossible or invalid value */ unsigned long heart_beat_kill_pid = 0; -#define VW_WD_TIMEOUT (heart_beat_timeout+heart_beat_report_delay+heart_beat_boot_delay) -#define SOL_WD_TIMEOUT (heart_beat_timeout+heart_beat_boot_delay) - /* reasons for reboot */ #define R_TIMEOUT (1) #define R_CLOSED (2) @@ -297,7 +284,6 @@ free_env_val(char *value) static void get_arguments(int argc, char** argv) { int i = 1; int h; - int w; unsigned long p; while (i < argc) { @@ -313,15 +299,6 @@ static void get_arguments(int argc, char** argv) { i++; } break; - case 'w': - if (strcmp(argv[i], "-wt") == 0) - if (sscanf(argv[i+1],"%i",&w) ==1) - if ((w > 10) && (w <= 65535)) { - heart_beat_boot_delay = w; - fprintf(stderr,"heart_beat_boot_delay = %d\n",w); - i++; - } - break; case 'p': if (strcmp(argv[i], "-pid") == 0) if (sscanf(argv[i+1],"%lu",&p) ==1){ @@ -347,7 +324,7 @@ static void get_arguments(int argc, char** argv) { } i++; } - debugf("arguments -ht %d -wt %d -pid %lu\n",h,w,p); + debugf("arguments -ht %d -pid %lu\n",h,p); } int main(int argc, char **argv) { @@ -674,11 +651,6 @@ void win_system(char *command) */ static void do_terminate(int erlin_fd, int reason) { - /* - When we get here, we have HEART_BEAT_BOOT_DELAY secs to finish - (plus heart_beat_report_delay if under VxWorks), so we don't need - to call wd_reset(). - */ int ret = 0, tmo=0; char *tmo_env; diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 0990fcf8a7..c7e2ac169d 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1817,6 +1817,262 @@ document etp-proc-state % Print state of process %--------------------------------------------------------------------------- end +define etp-proc-state-int +# Args: int +# + if ($arg0 & 0x80000000) + printf "GARBAGE<0x80000000> | " + end + if ($arg0 & 0x40000000) + printf "dirty-running-sys | " + end + if ($arg0 & 0x20000000) + printf "dirty-running | " + end + if ($arg0 & 0x10000000) + printf "dirty-active-sys | " + end + if ($arg0 & 0x8000000) + printf "dirty-io-proc | " + end + if ($arg0 & 0x4000000) + printf "dirty-cpu-proc | " + end + if ($arg0 & 0x2000000) + printf "on-heap-msgq | " + end + if ($arg0 & 0x1000000) + printf "off-heap-msgq | " + end + if ($arg0 & 0x800000) + printf "delayed-sys | " + end + if ($arg0 & 0x400000) + printf "proxy | " + set $proxy_process = 1 + else + set $proxy_process = 0 + end + if ($arg0 & 0x200000) + printf "running-sys | " + end + if ($arg0 & 0x100000) + printf "active-sys | " + end + if ($arg0 & 0x80000) + printf "trapping-exit | " + end + if ($arg0 & 0x40000) + printf "bound | " + end + if ($arg0 & 0x20000) + printf "garbage-collecting | " + end + if ($arg0 & 0x10000) + printf "suspended | " + end + if ($arg0 & 0x8000) + printf "running | " + end + if ($arg0 & 0x4000) + printf "in-run-queue | " + end + if ($arg0 & 0x2000) + printf "active | " + end + if ($arg0 & 0x1000) + printf "pending-exit | " + end + if ($arg0 & 0x800) + printf "exiting | " + end + if ($arg0 & 0x400) + printf "free | " + end + if ($arg0 & 0x200) + printf "in-prq-low | " + end + if ($arg0 & 0x100) + printf "in-prq-normal | " + end + if ($arg0 & 0x80) + printf "in-prq-high | " + end + if ($arg0 & 0x40) + printf "in-prq-max | " + end + if ($arg0 & 0x30) == 0x0 + printf "prq-prio-max | " + else + if ($arg0 & 0x30) == 0x10 + printf "prq-prio-high | " + else + if ($arg0 & 0x30) == 0x20 + printf "prq-prio-normal | " + else + printf "prq-prio-low | " + end + end + end + if ($arg0 & 0xc) == 0x0 + printf "usr-prio-max | " + else + if ($arg0 & 0xc) == 0x4 + printf "usr-prio-high | " + else + if ($arg0 & 0xc) == 0x8 + printf "usr-prio-normal | " + else + printf "usr-prio-low | " + end + end + end + if ($arg0 & 0x3) == 0x0 + printf "act-prio-max\n" + else + if ($arg0 & 0x3) == 0x1 + printf "act-prio-high\n" + else + if ($arg0 & 0x3) == 0x2 + printf "act-prio-normal\n" + else + printf "act-prio-low\n" + end + end + end +end + +document etp-proc-state-int +%--------------------------------------------------------------------------- +% etp-proc-state-int int +% +% Print state of process state value +%--------------------------------------------------------------------------- +end + + +define etp-proc-state +# Args: Process* +# + set $state_int = *(((Uint32 *) &(((Process *) $arg0)->state))) + etp-proc-state-int $state_int +end + +document etp-proc-state +%--------------------------------------------------------------------------- +% etp-proc-state Process* +% +% Print state of process +%--------------------------------------------------------------------------- +end + +define etp-proc-flags-int +# Args: int +# + if ($arg0 & ~0x1ffffff) + printf "GARBAGE<%x> ", ($arg0 & ~0x1ffffff) + end + if ($arg0 & 0x1000000) + printf "dirty-minor-gc " + end + if ($arg0 & 0x800000) + printf "dirty-major-gc " + end + if ($arg0 & 0x400000) + printf "dirty-gc-hibernate " + end + if ($arg0 & 0x200000) + printf "dirty-cla " + end + if ($arg0 & 0x100000) + printf "delayed-del-proc " + end + if ($arg0 & 0x80000) + printf "hipe-mode " + end + if ($arg0 & 0x40000) + printf "have-blocked-nmsb " + end + if ($arg0 & 0x20000) + printf "shdlr-onln-wait-q " + end + if ($arg0 & 0x10000) + printf "delay-gc " + end + if ($arg0 & 0x8000) + printf "abandoned-heap-use " + end + if ($arg0 & 0x4000) + printf "off-heap-msgq-chng " + end + if ($arg0 & 0x2000) + printf "on-heap-msgq " + end + if ($arg0 & 0x1000) + printf "off-heap-msgq " + end + if ($arg0 & 0x800) + printf "disable-gc " + end + if ($arg0 & 0x400) + printf "force-gc " + end + if ($arg0 & 0x200) + printf "p2pnr-resched " + end + if ($arg0 & 0x100) + printf "have-blocked-msb " + end + if ($arg0 & 0x80) + printf "using-ddll " + end + if ($arg0 & 0x40) + printf "distribution " + end + if ($arg0 & 0x20) + printf "using-db " + end + if ($arg0 & 0x10) + printf "need-fullsweep " + end + if ($arg0 & 0x8) + printf "heap-grow " + end + if ($arg0 & 0x4) + printf "timo " + end + if ($arg0 & 0x2) + printf "inslpqueue " + end + if ($arg0 & 0x1) + printf "hibernate-sched " + end + printf "\n" +end + +document etp-proc-flags-int +%--------------------------------------------------------------------------- +% etp-proc-flags-int int +% +% Print flags of process flags value +%--------------------------------------------------------------------------- +end + + +define etp-proc-flags +# Args: Process* +# + set $flags_int = ((Process *) $arg0)->flags + etp-proc-flags-int $flags_int +end + +document etp-proc-flags +%--------------------------------------------------------------------------- +% etp-proc-flags Process* +% +% Print flags of process +%--------------------------------------------------------------------------- +end define etp-process-info # Args: Process* @@ -1826,6 +2082,8 @@ define etp-process-info etp-1 $etp_proc->common.id printf "\n State: " etp-proc-state $etp_proc + printf "\n Flags: " + etp-proc-flags $etp_proc if $proxy_process != 0 printf " Pointer: (Process *) %p\n", $etp_proc printf " *** PROXY process struct *** refer to: \n" @@ -2356,8 +2614,20 @@ define etp-rq-flags-int if ($arg0 & 0x4000000) printf " protected" end - if ($arg0 & ~0x7ffffff) - printf " GARBAGE(0x%x)", ($arg0 & ~0x3ffffff) + if ($arg0 & 0x8000000) + printf " exec" + end + if ($arg0 & 0x10000000) + printf " msb_exec" + end + if ($arg0 & 0x20000000) + printf " misc_op" + end + if ($arg0 & 0x40000000) + printf " halting" + end + if ($arg0 & ~0x7fffffff) + printf " GARBAGE(0x%x)", ($arg0 & ~0x7fffffff) end printf "\n" end @@ -2389,6 +2659,9 @@ define etp-ssi-flags if ($arg0 & 0x10) printf " suspended" end + if ($arg0 & 0x20) + printf " msb_exec" + end printf "\n" end @@ -2556,7 +2829,7 @@ define etp-run-queue-info-internal set $rq_flags = *((Uint32 *) &($runq->flags)) etp-rq-flags-int $rq_flags printf " Pointer: (ErtsRunQueue *) %p\n", $runq - +end define etp-disasm-1 set $code_ptr = ((BeamInstr*)$arg0) diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index a997297f65..447720af7e 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2015. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/time_compat.erl b/erts/example/time_compat.erl index 589781c8e8..6472a271b6 100644 --- a/erts/example/time_compat.erl +++ b/erts/example/time_compat.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014-2015. All Rights Reserved. +%% Copyright Ericsson AB 2014-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. diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 64d1a70e61..4f4027c74e 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differindex 4406a82a36..c05bc813f0 100644 --- a/erts/preloaded/ebin/erl_tracer.beam +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 8247c399a4..0799546c60 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 0161151785..1b28a929ce 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam Binary files differindex df3bc9526b..e5381d3574 100644 --- a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam +++ b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex aae3976298..57b3023ea6 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/erts_literal_area_collector.beam b/erts/preloaded/ebin/erts_literal_area_collector.beam Binary files differindex 71f3c2ec8c..2fab34318e 100644 --- a/erts/preloaded/ebin/erts_literal_area_collector.beam +++ b/erts/preloaded/ebin/erts_literal_area_collector.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 74a0184818..ffddf2d54d 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex b601c048b3..3c6a6d4f41 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 77909b01f0..133fda4b13 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 5bbbaf14d5..99ad863b8b 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 1a573ce297..e52e442f8e 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 6afeb454d6..122406c834 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 6a7ad9164f..c683d395f3 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile index 2ab9edaf5e..edb9f35258 100644 --- a/erts/preloaded/src/Makefile +++ b/erts/preloaded/src/Makefile @@ -73,7 +73,7 @@ KERNEL_SRC=$(ERL_TOP)/lib/kernel/src KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include STDLIB_INCLUDE=$(ERL_TOP)/lib/stdlib/include -ERL_COMPILE_FLAGS += +warn_obsolete_guard +debug_info -I$(KERNEL_SRC) -I$(KERNEL_INCLUDE) +ERL_COMPILE_FLAGS += +debug_info -I$(KERNEL_SRC) -I$(KERNEL_INCLUDE) debug opt: $(TARGET_FILES) diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 15c3e01653..86ebb4dd4b 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -886,7 +886,7 @@ function_exported(_Module, _Function, _Arity) -> %% garbage_collect/0 -spec garbage_collect() -> true. garbage_collect() -> - erlang:nif_error(undefined). + erts_internal:garbage_collect(major). %% garbage_collect/1 -spec garbage_collect(Pid) -> GCResult when @@ -2333,6 +2333,10 @@ spawn_opt(_Tuple) -> SchedulerId :: pos_integer(), ActiveTime :: non_neg_integer(), TotalTime :: non_neg_integer(); + (scheduler_wall_time_all) -> [{SchedulerId, ActiveTime, TotalTime}] | undefined when + SchedulerId :: pos_integer(), + ActiveTime :: non_neg_integer(), + TotalTime :: non_neg_integer(); (total_active_tasks) -> ActiveTasks when ActiveTasks :: non_neg_integer(); (total_run_queue_lengths) -> TotalRunQueueLenghts when @@ -2532,6 +2536,7 @@ tuple_to_list(_Tuple) -> Alloc :: atom(); ({allocator_sizes, Alloc}) -> [_] when %% More or less anything Alloc :: atom(); + (atom_count) -> pos_integer(); (atom_limit) -> pos_integer(); (build_type) -> opt | debug | purify | quantify | purecov | gcov | valgrind | gprof | lcnt | frmptr; @@ -4013,6 +4018,7 @@ sched_wall_time(Ref, N, undefined) -> sched_wall_time(Ref, N, Acc) -> receive {Ref, undefined} -> sched_wall_time(Ref, N-1, undefined); + {Ref, SWTL} when erlang:is_list(SWTL) -> sched_wall_time(Ref, N-1, Acc ++ SWTL); {Ref, SWT} -> sched_wall_time(Ref, N-1, [SWT|Acc]) end. diff --git a/erts/vsn.mk b/erts/vsn.mk index 317d731cd7..028b114068 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 8.1.1 +VSN = 8.2.1 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile index 559836116f..9a388e4e8a 100644 --- a/lib/asn1/doc/src/Makefile +++ b/lib/asn1/doc/src/Makefile @@ -37,8 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = asn1ct.xml \ - asn1rt.xml +XML_REF3_FILES = asn1ct.xml GEN_XML = \ asn1_spec.xml diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index e5a7b1bcc4..ebe1ce44dc 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -321,45 +321,6 @@ File3.asn</pre> </func> <func> - <name>encode(Module, Type, Value)-> {ok, Bytes} | {error, Reason}</name> - <fsummary>Encodes an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - <v>Bytes = binary()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Encodes <c>Value</c> of <c>Type</c> defined in the <c>ASN.1</c> module - <c>Module</c>. To get as fast execution as possible, the - encode function performs only the rudimentary tests that input - <c>Value</c> is a correct instance of <c>Type</c>. So, for example, - the length of strings is - not always checked. Returns <c>{ok, Bytes}</c> if successful or - <c>{error, Reason}</c> if an error occurred. - </p> - <p>This function is deprecated. - Use <c>Module:encode(Type, Value)</c> instead.</p> - </desc> - </func> - - <func> - <name>decode(Module, Type, Bytes) -> {ok, Value} | {error, Reason}</name> - <fsummary>Decode from Bytes into an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = Reason = term()</v> - <v>Bytes = binary()</v> - </type> - <desc> - <p>Decodes <c>Type</c> from <c>Module</c> from the binary - <c>Bytes</c>. Returns <c>{ok, Value}</c> if successful.</p> - <p>This function is deprecated. - Use <c>Module:decode(Type, Bytes)</c> instead.</p> - </desc> - </func> - - <func> <name>value(Module, Type) -> {ok, Value} | {error, Reason}</name> <fsummary>Creates an ASN.1 value for test purposes.</fsummary> <type> @@ -424,11 +385,11 @@ File3.asn</pre> <p>Schematically, the following occurs for each type in the module:</p> <code type="none"> {ok, Value} = asn1ct:value(Module, Type), -{ok, Bytes} = asn1ct:encode(Module, Type, Value), -{ok, Value} = asn1ct:decode(Module, Type, Bytes).</code> +{ok, Bytes} = Module:encode(Type, Value), +{ok, Value} = Module:decode(Type, Bytes).</code> <p>The <c>test</c> functions use the <c>*.asn1db</c> files for all included modules. If they are located in a different - directory than the current working directory, use the include + directory than the current working directory, use the <c>include</c> option to add paths. This is only needed when automatically generating values. For static values using <c>Value</c> no options are needed.</p> diff --git a/lib/asn1/doc/src/asn1rt.xml b/lib/asn1/doc/src/asn1rt.xml deleted file mode 100644 index 3f53ca0f56..0000000000 --- a/lib/asn1/doc/src/asn1rt.xml +++ /dev/null @@ -1,135 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1997</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>asn1rt</title> - <prepared>Kenneth Lundin</prepared> - <responsible>Kenneth Lundin</responsible> - <docno>1</docno> - <approved>Kenneth Lundin</approved> - <checked></checked> - <date>97-10-04</date> - <rev>A</rev> - <file>asn1.sgml</file> - </header> - <module>asn1rt</module> - <modulesummary>ASN.1 runtime support functions</modulesummary> - <description> - <warning> - <p> - All functions in this module are deprecated and will be - removed in a future release. - </p> - </warning> - </description> - - <funcs> - - <func> - <name>decode(Module,Type,Bytes) -> {ok,Value}|{error,Reason}</name> - <fsummary>Decodes from Bytes into an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = Reason = term()</v> - <v>Bytes = binary</v> - </type> - <desc> - <p>Decodes <c>Type</c> from <c>Module</c> from the binary <c>Bytes</c>. - Returns <c>{ok,Value}</c> if successful.</p> - <p>Use <c>Module:decode(Type, Bytes)</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>encode(Module,Type,Value)-> {ok,Bytes} | {error,Reason}</name> - <fsummary>Encodes an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - <v>Bytes = binary</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Encodes <c>Value</c> of <c>Type</c> defined in the <c>ASN.1</c> - module <c>Module</c>. Returns a binary if successful. To get - as fast execution as possible, the encode function performs - only the rudimentary test that input <c>Value</c> is a correct - instance of <c>Type</c>. For example, the length of strings is - not always checked.</p> - <p>Use <c>Module:encode(Type, Value)</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>info(Module) -> {ok,Info} | {error,Reason}</name> - <fsummary>Returns compiler information about the Module.</fsummary> - <type> - <v>Module = atom()</v> - <v>Info = list()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Returns the version of the <c>ASN.1</c> compiler that was - used to compile the module. It also returns the compiler options - that were used.</p> - <p>Use <c>Module:info()</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>utf8_binary_to_list(UTF8Binary) -> {ok,UnicodeList} | {error,Reason}</name> - <fsummary>Transforms an UTF8 encoded binary to a unicode list.</fsummary> - <type> - <v>UTF8Binary = binary()</v> - <v>UnicodeList = [integer()]</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Transforms a UTF8 encoded binary - to a list of integers, where each integer represents one - character as its unicode value. The function fails if the binary - is not a properly encoded UTF8 string.</p> - <p>Use <seealso marker="stdlib:unicode#characters_to_list-1">unicode:characters_to_list/1</seealso> instead of this function.</p> - </desc> - </func> - - <func> - <name>utf8_list_to_binary(UnicodeList) -> {ok,UTF8Binary} | {error,Reason}</name> - <fsummary>Transforms an unicode list to a UTF8 binary.</fsummary> - <type> - <v>UnicodeList = [integer()]</v> - <v>UTF8Binary = binary()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Transforms a list of integers, - where each integer represents one character as its unicode - value, to a UTF8 encoded binary.</p> - <p>Use <seealso marker="stdlib:unicode#characters_to_binary-1">unicode:characters_to_binary/1</seealso> instead of this function.</p> - </desc> - </func> - - </funcs> - -</erlref> - diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 38cf2d496a..ba459f6cd3 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -68,7 +68,6 @@ CT_MODULES= \ $(EVAL_CT_MODULES) RT_MODULES= \ - asn1rt \ asn1rt_nif MODULES= $(CT_MODULES) $(RT_MODULES) diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index 1f8805ff5e..d2da727193 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -2,7 +2,6 @@ [{description, "The Erlang ASN1 compiler version %VSN%"}, {vsn, "%VSN%"}, {modules, [ - asn1rt, asn1rt_nif ]}, {registered, [ diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 8783b5418d..4e030861f5 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -20,17 +20,12 @@ %% %% -module(asn1ct). --deprecated([decode/3,encode/3]). --compile([{nowarn_deprecated_function,{asn1rt,decode,3}}, - {nowarn_deprecated_function,{asn1rt,encode,2}}, - {nowarn_deprecated_function,{asn1rt,encode,3}}]). %% Compile Time functions for ASN.1 (e.g ASN.1 compiler). %%-compile(export_all). %% Public exports -export([compile/1, compile/2]). --export([encode/2, encode/3, decode/3]). -export([test/1, test/2, test/3, value/2, value/3]). %% Application internal exports -export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3, @@ -1271,21 +1266,6 @@ pretty2(Module,AbsFile) -> start(Includes) when is_list(Includes) -> asn1_db:dbstart(Includes). - -encode(Module,Term) -> - asn1rt:encode(Module,Term). - -encode(Module,Type,Term) when is_list(Module) -> - asn1rt:encode(list_to_atom(Module),Type,Term); -encode(Module,Type,Term) -> - asn1rt:encode(Module,Type,Term). - -decode(Module,Type,Bytes) when is_list(Module) -> - asn1rt:decode(list_to_atom(Module),Type,Bytes); -decode(Module,Type,Bytes) -> - asn1rt:decode(Module,Type,Bytes). - - test(Module) -> test_module(Module, []). test(Module, [] = Options) -> test_module(Module, Options); @@ -1330,10 +1310,10 @@ test_type(Module, Type) -> test_value(Module, Type, Value) -> in_process(fun() -> - case catch encode(Module, Type, Value) of + case catch Module:encode(Type, Value) of {ok, Bytes} -> NewBytes = prepare_bytes(Bytes), - case decode(Module, Type, NewBytes) of + case Module:decode(Type, NewBytes) of {ok, Value} -> {ok, {Module, Type, Value}}; {ok, Res} -> diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 57cd3f8af6..b3d41dd9f3 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -19,7 +19,6 @@ %% %% -module(asn1ct_value). --compile([{nowarn_deprecated_function,{asn1rt,utf8_list_to_binary,1}}]). %% Generate Erlang values for ASN.1 types. %% The value is randomized within it's constraints @@ -292,8 +291,10 @@ from_type_prim(M, D) -> 'BMPString' -> adjust_list(size_random(C),c_string(C,"BMPString")); 'UTF8String' -> - {ok,Res}=asn1rt:utf8_list_to_binary(adjust_list(random(50),[$U,$T,$F,$8,$S,$t,$r,$i,$n,$g,16#ffff,16#fffffff,16#ffffff,16#fffff,16#fff])), - Res; + L = adjust_list(random(50), + [$U,$T,$F,$8,$S,$t,$r,$i,$n,$g, + 16#ffff,16#ffee,16#10ffff,16#ffff,16#fff]), + unicode:characters_to_binary(L); 'UniversalString' -> adjust_list(size_random(C),c_string(C,"UniversalString")); XX -> diff --git a/lib/asn1/src/asn1rt.erl b/lib/asn1/src/asn1rt.erl deleted file mode 100644 index 3e09ce2252..0000000000 --- a/lib/asn1/src/asn1rt.erl +++ /dev/null @@ -1,184 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-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% -%% -%% --module(asn1rt). --deprecated(module). - -%% Runtime functions for ASN.1 (i.e encode, decode) - --export([encode/2,encode/3,decode/3,load_driver/0,unload_driver/0,info/1]). - --export([utf8_binary_to_list/1,utf8_list_to_binary/1]). - -encode(Module,{Type,Term}) -> - encode(Module,Type,Term). - -encode(Module,Type,Term) -> - case catch apply(Module,encode,[Type,Term]) of - {'EXIT',undef} -> - {error,{asn1,{undef,Module,Type}}}; - Result -> - Result - end. - -decode(Module,Type,Bytes) -> - case catch apply(Module,decode,[Type,Bytes]) of - {'EXIT',undef} -> - {error,{asn1,{undef,Module,Type}}}; - Result -> - Result - end. - -%% Remove in R16A -load_driver() -> - ok. - -unload_driver() -> - ok. - -info(Module) -> - case catch apply(Module,info,[]) of - {'EXIT',{undef,_Reason}} -> - {error,{asn1,{undef,Module,info}}}; - Result -> - {ok,Result} - end. - -%% utf8_binary_to_list/1 transforms a utf8 encoded binary to a list of -%% unicode elements, where each element is the unicode integer value -%% of a utf8 character. -%% Bin is a utf8 encoded value. The return value is either {ok,Val} or -%% {error,Reason}. Val is a list of integers, where each integer is a -%% unicode character value. -utf8_binary_to_list(Bin) when is_binary(Bin) -> - utf8_binary_to_list(Bin,[]). - -utf8_binary_to_list(<<>>,Acc) -> - {ok,lists:reverse(Acc)}; -utf8_binary_to_list(Bin,Acc) -> - Len = utf8_binary_len(Bin), - case catch split_binary(Bin,Len) of - {CharBin,RestBin} -> - case utf8_binary_char(CharBin) of - C when is_integer(C) -> - utf8_binary_to_list(RestBin,[C|Acc]); - Err -> Err - end; - Err -> {error,{asn1,{bad_encoded_utf8string,Err}}} - end. - -utf8_binary_len(<<0:1,_:7,_/binary>>) -> - 1; -utf8_binary_len(<<1:1,1:1,0:1,_:5,_/binary>>) -> - 2; -utf8_binary_len(<<1:1,1:1,1:1,0:1,_:4,_/binary>>) -> - 3; -utf8_binary_len(<<1:1,1:1,1:1,1:1,0:1,_:3,_/binary>>) -> - 4; -utf8_binary_len(<<1:1,1:1,1:1,1:1,1:1,0:1,_:2,_/binary>>) -> - 5; -utf8_binary_len(<<1:1,1:1,1:1,1:1,1:1,1:1,0:1,_:1,_/binary>>) -> - 6; -utf8_binary_len(Bin) -> - {error,{asn1,{bad_utf8_length,Bin}}}. - -utf8_binary_char(<<0:1,Int:7>>) -> - Int; -utf8_binary_char(<<_:2,0:1,Int1:5,1:1,0:1,Int2:6>>) -> - (Int1 bsl 6) bor Int2; -utf8_binary_char(<<_:3,0:1,Int1:4,1:1,0:1,Int2:6,1:1,0:1,Int3:6>>) -> - <<Res:16>> = <<Int1:4,Int2:6,Int3:6>>, - Res; -utf8_binary_char(<<_:4,0:1,Int1:3,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6>> = Rest, - <<Res:24>> = <<0:3,Int1:3,Int2:6,Int3:6,Int4:6>>, - Res; -utf8_binary_char(<<_:5,0:1,Int1:2,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6,1:1,0:1,Int5:6>> = Rest, - <<Res:32>> = <<0:6,Int1:2,Int2:6,Int3:6,Int4:6,Int5:6>>, - Res; -utf8_binary_char(<<_:6,0:1,I:1,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6,1:1,0:1, - Int5:6,1:1,0:1,Int6:6>> = Rest, - <<Res:32>> = <<0:1,I:1,Int2:6,Int3:6,Int4:6,Int5:6,Int6:6>>, - Res; -utf8_binary_char(Err) -> - {error,{asn1,{bad_utf8_character_encoding,Err}}}. - - -%% macros used for utf8 encoding --define(bit1to6_into_utf8byte(I),16#80 bor (I band 16#3f)). --define(bit7to12_into_utf8byte(I),16#80 bor ((I band 16#fc0) bsr 6)). --define(bit13to18_into_utf8byte(I),16#80 bor ((I band 16#3f000) bsr 12)). --define(bit19to24_into_utf8byte(I),16#80 bor ((Int band 16#fc0000) bsr 18)). --define(bit25to30_into_utf8byte(I),16#80 bor ((Int band 16#3f000000) bsr 24)). - -%% utf8_list_to_binary/1 transforms a list of integers to a -%% binary. Each element in the input list has the unicode (integer) -%% value of an utf8 character. -%% The return value is either {ok,Bin} or {error,Reason}. The -%% resulting binary is utf8 encoded. -utf8_list_to_binary(List) -> - utf8_list_to_binary(List,[]). - -utf8_list_to_binary([],Acc) when is_list(Acc) -> - {ok,list_to_binary(lists:reverse(Acc))}; -utf8_list_to_binary([],Acc) -> - {error,{asn1,Acc}}; -utf8_list_to_binary([H|T],Acc) -> - case catch utf8_encode(H,Acc) of - NewAcc when is_list(NewAcc) -> - utf8_list_to_binary(T,NewAcc); - Err -> Err - end. - - -utf8_encode(Int,Acc) when Int < 128 -> - %% range 16#00000000 - 16#0000007f - %% utf8 encoding: 0xxxxxxx - [Int|Acc]; -utf8_encode(Int,Acc) when Int < 16#800 -> - %% range 16#00000080 - 16#000007ff - %% utf8 encoding: 110xxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),16#c0 bor (Int bsr 6)|Acc]; -utf8_encode(Int,Acc) when Int < 16#10000 -> - %% range 16#00000800 - 16#0000ffff - %% utf8 encoding: 1110xxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - 16#e0 bor ((Int band 16#f000) bsr 12)|Acc]; -utf8_encode(Int,Acc) when Int < 16#200000 -> - %% range 16#00010000 - 16#001fffff - %% utf8 encoding: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int), - 16#f0 bor ((Int band 16#1c0000) bsr 18)|Acc]; -utf8_encode(Int,Acc) when Int < 16#4000000 -> - %% range 16#00200000 - 16#03ffffff - %% utf8 encoding: 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int),?bit19to24_into_utf8byte(Int), - 16#f8 bor ((Int band 16#3000000) bsr 24)|Acc]; -utf8_encode(Int,Acc) -> - %% range 16#04000000 - 16#7fffffff - %% utf8 encoding: 1111110x 10xxxxxx ...(total 6 bytes) 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int),?bit19to24_into_utf8byte(Int), - ?bit25to30_into_utf8byte(Int), - 16#fc bor ((Int band 16#40000000) bsr 30)|Acc]. diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 0716d79291..40575e8a2f 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -134,7 +134,7 @@ RELSYSDIR = $(RELEASE_PATH)/asn1_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warnings_as_errors +ERL_COMPILE_FLAGS += +warnings_as_errors +nowarn_export_all EBIN = . # ---------------------------------------------------- diff --git a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl index 6cf8ecf451..cd6c74b995 100644 --- a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl +++ b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl @@ -120,10 +120,10 @@ run3(Erule) -> asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, asn1_NOVALUE,asn1_NOVALUE}}}}}}}, io:format("~p:~p~n",[Erule,Val]), - {ok,List}= asn1rt:encode('EUTRA-RRC-Definitions','DL-DCCH-Message',Val), + {ok,List}= 'EUTRA-RRC-Definitions':encode('DL-DCCH-Message',Val), Enc = iolist_to_binary(List), io:format("Result from encode:~n~p~n",[Enc]), - {ok,Val2} = asn1rt:decode('EUTRA-RRC-Definitions','DL-DCCH-Message',Enc), + {ok,Val2} = 'EUTRA-RRC-Definitions':decode('DL-DCCH-Message', Enc), io:format("Result from decode:~n~p~n",[Val2]), case Val2 of Val -> ok; diff --git a/lib/asn1/test/asn1_SUITE_data/testobj.erl b/lib/asn1/test/asn1_SUITE_data/testobj.erl index a0e00f8314..e547ea4572 100644 --- a/lib/asn1/test/asn1_SUITE_data/testobj.erl +++ b/lib/asn1/test/asn1_SUITE_data/testobj.erl @@ -1410,16 +1410,14 @@ int2bin(Int) -> %%%%%%%%%%%%%%%%% wrappers %%%%%%%%%%%%%%%%%%%%%%%% wrapper_encode(Module,Type,Value) -> - case asn1rt:encode(Module,Type,Value) of - {ok,X} when binary(X) -> + case Module:encode(Type, Value) of + {ok,X} when is_binary(X) -> {ok, binary_to_list(X)}; - {ok,X} -> - {ok, binary_to_list(list_to_binary(X))}; Error -> Error end. wrapper_decode(Module, Type, Bytes) when is_binary(Bytes) -> - asn1rt:decode(Module, Type, Bytes); + Module:decode(Type, Bytes); wrapper_decode(Module, Type, Bytes) when is_list(Bytes) -> - asn1rt:decode(Module, Type, list_to_binary(Bytes)). + Module:decode(Type, list_to_binary(Bytes)). diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index cb97655c15..b7f0323301 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -19,8 +19,6 @@ %% %% -module(testPrimStrings). --compile([{nowarn_deprecated_function,{asn1rt,utf8_list_to_binary,1}}, - {nowarn_deprecated_function,{asn1rt,utf8_binary_to_list,1}}]). -export([bit_string/2]). -export([octet_string/1]). @@ -756,19 +754,21 @@ utf8_string(_Rules) -> 16#800, 16#ffff, 16#10000, - 16#1fffff, - 16#200000, - 16#3ffffff, - 16#4000000, - 16#7fffffff], + 16#1ffff, + 16#20000, + 16#2ffff, + 16#e0000, + 16#effff, + 16#F0000, + 16#10ffff], [begin - {ok,UTF8} = asn1rt:utf8_list_to_binary([Char]), - {ok,[Char]} = asn1rt:utf8_binary_to_list(UTF8), + UTF8 = unicode:characters_to_binary([Char]), + [Char] = unicode:characters_to_list([UTF8]), roundtrip('UTF', UTF8) end || Char <- AllRanges], - {ok,UTF8} = asn1rt:utf8_list_to_binary(AllRanges), - {ok,AllRanges} = asn1rt:utf8_binary_to_list(UTF8), + UTF8 = unicode:characters_to_binary(AllRanges), + AllRanges = unicode:characters_to_list(UTF8), roundtrip('UTF', UTF8), ok. diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml index 53ef41dd5b..ea9f956271 100644 --- a/lib/common_test/doc/src/ct.xml +++ b/lib/common_test/doc/src/ct.xml @@ -740,7 +740,7 @@ <v>Format = string()</v> <v>FormatArgs = list()</v> <v>Opts = [Opt]</v> - <v>Opt = no_css | esc_chars</v> + <v>Opt = {heading,string()} | no_css | esc_chars</v> </type> <desc><marker id="log-5"/> <p>Prints from a test case to the log file.</p> @@ -798,53 +798,71 @@ <func> <name>pal(Format) -> ok</name> - <fsummary>Equivalent to pal(default, 50, Format, []).</fsummary> + <fsummary>Equivalent to pal(default, 50, Format, [], []).</fsummary> <desc><marker id="pal-1"/> <p>Equivalent to - <seealso marker="#pal-4"><c>ct:pal(default, 50, Format, - [])</c></seealso>.</p> + <seealso marker="#pal-5"><c>ct:pal(default, 50, Format, + [], [])</c></seealso>.</p> </desc> </func> <func> <name>pal(X1, X2) -> ok</name> <fsummary>Equivalent to pal(Category, Importance, Format, - FormatArgs).</fsummary> + FormatArgs, []).</fsummary> <type> <v>X1 = Category | Importance | Format</v> <v>X2 = Format | FormatArgs</v> </type> <desc><marker id="pal-2"/> - <p>Equivalent to <seealso marker="#pal-4"><c>ct:pal(Category, - Importance, Format, FormatArgs)</c></seealso>.</p> + <p>Equivalent to <seealso marker="#pal-5"><c>ct:pal(Category, + Importance, Format, FormatArgs, [])</c></seealso>.</p> </desc> </func> <func> <name>pal(X1, X2, X3) -> ok</name> <fsummary>Equivalent to pal(Category, Importance, Format, - FormatArgs).</fsummary> + FormatArgs, Opts).</fsummary> <type> <v>X1 = Category | Importance</v> <v>X2 = Importance | Format</v> - <v>X3 = Format | FormatArgs</v> + <v>X3 = Format | FormatArgs | Opts</v> </type> <desc><marker id="pal-3"/> - <p>Equivalent to <seealso marker="#pal-4"><c>ct:pal(Category, - Importance, Format, FormatArgs)</c></seealso>.</p> + <p>Equivalent to <seealso marker="#pal-5"><c>ct:pal(Category, + Importance, Format, FormatArgs, Opts)</c></seealso>.</p> + </desc> + </func> + + <func> + <name>pal(X1, X2, X3, X4) -> ok</name> + <fsummary>Equivalent to pal(Category, Importance, Format, + FormatArgs, Opts).</fsummary> + <type> + <v>X1 = Category | Importance</v> + <v>X2 = Importance | Format</v> + <v>X3 = Format | FormatArgs</v> + <v>X4 = FormatArgs | Opts</v> + </type> + <desc><marker id="pal-4"/> + <p>Equivalent to <seealso marker="#pal-5"><c>ct:pal(Category, + Importance, Format, FormatArgs, Opts)</c></seealso>.</p> </desc> </func> <func> - <name>pal(Category, Importance, Format, FormatArgs) -> ok</name> + <name>pal(Category, Importance, Format, FormatArgs, Opts) -> ok</name> <fsummary>Prints and logs from a test case.</fsummary> <type> <v>Category = atom()</v> <v>Importance = integer()</v> <v>Format = string()</v> <v>FormatArgs = list()</v> + <v>Opts = [Opt]</v> + <v>Opt = {heading,string()} | no_css</v> </type> - <desc><marker id="pal-4"/> + <desc><marker id="pal-5"/> <p>Prints and logs from a test case.</p> <p>This function is meant for printing a string from a test case, @@ -888,52 +906,70 @@ <func> <name>print(Format) -> ok</name> - <fsummary>Equivalent to print(default, 50, Format, []).</fsummary> + <fsummary>Equivalent to print(default, 50, Format, [], []).</fsummary> <desc><marker id="print-1"/> - <p>Equivalent to <seealso marker="#print-4"><c>ct:print(default, - 50, Format, [])</c></seealso>.</p> + <p>Equivalent to <seealso marker="#print-5"><c>ct:print(default, + 50, Format, [], [])</c></seealso>.</p> </desc> </func> <func> <name>print(X1, X2) -> ok</name> <fsummary>Equivalent to print(Category, Importance, Format, - FormatArgs).</fsummary> + FormatArgs, []).</fsummary> <type> <v>X1 = Category | Importance | Format</v> <v>X2 = Format | FormatArgs</v> </type> <desc><marker id="print-2"/> - <p>Equivalent to <seealso marker="#print-4"><c>ct:print(Category, - Importance, Format, FormatArgs)</c></seealso>.</p> + <p>Equivalent to <seealso marker="#print-5"><c>ct:print(Category, + Importance, Format, FormatArgs, [])</c></seealso>.</p> </desc> </func> <func> <name>print(X1, X2, X3) -> ok</name> <fsummary>Equivalent to print(Category, Importance, Format, - FormatArgs).</fsummary> + FormatArgs, Opts).</fsummary> <type> <v>X1 = Category | Importance</v> <v>X2 = Importance | Format</v> - <v>X3 = Format | FormatArgs</v> + <v>X3 = Format | FormatArgs | Opts</v> </type> <desc><marker id="print-3"/> - <p>Equivalent to <seealso marker="#print-4"><c>ct:print(Category, - Importance, Format, FormatArgs)</c></seealso>.</p> + <p>Equivalent to <seealso marker="#print-5"><c>ct:print(Category, + Importance, Format, FormatArgs, Opts)</c></seealso>.</p> + </desc> + </func> + + <func> + <name>print(X1, X2, X3, X4) -> ok</name> + <fsummary>Equivalent to print(Category, Importance, Format, + FormatArgs, Opts).</fsummary> + <type> + <v>X1 = Category | Importance</v> + <v>X2 = Importance | Format</v> + <v>X3 = Format | FormatArgs</v> + <v>X4 = FormatArgs | Opts</v> + </type> + <desc><marker id="print-4"/> + <p>Equivalent to <seealso marker="#print-5"><c>ct:print(Category, + Importance, Format, FormatArgs, Opts)</c></seealso>.</p> </desc> </func> <func> - <name>print(Category, Importance, Format, FormatArgs) -> ok</name> + <name>print(Category, Importance, Format, FormatArgs, Opts) -> ok</name> <fsummary>Prints from a test case to the console.</fsummary> <type> <v>Category = atom()</v> <v>Importance = integer()</v> <v>Format = string()</v> <v>FormatArgs = list()</v> + <v>Opts = [Opt]</v> + <v>Opt = {heading,string()}</v> </type> - <desc><marker id="print-4"/> + <desc><marker id="print-5"/> <p>Prints from a test case to the console.</p> <p>This function is meant for printing a string from a test case to diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 7653670d30..83e6511c04 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,65 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.13</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Some types of printouts to screen during test runs + (including <c>ct:print/1,2,3,4</c>) used the local + <c>user</c> process as IO device and these printouts + would not be visible when e.g. running tests via a shell + on a remote node. A default Common Test group leader + process has been introduced to solve the problem. This + process routes printouts to the group leader of the + starting process, if available, otherwise to <c>user</c>.</p> + <p> + Own Id: OTP-13973 Aux Id: ERL-279 </p> + </item> + <item> + <p> + Some Common Test processes, that act as I/O group leaders + for test cases, would not terminate as expected at the + end of test runs. This error has been corrected.</p> + <p> + Own Id: OTP-14026 Aux Id: ERL-287 </p> + </item> + <item> + <p> + The logging verbosity feature was incorrectly documented. + The default verbosity levels for test runs is e.g. not 50 + (<c>?STD_VERBOSITY</c>), but 100 (<c>?MAX_VERBOSITY</c>). + Also, some of the examples had errors and flaws. The + corresponding chapter (5.18) in the User's Guide has been + updated.</p> + <p> + Own Id: OTP-14044 Aux Id: seq13223 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + A feature to let the user specify headings to log + printouts has been added. The heading is specified as + <c>{heading,string()}</c> in the <c>Opts</c> list + argument to <c>ct:pal/3,4,5</c>, <c>ct:print/3,4,5</c>, + or <c>ct:log/3,4,5</c>. If the heading option is omitted, + the category name, or <c>"User"</c>, is used as the + heading instead.</p> + <p> + Own Id: OTP-14043 Aux Id: seq13226 </p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.12.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 1d3fbb6f76..f70bdb16c5 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -986,15 +986,17 @@ <c>io:put_chars/1</c>, and so on.</p> <p><c>Importance</c> is compared to a verbosity level set by the - <c>verbosity</c> start flag/option. The verbosity level can be set per - category or generally, or both. The default verbosity level, - <c>?STD_VERBOSITY</c>, is 50, that is, all standard I/O gets printed. - If a lower verbosity level is set, standard I/O printouts are ignored. - <c>Common Test</c> performs the following test:</p> + <c>verbosity</c> start flag/option. The level can be set per + category or generally, or both. If <c>verbosity</c> is not set by the user, + a level of 100 (<c>?MAX_VERBOSITY</c> = all printouts visible) is used as + default value. <c>Common Test</c> performs the following test:</p> <pre> - Importance >= (100-VerbosityLevel)</pre> - <p>This also means that verbosity level 0 effectively turns all logging off - (except from printouts made by <c>Common Test</c> itself).</p> +Importance >= (100-VerbosityLevel)</pre> + <p>The constant <c>?STD_VERBOSITY</c> has value 50 (see <c>ct.hrl</c>). + At this level, all standard I/O gets printed. If a lower verbosity level + is set, standard I/O printouts are ignored. Verbosity level 0 effectively + turns all logging off (except from printouts made by <c>Common Test</c> + itself).</p> <p>The general verbosity level is not associated with any particular category. This level sets the threshold for the standard I/O printouts, @@ -1003,17 +1005,17 @@ <p><em>Examples:</em></p> <p>Some printouts during test case execution:</p> - <pre> + <pre> io:format("1. Standard IO, importance = ~w~n", [?STD_IMPORTANCE]), ct:log("2. Uncategorized, importance = ~w", [?STD_IMPORTANCE]), - ct:log(info, "3. Categorized info, importance = ~w", [?STD_IMPORTANCE]]), + ct:log(info, "3. Categorized info, importance = ~w", [?STD_IMPORTANCE]), ct:log(info, ?LOW_IMPORTANCE, "4. Categorized info, importance = ~w", [?LOW_IMPORTANCE]), - ct:log(error, "5. Categorized error, importance = ~w", [?HI_IMPORTANCE]), - ct:log(error, ?HI_IMPORTANCE, "6. Categorized error, importance = ~w", [?MAX_IMPORTANCE]),</pre> + ct:log(error, ?HI_IMPORTANCE, "5. Categorized error, importance = ~w", [?HI_IMPORTANCE]), + ct:log(error, ?MAX_IMPORTANCE, "6. Categorized error, importance = ~w", [?MAX_IMPORTANCE]),</pre> - <p>If starting the test without specifying any verbosity levels as follows:</p> + <p>If starting the test with a general verbosity level of 50 (<c>?STD_VERBOSITY</c>):</p> <pre> - $ ct_run ...</pre> + $ ct_run -verbosity 50</pre> <p>the following is printed:</p> <pre> 1. Standard IO, importance = 50 @@ -1031,10 +1033,22 @@ 4. Categorized info, importance = 25 6. Categorized error, importance = 99</pre> + <p>Note that the category argument is not required in order to only specify the + importance of a printout. Example:</p> + <pre> +<c>ct:pal(?LOW_IMPORTANCE, "Info report: ~p", [Info])</c></pre> + <p>Or perhaps in combination with constants:</p> + <pre> +-define(INFO, ?LOW_IMPORTANCE). +-define(ERROR, ?HI_IMPORTANCE). + +ct:log(?INFO, "Info report: ~p", [Info]) +ct:pal(?ERROR, "Error report: ~p", [Error])</pre> + <p>The functions <seealso marker="ct#set_verbosity-2"><c>ct:set_verbosity/2</c></seealso> and <seealso marker="ct#get_verbosity-1"><c>ct:get_verbosity/1</c></seealso> may be used to modify and read verbosity levels during test execution.</p> - + <p>The arguments <c>Format</c> and <c>FormatArgs</c> in <c>ct:log/print/pal</c> are always passed on to the STDLIB function <c>io:format/3</c> (For details, see the <seealso marker="stdlib:io"><c>io</c></seealso> manual page).</p> diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 77588af59b..dfa321c901 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -22,6 +22,7 @@ {vsn, "%VSN%"}, {modules, [ct_cover, ct, + ct_default_gl, ct_event, ct_framework, ct_ftp, diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index f9f845e1a9..43abb91819 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -66,8 +66,8 @@ reload_config/1, escape_chars/1, escape_chars/2, log/1, log/2, log/3, log/4, log/5, - print/1, print/2, print/3, print/4, - pal/1, pal/2, pal/3, pal/4, + print/1, print/2, print/3, print/4, print/5, + pal/1, pal/2, pal/3, pal/4, pal/5, set_verbosity/2, get_verbosity/1, capture_start/0, capture_stop/0, capture_get/0, capture_get/1, fail/1, fail/2, comment/1, comment/2, make_priv_dir/0, @@ -592,7 +592,7 @@ log(X1,X2,X3,X4) -> %%% Format = string() %%% Args = list() %%% Opts = [Opt] -%%% Opt = esc_chars | no_css +%%% Opt = {heading,string()} | esc_chars | no_css %%% %%% @doc Printout from a test case to the log file. %%% @@ -610,43 +610,61 @@ log(Category,Importance,Format,Args,Opts) -> %%%----------------------------------------------------------------- %%% @spec print(Format) -> ok -%%% @equiv print(default,50,Format,[]) +%%% @equiv print(default,50,Format,[],[]) print(Format) -> - print(default,?STD_IMPORTANCE,Format,[]). + print(default,?STD_IMPORTANCE,Format,[],[]). %%%----------------------------------------------------------------- %%% @spec print(X1,X2) -> ok %%% X1 = Category | Importance | Format %%% X2 = Format | Args -%%% @equiv print(Category,Importance,Format,Args) +%%% @equiv print(Category,Importance,Format,Args,[]) print(X1,X2) -> {Category,Importance,Format,Args} = if is_atom(X1) -> {X1,?STD_IMPORTANCE,X2,[]}; is_integer(X1) -> {default,X1,X2,[]}; is_list(X1) -> {default,?STD_IMPORTANCE,X1,X2} end, - print(Category,Importance,Format,Args). + print(Category,Importance,Format,Args,[]). %%%----------------------------------------------------------------- %%% @spec print(X1,X2,X3) -> ok +%%% X1 = Category | Importance | Format +%%% X2 = Importance | Format | Args +%%% X3 = Format | Args | Opts +%%% @equiv print(Category,Importance,Format,Args,Opts) +print(X1,X2,X3) -> + {Category,Importance,Format,Args,Opts} = + if is_atom(X1), is_integer(X2) -> {X1,X2,X3,[],[]}; + is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3,[]}; + is_integer(X1) -> {default,X1,X2,X3,[]}; + is_list(X1), is_list(X2) -> {default,?STD_IMPORTANCE,X1,X2,X3} + end, + print(Category,Importance,Format,Args,Opts). + +%%%----------------------------------------------------------------- +%%% @spec print(X1,X2,X3,X4) -> ok %%% X1 = Category | Importance %%% X2 = Importance | Format %%% X3 = Format | Args -%%% @equiv print(Category,Importance,Format,Args) -print(X1,X2,X3) -> - {Category,Importance,Format,Args} = - if is_atom(X1), is_integer(X2) -> {X1,X2,X3,[]}; - is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3}; - is_integer(X1) -> {default,X1,X2,X3} +%%% X4 = Args | Opts +%%% @equiv print(Category,Importance,Format,Args,Opts) +print(X1,X2,X3,X4) -> + {Category,Importance,Format,Args,Opts} = + if is_atom(X1), is_integer(X2) -> {X1,X2,X3,X4,[]}; + is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3,X4}; + is_integer(X1) -> {default,X1,X2,X3,X4} end, - print(Category,Importance,Format,Args). + print(Category,Importance,Format,Args,Opts). %%%----------------------------------------------------------------- -%%% @spec print(Category,Importance,Format,Args) -> ok +%%% @spec print(Category,Importance,Format,Args,Opts) -> ok %%% Category = atom() %%% Importance = integer() %%% Format = string() %%% Args = list() +%%% Opts = [Opt] +%%% Opt = {heading,string()} %%% %%% @doc Printout from a test case to the console. %%% @@ -658,13 +676,13 @@ print(X1,X2,X3) -> %%% and default value for <c>Args</c> is <c>[]</c>.</p> %%% <p>Please see the User's Guide for details on <c>Category</c> %%% and <c>Importance</c>.</p> -print(Category,Importance,Format,Args) -> - ct_logs:tc_print(Category,Importance,Format,Args). +print(Category,Importance,Format,Args,Opts) -> + ct_logs:tc_print(Category,Importance,Format,Args,Opts). %%%----------------------------------------------------------------- %%% @spec pal(Format) -> ok -%%% @equiv pal(default,50,Format,[]) +%%% @equiv pal(default,50,Format,[],[]) pal(Format) -> pal(default,?STD_IMPORTANCE,Format,[]). @@ -672,35 +690,53 @@ pal(Format) -> %%% @spec pal(X1,X2) -> ok %%% X1 = Category | Importance | Format %%% X2 = Format | Args -%%% @equiv pal(Category,Importance,Format,Args) +%%% @equiv pal(Category,Importance,Format,Args,[]) pal(X1,X2) -> {Category,Importance,Format,Args} = if is_atom(X1) -> {X1,?STD_IMPORTANCE,X2,[]}; is_integer(X1) -> {default,X1,X2,[]}; is_list(X1) -> {default,?STD_IMPORTANCE,X1,X2} end, - pal(Category,Importance,Format,Args). + pal(Category,Importance,Format,Args,[]). %%%----------------------------------------------------------------- %%% @spec pal(X1,X2,X3) -> ok +%%% X1 = Category | Importance | Format +%%% X2 = Importance | Format | Args +%%% X3 = Format | Args | Opts +%%% @equiv pal(Category,Importance,Format,Args,Opts) +pal(X1,X2,X3) -> + {Category,Importance,Format,Args,Opts} = + if is_atom(X1), is_integer(X2) -> {X1,X2,X3,[],[]}; + is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3,[]}; + is_integer(X1) -> {default,X1,X2,X3,[]}; + is_list(X1), is_list(X2) -> {default,?STD_IMPORTANCE,X1,X2,X3} + end, + pal(Category,Importance,Format,Args,Opts). + +%%%----------------------------------------------------------------- +%%% @spec pal(X1,X2,X3,X4) -> ok %%% X1 = Category | Importance %%% X2 = Importance | Format %%% X3 = Format | Args -%%% @equiv pal(Category,Importance,Format,Args) -pal(X1,X2,X3) -> - {Category,Importance,Format,Args} = - if is_atom(X1), is_integer(X2) -> {X1,X2,X3,[]}; - is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3}; - is_integer(X1) -> {default,X1,X2,X3} +%%% X4 = Args | Opts +%%% @equiv pal(Category,Importance,Format,Args,Opts) +pal(X1,X2,X3,X4) -> + {Category,Importance,Format,Args,Opts} = + if is_atom(X1), is_integer(X2) -> {X1,X2,X3,X4,[]}; + is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3,X4}; + is_integer(X1) -> {default,X1,X2,X3,X4} end, - pal(Category,Importance,Format,Args). + pal(Category,Importance,Format,Args,Opts). %%%----------------------------------------------------------------- -%%% @spec pal(Category,Importance,Format,Args) -> ok +%%% @spec pal(Category,Importance,Format,Args,Opts) -> ok %%% Category = atom() %%% Importance = integer() %%% Format = string() %%% Args = list() +%%% Opts = [Opt] +%%% Opt = {heading,string()} | no_css %%% %%% @doc Print and log from a test case. %%% @@ -712,8 +748,8 @@ pal(X1,X2,X3) -> %%% and default value for <c>Args</c> is <c>[]</c>.</p> %%% <p>Please see the User's Guide for details on <c>Category</c> %%% and <c>Importance</c>.</p> -pal(Category,Importance,Format,Args) -> - ct_logs:tc_pal(Category,Importance,Format,Args). +pal(Category,Importance,Format,Args,Opts) -> + ct_logs:tc_pal(Category,Importance,Format,Args,Opts). %%%----------------------------------------------------------------- %%% @spec set_verbosity(Category, Level) -> ok diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 0daed60dba..09ad709da5 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -45,8 +45,8 @@ %% Logging stuff directly from testcase -export([tc_log/3, tc_log/4, tc_log/5, tc_log/6, tc_log_async/3, tc_log_async/5, - tc_print/3, tc_print/4, - tc_pal/3, tc_pal/4, ct_log/3, + tc_print/3, tc_print/4, tc_print/5, + tc_pal/3, tc_pal/4, tc_pal/5, ct_log/3, basic_html/0]). %% Simulate logger process for use without ct environment running @@ -447,10 +447,10 @@ tc_log(Category,Importance,Format,Args,Opts) -> tc_log(Category,Importance,"User",Format,Args,Opts). %%%----------------------------------------------------------------- -%%% @spec tc_log(Category,Importance,Printer,Format,Args,Opts) -> ok +%%% @spec tc_log(Category,Importance,Heading,Format,Args,Opts) -> ok %%% Category = atom() %%% Importance = integer() -%%% Printer = string() +%%% Heading = string() %%% Format = string() %%% Args = list() %%% Opts = list() @@ -460,13 +460,18 @@ tc_log(Category,Importance,Format,Args,Opts) -> %%% <p>This function is called by <code>ct</code> when logging %%% stuff directly from a testcase (i.e. not from within the CT %%% framework).</p> -tc_log(Category,Importance,Printer,Format,Args,Opts) -> +tc_log(Category,Importance,Heading,Format,Args,Opts) -> Data = case lists:member(no_css, Opts) of true -> [{Format,Args}]; false -> - [{hd,div_header(Category,Printer),[]}, + Heading1 = + case proplists:get_value(heading, Opts) of + undefined -> Heading; + Str -> Str + end, + [{hd,div_header(Category,Heading1),[]}, {Format,Args}, {ft,div_footer(),[]}] end, @@ -484,7 +489,7 @@ tc_log_async(Category,Format,Args) -> %%% @spec tc_log_async(Category,Importance,Format,Args) -> ok %%% Category = atom() %%% Importance = integer() -%%% Printer = string() +%%% Heading = string() %%% Format = string() %%% Args = list() %%% @@ -495,31 +500,38 @@ tc_log_async(Category,Format,Args) -> %%% to avoid deadlocks when e.g. the hook that handles SASL printouts %%% prints to the test case log file at the same time test server %%% asks ct_logs for an html wrapper.</p> -tc_log_async(Category,Importance,Printer,Format,Args) -> +tc_log_async(Category,Importance,Heading,Format,Args) -> cast({log,async,self(),group_leader(),Category,Importance, - [{hd,div_header(Category,Printer),[]}, + [{hd,div_header(Category,Heading),[]}, {Format,Args}, {ft,div_footer(),[]}], true}), ok. %%%----------------------------------------------------------------- %%% @spec tc_print(Category,Format,Args) -%%% @equiv tc_print(Category,?STD_IMPORTANCE,Format,Args) +%%% @equiv tc_print(Category,?STD_IMPORTANCE,Format,Args,[]) tc_print(Category,Format,Args) -> - tc_print(Category,?STD_IMPORTANCE,Format,Args). + tc_print(Category,?STD_IMPORTANCE,Format,Args,[]). + +%%%----------------------------------------------------------------- +%%% @spec tc_print(Category,Importance,Format,Args) +%%% @equiv tc_print(Category,Importance,Format,Args,[]) +tc_print(Category,Importance,Format,Args) -> + tc_print(Category,Importance,Format,Args,[]). %%%----------------------------------------------------------------- -%%% @spec tc_print(Category,Importance,Format,Args) -> ok +%%% @spec tc_print(Category,Importance,Format,Args,Opts) -> ok %%% Category = atom() %%% Importance = integer() %%% Format = string() %%% Args = list() +%%% Opts = list() %%% %%% @doc Console printout from a testcase. %%% %%% <p>This function is called by <code>ct</code> when printing %%% stuff from a testcase on the user console.</p> -tc_print(Category,Importance,Format,Args) -> +tc_print(Category,Importance,Format,Args,Opts) -> VLvl = case ct_util:get_verbosity(Category) of undefined -> ct_util:get_verbosity('$unspecified'); @@ -531,7 +543,12 @@ tc_print(Category,Importance,Format,Args) -> Val end, if Importance >= (100-VLvl) -> - Str = lists:concat([get_heading(Category),Format,"\n\n"]), + Heading = + case proplists:get_value(heading, Opts) of + undefined -> atom_to_list(Category); + Hd -> Hd + end, + Str = lists:concat([get_header(Heading),Format,"\n\n"]), try io:format(?def_gl, Str, Args) catch @@ -543,43 +560,44 @@ tc_print(Category,Importance,Format,Args) -> ok end. -get_heading(default) -> +get_header("default") -> io_lib:format("\n-----------------------------" "-----------------------\n~s\n", [log_timestamp(?now)]); -get_heading(Category) -> +get_header(Heading) -> io_lib:format("\n-----------------------------" - "-----------------------\n~s ~w\n", - [log_timestamp(?now),Category]). + "-----------------------\n~s ~s\n", + [Heading,log_timestamp(?now)]). %%%----------------------------------------------------------------- %%% @spec tc_pal(Category,Format,Args) -> ok -%%% @equiv tc_pal(Category,?STD_IMPORTANCE,Format,Args) -> ok +%%% @equiv tc_pal(Category,?STD_IMPORTANCE,Format,Args,[]) -> ok tc_pal(Category,Format,Args) -> - tc_pal(Category,?STD_IMPORTANCE,Format,Args). + tc_pal(Category,?STD_IMPORTANCE,Format,Args,[]). %%%----------------------------------------------------------------- %%% @spec tc_pal(Category,Importance,Format,Args) -> ok +%%% @equiv tc_pal(Category,Importance,Format,Args,[]) -> ok +tc_pal(Category,Importance,Format,Args) -> + tc_pal(Category,Importance,Format,Args,[]). + +%%%----------------------------------------------------------------- +%%% @spec tc_pal(Category,Importance,Format,Args,Opts) -> ok %%% Category = atom() %%% Importance = integer() %%% Format = string() %%% Args = list() +%%% Opts = list() %%% %%% @doc Print and log from a testcase. %%% %%% <p>This function is called by <code>ct</code> when logging %%% stuff directly from a testcase. The info is written both in the %%% log and on the console.</p> -tc_pal(Category,Importance,Format,Args) -> - tc_print(Category,Importance,Format,Args), - cast({log,sync,self(),group_leader(),Category,Importance, - [{hd,div_header(Category),[]}, - {Format,Args}, - {ft,div_footer(),[]}], - true}), - ok. - +tc_pal(Category,Importance,Format,Args,Opts) -> + tc_print(Category,Importance,Format,Args,Opts), + tc_log(Category,Importance,"User",Format,Args,[esc_chars|Opts]). %%%----------------------------------------------------------------- %%% @spec ct_log(Category,Format,Args) -> ok @@ -608,9 +626,9 @@ int_footer() -> div_header(Class) -> div_header(Class,"User"). -div_header(Class,Printer) -> +div_header(Class,Heading) -> "\n</pre>\n<div class=\"" ++ atom_to_list(Class) ++ "\"><pre><b>*** " - ++ Printer ++ " " ++ log_timestamp(?now) ++ " ***</b>". + ++ Heading ++ " " ++ log_timestamp(?now) ++ " ***</b>". div_footer() -> "</pre></div>\n<pre>". diff --git a/lib/common_test/src/ct_snmp.erl b/lib/common_test/src/ct_snmp.erl index 2c59b19196..5844909d17 100644 --- a/lib/common_test/src/ct_snmp.erl +++ b/lib/common_test/src/ct_snmp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 34d27ed5f4..bff1112ab9 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2015. All Rights Reserved. +%% Copyright Ericsson AB 2003-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. diff --git a/lib/common_test/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl index 7d6fe64b92..4845b86dd3 100644 --- a/lib/common_test/src/test_server_gl.erl +++ b/lib/common_test/src/test_server_gl.erl @@ -24,7 +24,7 @@ %% through the test_server_io module/process. -module(test_server_gl). --export([start_link/0,stop/1,set_minor_fd/3,unset_minor_fd/1, +-export([start_link/1,stop/1,set_minor_fd/3,unset_minor_fd/1, get_tc_supervisor/1,print/4,set_props/2]). -export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]). @@ -33,6 +33,7 @@ tc :: mfa() | 'undefined', %Current test case MFA minor :: 'none'|pid(), %Minor fd minor_monitor, %Monitor ref for minor fd + tsio_monitor, %Monitor red for controlling proc capture :: 'none'|pid(), %Capture output reject_io :: boolean(), %Reject I/O requests... permit_io, %... and exceptions @@ -45,8 +46,8 @@ %% Start a new group leader process. Only to be called by %% the test_server_io process. -start_link() -> - case gen_server:start_link(?MODULE, [], []) of +start_link(TSIO) -> + case gen_server:start_link(?MODULE, [TSIO], []) of {ok,Pid} -> {ok,Pid}; Other -> @@ -130,14 +131,16 @@ set_props(GL, PropList) -> %%% Internal functions. -init([]) -> +init([TSIO]) -> EscChars = case application:get_env(test_server, esc_chars) of {ok,ECBool} -> ECBool; _ -> true end, + Ref = erlang:monitor(process, TSIO), {ok,#st{tc_supervisor=none, minor=none, minor_monitor=none, + tsio_monitor=Ref, capture=none, reject_io=false, permit_io=gb_sets:empty(), @@ -176,6 +179,9 @@ handle_info({'DOWN',Ref,process,_,Reason}=D, #st{minor_monitor=Ref}=St) -> test_server_io:print_unexpected(Data) end, {noreply,St#st{minor=none,minor_monitor=none}}; +handle_info({'DOWN',Ref,process,_,_}, #st{tsio_monitor=Ref}=St) -> + %% controlling process (test_server_io) terminated, we're done + {stop,normal,St}; handle_info({permit_io,Pid}, #st{permit_io=P}=St) -> {noreply,St#st{permit_io=gb_sets:add(Pid, P)}}; handle_info({capture,Cap0}, St) -> diff --git a/lib/common_test/src/test_server_io.erl b/lib/common_test/src/test_server_io.erl index 3d5238052b..fdabf17b08 100644 --- a/lib/common_test/src/test_server_io.erl +++ b/lib/common_test/src/test_server_io.erl @@ -185,7 +185,7 @@ reset_state() -> init([]) -> process_flag(trap_exit, true), Empty = gb_trees:empty(), - {ok,Shared} = test_server_gl:start_link(), + {ok,Shared} = test_server_gl:start_link(self()), {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), io_buffering=gb_sets:empty(), buffered=Empty, @@ -200,7 +200,7 @@ req(Req) -> gen_server:call(?MODULE, Req, infinity). handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) -> - {ok,Pid} = test_server_gl:start_link(), + {ok,Pid} = test_server_gl:start_link(self()), test_server_gl:set_props(Pid, Props), {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}}; handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) -> @@ -285,7 +285,7 @@ handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls, ok end, Empty = gb_trees:empty(), - {ok,Shared} = test_server_gl:start_link(), + {ok,Shared} = test_server_gl:start_link(self()), {reply,ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), io_buffering=gb_sets:empty(), buffered=Empty, diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index 4897ddb2f8..0f29b2dbb2 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -53,8 +53,6 @@ %%% @see ct_telnet -module(unix_telnet). --compile(export_all). - %% Callbacks for ct_telnet.erl -export([connect/7,get_prompt_regexp/0]). -import(ct_telnet,[start_gen_log/1,log/4,end_gen_log/0]). diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index b1eddfedd7..2f0fc2e05a 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -70,7 +70,8 @@ MODULES= \ test_server_SUITE \ test_server_test_lib \ ct_release_test_SUITE \ - ct_log_SUITE + ct_log_SUITE \ + ct_SUITE ERL_FILES= $(MODULES:%=%.erl) HRL_FILES= test_server_test_lib.hrl diff --git a/lib/common_test/test/ct_SUITE.erl b/lib/common_test/test/ct_SUITE.erl new file mode 100644 index 0000000000..eb98c2544f --- /dev/null +++ b/lib/common_test/test/ct_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-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% +%% +-module(ct_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{timetrap,{seconds,30}}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [app_file, appup_file]. + +%%%----------------------------------------------------------------- +%%% Test cases + +app_file(_Config) -> + ok = test_server:app_test(common_test), + ok. + +appup_file(_Config) -> + ok = test_server:appup_test(common_test). + diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 690d0af1bb..bc716fb5e3 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -70,20 +70,20 @@ suite() -> all() -> all(suite). -all(suite) -> +all(suite) -> lists:reverse( [ one_cth, two_cth, faulty_cth_no_init, faulty_cth_id_no_init, faulty_cth_exit_in_init, faulty_cth_exit_in_id, - faulty_cth_exit_in_init_scope_suite, minimal_cth, - minimal_and_maximal_cth, faulty_cth_undef, + faulty_cth_exit_in_init_scope_suite, minimal_cth, + minimal_and_maximal_cth, faulty_cth_undef, scope_per_suite_cth, scope_per_group_cth, scope_suite_cth, - scope_per_suite_state_cth, scope_per_group_state_cth, + scope_per_suite_state_cth, scope_per_group_state_cth, scope_suite_state_cth, fail_pre_suite_cth, double_fail_pre_suite_cth, fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth, skip_post_suite_cth, recover_post_suite_cth, update_config_cth, - state_update_cth, options_cth, same_id_cth, + state_update_cth, options_cth, same_id_cth, fail_n_skip_with_minimal_cth, prio_cth, no_config, data_dir, cth_log ] @@ -96,10 +96,10 @@ all(suite) -> %%%----------------------------------------------------------------- %%% -one_cth(Config) when is_list(Config) -> +one_cth(Config) when is_list(Config) -> do_test(one_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth], Config). -two_cth(Config) when is_list(Config) -> +two_cth(Config) when is_list(Config) -> do_test(two_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth,empty_cth], Config). @@ -119,13 +119,13 @@ minimal_cth(Config) when is_list(Config) -> minimal_and_maximal_cth(Config) when is_list(Config) -> do_test(minimal_and_maximal_cth, "ct_cth_empty_SUITE.erl", [minimal_cth, empty_cth],Config). - + faulty_cth_undef(Config) when is_list(Config) -> do_test(faulty_cth_undef, "ct_cth_empty_SUITE.erl", [undef_cth],Config). faulty_cth_exit_in_init_scope_suite(Config) when is_list(Config) -> - do_test(faulty_cth_exit_in_init_scope_suite, + do_test(faulty_cth_exit_in_init_scope_suite, "ct_exit_in_init_scope_suite_cth_SUITE.erl", [],Config). @@ -205,7 +205,7 @@ state_update_cth(Config) when is_list(Config) -> options_cth(Config) when is_list(Config) -> do_test(options_cth, "ct_cth_empty_SUITE.erl", [{empty_cth,[test]}],Config). - + same_id_cth(Config) when is_list(Config) -> do_test(same_id_cth, "ct_cth_empty_SUITE.erl", [same_id_cth,same_id_cth],Config). @@ -227,9 +227,10 @@ data_dir(Config) when is_list(Config) -> do_test(data_dir, "ct_data_dir_SUITE.erl", [verify_data_dir_cth],Config). -cth_log(Config) when is_list(Config) -> +cth_log(Config) when is_list(Config) -> %% test that cth_log_redirect writes properly to %% unexpected I/O log + ct:timetrap({minutes,10}), StartOpts = do_test(cth_log, "cth_log_SUITE.erl", [], Config), Logdir = proplists:get_value(logdir, StartOpts), UnexpIoLogs = @@ -266,7 +267,6 @@ do_test(Tag, SWC, CTHs, Config, Res) -> do_test(Tag, SWC, CTHs, Config, Res, 2). do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> - DataDir = ?config(data_dir, Config), Suites = filelib:wildcard( filename:join([DataDir,"cth/tests",SuiteWildCard])), @@ -275,7 +275,7 @@ do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> Res = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), - ct_test_support:log_events(Tag, + ct_test_support:log_events(Tag, reformat(Events, ?eh), ?config(priv_dir, Config), Opts), @@ -328,7 +328,7 @@ test_events(one_empty_cth) -> {?eh,cth,{empty_cth,pre_end_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, [ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -360,7 +360,7 @@ test_events(two_empty_cth) -> {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -402,7 +402,7 @@ test_events(minimal_cth) -> {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -426,7 +426,7 @@ test_events(minimal_and_maximal_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_cth_empty_SUITE,'$proplist','_',[]]}}, @@ -452,11 +452,11 @@ test_events(faulty_cth_undef) -> {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed, FailReason}}}, {?eh,cth,{'_',on_tc_skip,'_'}}, - + {?eh,tc_auto_skip,{ct_cth_empty_SUITE,end_per_suite, {failed, FailReason}}}, {?eh,cth,{'_',on_tc_skip,'_'}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -515,7 +515,7 @@ test_events(scope_per_suite_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_suite_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_suite_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_scope_per_suite_cth_SUITE,'$proplist',[]]}}, @@ -541,7 +541,7 @@ test_events(scope_suite_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_suite_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_suite_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist','_',[]]}}, @@ -563,18 +563,18 @@ test_events(scope_per_group_cth) -> {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},ok}}], - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -595,7 +595,7 @@ test_events(scope_per_suite_state_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_scope_per_suite_state_cth_SUITE,'$proplist',[test]]}}, @@ -621,7 +621,7 @@ test_events(scope_suite_state_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_suite_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist','_',[test]]}}, @@ -643,18 +643,18 @@ test_events(scope_per_group_state_cth) -> {?eh,cth,{'_',init,['_',[test]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[test]]}}, {?eh,cth,{'_',terminate,[[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]},ok}}], - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -666,7 +666,7 @@ test_events(fail_pre_suite_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist', @@ -676,7 +676,7 @@ test_events(fail_pre_suite_cth) -> {?eh,cth,{'_',on_tc_fail, [init_per_suite,{failed,"Test failure"},[]]}}, - + {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, @@ -685,7 +685,7 @@ test_events(fail_pre_suite_cth) -> {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, - + {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, @@ -694,7 +694,7 @@ test_events(fail_pre_suite_cth) -> {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth, {'_',terminate,[[]]}}, {?eh,stop_logging,[]} @@ -733,7 +733,7 @@ test_events(fail_post_suite_cth) -> {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_auto_skip,'_'},[]]}}, - + {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, @@ -758,7 +758,7 @@ test_events(skip_pre_suite_cth) -> {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, - + {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -772,18 +772,18 @@ test_events(skip_pre_end_cth) -> {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,init_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,init_per_suite,ok}}, - + [{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, @@ -808,7 +808,7 @@ test_events(skip_post_suite_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, @@ -818,9 +818,9 @@ test_events(skip_post_suite_cth) -> {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, - + {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,stop_logging,[]} @@ -844,7 +844,7 @@ test_events(recover_post_suite_cth) -> {?eh,cth,{'_',post_end_per_testcase, [test_case, contains([tc_status]),'_',[]]}}, {?eh,tc_done,{Suite,test_case,ok}}, - + {?eh,tc_start,{Suite,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [Suite,not_contains([tc_status]),[]]}}, @@ -861,7 +861,7 @@ test_events(update_config_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_update_config_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite, [ct_update_config_SUITE,contains([]),[]]}}, @@ -941,7 +941,7 @@ test_events(update_config_cth) -> pre_init_per_suite]), ok,[]]}}, {?eh,tc_done,{ct_update_config_SUITE,{end_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_update_config_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_update_config_SUITE,contains( @@ -974,7 +974,7 @@ test_events(state_update_cth) -> {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{'_',init_per_suite}}, - + {?eh,tc_done,{'_',end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[contains( @@ -1021,7 +1021,7 @@ test_events(options_cth) -> {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[test]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, [ct_cth_empty_SUITE,'$proplist',[test]]}}, @@ -1058,7 +1058,7 @@ test_events(same_id_cth) -> {negative, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {negative, @@ -1115,17 +1115,14 @@ test_events(fail_n_skip_with_minimal_cth) -> ]; test_events(prio_cth) -> - GenPre = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_',State]}} || - State <- States] + [{?eh,cth,{'_',Func,['_','_',State]}} || State <- States] end, GenPost = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_','_',State]}} || - State <- States] + [{?eh,cth,{'_',Func,['_','_','_',State]}} || State <- States] end, - + [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++ @@ -1136,7 +1133,7 @@ test_events(prio_cth) -> [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], [1200,1050],[1100],[1200]]) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,init_per_suite,ok}}, - + [{?eh,tc_start,{ct_cth_prio_SUITE,{init_per_group,'_',[]}}}] ++ GenPre(pre_init_per_group, @@ -1147,7 +1144,7 @@ test_events(prio_cth) -> [900],[900,900],[500,900],[1000],[1200,1050], [1100],[1200]]) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,{init_per_group,'_',[]},ok}}] ++ - + [{?eh,tc_start,{ct_cth_prio_SUITE,test_case}}] ++ GenPre(pre_init_per_testcase, [[1100,100],[600,200],[600,600],[600],[700],[800], @@ -1161,7 +1158,7 @@ test_events(prio_cth) -> [{?eh,tc_done,{ct_cth_prio_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_prio_SUITE,{end_per_group,'_',[]}}}] ++ - GenPre(pre_end_per_group, + GenPre(pre_end_per_group, lists:reverse( [[1100,100],[600,200],[600,600],[600],[700],[800], [900],[900,900],[500,900],[1000],[1200,1050], @@ -1300,7 +1297,7 @@ test_events(cth_log) -> [{suite,cth_log_SUITE},parallel]}}}, {?eh,tc_done,{ct_framework,{end_per_group,g1, [{suite,cth_log_SUITE},parallel]},ok}}]}, - + {?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} @@ -1309,7 +1306,6 @@ test_events(cth_log) -> test_events(ok) -> ok. - %% test events help functions contains(List) -> fun(Proplist) when is_list(Proplist) -> diff --git a/lib/common_test/test/ct_log_SUITE.erl b/lib/common_test/test/ct_log_SUITE.erl index 9bdd44cbdf..93affda398 100644 --- a/lib/common_test/test/ct_log_SUITE.erl +++ b/lib/common_test/test/ct_log_SUITE.erl @@ -86,18 +86,7 @@ print(Config) -> io:format("5. Printing a pid: ~w~n", [Pid]), io:format("6. Printing HTML: <pre>~s</pre>~n", [String]), - %% --- API --- - %% pal(Format) -> - %% = ct:pal(default, 50, Format, []). - %% pal(X1, X2) -> ok - %% X1 = Category | Importance | Format - %% X2 = Format | FormatArgs - %% pal(X1, X2, X3) -> ok - %% X1 = Category | Importance - %% X2 = Importance | Format - %% X3 = Format | FormatArgs - %% pal(Category, Importance, Format, FormatArgs) -> ok - %% ------ + %% ct:pal ct:pal("1. Printing nothing"), ct:pal("2. Printing nothing", []), ct:pal("3. Printing a string: ~s", [String]), @@ -111,23 +100,16 @@ print(Config) -> ct:pal(50, "11. Printing with ~s", ["importance"]), ct:pal(ct_internal, 50, "12. Printing with ~s", ["category and importance"]), - %% --- API --- - %% log(Format) -> ok - %% = ct:log(default, 50, Format, [], []). - %% log(X1, X2) -> ok - %% X1 = Category | Importance | Format - %% X2 = Format | FormatArgs - %% log(X1, X2, X3) -> ok - %% X1 = Category | Importance - %% X2 = Importance | Format - %% X3 = Format | FormatArgs | Opts - %% log(X1, X2, X3, X4) -> ok - %% X1 = Category | Importance - %% X2 = Importance | Format - %% X3 = Format | FormatArgs - %% X4 = FormatArgs | Opts - %% log(Category, Importance, Format, FormatArgs, Opts) -> ok - %% ------ + ct:pal("13. Printing with heading", [], + [{heading,"This is a heading"}]), + ct:pal(ct_internal, "14. Printing with category and heading", [], + [{heading,"This is a heading"}]), + ct:pal(50, "15. Printing with importance and heading", [], + [{heading,"This is a heading"}]), + ct:pal(ct_internal, 50, "16. Printing with category, importance and heading", [], + [{heading,"This is a heading"}]), + + %% ct:log ct:log("1. Printing nothing"), ct:log("2. Printing nothing", []), ct:log("3. Printing a string: ~s", [String]), @@ -153,8 +135,37 @@ print(Config) -> ct:log(ct_internal, 50, "21. Printing a pid escaped with ~s, no_css: ~w", ["category and importance",Pid], [esc_chars,no_css]), + ct:log("22. Printing with heading", [], + [{heading,"This is a heading"}]), + ct:log(ct_internal, "23. Printing with category and heading", [], + [{heading,"This is a heading"}]), + ct:log(50, "24. Printing with importance and heading", [], + [{heading,"This is a heading"}]), + ct:log(ct_internal, 50, "25. Printing with category, importance and heading", [], + [{heading,"This is a heading"}]), + %% END mark ct:log("LOGGING END", [], [no_css]), + + + %% ct:print + ct:print("1. Does this show??"), + ct:print("2. Does this ~s", ["show??"]), + ct:print("3. Is this a non-html pid?? ~w", [self()]), + ct:print(ct_internal, "4. Printing with category"), + ct:print(ct_internal, "5. Printing with ~s", ["category"]), + ct:print(50, "6. Printing with importance"), + ct:print(50, "7. Printing with ~s", ["importance"]), + ct:print(ct_internal, 50, "8. Printing with ~s", ["category and importance"]), + ct:print("9. Printing with heading", [], + [{heading,"This is a heading"}]), + ct:print(ct_internal, "10. Printing with category and heading", [], + [{heading,"This is a heading"}]), + ct:print(50, "11. Printing with importance and heading", [], + [{heading,"This is a heading"}]), + ct:print(ct_internal, 50, "12. Printing with category, importance and heading", [], + [{heading,"This is a heading"}]), + {save_config,[{the_logfile,TcLogFile},{the_pid,Pid},{the_string,String}]}. @@ -169,6 +180,8 @@ verify(Config) -> {ok,Dev} = file:open(TcLogFile, [read]), ok = read_until(Dev, "LOGGING START\n"), + ct:pal("VERIFYING LOG ENTRIES...", []), + %% io:format match_line(Dev, "1. Printing nothing", []), read_nl(Dev), @@ -182,6 +195,7 @@ verify(Config) -> read_nl(Dev), match_line(Dev, "6. Printing HTML: <pre>~s</pre>", [String]), read_nl(Dev), + %% ct:pal read_header(Dev), match_line(Dev, "1. Printing nothing", []), @@ -219,6 +233,19 @@ verify(Config) -> read_header(Dev, "\"ct_internal\""), match_line(Dev, "12. Printing with ~s", ["category and importance"]), read_footer(Dev), + read_header(Dev, "\"default\"", "This is a heading"), + match_line(Dev, "13. Printing with heading", []), + read_footer(Dev), + read_header(Dev, "\"ct_internal\"", "This is a heading"), + match_line(Dev, "14. Printing with category and heading", []), + read_footer(Dev), + read_header(Dev, "\"default\"", "This is a heading"), + match_line(Dev, "15. Printing with importance and heading", []), + read_footer(Dev), + read_header(Dev, "\"ct_internal\"", "This is a heading"), + match_line(Dev, "16. Printing with category, importance and heading", []), + read_footer(Dev), + %% ct:log read_header(Dev), match_line(Dev, "1. Printing nothing", []), @@ -275,7 +302,18 @@ verify(Config) -> read_footer(Dev), match_line(Dev, "21. Printing a pid escaped with ~s, no_css: ~s", ["category and importance",EscPid]), - + read_header(Dev, "\"default\"", "This is a heading"), + match_line(Dev, "22. Printing with heading", []), + read_footer(Dev), + read_header(Dev, "\"ct_internal\"", "This is a heading"), + match_line(Dev, "23. Printing with category and heading", []), + read_footer(Dev), + read_header(Dev, "\"default\"", "This is a heading"), + match_line(Dev, "24. Printing with importance and heading", []), + read_footer(Dev), + read_header(Dev, "\"ct_internal\"", "This is a heading"), + match_line(Dev, "25. Printing with category, importance and heading", []), + read_footer(Dev), file:close(Dev), ok. @@ -298,29 +336,51 @@ read_until(Dev, Pat) -> match_line(Dev, Format, Args) -> Pat = lists:flatten(io_lib:format(Format, Args)), Line = element(2, file:read_line(Dev)), + + %% for debugging purposes: + ct:pal("L: ~tp", [Line], [no_css]), + case re:run(Line, Pat) of {match,_} -> ok; nomatch -> - ct:pal("ERROR! No match for ~p.\nLine = ~p", [Pat,Line]), + ct:pal("ERROR! No match for ~p", [Pat]), file:close(Dev), ct:fail({mismatch,Pat,Line}) end. read_header(Dev) -> - read_header(Dev, "\"default\""). + read_header(Dev, "\"default\"", "User"). read_header(Dev, Cat) -> + read_header(Dev, Cat, "User"). + +read_header(Dev, Cat, Heading) -> file:read_line(Dev), % \n "</pre>\n" = element(2, file:read_line(Dev)), - {match,_} = - re:run(element(2, file:read_line(Dev)), "<div class="++Cat++"><pre><b>" - "\\*\\*\\* User \\d{4}-\\d{2}-\\d{2} " - "\\d{2}:\\d{2}:\\d{2}.\\d{1,} \\*\\*\\*</b>"). + {ok,Hd} = file:read_line(Dev), + + %% for debugging purposes: + ct:pal("H: ~tp", [Hd], [no_css]), + + Pat = "<div class="++Cat++"><pre><b>"++ + "\\*\\*\\* "++Heading++" \\d{4}-\\d{2}-\\d{2} "++ + "\\d{2}:\\d{2}:\\d{2}.\\d{1,} \\*\\*\\*</b>", + + case re:run(Hd, Pat) of + {match,_} -> + ok; + _ -> + ct:pal("ERROR! No match for ~p", [Pat]), + file:close(Dev), + ct:fail({mismatch,Pat,Hd}) + end. read_footer(Dev) -> "</pre></div>\n" = element(2, file:read_line(Dev)), - "<pre>\n" = element(2, file:read_line(Dev)). + "<pre>\n" = element(2, file:read_line(Dev)), + %% for debugging purposes: + ct:pal("F: </pre></div><pre>", [], [no_css]). read_nl(Dev) -> file:read_line(Dev). diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index ab5cfd7a80..2fab4d3883 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.12.3 +COMMON_TEST_VSN = 1.13 diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 3ce37b98e9..bd488a39a5 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -176,6 +176,14 @@ <seealso marker="stdlib:beam_lib#debug_info">beam_lib(3)</seealso>.</p> </item> + <tag><c>deterministic</c></tag> + <item> + <p>Omit the <c>options</c> and <c>source</c> tuples in + the list returned by <c>Module:module_info(compile)</c>. + This option will make it easier to achieve reproducible builds. + </p> + </item> + <tag><c>makedep</c></tag> <item> <p>Produces a Makefile rule to track headers dependencies. @@ -498,9 +506,11 @@ module.beam: module.erl \ </warning> </item> - <tag><c>warn_export_all</c></tag> + <tag><c>nowarn_export_all</c></tag> <item> - <p>Emits a warning if option <c>export_all</c> is also given.</p> + <p>Turns off warnings for uses of the <c>export_all</c> + option. Default is to emit a warning if option + <c>export_all</c> is also given.</p> </item> <tag><c>warn_export_vars</c></tag> @@ -574,7 +584,7 @@ module.beam: module.erl \ such as <c>pid/1</c> and <c>list/1</c>. See the <seealso marker="doc/reference_manual:expressions#guards">Erlang Reference Manual</seealso> for a complete list of type testing BIFs and their old - equivalents. Default is to emit no warnings for calls to + equivalents. Default is to emit warnings for calls to old type testing BIFs.</p> </item> diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 6aaf16e9a5..2e58b68bf0 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -32,6 +32,41 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 7.0.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a compiler crash when maps were matched.</p> + <p> + Own Id: OTP-13931 Aux Id: ERL-266 </p> + </item> + <item> + <p> + Fixed a compiler crash having to with the delayed + sub-creation optimization. (Thanks to Jose Valim for + reporting this bug.)</p> + <p> + Own Id: OTP-13947 Aux Id: ERL-268 </p> + </item> + <item> + <p>The compiler option <c>inline_list_funcs</c> + accidentally turned off some other optimizations.</p> + <p> + Own Id: OTP-13985</p> + </item> + <item> + <p>The compiler could sometimes generate spurious + warnings when inlining was enabled.</p> + <p> + Own Id: OTP-14040 Aux Id: ERL-301 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.0.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index c37f731d8c..cf60355a40 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -126,7 +126,7 @@ ERL_COMPILE_FLAGS += +native endif ERL_COMPILE_FLAGS += +inline +warn_unused_import \ -Werror \ - -I../../stdlib/include -I$(EGEN) -W + -I../../stdlib/include -I$(EGEN) -W +warn_missing_spec # ---------------------------------------------------- # Targets diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 91e6d80da3..cdb32d5d55 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -25,6 +25,9 @@ -export([module/2]). +-spec module(beam_asm: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}}. diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index f6ca7a0afb..a2f5dc674c 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -24,9 +24,42 @@ -export([module/4]). -export([encode/2]). +-export_type([fail/0,label/0,reg/0,src/0,module_code/0,function_name/0]). + -import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]). -include("beam_opcodes.hrl"). +%% Common types for describing operands for BEAM instructions. +-type reg_num() :: 0..1023. +-type reg() :: {'x',reg_num()} | {'y',reg_num()}. +-type src() :: reg() | + {'literal',term()} | + {'atom',atom()} | + {'integer',integer()} | + 'nil' | + {'float',float()}. +-type label() :: pos_integer(). +-type fail() :: {'f',label() | 0}. + +%% asm_instruction() describes only the instructions that +%% are used in BEAM files (as opposed to internal instructions +%% used only during optimization). + +-type asm_instruction() :: atom() | tuple(). + +-type function_name() :: atom(). + +-type exports() :: [{function_name(),arity()}]. + +-type asm_function() :: + {'function',function_name(),arity(),label(),[asm_instruction()]}. + +-type module_code() :: + {module(),[_],[_],[asm_function()],pos_integer()}. + +-spec module(module_code(), exports(), [_], [compile:option()]) -> + {'ok',binary()}. + module(Code, Abst, SourceFile, Opts) -> {ok,assemble(Code, Abst, SourceFile, Opts)}. @@ -233,7 +266,12 @@ build_attributes(Opts, SourceFile, Attr, MD5) -> false -> Misc0; true -> [] end, - Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], + Compile = case member(deterministic, Opts) of + false -> + [{options,Opts},{version,?COMPILER_VSN}|Misc]; + true -> + [{version,?COMPILER_VSN}] + end, {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}. build_line_table(Dict) -> @@ -434,6 +472,8 @@ encode_alloc_list_1([{floats,Floats}|T], Dict, Acc0) -> encode_alloc_list_1([], Dict, Acc) -> {iolist_to_binary(Acc),Dict}. +-spec encode(non_neg_integer(), pos_integer()) -> iodata(). + encode(Tag, N) when N < 0 -> encode1(Tag, negative_to_bytes(N)); encode(Tag, N) when N < 16 -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 6a35191f6e..6543e05e20 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -25,6 +25,9 @@ -export([module/2]). -import(lists, [reverse/1,reverse/2,foldl/3,member/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}}. diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl index 2aed98d4e7..beb055b23d 100644 --- a/lib/compiler/src/beam_bs.erl +++ b/lib/compiler/src/beam_bs.erl @@ -25,6 +25,9 @@ -export([module/2]). -import(lists, [mapfoldl/3,reverse/1]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index ae1b34ba49..9a4e7fb133 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -60,19 +60,26 @@ %%% data structures or passed to BIFs. %%% +-type label() :: beam_asm:label(). +-type func_info() :: {beam_asm:reg(),boolean()}. + -record(btb, - {f, %Gbtrees for all functions. - index, %{Label,Code} index (for liveness). - ok_br, %Labels that are OK. - must_not_save, %Must not save position when - % optimizing (reaches - % bs_context_to_binary). - must_save %Must save position when optimizing. + {f :: gb_trees:tree(label(), func_info()), + index :: beam_utils:code_index(), %{Label,Code} index (for liveness). + ok_br=gb_sets:empty() :: gb_sets:set(label()), %Labels that are OK. + must_not_save=false :: boolean(), %Must not save position when + % optimizing (reaches + % bs_context_to_binary). + must_save=false :: boolean() %Must save position when optimizing. }). + +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, Opts) -> - D = #btb{f=btb_index(Fs0)}, - Fs = [function(F, D) || F <- Fs0], + FIndex = btb_index(Fs0), + Fs = [function(F, FIndex) || F <- Fs0], Code = {Mod,Exp,Attr,Fs,Lc}, case proplists:get_bool(bin_opt_info, Opts) of true -> @@ -92,10 +99,10 @@ format_error({no_bin_opt,Reason}) -> %%% Local functions. %%% -function({function,Name,Arity,Entry,Is}, D0) -> +function({function,Name,Arity,Entry,Is}, FIndex) -> try Index = beam_utils:index_labels(Is), - D = D0#btb{index=Index}, + D = #btb{f=FIndex,index=Index}, {function,Name,Arity,Entry,btb_opt_1(Is, D, [])} catch Class:Error -> @@ -179,15 +186,14 @@ btb_gen_save(false, _, Acc) -> Acc. %% a bs_context_to_binary instruction. %% -btb_reaches_match(Is, RegList, D0) -> +btb_reaches_match(Is, RegList, D) -> try Regs = btb_regs_from_list(RegList), - D = D0#btb{ok_br=gb_sets:empty(),must_not_save=false,must_save=false}, #btb{must_not_save=MustNotSave,must_save=MustSave} = - btb_reaches_match_1(Is, Regs, D), - case MustNotSave and MustSave of + btb_reaches_match_1(Is, Regs, D), + case MustNotSave andalso MustSave of true -> btb_error(must_and_must_not_save); - _ -> {ok,MustSave} + false -> {ok,MustSave} end catch throw:{error,_}=Error -> Error diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 10805a3c36..b736d39f9c 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -26,6 +26,9 @@ -export([clean_labels/1]). -import(lists, [map/2,foldl/3,reverse/1,filter/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,_}, Opts) -> Order = [Lbl || {function,_,_,Lbl,_} <- Fs0], All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end, @@ -39,6 +42,10 @@ module({Mod,Exp,Attr,Fs0,_}, 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), []). @@ -98,13 +105,18 @@ add_to_work_list(F, {Fs,Used}=Sets) -> %%% want to see the expanded code in a .S file. %%% --record(st, {lmap, %Translation tables for labels. - entry, %Number of entry label. - lc %Label counter +-type label() :: beam_asm:label(). + +-record(st, {lmap :: [{label(),label()}], %Translation tables for labels. + entry :: beam_asm:label(), %Number of entry label. + lc :: non_neg_integer() %Label counter }). +-spec clean_labels([beam_utils:instruction()]) -> + {[beam_utils:instruction()],pos_integer()}. + clean_labels(Fs0) -> - St0 = #st{lmap=[],lc=1}, + St0 = #st{lmap=[],entry=1,lc=1}, {Fs1,#st{lmap=Lmap0,lc=Lc}} = function_renumber(Fs0, St0, []), Lmap = gb_trees:from_orddict(ordsets:from_list(Lmap0)), Fs = function_replace(Fs1, Lmap, []), diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 9087586b58..d379fdc4eb 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -29,6 +29,10 @@ -import(lists, [mapfoldl/3,reverse/1]). + +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,_}, _Opts) -> {Fs1,Lc1} = beam_clean:clean_labels(Fs0), {Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs1), diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 9565ab74c4..719d799fd7 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -28,7 +28,7 @@ string_table/1,lambda_table/1,literal_table/1, line_table/1]). --type label() :: non_neg_integer(). +-type label() :: beam_asm:label(). -type index() :: non_neg_integer(). @@ -38,13 +38,16 @@ -type line_tab() :: #{{Fname :: index(), Line :: term()} => index()}. -type literal_tab() :: dict:dict(Literal :: term(), index()). +-type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}. +-type lambda_tab() :: {non_neg_integer(),[lambda_info()]}. + -record(asm, {atoms = #{} :: atom_tab(), exports = [] :: [{label(), arity(), label()}], locals = [] :: [{label(), arity(), label()}], imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool - lambdas = {0,[]}, %[{...}] + lambdas = {0,[]} :: lambda_tab(), literals = dict:new() :: literal_tab(), fnames = #{} :: fname_tab(), lines = #{} :: line_tab(), @@ -148,10 +151,7 @@ string(Str, Dict) when is_list(Str) -> lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) -> %% Set Index the same as OldIndex. Index = OldIndex, - %% Initialize OldUniq to 0. It will be set to an unique value - %% based on the MD5 checksum of the BEAM code for the module. - OldUniq = 0, - Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], + Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0], {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}. %% Returns the index for a literal (adding it to the literal table if necessary). @@ -185,6 +185,9 @@ line([{location,Name,Line}], #asm{lines=Lines,num_lines=N}=Dict0) -> {Index, Dict1#asm{lines=Lines#{Key=>Index},num_lines=N+1}} end. +-spec fname(nonempty_string(), bdict()) -> + {non_neg_integer(), bdict()}. + fname(Name, #asm{fnames=Fnames}=Dict) -> case Fnames of #{Name := Index} -> {Index,Dict}; @@ -239,8 +242,11 @@ lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) -> Lambdas1 = sofs:relation(Lambdas0), Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]), Lambdas2 = sofs:relative_product1(Lambdas1, Loc), + %% Initialize OldUniq to 0. It will be set to an unique value + %% based on the MD5 checksum of the BEAM code for the module. + OldUniq = 0, Lambdas = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> || - {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)], + {{Index,Lbl,NumFree},{F,A}} <- sofs:to_external(Lambdas2)], {NumLambdas,Lambdas}. %% Returns the literal table. diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 4a181c1923..9801c68ee2 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -33,6 +33,9 @@ -import(lists, [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}}. @@ -49,9 +52,9 @@ function({function,Name,Arity,CLabel,Is0}) -> end. -record(st, - {lbl, %func_info label - loc, %location for func_info - arity %arity for function + {lbl :: beam_asm:label(), %func_info label + loc :: [_], %location for func_info + arity :: arity() %arity for function }). function_1(Is0) -> diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index c9ff07b496..a4d45a4ca6 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -25,6 +25,9 @@ -import(lists, [reverse/1,reverse/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs,Lc}, _Opt) -> {ok,{Mod,Exp,Attr,[function(F) || F <- Fs],Lc}}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index e096270d8c..4365451356 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -130,6 +130,11 @@ -import(lists, [reverse/1,reverse/2,foldl/3]). +-type instruction() :: beam_utils:instruction(). + +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. @@ -269,9 +274,9 @@ extract_seq_1(_, _) -> no. -record(st, { - entry, %Entry label (must not be moved). - mlbl, %Moved labels. - labels :: cerl_sets:set() %Set of referenced labels. + entry :: beam_asm:label(), %Entry label (must not be moved). + mlbl :: #{beam_asm:label() := [beam_asm:label()]}, %Moved labels. + labels :: cerl_sets:set() %Set of referenced labels. }). opt(Is0, CLabel) -> @@ -453,6 +458,8 @@ is_label_used(L, St) -> %% is_unreachable_after(Instruction) -> boolean() %% Test whether the code after Instruction is unreachable. +-spec is_unreachable_after(instruction()) -> boolean(). + is_unreachable_after({func_info,_M,_F,_A}) -> true; is_unreachable_after(return) -> true; is_unreachable_after({jump,_Lbl}) -> true; @@ -465,6 +472,8 @@ is_unreachable_after(I) -> is_exit_instruction(I). %% Test whether the instruction Instruction always %% causes an exit/failure. +-spec is_exit_instruction(instruction()) -> boolean(). + is_exit_instruction({call_ext,_,{extfunc,M,F,A}}) -> erl_bifs:is_exit_bif(M, F, A); is_exit_instruction(if_end) -> true; @@ -477,6 +486,8 @@ is_exit_instruction(_) -> false. %% Remove all unused labels. Also remove unreachable %% instructions following labels that are removed. +-spec remove_unused_labels([instruction()]) -> [instruction()]. + remove_unused_labels(Is) -> Used0 = initial_labels(Is), Used = foldl(fun ulbl/2, Used0, Is), diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index d82ed8639d..94b47cf568 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -21,14 +21,24 @@ -export([module/2]). +-include("core_parse.hrl"). +-include("v3_kernel.hrl"). -include("v3_life.hrl"). -import(lists, [foreach/2]). -module(File, Core) when element(1, Core) == c_module -> +-type code() :: cerl:c_module() + | beam_utils:module_code() + | #k_mdef{} + | {module(),_,_,_} %v3_life + | [_]. %form-based format + +-spec module(file:io_device(), code()) -> 'ok'. + +module(File, #c_module{}=Core) -> %% This is a core module. io:put_chars(File, core_pp:format(Core)); -module(File, Kern) when element(1, Kern) == k_mdef -> +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])); diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index c8bef31824..6df5c02334 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -24,6 +24,9 @@ -import(lists, [reverse/1,member/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,_}, _Opts) -> %% First coalesce adjacent labels. {Fs1,Lc} = beam_clean:clean_labels(Fs0), diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 89cafe27ce..1403e1e05e 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -65,6 +65,9 @@ %%% 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}, diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl index 6a7c033ec6..910b7f6b0a 100644 --- a/lib/compiler/src/beam_reorder.erl +++ b/lib/compiler/src/beam_reorder.erl @@ -23,6 +23,9 @@ -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}}. diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index feeab0af50..d041f18806 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -23,6 +23,9 @@ -import(lists, [reverse/1]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> Fs = [split_blocks(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index d40669083e..4da0985085 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -24,10 +24,13 @@ -import(lists, [reverse/1,reverse/2,splitwith/2,sort/1]). -record(st, - {safe, %Safe labels. - lbl %Code at each label. + {safe :: gb_sets:set(beam_asm:label()), %Safe labels. + lbl :: beam_utils:code_index() %Code at each label. }). +-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}}. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index d324580cba..050c599d6b 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -26,6 +26,9 @@ -import(lists, [filter/2,foldl/3,keyfind/3,member/2, reverse/1,reverse/2,sort/1]). +-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}}. @@ -34,7 +37,8 @@ function({function,Name,Arity,CLabel,Asm0}) -> try Asm1 = beam_utils:live_opt(Asm0), Asm2 = opt(Asm1, [], tdb_new()), - Asm = beam_utils:delete_live_annos(Asm2), + Asm3 = beam_utils:live_opt(Asm2), + Asm = beam_utils:delete_live_annos(Asm3), {function,Name,Arity,CLabel,Asm} catch Class:Error -> diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 74e3d7e38a..cc6e54ca16 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -28,11 +28,31 @@ live_opt/1,delete_live_annos/1,combine_heap_needs/2, split_even/1]). +-export_type([code_index/0,module_code/0,instruction/0]). + -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). +%% instruction() describes all instructions that are used during optimzation +%% (from beam_a to beam_z). +-type instruction() :: atom() | tuple(). + +-type code_index() :: gb_trees:tree(beam_asm:label(), [instruction()]). + +-type int_function() :: {'function',beam_asm:function_name(),arity(), + beam_asm:label(),[instruction()]}. + +-type module_code() :: + {module(),[_],[_],[int_function()],pos_integer()}. + +%% Internal types. +-type fail() :: beam_asm:fail() | 'fail'. +-type test() :: {'test',atom(),fail(),[beam_asm:src()]} | + {'test',atom(),fail(),integer(),list(),beam_asm:reg()}. +-type result_cache() :: gb_trees:tree(beam_asm:label(), 'killed' | 'used'). + -record(live, - {lbl, %Label to code index. - res}). %Result cache for each label. + {lbl :: code_index(), %Label to code index. + res :: result_cache()}). %Result cache for each label. %% is_killed_block(Register, [Instruction]) -> true|false @@ -44,6 +64,8 @@ %% 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]) -> @@ -65,6 +87,8 @@ is_killed_block(_, []) -> false. %% The state (constructed by index_instructions/1) is used to allow us %% to determine the kill state across branches. +-spec is_killed(beam_asm:reg(), [instruction()], code_index()) -> boolean(). + is_killed(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of @@ -75,6 +99,8 @@ is_killed(R, Is, D) -> %% is_killed_at(Reg, Lbl, State) -> true|false %% Determine whether Reg is killed at label Lbl. +-spec is_killed_at(beam_asm:reg(), beam_asm:label(), code_index()) -> boolean(). + is_killed_at(R, Lbl, D) when is_integer(Lbl) -> St0 = #live{lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St0) of @@ -89,6 +115,8 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> %% The state is used to allow us to determine the usage state %% across branches. +-spec is_not_used(beam_asm:reg(), [instruction()], code_index()) -> boolean(). + is_not_used(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of @@ -100,18 +128,25 @@ is_not_used(R, Is, D) -> %% Index the instruction sequence so that we can quickly %% look up the instruction following a specific label. +-spec index_labels([instruction()]) -> code_index(). + index_labels(Is) -> index_labels_1(Is, []). %% empty_label_index() -> State %% Create an empty label index. +-spec empty_label_index() -> code_index(). + empty_label_index() -> gb_trees:empty(). %% index_label(Label, [Instruction], State) -> State %% Add an index for a label. +-spec index_label(beam_asm:label(), [instruction()], code_index()) -> + code_index(). + index_label(Lbl, Is0, Acc) -> Is = drop_labels(Is0), gb_trees:enter(Lbl, Is, Acc). @@ -120,12 +155,16 @@ index_label(Lbl, Is0, Acc) -> %% code_at(Label, State) -> [I]. %% Retrieve the code at the given label. +-spec code_at(beam_asm:label(), code_index()) -> [instruction()]. + code_at(L, Ll) -> gb_trees:get(L, Ll). %% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]} %% Convert a BIF to a test. Fail if not possible. +-spec bif_to_test(atom(), list(), fail()) -> test(). + bif_to_test(is_atom, [_]=Ops, Fail) -> {test,is_atom,Fail,Ops}; bif_to_test(is_boolean, [_]=Ops, Fail) -> {test,is_boolean,Fail,Ops}; bif_to_test(is_binary, [_]=Ops, Fail) -> {test,is_binary,Fail,Ops}; @@ -158,6 +197,9 @@ bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. %% Return 'true' if the test instruction does not modify any %% registers and/or bit syntax matching state. %% + +-spec is_pure_test(test()) -> boolean(). + is_pure_test({test,is_eq,_,[_,_]}) -> true; is_pure_test({test,is_ne,_,[_,_]}) -> true; is_pure_test({test,is_eq_exact,_,[_,_]}) -> true; @@ -180,7 +222,9 @@ is_pure_test({test,Op,_,Ops}) -> %% whose destination is a register that will not be used. %% Also insert {'%live',Live,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; @@ -193,7 +237,9 @@ live_opt(Is0) -> %% delete_live_annos([Instruction]) -> [Instruction]. %% Delete all live annotations. -%% + +-spec delete_live_annos([instruction()]) -> [instruction()]. + delete_live_annos([{block,Bl0}|Is]) -> case delete_live_annos(Bl0) of [] -> delete_live_annos(Is); @@ -208,6 +254,8 @@ delete_live_annos([]) -> []. %% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed %% Combine the heap need for two allocation instructions. +-spec combine_heap_needs(term(), term()) -> term(). + combine_heap_needs({alloc,Alloc1}, {alloc,Alloc2}) -> {alloc,combine_alloc_lists(Alloc1, Alloc2)}; combine_heap_needs({alloc,Alloc}, Words) when is_integer(Words) -> @@ -220,6 +268,8 @@ combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) -> %% split_even/1 %% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} +-spec split_even(list()) -> {list(),list()}. + split_even(Rs) -> split_even(Rs, [], []). @@ -768,6 +818,8 @@ live_opt_block([{set,Ds,Ss,Op}=I0|Is], Regs0, D, Acc) -> _ -> live_opt_block(Is, Regs, D, [I|Acc]) end; +live_opt_block([{'%live',_,_}|Is], Regs, D, Acc) -> + live_opt_block(Is, Regs, D, Acc); live_opt_block([], Regs, _, Acc) -> {Acc,Regs}. live_join_labels([{f,L}|T], D, Regs0) when L =/= 0 -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 5659077c5d..bf33ae0aeb 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -32,6 +32,10 @@ -import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). %% To be called by the compiler. + +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_utils:module_code()}. + module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) -> case validate(Mod, Fs) of diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 6c7f8543c2..787e33c142 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -26,6 +26,9 @@ -import(lists, [dropwhile/2]). +-spec module(beam_utils:module_code(), [compile:option()]) -> + {'ok',beam_asm:module_code()}. + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index b1be6ffc6d..6b936a7687 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1584,6 +1584,8 @@ ann_make_list(_, [], Node) -> %% @doc Returns <code>true</code> if <code>Node</code> is an abstract %% map constructor, otherwise <code>false</code>. +-type map_op() :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}. + -spec is_c_map(cerl()) -> boolean(). is_c_map(#c_map{}) -> @@ -1679,8 +1681,16 @@ update_c_map(#c_map{is_pat=true}=Old, M, Es) -> update_c_map(#c_map{is_pat=false}=Old, M, Es) -> ann_c_map(get_ann(Old), M, Es). +-spec map_pair_key(c_map_pair()) -> cerl(). + map_pair_key(#c_map_pair{key=K}) -> K. + +-spec map_pair_val(c_map_pair()) -> cerl(). + map_pair_val(#c_map_pair{val=V}) -> V. + +-spec map_pair_op(c_map_pair()) -> map_op(). + map_pair_op(#c_map_pair{op=Op}) -> Op. -spec c_map_pair(cerl(), cerl()) -> c_map_pair(). @@ -1699,6 +1709,8 @@ c_map_pair_exact(Key,Val) -> ann_c_map_pair(As,Op,K,V) -> #c_map_pair{op=Op, key = K, val=V, anno = As}. +-spec update_c_map_pair(c_map_pair(), map_op(), cerl(), cerl()) -> c_map_pair(). + update_c_map_pair(Old,Op,K,V) -> #c_map_pair{op=Op, key=K, val=V, anno = get_ann(Old)}. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 3868b971a3..069add7890 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -147,8 +147,8 @@ env_compiler_options() -> env_default_opts(). %% Local functions %% --define(pass(P), {P,fun P/1}). --define(pass(P,T), {P,fun T/1,fun P/1}). +-define(pass(P), {P,fun P/2}). +-define(pass(P,T), {P,fun T/1,fun P/2}). env_default_opts() -> Key = "ERL_COMPILER_OPTIONS", @@ -173,17 +173,25 @@ env_default_opts() -> do_compile(Input, Opts0) -> Opts = expand_opts(Opts0), - {Pid,Ref} = - spawn_monitor(fun() -> - exit(try - internal(Input, Opts) - catch - error:Reason -> - {error,Reason} - end) - end), - receive - {'DOWN',Ref,process,Pid,Rep} -> Rep + IntFun = fun() -> try + internal(Input, Opts) + catch + error:Reason -> + {error,Reason} + end + end, + %% Dialyzer has already spawned workers. + case lists:member(dialyzer, Opts) of + true -> + IntFun(); + false -> + {Pid,Ref} = + spawn_monitor(fun() -> + exit(IntFun()) + end), + receive + {'DOWN',Ref,process,Pid,Rep} -> Rep + end end. expand_opts(Opts0) -> @@ -220,6 +228,8 @@ expand_opt(O, Os) -> [O|Os]. %% format_error(ErrorDescriptor) -> string() +-spec format_error(term()) -> iolist(). + format_error(no_native_support) -> "this system is not configured for native-code compilation."; format_error(no_crypto) -> @@ -280,34 +290,35 @@ format_error_reason({Reason, Stack}) when is_list(Stack) -> format_error_reason(Reason) -> io_lib:format("~tp", [Reason]). +-type err_warn_info() :: tuple(). + %% The compile state record. -record(compile, {filename="" :: file:filename(), dir="" :: file:filename(), base="" :: file:filename(), ifile="" :: file:filename(), ofile="" :: file:filename(), - module=[], - code=[], - core_code=[], - abstract_code=[], %Abstract code for debugger. - options=[] :: [option()], %Options for compilation + module=[] :: module() | [], + core_code=[] :: cerl:c_module() | [], + abstract_code=[] :: binary() | [], %Abstract code for debugger. + options=[] :: [option()], %Options for compilation mod_options=[] :: [option()], %Options for module_info encoding=none :: none | epp:source_encoding(), - errors=[], - warnings=[]}). + errors=[] :: [err_warn_info()], + warnings=[] :: [err_warn_info()]}). internal({forms,Forms}, Opts0) -> {_,Ps} = passes(forms, Opts0), Source = proplists:get_value(source, Opts0, ""), Opts1 = proplists:delete(source, Opts0), - Compile = #compile{code=Forms,options=Opts1,mod_options=Opts1}, - internal_comp(Ps, Source, "", Compile); + Compile = #compile{options=Opts1,mod_options=Opts1}, + internal_comp(Ps, Forms, Source, "", Compile); internal({file,File}, Opts) -> {Ext,Ps} = passes(file, Opts), Compile = #compile{options=Opts,mod_options=Opts}, - internal_comp(Ps, File, Ext, Compile). + internal_comp(Ps, none, File, Ext, Compile). -internal_comp(Passes, File, Suffix, St0) -> +internal_comp(Passes, Code0, File, Suffix, St0) -> Dir = filename:dirname(File), Base = filename:basename(File, Suffix), St1 = St0#compile{filename=File, dir=Dir, base=Base, @@ -317,36 +328,41 @@ internal_comp(Passes, File, Suffix, St0) -> Run0 = case member(time, Opts) of true -> io:format("Compiling ~tp\n", [File]), - fun run_tc/2; - false -> fun({_Name,Fun}, St) -> catch Fun(St) end + fun run_tc/3; + false -> + fun({_Name,Fun}, Code, St) -> + catch Fun(Code, St) + end end, Run = case keyfind(eprof, 1, Opts) of {eprof,EprofPass} -> - fun(P, St) -> - run_eprof(P, EprofPass, St) + fun(P, Code, St) -> + run_eprof(P, Code, EprofPass, St) end; false -> Run0 end, - case fold_comp(Passes, Run, St1) of - {ok,St2} -> comp_ret_ok(St2); + case fold_comp(Passes, Run, Code0, St1) of + {ok,Code,St2} -> comp_ret_ok(Code, St2); {error,St2} -> comp_ret_err(St2) end. -fold_comp([{delay,Ps0}|Passes], Run, #compile{options=Opts}=St) -> +fold_comp([{delay,Ps0}|Passes], Run, Code, #compile{options=Opts}=St) -> Ps = select_passes(Ps0, Opts) ++ Passes, - fold_comp(Ps, Run, St); -fold_comp([{Name,Test,Pass}|Ps], Run, St) -> + fold_comp(Ps, Run, Code, St); +fold_comp([{Name,Test,Pass}|Ps], Run, Code, St) -> case Test(St) of false -> %Pass is not needed. - fold_comp(Ps, Run, St); + fold_comp(Ps, Run, Code, St); true -> %Run pass in the usual way. - fold_comp([{Name,Pass}|Ps], Run, St) + fold_comp([{Name,Pass}|Ps], Run, Code, St) end; -fold_comp([{Name,Pass}|Ps], Run, St0) -> - case Run({Name,Pass}, St0) of - {ok,St1} -> fold_comp(Ps, Run, St1); - {error,_St1} = Error -> Error; +fold_comp([{Name,Pass}|Ps], Run, Code0, St0) -> + case Run({Name,Pass}, Code0, St0) of + {ok,Code,St1} -> + fold_comp(Ps, Run, Code, St1); + {error,_St1}=Error -> + Error; {'EXIT',Reason} -> Es = [{St0#compile.ifile,[{none,?MODULE,{crash,Name,Reason}}]}], {error,St0#compile{errors=St0#compile.errors ++ Es}}; @@ -354,11 +370,11 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> Es = [{St0#compile.ifile,[{none,?MODULE,{bad_return,Name,Other}}]}], {error,St0#compile{errors=St0#compile.errors ++ Es}} end; -fold_comp([], _Run, St) -> {ok,St}. +fold_comp([], _Run, Code, St) -> {ok,Code,St}. -run_tc({Name,Fun}, St) -> +run_tc({Name,Fun}, Code, St) -> T1 = erlang:monotonic_time(), - Val = (catch Fun(St)), + Val = (catch Fun(Code, St)), T2 = erlang:monotonic_time(), Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond), Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), @@ -367,17 +383,17 @@ run_tc({Name,Fun}, St) -> [Name,Elapsed/1000,Mem]), Val. -run_eprof({Name,Fun}, Name, St) -> +run_eprof({Name,Fun}, Code, Name, St) -> io:format("~p: Running eprof\n", [Name]), c:appcall(tools, eprof, start_profiling, [[self()]]), - Val = (catch Fun(St)), + Val = (catch Fun(Code, St)), c:appcall(tools, eprof, stop_profiling, []), c:appcall(tools, eprof, analyze, []), Val; -run_eprof({_,Fun}, _, St) -> - catch Fun(St). +run_eprof({_,Fun}, Code, _, St) -> + catch Fun(Code, St). -comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> +comp_ret_ok(Code, #compile{warnings=Warn0,module=Mod,options=Opts}=St) -> case werror(St) of true -> case member(report_warnings, Opts) of @@ -532,21 +548,21 @@ pass(_) -> none. %% select_passes([{pass,Mod}|Ps], Opts) -> - F = fun(St) -> - case catch Mod:module(St#compile.code, St#compile.options) of + F = fun(Code0, St) -> + case catch Mod:module(Code0, St#compile.options) of {ok,Code} -> - {ok,St#compile{code=Code}}; + {ok,Code,St}; {ok,Code,Ws} -> - {ok,St#compile{code=Code,warnings=St#compile.warnings++Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings++Ws}}; {error,Es} -> {error,St#compile{errors=St#compile.errors ++ Es}} end end, [{Mod,F}|select_passes(Ps, Opts)]; select_passes([{src_listing,Ext}|_], _Opts) -> - [{listing,fun (St) -> src_listing(Ext, St) end}]; + [{listing,fun (Code, St) -> src_listing(Ext, Code, St) end}]; select_passes([{listing,Ext}|_], _Opts) -> - [{listing,fun (St) -> listing(Ext, St) end}]; + [{listing,fun (Code, St) -> listing(Ext, Code, St) end}]; select_passes([done|_], _Opts) -> []; select_passes([{done,Ext}|_], Opts) -> @@ -662,14 +678,14 @@ core_passes() -> [{iff,clint0,?pass(core_lint_module)}, {delay, [{unless,no_copt, - [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, + [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2}, {iff,doldinline,{listing,"oldinline"}}, {pass,sys_core_fold}, {iff,dcorefold,{listing,"corefold"}}, - {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, + {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2}, {iff,dinline,{listing,"inline"}}, {core_fold_after_inlining,fun test_any_inliner/1, - fun core_fold_module_after_inlining/1}, + fun core_fold_module_after_inlining/2}, ?pass(core_transforms)]}, {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} @@ -741,7 +757,7 @@ asm_passes() -> | binary_passes()]. binary_passes() -> - [{native_compile,fun test_native/1,fun native_compile/1}, + [{native_compile,fun test_native/1,fun native_compile/2}, {unless,binary,?pass(save_binary,not_werror)}]. %%% @@ -749,9 +765,9 @@ binary_passes() -> %%% %% Remove the target file so we don't have an old one if the compilation fail. -remove_file(St) -> +remove_file(Code, St) -> _ = file:delete(St#compile.ofile), - {ok,St}. + {ok,Code,St}. -record(asm_module, {module, exports, @@ -799,28 +815,28 @@ collect_asm([{attributes, Attr} | Rest], R) -> collect_asm([X | Rest], R) -> collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}). -beam_consult_asm(St) -> +beam_consult_asm(_Code, St) -> case file:consult(St#compile.ifile) of - {ok, Forms0} -> + {ok,Forms0} -> Encoding = epp:read_encoding(St#compile.ifile), - {Module, Forms} = preprocess_asm_forms(Forms0), - {ok,St#compile{module=Module, code=Forms, encoding=Encoding}}; + {Module,Forms} = preprocess_asm_forms(Forms0), + {ok,Forms,St#compile{module=Module,encoding=Encoding}}; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. -read_beam_file(St) -> +read_beam_file(_Code, St) -> case file:read_file(St#compile.ifile) of {ok,Beam} -> Infile = St#compile.ifile, case no_native_compilation(Infile, St) of true -> - {ok,St#compile{module=none,code=none}}; + {ok,none,St#compile{module=none}}; false -> Mod0 = filename:rootname(filename:basename(Infile)), Mod = list_to_atom(Mod0), - {ok,St#compile{module=Mod,code=Beam,ofile=Infile}} + {ok,Beam,St#compile{module=Mod,ofile=Infile}} end; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], @@ -839,17 +855,17 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) -> _ -> false end. -parse_module(St0) -> +parse_module(_Code, St0) -> case do_parse_module(utf8, St0) of - {ok,_}=Ret -> + {ok,_,_}=Ret -> Ret; {error,_}=Ret -> Ret; {invalid_unicode,File,Line} -> case do_parse_module(latin1, St0) of - {ok,St} -> + {ok,Code,St} -> Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], - {ok,St#compile{warnings=Es++St#compile.warnings}}; + {ok,Code,St#compile{warnings=Es++St#compile.warnings}}; {error,St} -> Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], {error,St#compile{errors=Es++St#compile.errors}} @@ -867,13 +883,13 @@ do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> Encoding = proplists:get_value(encoding, Extra), case find_invalid_unicode(Forms, File) of none -> - {ok,St#compile{code=Forms,encoding=Encoding}}; + {ok,Forms,St#compile{encoding=Encoding}}; {invalid_unicode,_,_}=Ret -> case Encoding of none -> Ret; _ -> - {ok,St#compile{code=Forms,encoding=Encoding}} + {ok,Forms,St#compile{encoding=Encoding}} end end; {error,E} -> @@ -892,7 +908,7 @@ find_invalid_unicode([H|T], File0) -> end; find_invalid_unicode([], _) -> none. -parse_core(St) -> +parse_core(_Code, St) -> case file:read_file(St#compile.ifile) of {ok,Bin} -> case core_scan:string(binary_to_list(Bin)) of @@ -900,7 +916,7 @@ parse_core(St) -> case core_parse:parse(Toks) of {ok,Mod} -> Name = (Mod#c_module.name)#c_literal.val, - {ok,St#compile{module=Name,code=Mod}}; + {ok,Mod,St#compile{module=Name}}; {error,E} -> Es = [{St#compile.ifile,[E]}], {error,St#compile{errors=St#compile.errors ++ Es}} @@ -937,31 +953,36 @@ clean_parse_transforms_1([], Acc) -> reverse(Acc). transforms(Os) -> [ M || {parse_transform,M} <- Os ]. -transform_module(#compile{options=Opt,code=Code0}=St0) -> +transform_module(Code0, #compile{options=Opt}=St) -> %% Extract compile options from code into options field. case transforms(Opt ++ compile_options(Code0)) of - [] -> {ok,St0}; %No parse transforms. + [] -> + %% No parse transforms. + {ok,Code0,St}; Ts -> %% Remove parse_transform attributes from the abstract code to %% prevent parse transforms to be run more than once. Code = clean_parse_transforms(Code0), - St = St0#compile{code=Code}, - foldl_transform(St, Ts) + foldl_transform(Ts, Code, St) end. -foldl_transform(St, [T|Ts]) -> +foldl_transform([T|Ts], Code0, St) -> Name = "transform " ++ atom_to_list(T), case code:ensure_loaded(T) =:= {module,T} andalso - erlang:function_exported(T, parse_transform, 2) of + erlang:function_exported(T, parse_transform, 2) of true -> - Fun = fun(S) -> - T:parse_transform(S#compile.code, S#compile.options) + Fun = fun(Code, S) -> + T:parse_transform(Code, S#compile.options) end, Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end + true -> + fun run_tc/3; + false -> + fun({_Name,F}, Code, S) -> + catch F(Code, S) + end end, - case Run({Name, Fun}, St) of + case Run({Name, Fun}, Code0, St) of {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}}; @@ -970,41 +991,44 @@ foldl_transform(St, [T|Ts]) -> {parse_transform,T,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}}; {warning, Forms, Ws} -> - foldl_transform( - St#compile{code=Forms, - warnings=St#compile.warnings ++ Ws}, Ts); + foldl_transform(Ts, Forms, + St#compile{warnings=St#compile.warnings ++ Ws}); Forms -> - foldl_transform(St#compile{code=Forms}, Ts) + foldl_transform(Ts, Forms, St) end; false -> Es = [{St#compile.ifile,[{none,compile, {undef_parse_transform,T}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end; -foldl_transform(St, []) -> {ok,St}. +foldl_transform([], Code, St) -> {ok,Code,St}. get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts]. -core_transforms(St) -> +core_transforms(Code, St) -> %% The options field holds the complete list of options at this Ts = get_core_transforms(St#compile.options), - foldl_core_transforms(St, Ts). + foldl_core_transforms(Ts, Code, St). -foldl_core_transforms(St, [T|Ts]) -> +foldl_core_transforms([T|Ts], Code0, St) -> Name = "core transform " ++ atom_to_list(T), - Fun = fun(S) -> T:core_transform(S#compile.code, S#compile.options) end, + Fun = fun(Code, S) -> T:core_transform(Code, S#compile.options) end, Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end + true -> + fun run_tc/3; + false -> + fun({_Name,F}, Code, S) -> + catch F(Code, S) + end end, - case Run({Name, Fun}, St) of + case Run({Name, Fun}, Code0, St) of {'EXIT',R} -> Es = [{St#compile.ifile,[{none,compile,{core_transform,T,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}}; Forms -> - foldl_core_transforms(St#compile{code=Forms}, Ts) + foldl_core_transforms(Ts, Forms, St) end; -foldl_core_transforms(St, []) -> {ok,St}. +foldl_core_transforms([], Code, St) -> {ok,Code,St}. %%% Fetches the module name from a list of forms. The module attribute must %%% be present. @@ -1025,31 +1049,28 @@ add_default_base(St, Forms) -> St end. -lint_module(St) -> - case erl_lint:module(St#compile.code, - St#compile.ifile, St#compile.options) of +lint_module(Code, St) -> + case erl_lint:module(Code, St#compile.ifile, St#compile.options) of {ok,Ws} -> %% Insert name of module as base name, if needed. This is %% for compile:forms to work with listing files. - St1 = add_default_base(St, St#compile.code), - {ok,St1#compile{warnings=St1#compile.warnings ++ Ws}}; + St1 = add_default_base(St, Code), + {ok,Code,St1#compile{warnings=St1#compile.warnings ++ Ws}}; {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}} end. -core_lint_module(St) -> - case core_lint:module(St#compile.code, St#compile.options) of +core_lint_module(Code, St) -> + case core_lint:module(Code, St#compile.options) of {ok,Ws} -> - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}} end. -makedep(#compile{code=Code,options=Opts}=St) -> - Ifile = St#compile.ifile, - Ofile = St#compile.ofile, +makedep(Code0, #compile{ifile=Ifile,ofile=Ofile,options=Opts}=St) -> %% Get the target of the Makefile rule. Target0 = @@ -1081,7 +1102,7 @@ makedep(#compile{code=Code,options=Opts}=St) -> %% List the dependencies (includes) for this target. {MainRule,PhonyRules} = makedep_add_headers( Ifile, % The input file name. - Code, % The parsed source. + Code0, % The parsed source. [], % The list of dependencies already added. length(Target), % The current line length. Target, % The target. @@ -1101,7 +1122,8 @@ makedep(#compile{code=Code,options=Opts}=St) -> true -> MainRule ++ PhonyRules; _ -> MainRule end, - {ok,St#compile{code=iolist_to_binary([Makefile,"\n"])}}. + Code = iolist_to_binary([Makefile,"\n"]), + {ok,Code,St}. makedep_add_headers(Ifile, [{attribute,_,file,{File,_}}|Rest], Included, LineLen, MainTarget, Phony, Opts) -> @@ -1166,7 +1188,7 @@ makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File) -> end end. -makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> +makedep_output(Code, #compile{options=Opts,ofile=Ofile}=St) -> %% Write this Makefile (Code) to the selected output. %% If no output is specified, the default is to write to a file named after %% the output file. @@ -1208,7 +1230,7 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> CloseOutput -> ok = file:close(Output1); true -> ok end, - {ok,St} + {ok,Code,St} catch error:_ -> %% Couldn't write to output Makefile. @@ -1225,33 +1247,33 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> {error,St#compile{errors=St#compile.errors++[Err]}} end. -expand_records(#compile{code=Code0,options=Opts}=St0) -> +expand_records(Code0, #compile{options=Opts}=St) -> Code = erl_expand_records:module(Code0, Opts), - {ok,St0#compile{code=Code}}. + {ok,Code,St}. -core(#compile{code=Forms,options=Opts0}=St) -> +core(Forms, #compile{options=Opts0}=St) -> Opts1 = lists:flatten([C || {attribute,_,compile,C} <- Forms] ++ Opts0), Opts = expand_opts(Opts1), {ok,Core,Ws} = v3_core:module(Forms, Opts), Mod = cerl:concrete(cerl:module_name(Core)), - {ok,St#compile{module=Mod,code=Core,options=Opts, - warnings=St#compile.warnings++Ws}}. + {ok,Core,St#compile{module=Mod,options=Opts, + warnings=St#compile.warnings++Ws}}. -core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> +core_fold_module_after_inlining(Code0, #compile{options=Opts}=St) -> %% Inlining may produce code that generates spurious warnings. %% Ignore all warnings. {ok,Code,_Ws} = sys_core_fold:module(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -v3_kernel(#compile{code=Code0,options=Opts,warnings=Ws0}=St) -> +v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) -> {ok,Code,Ws} = v3_kernel:module(Code0, Opts), case Ws =:= [] orelse test_core_inliner(St) of false -> - {ok,St#compile{code=Code,warnings=Ws0++Ws}}; + {ok,Code,St#compile{warnings=Ws0++Ws}}; true -> %% cerl_inline may produce code that generates spurious %% warnings. Ignore any such warnings. - {ok,St#compile{code=Code}} + {ok,Code,St} end. test_old_inliner(#compile{options=Opts}) -> @@ -1275,23 +1297,23 @@ test_core_inliner(#compile{options=Opts}) -> test_any_inliner(St) -> test_old_inliner(St) orelse test_core_inliner(St). -core_old_inliner(#compile{code=Code0,options=Opts}=St) -> +core_old_inliner(Code0, #compile{options=Opts}=St) -> {ok,Code} = sys_core_inline:module(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -core_inline_module(#compile{code=Code0,options=Opts}=St) -> +core_inline_module(Code0, #compile{options=Opts}=St) -> Code = cerl_inline:core_transform(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -save_abstract_code(#compile{ifile=File}=St) -> - case abstract_code(St) of - {ok,Code} -> - {ok,St#compile{abstract_code=Code}}; +save_abstract_code(Code, #compile{ifile=File}=St) -> + case abstract_code(Code, St) of + {ok,Abstr} -> + {ok,Code,St#compile{abstract_code=Abstr}}; {error,Es} -> {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}} end. -abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> +abstract_code(Code0, #compile{options=Opts,ofile=OFile}) -> Code = erl_parse:anno_to_term(Code0), Abstr = erlang:term_to_binary({raw_abstract_v1,Code}, [compressed]), case member(encrypt_debug_info, Opts) of @@ -1313,7 +1335,7 @@ abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> end end; false -> - {ok, Abstr} + {ok,Abstr} end. encrypt_abs_code(Abstr, Key0) -> @@ -1351,18 +1373,17 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> TypeString = atom_to_list(Type), list_to_binary([0,length(TypeString),TypeString,Bin]). -save_core_code(St) -> - {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}. +save_core_code(Code, St) -> + {ok,Code,St#compile{core_code=cerl:from_records(Code)}}. -beam_asm(#compile{ifile=File,code=Code0, - abstract_code=Abst,mod_options=Opts0}=St) -> +beam_asm(Code0, #compile{ifile=File,abstract_code=Abst,mod_options=Opts0}=St) -> Source = paranoid_absname(File), Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'}; (Other) -> Other end, Opts0), Opts2 = [O || O <- Opts1, effects_code_generation(O)], case beam_asm:module(Code0, Abst, Source, Opts2) of - {ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}} + {ok,Code} -> {ok,Code,St#compile{abstract_code=[]}} end. paranoid_absname(""=File) -> @@ -1386,17 +1407,17 @@ is_native_enabled([no_native|_]) -> false; is_native_enabled([_|Opts]) -> is_native_enabled(Opts); is_native_enabled([]) -> false. -native_compile(#compile{code=none}=St) -> {ok,St}; -native_compile(St) -> +native_compile(none, St) -> {ok,none,St}; +native_compile(Code, St) -> case erlang:system_info(hipe_architecture) of undefined -> Ws = [{St#compile.ifile,[{none,compile,no_native_support}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; _ -> - native_compile_1(St) + native_compile_1(Code, St) end. -native_compile_1(St) -> +native_compile_1(Code, St) -> Opts0 = St#compile.options, IgnoreErrors = member(ignore_native_errors, Opts0), Opts = case keyfind(hipe, 1, Opts0) of @@ -1406,10 +1427,10 @@ native_compile_1(St) -> end, try hipe:compile(St#compile.module, St#compile.core_code, - St#compile.code, + Code, Opts) of {ok,{_Type,Bin}=T} when is_binary(Bin) -> - {ok,embed_native_code(St, T)}; + {ok,embed_native_code(Code, T),St}; {error,R} -> case IgnoreErrors of true -> @@ -1432,13 +1453,13 @@ native_compile_1(St) -> end end. -embed_native_code(St, {Architecture,NativeCode}) -> - {ok, _, Chunks0} = beam_lib:all_chunks(St#compile.code), +embed_native_code(Code, {Architecture,NativeCode}) -> + {ok, _, Chunks0} = beam_lib:all_chunks(Code), ChunkName = hipe_unified_loader:chunk_name(Architecture), Chunks1 = lists:keydelete(ChunkName, 1, Chunks0), Chunks = Chunks1 ++ [{ChunkName,NativeCode}], - {ok, BeamPlusNative} = beam_lib:build_module(Chunks), - St#compile{code=BeamPlusNative}. + {ok,BeamPlusNative} = beam_lib:build_module(Chunks), + BeamPlusNative. %% effects_code_generation(Option) -> true|false. %% Determine whether the option could have any effect on the @@ -1458,18 +1479,17 @@ effects_code_generation(Option) -> _ -> true end. -save_binary(#compile{code=none}=St) -> {ok,St}; -save_binary(#compile{module=Mod,ofile=Outfile, - options=Opts}=St) -> +save_binary(none, St) -> {ok,none,St}; +save_binary(Code, #compile{module=Mod,ofile=Outfile,options=Opts}=St) -> %% Test that the module name and output file name match. case member(no_error_module_mismatch, Opts) of true -> - save_binary_1(St); + save_binary_1(Code, St); false -> Base = filename:rootname(filename:basename(Outfile)), case atom_to_list(Mod) of Base -> - save_binary_1(St); + save_binary_1(Code, St); _ -> Es = [{St#compile.ofile, [{none,?MODULE,{module_name,Mod,Base}}]}], @@ -1477,14 +1497,14 @@ save_binary(#compile{module=Mod,ofile=Outfile, end end. -save_binary_1(St) -> +save_binary_1(Code, St) -> Ofile = St#compile.ofile, Tfile = tmpfile(Ofile), %Temp working file - case write_binary(Tfile, St#compile.code, St) of + case write_binary(Tfile, Code, St) of ok -> case file:rename(Tfile, Ofile) of ok -> - {ok,St}; + {ok,none,St}; {error,RenameError} -> Es0 = [{Ofile,[{none,?MODULE,{rename,Tfile,Ofile, RenameError}}]}], @@ -1584,6 +1604,9 @@ list_errors(_F, []) -> ok. %% tmpfile(ObjFile) -> TmpFile %% Work out the correct input and output file names. +-spec iofile(atom() | file:filename_all()) -> + {file:name_all(),file:name_all()}. + iofile(File) when is_atom(File) -> iofile(atom_to_list(File)); iofile(File) -> @@ -1624,29 +1647,29 @@ pre_defs([]) -> []. inc_paths(Opts) -> [ P || {i,P} <- Opts, is_list(P) ]. -src_listing(Ext, St) -> +src_listing(Ext, Code, St) -> listing(fun (Lf, {_Mod,_Exp,Fs}) -> do_src_listing(Lf, Fs); (Lf, Fs) -> do_src_listing(Lf, Fs) end, - Ext, St). + Ext, Code, St). do_src_listing(Lf, Fs) -> Opts = [lists:keyfind(encoding, 1, io:getopts(Lf))], foreach(fun (F) -> io:put_chars(Lf, [erl_pp:form(F, Opts),"\n"]) end, Fs). -listing(Ext, St0) -> +listing(Ext, Code, St0) -> St = St0#compile{encoding = none}, - listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, St). + listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, Code, St). -listing(LFun, Ext, St) -> +listing(LFun, Ext, Code, St) -> Lfile = outfile(St#compile.base, Ext, St#compile.options), case file:open(Lfile, [write,delayed_write]) of {ok,Lf} -> - Code = restore_expanded_types(Ext, St#compile.code), + Code = restore_expanded_types(Ext, Code), output_encoding(Lf, St), LFun(Lf, Code), ok = file:close(Lf), - {ok,St}; + {ok,Code,St}; {error,Error} -> Es = [{Lfile,[{none,compile,{write_error,Error}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} @@ -1718,6 +1741,8 @@ help(_) -> %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. +-spec compile(file:filename(), _, #options{}) -> 'ok' | 'error'. + compile(File0, _OutFile, Options) -> pre_load(), File = shorten_filename(File0), @@ -1726,6 +1751,8 @@ compile(File0, _OutFile, Options) -> Other -> Other end. +-spec compile_beam(file:filename(), _, #options{}) -> 'ok' | 'error'. + compile_beam(File0, _OutFile, Opts) -> File = shorten_filename(File0), case file(File, [from_beam|make_erl_options(Opts)]) of @@ -1733,6 +1760,8 @@ compile_beam(File0, _OutFile, Opts) -> Other -> Other end. +-spec compile_asm(file:filename(), _, #options{}) -> 'ok' | 'error'. + compile_asm(File0, _OutFile, Opts) -> File = shorten_filename(File0), case file(File, [from_asm|make_erl_options(Opts)]) of @@ -1740,6 +1769,8 @@ compile_asm(File0, _OutFile, Opts) -> Other -> Other end. +-spec compile_core(file:filename(), _, #options{}) -> 'ok' | 'error'. + compile_core(File0, _OutFile, Opts) -> File = shorten_filename(File0), case file(File, [from_core|make_erl_options(Opts)]) of diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 11b52f6c5f..15bfc78c8b 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -49,13 +49,37 @@ -import(lists, [reverse/1]). +-type location() :: integer(). +-type category() :: atom(). +-type symbol() :: atom() | float() | integer() | string(). +-type token() :: {category(), Anno :: location(), symbol()} + | {category(), Anno :: location()}. +-type tokens() :: [token()]. +-type error_description() :: term(). +-type error_info() :: {erl_anno:location(), module(), error_description()}. + %% string([Char]) -> %% string([Char], StartPos) -> %% {ok, [Tok], EndPos} | %% {error, {Pos,core_scan,What}, EndPos} +-spec string(String) -> Return when + String :: string(), + Return :: {'ok', Tokens :: tokens(), EndLocation} + | {'error', ErrorInfo :: error_info(), ErrorLocation}, + EndLocation :: location(), + ErrorLocation :: location(). + string(Cs) -> string(Cs, 1). +-spec string(String, StartLocation) -> Return when + String :: string(), + Return :: {'ok', Tokens :: tokens(), EndLocation} + | {'error', ErrorInfo :: error_info(), ErrorLocation}, + StartLocation :: location(), + EndLocation :: location(), + ErrorLocation :: location(). + string(Cs, Sp) -> %% Add an 'eof' to always get correct handling. case string_pre_scan(Cs, [], Sp) of diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 50d28c0a5f..3673a339f6 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1893,10 +1893,10 @@ case_opt_arg_1(E0, Cs0, LitExpr) -> true -> E = case_opt_compiler_generated(E0), Cs = case_opt_nomatch(E, Cs0, LitExpr), - case cerl:data_type(E) of - {atomic,_} -> + case cerl:is_literal(E) of + true -> case_opt_lit(E, Cs); - _ -> + false -> case_opt_data(E, Cs) end end. diff --git a/lib/compiler/src/sys_pre_attributes.erl b/lib/compiler/src/sys_pre_attributes.erl index bc93c85989..67adae5acf 100644 --- a/lib/compiler/src/sys_pre_attributes.erl +++ b/lib/compiler/src/sys_pre_attributes.erl @@ -25,10 +25,10 @@ -define(OPTION_TAG, attributes). --record(state, {forms, - pre_ops = [], - post_ops = [], - options}). +-record(state, {forms :: [form()], + pre_ops = [] :: [op()], + post_ops = [] :: [op()], + options :: [option()]}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Inserts, deletes and replaces Erlang compiler attributes. @@ -59,9 +59,23 @@ %% due to that the pre_transform pass did not find the attribute plus %% all insert operations. +-type attribute() :: atom(). +-type value() :: term(). +-type form() :: {function, integer(), atom(), arity(), _} + | {attribute, integer(), attribute(), _}. +-type option() :: compile:option() + | {'attribute', 'insert', attribute(), value()} + | {'attribute', 'replace', attribute(), value()} + | {'attribute', 'delete', attribute()}. +-type op() :: {'insert', attribute(), value()} + | {'replace', attribute(), value()} + | {'delete', attribute()}. + +-spec parse_transform([form()], [option()]) -> [form()]. + parse_transform(Forms, Options) -> S = #state{forms = Forms, options = Options}, - S2 = init_transform(S), + S2 = init_transform(Options, S), report_verbose("Pre options: ~p~n", [S2#state.pre_ops], S2), report_verbose("Post options: ~p~n", [S2#state.post_ops], S2), S3 = pre_transform(S2), @@ -71,13 +85,6 @@ parse_transform(Forms, Options) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Computes the lists of pre_ops and post_ops that are %% used in the real transformation. -init_transform(S) -> - case S#state.options of - Options when is_list(Options) -> - init_transform(Options, S); - Option -> - init_transform([Option], S) - end. init_transform([{attribute, insert, Name, Val} | Tail], S) -> Op = {insert, Name, Val}, @@ -92,12 +99,9 @@ init_transform([{attribute, delete, Name} | Tail], S) -> Op = {delete, Name}, PreOps = [Op | S#state.pre_ops], init_transform(Tail, S#state{pre_ops = PreOps}); -init_transform([], S) -> - S; init_transform([_ | T], S) -> init_transform(T, S); -init_transform(BadOpt, S) -> - report_error("Illegal option (ignored): ~p~n", [BadOpt], S), +init_transform([], S) -> S. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -176,18 +180,9 @@ attrs([], _, _) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Report functions. %% -%% Errors messages are controlled with the 'report_errors' compiler option %% Warning messages are controlled with the 'report_warnings' compiler option %% Verbose messages are controlled with the 'verbose' compiler option -report_error(Format, Args, S) -> - case is_error(S) of - true -> - io:format("~p: * ERROR * " ++ Format, [?MODULE | Args]); - false -> - ok - end. - report_warning(Format, Args, S) -> case is_warning(S) of true -> @@ -204,9 +199,6 @@ report_verbose(Format, Args, S) -> ok end. -is_error(S) -> - lists:member(report_errors, S#state.options) or is_verbose(S). - is_warning(S) -> lists:member(report_warnings, S#state.options) or is_verbose(S). diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 3627cdb7cd..47c1567f10 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -69,6 +69,10 @@ stk=[], %Stack table res=[]}). %Reserved regs: [{reserved,I,V}] +-type life_module() :: {module(),_,_,[_]}. + +-spec module(life_module(), [compile:option()]) -> {'ok',beam_asm:module_code()}. + module({Mod,Exp,Attr,Forms}, _Options) -> {Fs,St} = functions(Forms, {atom,Mod}), {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 2bfa610628..4b5d7d919c 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -151,6 +151,7 @@ include_attribute(optional_callbacks) -> false; include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> + %%io:format("~w/~w~n", [F,Arity]), try St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=cerl_sets:new()}, {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), @@ -1820,10 +1821,70 @@ select(T, Cs) -> [ C || C <- Cs, clause_con(C) =:= T ]. %% At this point all the clauses have the same constructor, we must %% now separate them according to value. -match_value(Us, T, Cs0, Def, St0) -> - Css = group_value(T, Cs0), +match_value(Us0, T, Cs0, Def, St0) -> + {Us1,Cs1,St1} = partition_intersection(T, Us0, Cs0, St0), + UCss = group_value(T, Us1, Cs1), %%ok = io:format("match_value ~p ~p~n", [T, Css]), - mapfoldl(fun (Cs, St) -> match_clause(Us, Cs, Def, St) end, St0, Css). + mapfoldl(fun ({Us,Cs}, St) -> match_clause(Us, Cs, Def, St) end, St1, UCss). + +%% partition_intersection +%% Partitions a map into two maps with the most common keys to the first map. +%% case <M> of +%% <#{a}> +%% <#{a,b}> +%% <#{a,c}> +%% <#{c}> +%% end +%% becomes +%% case <M,M> of +%% <#{a}, #{ }> +%% <#{a}, #{b}> +%% <#{ }, #{c}> +%% <#{a}, #{c}> +%% end +%% The intention is to group as many keys together as possible and thus +%% reduce the number of lookups to that key. +partition_intersection(k_map, [U|_]=Us0, [_,_|_]=Cs0,St0) -> + Ps = [clause_val(C) || C <- Cs0], + case find_key_partition(Ps) of + no_partition -> + {Us0,Cs0,St0}; + Ks -> + {Cs1,St1} = mapfoldl(fun(#iclause{pats=[Arg|Args]}=C, Sti) -> + {{Arg1,Arg2},St} = partition_key_intersection(Arg, Ks, Sti), + {C#iclause{pats=[Arg1,Arg2|Args]}, St} + end, St0, Cs0), + {[U|Us0],Cs1,St1} + end; +partition_intersection(_, Us, Cs, St) -> + {Us,Cs,St}. + +partition_key_intersection(#k_map{es=Pairs}=Map,Ks,St0) -> + F = fun(#k_map_pair{key=Key}) -> member(map_key_clean(Key), Ks) end, + {Ps1,Ps2} = partition(F, Pairs), + {{Map#k_map{es=Ps1},Map#k_map{es=Ps2}},St0}; +partition_key_intersection(#ialias{pat=Map}=Alias,Ks,St0) -> + %% only alias one of them + {{Map1,Map2},St1} = partition_key_intersection(Map, Ks, St0), + {{Map1,Alias#ialias{pat=Map2}},St1}. + +% Only check for the complete intersection of keys and not commonality +find_key_partition(Ps) -> + Sets = [sets:from_list(Ks)||Ks <- Ps], + Is = sets:intersection(Sets), + case sets:to_list(Is) of + [] -> no_partition; + KeyIntersection -> + %% Check if the intersection are all keys in all clauses. + %% Don't split if they are since this will only + %% infer extra is_map instructions with no gain. + All = foldl(fun (Kset, Bool) -> + Bool andalso sets:is_subset(Kset, Is) + end, true, Sets), + if All -> no_partition; + true -> KeyIntersection + end + end. %% group_value([Clause]) -> [[Clause]]. %% Group clauses according to value. Here we know that @@ -1831,30 +1892,30 @@ match_value(Us, T, Cs0, Def, St0) -> %% 2. The clauses in bin_segs cannot be reordered only grouped %% 3. Other types are disjoint and can be reordered -group_value(k_cons, Cs) -> [Cs]; %These are single valued -group_value(k_nil, Cs) -> [Cs]; -group_value(k_binary, Cs) -> [Cs]; -group_value(k_bin_end, Cs) -> [Cs]; -group_value(k_bin_seg, Cs) -> group_bin_seg(Cs); -group_value(k_bin_int, Cs) -> [Cs]; -group_value(k_map, Cs) -> group_map(Cs); -group_value(_, Cs) -> +group_value(k_cons, Us, Cs) -> [{Us,Cs}]; %These are single valued +group_value(k_nil, Us, Cs) -> [{Us,Cs}]; +group_value(k_binary, Us, Cs) -> [{Us,Cs}]; +group_value(k_bin_end, Us, Cs) -> [{Us,Cs}]; +group_value(k_bin_seg, Us, Cs) -> group_bin_seg(Us,Cs); +group_value(k_bin_int, Us, Cs) -> [{Us,Cs}]; +group_value(k_map, Us, Cs) -> group_map(Us,Cs); +group_value(_, Us, Cs) -> %% group_value(Cs). Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end, dict:new(), Cs), - dict:fold(fun (_, Vcs, Css) -> [Vcs|Css] end, [], Cd). + dict:fold(fun (_, Vcs, Css) -> [{Us,Vcs}|Css] end, [], Cd). -group_bin_seg([C1|Cs]) -> +group_bin_seg(Us, [C1|Cs]) -> V1 = clause_val(C1), {More,Rest} = splitwith(fun (C) -> clause_val(C) == V1 end, Cs), - [[C1|More]|group_bin_seg(Rest)]; -group_bin_seg([]) -> []. + [{Us,[C1|More]}|group_bin_seg(Us,Rest)]; +group_bin_seg(_, []) -> []. -group_map([C1|Cs]) -> +group_map(Us, [C1|Cs]) -> V1 = clause_val(C1), {More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs), - [[C1|More]|group_map(Rest)]; -group_map([]) -> []. + [{Us,[C1|More]}|group_map(Us,Rest)]; +group_map(_, []) -> []. %% Profiling shows that this quadratic implementation account for a big amount %% of the execution time if there are many values. diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index d5f6ee19c9..187e69a22c 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -47,7 +47,7 @@ canno(Cthing) -> element(2, Cthing). --spec format(cerl:cerl()) -> iolist(). +-spec format(#k_mdef{}) -> iolist(). format(Node) -> format(Node, #ctxt{}). diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 0f2aeda87f..be3ade47ff 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -52,10 +52,15 @@ -include("v3_kernel.hrl"). -include("v3_life.hrl"). +-type fa() :: {atom(),arity()}. + %% These are not defined in v3_kernel.hrl. get_kanno(Kthing) -> element(2, Kthing). %%set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). +-spec module(#k_mdef{}, [compile:option()]) -> + {'ok',{module(),[fa()],[_],[_]}}. + module(#k_mdef{name=M,exports=Es,attributes=As,body=Fs0}, _Opts) -> Fs1 = functions(Fs0, []), {ok,{M,Es,As,Fs1}}. @@ -416,6 +421,10 @@ add_var(V, F, L, Vdb) -> vdb_new(Vs) -> sort([{V,0,0} || {var,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; diff --git a/lib/compiler/src/v3_life.hrl b/lib/compiler/src/v3_life.hrl index 9d03a86ccd..5c76312067 100644 --- a/lib/compiler/src/v3_life.hrl +++ b/lib/compiler/src/v3_life.hrl @@ -20,8 +20,10 @@ %% This record contains variable life-time annotation for a %% kernel expression. Added by v3_life, used by v3_codegen. +-type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}. + -record(l, {ke, %Kernel expression - i=0, %Op number - vdb=[], %Variable database - a}). %Core annotation + i=0 :: non_neg_integer(), %Op number + vdb=[] :: [vdb_entry()], %Variable database + a=[] :: [term()]}). %Core annotation diff --git a/lib/compiler/test/beam_reorder_SUITE.erl b/lib/compiler/test/beam_reorder_SUITE.erl index ff31f2d3bd..27ce51eec3 100644 --- a/lib/compiler/test/beam_reorder_SUITE.erl +++ b/lib/compiler/test/beam_reorder_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 69e2f1838d..492067ef00 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index 5e29f8d7b4..a3f1bb93fe 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index e2988b18dc..8c09414a52 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -105,6 +105,14 @@ file_1(Config) when is_list(Config) -> {ok,simple} = compile:file(Simple, [{eprof,beam_z}]), %Coverage + + %% Test option 'deterministic'. + {ok,simple} = compile:file(Simple, [deterministic]), + {module,simple} = c:l(simple), + [{version,_}] = simple:module_info(compile), + true = code:delete(simple), + false = code:purge(simple), + ok = file:set_cwd(Cwd), true = exists(Target), passed = run(Target, test, []), diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index 3cb49433ce..adb96fb87d 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -19,7 +19,7 @@ %% -module(lc_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, basic/1,deeply_nested/1,no_generator/1, @@ -32,11 +32,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. -all() -> +all() -> test_lib:recompile(?MODULE), [{group,p}]. -groups() -> +groups() -> [{p,test_lib:parallel(), [basic, deeply_nested, @@ -214,6 +214,7 @@ shadow(Config) when is_list(Config) -> ok. effect(Config) when is_list(Config) -> + ct:timetrap({minutes,10}), [{42,{a,b,c}}] = do_effect(fun(F, L) -> [F({V1,V2}) || @@ -240,7 +241,7 @@ do_effect(Lc, L) -> lists:reverse(erase(?MODULE)). id(I) -> I. - + fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}}) when length(Args) =:= Arity -> diff --git a/lib/compiler/test/regressions_SUITE.erl b/lib/compiler/test/regressions_SUITE.erl index 7d2c2ac974..7a6fe08c73 100644 --- a/lib/compiler/test/regressions_SUITE.erl +++ b/lib/compiler/test/regressions_SUITE.erl @@ -24,7 +24,7 @@ -export([all/0,groups/0,init_per_testcase/2,end_per_testcase/2,suite/0]). -export([maps/1]). -groups() -> +groups() -> [{p,test_lib:parallel(), [maps]}]. @@ -38,7 +38,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. -all() -> +all() -> test_lib:recompile(?MODULE), [{group,p}]. @@ -48,7 +48,18 @@ maps(Config) when is_list(Config) -> Ts = [{beam_bool_get_elements, <<"century(#{ron := operator}, _century) -> if 0.0; _century, _century, _century -> _century end. - ">>}], + ">>}, + {empty_map_clauses, + <<"politics(#{}, researchers) -> concerned; + politics(#{[] := _}, workers) -> dot; + politics(#{[] := ct}, counsel) -> calls. + ">>}, + {empty_map_clauses_variable, + <<"georgia(#{a := effectively}, ratio, is, eventually) -> teens; + georgia(#{a := government}, knowledge, poker, partly) -> signed; + georgia(#{}, recording, bring, vital) -> divided; + georgia(#{0 := 0}, articles, brought, #{true := true, a := There}) -> There. + ">>}], ok = run(Config, Ts), ok. @@ -58,7 +69,7 @@ run(Config, Tests) -> F = fun({N,P}) -> io:format("Compiling test for: ~w~n", [N]), case catch run_test(Config, P) of - {'EXIT', Reason} -> + {'EXIT', Reason} -> io:format("~nTest ~p failed.~nReason: ~p~n", [N, Reason]), fail(); diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 87fde38f2b..9c3cf1f34b 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.0.2 +COMPILER_VSN = 7.0.3 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 86b839eddb..38b49c7a76 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -65,66 +65,66 @@ /* Helper macro to construct a OPENSSL_VERSION_NUMBER. * See openssl/opensslv.h */ -#define OpenSSL_version(MAJ, MIN, FIX, P) \ +#define PACKED_OPENSSL_VERSION(MAJ, MIN, FIX, P) \ ((((((((MAJ << 8) | MIN) << 8 ) | FIX) << 8) | (P-'a'+1)) << 4) | 0xf) -#define OpenSSL_version_plain(MAJ, MIN, FIX) \ - OpenSSL_version(MAJ,MIN,FIX,('a'-1)) +#define PACKED_OPENSSL_VERSION_PLAIN(MAJ, MIN, FIX) \ + PACKED_OPENSSL_VERSION(MAJ,MIN,FIX,('a'-1)) -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) #include <openssl/modes.h> #endif #include "crypto_callback.h" -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(0,9,8) \ +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(0,9,8) \ && !defined(OPENSSL_NO_SHA224) && defined(NID_sha224) \ && !defined(OPENSSL_NO_SHA256) /* disabled like this in my sha.h (?) */ # define HAVE_SHA224 #endif -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(0,9,8) \ +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(0,9,8) \ && !defined(OPENSSL_NO_SHA256) && defined(NID_sha256) # define HAVE_SHA256 #endif -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(0,9,8) \ +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(0,9,8) \ && !defined(OPENSSL_NO_SHA384) && defined(NID_sha384)\ && !defined(OPENSSL_NO_SHA512) /* disabled like this in my sha.h (?) */ # define HAVE_SHA384 #endif -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(0,9,8) \ +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(0,9,8) \ && !defined(OPENSSL_NO_SHA512) && defined(NID_sha512) # define HAVE_SHA512 #endif -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version(0,9,7,'e') +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,7,'e') # define HAVE_DES_ede3_cfb_encrypt #endif -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version(0,9,8,'o') \ +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'o') \ && !defined(OPENSSL_NO_EC) \ && !defined(OPENSSL_NO_ECDH) \ && !defined(OPENSSL_NO_ECDSA) # define HAVE_EC #endif -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version(0,9,8,'c') +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'c') # define HAVE_AES_IGE #endif -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,1) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,1) # define HAVE_EVP_AES_CTR # define HAVE_GCM # define HAVE_CMAC -# if OPENSSL_VERSION_NUMBER < OpenSSL_version(1,0,1,'d') +# if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION(1,0,1,'d') # define HAVE_GCM_EVP_DECRYPT_BUG # endif #endif -#if defined(NID_chacha20) && !defined(OPENSSL_NO_CHACHA) && !defined(OPENSSL_NO_POLY1305) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,0) # define HAVE_CHACHA20_POLY1305 #endif -#if OPENSSL_VERSION_NUMBER <= OpenSSL_version(0,9,8,'l') +#if OPENSSL_VERSION_NUMBER <= PACKED_OPENSSL_VERSION(0,9,8,'l') # define HAVE_ECB_IVEC_BUG #endif @@ -138,19 +138,6 @@ #include <openssl/ecdsa.h> #endif -#if defined(HAVE_CHACHA20_POLY1305) -#include <openssl/chacha.h> -#include <openssl/poly1305.h> - -#if !defined(CHACHA20_NONCE_LEN) -# define CHACHA20_NONCE_LEN 8 -#endif -#if !defined(POLY1305_TAG_LEN) -# define POLY1305_TAG_LEN 16 -#endif - -#endif - #ifdef VALGRIND # include <valgrind/memcheck.h> @@ -219,6 +206,122 @@ do { \ } \ } while (0) +#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) + +/* + * In OpenSSL 1.1.0, most structs are opaque. That means that + * the structs cannot be allocated as automatic variables on the + * C stack (because the size is unknown) and that it is necessary + * to use access functions. + * + * For backward compatibility to previous versions of OpenSSL, define + * on our versions of the new functions defined in 1.1.0 here, so that + * we don't have to sprinkle ifdefs throughout the code. + */ + +static HMAC_CTX *HMAC_CTX_new(void); +static void HMAC_CTX_free(HMAC_CTX *ctx); + +static HMAC_CTX *HMAC_CTX_new() +{ + HMAC_CTX *ctx = CRYPTO_malloc(sizeof(HMAC_CTX), __FILE__, __LINE__); + HMAC_CTX_init(ctx); + return ctx; +} + +static void HMAC_CTX_free(HMAC_CTX *ctx) +{ + HMAC_CTX_cleanup(ctx); + return CRYPTO_free(ctx); +} + +#define EVP_MD_CTX_new() EVP_MD_CTX_create() +#define EVP_MD_CTX_free(ctx) EVP_MD_CTX_destroy(ctx) + +static INLINE int RSA_set0_key(RSA *r, BIGNUM *n, BIGNUM *e, BIGNUM *d); +static INLINE int RSA_set0_factors(RSA *r, BIGNUM *p, BIGNUM *q); +static INLINE int RSA_set0_crt_params(RSA *r, BIGNUM *dmp1, BIGNUM *dmq1, BIGNUM *iqmp); + +static INLINE int RSA_set0_key(RSA *r, BIGNUM *n, BIGNUM *e, BIGNUM *d) +{ + r->n = n; + r->e = e; + r->d = d; + return 1; +} + +static INLINE int RSA_set0_factors(RSA *r, BIGNUM *p, BIGNUM *q) +{ + r->p = p; + r->q = q; + return 1; +} + +static INLINE int RSA_set0_crt_params(RSA *r, BIGNUM *dmp1, BIGNUM *dmq1, BIGNUM *iqmp) +{ + r->dmp1 = dmp1; + r->dmq1 = dmq1; + r->iqmp = iqmp; + return 1; +} + +static INLINE int DSA_set0_key(DSA *d, BIGNUM *pub_key, BIGNUM *priv_key); +static INLINE int DSA_set0_pqg(DSA *d, BIGNUM *p, BIGNUM *q, BIGNUM *g); + +static INLINE int DSA_set0_key(DSA *d, BIGNUM *pub_key, BIGNUM *priv_key) +{ + d->pub_key = pub_key; + d->priv_key = priv_key; + return 1; +} + +static INLINE int DSA_set0_pqg(DSA *d, BIGNUM *p, BIGNUM *q, BIGNUM *g) +{ + d->p = p; + d->q = q; + d->g = g; + return 1; +} + +static INLINE int DH_set0_key(DH *dh, BIGNUM *pub_key, BIGNUM *priv_key); +static INLINE int DH_set0_pqg(DH *dh, BIGNUM *p, BIGNUM *q, BIGNUM *g); +static INLINE void DH_get0_pqg(const DH *dh, + const BIGNUM **p, const BIGNUM **q, const BIGNUM **g); +static INLINE void DH_get0_key(const DH *dh, + const BIGNUM **pub_key, const BIGNUM **priv_key); + +static INLINE int DH_set0_key(DH *dh, BIGNUM *pub_key, BIGNUM *priv_key) +{ + dh->pub_key = pub_key; + dh->priv_key = priv_key; + return 1; +} + +static INLINE int DH_set0_pqg(DH *dh, BIGNUM *p, BIGNUM *q, BIGNUM *g) +{ + dh->p = p; + dh->q = q; + dh->g = g; + return 1; +} + +static INLINE void +DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g) +{ + *p = dh->p; + *q = dh->q; + *g = dh->g; +} + +static INLINE void +DH_get0_key(const DH *dh, const BIGNUM **pub_key, const BIGNUM **priv_key) +{ + *pub_key = dh->pub_key; + *priv_key = dh->priv_key; +} + +#endif /* End of compatibility definitions. */ + /* NIF interface declarations */ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); @@ -403,7 +506,7 @@ struct hmac_context { ErlNifMutex* mtx; int alive; - HMAC_CTX ctx; + HMAC_CTX* ctx; }; static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); @@ -530,18 +633,24 @@ static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len); #define PRINTF_ERR1(FMT,A1) #define PRINTF_ERR2(FMT,A1,A2) -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) /* Define resource types for OpenSSL context structures. */ static ErlNifResourceType* evp_md_ctx_rtype; -static void evp_md_ctx_dtor(ErlNifEnv* env, EVP_MD_CTX* ctx) { - EVP_MD_CTX_cleanup(ctx); +struct evp_md_ctx { + EVP_MD_CTX* ctx; +}; +static void evp_md_ctx_dtor(ErlNifEnv* env, struct evp_md_ctx *ctx) { + EVP_MD_CTX_free(ctx->ctx); } #endif #ifdef HAVE_EVP_AES_CTR static ErlNifResourceType* evp_cipher_ctx_rtype; -static void evp_cipher_ctx_dtor(ErlNifEnv* env, EVP_CIPHER_CTX* ctx) { - EVP_CIPHER_CTX_cleanup(ctx); +struct evp_cipher_ctx { + EVP_CIPHER_CTX* ctx; +}; +static void evp_cipher_ctx_dtor(ErlNifEnv* env, struct evp_cipher_ctx* ctx) { + EVP_CIPHER_CTX_free(ctx->ctx); } #endif @@ -636,7 +745,7 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'"); return __LINE__; } -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) evp_md_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_MD_CTX", (ErlNifResourceDtor*) evp_md_ctx_dtor, ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, @@ -811,7 +920,7 @@ static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */ static int algo_pubkey_cnt, algo_pubkey_fips_cnt; static ERL_NIF_TERM algo_pubkey[7]; /* increase when extending the list */ static int algo_cipher_cnt, algo_cipher_fips_cnt; -static ERL_NIF_TERM algo_cipher[23]; /* increase when extending the list */ +static ERL_NIF_TERM algo_cipher[24]; /* increase when extending the list */ static void init_algorithms_types(ErlNifEnv* env) { @@ -1019,12 +1128,12 @@ static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] return ret; } -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type) */ struct digest_type_t *digp = NULL; - EVP_MD_CTX *ctx; + struct evp_md_ctx *ctx; ERL_NIF_TERM ret; digp = get_digest_type(argv[0]); @@ -1035,8 +1144,9 @@ static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a return atom_notsup; } - ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX)); - if (!EVP_DigestInit(ctx, digp->md.p)) { + ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx)); + ctx->ctx = EVP_MD_CTX_new(); + if (!EVP_DigestInit(ctx->ctx, digp->md.p)) { enif_release_resource(ctx); return atom_notsup; } @@ -1046,7 +1156,7 @@ static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a } static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ - EVP_MD_CTX *ctx, *new_ctx; + struct evp_md_ctx *ctx, *new_ctx; ErlNifBinary data; ERL_NIF_TERM ret; @@ -1055,9 +1165,10 @@ static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return enif_make_badarg(env); } - new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX)); - if (!EVP_MD_CTX_copy(new_ctx, ctx) || - !EVP_DigestUpdate(new_ctx, data.data, data.size)) { + new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx)); + new_ctx->ctx = EVP_MD_CTX_new(); + if (!EVP_MD_CTX_copy(new_ctx->ctx, ctx->ctx) || + !EVP_DigestUpdate(new_ctx->ctx, data.data, data.size)) { enif_release_resource(new_ctx); return atom_notsup; } @@ -1069,7 +1180,8 @@ static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM } static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context) */ - EVP_MD_CTX *ctx, new_ctx; + struct evp_md_ctx *ctx; + EVP_MD_CTX *new_ctx; ERL_NIF_TERM ret; unsigned ret_size; @@ -1077,16 +1189,19 @@ static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return enif_make_badarg(env); } - ret_size = (unsigned)EVP_MD_CTX_size(ctx); + ret_size = (unsigned)EVP_MD_CTX_size(ctx->ctx); ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE); - if (!EVP_MD_CTX_copy(&new_ctx, ctx) || - !EVP_DigestFinal(&new_ctx, + new_ctx = EVP_MD_CTX_new(); + if (!EVP_MD_CTX_copy(new_ctx, ctx->ctx) || + !EVP_DigestFinal(new_ctx, enif_make_new_binary(env, ret_size, &ret), &ret_size)) { + EVP_MD_CTX_free(new_ctx); return atom_notsup; } - ASSERT(ret_size == (unsigned)EVP_MD_CTX_size(ctx)); + EVP_MD_CTX_free(new_ctx); + ASSERT(ret_size == (unsigned)EVP_MD_CTX_size(ctx->ctx)); return ret; } @@ -1370,7 +1485,7 @@ static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj) { if (obj->alive) { - HMAC_CTX_cleanup(&obj->ctx); + HMAC_CTX_free(obj->ctx); obj->alive = 0; } enif_mutex_destroy(obj->mtx); @@ -1395,15 +1510,16 @@ static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context)); obj->mtx = enif_mutex_create("crypto.hmac"); obj->alive = 1; -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) + obj->ctx = HMAC_CTX_new(); +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) // Check the return value of HMAC_Init: it may fail in FIPS mode // for disabled algorithms - if (!HMAC_Init(&obj->ctx, key.data, key.size, digp->md.p)) { + if (!HMAC_Init_ex(obj->ctx, key.data, key.size, digp->md.p, NULL)) { enif_release_resource(obj); return atom_notsup; } #else - HMAC_Init(&obj->ctx, key.data, key.size, digp->md.p); + HMAC_Init_ex(obj->ctx, key.data, key.size, digp->md.p, NULL); #endif ret = enif_make_resource(env, obj); @@ -1425,7 +1541,7 @@ static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM enif_mutex_unlock(obj->mtx); return enif_make_badarg(env); } - HMAC_Update(&obj->ctx, data.data, data.size); + HMAC_Update(obj->ctx, data.data, data.size); enif_mutex_unlock(obj->mtx); CONSUME_REDS(env,data); @@ -1452,8 +1568,8 @@ static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return enif_make_badarg(env); } - HMAC_Final(&obj->ctx, mac_buf, &mac_len); - HMAC_CTX_cleanup(&obj->ctx); + HMAC_Final(obj->ctx, mac_buf, &mac_len); + HMAC_CTX_free(obj->ctx); obj->alive = 0; enif_mutex_unlock(obj->mtx); @@ -1519,7 +1635,7 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM struct cipher_type_t *cipherp = NULL; const EVP_CIPHER *cipher; ErlNifBinary key, ivec, text; - EVP_CIPHER_CTX ctx; + EVP_CIPHER_CTX* ctx; ERL_NIF_TERM ret; unsigned char *out; int ivec_size, out_size = 0; @@ -1564,30 +1680,30 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM out = enif_make_new_binary(env, text.size, &ret); - EVP_CIPHER_CTX_init(&ctx); - if (!EVP_CipherInit_ex(&ctx, cipher, NULL, NULL, NULL, + ctx = EVP_CIPHER_CTX_new(); + if (!EVP_CipherInit_ex(ctx, cipher, NULL, NULL, NULL, (argv[argc - 1] == atom_true)) || - !EVP_CIPHER_CTX_set_key_length(&ctx, key.size) || + !EVP_CIPHER_CTX_set_key_length(ctx, key.size) || !(EVP_CIPHER_type(cipher) != NID_rc2_cbc || - EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_SET_RC2_KEY_BITS, key.size * 8, NULL)) || - !EVP_CipherInit_ex(&ctx, NULL, NULL, + EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_SET_RC2_KEY_BITS, key.size * 8, NULL)) || + !EVP_CipherInit_ex(ctx, NULL, NULL, key.data, ivec_size ? ivec.data : NULL, -1) || - !EVP_CIPHER_CTX_set_padding(&ctx, 0)) { + !EVP_CIPHER_CTX_set_padding(ctx, 0)) { - EVP_CIPHER_CTX_cleanup(&ctx); + EVP_CIPHER_CTX_free(ctx); return enif_raise_exception(env, atom_notsup); } if (text.size > 0 && /* OpenSSL 0.9.8h asserts text.size > 0 */ - (!EVP_CipherUpdate(&ctx, out, &out_size, text.data, text.size) + (!EVP_CipherUpdate(ctx, out, &out_size, text.data, text.size) || (ASSERT(out_size == text.size), 0) - || !EVP_CipherFinal_ex(&ctx, out + out_size, &out_size))) { + || !EVP_CipherFinal_ex(ctx, out + out_size, &out_size))) { - EVP_CIPHER_CTX_cleanup(&ctx); + EVP_CIPHER_CTX_free(ctx); return enif_raise_exception(env, atom_notsup); } ASSERT(out_size == 0); - EVP_CIPHER_CTX_cleanup(&ctx); + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, text); return ret; @@ -1668,7 +1784,7 @@ static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec) */ ErlNifBinary key_bin, ivec_bin; - EVP_CIPHER_CTX *ctx; + struct evp_cipher_ctx *ctx; const EVP_CIPHER *cipher; ERL_NIF_TERM ret; @@ -1686,18 +1802,18 @@ static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_ default: return enif_make_badarg(env); } - ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(EVP_CIPHER_CTX)); - EVP_CIPHER_CTX_init(ctx); - EVP_CipherInit_ex(ctx, cipher, NULL, + 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, 0); + EVP_CIPHER_CTX_set_padding(ctx->ctx, 0); ret = enif_make_resource(env, ctx); enif_release_resource(ctx); return ret; } static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ - EVP_CIPHER_CTX *ctx, *new_ctx; + struct evp_cipher_ctx *ctx, *new_ctx; ErlNifBinary data_bin; ERL_NIF_TERM ret, cipher_term; unsigned char *out; @@ -1707,11 +1823,11 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N || !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(EVP_CIPHER_CTX)); - EVP_CIPHER_CTX_init(new_ctx); - EVP_CIPHER_CTX_copy(new_ctx, ctx); + 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, out, &outl, data_bin.data, data_bin.size); + 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); @@ -1782,7 +1898,7 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ #if defined(HAVE_GCM) - EVP_CIPHER_CTX ctx; + EVP_CIPHER_CTX *ctx; const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; unsigned int tag_len; @@ -1806,40 +1922,40 @@ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM else if (key.size == 32) cipher = EVP_aes_256_gcm(); - EVP_CIPHER_CTX_init(&ctx); + ctx = EVP_CIPHER_CTX_new(); - if (EVP_EncryptInit_ex(&ctx, cipher, NULL, NULL, NULL) != 1) + if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) goto out_err; - EVP_CIPHER_CTX_set_padding(&ctx, 0); + EVP_CIPHER_CTX_set_padding(ctx, 0); - if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) goto out_err; - if (EVP_EncryptInit_ex(&ctx, NULL, NULL, key.data, iv.data) != 1) + if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err; - if (EVP_EncryptUpdate(&ctx, NULL, &len, aad.data, aad.size) != 1) + if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) goto out_err; outp = enif_make_new_binary(env, in.size, &out); - if (EVP_EncryptUpdate(&ctx, outp, &len, in.data, in.size) != 1) + if (EVP_EncryptUpdate(ctx, outp, &len, in.data, in.size) != 1) goto out_err; - if (EVP_EncryptFinal_ex(&ctx, outp+len, &len) != 1) + if (EVP_EncryptFinal_ex(ctx, outp+len, &len) != 1) goto out_err; tagp = enif_make_new_binary(env, tag_len, &out_tag); - if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_GET_TAG, tag_len, tagp) != 1) + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_GET_TAG, tag_len, tagp) != 1) goto out_err; - EVP_CIPHER_CTX_cleanup(&ctx); + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return enif_make_tuple2(env, out, out_tag); out_err: - EVP_CIPHER_CTX_cleanup(&ctx); + EVP_CIPHER_CTX_free(ctx); return atom_error; #else @@ -1852,7 +1968,7 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM #if defined(HAVE_GCM_EVP_DECRYPT_BUG) return aes_gcm_decrypt_NO_EVP(env, argc, argv); #elif defined(HAVE_GCM) - EVP_CIPHER_CTX ctx; + EVP_CIPHER_CTX *ctx; const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; unsigned char *outp; @@ -1875,34 +1991,34 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM else if (key.size == 32) cipher = EVP_aes_256_gcm(); - EVP_CIPHER_CTX_init(&ctx); + ctx = EVP_CIPHER_CTX_new(); - if (EVP_DecryptInit_ex(&ctx, cipher, NULL, NULL, NULL) != 1) + if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) goto out_err; - if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) goto out_err; - if (EVP_DecryptInit_ex(&ctx, NULL, NULL, key.data, iv.data) != 1) + if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err; - if (EVP_DecryptUpdate(&ctx, NULL, &len, aad.data, aad.size) != 1) + if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) goto out_err; outp = enif_make_new_binary(env, in.size, &out); - if (EVP_DecryptUpdate(&ctx, outp, &len, in.data, in.size) != 1) + if (EVP_DecryptUpdate(ctx, outp, &len, in.data, in.size) != 1) goto out_err; - if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_TAG, tag.size, tag.data) != 1) + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_TAG, tag.size, tag.data) != 1) goto out_err; - if (EVP_DecryptFinal_ex(&ctx, outp+len, &len) != 1) + if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) goto out_err; - EVP_CIPHER_CTX_cleanup(&ctx); + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return out; out_err: - EVP_CIPHER_CTX_cleanup(&ctx); + EVP_CIPHER_CTX_free(ctx); return atom_error; #else return enif_raise_exception(env, atom_notsup); @@ -1956,71 +2072,61 @@ out_err: } #endif /* HAVE_GCM_EVP_DECRYPT_BUG */ -#if defined(HAVE_CHACHA20_POLY1305) -static void -poly1305_update_with_length(poly1305_state *poly1305, - const unsigned char *data, size_t data_len) -{ - size_t j = data_len; - unsigned char length_bytes[8]; - unsigned i; - - for (i = 0; i < sizeof(length_bytes); i++) { - length_bytes[i] = j; - j >>= 8; - } - - CRYPTO_poly1305_update(poly1305, data, data_len); - CRYPTO_poly1305_update(poly1305, length_bytes, sizeof(length_bytes)); -} -#endif static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ #if defined(HAVE_CHACHA20_POLY1305) + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; - unsigned char *outp; + unsigned char *outp, *tagp; ERL_NIF_TERM out, out_tag; - ErlNifUInt64 in_len_64; - unsigned char poly1305_key[32]; - poly1305_state poly1305; + int len; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 - || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 || iv.size > 16 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { return enif_make_badarg(env); } - /* Take from OpenSSL patch set/LibreSSL: - * - * The underlying ChaCha implementation may not overflow the block - * counter into the second counter word. Therefore we disallow - * individual operations that work on more than 2TB at a time. - * in_len_64 is needed because, on 32-bit platforms, size_t is only - * 32-bits and this produces a warning because it's always false. - * Casting to uint64_t inside the conditional is not sufficient to stop - * the warning. */ - in_len_64 = in.size; - if (in_len_64 >= (1ULL << 32) * 64 - 64) - return enif_make_badarg(env); + cipher = EVP_chacha20_poly1305(); + + ctx = EVP_CIPHER_CTX_new(); + + if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; + + EVP_CIPHER_CTX_set_padding(ctx, 0); - memset(poly1305_key, 0, sizeof(poly1305_key)); - CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_SET_IVLEN, iv.size, NULL) != 1) + goto out_err; + if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto out_err; + if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) + goto out_err; outp = enif_make_new_binary(env, in.size, &out); - CRYPTO_poly1305_init(&poly1305, poly1305_key); - poly1305_update_with_length(&poly1305, aad.data, aad.size); - CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); - poly1305_update_with_length(&poly1305, outp, in.size); + if (EVP_EncryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_EncryptFinal_ex(ctx, outp+len, &len) != 1) + goto out_err; - CRYPTO_poly1305_finish(&poly1305, enif_make_new_binary(env, POLY1305_TAG_LEN, &out_tag)); + tagp = enif_make_new_binary(env, 16, &out_tag); + + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_GET_TAG, 16, tagp) != 1) + goto out_err; + + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return enif_make_tuple2(env, out, out_tag); +out_err: + EVP_CIPHER_CTX_free(ctx); + return atom_error; #else return enif_raise_exception(env, atom_notsup); #endif @@ -2029,53 +2135,52 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In,Tag) */ #if defined(HAVE_CHACHA20_POLY1305) + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; unsigned char *outp; ERL_NIF_TERM out; - ErlNifUInt64 in_len_64; - unsigned char poly1305_key[32]; - unsigned char mac[POLY1305_TAG_LEN]; - poly1305_state poly1305; + int len; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 - || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 || iv.size > 16 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in) - || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != POLY1305_TAG_LEN) { + || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != 16) { return enif_make_badarg(env); } - /* Take from OpenSSL patch set/LibreSSL: - * - * The underlying ChaCha implementation may not overflow the block - * counter into the second counter word. Therefore we disallow - * individual operations that work on more than 2TB at a time. - * in_len_64 is needed because, on 32-bit platforms, size_t is only - * 32-bits and this produces a warning because it's always false. - * Casting to uint64_t inside the conditional is not sufficient to stop - * the warning. */ - in_len_64 = in.size; - if (in_len_64 >= (1ULL << 32) * 64 - 64) - return enif_make_badarg(env); + cipher = EVP_chacha20_poly1305(); - memset(poly1305_key, 0, sizeof(poly1305_key)); - CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + ctx = EVP_CIPHER_CTX_new(); - CRYPTO_poly1305_init(&poly1305, poly1305_key); - poly1305_update_with_length(&poly1305, aad.data, aad.size); - poly1305_update_with_length(&poly1305, in.data, in.size); - CRYPTO_poly1305_finish(&poly1305, mac); - - if (memcmp(mac, tag.data, POLY1305_TAG_LEN) != 0) - return atom_error; + if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_SET_IVLEN, iv.size, NULL) != 1) + goto out_err; + if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto out_err; + if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) + goto out_err; outp = enif_make_new_binary(env, in.size, &out); - CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); + if (EVP_DecryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_SET_TAG, tag.size, tag.data) != 1) + goto out_err; + if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) + goto out_err; + + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return out; + +out_err: + EVP_CIPHER_CTX_free(ctx); + return atom_error; #else return enif_raise_exception(env, atom_notsup); #endif @@ -2224,13 +2329,10 @@ static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM } dsa = DSA_new(); - dsa->p = dsa_p; - dsa->q = dsa_q; - dsa->g = dsa_g; - dsa->priv_key = NULL; - dsa->pub_key = dsa_y; - i = DSA_verify(0, digest_bin.data, SHA_DIGEST_LENGTH, - sign_bin.data, sign_bin.size, dsa); + DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g); + DSA_set0_key(dsa, dsa_y, NULL); + i = DSA_verify(0, digest_bin.data, SHA_DIGEST_LENGTH, + sign_bin.data, sign_bin.size, dsa); DSA_free(dsa); return(i > 0) ? atom_true : atom_false; } @@ -2287,13 +2389,15 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ERL_NIF_TERM head, tail, ret; int i; RSA *rsa; -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) EVP_PKEY *pkey; EVP_PKEY_CTX *ctx; #endif const EVP_MD *md; const ERL_NIF_TERM type = argv[0]; struct digest_type_t *digp = NULL; + BIGNUM *rsa_e; + BIGNUM *rsa_n; digp = get_digest_type(type); if (!digp) { @@ -2310,16 +2414,18 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM || digest_bin.size != EVP_MD_size(md) || !enif_inspect_binary(env, argv[2], &sign_bin) || !enif_get_list_cell(env, argv[3], &head, &tail) - || !get_bn_from_bin(env, head, &rsa->e) + || !get_bn_from_bin(env, head, &rsa_e) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->n) + || !get_bn_from_bin(env, head, &rsa_n) || !enif_is_empty_list(env, tail)) { ret = enif_make_badarg(env); goto done; } -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) + (void) RSA_set0_key(rsa, rsa_n, rsa_e, NULL); + +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) pkey = EVP_PKEY_new(); EVP_PKEY_set1_RSA(pkey, rsa); @@ -2413,34 +2519,44 @@ static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) { /* key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C] */ ERL_NIF_TERM head, tail; + BIGNUM *e, *n, *d; + BIGNUM *p, *q; + BIGNUM *dmp1, *dmq1, *iqmp; if (!enif_get_list_cell(env, key, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->e) + || !get_bn_from_bin(env, head, &e) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_bin(env, head, &n) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_bin(env, head, &d)) { + return 0; + } + (void) RSA_set0_key(rsa, n, e, d); + if (enif_is_empty_list(env, tail)) { + return 1; + } + if (!enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_bin(env, head, &p) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_bin(env, head, &q) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_bin(env, head, &dmp1) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->n) + || !get_bn_from_bin(env, head, &dmq1) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->d) - || (!enif_is_empty_list(env, tail) && - (!enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->p) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->q) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->dmp1) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->dmq1) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->iqmp) - || !enif_is_empty_list(env, tail)))) { + || !get_bn_from_bin(env, head, &iqmp) + || !enif_is_empty_list(env, tail)) { return 0; } + (void) RSA_set0_factors(rsa, p, q); + (void) RSA_set0_crt_params(rsa, dmp1, dmq1, iqmp); return 1; } static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Digest, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */ ErlNifBinary digest_bin, ret_bin; -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) EVP_PKEY *pkey; EVP_PKEY_CTX *ctx; size_t rsa_s_len; @@ -2473,7 +2589,7 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } -#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,0) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) pkey = EVP_PKEY_new(); EVP_PKEY_set1_RSA(pkey, rsa); rsa_s_len=(size_t)EVP_PKEY_size(pkey); @@ -2520,6 +2636,8 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar ERL_NIF_TERM head, tail; unsigned int dsa_s_len; DSA* dsa; + BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL; + BIGNUM *dummy_pub_key, *priv_key = NULL; int i; if (argv[0] != atom_sha @@ -2528,26 +2646,37 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return enif_make_badarg(env); } - dsa = DSA_new(); - - dsa->pub_key = NULL; if (!enif_get_list_cell(env, argv[2], &head, &tail) - || !get_bn_from_bin(env, head, &dsa->p) + || !get_bn_from_bin(env, head, &dsa_p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dsa->q) + || !get_bn_from_bin(env, head, &dsa_q) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dsa->g) + || !get_bn_from_bin(env, head, &dsa_g) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dsa->priv_key) + || !get_bn_from_bin(env, head, &priv_key) || !enif_is_empty_list(env,tail)) { - DSA_free(dsa); + if (dsa_p) BN_free(dsa_p); + if (dsa_q) BN_free(dsa_q); + if (dsa_g) BN_free(dsa_g); + if (priv_key) BN_free(priv_key); return enif_make_badarg(env); } + /* Note: DSA_set0_key() does not allow setting only the + * private key, although DSA_sign() does not use the + * public key. Work around this limitation by setting + * the public key to a copy of the private key. + */ + dummy_pub_key = BN_dup(priv_key); + + dsa = DSA_new(); + DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g); + DSA_set0_key(dsa, dummy_pub_key, priv_key); enif_alloc_binary(DSA_size(dsa), &ret_bin); i = DSA_sign(NID_sha1, digest_bin.data, SHA_DIGEST_LENGTH, ret_bin.data, &dsa_s_len, dsa); DSA_free(dsa); + if (i) { if (dsa_s_len != ret_bin.size) { enif_realloc_binary(&ret_bin, dsa_s_len); @@ -2584,20 +2713,22 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER ERL_NIF_TERM head, tail; int padding, i; RSA* rsa; + BIGNUM *e, *n; rsa = RSA_new(); if (!enif_inspect_binary(env, argv[0], &data_bin) || !enif_get_list_cell(env, argv[1], &head, &tail) - || !get_bn_from_bin(env, head, &rsa->e) + || !get_bn_from_bin(env, head, &e) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &rsa->n) + || !get_bn_from_bin(env, head, &n) || !enif_is_empty_list(env,tail) || !rsa_pad(argv[2], &padding)) { RSA_free(rsa); return enif_make_badarg(env); } + (void) RSA_set0_key(rsa, n, e, NULL); enif_alloc_binary(RSA_size(rsa), &ret_bin); @@ -2678,6 +2809,7 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E int p_len, g_len; unsigned char *p_ptr, *g_ptr; ERL_NIF_TERM ret_p, ret_g; + const BIGNUM *dh_p, *dh_q, *dh_g; if (!enif_get_int(env, argv[0], &prime_len) || !enif_get_int(env, argv[1], &generator)) { @@ -2688,15 +2820,16 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E if (dh_params == NULL) { return atom_error; } - p_len = BN_num_bytes(dh_params->p); - g_len = BN_num_bytes(dh_params->g); + DH_get0_pqg(dh_params, &dh_p, &dh_q, &dh_g); + DH_free(dh_params); + p_len = BN_num_bytes(dh_p); + g_len = BN_num_bytes(dh_g); p_ptr = enif_make_new_binary(env, p_len, &ret_p); g_ptr = enif_make_new_binary(env, g_len, &ret_g); - BN_bn2bin(dh_params->p, p_ptr); - BN_bn2bin(dh_params->g, g_ptr); + BN_bn2bin(dh_p, p_ptr); + BN_bn2bin(dh_g, g_ptr); ERL_VALGRIND_MAKE_MEM_DEFINED(p_ptr, p_len); ERL_VALGRIND_MAKE_MEM_DEFINED(g_ptr, g_len); - DH_free(dh_params); return enif_make_list2(env, ret_p, ret_g); } @@ -2705,18 +2838,19 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] DH* dh_params; int i; ERL_NIF_TERM ret, head, tail; - - dh_params = DH_new(); + BIGNUM *dh_p, *dh_g; if (!enif_get_list_cell(env, argv[0], &head, &tail) - || !get_bn_from_bin(env, head, &dh_params->p) + || !get_bn_from_bin(env, head, &dh_p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dh_params->g) + || !get_bn_from_bin(env, head, &dh_g) || !enif_is_empty_list(env,tail)) { - DH_free(dh_params); return enif_make_badarg(env); } + + dh_params = DH_new(); + DH_set0_pqg(dh_params, dh_p, NULL, dh_g); if (DH_check(dh_params, &i)) { if (i == 0) ret = atom_ok; else if (i & DH_CHECK_P_NOT_PRIME) ret = atom_not_prime; @@ -2739,32 +2873,40 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ unsigned char *pub_ptr, *prv_ptr; ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; int mpint; /* 0 or 4 */ + BIGNUM *priv_key = NULL; + BIGNUM *dh_p = NULL, *dh_g = NULL; - dh_params = DH_new(); - - if (!(get_bn_from_bin(env, argv[0], &dh_params->priv_key) + if (!(get_bn_from_bin(env, argv[0], &priv_key) || argv[0] == atom_undefined) || !enif_get_list_cell(env, argv[1], &head, &tail) - || !get_bn_from_bin(env, head, &dh_params->p) + || !get_bn_from_bin(env, head, &dh_p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dh_params->g) + || !get_bn_from_bin(env, head, &dh_g) || !enif_is_empty_list(env, tail) || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)) { - DH_free(dh_params); + if (priv_key) BN_free(priv_key); + if (dh_p) BN_free(dh_p); + if (dh_g) BN_free(dh_g); return enif_make_badarg(env); } + dh_params = DH_new(); + DH_set0_key(dh_params, NULL, priv_key); + DH_set0_pqg(dh_params, dh_p, NULL, dh_g); + if (DH_generate_key(dh_params)) { - pub_len = BN_num_bytes(dh_params->pub_key); - prv_len = BN_num_bytes(dh_params->priv_key); + const BIGNUM *pub_key, *priv_key; + DH_get0_key(dh_params, &pub_key, &priv_key); + pub_len = BN_num_bytes(pub_key); + prv_len = BN_num_bytes(priv_key); pub_ptr = enif_make_new_binary(env, pub_len+mpint, &ret_pub); prv_ptr = enif_make_new_binary(env, prv_len+mpint, &ret_prv); if (mpint) { put_int32(pub_ptr, pub_len); pub_ptr += 4; put_int32(prv_ptr, prv_len); prv_ptr += 4; } - BN_bn2bin(dh_params->pub_key, pub_ptr); - BN_bn2bin(dh_params->priv_key, prv_ptr); + BN_bn2bin(pub_key, pub_ptr); + BN_bn2bin(priv_key, prv_ptr); ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr, pub_len); ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr, prv_len); ret = enif_make_tuple2(env, ret_pub, ret_prv); @@ -2779,26 +2921,37 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */ DH* dh_params; - BIGNUM* pubkey = NULL; + BIGNUM *dummy_pub_key = NULL, *priv_key = NULL; + BIGNUM *other_pub_key; + BIGNUM *dh_p = NULL, *dh_g = NULL; int i; ErlNifBinary ret_bin; ERL_NIF_TERM ret, head, tail; dh_params = DH_new(); - if (!get_bn_from_bin(env, argv[0], &pubkey) - || !get_bn_from_bin(env, argv[1], &dh_params->priv_key) + if (!get_bn_from_bin(env, argv[0], &other_pub_key) + || !get_bn_from_bin(env, argv[1], &priv_key) || !enif_get_list_cell(env, argv[2], &head, &tail) - || !get_bn_from_bin(env, head, &dh_params->p) + || !get_bn_from_bin(env, head, &dh_p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dh_params->g) + || !get_bn_from_bin(env, head, &dh_g) || !enif_is_empty_list(env, tail)) { - + if (dh_p) BN_free(dh_p); + if (dh_g) BN_free(dh_g); ret = enif_make_badarg(env); } else { + /* Note: DH_set0_key() does not allow setting only the + * private key, although DH_compute_key() does not use the + * public key. Work around this limitation by setting + * the public key to a copy of the private key. + */ + dummy_pub_key = BN_dup(priv_key); + DH_set0_key(dh_params, dummy_pub_key, priv_key); + DH_set0_pqg(dh_params, dh_p, NULL, dh_g); enif_alloc_binary(DH_size(dh_params), &ret_bin); - i = DH_compute_key(ret_bin.data, pubkey, dh_params); + i = DH_compute_key(ret_bin.data, other_pub_key, dh_params); if (i > 0) { if (i != ret_bin.size) { enif_realloc_binary(&ret_bin, i); @@ -2810,7 +2963,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ret = atom_error; } } - if (pubkey) BN_free(pubkey); + if (other_pub_key) BN_free(other_pub_key); DH_free(dh_params); return ret; } @@ -3388,7 +3541,7 @@ static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM enif_alloc_binary(ECDSA_size(key), &ret_bin); - i = ECDSA_sign(md->type, digest_bin.data, len, + i = ECDSA_sign(EVP_MD_type(md), digest_bin.data, len, ret_bin.data, &dsa_s_len, key); EC_KEY_free(key); @@ -3438,7 +3591,7 @@ static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER || !get_ec_key(env, argv[3], atom_undefined, argv[4], &key)) goto badarg; - i = ECDSA_verify(md->type, digest_bin.data, len, + i = ECDSA_verify(EVP_MD_type(md), digest_bin.data, len, sign_bin.data, sign_bin.size, key); EC_KEY_free(key); diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index 4c23379f7f..23d2bed057 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -62,7 +62,7 @@ static void nomem(size_t size, const char* op) abort(); } -static void* crypto_alloc(size_t size) +static void* crypto_alloc(size_t size CCB_FILE_LINE_ARGS) { void *ret = enif_alloc(size); @@ -70,7 +70,7 @@ static void* crypto_alloc(size_t size) nomem(size, "allocate"); return ret; } -static void* crypto_realloc(void* ptr, size_t size) +static void* crypto_realloc(void* ptr, size_t size CCB_FILE_LINE_ARGS) { void* ret = enif_realloc(ptr, size); @@ -78,7 +78,7 @@ static void* crypto_realloc(void* ptr, size_t size) nomem(size, "reallocate"); return ret; } -static void crypto_free(void* ptr) +static void crypto_free(void* ptr CCB_FILE_LINE_ARGS) { enif_free(ptr); } diff --git a/lib/crypto/c_src/crypto_callback.h b/lib/crypto/c_src/crypto_callback.h index 894d86cfd9..2641cc0c8b 100644 --- a/lib/crypto/c_src/crypto_callback.h +++ b/lib/crypto/c_src/crypto_callback.h @@ -18,13 +18,20 @@ * %CopyrightEnd% */ +#include <openssl/crypto.h> +#if OPENSSL_VERSION_NUMBER < 0x10100000L +# define CCB_FILE_LINE_ARGS +#else +# define CCB_FILE_LINE_ARGS , const char *file, int line +#endif + struct crypto_callbacks { size_t sizeof_me; - void* (*crypto_alloc)(size_t size); - void* (*crypto_realloc)(void* ptr, size_t size); - void (*crypto_free)(void* ptr); + void* (*crypto_alloc)(size_t size CCB_FILE_LINE_ARGS); + void* (*crypto_realloc)(void* ptr, size_t size CCB_FILE_LINE_ARGS); + void (*crypto_free)(void* ptr CCB_FILE_LINE_ARGS); /* openssl callbacks */ #ifdef OPENSSL_THREADS diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 4ae64e059e..53ea6bb58b 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -31,6 +31,46 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 3.7.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The crypto application has been fixed to not use RC2 + against OpenSSL built with RC2 disabled.</p> + <p> + Own Id: OTP-13895 Aux Id: PR-1163 </p> + </item> + <item> + <p> + The crypto application has been fixed to not use RC4 + against OpenSSL built with RC4 disabled.</p> + <p> + Own Id: OTP-13896 Aux Id: PR-1169 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + To ease troubleshooting, <c>erlang:load_nif/2</c> now + includes the return value from a failed call to + load/reload/upgrade in the text part of the error tuple. + The <c>crypto</c> NIF makes use of this feature by + returning the source line where/if the initialization + fails.</p> + <p> + Own Id: OTP-13951</p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 3.7.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/crypto/src/Makefile b/lib/crypto/src/Makefile index 456b8be64d..aea8a5a71c 100644 --- a/lib/crypto/src/Makefile +++ b/lib/crypto/src/Makefile @@ -56,7 +56,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard -DCRYPTO_VSN=\"$(VSN)\" -Werror +ERL_COMPILE_FLAGS += -DCRYPTO_VSN=\"$(VSN)\" -Werror # ---------------------------------------------------- # Targets diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 0b62964efa..9767a13dfc 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -159,10 +159,11 @@ cmac(Type, Key, Data, MacSize) -> des3_cbc | des3_cbf | des3_cfb | des_ede3 | blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | - aes_cbc | + aes_cbc | rc2_cbc, - Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); - (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); + (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}; + (aes_gcm, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), TagLength::1..16}) -> {binary(), binary()}. block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; Type =:= des_cfb; diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 0c3b7a0445..31f4e89ffe 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -2249,16 +2249,49 @@ aes_gcm() -> 1} %% TagLength ]. -%% http://tools.ietf.org/html/draft-agl-tls-chacha20poly1305-04 +%% https://tools.ietf.org/html/rfc7539#appendix-A.5 chacha20_poly1305() -> [ - {chacha20_poly1305, hexstr2bin("4290bcb154173531f314af57f3be3b500" %% Key - "6da371ece272afa1b5dbdd1100a1007"), - hexstr2bin("86d09974840bded2a5ca"), %% PlainText - hexstr2bin("cd7cf67be39c794a"), %% Nonce - hexstr2bin("87e229d4500845a079c0"), %% AAD - hexstr2bin("e3e446f7ede9a19b62a4"), %% CipherText - hexstr2bin("677dabf4e3d24b876bb284753896e1d6")} %% CipherTag + {chacha20_poly1305, + hexstr2bin("1c9240a5eb55d38af333888604f6b5f0" %% Key + "473917c1402b80099dca5cbc207075c0"), + hexstr2bin("496e7465726e65742d44726166747320" %% PlainText + "61726520647261667420646f63756d65" + "6e74732076616c696420666f72206120" + "6d6178696d756d206f6620736978206d" + "6f6e74687320616e64206d6179206265" + "20757064617465642c207265706c6163" + "65642c206f72206f62736f6c65746564" + "206279206f7468657220646f63756d65" + "6e747320617420616e792074696d652e" + "20497420697320696e617070726f7072" + "6961746520746f2075736520496e7465" + "726e65742d4472616674732061732072" + "65666572656e6365206d617465726961" + "6c206f7220746f206369746520746865" + "6d206f74686572207468616e20617320" + "2fe2809c776f726b20696e2070726f67" + "726573732e2fe2809d"), + hexstr2bin("000000000102030405060708"), %% Nonce + hexstr2bin("f33388860000000000004e91"), %% AAD + hexstr2bin("64a0861575861af460f062c79be643bd" %% CipherText + "5e805cfd345cf389f108670ac76c8cb2" + "4c6cfc18755d43eea09ee94e382d26b0" + "bdb7b73c321b0100d4f03b7f355894cf" + "332f830e710b97ce98c8a84abd0b9481" + "14ad176e008d33bd60f982b1ff37c855" + "9797a06ef4f0ef61c186324e2b350638" + "3606907b6a7c02b0f9f6157b53c867e4" + "b9166c767b804d46a59b5216cde7a4e9" + "9040c5a40433225ee282a1b0a06c523e" + "af4534d7f83fa1155b0047718cbc546a" + "0d072b04b3564eea1b422273f548271a" + "0bb2316053fa76991955ebd63159434e" + "cebb4e466dae5a1073a6727627097a10" + "49e617d91d361094fa68f0ff77987130" + "305beaba2eda04df997b714d6c6f2c29" + "a6ad5cb4022b02709b"), + hexstr2bin("eead9d67890cbb22392336fea1851f38")} %% CipherTag ]. rsa_plain() -> diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index bbee24554a..38e2db9033 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 3.7.1 +CRYPTO_VSN = 3.7.2 diff --git a/lib/debugger/src/Makefile b/lib/debugger/src/Makefile index 9594a0bfe3..118cb6b758 100644 --- a/lib/debugger/src/Makefile +++ b/lib/debugger/src/Makefile @@ -85,7 +85,7 @@ APPUP_TARGET = $(EBIN)/$(APPUP_FILE) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard -Werror +ERL_COMPILE_FLAGS += -Werror # ---------------------------------------------------- diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl index 25ffc5054c..d302423077 100644 --- a/lib/debugger/src/dbg_wx_win.erl +++ b/lib/debugger/src/dbg_wx_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml index d86deba48d..54abd09504 100644 --- a/lib/dialyzer/doc/src/notes.xml +++ b/lib/dialyzer/doc/src/notes.xml @@ -32,6 +32,37 @@ <p>This document describes the changes made to the Dialyzer application.</p> +<section><title>Dialyzer 3.0.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix bugs regarding opaque types. </p> + <p> + Own Id: OTP-13693</p> + </item> + <item> + <p> Fix error handling of bad <c>-dialyzer()</c> + attributes. </p> + <p> + Own Id: OTP-13979 Aux Id: ERL-283 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> A few warning messages have been improved. </p> + <p> + Own Id: OTP-11403</p> + </item> + </list> + </section> + +</section> + <section><title>Dialyzer 3.0.2</title> <section><title>Improvements and New Features</title> diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index b5510731e0..ae1e4d8c38 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -94,9 +94,9 @@ loop(#server_state{parent = Parent} = State, {AnalPid, cserver, CServer, Plt} -> send_codeserver_plt(Parent, CServer, Plt), loop(State, Analysis, ExtCalls); - {AnalPid, done, Plt, DocPlt} -> + {AnalPid, done, MiniPlt, DocPlt} -> send_ext_calls(Parent, ExtCalls), - send_analysis_done(Parent, Plt, DocPlt); + send_analysis_done(Parent, MiniPlt, DocPlt); {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); {AnalPid, ext_types, ExtTypes} -> @@ -114,6 +114,7 @@ loop(#server_state{parent = Parent} = State, %% The Analysis %%-------------------------------------------------------------------- +%% Calls to erlang:garbage_collect() help to reduce the heap size. analysis_start(Parent, Analysis, LegalWarnings) -> CServer = dialyzer_codeserver:new(), Plt = Analysis#analysis.plt, @@ -150,12 +151,9 @@ analysis_start(Parent, Analysis, LegalWarnings) -> TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0), TmpCServer2 = dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), + erlang:garbage_collect(), ?timing(State#analysis_state.timing_server, "remote", - begin - TmpCServer3 = - dialyzer_utils:process_record_remote_types(TmpCServer2), - dialyzer_contracts:process_contract_remote_types(TmpCServer3) - end) + contracts_and_records(TmpCServer2)) catch throw:{error, _ErrorMsg} = Error -> exit(Error) end, @@ -164,48 +162,75 @@ analysis_start(Parent, Analysis, LegalWarnings) -> NewPlt1 = dialyzer_plt:insert_exported_types(NewPlt0, ExpTypes), State0 = State#analysis_state{plt = NewPlt1}, dump_callgraph(Callgraph, State0, Analysis), - State1 = State0#analysis_state{codeserver = NewCServer}, %% Remove all old versions of the files being analyzed AllNodes = dialyzer_callgraph:all_nodes(Callgraph), - Plt1 = dialyzer_plt:delete_list(NewPlt1, AllNodes), + Plt1_a = dialyzer_plt:delete_list(NewPlt1, AllNodes), + Plt1 = dialyzer_plt:insert_callbacks(Plt1_a, NewCServer), + State1 = State0#analysis_state{codeserver = NewCServer, plt = Plt1}, Exports = dialyzer_codeserver:get_exports(NewCServer), + NonExports = sets:subtract(sets:from_list(AllNodes), Exports), + NonExportsList = sets:to_list(NonExports), NewCallgraph = case Analysis#analysis.race_detection of true -> dialyzer_callgraph:put_race_detection(true, Callgraph); false -> Callgraph end, - State2 = analyze_callgraph(NewCallgraph, State1#analysis_state{plt = Plt1}), + State2 = analyze_callgraph(NewCallgraph, State1), + #analysis_state{plt = MiniPlt2, doc_plt = DocPlt} = State2, dialyzer_callgraph:dispose_race_server(NewCallgraph), rcv_and_send_ext_types(Parent), - NonExports = sets:subtract(sets:from_list(AllNodes), Exports), - NonExportsList = sets:to_list(NonExports), - Plt2 = dialyzer_plt:delete_list(State2#analysis_state.plt, NonExportsList), - send_codeserver_plt(Parent, CServer, State2#analysis_state.plt), - send_analysis_done(Parent, Plt2, State2#analysis_state.doc_plt). + %% Since the PLT is never used, a dummy is sent: + DummyPlt = dialyzer_plt:new(), + send_codeserver_plt(Parent, CServer, DummyPlt), + MiniPlt3 = dialyzer_plt:delete_list(MiniPlt2, NonExportsList), + send_analysis_done(Parent, MiniPlt3, DocPlt). + +contracts_and_records(CodeServer) -> + Fun = contrs_and_recs(CodeServer), + {Pid, Ref} = erlang:spawn_monitor(Fun), + dialyzer_codeserver:give_away(CodeServer, Pid), + Pid ! {self(), go}, + receive {'DOWN', Ref, process, Pid, Return} -> + Return + end. + +-spec contrs_and_recs(dialyzer_codeserver:codeserver()) -> + fun(() -> no_return()). + +contrs_and_recs(TmpCServer2) -> + fun() -> + Parent = receive {Pid, go} -> Pid end, + {TmpCServer3, RecordDict} = + dialyzer_utils:process_record_remote_types(TmpCServer2), + TmpServer4 = + dialyzer_contracts:process_contract_remote_types(TmpCServer3, + RecordDict), + dialyzer_codeserver:give_away(TmpServer4, Parent), + exit(TmpServer4) + end. analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver, doc_plt = DocPlt, + plt = Plt, timing_server = TimingServer, parent = Parent, solvers = Solvers} = State) -> - Plt = dialyzer_plt:insert_callbacks(State#analysis_state.plt, Codeserver), - {NewPlt, NewDocPlt} = - case State#analysis_state.analysis_type of - plt_build -> - NewPlt0 = - dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver, - TimingServer, Solvers, Parent), - {NewPlt0, DocPlt}; - succ_typings -> - {Warnings, NewPlt0, NewDocPlt0} = - dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver, - TimingServer, Solvers, Parent), - Warnings1 = filter_warnings(Warnings, Codeserver), - send_warnings(State#analysis_state.parent, Warnings1), - {NewPlt0, NewDocPlt0} - end, - dialyzer_callgraph:delete(Callgraph), - State#analysis_state{plt = NewPlt, doc_plt = NewDocPlt}. + case State#analysis_state.analysis_type of + plt_build -> + NewMiniPlt = + dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver, + TimingServer, Solvers, Parent), + dialyzer_callgraph:delete(Callgraph), + State#analysis_state{plt = NewMiniPlt, doc_plt = DocPlt}; + succ_typings -> + {Warnings, NewMiniPlt, NewDocPlt} = + dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver, + TimingServer, Solvers, Parent), + dialyzer_callgraph:delete(Callgraph), + Warnings1 = filter_warnings(Warnings, Codeserver), + send_warnings(State#analysis_state.parent, Warnings1), + State#analysis_state{plt = NewMiniPlt, doc_plt = NewDocPlt} + end. %%-------------------------------------------------------------------- %% Build the callgraph and fill the codeserver. @@ -562,8 +587,9 @@ is_ok_fun({_Filename, _Line, {_M, _F, _A} = MFA}, Codeserver) -> is_ok_tag(Tag, {_F, _L, MorMFA}, Codeserver) -> not dialyzer_utils:is_suppressed_tag(MorMFA, Tag, Codeserver). -send_analysis_done(Parent, Plt, DocPlt) -> - Parent ! {self(), done, Plt, DocPlt}, +send_analysis_done(Parent, MiniPlt, DocPlt) -> + ok = dialyzer_plt:give_away(MiniPlt, Parent), + Parent ! {self(), done, MiniPlt, DocPlt}, ok. send_ext_calls(_Parent, none) -> @@ -576,7 +602,7 @@ send_ext_types(Parent, ExtTypes) -> Parent ! {self(), ext_types, ExtTypes}, ok. -send_codeserver_plt(Parent, CServer, Plt ) -> +send_codeserver_plt(Parent, CServer, Plt) -> Parent ! {self(), cserver, CServer, Plt}, ok. @@ -595,14 +621,14 @@ format_bad_calls([{{_, _, _}, {_, module_info, A}}|Left], CodeServer, Acc) format_bad_calls([{FromMFA, {M, F, A} = To}|Left], CodeServer, Acc) -> {_Var, FunCode} = dialyzer_codeserver:lookup_mfa_code(FromMFA, CodeServer), Msg = {call_to_missing, [M, F, A]}, - {File, Line} = find_call_file_and_line(FunCode, To), + {File, Line} = find_call_file_and_line(FromMFA, FunCode, To, CodeServer), WarningInfo = {File, Line, FromMFA}, NewAcc = [{?WARN_CALLGRAPH, WarningInfo, Msg}|Acc], format_bad_calls(Left, CodeServer, NewAcc); format_bad_calls([], _CodeServer, Acc) -> Acc. -find_call_file_and_line(Tree, MFA) -> +find_call_file_and_line({Module, _, _}, Tree, MFA, CodeServer) -> Fun = fun(SubTree, Acc) -> case cerl:is_c_call(SubTree) of @@ -615,7 +641,7 @@ find_call_file_and_line(Tree, MFA) -> case {cerl:concrete(M), cerl:concrete(F), A} of MFA -> Ann = cerl:get_ann(SubTree), - [{get_file(Ann), get_line(Ann)}|Acc]; + [{get_file(CodeServer, Module, Ann), get_line(Ann)}|Acc]; {erlang, make_fun, 3} -> [CA1, CA2, CA3] = cerl:call_args(SubTree), case @@ -631,7 +657,8 @@ find_call_file_and_line(Tree, MFA) -> of MFA -> Ann = cerl:get_ann(SubTree), - [{get_file(Ann), get_line(Ann)}|Acc]; + [{get_file(CodeServer, Module, Ann), + get_line(Ann)}|Acc]; _ -> Acc end; @@ -651,8 +678,10 @@ get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file(Codeserver, Module, [{file, FakeFile}|_]) -> + dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile); +get_file(Codeserver, Module, [_|Tail]) -> + get_file(Codeserver, Module, Tail). -spec dump_callgraph(dialyzer_callgraph:callgraph(), #analysis_state{}, #analysis{}) -> 'ok'. diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index e79a5d1cd9..d380ab2a50 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -55,9 +55,9 @@ check_callbacks(Module, Attrs, Records, Plt, Codeserver) -> _ -> MFA = {Module,module_info,0}, {_Var,Code} = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), - File = get_file(cerl:get_ann(Code)), + File = get_file(Codeserver, Module, cerl:get_ann(Code)), State = #state{plt = Plt, filename = File, behlines = BehLines, - codeserver = Codeserver, records = Records}, + codeserver = Codeserver, records = Records}, Warnings = get_warnings(Module, Behaviours, State), [add_tag_warning_info(Module, W, State) || W <- Warnings] end. @@ -206,12 +206,15 @@ add_tag_warning_info(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) -> dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity}, State#state.codeserver), Anns = cerl:get_ann(FunCode), - WarningInfo = {get_file(Anns), get_line(Anns), {Module, Fun, Arity}}, + File = get_file(State#state.codeserver, Module, Anns), + WarningInfo = {File, get_line(Anns), {Module, Fun, Arity}}, {?WARN_BEHAVIOUR, WarningInfo, Warn}. get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file(Codeserver, Module, [{file, FakeFile}|_]) -> + dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile); +get_file(Codeserver, Module, [_|Tail]) -> + get_file(Codeserver, Module, Tail). diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 227ee2a892..68f3d7a240 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -112,7 +112,11 @@ -opaque callgraph() :: #callgraph{}. --type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}. +-type active_digraph() :: {'d', digraph:graph()} + | {'e', + Out :: ets:tid(), + In :: ets:tid(), + Map :: ets:tid()}. %%---------------------------------------------------------------------- @@ -241,24 +245,30 @@ find_non_local_calls([], Set) -> -spec get_depends_on(scc() | module(), callgraph()) -> [scc()]. -get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In}}) -> - case ets_lookup_dict(SCC, Out) of - {ok, Value} -> Value; - error -> [] - end; +get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In, Maps}}) -> + lookup_scc(SCC, Out, Maps); get_depends_on(SCC, #callgraph{active_digraph = {'d', DG}}) -> digraph:out_neighbours(DG, SCC). -spec get_required_by(scc() | module(), callgraph()) -> [scc()]. -get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In}}) -> - case ets_lookup_dict(SCC, In) of - {ok, Value} -> Value; - error -> [] - end; +get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In, Maps}}) -> + lookup_scc(SCC, In, Maps); get_required_by(SCC, #callgraph{active_digraph = {'d', DG}}) -> digraph:in_neighbours(DG, SCC). +lookup_scc(SCC, Table, Maps) -> + case ets_lookup_dict({'scc', SCC}, Maps) of + {ok, SCCInt} -> + case ets_lookup_dict(SCCInt, Table) of + {ok, Ints} -> + [ets:lookup_element(Maps, Int, 2) || Int <- Ints]; + error -> + [] + end; + error -> [] + end. + %%---------------------------------------------------------------------- %% Handling of modules & SCCs %%---------------------------------------------------------------------- @@ -575,9 +585,10 @@ digraph_delete(DG) -> active_digraph_delete({'d', DG}) -> digraph:delete(DG); -active_digraph_delete({'e', Out, In}) -> +active_digraph_delete({'e', Out, In, Maps}) -> ets:delete(Out), - ets:delete(In). + ets:delete(In), + ets:delete(Maps). digraph_edges(DG) -> digraph:edges(DG). @@ -751,37 +762,28 @@ to_ps(#callgraph{} = CG, File, Args) -> ok. condensation(G) -> - SCs = digraph_utils:strong_components(G), - V2I = ets:new(condensation_v2i, []), - I2C = ets:new(condensation_i2c, []), - I2I = ets:new(condensation_i2i, [bag]), - CFun = - fun(SC, N) -> - lists:foreach(fun(V) -> true = ets:insert(V2I, {V,N}) end, SC), - true = ets:insert(I2C, {N, SC}), - N + 1 - end, - lists:foldl(CFun, 1, SCs), - Fun1 = - fun({V1, V2}) -> - I1 = ets:lookup_element(V2I, V1, 2), - I2 = ets:lookup_element(V2I, V2, 2), - I1 =:= I2 orelse ets:insert(I2I, {I1, I2}) - end, - lists:foreach(Fun1, digraph:edges(G)), - Fun3 = - fun({I1, I2}, {Out, In}) -> - SC1 = ets:lookup_element(I2C, I1, 2), - SC2 = ets:lookup_element(I2C, I2, 2), - {dict:append(SC1, SC2, Out), dict:append(SC2, SC1, In)} - end, - {OutDict, InDict} = ets:foldl(Fun3, {dict:new(), dict:new()}, I2I), - [OutETS, InETS] = + SCCs = digraph_utils:strong_components(G), + %% Assign unique numbers to SCCs: + Ints = lists:seq(1, length(SCCs)), + IntToSCC = lists:zip(Ints, SCCs), + IntScc = sofs:relation(IntToSCC, [{int, scc}]), + %% Subsitute strong components for vertices in edges using the + %% unique numbers: + C2V = sofs:relation([{SC, V} || SC <- SCCs, V <- SC], [{scc, v}]), + I2V = sofs:relative_product(IntScc, C2V), % [{v, int}] + Es = sofs:relation(digraph:edges(G), [{v, v}]), + R1 = sofs:relative_product(I2V, Es), + R2 = sofs:relative_product(I2V, sofs:converse(R1)), + %% Create in- and out-neighbours: + In = sofs:relation_to_family(sofs:strict_relation(R2)), + R3 = sofs:converse(R2), + Out = sofs:relation_to_family(sofs:strict_relation(R3)), + [OutETS, InETS, MapsETS] = [ets:new(Name,[{read_concurrency, true}]) || - Name <- [callgraph_deps_out, callgraph_deps_in]], - ets:insert(OutETS, dict:to_list(OutDict)), - ets:insert(InETS, dict:to_list(InDict)), - ets:delete(V2I), - ets:delete(I2C), - ets:delete(I2I), - {{'e', OutETS, InETS}, SCs}. + Name <- [callgraph_deps_out, callgraph_deps_in, callgraph_scc_map]], + ets:insert(OutETS, sofs:to_external(Out)), + ets:insert(InETS, sofs:to_external(In)), + %% Create mappings from SCCs to unique integers, and the inverse: + ets:insert(MapsETS, lists:zip([{'scc', SCC} || SCC<- SCCs], Ints)), + ets:insert(MapsETS, IntToSCC), + {{'e', OutETS, InETS, MapsETS}, SCCs}. diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index b43711446b..158ee761af 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -630,8 +630,8 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); - {BackendPid, done, NewPlt, _NewDocPlt} -> - return_value(State, NewPlt); + {BackendPid, done, NewMiniPlt, _NewDocPlt} -> + return_value(State, NewMiniPlt); {BackendPid, ext_calls, ExtCalls} -> cl_loop(State#cl_state{external_calls = ExtCalls}, LogCache); {BackendPid, ext_types, ExtTypes} -> @@ -647,6 +647,7 @@ cl_loop(State, LogCache) -> cl_error(State, Msg); _Other -> %% io:format("Received ~p\n", [_Other]), + %% Note: {BackendPid, cserver, CodeServer, Plt} is ignored. cl_loop(State, LogCache) end. @@ -692,10 +693,13 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, output_plt = OutputPlt, plt_info = PltInfo, stored_warnings = StoredWarnings}, - Plt) -> + MiniPlt) -> case OutputPlt =:= none of - true -> ok; - false -> dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo) + true -> + dialyzer_plt:delete(MiniPlt); + false -> + Plt = dialyzer_plt:restore_full_plt(MiniPlt), + dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo) end, UnknownWarnings = unknown_warnings(State), RetValue = diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index dd383ea828..f53c713bfe 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -22,7 +22,9 @@ -module(dialyzer_codeserver). -export([delete/1, - finalize_contracts/3, + store_temp_contracts/4, + give_away/2, + finalize_contracts/1, finalize_exported_types/2, finalize_records/2, get_contracts/1, @@ -31,7 +33,9 @@ get_exports/1, get_records/1, get_next_core_label/1, - get_temp_contracts/1, + get_temp_contracts/2, + contracts_modules/1, + store_contracts/4, get_temp_exported_types/1, get_temp_records/1, insert/3, @@ -41,6 +45,7 @@ is_exported/2, lookup_mod_code/2, lookup_mfa_code/2, + lookup_mfa_var_label/2, lookup_mod_records/2, lookup_mod_contracts/2, lookup_mfa_contract/2, @@ -49,21 +54,22 @@ set_next_core_label/2, set_temp_records/2, store_temp_records/3, - store_temp_contracts/4]). + translate_fake_file/3]). --export_type([codeserver/0, fun_meta_info/0]). +-export_type([codeserver/0, fun_meta_info/0, contracts/0]). -include("dialyzer.hrl"). %%-------------------------------------------------------------------- -type dict_ets() :: ets:tid(). +-type map_ets() :: ets:tid(). -type set_ets() :: ets:tid(). -type types() :: erl_types:type_table(). --type mod_records() :: dict:dict(module(), types()). +-type mod_records() :: erl_types:mod_records(). --type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()). +-type contracts() :: #{mfa() => dialyzer_contracts:file_contract()}. -type mod_contracts() :: dict:dict(module(), contracts()). %% A property-list of data compiled from -compile and -dialyzer attributes. @@ -74,16 +80,16 @@ -record(codeserver, {next_core_label = 0 :: label(), code :: dict_ets(), - exported_types :: set_ets() | 'undefined', % set(mfa()) - records :: dict_ets() | 'undefined', - contracts :: dict_ets() | 'undefined', - callbacks :: dict_ets() | 'undefined', + exported_types :: set_ets(), % set(mfa()) + records :: map_ets(), + contracts :: map_ets(), + callbacks :: map_ets(), fun_meta_info :: dict_ets(), % {mfa(), meta_info()} exports :: 'clean' | set_ets(), % set(mfa()) temp_exported_types :: 'clean' | set_ets(), % set(mfa()) - temp_records :: 'clean' | dict_ets(), - temp_contracts :: 'clean' | dict_ets(), - temp_callbacks :: 'clean' | dict_ets() + temp_records :: 'clean' | map_ets(), + temp_contracts :: 'clean' | map_ets(), + temp_callbacks :: 'clean' | map_ets() }). -opaque codeserver() :: #codeserver{}. @@ -97,7 +103,7 @@ ets_dict_find(Key, Table) -> _:_ -> error end. -ets_dict_store(Key, Element, Table) -> +ets_map_store(Key, Element, Table) -> true = ets:insert(Table, {Key, Element}), Table. @@ -121,9 +127,6 @@ ets_set_to_set(Table) -> Fold = fun({E}, Set) -> sets:add_element(E, Set) end, ets:foldl(Fold, sets:new(), Table). -ets_read_concurrent_table(Name) -> - ets:new(Name, [{read_concurrency, true}]). - %%-------------------------------------------------------------------- -spec new() -> codeserver(). @@ -131,6 +134,13 @@ ets_read_concurrent_table(Name) -> new() -> CodeOptions = [compressed, public, {read_concurrency, true}], Code = ets:new(dialyzer_codeserver_code, CodeOptions), + ReadOptions = [compressed, {read_concurrency, true}], + [Contracts, Callbacks, Records, ExportedTypes] = + [ets:new(Name, ReadOptions) || + Name <- [dialyzer_codeserver_contracts, + dialyzer_codeserver_callbacks, + dialyzer_codeserver_records, + dialyzer_codeserver_exported_types]], TempOptions = [public, {write_concurrency, true}], [Exports, FunMetaInfo, TempExportedTypes, TempRecords, TempContracts, TempCallbacks] = @@ -143,6 +153,10 @@ new() -> #codeserver{code = Code, exports = Exports, fun_meta_info = FunMetaInfo, + exported_types = ExportedTypes, + records = Records, + contracts = Contracts, + callbacks = Callbacks, temp_exported_types = TempExportedTypes, temp_records = TempRecords, temp_contracts = TempContracts, @@ -163,13 +177,15 @@ insert(Mod, ModCode, CS) -> Exports = cerl:module_exports(ModCode), Attrs = cerl:module_attrs(ModCode), Defs = cerl:module_defs(ModCode), + {Files, SmallDefs} = compress_file_anno(Defs), As = cerl:get_ann(ModCode), Funs = [{{Mod, cerl:fname_id(Var), cerl:fname_arity(Var)}, - Val} || Val = {Var, _Fun} <- Defs], - Keys = [Key || {Key, _Value} <- Funs], + Val, {Var, cerl_trees:get_label(Fun)}} || Val = {Var, Fun} <- SmallDefs], + Keys = [Key || {Key, _Value, _Label} <- Funs], ModEntry = {Mod, {Name, Exports, Attrs, Keys, As}}, - true = ets:insert(CS#codeserver.code, [ModEntry|Funs]), + ModFileEntry = {{mod, Mod}, Files}, + true = ets:insert(CS#codeserver.code, [ModEntry, ModFileEntry|Funs]), CS. -spec get_temp_exported_types(codeserver()) -> sets:set(mfa()). @@ -213,12 +229,12 @@ get_exports(#codeserver{exports = Exports}) -> -spec finalize_exported_types(sets:set(mfa()), codeserver()) -> codeserver(). -finalize_exported_types(Set, CS) -> - ExportedTypes = ets_read_concurrent_table(dialyzer_codeserver_exported_types), +finalize_exported_types(Set, + #codeserver{exported_types = ExportedTypes, + temp_exported_types = TempETypes} = CS) -> true = ets_set_insert_set(Set, ExportedTypes), - TempExpTypes = CS#codeserver.temp_exported_types, - true = ets:delete(TempExpTypes), - CS#codeserver{exported_types = ExportedTypes, temp_exported_types = clean}. + true = ets:delete(TempETypes), + CS#codeserver{temp_exported_types = clean}. -spec lookup_mod_code(atom(), codeserver()) -> cerl:c_module(). @@ -230,6 +246,11 @@ lookup_mod_code(Mod, CS) when is_atom(Mod) -> lookup_mfa_code({_M, _F, _A} = MFA, CS) -> table__lookup(CS#codeserver.code, MFA). +-spec lookup_mfa_var_label(mfa(), codeserver()) -> {cerl:c_var(), label()}. + +lookup_mfa_var_label({_M, _F, _A} = MFA, CS) -> + ets:lookup_element(CS#codeserver.code, MFA, 3). + -spec get_next_core_label(codeserver()) -> label(). get_next_core_label(#codeserver{next_core_label = NCL}) -> @@ -244,8 +265,8 @@ set_next_core_label(NCL, CS) -> lookup_mod_records(Mod, #codeserver{records = RecDict}) when is_atom(Mod) -> case ets_dict_find(Mod, RecDict) of - error -> dict:new(); - {ok, Dict} -> Dict + error -> maps:new(); + {ok, Map} -> Map end. -spec get_records(codeserver()) -> mod_records(). @@ -255,11 +276,11 @@ get_records(#codeserver{records = RecDict}) -> -spec store_temp_records(module(), types(), codeserver()) -> codeserver(). -store_temp_records(Mod, Dict, #codeserver{temp_records = TempRecDict} = CS) +store_temp_records(Mod, Map, #codeserver{temp_records = TempRecDict} = CS) when is_atom(Mod) -> - case dict:size(Dict) =:= 0 of + case maps:size(Map) =:= 0 of true -> CS; - false -> CS#codeserver{temp_records = ets_dict_store(Mod, Dict, TempRecDict)} + false -> CS#codeserver{temp_records = ets_map_store(Mod, Map, TempRecDict)} end. -spec get_temp_records(codeserver()) -> mod_records(). @@ -277,20 +298,20 @@ set_temp_records(Dict, CS) -> -spec finalize_records(mod_records(), codeserver()) -> codeserver(). -finalize_records(Dict, CS) -> - true = ets:delete(CS#codeserver.temp_records), - Records = ets_read_concurrent_table(dialyzer_codeserver_records), +finalize_records(Dict, #codeserver{temp_records = TmpRecords, + records = Records} = CS) -> + true = ets:delete(TmpRecords), true = ets_dict_store_dict(Dict, Records), - CS#codeserver{records = Records, temp_records = clean}. + CS#codeserver{temp_records = clean}. -spec lookup_mod_contracts(atom(), codeserver()) -> contracts(). lookup_mod_contracts(Mod, #codeserver{contracts = ContDict}) when is_atom(Mod) -> case ets_dict_find(Mod, ContDict) of - error -> dict:new(); + error -> maps:new(); {ok, Keys} -> - dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys]) + maps:from_list([get_file_contract(Key, ContDict)|| Key <- Keys]) end. get_file_contract(Key, ContDict) -> @@ -323,48 +344,69 @@ get_callbacks(#codeserver{callbacks = CallbDict}) -> -spec store_temp_contracts(module(), contracts(), contracts(), codeserver()) -> codeserver(). -store_temp_contracts(Mod, SpecDict, CallbackDict, +store_temp_contracts(Mod, SpecMap, CallbackMap, #codeserver{temp_contracts = Cn, temp_callbacks = Cb} = CS) when is_atom(Mod) -> - CS1 = - case dict:size(SpecDict) =:= 0 of - true -> CS; - false -> - CS#codeserver{temp_contracts = ets_dict_store(Mod, SpecDict, Cn)} - end, - case dict:size(CallbackDict) =:= 0 of - true -> CS1; - false -> - CS1#codeserver{temp_callbacks = ets_dict_store(Mod, CallbackDict, Cb)} - end. - --spec get_temp_contracts(codeserver()) -> {mod_contracts(), mod_contracts()}. + CS1 = CS#codeserver{temp_contracts = ets_map_store(Mod, SpecMap, Cn)}, + CS1#codeserver{temp_callbacks = ets_map_store(Mod, CallbackMap, Cb)}. -get_temp_contracts(#codeserver{temp_contracts = TempContDict, - temp_callbacks = TempCallDict}) -> - {ets_dict_to_dict(TempContDict), ets_dict_to_dict(TempCallDict)}. +-spec contracts_modules(codeserver()) -> [module()]. --spec finalize_contracts(mod_contracts(), mod_contracts(), codeserver()) -> - codeserver(). +contracts_modules(#codeserver{temp_contracts = TempContTable}) -> + ets:select(TempContTable, [{{'$1', '$2'}, [], ['$1']}]). -finalize_contracts(SpecDict, CallbackDict, CS) -> - Contracts = ets_read_concurrent_table(dialyzer_codeserver_contracts), - Callbacks = ets_read_concurrent_table(dialyzer_codeserver_callbacks), - Contracts = dict:fold(fun decompose_spec_dict/3, Contracts, SpecDict), - Callbacks = dict:fold(fun decompose_cb_dict/3, Callbacks, CallbackDict), - CS#codeserver{contracts = Contracts, callbacks = Callbacks, - temp_contracts = clean, temp_callbacks = clean}. +-spec store_contracts(module(), contracts(), contracts(), codeserver()) -> + codeserver(). -decompose_spec_dict(Mod, Dict, Table) -> - Keys = dict:fetch_keys(Dict), - true = ets:insert(Table, dict:to_list(Dict)), - true = ets:insert(Table, {Mod, Keys}), - Table. +store_contracts(Mod, SpecMap, CallbackMap, CS) -> + #codeserver{contracts = SpecDict, callbacks = CallbackDict} = CS, + Keys = maps:keys(SpecMap), + true = ets:insert(SpecDict, maps:to_list(SpecMap)), + true = ets:insert(SpecDict, {Mod, Keys}), + true = ets:insert(CallbackDict, maps:to_list(CallbackMap)), + CS. -decompose_cb_dict(_Mod, Dict, Table) -> - true = ets:insert(Table, dict:to_list(Dict)), - Table. +-spec get_temp_contracts(module(), codeserver()) -> + {contracts(), contracts()}. + +get_temp_contracts(Mod, #codeserver{temp_contracts = TempContDict, + temp_callbacks = TempCallDict}) -> + [{Mod, Contracts}] = ets:lookup(TempContDict, Mod), + true = ets:delete(TempContDict, Mod), + [{Mod, Callbacks}] = ets:lookup(TempCallDict, Mod), + true = ets:delete(TempCallDict, Mod), + {Contracts, Callbacks}. + +-spec give_away(codeserver(), pid()) -> 'ok'. + +give_away(#codeserver{temp_records = TempRecords, + temp_contracts = TempContracts, + temp_callbacks = TempCallbacks, + records = Records, + contracts = Contracts, + callbacks = Callbacks}, Pid) -> + _ = [true = ets:give_away(Table, Pid, any) || + Table <- [TempRecords, TempContracts, TempCallbacks, + Records, Contracts, Callbacks], + Table =/= clean], + ok. + +-spec finalize_contracts(codeserver()) -> codeserver(). + +finalize_contracts(#codeserver{temp_contracts = TempContDict, + temp_callbacks = TempCallDict} = CS) -> + true = ets:delete(TempContDict), + true = ets:delete(TempCallDict), + CS#codeserver{temp_contracts = clean, temp_callbacks = clean}. + +-spec translate_fake_file(codeserver(), module(), file:filename()) -> + file:filename(). + +translate_fake_file(#codeserver{code = Code}, Module, FakeFile) -> + Files = ets:lookup_element(Code, {mod, Module}, 2), + {FakeFile, File} = lists:keyfind(FakeFile, 1, Files), + File. table__lookup(TablePid, M) when is_atom(M) -> {Name, Exports, Attrs, Keys, As} = ets:lookup_element(TablePid, M, 2), @@ -372,3 +414,25 @@ table__lookup(TablePid, M) when is_atom(M) -> cerl:ann_c_module(As, Name, Exports, Attrs, Defs); table__lookup(TablePid, MFA) -> ets:lookup_element(TablePid, MFA, 2). + +compress_file_anno(Term) -> + {Files, SmallTerm} = compress_file_anno(Term, []), + {[{FakeFile, File} || {File, {file, FakeFile}} <- Files], SmallTerm}. + +compress_file_anno({file, F}, Fs) when is_list(F) -> + case lists:keyfind(F, 1, Fs) of + false -> + I = integer_to_list(length(Fs)), + FileI = {file, I}, + NFs = [{F, FileI}|Fs], + {NFs, FileI}; + {F, FileI} -> {Fs, FileI} + end; +compress_file_anno(T, Fs) when is_tuple(T) -> + {NFs, NL} = compress_file_anno(tuple_to_list(T), Fs), + {NFs, list_to_tuple(NL)}; +compress_file_anno([E|L], Fs) -> + {Fs1, NE} = compress_file_anno(E, Fs), + {NFs, NL} = compress_file_anno(L, Fs1), + {NFs, [NE|NL]}; +compress_file_anno(T, Fs) -> {Fs, T}. diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 7cc4a9d3eb..2078e58ce8 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -24,7 +24,7 @@ get_contract_return/2, %% get_contract_signature/1, is_overloaded/1, - process_contract_remote_types/1, + process_contract_remote_types/2, store_tmp_contract/5]). -export_type([file_contract/0, plt_contracts/0]). @@ -139,14 +139,13 @@ sequence([], _Delimiter) -> ""; sequence([H], _Delimiter) -> H; sequence([H|T], Delimiter) -> H ++ Delimiter ++ sequence(T, Delimiter). --spec process_contract_remote_types(dialyzer_codeserver:codeserver()) -> - dialyzer_codeserver:codeserver(). +-spec process_contract_remote_types(dialyzer_codeserver:codeserver(), + erl_types:mod_records()) -> + dialyzer_codeserver:codeserver(). -process_contract_remote_types(CodeServer) -> - {TmpContractDict, TmpCallbackDict} = - dialyzer_codeserver:get_temp_contracts(CodeServer), +process_contract_remote_types(CodeServer, RecordDict) -> + Mods = dialyzer_codeserver:contracts_modules(CodeServer), ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer), - RecordDict = dialyzer_codeserver:get_records(CodeServer), ContractFun = fun({{_M, _F, _A}=MFA, {File, TmpContract, Xtra}}, C0) -> #tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract, @@ -158,20 +157,21 @@ process_contract_remote_types(CodeServer) -> {{MFA, {File, Contract, Xtra}}, C2} end, ModuleFun = - fun({ModuleName, ContractDict}, C3) -> - {NewContractList, C4} = - lists:mapfoldl(ContractFun, C3, dict:to_list(ContractDict)), - {{ModuleName, dict:from_list(NewContractList)}, C4} + fun(ModuleName) -> + Cache = erl_types:cache__new(), + {ContractMap, CallbackMap} = + dialyzer_codeserver:get_temp_contracts(ModuleName, CodeServer), + {NewContractList, Cache1} = + lists:mapfoldl(ContractFun, Cache, maps:to_list(ContractMap)), + {NewCallbackList, _NewCache} = + lists:mapfoldl(ContractFun, Cache1, maps:to_list(CallbackMap)), + dialyzer_codeserver:store_contracts(ModuleName, + maps:from_list(NewContractList), + maps:from_list(NewCallbackList), + CodeServer) end, - Cache = erl_types:cache__new(), - {NewContractList, C5} = - lists:mapfoldl(ModuleFun, Cache, dict:to_list(TmpContractDict)), - {NewCallbackList, _C6} = - lists:mapfoldl(ModuleFun, C5, dict:to_list(TmpCallbackDict)), - NewContractDict = dict:from_list(NewContractList), - NewCallbackDict = dict:from_list(NewCallbackList), - dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict, - CodeServer). + lists:foreach(ModuleFun, Mods), + dialyzer_codeserver:finalize_contracts(CodeServer). -type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]). @@ -390,7 +390,7 @@ solve_constraints(Contract, Call, Constraints) -> %% ?debug("Inf: ~s\n", [erl_types:t_to_string(Inf)]), %% erl_types:t_assign_variables_to_subtype(Contract, Inf). --type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()). +-type contracts() :: dialyzer_codeserver:contracts(). %% Checks the contracts for functions that are not implemented -spec contracts_without_fun(contracts(), [_], dialyzer_callgraph:callgraph()) -> @@ -400,12 +400,12 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) -> AllFuns1 = [{dialyzer_callgraph:lookup_name(Label, Callgraph), Arity} || {Label, Arity} <- AllFuns0], AllFuns2 = [{M, F, A} || {{ok, {M, F, _}}, A} <- AllFuns1], - AllContractMFAs = dict:fetch_keys(Contracts), + AllContractMFAs = maps:keys(Contracts), ErrorContractMFAs = AllContractMFAs -- AllFuns2, [warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs]. warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> - {{File, Line}, _Contract, _Xtra} = dict:fetch(MFA, Contracts), + {{File, Line}, _Contract, _Xtra} = maps:get(MFA, Contracts), WarningInfo = {File, Line, MFA}, {?WARN_CONTRACT_SYNTAX, WarningInfo, {spec_missing_fun, [M, F, A]}}. @@ -438,11 +438,11 @@ insert_constraints([], Map) -> Map. -spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) -> contracts(). -store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) -> +store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecMap, RecordsDict) -> %% io:format("contract from form: ~p\n", [TypeSpec]), TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine), %% io:format("contract: ~p\n", [TmpContract]), - dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict). + maps:put(MFA, {FileLine, TmpContract, Xtra}, SpecMap). contract_from_form(Forms, MFA, RecDict, FileLine) -> {CFuns, Forms1} = contract_from_form(Forms, MFA, RecDict, FileLine, [], []), @@ -670,7 +670,7 @@ get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) -> get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, Acc) -> Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer), - Contracts2 = dict:to_list(Contracts1), + Contracts2 = maps:to_list(Contracts1), Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer), NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, FindOpaques, Acc), get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, FindOpaques, NewAcc); diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index fdcf8269e4..f706ebfb02 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -522,7 +522,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], case is_race_analysis_enabled(State) of true -> Ann = cerl:get_ann(Tree), - File = get_file(Ann), + File = get_file(Ann, State), Line = abs(get_line(Ann)), dialyzer_races:store_race_call(Fun, ArgTypes, Args, {File, Line}, State); @@ -3083,7 +3083,7 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, Ann = cerl:get_ann(Tree), case Force of true -> - WarningInfo = {get_file(Ann), + WarningInfo = {get_file(Ann, State), abs(get_line(Ann)), State#state.curr_fun}, Warn = {Tag, WarningInfo, Msg}, @@ -3093,7 +3093,9 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, case is_compiler_generated(Ann) of true -> State; false -> - WarningInfo = {get_file(Ann), get_line(Ann), State#state.curr_fun}, + WarningInfo = {get_file(Ann, State), + get_line(Ann), + State#state.curr_fun}, Warn = {Tag, WarningInfo, Msg}, case Tag of ?WARN_CONTRACT_RANGE -> ok; @@ -3492,6 +3494,12 @@ state__put_races(Races, State) -> state__records_only(#state{records = Records}) -> #state{records = Records}. +-spec state__translate_file(file:filename(), state()) -> file:filename(). + +state__translate_file(FakeFile, State) -> + #state{codeserver = CodeServer, module = Module} = State, + dialyzer_codeserver:translate_fake_file(CodeServer, Module, FakeFile). + %%% =========================================================================== %%% %%% Races @@ -3563,9 +3571,11 @@ get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); get_line([]) -> -1. -get_file([]) -> []; -get_file([{file, File}|_]) -> File; -get_file([_|Tail]) -> get_file(Tail). +get_file([], _State) -> []; +get_file([{file, FakeFile}|_], State) -> + state__translate_file(FakeFile, State); +get_file([_|Tail], State) -> + get_file(Tail, State). is_compiler_generated(Ann) -> lists:member(compiler_generated, Ann) orelse (get_line(Ann) < 1). diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 91f7fbe467..d1b955044b 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -498,8 +498,9 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt, end, ExplanationPid = spawn_link(Fun), gui_loop(State#gui_state{expl_pid = ExplanationPid}); - {BackendPid, done, _NewPlt, NewDocPlt} -> + {BackendPid, done, NewMiniPlt, NewDocPlt} -> message(State, "Analysis done"), + dialyzer_plt:delete(NewMiniPlt), config_gui_stop(State), gui_loop(State#gui_state{doc_plt = NewDocPlt}); {'EXIT', BackendPid, {error, Reason}} -> diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 64b10af1ba..37c22fef48 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -51,7 +51,9 @@ get_specs/4, to_file/4, get_mini_plt/1, - restore_full_plt/2 + restore_full_plt/1, + delete/1, + give_away/2 ]). %% Debug utilities @@ -75,14 +77,16 @@ %%---------------------------------------------------------------------- -record(plt, {info = table_new() :: dict:dict(), - types = table_new() :: dict:dict(), + types = table_new() :: erl_types:mod_records(), contracts = table_new() :: dict:dict(), callbacks = table_new() :: dict:dict(), exported_types = sets:new() :: sets:set()}). -record(mini_plt, {info :: ets:tid(), + types :: ets:tid(), contracts :: ets:tid(), - callbacks :: ets:tid() + callbacks :: ets:tid(), + exported_types :: ets:tid() }). -opaque plt() :: #plt{} | #mini_plt{}. @@ -123,6 +127,10 @@ delete_module(#plt{info = Info, types = Types, -spec delete_list(plt(), [mfa() | integer()]) -> plt(). +delete_list(#mini_plt{info = Info, + contracts = Contracts}=Plt, List) -> + Plt#mini_plt{info = ets_table_delete_list(Info, List), + contracts = ets_table_delete_list(Contracts, List)}; delete_list(#plt{info = Info, types = Types, contracts = Contracts, callbacks = Callbacks, @@ -176,7 +184,7 @@ lookup(Plt, Label) when is_integer(Label) -> lookup_1(#mini_plt{info = Info}, MFAorLabel) -> ets_table_lookup(Info, MFAorLabel). --spec insert_types(plt(), dict:dict()) -> plt(). +-spec insert_types(plt(), erl_types:mod_records()) -> plt(). insert_types(PLT, Rec) -> PLT#plt{types = Rec}. @@ -186,7 +194,7 @@ insert_types(PLT, Rec) -> insert_exported_types(PLT, Set) -> PLT#plt{exported_types = Set}. --spec get_types(plt()) -> dict:dict(). +-spec get_types(plt()) -> erl_types:mod_records(). get_types(#plt{types = Types}) -> Types. @@ -246,8 +254,10 @@ from_file(FileName, ReturnInfo) -> Msg = io_lib:format("Old PLT file ~s\n", [FileName]), plt_error(Msg); ok -> + Types = [{Mod, maps:from_list(dict:to_list(Types))} || + {Mod, Types} <- dict:to_list(Rec#file_plt.types)], Plt = #plt{info = Rec#file_plt.info, - types = Rec#file_plt.types, + types = dict:from_list(Types), contracts = Rec#file_plt.contracts, callbacks = Rec#file_plt.callbacks, exported_types = Rec#file_plt.exported_types}, @@ -364,12 +374,14 @@ to_file(FileName, end, OldModDeps, ModDeps), ImplMd5 = compute_implementation_md5(), + FileTypes = dict:from_list([{Mod, dict:from_list(maps:to_list(MTypes))} || + {Mod, MTypes} <- dict:to_list(Types)]), Record = #file_plt{version = ?VSN, file_md5_list = MD5, info = Info, contracts = Contracts, callbacks = Callbacks, - types = Types, + types = FileTypes, exported_types = ExpTypes, mod_deps = NewModDeps, implementation_md5 = ImplMd5}, @@ -503,32 +515,100 @@ init_md5_list_1(Md5List, [], Acc) -> -spec get_mini_plt(plt()) -> plt(). -get_mini_plt(#plt{info = Info, contracts = Contracts, callbacks = Callbacks}) -> - [ETSInfo, ETSContracts, ETSCallbacks] = - [ets:new(Name, [public]) || Name <- [plt_info, plt_contracts, plt_callbacks]], +get_mini_plt(#plt{info = Info, + types = Types, + contracts = Contracts, + callbacks = Callbacks, + exported_types = ExpTypes}) -> + [ETSInfo, ETSTypes, ETSContracts, ETSCallbacks, ETSExpTypes] = + [ets:new(Name, [public]) || + Name <- [plt_info, plt_types, plt_contracts, plt_callbacks, + plt_exported_types]], CallbackList = dict:to_list(Callbacks), CallbacksByModule = [{M, [Cb || {{M1,_,_},_} = Cb <- CallbackList, M1 =:= M]} || M <- lists:usort([M || {{M,_,_},_} <- CallbackList])], - [true, true] = + [true, true, true] = [ets:insert(ETS, dict:to_list(Data)) || - {ETS, Data} <- [{ETSInfo, Info}, {ETSContracts, Contracts}]], + {ETS, Data} <- [{ETSInfo, Info}, + {ETSTypes, Types}, + {ETSContracts, Contracts}]], true = ets:insert(ETSCallbacks, CallbacksByModule), - #mini_plt{info = ETSInfo, contracts = ETSContracts, callbacks = ETSCallbacks}; + true = ets:insert(ETSExpTypes, [{ET} || ET <- sets:to_list(ExpTypes)]), + #mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}; get_mini_plt(undefined) -> undefined. --spec restore_full_plt(plt(), plt()) -> plt(). - -restore_full_plt(#mini_plt{info = ETSInfo, contracts = ETSContracts}, Plt) -> - Info = dict:from_list(ets:tab2list(ETSInfo)), - Contracts = dict:from_list(ets:tab2list(ETSContracts)), - ets:delete(ETSContracts), - ets:delete(ETSInfo), - Plt#plt{info = Info, contracts = Contracts}; -restore_full_plt(undefined, undefined) -> +-spec restore_full_plt(plt()) -> plt(). + +restore_full_plt(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes} = MiniPlt) -> + Info = dict:from_list(tab2list(ETSInfo)), + Contracts = dict:from_list(tab2list(ETSContracts)), + Types = dict:from_list(tab2list(ETSTypes)), + Callbacks = + dict:from_list([Cb || {_M, Cbs} <- tab2list(ETSCallbacks), Cb <- Cbs]), + ExpTypes = sets:from_list([E || {E} <- tab2list(ETSExpTypes)]), + ok = delete(MiniPlt), + #plt{info = Info, + types = Types, + contracts = Contracts, + callbacks = Callbacks, + exported_types = ExpTypes}; +restore_full_plt(undefined) -> undefined. +-spec delete(plt()) -> 'ok'. + +delete(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}) -> + true = ets:delete(ETSContracts), + true = ets:delete(ETSTypes), + true = ets:delete(ETSInfo), + true = ets:delete(ETSCallbacks), + true = ets:delete(ETSExpTypes), + ok. + +-spec give_away(plt(), pid()) -> 'ok'. + +give_away(#mini_plt{info = ETSInfo, + types = ETSTypes, + contracts = ETSContracts, + callbacks = ETSCallbacks, + exported_types = ETSExpTypes}, + Pid) -> + true = ets:give_away(ETSContracts, Pid, any), + true = ets:give_away(ETSTypes, Pid, any), + true = ets:give_away(ETSInfo, Pid, any), + true = ets:give_away(ETSCallbacks, Pid, any), + true = ets:give_away(ETSExpTypes, Pid, any), + ok. + +%% Somewhat slower than ets:tab2list(), but uses less memory. +tab2list(T) -> + tab2list(ets:first(T), T, []). + +tab2list('$end_of_table', T, A) -> + case ets:first(T) of % no safe_fixtable()... + '$end_of_table' -> A; + Key -> tab2list(Key, T, A) + end; +tab2list(Key, T, A) -> + Vs = ets:lookup(T, Key), + Key1 = ets:next(T, Key), + ets:delete(T, Key), + tab2list(Key1, T, Vs ++ A). + %%--------------------------------------------------------------------------- %% Edoc @@ -600,6 +680,12 @@ table_delete_module1(Plt, Mod) -> table_delete_module2(Plt, Mod) -> dict:filter(fun(M, _Val) -> M =/= Mod end, Plt). +ets_table_delete_list(Tab, [H|T]) -> + ets:delete(Tab, H), + ets_table_delete_list(Tab, T); +ets_table_delete_list(Tab, []) -> + Tab. + table_delete_list(Plt, [H|T]) -> table_delete_list(dict:erase(H, Plt), T); table_delete_list(Plt, []) -> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index df12796dd4..3c90f46e95 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -89,7 +89,7 @@ analyze_callgraph(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent) -> NewState = init_state_and_get_success_typings(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent), - dialyzer_plt:restore_full_plt(NewState#st.plt, Plt). + NewState#st.plt. %%-------------------------------------------------------------------- @@ -104,6 +104,7 @@ init_state_and_get_success_typings(Callgraph, Plt, Codeserver, get_refined_success_typings(SCCs, #st{callgraph = Callgraph, timing_server = TimingServer} = State) -> + erlang:garbage_collect(), case find_succ_typings(SCCs, State) of {fixpoint, State1} -> State1; {not_fixpoint, NotFixpoint1, State1} -> @@ -148,8 +149,8 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver, ?timing(TimingServer, "warning", get_warnings_from_modules(Mods, InitState, MiniDocPlt)), {postprocess_warnings(CWarns ++ ModWarns, Codeserver), - dialyzer_plt:restore_full_plt(MiniPlt, Plt), - dialyzer_plt:restore_full_plt(MiniDocPlt, DocPlt)}. + MiniPlt, + dialyzer_plt:restore_full_plt(MiniDocPlt)}. get_warnings_from_modules(Mods, State, DocPlt) -> #st{callgraph = Callgraph, codeserver = Codeserver, @@ -167,10 +168,10 @@ collect_warnings(M, {Codeserver, Callgraph, Plt, DocPlt}) -> %% Check if there are contracts for functions that do not exist Warnings1 = dialyzer_contracts:contracts_without_fun(Contracts, AllFuns, Callgraph), + Attrs = cerl:module_attrs(ModCode), {Warnings2, FunTypes} = dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, Codeserver, Records), - Attrs = cerl:module_attrs(ModCode), Warnings3 = dialyzer_behaviours:check_callbacks(M, Attrs, Records, Plt, Codeserver), DocPlt = insert_into_doc_plt(FunTypes, Callgraph, DocPlt), @@ -255,7 +256,7 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) -> NewFunTypes = dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, CodeServer, Records), Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer), - Contracts = orddict:from_list(dict:to_list(Contracts1)), + Contracts = orddict:from_list(maps:to_list(Contracts1)), FindOpaques = find_opaques_fun(Records), DecoratedFunTypes = decorate_succ_typings(Contracts, Callgraph, NewFunTypes, FindOpaques), @@ -341,21 +342,25 @@ find_succ_typings(SCCs, #st{codeserver = Codeserver, callgraph = Callgraph, -spec find_succ_types_for_scc(scc(), typesig_init_data()) -> [mfa_or_funlbl()]. -find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) -> - SCC_Info = [{MFA, - dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), - dialyzer_codeserver:lookup_mod_records(M, Codeserver)} - || {M, _, _} = MFA <- SCC], +find_succ_types_for_scc(SCC0, {Codeserver, Callgraph, Plt, Solvers}) -> + SCC = [MFA || {_, _, _} = MFA <- SCC0], Contracts1 = [{MFA, dialyzer_codeserver:lookup_mfa_contract(MFA, Codeserver)} - || {_, _, _} = MFA <- SCC], + || MFA <- SCC], Contracts2 = [{MFA, Contract} || {MFA, {ok, Contract}} <- Contracts1], Contracts3 = orddict:from_list(Contracts2), Label = dialyzer_codeserver:get_next_core_label(Codeserver), - AllFuns = collect_fun_info([Fun || {_MFA, {_Var, Fun}, _Rec} <- SCC_Info]), + AllFuns = lists:append( + [begin + {_Var, Fun} = + dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), + collect_fun_info([Fun]) + end || MFA <- SCC]), + erlang:garbage_collect(), PropTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt), %% Assume that the PLT contains the current propagated types - FunTypes = dialyzer_typesig:analyze_scc(SCC_Info, Label, Callgraph, - Plt, PropTypes, Solvers), + FunTypes = dialyzer_typesig:analyze_scc(SCC, Label, Callgraph, + Codeserver, Plt, PropTypes, + Solvers), AllFunSet = sets:from_list([X || {X, _} <- AllFuns]), FilteredFunTypes = dict:filter(fun(X, _) -> sets:is_element(X, AllFunSet) end, FunTypes), diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 457db9df83..b33484bda4 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -22,7 +22,7 @@ -module(dialyzer_typesig). --export([analyze_scc/6]). +-export([analyze_scc/7]). -export([get_safe_underapprox/2]). %%-import(helper, %% 'helper' could be any module doing sanity checks... @@ -94,10 +94,9 @@ -type types() :: erl_types:type_table(). --type typesig_scc() :: [{mfa(), {cerl:c_var(), cerl:c_fun()}, types()}]. -type typesig_funmap() :: #{type_var() => type_var()}. --type prop_types() :: dict:dict(label(), types()). +-type prop_types() :: dict:dict(label(), erl_types:erl_type()). -record(state, {callgraph :: dialyzer_callgraph:callgraph() | 'undefined', @@ -114,7 +113,7 @@ plt :: dialyzer_plt:plt() | 'undefined', prop_types = dict:new() :: prop_types(), - records = dict:new() :: types(), + records = maps:new() :: types(), scc = [] :: ordsets:ordset(type_var()), mfas :: [mfa()], solvers = [] :: [solver()] @@ -153,11 +152,10 @@ %%----------------------------------------------------------------------------- %% Analysis of strongly connected components. %% -%% analyze_scc(SCC, NextLabel, CallGraph, PLT, PropTypes, Solvers) -> FunTypes +%% analyze_scc(SCC, NextLabel, CallGraph, CodeServer, +%% PLT, PropTypes, Solvers) -> FunTypes %% -%% SCC - [{MFA, Def, Records}] -%% where Def = {Var, Fun} as in the Core Erlang module definitions. -%% Records = dict(RecName, {Arity, [{FieldName, FieldType}]}) +%% SCC - [{MFA}] %% NextLabel - An integer that is higher than any label in the code. %% CallGraph - A callgraph as produced by dialyzer_callgraph.erl %% Note: The callgraph must have been built with all the @@ -169,28 +167,27 @@ %% Solvers - User specified solvers. %%----------------------------------------------------------------------------- --spec analyze_scc(typesig_scc(), label(), +-spec analyze_scc([mfa()], label(), dialyzer_callgraph:callgraph(), + dialyzer_codeserver:codeserver(), dialyzer_plt:plt(), prop_types(), [solver()]) -> prop_types(). -analyze_scc(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers0) -> +analyze_scc(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers0) -> Solvers = solvers(Solvers0), - assert_format_of_scc(SCC), - State1 = new_state(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers), - DefSet = add_def_list([Var || {_MFA, {Var, _Fun}, _Rec} <- SCC], sets:new()), - State2 = traverse_scc(SCC, DefSet, State1), + State1 = new_state(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, + Solvers), + DefSet = add_def_list(maps:values(State1#state.name_map), sets:new()), + ModRecs = [{M, dialyzer_codeserver:lookup_mod_records(M, CServer)} || + M <- lists:usort([M || {M, _, _} <- SCC])], + State2 = traverse_scc(SCC, CServer, DefSet, ModRecs, State1), State3 = state__finalize(State2), + erlang:garbage_collect(), Funs = state__scc(State3), pp_constrs_scc(Funs, State3), constraints_to_dot_scc(Funs, State3), T = solve(Funs, State3), dict:from_list(maps:to_list(T)). -assert_format_of_scc([{_MFA, {_Var, _Fun}, _Records}|Left]) -> - assert_format_of_scc(Left); -assert_format_of_scc([]) -> - ok. - solvers([]) -> [v2]; solvers(Solvers) -> Solvers. @@ -200,12 +197,14 @@ solvers(Solvers) -> Solvers. %% %% ============================================================================ -traverse_scc([{_MFA, Def, Rec}|Left], DefSet, AccState) -> +traverse_scc([{M,_,_}=MFA|Left], Codeserver, DefSet, ModRecs, AccState) -> + Def = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver), + {M, Rec} = lists:keyfind(M, 1, ModRecs), TmpState1 = state__set_rec_dict(AccState, Rec), DummyLetrec = cerl:c_letrec([Def], cerl:c_atom(foo)), {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState1), - traverse_scc(Left, DefSet, NewAccState); -traverse_scc([], _DefSet, AccState) -> + traverse_scc(Left, Codeserver, DefSet, ModRecs, NewAccState); +traverse_scc([], _Codeserver, _DefSet, _ModRecs, AccState) -> AccState. traverse(Tree, DefinedVars, State) -> @@ -2695,11 +2694,14 @@ pp_map(_S, _Map) -> %% %% ============================================================================ -new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) -> - List = [{MFA, Var} || {MFA, {Var, _Fun}, _Rec} <- SCC0], +new_state(MFAs, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers) -> + List_SCC = + [begin + {Var, Label} = dialyzer_codeserver:lookup_mfa_var_label(MFA, CServer), + {{MFA, Var}, t_var(Label)} + end || MFA <- MFAs], + {List, SCC} = lists:unzip(List_SCC), NameMap = maps:from_list(List), - MFAs = [MFA || {MFA, _Var} <- List], - SCC = [mk_var(Fun) || {_MFA, {_Var, Fun}, _Rec} <- SCC0], SelfRec = case SCC of [OneF] -> diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 8480129dab..432d27571b 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -195,7 +195,7 @@ get_core_from_abstract_code(AbstrCode, Opts) -> get_record_and_type_info(AbstractCode) -> Module = get_module(AbstractCode), - get_record_and_type_info(AbstractCode, Module, dict:new()). + get_record_and_type_info(AbstractCode, Module, maps:new()). -spec get_record_and_type_info(abstract_code(), module(), type_table()) -> {'ok', type_table()} | {'error', string()}. @@ -208,7 +208,7 @@ get_record_and_type_info([{attribute, A, record, {Name, Fields0}}|Left], {ok, Fields} = get_record_fields(Fields0, RecDict), Arity = length(Fields), FN = {File, erl_anno:line(A)}, - NewRecDict = dict:store({record, Name}, {FN, [{Arity,Fields}]}, RecDict), + NewRecDict = maps:put({record, Name}, {FN, [{Arity,Fields}]}, RecDict), get_record_and_type_info(Left, Module, NewRecDict, File); get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}} |Left], Module, RecDict, File) -> @@ -216,7 +216,7 @@ get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}} {ok, Fields} = get_record_fields(Fields0, RecDict), Arity = length(Fields), FN = {File, erl_anno:line(A)}, - NewRecDict = dict:store({record, Name}, {FN, [{Arity, Fields}]}, RecDict), + NewRecDict = maps:put({record, Name}, {FN, [{Arity, Fields}]}, RecDict), get_record_and_type_info(Left, Module, NewRecDict, File); get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm}}|Left], Module, RecDict, File) @@ -256,9 +256,9 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN, false -> try erl_types:t_var_names(ArgForms) of ArgNames -> - dict:store({TypeOrOpaque, Name, Arity}, - {{Module, FN, TypeForm, ArgNames}, - erl_types:t_any()}, RecDict) + maps:put({TypeOrOpaque, Name, Arity}, + {{Module, FN, TypeForm, ArgNames}, + erl_types:t_any()}, RecDict) catch _:_ -> throw({error, flat_format("Type declaration for ~w does not " @@ -289,19 +289,18 @@ get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) -> get_record_fields([], _RecDict, Acc) -> lists:reverse(Acc). --spec process_record_remote_types(codeserver()) -> codeserver(). +-spec process_record_remote_types(codeserver()) -> + {codeserver(), mod_records()}. %% The field types are cached. Used during analysis when handling records. process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), ExpTypes = dialyzer_codeserver:get_exported_types(CServer), - Cache = erl_types:cache__new(), - {TempRecords1, Cache1} = - process_opaque_types0(TempRecords, ExpTypes, Cache), + TempRecords1 = process_opaque_types0(TempRecords, ExpTypes), %% A cache (not the field type cache) is used for speeding things up a bit. VarTable = erl_types:var_table__new(), ModuleFun = - fun({Module, Record}, C0) -> + fun({Module, Record}) -> RecordFun = fun({Key, Value}, C2) -> case Key of @@ -327,24 +326,27 @@ process_record_remote_types(CServer) -> _Other -> {{Key, Value}, C2} end end, - {RecordList, C1} = - lists:mapfoldl(RecordFun, C0, dict:to_list(Record)), - {{Module, dict:from_list(RecordList)}, C1} + Cache = erl_types:cache__new(), + {RecordList, _NewCache} = + lists:mapfoldl(RecordFun, Cache, maps:to_list(Record)), + {Module, maps:from_list(RecordList)} end, - {NewRecordsList, C1} = - lists:mapfoldl(ModuleFun, Cache1, dict:to_list(TempRecords1)), + NewRecordsList = lists:map(ModuleFun, dict:to_list(TempRecords1)), NewRecords = dict:from_list(NewRecordsList), - _C8 = check_record_fields(NewRecords, ExpTypes, C1), - dialyzer_codeserver:finalize_records(NewRecords, CServer). + check_record_fields(NewRecords, ExpTypes), + {dialyzer_codeserver:finalize_records(NewRecords, CServer), NewRecords}. %% erl_types:t_from_form() substitutes the declaration of opaque types %% for the expanded type in some cases. To make sure the initial type, %% any(), is not used, the expansion is done twice. %% XXX: Recursive opaque types are not handled well. -process_opaque_types0(TempRecords0, TempExpTypes, Cache) -> - {TempRecords1, NewCache} = +process_opaque_types0(TempRecords0, TempExpTypes) -> + Cache = erl_types:cache__new(), + {TempRecords1, Cache1} = process_opaque_types(TempRecords0, TempExpTypes, Cache), - process_opaque_types(TempRecords1, TempExpTypes, NewCache). + {TempRecords, _NewCache} = + process_opaque_types(TempRecords1, TempExpTypes, Cache1), + TempRecords. process_opaque_types(TempRecords, TempExpTypes, Cache) -> VarTable = erl_types:var_table__new(), @@ -364,8 +366,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) -> end end, {RecordList, C1} = - lists:mapfoldl(RecordFun, C0, dict:to_list(Record)), - {{Module, dict:from_list(RecordList)}, C1} + lists:mapfoldl(RecordFun, C0, maps:to_list(Record)), + {{Module, maps:from_list(RecordList)}, C1} %% dict:map(RecordFun, Record) end, {TempRecordList, NewCache} = @@ -373,7 +375,8 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) -> {dict:from_list(TempRecordList), NewCache}. %% dict:map(ModuleFun, TempRecords). -check_record_fields(Records, TempExpTypes, Cache) -> +check_record_fields(Records, TempExpTypes) -> + Cache = erl_types:cache__new(), VarTable = erl_types:var_table__new(), CheckFun = fun({Module, Element}, C0) -> @@ -403,9 +406,10 @@ check_record_fields(Records, TempExpTypes, Cache) -> msg_with_position(Fun, FileLine) end end, - lists:foldl(ElemFun, C0, dict:to_list(Element)) + lists:foldl(ElemFun, C0, maps:to_list(Element)) end, - lists:foldl(CheckFun, Cache, dict:to_list(Records)). + _NewCache = lists:foldl(CheckFun, Cache, dict:to_list(Records)), + ok. msg_with_position(Fun, FileLine) -> try Fun() @@ -428,17 +432,17 @@ merge_records(NewRecords, OldRecords) -> %% %% ============================================================================ --type spec_dict() :: dict:dict(). --type callback_dict() :: dict:dict(). +-type spec_map() :: dialyzer_codeserver:contracts(). +-type callback_map() :: dialyzer_codeserver:contracts(). -spec get_spec_info(module(), abstract_code(), type_table()) -> - {'ok', spec_dict(), callback_dict()} | {'error', string()}. + {'ok', spec_map(), callback_map()} | {'error', string()}. -get_spec_info(ModName, AbstractCode, RecordsDict) -> +get_spec_info(ModName, AbstractCode, RecordsMap) -> OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName), OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0), - get_spec_info(AbstractCode, dict:new(), dict:new(), - RecordsDict, ModName, OptionalCallbacks, "nofile"). + get_spec_info(AbstractCode, maps:new(), maps:new(), + RecordsMap, ModName, OptionalCallbacks, "nofile"). get_optional_callbacks(Abs, ModName) -> [{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)]. @@ -456,7 +460,7 @@ get_optional_callbacks(Abs) -> %% are erl_types:erl_type() get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File) + SpecMap, CallbackMap, RecordsMap, ModName, OptCb, File) when ((Contract =:= 'spec') or (Contract =:= 'callback')), is_list(TypeSpec) -> Ln = erl_anno:line(Anno), @@ -465,24 +469,24 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], {F, A} -> {ModName, F, A} end, Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)], - ActiveDict = + ActiveMap = case Contract of - spec -> SpecDict; - callback -> CallbackDict + spec -> SpecMap; + callback -> CallbackMap end, - try dict:find(MFA, ActiveDict) of + try maps:find(MFA, ActiveMap) of error -> SpecData = {TypeSpec, Xtra}, - NewActiveDict = + NewActiveMap = dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData, - ActiveDict, RecordsDict), - {NewSpecDict, NewCallbackDict} = + ActiveMap, RecordsMap), + {NewSpecMap, NewCallbackMap} = case Contract of - spec -> {NewActiveDict, CallbackDict}; - callback -> {SpecDict, NewActiveDict} + spec -> {NewActiveMap, CallbackMap}; + callback -> {SpecMap, NewActiveMap} end, - get_spec_info(Left, NewSpecDict, NewCallbackDict, - RecordsDict, ModName, OptCb, File); + get_spec_info(Left, NewSpecMap, NewCallbackMap, + RecordsMap, ModName, OptCb, File); {ok, {{OtherFile, L}, _D}} -> {Mod, Fun, Arity} = MFA, Msg = flat_format(" Contract/callback for function ~w:~w/~w " @@ -495,16 +499,16 @@ get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], [Ln, Error])} end; get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) -> - get_spec_info(Left, SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, IncludeFile); -get_spec_info([_Other|Left], SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, File) -> - get_spec_info(Left, SpecDict, CallbackDict, - RecordsDict, ModName, OptCb, File); -get_spec_info([], SpecDict, CallbackDict, - _RecordsDict, _ModName, _OptCb, _File) -> - {ok, SpecDict, CallbackDict}. + SpecMap, CallbackMap, RecordsMap, ModName, OptCb, _File) -> + get_spec_info(Left, SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, IncludeFile); +get_spec_info([_Other|Left], SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, File) -> + get_spec_info(Left, SpecMap, CallbackMap, + RecordsMap, ModName, OptCb, File); +get_spec_info([], SpecMap, CallbackMap, + _RecordsMap, _ModName, _OptCb, _File) -> + {ok, SpecMap, CallbackMap}. -spec get_fun_meta_info(module(), abstract_code(), [dial_warn_tag()]) -> dialyzer_codeserver:fun_meta_info() | {'error', string()}. @@ -700,7 +704,7 @@ format_errors([]) -> -spec format_sig(erl_types:erl_type()) -> string(). format_sig(Type) -> - format_sig(Type, dict:new()). + format_sig(Type, maps:new()). -spec format_sig(erl_types:erl_type(), type_table()) -> string(). @@ -952,9 +956,7 @@ label(Tree) -> -spec parallelism() -> integer(). parallelism() -> - CPUs = erlang:system_info(logical_processors_available), - Schedulers = erlang:system_info(schedulers), - min(CPUs, Schedulers). + erlang:system_info(schedulers_online). -spec family([{K,V}]) -> [{K,[V]}]. diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars new file mode 100644 index 0000000000..2c1f8f8d17 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/chars @@ -0,0 +1,4 @@ + +chars.erl:29: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok' +chars.erl:32: Function t1/0 has no local return +chars.erl:32: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok' diff --git a/lib/dialyzer/test/small_SUITE_data/src/anno.erl b/lib/dialyzer/test/small_SUITE_data/src/anno.erl new file mode 100644 index 0000000000..70f1d42141 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/anno.erl @@ -0,0 +1,18 @@ +-module(anno). + +%% OTP-14131 + +-export([t1/0, t2/0, t3/0]). + +t1() -> + A = erl_parse:anno_from_term({attribute, 1, module, my_test}), + compile:forms([A], []). + +t2() -> + A = erl_parse:new_anno({attribute, 1, module, my_test}), + compile:forms([A], []). + +t3() -> + A = erl_parse:new_anno({attribute, 1, module, my_test}), + T = erl_parse:anno_to_term(A), + {attribute, 1, module, my_test} = T. diff --git a/lib/dialyzer/test/small_SUITE_data/src/chars.erl b/lib/dialyzer/test/small_SUITE_data/src/chars.erl new file mode 100644 index 0000000000..1e9c8ab6b9 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/chars.erl @@ -0,0 +1,32 @@ +-module(chars). + +%% ERL-313 + +-export([t/0]). +-export([t1/0]). + +-record(r, {f :: $A .. $Z}). + +-type cs() :: $A..$Z | $a .. $z | $/. + +-spec t() -> $0-$0..$9-$0| $?. + +t() -> + c(#r{f = $z - 3}), + c($z - 3), + c($B). + +-spec c(cs()) -> $3-$0..$9-$0. + +c($A + 1) -> 2; +c(C) -> + case C of + $z - 3 -> 3; + #r{f = $z - 3} -> 7 + end. + +%% Display contract with character in warning: +-spec f(#{a := $1, b => $2, c => $3}) -> ok. % invalid type spec +f(_) -> ok. + +t1() -> f(#{b => $2}). % breaks the contract diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index 6723876208..9830a36e60 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 3.0.2 +DIALYZER_VSN = 3.0.3 diff --git a/lib/diameter/examples/code/relay.erl b/lib/diameter/examples/code/relay.erl index cf4ce8848b..806f79915b 100644 --- a/lib/diameter/examples/code/relay.erl +++ b/lib/diameter/examples/code/relay.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index 4007d6b7b1..864d5f0691 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl index ed6641b9fb..c77d46f27a 100644 --- a/lib/diameter/test/diameter_capx_SUITE.erl +++ b/lib/diameter/test/diameter_capx_SUITE.erl @@ -384,7 +384,7 @@ load_dict(N) -> A3 = erl_anno:new(3), A4 = erl_anno:new(4), Forms = [{attribute, A1, module, Mod}, - {attribute, A2, compile, [export_all]}, + {attribute, A2, export, [{id,0}]}, {function, A3, id, 0, [{clause, A4, [], [], [{integer, A4, N}]}]}], {ok, Mod, Bin, []} = compile:forms(Forms, [return]), diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index 37c41a1761..869797f11f 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index b5e520e642..5353688bf4 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. diff --git a/lib/edoc/doc/src/notes.xml b/lib/edoc/doc/src/notes.xml index e6ad2c683f..4982488335 100644 --- a/lib/edoc/doc/src/notes.xml +++ b/lib/edoc/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the EDoc application.</p> +<section><title>Edoc 0.8.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> Document the function tags <c>@param</c> and + <c>@returns</c>. </p> + <p> + Own Id: OTP-13930 Aux Id: PR-1175 </p> + </item> + </list> + </section> + +</section> + <section><title>Edoc 0.8</title> <section><title>Improvements and New Features</title> diff --git a/lib/edoc/vsn.mk b/lib/edoc/vsn.mk index d3cc732e9c..d66802fdac 100644 --- a/lib/edoc/vsn.mk +++ b/lib/edoc/vsn.mk @@ -1 +1 @@ -EDOC_VSN = 0.8 +EDOC_VSN = 0.8.1 diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile index 21a0da926f..81fa8f187a 100644 --- a/lib/eldap/test/Makefile +++ b/lib/eldap/test/Makefile @@ -42,7 +42,7 @@ TARGET_FILES= \ SPEC_FILES = eldap.spec -# COVER_FILE = eldap.cover +COVER_FILE = eldap.cover # ---------------------------------------------------- diff --git a/lib/eldap/test/eldap.cover b/lib/eldap/test/eldap.cover new file mode 100644 index 0000000000..8c15956e72 --- /dev/null +++ b/lib/eldap/test/eldap.cover @@ -0,0 +1,3 @@ +{incl_app,eldap,details}. + +{excl_mods, eldap, ['ELDAPv3']}. diff --git a/lib/erl_docgen/doc/src/notes.xml b/lib/erl_docgen/doc/src/notes.xml index cf24161d43..4824a755d9 100644 --- a/lib/erl_docgen/doc/src/notes.xml +++ b/lib/erl_docgen/doc/src/notes.xml @@ -31,7 +31,24 @@ </header> <p>This document describes the changes made to the <em>erl_docgen</em> application.</p> - <section><title>Erl_Docgen 0.6</title> + <section><title>Erl_Docgen 0.6.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Docgen would previously emit "utf8" as the default + encoding in xml. This has now been remedied by emitting + the correct string "UTF-8" instead.</p> + <p> + Own Id: OTP-13971</p> + </item> + </list> + </section> + +</section> + +<section><title>Erl_Docgen 0.6</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk index 6489d26327..d6106a2823 100644 --- a/lib/erl_docgen/vsn.mk +++ b/lib/erl_docgen/vsn.mk @@ -1 +1 @@ -ERL_DOCGEN_VSN = 0.6 +ERL_DOCGEN_VSN = 0.6.1 diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 4ef5454f44..69ba3cddb8 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,35 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.9.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix <c>ei_connect_init</c> and <c>ei_connect_xinit</c> to + adjust the <c>creation</c> argument to be compatible with + nodes older than OTP-19.</p> + <p> + Own Id: OTP-13981</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Editorial documentation changes</p> + <p> + Own Id: OTP-13980</p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.9.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/erl_interface/src/prog/erl_start.c b/lib/erl_interface/src/prog/erl_start.c index d8f0632341..670a5900c9 100644 --- a/lib/erl_interface/src/prog/erl_start.c +++ b/lib/erl_interface/src/prog/erl_start.c @@ -17,7 +17,6 @@ * * %CopyrightEnd% * - */ /* An exception from using eidef.h, use config.h directly */ @@ -45,7 +44,7 @@ #include <unistd.h> #include <sys/socket.h> #include <netinet/in.h> -#include <netinet/tcp.h> +#include <netinet/tcp.h> #include <symLib.h> #include <sysSymTbl.h> #include <sysLib.h> @@ -117,9 +116,9 @@ static int unique_id(void); static unsigned long spawn_erlang_epmd(ei_cnode *ec, char *alive, Erl_IpAddr adr, - int flags, - char *erl_or_epmd, - char *args[], + int flags, + char *erl_or_epmd, + char *args[], int port, int is_erlang); #else @@ -161,10 +160,10 @@ int erl_start_sys(ei_cnode *ec, char *alive, Erl_IpAddr adr, int flags, r = ERL_SYS_ERROR; goto done; } - + memset(&addr,0,sizeof(addr)); - addr.sin_family = AF_INET; - addr.sin_addr.s_addr = htonl(INADDR_ANY); + addr.sin_family = AF_INET; + addr.sin_addr.s_addr = htonl(INADDR_ANY); addr.sin_port = 0; if (bind(sockd,(struct sockaddr *)&addr,sizeof(addr))<0) { @@ -179,12 +178,12 @@ int erl_start_sys(ei_cnode *ec, char *alive, Erl_IpAddr adr, int flags, listen(sockd,5); #if defined(VXWORKS) || defined(__WIN32__) - if((pid = spawn_erlang_epmd(ec,alive,adr,flags,erl,args,port,1)) + if((pid = spawn_erlang_epmd(ec,alive,adr,flags,erl,args,port,1)) == 0) return ERL_SYS_ERROR; timeout.tv_usec = 0; timeout.tv_sec = 10; /* ignoring ERL_START_TIME */ - if((r = wait_for_erlang(sockd,unique_id(),&timeout)) + if((r = wait_for_erlang(sockd,unique_id(),&timeout)) == ERL_TIMEOUT) { #if defined(VXWORKS) taskDelete((int) pid); @@ -262,7 +261,7 @@ done: static int unique_id(void){ #if defined(VXWORKS) return taskIdSelf(); -#else +#else return (int) GetCurrentThreadId(); #endif } @@ -285,7 +284,7 @@ static int enquote_args(char **oargs, char ***qargs){ for(len=0;oargs[len] != NULL; ++len) ; args = malloc(sizeof(char *) * (len + 1)); - + for(i = 0; i < len; ++i){ qwhole = strchr(oargs[i],' ') != NULL; extra = qwhole * 2; @@ -337,16 +336,16 @@ static FUNCPTR lookup_function(char *symname){ static unsigned long spawn_erlang_epmd(ei_cnode *ec, char *alive, Erl_IpAddr adr, - int flags, - char *erl_or_epmd, - char *args[], + int flags, + char *erl_or_epmd, + char *args[], int port, int is_erlang) { #if defined(VXWORKS) FUNCPTR erlfunc; #else /* Windows */ - STARTUPINFO sinfo; + STARTUPINFO sinfo; SECURITY_ATTRIBUTES sa; PROCESS_INFORMATION pinfo; #endif @@ -364,7 +363,7 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, if(is_erlang){ get_addr(ei_thishostname(ec), &myaddr); #if defined(VXWORKS) - inet_ntoa_b(myaddr, iaddrbuf); + inet_ntoa_b(myaddr, iaddrbuf); #else /* Windows */ if((ptr = inet_ntoa(myaddr)) == NULL) return 0; @@ -372,7 +371,7 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, strcpy(iaddrbuf,ptr); #endif } - if ((flags & ERL_START_REMOTE) || + if ((flags & ERL_START_REMOTE) || (is_erlang && (hisaddr->s_addr != myaddr.s_addr))) { return 0; } else { @@ -382,19 +381,17 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, #if !defined(VXWORKS) /* On VxWorks, we dont actually run a command, we call start_erl() */ - if(!erl_or_epmd) + if(!erl_or_epmd) #endif erl_or_epmd = (is_erlang) ? DEF_ERL_COMMAND : DEF_EPMD_COMMAND; if(is_erlang){ name_format = (flags & ERL_START_LONG) ? ERL_NAME_FMT : ERL_SNAME_FMT; - cmdlen += + cmdlen += strlen(erl_or_epmd) + (*erl_or_epmd != '\0') + strlen(name_format) + 1 + strlen(alive) + - strlen(ERL_REPLY_FMT) + 1 + strlen(iaddrbuf) + - 2 * FORMATTED_INT_LEN + - 1; + strlen(ERL_REPLY_FMT) + 1 + strlen(iaddrbuf) + 2 * FORMATTED_INT_LEN + 1; ptr = cmdbuf = malloc(cmdlen); if(*erl_or_epmd != '\0') ptr += sprintf(ptr,"%s ",erl_or_epmd); @@ -484,11 +481,11 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, * arguments we use here. */ static int exec_erlang(ei_cnode *ec, - char *alive, + char *alive, Erl_IpAddr adr, - int flags, - char *erl, - char *args[], + int flags, + char *erl, + char *args[], int port) { #if !defined(__WIN32__) && !defined(VXWORKS) @@ -498,8 +495,11 @@ static int exec_erlang(ei_cnode *ec, char argbuf[BUFSIZ]; struct in_addr myaddr; struct in_addr *hisaddr = (struct in_addr *)adr; - - get_addr(ei_thishostname(ec), &myaddr); + + if (!get_addr(ei_thishostname(ec), &myaddr)) { + fprintf(stderr,"erl_call: failed to find hostname\r\n"); + return ERL_SYS_ERROR; + } /* on this host? */ /* compare ip addresses, unless forced by flag setting to use rsh */ @@ -525,8 +525,8 @@ static int exec_erlang(ei_cnode *ec, /* *must* be noinput or node (seems to) hang... */ /* long or short names? */ - sprintf(&argbuf[len], "-noinput %s %s ", - ((flags & ERL_START_LONG) ? "-name" : "-sname"), + sprintf(&argbuf[len], "-noinput %s %s ", + ((flags & ERL_START_LONG) ? "-name" : "-sname"), alive); len = strlen(argbuf); @@ -572,7 +572,7 @@ static int exec_erlang(ei_cnode *ec, fprintf(stderr,"\n\n===== Log started ======\n%s \n",ctime(&t)); fprintf(stderr,"erl_call: %s %s %s\n",argv[0],argv[1],argv[2]); } - } + } /* start the system */ execvp(argv[0], argv); @@ -609,7 +609,7 @@ static void gettimeofday(struct timeval *now, void *dummy){ now->tv_usec = ((ctick - (now->tv_sec * rate))*1000000)/rate; } #endif - + /* wait for the remote system to reply */ /* @@ -648,7 +648,7 @@ static int wait_for_erlang(int sockd, int magic, struct timeval *timeout) "will timeout at %ld.%06ld\n", now.tv_sec,now.tv_usec,stop_time.tv_sec,stop_time.tv_usec); #endif - + while (1) { FD_ZERO(&rdset); FD_SET(sockd,&rdset); @@ -662,7 +662,7 @@ static int wait_for_erlang(int sockd, int magic, struct timeval *timeout) to.tv_sec--; } if (to.tv_sec < 0) return ERL_TIMEOUT; - + #ifdef DEBUG fprintf(stderr,"erl_call: debug remaining to timeout: %ld.%06ld\n", to.tv_sec,to.tv_usec); @@ -690,7 +690,7 @@ static int wait_for_erlang(int sockd, int magic, struct timeval *timeout) if (FD_ISSET(sockd,&rdset)) { if ((fd = accept(sockd,(struct sockaddr *)&peer,&len)) < 0) return ERL_SYS_ERROR; - + /* now get sign-on message and terminate it */ #if defined(__WIN32__) if ((n=recv(fd,buf,16,0)) >= 0) buf[n]=0x0; @@ -703,7 +703,6 @@ static int wait_for_erlang(int sockd, int magic, struct timeval *timeout) fprintf(stderr,"erl_call: debug got %d, expected %d\n", atoi(buf),magic); #endif - if (atoi(buf) == magic) return 0; /* success */ } /* if FD_SET */ } /* switch */ diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index 82be43b7df..c7981ed3a5 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.9.1 +EI_VSN = 3.9.2 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/eunit/doc/src/notes.xml b/lib/eunit/doc/src/notes.xml index 6ae3c04bc8..8509f44ffc 100644 --- a/lib/eunit/doc/src/notes.xml +++ b/lib/eunit/doc/src/notes.xml @@ -33,6 +33,22 @@ </header> <p>This document describes the changes made to the EUnit application.</p> +<section><title>Eunit 2.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The address to the FSF in the license header has been + updated.</p> + <p> + Own Id: OTP-14084</p> + </item> + </list> + </section> + +</section> + <section><title>Eunit 2.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile index 86a6d8831e..3510d3cc93 100644 --- a/lib/eunit/src/Makefile +++ b/lib/eunit/src/Makefile @@ -24,7 +24,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/eunit-$(VSN) EBIN = ../ebin INCLUDE=../include -ERL_COMPILE_FLAGS += -pa $(EBIN) -pa ../../stdlib/ebin -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard +ERL_COMPILE_FLAGS += -pa $(EBIN) -pa ../../stdlib/ebin -I$(INCLUDE) +nowarn_shadow_vars +warn_unused_import PARSE_TRANSFORM = eunit_autoexport.erl diff --git a/lib/eunit/vsn.mk b/lib/eunit/vsn.mk index 83d826f8b6..7eee75ee10 100644 --- a/lib/eunit/vsn.mk +++ b/lib/eunit/vsn.mk @@ -1 +1 @@ -EUNIT_VSN = 2.3.1 +EUNIT_VSN = 2.3.2 diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 5a4cf77b81..91ee104f77 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -228,7 +228,8 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]). +-export_type([erl_type/0, opaques/0, type_table/0, mod_records/0, + var_table/0, cache/0]). %%-define(DEBUG, true). @@ -371,8 +372,9 @@ -type type_value() :: {{module(), {file:name(), erl_anno:line()}, erl_parse:abstract_type(), ArgNames :: [atom()]}, erl_type()}. --type type_table() :: dict:dict(record_key() | type_key(), - record_value() | type_value()). +-type type_table() :: #{record_key() | type_key() => + record_value() | type_value()}. +-type mod_records() :: dict:dict(module(), type_table()). -opaque var_table() :: #{atom() => erl_type()}. @@ -741,16 +743,16 @@ decorate_tuples_in_sets([], _L, _Opaques, Acc) -> -spec t_opaque_from_records(type_table()) -> [erl_type()]. -t_opaque_from_records(RecDict) -> - OpaqueRecDict = - dict:filter(fun(Key, _Value) -> +t_opaque_from_records(RecMap) -> + OpaqueRecMap = + maps:filter(fun(Key, _Value) -> case Key of {opaque, _Name, _Arity} -> true; _ -> false end - end, RecDict), - OpaqueTypeDict = - dict:map(fun({opaque, Name, _Arity}, + end, RecMap), + OpaqueTypeMap = + maps:map(fun({opaque, Name, _Arity}, {{Module, _FileLine, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), @@ -759,8 +761,8 @@ t_opaque_from_records(RecDict) -> Rep = t_any(), % not used for anything right now Args = [t_any() || _ <- ArgNames], t_opaque(Module, Name, Args, Rep) - end, OpaqueRecDict), - [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)]. + end, OpaqueRecMap), + [OpaqueType || {_Key, OpaqueType} <- maps:to_list(OpaqueTypeMap)]. %% Decompose opaque instances of type arg2 to structured types, in arg1 %% XXX: Same as t_unopaque @@ -794,10 +796,6 @@ list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. %%----------------------------------------------------------------------------- - --type mod_records() :: dict:dict(module(), type_table()). - -%%----------------------------------------------------------------------------- %% Unit type. Signals non termination. %% @@ -3059,88 +3057,91 @@ is_compat_args([A1|Args1], [A2|Args2]) -> is_compat_args([], []) -> true; is_compat_args(_, _) -> false. -is_compat_arg(A1, A2) -> - is_specialization(A1, A2) orelse is_specialization(A2, A1). - --spec is_specialization(erl_type(), erl_type()) -> boolean(). - -%% Returns true if the first argument is a specialization of the -%% second argument in the sense that every type is a specialization of -%% any(). For example, {_,_} is a specialization of any(), but not of -%% tuple(). Does not handle variables, but any() and unions (sort of). - -is_specialization(T, T) -> true; -is_specialization(_, ?any) -> true; -is_specialization(?any, _) -> false; -is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) -> - (is_specialization(Domain1, Domain2) andalso - is_specialization(Range1, Range2)); -is_specialization(?list(Contents1, Termination1, Size1), - ?list(Contents2, Termination2, Size2)) -> +-spec is_compat_arg(erl_type(), erl_type()) -> boolean(). + +%% The intention is that 'true' is to be returned iff one of the +%% arguments is a specialization of the other argument in the sense +%% that every type is a specialization of any(). For example, {_,_} is +%% a specialization of any(), but not of tuple(). Does not handle +%% variables, but any() and unions (sort of). However, the +%% implementation is more relaxed as any() is compatible to anything. + +is_compat_arg(T, T) -> true; +is_compat_arg(_, ?any) -> true; +is_compat_arg(?any, _) -> true; +is_compat_arg(?function(Domain1, Range1), ?function(Domain2, Range2)) -> + (is_compat_arg(Domain1, Domain2) andalso + is_compat_arg(Range1, Range2)); +is_compat_arg(?list(Contents1, Termination1, Size1), + ?list(Contents2, Termination2, Size2)) -> (Size1 =:= Size2 andalso - is_specialization(Contents1, Contents2) andalso - is_specialization(Termination1, Termination2)); -is_specialization(?product(Types1), ?product(Types2)) -> - specialization_list(Types1, Types2); -is_specialization(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; -is_specialization(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; -is_specialization(?tuple(Elements1, Arity, _), - ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> - specialization_list(Elements1, Elements2); -is_specialization(?tuple_set([{Arity, List}]), - ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> - specialization_list(sup_tuple_elements(List), Elements2); -is_specialization(?tuple(Elements1, Arity, _), - ?tuple_set([{Arity, List}])) when Arity =/= ?any -> - specialization_list(Elements1, sup_tuple_elements(List)); -is_specialization(?tuple_set(List1), ?tuple_set(List2)) -> + is_compat_arg(Contents1, Contents2) andalso + is_compat_arg(Termination1, Termination2)); +is_compat_arg(?product(Types1), ?product(Types2)) -> + is_compat_list(Types1, Types2); +is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) -> + (is_compat_list(Pairs1, Pairs2) andalso + is_compat_arg(DefK1, DefK2) andalso + is_compat_arg(DefV1, DefV2)); +is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; +is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; +is_compat_arg(?tuple(Elements1, Arity, _), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + is_compat_list(Elements1, Elements2); +is_compat_arg(?tuple_set([{Arity, List}]), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + is_compat_list(sup_tuple_elements(List), Elements2); +is_compat_arg(?tuple(Elements1, Arity, _), + ?tuple_set([{Arity, List}])) when Arity =/= ?any -> + is_compat_list(Elements1, sup_tuple_elements(List)); +is_compat_arg(?tuple_set(List1), ?tuple_set(List2)) -> try - specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], - [sup_tuple_elements(T) || {_Arity, T} <- List2]) + is_compat_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], + [sup_tuple_elements(T) || {_Arity, T} <- List2]) catch _:_ -> false end; -is_specialization(?opaque(_) = T1, T2) -> - is_specialization(t_opaque_structure(T1), T2); -is_specialization(T1, ?opaque(_) = T2) -> - is_specialization(T1, t_opaque_structure(T2)); -is_specialization(?union(List1)=T1, ?union(List2)=T2) -> - case specialization_union2(T1, T2) of - {yes, Type1, Type2} -> is_specialization(Type1, Type2); - no -> specialization_list(List1, List2) +is_compat_arg(?opaque(_) = T1, T2) -> + is_compat_arg(t_opaque_structure(T1), T2); +is_compat_arg(T1, ?opaque(_) = T2) -> + is_compat_arg(T1, t_opaque_structure(T2)); +is_compat_arg(?union(List1)=T1, ?union(List2)=T2) -> + case is_compat_union2(T1, T2) of + {yes, Type1, Type2} -> is_compat_arg(Type1, Type2); + no -> is_compat_list(List1, List2) end; -is_specialization(?union(List), T2) -> +is_compat_arg(?union(List), T2) -> case unify_union(List) of - {yes, Type} -> is_specialization(Type, T2); + {yes, Type} -> is_compat_arg(Type, T2); no -> false end; -is_specialization(T1, ?union(List)) -> +is_compat_arg(T1, ?union(List)) -> case unify_union(List) of - {yes, Type} -> is_specialization(T1, Type); + {yes, Type} -> is_compat_arg(T1, Type); no -> false end; -is_specialization(?var(_), _) -> exit(error); -is_specialization(_, ?var(_)) -> exit(error); -is_specialization(?none, _) -> false; -is_specialization(_, ?none) -> false; -is_specialization(?unit, _) -> false; -is_specialization(_, ?unit) -> false; -is_specialization(#c{}, #c{}) -> false. +is_compat_arg(?var(_), _) -> exit(error); +is_compat_arg(_, ?var(_)) -> exit(error); +is_compat_arg(?none, _) -> false; +is_compat_arg(_, ?none) -> false; +is_compat_arg(?unit, _) -> false; +is_compat_arg(_, ?unit) -> false; +is_compat_arg(#c{}, #c{}) -> false. -specialization_list_list(LL1, LL2) -> - length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2). +is_compat_list_list(LL1, LL2) -> + length(LL1) =:= length(LL2) andalso is_compat_list_list1(LL1, LL2). -specialization_list_list1([], []) -> true; -specialization_list_list1([L1|LL1], [L2|LL2]) -> - specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2). +is_compat_list_list1([], []) -> true; +is_compat_list_list1([L1|LL1], [L2|LL2]) -> + is_compat_list(L1, L2) andalso is_compat_list_list1(LL1, LL2). -specialization_list(L1, L2) -> - length(L1) =:= length(L2) andalso specialization_list1(L1, L2). +is_compat_list(L1, L2) -> + length(L1) =:= length(L2) andalso is_compat_list1(L1, L2). -specialization_list1([], []) -> true; -specialization_list1([T1|L1], [T2|L2]) -> - is_specialization(T1, T2) andalso specialization_list1(L1, L2). +is_compat_list1([], []) -> true; +is_compat_list1([T1|L1], [T2|L2]) -> + is_compat_arg(T1, T2) andalso is_compat_list1(L1, L2). -specialization_union2(?union(List1)=T1, ?union(List2)=T2) -> +is_compat_union2(?union(List1)=T1, ?union(List2)=T2) -> case {unify_union(List1), unify_union(List2)} of {{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2}; {{yes, Type1}, no} -> {yes, Type1, T2}; @@ -4173,7 +4174,7 @@ t_map(Fun, T) -> -spec t_to_string(erl_type()) -> string(). t_to_string(T) -> - t_to_string(T, dict:new()). + t_to_string(T, maps:new()). -spec t_to_string(erl_type(), type_table()) -> string(). @@ -4534,6 +4535,8 @@ from_form({atom, _L, Atom}, _S, _D, L, C) -> {t_atom(Atom), L, C}; from_form({integer, _L, Int}, _S, _D, L, C) -> {t_integer(Int), L, C}; +from_form({char, _L, Char}, _S, _D, L, C) -> + {t_integer(Char), L, C}; from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> @@ -5048,6 +5051,7 @@ check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, list_check_record_fields(Args, S, C); check_record_fields({atom, _L, _}, _S, C) -> C; check_record_fields({integer, _L, _}, _S, C) -> C; +check_record_fields({char, _L, _}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C; check_record_fields({type, _L, tuple, any}, _S, C) -> C; @@ -5149,6 +5153,7 @@ t_form_to_string({var, _L, Name}) -> atom_to_list(Name); t_form_to_string({atom, _L, Atom}) -> io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... ' t_form_to_string({integer, _L, Int}) -> integer_to_list(Int); +t_form_to_string({char, _L, Char}) -> integer_to_list(Char); t_form_to_string({op, _L, _Op, _Arg} = Op) -> case erl_eval:partial_eval(Op) of {integer, _, _} = Int -> t_form_to_string(Int); @@ -5231,7 +5236,7 @@ t_form_to_string({type, _L, union, Args}) -> t_form_to_string({type, _L, Name, []} = T) -> try M = mod, - D0 = dict:new(), + D0 = maps:new(), MR = dict:from_list([{M, D0}]), Site = {type, {M,Name,0}}, V = var_table__new(), @@ -5295,8 +5300,8 @@ is_erl_type(_) -> false. -spec lookup_record(atom(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. -lookup_record(Tag, RecDict) when is_atom(Tag) -> - case dict:find({record, Tag}, RecDict) of +lookup_record(Tag, Table) when is_atom(Tag) -> + case maps:find({record, Tag}, Table) of {ok, {_FileLine, [{_Arity, Fields}]}} -> {ok, Fields}; {ok, {_FileLine, List}} when is_list(List) -> @@ -5310,18 +5315,18 @@ lookup_record(Tag, RecDict) when is_atom(Tag) -> -spec lookup_record(atom(), arity(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. -lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> - case dict:find({record, Tag}, RecDict) of +lookup_record(Tag, Arity, Table) when is_atom(Tag) -> + case maps:find({record, Tag}, Table) of {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields}; {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict); error -> error end. -spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'. -lookup_type(Name, Arity, RecDict) -> - case dict:find({type, Name, Arity}, RecDict) of +lookup_type(Name, Arity, Table) -> + case maps:find({type, Name, Arity}, Table) of error -> - case dict:find({opaque, Name, Arity}, RecDict) of + case maps:find({opaque, Name, Arity}, Table) of error -> error; {ok, Found} -> {opaque, Found} end; @@ -5331,8 +5336,8 @@ lookup_type(Name, Arity, RecDict) -> -spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) -> boolean(). -type_is_defined(TypeOrOpaque, Name, Arity, RecDict) -> - dict:is_key({TypeOrOpaque, Name, Arity}, RecDict). +type_is_defined(TypeOrOpaque, Name, Arity, Table) -> + maps:is_key({TypeOrOpaque, Name, Arity}, Table). cannot_have_opaque(Type, TypeName, TypeNames) -> t_is_none(Type) orelse is_recursive(TypeName, TypeNames). diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml index fc529fba61..0bdd60adfd 100644 --- a/lib/hipe/doc/src/notes.xml +++ b/lib/hipe/doc/src/notes.xml @@ -31,6 +31,51 @@ </header> <p>This document describes the changes made to HiPE.</p> +<section><title>Hipe 3.15.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix flow control bug in hipe compiler that may cause + compile time crash.</p> + <p> + Own Id: OTP-13965 Aux Id: PR-1253 </p> + </item> + <item> + <p> + Fix bug in native compilation of bitstring pattern + matching causing erroneous runtime matching result. The + bug only affects code containing constant-valued segments + whose size is expressed in bits; it is triggered when the + pattern matching against these segments fails (i.e., when + the next clause needs to be tried).</p> + <p> + Own Id: OTP-14005</p> + </item> + <item> + <p> + Workaround in HiPE LLVM backend for a bug in LLVM 3.9. + The bug could cause LLVM-compiled modules to be rejected + during loading with a badarg exception in + hipe_bifs:enter_sdecs/1, but also cause corruption or + segmentation faults i runtime.</p> + <p> + Own Id: OTP-14027 Aux Id: ERL-292, PR-1237 </p> + </item> + <item> + <p> + Fix a bug in HiPE LLVM backend involving incorrect type + tests of atoms sometimes causing incorrect behaviour or + even segfaults.</p> + <p> + Own Id: OTP-14028 Aux Id: PR-1237 </p> + </item> + </list> + </section> + +</section> + <section><title>Hipe 3.15.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl new file mode 100644 index 0000000000..807c4b0d0d --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_num_bif.erl @@ -0,0 +1,217 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : basic_num_bif.erl +%%% Description : Taken from the compiler test suite +%%%------------------------------------------------------------------- +-module(basic_num_bif). + +-export([test/0]). + +%% Tests optimization of the BIFs: +%% abs/1 +%% float/1 +%% float_to_list/1 +%% integer_to_list/1 +%% list_to_float/1 +%% list_to_integer/1 +%% round/1 +%% trunc/1 + +test() -> + Funs = [fun t_abs/0, fun t_float/0, + fun t_float_to_list/0, fun t_integer_to_list/0, + fun t_list_to_float_safe/0, fun t_list_to_float_risky/0, + fun t_list_to_integer/0, fun t_round/0, fun t_trunc/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +t_abs() -> + %% Floats. + 5.5 = abs(5.5), + 0.0 = abs(0.0), + 100.0 = abs(-100.0), + %% Integers. + 5 = abs(5), + 0 = abs(0), + 100 = abs(-100), + %% The largest smallnum. OTP-3190. + X = (1 bsl 27) - 1, + X = abs(X), + X = abs(X-1)+1, + X = abs(X+1)-1, + X = abs(-X), + X = abs(-X-1)-1, + X = abs(-X+1)+1, + %% Bignums. + BigNum = 13984792374983749, + BigNum = abs(BigNum), + BigNum = abs(-BigNum), + ok. + +t_float() -> + 0.0 = float(0), + 2.5 = float(2.5), + 0.0 = float(0.0), + -100.55 = float(-100.55), + 42.0 = float(42), + -100.0 = float(-100), + %% Bignums. + 4294967305.0 = float(4294967305), + -4294967305.0 = float(-4294967305), + %% Extremely big bignums. + Big = list_to_integer(lists:duplicate(2000, $1)), + {'EXIT', {badarg, _}} = (catch float(Big)), + ok. + +%% Tests float_to_list/1. + +t_float_to_list() -> + test_ftl("0.0e+0", 0.0), + test_ftl("2.5e+1", 25.0), + test_ftl("2.5e+0", 2.5), + test_ftl("2.5e-1", 0.25), + test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%% Tests integer_to_list/1. + +t_integer_to_list() -> + "0" = integer_to_list(0), + "42" = integer_to_list(42), + "-42" = integer_to_list(-42), + "-42" = integer_to_list(-42), + "32768" = integer_to_list(32768), + "268435455" = integer_to_list(268435455), + "-268435455" = integer_to_list(-268435455), + "123456932798748738738" = integer_to_list(123456932798748738738), + Big_List = lists:duplicate(2000, $1), + Big = list_to_integer(Big_List), + Big_List = integer_to_list(Big), + ok. + +%% Tests list_to_float/1. + +t_list_to_float_safe() -> + 0.0 = list_to_float("0.0"), + 0.0 = list_to_float("-0.0"), + 0.5 = list_to_float("0.5"), + -0.5 = list_to_float("-0.5"), + 100.0 = list_to_float("1.0e2"), + 127.5 = list_to_float("127.5"), + -199.5 = list_to_float("-199.5"), + ok. + +%% This might crash the emulator... +%% (Known to crash the Unix version of Erlang 4.4.1) + +t_list_to_float_risky() -> + Many_Ones = lists:duplicate(25000, $1), + _ = list_to_float("2."++Many_Ones), + {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), + ok. + +%% Tests list_to_integer/1. + +t_list_to_integer() -> + 0 = list_to_integer("0"), + 0 = list_to_integer("00"), + 0 = list_to_integer("-0"), + 1 = list_to_integer("1"), + -1 = list_to_integer("-1"), + 42 = list_to_integer("42"), + -12 = list_to_integer("-12"), + 32768 = list_to_integer("32768"), + 268435455 = list_to_integer("268435455"), + -268435455 = list_to_integer("-268435455"), + %% Bignums. + 123456932798748738738 = list_to_integer("123456932798748738738"), + _ = list_to_integer(lists:duplicate(2000, $1)), + ok. + +%% Tests round/1. + +t_round() -> + 0 = round(0.0), + 0 = round(0.4), + 1 = round(0.5), + 0 = round(-0.4), + -1 = round(-0.5), + 255 = round(255.3), + 256 = round(255.6), + -1033 = round(-1033.3), + -1034 = round(-1033.6), + %% OTP-3722: + X = (1 bsl 27) - 1, + MX = -X, + MXm1 = -X-1, + MXp1 = -X+1, + F = X + 0.0, + X = round(F), + X = round(F+1)-1, + X = round(F-1)+1, + MX = round(-F), + MXm1 = round(-F-1), + MXp1 = round(-F+1), + X = round(F+0.1), + X = round(F+1+0.1)-1, + X = round(F-1+0.1)+1, + MX = round(-F+0.1), + MXm1 = round(-F-1+0.1), + MXp1 = round(-F+1+0.1), + X = round(F-0.1), + X = round(F+1-0.1)-1, + X = round(F-1-0.1)+1, + MX = round(-F-0.1), + MXm1 = round(-F-1-0.1), + MXp1 = round(-F+1-0.1), + 0.5 = abs(round(F+0.5)-(F+0.5)), + 0.5 = abs(round(F-0.5)-(F-0.5)), + 0.5 = abs(round(-F-0.5)-(-F-0.5)), + 0.5 = abs(round(-F+0.5)-(-F+0.5)), + %% Bignums. + 4294967296 = round(4294967296.1), + 4294967297 = round(4294967296.9), + -4294967296 = -round(4294967296.1), + -4294967297 = -round(4294967296.9), + ok. + +t_trunc() -> + 0 = trunc(0.0), + 5 = trunc(5.3333), + -10 = trunc(-10.978987), + %% The largest smallnum, converted to float (OTP-3722): + X = (1 bsl 27) - 1, + F = X + 0.0, + %% io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", + %% [X, X, binary_to_list(term_to_binary(X)), + %% F, F, binary_to_list(term_to_binary(F)), + %% trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), + X = trunc(F), + X = trunc(F+1)-1, + X = trunc(F-1)+1, + X = -trunc(-F), + X = -trunc(-F-1)-1, + X = -trunc(-F+1)+1, + %% Bignums. + 4294967305 = trunc(4294967305.7), + -4294967305 = trunc(-4294967305.7), + ok. diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl index a5b3924aa8..b9adb660f2 100644 --- a/lib/hipe/test/hipe_SUITE.erl +++ b/lib/hipe/test/hipe_SUITE.erl @@ -16,7 +16,11 @@ %% -module(hipe_SUITE). --compile([export_all]). +-export([all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + app/0, app/1, appup/0, appup/1]). + -include_lib("common_test/include/ct.hrl"). all() -> diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl index 61952e81d7..86083fa02b 100644 --- a/lib/hipe/test/opt_verify_SUITE.erl +++ b/lib/hipe/test/opt_verify_SUITE.erl @@ -1,6 +1,9 @@ -module(opt_verify_SUITE). --compile([export_all]). +-export([all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + call_elim/0, call_elim/1]). all() -> [call_elim]. @@ -23,23 +26,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -call_elim_test_file(Config, FileName, Option) -> - PrivDir = test_server:lookup_config(priv_dir, Config), - TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")), - {ok, TestCase} = compile:file(FileName), - {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]), - {ok, Icode} = file:read_file(TempOut), - ok = file:delete(TempOut), - Icode. - -substring_count(Icode, Substring) -> - substring_count(Icode, Substring, 0). -substring_count(Icode, Substring, N) -> - case string:str(Icode, Substring) of - 0 -> N; - I -> substring_count(lists:nthtail(I, Icode), Substring, N+1) - end. - call_elim() -> [{doc, "Test that the call elimination optimization pass is ok"}]. call_elim(Config) -> @@ -60,3 +46,20 @@ call_elim(Config) -> Icode6 = call_elim_test_file(Config, F3, no_icode_call_elim), 3 = substring_count(binary:bin_to_list(Icode6), "is_key"), ok. + +call_elim_test_file(Config, FileName, Option) -> + PrivDir = test_server:lookup_config(priv_dir, Config), + TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")), + {ok, TestCase} = compile:file(FileName), + {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]), + {ok, Icode} = file:read_file(TempOut), + ok = file:delete(TempOut), + Icode. + +substring_count(Icode, Substring) -> + substring_count(Icode, Substring, 0). +substring_count(Icode, Substring, N) -> + case string:str(Icode, Substring) of + 0 -> N; + I -> substring_count(lists:nthtail(I, Icode), Substring, N+1) + end. diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index f00ff0cf2e..cb4174381a 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.15.2 +HIPE_VSN = 3.15.3 diff --git a/lib/inets/doc/src/http_uri.xml b/lib/inets/doc/src/http_uri.xml index 2ef36d23ee..696b7dfa31 100644 --- a/lib/inets/doc/src/http_uri.xml +++ b/lib/inets/doc/src/http_uri.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2012</year><year>2015</year> + <year>2012</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 705afec022..4217b3c4fb 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -83,7 +83,7 @@ <title>HTTP DATA TYPES</title> <p>Type definitions related to HTTP:</p> - <p><c>method() = head | get | put | post | trace | options | delete</c></p> + <p><c>method() = head | get | put | post | trace | options | delete | patch</c></p> <taglist> <tag><c>request()</c></tag> <item><p>= <c>{url(), headers()}</c></p> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 0c7604ef65..398fc7e5b6 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,66 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.3.3</title> + <section><title>Inets 6.3.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixes a bug that makes the ftp client end up in bad state + if there is a multi line response from the server and the + response number is in the message being sent.</p> + <p> + Own Id: OTP-13960 Aux Id: PR1196 </p> + </item> + <item> + <p> + The ftp client could stop consuming messages when the + multiline response handling was corrected.</p> + <p> + Own Id: OTP-13967</p> + </item> + <item> + <p> + Fix keep-alive https through proxy connections so that + all requests, following the first one, will run as + expected instead of failing.</p> + <p> + Own Id: OTP-14041</p> + </item> + <item> + <p> + Fix bug from commit + fdfda2fab0921d409789174556582db28141448e that could make + listing of group members in mod_auth callbacks fail.</p> + <p> + Own Id: OTP-14082</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Update behavior of httpc:request to match RFC-7231</p> + <p> + Own Id: OTP-13902</p> + </item> + <item> + <p> + Fixed dialyzer warnings as well as some white-space + issues. Thanks to Kostis.</p> + <p> + Own Id: OTP-13982 Aux Id: PR-1207 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.3.3</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 91d87289a2..bd5f6df39e 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -147,6 +147,26 @@ request(Method, Request, HttpOptions, Options) -> request(Method, Request, HttpOptions, Options, default_profile()). request(Method, + {Url, Headers, ContentType, TupleBody}, + HTTPOptions, Options, Profile) + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete)) + andalso (is_atom(Profile) orelse is_pid(Profile)) andalso + is_list(ContentType) andalso is_tuple(TupleBody)-> + case check_body_gen(TupleBody) of + ok -> + do_request(Method, {Url, Headers, ContentType, TupleBody}, HTTPOptions, Options, Profile); + Error -> + Error + end; +request(Method, + {Url, Headers, ContentType, Body}, + HTTPOptions, Options, Profile) + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete)) + andalso (is_atom(Profile) orelse is_pid(Profile)) andalso + is_list(ContentType) andalso (is_list(Body) orelse is_binary(Body)) -> + do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile); + +request(Method, {Url, Headers}, HTTPOptions, Options, Profile) when (Method =:= options) orelse @@ -155,12 +175,6 @@ request(Method, (Method =:= delete) orelse (Method =:= trace) andalso (is_atom(Profile) orelse is_pid(Profile)) -> - ?hcrt("request", [{method, Method}, - {url, Url}, - {headers, Headers}, - {http_options, HTTPOptions}, - {options, Options}, - {profile, Profile}]), case uri_parse(Url, Options) of {error, Reason} -> {error, Reason}; @@ -172,21 +186,9 @@ request(Method, handle_request(Method, Url, ParsedUrl, Headers, [], [], HTTPOptions, Options, Profile) end - end; - -request(Method, - {Url, Headers, ContentType, Body}, - HTTPOptions, Options, Profile) - when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse - (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> - ?hcrt("request", [{method, Method}, - {url, Url}, - {headers, Headers}, - {content_type, ContentType}, - {body, Body}, - {http_options, HTTPOptions}, - {options, Options}, - {profile, Profile}]), + end. + +do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) -> case uri_parse(Url, Options) of {error, Reason} -> {error, Reason}; @@ -196,7 +198,6 @@ request(Method, HTTPOptions, Options, Profile) end. - %%-------------------------------------------------------------------------- %% cancel_request(RequestId) -> ok %% cancel_request(RequestId, Profile) -> ok @@ -209,7 +210,6 @@ cancel_request(RequestId) -> cancel_request(RequestId, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]), httpc_manager:cancel_request(RequestId, profile_name(Profile)). @@ -232,7 +232,6 @@ cancel_request(RequestId, Profile) set_options(Options) -> set_options(Options, default_profile()). set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("set options", [{options, Options}, {profile, Profile}]), case validate_options(Options) of {ok, Opts} -> httpc_manager:set_options(Opts, profile_name(Profile)); @@ -272,7 +271,6 @@ get_options(all = _Options, Profile) -> get_options(Options, Profile) when (is_list(Options) andalso (is_atom(Profile) orelse is_pid(Profile))) -> - ?hcrt("get options", [{options, Options}, {profile, Profile}]), case Options -- get_options() of [] -> try @@ -314,9 +312,6 @@ store_cookies(SetCookieHeaders, Url) -> store_cookies(SetCookieHeaders, Url, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("store cookies", [{set_cookie_headers, SetCookieHeaders}, - {url, Url}, - {profile, Profile}]), try begin %% Since the Address part is not actually used @@ -353,9 +348,6 @@ cookie_header(Url, Opts) when is_list(Opts) -> cookie_header(Url, Opts, Profile) when (is_list(Opts) andalso (is_atom(Profile) orelse is_pid(Profile))) -> - ?hcrt("cookie header", [{url, Url}, - {opts, Opts}, - {profile, Profile}]), try begin httpc_manager:which_cookies(Url, Opts, profile_name(Profile)) @@ -398,7 +390,6 @@ which_sessions() -> which_sessions(default_profile()). which_sessions(Profile) -> - ?hcrt("which sessions", [{profile, Profile}]), try begin httpc_manager:which_sessions(profile_name(Profile)) @@ -419,7 +410,6 @@ info() -> info(default_profile()). info(Profile) -> - ?hcrt("info", [{profile, Profile}]), try begin httpc_manager:info(profile_name(Profile)) @@ -440,7 +430,6 @@ reset_cookies() -> reset_cookies(default_profile()). reset_cookies(Profile) -> - ?hcrt("reset cookies", [{profile, Profile}]), try begin httpc_manager:reset_cookies(profile_name(Profile)) @@ -458,7 +447,6 @@ reset_cookies(Profile) -> %% same behavior as active once for sockets. %%------------------------------------------------------------------------- stream_next(Pid) -> - ?hcrt("stream next", [{handler, Pid}]), httpc_handler:stream_next(Pid). @@ -466,7 +454,6 @@ stream_next(Pid) -> %%% Behaviour callbacks %%%======================================================================== start_standalone(PropList) -> - ?hcrt("start standalone", [{proplist, PropList}]), case proplists:get_value(profile, PropList) of undefined -> {error, no_profile}; @@ -477,14 +464,11 @@ start_standalone(PropList) -> end. start_service(Config) -> - ?hcrt("start service", [{config, Config}]), httpc_profile_sup:start_child(Config). stop_service(Profile) when is_atom(Profile) -> - ?hcrt("stop service", [{profile, Profile}]), httpc_profile_sup:stop_child(Profile); stop_service(Pid) when is_pid(Pid) -> - ?hcrt("stop service", [{pid, Pid}]), case service_info(Pid) of {ok, [{profile, Profile}]} -> stop_service(Profile); @@ -510,7 +494,6 @@ service_info(Pid) -> %%%======================================================================== %%% Internal functions %%%======================================================================== - handle_request(Method, Url, {Scheme, UserInfo, Host, Port, Path, Query}, Headers0, ContentType, Body0, @@ -521,9 +504,6 @@ handle_request(Method, Url, try begin - ?hcrt("begin processing", [{started, Started}, - {new_headers, NewHeaders0}]), - {NewHeaders, Body} = case Body0 of {chunkify, ProcessBody, Acc} @@ -575,16 +555,13 @@ handle_request(Method, Url, {ok, RequestId} -> handle_answer(RequestId, Sync, Options); {error, Reason} -> - ?hcrd("request failed", [{reason, Reason}]), {error, Reason} end end catch error:{noproc, _} -> - ?hcrv("noproc", [{profile, Profile}]), {error, {not_started, Profile}}; throw:Error -> - ?hcrv("throw", [{error, Error}]), Error end. @@ -620,15 +597,10 @@ handle_answer(RequestId, false, _) -> handle_answer(RequestId, true, Options) -> receive {http, {RequestId, saved_to_file}} -> - ?hcrt("received saved-to-file", [{request_id, RequestId}]), {ok, saved_to_file}; {http, {RequestId, {_,_,_} = Result}} -> - ?hcrt("received answer", [{request_id, RequestId}, - {result, Result}]), return_answer(Options, Result); {http, {RequestId, {error, Reason}}} -> - ?hcrt("received error", [{request_id, RequestId}, - {reason, Reason}]), {error, Reason} end. @@ -1257,18 +1229,14 @@ child_name(Pid, [{Name, Pid} | _]) -> child_name(Pid, [_ | Children]) -> child_name(Pid, Children). -%% d(F) -> -%% d(F, []). - -%% d(F, A) -> -%% d(get(dbg), F, A). - -%% d(true, F, A) -> -%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]); -%% d(_, _, _) -> -%% ok. - host_address(Host, false) -> Host; host_address(Host, true) -> string:strip(string:strip(Host, right, $]), left, $[). + +check_body_gen({Fun, _}) when is_function(Fun) -> + ok; +check_body_gen({chunkify, Fun, _}) when is_function(Fun) -> + ok; +check_body_gen(Gen) -> + {error, {bad_body_generator, Gen}}. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 59cb1299e9..c99200777b 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2015. All Rights Reserved. +%% Copyright Ericsson AB 2002-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. @@ -32,7 +32,6 @@ %% Internal Application API -export([ start_link/4, - %% connect_and_send/2, send/2, cancel/2, stream_next/1, @@ -165,14 +164,12 @@ info(Pid) -> %%-------------------------------------------------------------------- %% Request should not be streamed stream(BodyPart, #request{stream = none} = Request, _) -> - ?hcrt("stream - none", []), {false, BodyPart, Request}; %% Stream to caller stream(BodyPart, #request{stream = Self} = Request, Code) when ?IS_STREAMED(Code) andalso ((Self =:= self) orelse (Self =:= {self, once})) -> - ?hcrt("stream - self", [{stream, Self}, {code, Code}]), httpc_response:send(Request#request.from, {Request#request.id, stream, BodyPart}), {true, <<>>, Request}; @@ -182,10 +179,8 @@ stream(BodyPart, #request{stream = Self} = Request, Code) %% We keep this for backward compatibillity... stream(BodyPart, #request{stream = Filename} = Request, Code) when ?IS_STREAMED(Code) andalso is_list(Filename) -> - ?hcrt("stream - filename", [{stream, Filename}, {code, Code}]), case file:open(Filename, [write, raw, append, delayed_write]) of {ok, Fd} -> - ?hcrt("stream - file open ok", [{fd, Fd}]), stream(BodyPart, Request#request{stream = Fd}, 200); {error, Reason} -> exit({stream_to_file_failed, Reason}) @@ -194,7 +189,6 @@ stream(BodyPart, #request{stream = Filename} = Request, Code) %% Stream to file stream(BodyPart, #request{stream = Fd} = Request, Code) when ?IS_STREAMED(Code) -> - ?hcrt("stream to file", [{stream, Fd}, {code, Code}]), case file:write(Fd, BodyPart) of ok -> {true, <<>>, Request}; @@ -203,7 +197,6 @@ stream(BodyPart, #request{stream = Fd} = Request, Code) end; stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed - ?hcrt("stream - ignore", [{request, Request}]), {false, BodyPart, Request}. @@ -257,22 +250,148 @@ init([Parent, Request, Options, ProfileName]) -> %% {stop, Reason, State} (terminate/2 is called) %% Description: Handling call messages %%-------------------------------------------------------------------- -handle_call(#request{address = Addr} = Request, _, +handle_call(Request, From, State) -> + try do_handle_call(Request, From, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + + +%%-------------------------------------------------------------------- +%% Function: handle_cast(Msg, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast(Msg, State) -> + try do_handle_cast(Msg, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + +%%-------------------------------------------------------------------- +%% Function: handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling all non call/cast messages +%%-------------------------------------------------------------------- +handle_info(Info, State) -> + try do_handle_info(Info, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> _ (ignored by gen_server) +%% Description: Shutdown the httpc_handler +%%-------------------------------------------------------------------- + +%% Init error there is no socket to be closed. +terminate(normal, + #state{request = Request, + session = {send_failed, _} = Reason} = State) -> + maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + ok; + +terminate(normal, + #state{request = Request, + session = {connect_failed, _} = Reason} = State) -> + maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + ok; + +terminate(normal, #state{session = undefined}) -> + ok; + +%% Init error sending, no session information has been setup but +%% there is a socket that needs closing. +terminate(normal, + #state{session = #session{id = undefined} = Session}) -> + close_socket(Session); + +%% Socket closed remotely +terminate(normal, + #state{session = #session{socket = {remote_close, Socket}, + socket_type = SocketType, + id = Id}, + profile_name = ProfileName, + request = Request, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + %% Cancel timers + cancel_timers(Timers), + + %% Maybe deliver answers to requests + deliver_answer(Request), + + %% And, just in case, close our side (**really** overkill) + http_transport:close(SocketType, Socket); + +terminate(_Reason, #state{session = #session{id = Id, + socket = Socket, + socket_type = SocketType}, + request = undefined, + profile_name = ProfileName, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> + + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + cancel_timer(Timers#timers.queue_timer, timeout_queue), + http_transport:close(SocketType, Socket); + +terminate(_Reason, #state{request = undefined}) -> + ok; + +terminate(Reason, #state{request = Request} = State) -> + NewState = maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + terminate(Reason, NewState#state{request = undefined}). + +%%-------------------------------------------------------------------- +%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} +%% Purpose: Convert process state when code is changed +%%-------------------------------------------------------------------- + +code_change(_, State, _) -> + {ok, State}. + +%%%-------------------------------------------------------------------- +%%% Internal functions +%%%-------------------------------------------------------------------- +do_handle_call(#request{address = Addr} = Request, _, #state{status = Status, session = #session{type = pipeline} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, profile_name = ProfileName} = State0) when Status =/= undefined -> - - ?hcrv("new request on a pipeline session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}, - {timers, Timers}]), - Address = handle_proxy(Addr, Proxy), - case httpc_request:send(Address, Session, Request) of ok -> @@ -287,9 +406,8 @@ handle_call(#request{address = Addr} = Request, _, case State0#state.request of #request{} = OldRequest -> %% Old request not yet finished - ?hcrd("old request still not finished", []), %% Make sure to use the new value of timers in state - NewTimers = State1#state.timers, + NewTimers = State1#state.timers, NewPipeline = queue:in(Request, State1#state.pipeline), NewSession = Session#session{queue_length = @@ -297,7 +415,6 @@ handle_call(#request{address = Addr} = Request, _, queue:len(NewPipeline) + 1, client_close = ClientClose}, insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), {reply, ok, State1#state{ request = OldRequest, pipeline = NewPipeline, @@ -306,7 +423,6 @@ handle_call(#request{address = Addr} = Request, _, undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. - ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, timeout_queue), NewSession = @@ -314,18 +430,16 @@ handle_call(#request{address = Addr} = Request, _, client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), NewTimers = Timers#timers{queue_timer = undefined}, - ?hcrd("session created", []), State = init_wait_for_response_state(Request, State1#state{session = NewSession, timers = NewTimers}), {reply, ok, State} end; {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), NewPipeline = queue:in(Request, State0#state.pipeline), - {stop, shutdown, {pipeline_failed, Reason}, State0#state{pipeline = NewPipeline}} + {stop, {shutdown, {pipeline_failed, Reason}}, State0#state{pipeline = NewPipeline}} end; -handle_call(#request{address = Addr} = Request, _, +do_handle_call(#request{address = Addr} = Request, _, #state{status = Status, session = #session{type = keep_alive} = Session, timers = Timers, @@ -333,17 +447,11 @@ handle_call(#request{address = Addr} = Request, _, profile_name = ProfileName} = State0) when Status =/= undefined -> - ?hcrv("new request on a keep-alive session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}]), - ClientClose = httpc_request:is_client_closing(Request#request.headers), case State0#state.request of #request{} -> %% Old request not yet finished %% Make sure to use the new value of timers in state - ?hcrd("old request still not finished", []), NewKeepAlive = queue:in(Request, State0#state.keep_alive), NewSession = Session#session{queue_length = @@ -351,13 +459,11 @@ handle_call(#request{address = Addr} = Request, _, queue:len(NewKeepAlive) + 1, client_close = ClientClose}, insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), {reply, ok, State0#state{keep_alive = NewKeepAlive, session = NewSession}}; undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. - ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, timeout_queue), NewTimers = Timers#timers{queue_timer = undefined}, @@ -365,8 +471,6 @@ handle_call(#request{address = Addr} = Request, _, Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, Request) of ok -> - ?hcrd("request sent", []), - %% Activate the request time out for the new request State2 = activate_request_timeout(State1#state{request = Request}), @@ -377,22 +481,13 @@ handle_call(#request{address = Addr} = Request, _, State = init_wait_for_response_state(Request, State2#state{session = NewSession}), {reply, ok, State}; {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {stop, shutdown, {keepalive_failed, Reason}, State1} + {stop, {shutdown, {keepalive_failed, Reason}}, State1} end end; - -handle_call(info, _, State) -> +do_handle_call(info, _, State) -> Info = handler_info(State), {reply, Info, State}. -%%-------------------------------------------------------------------- -%% Function: handle_cast(Msg, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%% Description: Handling cast messages -%%-------------------------------------------------------------------- - %% When the request in process has been canceled the handler process is %% stopped and the pipelined requests will be reissued or remaining %% requests will be sent on a new connection. This is is @@ -405,145 +500,102 @@ handle_call(info, _, State) -> %% handle_keep_alive_queue/2 on the other hand will just skip the %% request as if it was never issued as in this case the request will %% not have been sent. -handle_cast({cancel, RequestId}, +do_handle_cast({cancel, RequestId}, #state{request = #request{id = RequestId} = Request, - profile_name = ProfileName, canceled = Canceled} = State) -> - ?hcrv("cancel current request", [{request_id, RequestId}, - {profile, ProfileName}, - {canceled, Canceled}]), {stop, normal, State#state{canceled = [RequestId | Canceled], request = Request#request{from = answer_sent}}}; -handle_cast({cancel, RequestId}, - #state{profile_name = ProfileName, - request = #request{id = CurrId}, - canceled = Canceled} = State) -> - ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, CurrId}, - {profile, ProfileName}, - {canceled, Canceled}]), +do_handle_cast({cancel, RequestId}, + #state{request = #request{}, + canceled = Canceled} = State) -> {noreply, State#state{canceled = [RequestId | Canceled]}}; -handle_cast({cancel, RequestId}, - #state{profile_name = ProfileName, - request = undefined, - canceled = Canceled} = State) -> - ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, undefined}, - {profile, ProfileName}, - {canceled, Canceled}]), +do_handle_cast({cancel, _}, + #state{request = undefined} = State) -> {noreply, State}; - -handle_cast(stream_next, #state{session = Session} = State) -> +do_handle_cast(stream_next, #state{session = Session} = State) -> activate_once(Session), %% Inactivate the #state.once here because we don't want %% next_body_chunk/1 to activate the socket twice. {noreply, State#state{once = inactive}}. - -%%-------------------------------------------------------------------- -%% Function: handle_info(Info, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%% Description: Handling all non call/cast messages -%%-------------------------------------------------------------------- -handle_info({Proto, _Socket, Data}, +do_handle_info({Proto, _Socket, Data}, #state{mfa = {Module, Function, Args}, - request = #request{method = Method, - stream = Stream} = Request, + request = #request{method = Method} = Request, session = Session, status_line = StatusLine} = State) when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> - ?hcri("received data", [{proto, Proto}, - {module, Module}, - {function, Function}, - {method, Method}, - {stream, Stream}, - {session, Session}, - {status_line, StatusLine}]), - - FinalResult = - try Module:Function([Data | Args]) of - {ok, Result} -> - ?hcrd("data processed - ok", []), - handle_http_msg(Result, State); - {_, whole_body, _} when Method =:= head -> - ?hcrd("data processed - whole body", []), - handle_response(State#state{body = <<>>}); - {Module, whole_body, [Body, Length]} -> - ?hcrd("data processed - whole body", [{length, Length}]), - {_, Code, _} = StatusLine, - {Streamed, NewBody, NewRequest} = stream(Body, Request, Code), - %% When we stream we will not keep the already - %% streamed data, that would be a waste of memory. - NewLength = - case Streamed of - false -> - Length; - true -> - Length - size(Body) - end, - - NewState = next_body_chunk(State, Code), - NewMFA = {Module, whole_body, [NewBody, NewLength]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - {Module, decode_size, - [TotalChunk, HexList, + try Module:Function([Data | Args]) of + {ok, Result} -> + handle_http_msg(Result, State); + {_, whole_body, _} when Method =:= head -> + handle_response(State#state{body = <<>>}); + {Module, whole_body, [Body, Length]} -> + {_, Code, _} = StatusLine, + {Streamed, NewBody, NewRequest} = stream(Body, Request, Code), + %% When we stream we will not keep the already + %% streamed data, that would be a waste of memory. + NewLength = + case Streamed of + false -> + Length; + true -> + Length - size(Body) + end, + + NewState = next_body_chunk(State, Code), + NewMFA = {Module, whole_body, [NewBody, NewLength]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_size, + [TotalChunk, HexList, AccHeaderSize, {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} - when BodySoFar =/= <<>> -> - ?hcrd("data processed - decode_size", []), - %% The response body is chunk-encoded. Steal decoded - %% chunks as much as possible to stream. - {_, Code, _} = StatusLine, - {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code), - NewState = next_body_chunk(State, Code), - NewMFA = {Module, decode_size, - [TotalChunk, HexList, + when BodySoFar =/= <<>> -> + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + {_, Code, _} = StatusLine, + {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code), + NewState = next_body_chunk(State, Code), + NewMFA = {Module, decode_size, + [TotalChunk, HexList, AccHeaderSize, {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_data, + [ChunkSize, TotalChunk, + {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} + when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), + <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, + StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, + NewChunkSize = ChunkSize - ChunkSizeToSteal, + {_, Code, _} = StatusLine, + + {_, NewBody, NewRequest} = stream(StolenBody, Request, Code), + NewState = next_body_chunk(State, Code), + NewMFA = {Module, decode_data, + [NewChunkSize, NewTotalChunk, + {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, {noreply, NewState#state{mfa = NewMFA, request = NewRequest}}; - {Module, decode_data, - [ChunkSize, TotalChunk, - {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} - when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> - ?hcrd("data processed - decode_data", []), - %% The response body is chunk-encoded. Steal decoded - %% chunks as much as possible to stream. - ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), - <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, - StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, - NewChunkSize = ChunkSize - ChunkSizeToSteal, - {_, Code, _} = StatusLine, - - {_, NewBody, NewRequest} = stream(StolenBody, Request, Code), - NewState = next_body_chunk(State, Code), - NewMFA = {Module, decode_data, - [NewChunkSize, NewTotalChunk, - {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - NewMFA -> - ?hcrd("data processed - new mfa", []), - activate_once(Session), - {noreply, State#state{mfa = NewMFA}} - catch - _:_Reason -> - ?hcrd("data processing exit", [{exit, _Reason}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState} - end, - ?hcri("data processed", [{final_result, FinalResult}]), - FinalResult; - + NewMFA -> + activate_once(Session), + {noreply, State#state{mfa = NewMFA}} + catch + _:Reason -> + ClientReason = {could_not_parse_as_http, Data}, + ClientErrMsg = httpc_response:error(Request, ClientReason), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, {shutdown, Reason}, NewState} + end; -handle_info({Proto, Socket, Data}, +do_handle_info({Proto, Socket, Data}, #state{mfa = MFA, request = Request, session = Session, @@ -568,200 +620,107 @@ handle_info({Proto, Socket, Data}, {noreply, State}; - %% The Server may close the connection to indicate that the %% whole body is now sent instead of sending an length %% indicator. -handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> +do_handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> handle_response(State#state{body = hd(Args)}); -handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> +do_handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> handle_response(State#state{body = hd(Args)}); %%% Server closes idle pipeline -handle_info({tcp_closed, _}, State = #state{request = undefined}) -> +do_handle_info({tcp_closed, _}, State = #state{request = undefined}) -> {stop, normal, State}; -handle_info({ssl_closed, _}, State = #state{request = undefined}) -> +do_handle_info({ssl_closed, _}, State = #state{request = undefined}) -> {stop, normal, State}; %%% Error cases -handle_info({tcp_closed, _}, #state{session = Session0} = State) -> +do_handle_info({tcp_closed, _}, #state{session = Session0} = State) -> Socket = Session0#session.socket, Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; -handle_info({ssl_closed, _}, #state{session = Session0} = State) -> +do_handle_info({ssl_closed, _}, #state{session = Session0} = State) -> Socket = Session0#session.socket, Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; -handle_info({tcp_error, _, _} = Reason, State) -> +do_handle_info({tcp_error, _, _} = Reason, State) -> {stop, Reason, State}; -handle_info({ssl_error, _, _} = Reason, State) -> +do_handle_info({ssl_error, _, _} = Reason, State) -> {stop, Reason, State}; %% Timeouts %% Internally, to a request handling process, a request timeout is %% seen as a canceled request. -handle_info({timeout, RequestId}, +do_handle_info({timeout, RequestId}, #state{request = #request{id = RequestId} = Request, canceled = Canceled, profile_name = ProfileName} = State) -> - ?hcri("timeout of current request", [{id, RequestId}]), httpc_response:send(Request#request.from, httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent - now terminate", []), {stop, normal, State#state{request = Request#request{from = answer_sent}, canceled = [RequestId | Canceled]}}; -handle_info({timeout, RequestId}, +do_handle_info({timeout, RequestId}, #state{canceled = Canceled, profile_name = ProfileName} = State) -> - ?hcri("timeout", [{id, RequestId}]), Filter = fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> - ?hcrv("found request", [{id, Id}, {from, From}]), %% Notify the owner httpc_response:send(From, httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent", []), [Request#request{from = answer_sent}]; (_) -> true end, case State#state.status of pipeline -> - ?hcrd("pipeline", []), Pipeline = queue:filter(Filter, State#state.pipeline), {noreply, State#state{canceled = [RequestId | Canceled], pipeline = Pipeline}}; keep_alive -> - ?hcrd("keep_alive", []), KeepAlive = queue:filter(Filter, State#state.keep_alive), {noreply, State#state{canceled = [RequestId | Canceled], keep_alive = KeepAlive}} end; -handle_info(timeout_queue, State = #state{request = undefined}) -> +do_handle_info(timeout_queue, State = #state{request = undefined}) -> {stop, normal, State}; %% Timing was such as the queue_timeout was not canceled! -handle_info(timeout_queue, #state{timers = Timers} = State) -> +do_handle_info(timeout_queue, #state{timers = Timers} = State) -> {noreply, State#state{timers = Timers#timers{queue_timer = undefined}}}; %% Setting up the connection to the server somehow failed. -handle_info({init_error, Tag, ClientErrMsg}, +do_handle_info({init_error, Reason, ClientErrMsg}, State = #state{request = Request}) -> - ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]), NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - + {stop, {shutdown, Reason}, NewState}; %%% httpc_manager process dies. -handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> +do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> {stop, normal, State}; %%Try to finish the current request anyway, %% there is a fairly high probability that it can be done successfully. %% Then close the connection, hopefully a new manager is started that %% can retry requests in the pipeline. -handle_info({'EXIT', _, _}, State) -> +do_handle_info({'EXIT', _, _}, State) -> {noreply, State#state{status = close}}. -%%-------------------------------------------------------------------- -%% Function: terminate(Reason, State) -> _ (ignored by gen_server) -%% Description: Shutdown the httpc_handler -%%-------------------------------------------------------------------- - -%% Init error there is no socket to be closed. -terminate(normal, - #state{request = Request, - session = {send_failed, AReason} = Reason} = State) -> - ?hcrd("terminate", [{send_reason, AReason}, {request, Request}]), - maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - ok; - -terminate(normal, - #state{request = Request, - session = {connect_failed, AReason} = Reason} = State) -> - ?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]), - maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - ok; - -terminate(normal, #state{session = undefined}) -> - ok; - -%% Init error sending, no session information has been setup but -%% there is a socket that needs closing. -terminate(normal, - #state{session = #session{id = undefined} = Session}) -> - close_socket(Session); - -%% Socket closed remotely -terminate(normal, - #state{session = #session{socket = {remote_close, Socket}, - socket_type = SocketType, - id = Id}, - profile_name = ProfileName, - request = Request, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> - ?hcrt("terminate(normal) - remote close", - [{id, Id}, {profile, ProfileName}]), - - %% Clobber session - (catch httpc_manager:delete_session(Id, ProfileName)), - - maybe_retry_queue(Pipeline, State), - maybe_retry_queue(KeepAlive, State), - - %% Cancel timers - cancel_timers(Timers), - - %% Maybe deliver answers to requests - deliver_answer(Request), - - %% And, just in case, close our side (**really** overkill) - http_transport:close(SocketType, Socket); - -terminate(Reason, #state{session = #session{id = Id, - socket = Socket, - socket_type = SocketType}, - request = undefined, - profile_name = ProfileName, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> - ?hcrt("terminate", - [{id, Id}, {profile, ProfileName}, {reason, Reason}]), - - %% Clobber session - (catch httpc_manager:delete_session(Id, ProfileName)), - - maybe_retry_queue(Pipeline, State), - maybe_retry_queue(KeepAlive, State), - - cancel_timer(Timers#timers.queue_timer, timeout_queue), - http_transport:close(SocketType, Socket); +call(Msg, Pid) -> + call(Msg, Pid, infinity). -terminate(Reason, #state{request = undefined}) -> - ?hcrt("terminate", [{reason, Reason}]), - ok; +call(Msg, Pid, Timeout) -> + gen_server:call(Pid, Msg, Timeout). -terminate(Reason, #state{request = Request} = State) -> - ?hcrd("terminate", [{reason, Reason}, {request, Request}]), - NewState = maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - terminate(Reason, NewState#state{request = undefined}). +cast(Msg, Pid) -> + gen_server:cast(Pid, Msg). maybe_retry_queue(Q, State) -> case queue:is_empty(Q) of @@ -776,45 +735,13 @@ maybe_send_answer(#request{from = answer_sent}, _Reason, State) -> maybe_send_answer(Request, Answer, State) -> answer_request(Request, Answer, State). -deliver_answer(#request{id = Id, from = From} = Request) +deliver_answer(#request{from = From} = Request) when is_pid(From) -> Response = httpc_response:error(Request, socket_closed_remotely), - ?hcrd("deliver answer", [{id, Id}, {from, From}, {response, Response}]), httpc_response:send(From, Response); -deliver_answer(Request) -> - ?hcrd("skip deliver answer", [{request, Request}]), +deliver_answer(_Request) -> ok. - -%%-------------------------------------------------------------------- -%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} -%% Purpose: Convert process state when code is changed -%%-------------------------------------------------------------------- - -code_change(_, State, _) -> - {ok, State}. - - -%% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}) -> -%% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}. - -%% old_http_options({http_options, _, TimeOut, AutoRedirect, -%% SslOpts, Auth, Relaxed}) -> -%% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}. - -%% new_queue(Queue, Fun) -> -%% List = queue:to_list(Queue), -%% NewList = -%% lists:map(fun(Request) -> -%% Settings = -%% Fun(Request#request.settings), -%% Request#request{settings = Settings} -%% end, List), -%% queue:from_list(NewList). - - %%%-------------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -872,26 +799,21 @@ connect(SocketType, ToAddress, connect_and_send_first_request(Address, Request, #state{options = Options} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, - ?hcri("connect", - [{address, Address}, {request, Request}, {options, Options}]), case connect(SocketType, Address, Options, ConnTimeout) of {ok, Socket} -> ClientClose = - httpc_request:is_client_closing( - Request#request.headers), + httpc_request:is_client_closing( + Request#request.headers), SessionType = httpc_manager:session_type(Options), SocketType = socket_type(Request), Session = #session{id = {Request#request.address, self()}, scheme = Request#request.scheme, socket = Socket, - socket_type = SocketType, - client_close = ClientClose, - type = SessionType}, - ?hcri("connected - now send first request", [{socket, Socket}]), - + socket_type = SocketType, + client_close = ClientClose, + type = SessionType}, case httpc_request:send(Address, Session, Request) of ok -> - ?hcri("first request sent", []), TmpState = State#state{request = Request, session = Session, mfa = init_mfa(Request, State), @@ -949,12 +871,6 @@ handler_info(#state{request = Request, options = _Options, timers = _Timers} = _State) -> - ?hcrt("handler info", [{request, Request}, - {session, Session}, - {pipeline, Pipeline}, - {keep_alive, KeepAlive}, - {status, Status}]), - %% Info about the current request RequestInfo = case Request of @@ -965,8 +881,6 @@ handler_info(#state{request = Request, [{id, Id}, {started, ReqStarted}] end, - ?hcrt("handler info", [{request_info, RequestInfo}]), - %% Info about the current session/socket SessionType = Session#session.type, QueueLen = case SessionType of @@ -979,22 +893,12 @@ handler_info(#state{request = Request, Socket = Session#session.socket, SocketType = Session#session.socket_type, - ?hcrt("handler info", [{session_type, SessionType}, - {queue_length, QueueLen}, - {scheme, Scheme}, - {socket, Socket}]), - SocketOpts = http_transport:getopts(SocketType, Socket), SocketStats = http_transport:getstat(SocketType, Socket), Remote = http_transport:peername(SocketType, Socket), Local = http_transport:sockname(SocketType, Socket), - ?hcrt("handler info", [{remote, Remote}, - {local, Local}, - {socket_opts, SocketOpts}, - {socket_stats, SocketStats}]), - SocketInfo = [{remote, Remote}, {local, Local}, {socket_opts, SocketOpts}, @@ -1014,7 +918,6 @@ handler_info(#state{request = Request, handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, State = #state{request = Request}) -> - ?hcrt("handle_http_msg", [{headers, Headers}]), case Headers#http_response_h.'content-type' of "multipart/byteranges" ++ _Param -> exit({not_yet_implemented, multypart_byteranges}); @@ -1028,15 +931,12 @@ handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, end; handle_http_msg({ChunkedHeaders, Body}, #state{status_line = {_, Code, _}, headers = Headers} = State) -> - ?hcrt("handle_http_msg", - [{chunked_headers, ChunkedHeaders}, {headers, Headers}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), {_, NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{headers = NewHeaders, body = NewBody, request = NewRequest}); handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) -> - ?hcrt("handle_http_msg", [{code, Code}]), {_, NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{body = NewBody, request = NewRequest}). @@ -1051,41 +951,28 @@ handle_http_body(_, #state{status = {ssl_tunnel, Request}, {stop, normal, NewState}; handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) -> - ?hcrt("handle_http_body - 304", []), handle_response(State#state{body = <<>>}); handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) -> - ?hcrt("handle_http_body - 204", []), handle_response(State#state{body = <<>>}); handle_http_body(<<>>, #state{request = #request{method = head}} = State) -> - ?hcrt("handle_http_body - head", []), handle_response(State#state{body = <<>>}); handle_http_body(Body, #state{headers = Headers, max_body_size = MaxBodySize, status_line = {_,Code, _}, request = Request} = State) -> - ?hcrt("handle_http_body", - [{max_body_size, MaxBodySize}, {headers, Headers}, {code, Code}]), TransferEnc = Headers#http_response_h.'transfer-encoding', case case_insensitive_header(TransferEnc) of "chunked" -> - ?hcrt("handle_http_body - chunked", []), try http_chunk:decode(Body, State#state.max_body_size, State#state.max_header_size) of {Module, Function, Args} -> - ?hcrt("handle_http_body - new mfa", - [{module, Module}, - {function, Function}, - {args, Args}]), NewState = next_body_chunk(State, Code), {noreply, NewState#state{mfa = {Module, Function, Args}}}; {ok, {ChunkedHeaders, NewBody}} -> - ?hcrt("handle_http_body - new body", - [{chunked_headers, ChunkedHeaders}, - {new_body, NewBody}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), case Body of @@ -1107,7 +994,6 @@ handle_http_body(Body, #state{headers = Headers, {stop, normal, NewState} end; Enc when Enc =:= "identity"; Enc =:= undefined -> - ?hcrt("handle_http_body - identity", []), Length = list_to_integer(Headers#http_response_h.'content-length'), case ((Length =< MaxBodySize) orelse (MaxBodySize =:= nolimit)) of @@ -1131,7 +1017,6 @@ handle_http_body(Body, #state{headers = Headers, {stop, normal, NewState} end; Encoding when is_list(Encoding) -> - ?hcrt("handle_http_body - other", [{encoding, Encoding}]), NewState = answer_request(Request, httpc_response:error(Request, unknown_encoding), @@ -1152,18 +1037,10 @@ handle_response(#state{request = Request, options = Options, profile_name = ProfileName} = State) when Status =/= new -> - - ?hcrd("handle response", [{profile, ProfileName}, - {status, Status}, - {request, Request}, - {session, Session}, - {status_line, StatusLine}]), - handle_cookies(Headers, Request, Options, ProfileName), case httpc_response:result({StatusLine, Headers, Body}, Request) of %% 100-continue continue -> - ?hcrd("handle response - continue", []), %% Send request body {_, RequestBody} = Request#request.content, send_raw(Session, RequestBody), @@ -1180,7 +1057,6 @@ handle_response(#state{request = Request, %% Ignore unexpected 100-continue response and receive the %% actual response that the server will send right away. {ignore, Data} -> - ?hcrd("handle response - ignore", [{data, Data}]), Relaxed = (Request#request.settings)#http_options.relaxed, MFA = {httpc_response, parse, [State#state.max_header_size, Relaxed]}, @@ -1194,23 +1070,17 @@ handle_response(#state{request = Request, %% obsolete and the manager will create a new request %% with the same id as the current. {redirect, NewRequest, Data} -> - ?hcrt("handle response - redirect", - [{new_request, NewRequest}, {data, Data}]), ok = httpc_manager:redirect_request(NewRequest, ProfileName), handle_queue(State#state{request = undefined}, Data); {retry, TimeNewRequest, Data} -> - ?hcrt("handle response - retry", - [{time_new_request, TimeNewRequest}, {data, Data}]), ok = httpc_manager:retry_request(TimeNewRequest, ProfileName), handle_queue(State#state{request = undefined}, Data); {ok, Msg, Data} -> - ?hcrd("handle response - ok", []), stream_remaining_body(Body, Request, StatusLine), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), handle_queue(NewState, Data); {stop, Msg} -> - ?hcrd("handle response - stop", [{msg, Msg}]), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), {stop, normal, NewState} @@ -1245,28 +1115,19 @@ handle_pipeline(#state{status = pipeline, profile_name = ProfileName, options = #options{pipeline_timeout = TimeOut}} = State, Data) -> - - ?hcrd("handle pipeline", [{profile, ProfileName}, - {session, Session}, - {timeout, TimeOut}]), - case queue:out(State#state.pipeline) of {empty, _} -> - ?hcrd("pipeline queue empty", []), handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, Pipeline} -> - ?hcrd("pipeline queue non-empty", []), case lists:member(NextRequest#request.id, State#state.canceled) of true -> - ?hcrv("next request had been cancelled", []), %% See comment for handle_cast({cancel, RequestId}) {stop, normal, State#state{request = NextRequest#request{from = answer_sent}, pipeline = Pipeline}}; false -> - ?hcrv("next request", [{request, NextRequest}]), NewSession = Session#session{queue_length = %% Queue + current @@ -1283,25 +1144,16 @@ handle_keep_alive_queue(#state{status = keep_alive, options = #options{keep_alive_timeout = TimeOut, proxy = Proxy}} = State, Data) -> - - ?hcrd("handle keep_alive", [{profile, ProfileName}, - {session, Session}, - {timeout, TimeOut}]), - case queue:out(State#state.keep_alive) of {empty, _} -> - ?hcrd("keep_alive queue empty", []), handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, KeepAlive} -> - ?hcrd("keep_alive queue non-empty", []), case lists:member(NextRequest#request.id, State#state.canceled) of true -> - ?hcrv("next request has already been canceled", []), handle_keep_alive_queue( State#state{keep_alive = KeepAlive}, Data); false -> - ?hcrv("next request", [{request, NextRequest}]), #request{address = Addr} = NextRequest, Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, NextRequest) of @@ -1314,7 +1166,6 @@ handle_keep_alive_queue(#state{status = keep_alive, end end end. - handle_empty_queue(Session, ProfileName, TimeOut, State) -> %% The server may choose too terminate an idle pipline| keep_alive session %% in this case we want to receive the close message @@ -1350,7 +1201,6 @@ init_wait_for_response_state(Request, State) -> status_line = undefined, headers = undefined, body = undefined}. - gather_data(<<>>, Session, State) -> activate_once(Session), {noreply, State}; @@ -1381,10 +1231,6 @@ activate_request_timeout( State; _ -> ReqId = Request#request.id, - ?hcrt("activate request timer", - [{request_id, ReqId}, - {time_consumed, t() - Request#request.started}, - {timeout, Timeout}]), Msg = {timeout, ReqId}, Ref = erlang:send_after(Timeout, self(), Msg), Request2 = Request#request{timer = Ref}, @@ -1427,10 +1273,6 @@ try_to_enable_pipeline_or_keep_alive( status_line = {Version, _, _}, headers = Headers, profile_name = ProfileName} = State) -> - ?hcrd("try to enable pipeline or keep-alive", - [{version, Version}, - {headers, Headers}, - {session, Session}]), case is_keep_alive_enabled_server(Version, Headers) andalso is_keep_alive_connection(Headers, Session) of true -> @@ -1455,7 +1297,6 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg, #state{session = Session, timers = Timers, profile_name = ProfileName} = State) -> - ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), RequestTimers = Timers#timers.request_timers, TimerRef = @@ -1602,42 +1443,32 @@ socket_type(#request{scheme = http}) -> ip_comm; socket_type(#request{scheme = https, settings = Settings}) -> Settings#http_options.ssl. -%% socket_type(http) -> -%% ip_comm; -%% socket_type(https) -> -%% {ssl1, []}. %% Dummy value ok for ex setopts that does not use this value start_stream({_Version, _Code, _ReasonPhrase}, _Headers, #request{stream = none} = Request) -> - ?hcrt("start stream - none", []), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = self} = Request) when ?IS_STREAMED(Code) -> - ?hcrt("start stream - self", [{code, Code}]), Msg = httpc_response:stream_start(Headers, Request, ignore), httpc_response:send(Request#request.from, Msg), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = {self, once}} = Request) when ?IS_STREAMED(Code) -> - ?hcrt("start stream - self:once", [{code, Code}]), Msg = httpc_response:stream_start(Headers, Request, self()), httpc_response:send(Request#request.from, Msg), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, _Headers, #request{stream = Filename} = Request) when ?IS_STREAMED(Code) andalso is_list(Filename) -> - ?hcrt("start stream", [{code, Code}, {filename, Filename}]), case file:open(Filename, [write, raw, append, delayed_write]) of {ok, Fd} -> - ?hcri("start stream - file open ok", [{fd, Fd}]), {ok, Request#request{stream = Fd}}; {error, Reason} -> exit({stream_to_file_failed, Reason}) end; start_stream(_StatusLine, _Headers, Request) -> - ?hcrt("start stream - no op", []), {ok, Request}. stream_remaining_body(<<>>, _, _) -> @@ -1648,16 +1479,12 @@ stream_remaining_body(Body, Request, {_, Code, _}) -> %% Note the end stream message is handled by httpc_response and will %% be sent by answer_request end_stream(_, #request{stream = none}) -> - ?hcrt("end stream - none", []), ok; end_stream(_, #request{stream = self}) -> - ?hcrt("end stream - self", []), ok; end_stream(_, #request{stream = {self, once}}) -> - ?hcrt("end stream - self:once", []), ok; end_stream({_,200,_}, #request{stream = Fd}) -> - ?hcrt("end stream - 200", [{stream, Fd}]), case file:close(Fd) of ok -> ok; @@ -1665,15 +1492,13 @@ end_stream({_,200,_}, #request{stream = Fd}) -> file:close(Fd) end; end_stream({_,206,_}, #request{stream = Fd}) -> - ?hcrt("end stream - 206", [{stream, Fd}]), case file:close(Fd) of ok -> ok; {error, enospc} -> % Could be due to delayed_write file:close(Fd) end; -end_stream(SL, R) -> - ?hcrt("end stream", [{status_line, SL}, {request, R}]), +end_stream(_, _) -> ok. @@ -1702,11 +1527,8 @@ handle_verbose(trace) -> handle_verbose(_) -> ok. - - send_raw(#session{socket = Socket, socket_type = SocketType}, {ProcessBody, Acc}) when is_function(ProcessBody, 1) -> - ?hcrt("send raw", [{acc, Acc}]), send_raw(SocketType, Socket, ProcessBody, Acc); send_raw(#session{socket = Socket, socket_type = SocketType}, Body) -> http_transport:send(SocketType, Socket, Body). @@ -1717,7 +1539,6 @@ send_raw(SocketType, Socket, ProcessBody, Acc) -> ok; {ok, Data, NewAcc} -> DataBin = iolist_to_binary(Data), - ?hcrd("send", [{data, DataBin}]), case http_transport:send(SocketType, Socket, DataBin) of ok -> send_raw(SocketType, Socket, ProcessBody, NewAcc); @@ -1749,14 +1570,16 @@ tls_tunnel(Address, Request, #state{session = #session{socket = Socket, tls_tunnel_request(#request{headers = Headers, settings = Options, + id = RequestId, + from = From, address = {Host, Port}= Adress, ipv6_host_with_brackets = IPV6}) -> URI = Host ++":" ++ integer_to_list(Port), #request{ - id = make_ref(), - from = self(), + id = RequestId, + from = From, scheme = http, %% Use tcp-first and then upgrade! address = Adress, path = URI, @@ -1881,16 +1704,3 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> end. -%% --------------------------------------------------------------------- - -call(Msg, Pid) -> - call(Msg, Pid, infinity). - -call(Msg, Pid, Timeout) -> - gen_server:call(Pid, Msg, Timeout). - -cast(Msg, Pid) -> - gen_server:cast(Pid, Msg). - -t() -> - http_util:timestamp(). diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index d8bdac24e3..0fd5faa466 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -363,7 +363,7 @@ redirect(Response = {StatusLine, Headers, Body}, Request) -> %% Automatic redirection {ok, {Scheme, _, Host, Port, Path, Query}} -> NewHeaders = - (Request#request.headers)#http_request_h{host = Host}, + (Request#request.headers)#http_request_h{host = Host++":"++integer_to_list(Port)}, NewRequest = Request#request{redircount = Request#request.redircount+1, diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index 991417cb36..ca1dad07cd 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2015. All Rights Reserved. +%% Copyright Ericsson AB 2002-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. diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index 1374b7e85e..effa273e92 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. diff --git a/lib/inets/src/http_server/mod_auth_server.erl b/lib/inets/src/http_server/mod_auth_server.erl index 93d8145821..90d9ee34b1 100644 --- a/lib/inets/src/http_server/mod_auth_server.erl +++ b/lib/inets/src/http_server/mod_auth_server.erl @@ -128,7 +128,7 @@ list_group_members(Addr, Port, Dir, Group, Password) -> list_group_members(Addr, Port, ?DEFAULT_PROFILE, Dir, Group, Password). list_group_members(Addr, Port, Profile, Dir, Group, Password) -> Name = make_name(Addr, Port, Profile), - Req = {list_group_members, Addr, Port, Dir, Group, Password}, + Req = {list_group_members, Addr, Port, Profile, Dir, Group, Password}, call(Name, Req). delete_group(Addr, Port, Dir, GroupName, Password) -> diff --git a/lib/inets/src/inets_app/inets_lib.erl b/lib/inets/src/inets_app/inets_lib.erl index 8993be29e4..3fae376a9f 100644 --- a/lib/inets/src/inets_app/inets_lib.erl +++ b/lib/inets/src/inets_app/inets_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index a2b463e98c..4e10a97f58 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 57da82c6ad..8aea38037d 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. @@ -88,7 +88,8 @@ real_requests()-> stream_through_mfa, streaming_error, inet_opts, - invalid_headers + invalid_headers, + invalid_body ]. only_simulated() -> @@ -125,7 +126,9 @@ only_simulated() -> redirect_see_other, redirect_temporary_redirect, port_in_host_header, - relaxed + redirect_port_in_host_header, + relaxed, + multipart_chunks ]. misc() -> @@ -1000,10 +1003,25 @@ invalid_headers(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), [{"cookie", undefined}]}, {error, _} = httpc:request(get, Request, [], []). +%%------------------------------------------------------------------------- + +invalid_body(Config) -> + URL = url(group_name(Config), "/dummy.html", Config), + try + httpc:request(post, {URL, [], <<"text/plain">>, "foobar"}, + [], []), + ct:fail(accepted_invalid_input) + catch + error:function_clause -> + ok + end. + +%%------------------------------------------------------------------------- remote_socket_close(Config) when is_list(Config) -> URL = url(group_name(Config), "/just_close.html", Config), {error, socket_closed_remotely} = httpc:request(URL). + %%------------------------------------------------------------------------- remote_socket_close_async(Config) when is_list(Config) -> @@ -1102,7 +1120,20 @@ port_in_host_header(Config) when is_list(Config) -> Request = {url(group_name(Config), "/ensure_host_header_with_port.html", Config), []}, {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), inets_test_lib:check_body(Body). +%%------------------------------------------------------------------------- +redirect_port_in_host_header(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/redirect_ensure_host_header_with_port.html", Config), []}, + {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), + inets_test_lib:check_body(Body). + +%%------------------------------------------------------------------------- +multipart_chunks(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/multipart_chunks.html", Config), []}, + {ok, Ref} = httpc:request(get, Request, [], [{sync, false}, {stream, self}]), + ok = receive_stream_n(Ref, 10), + httpc:cancel_request(Ref). + %%------------------------------------------------------------------------- timeout_memory_leak() -> [{doc, "Check OTP-8739"}]. @@ -1398,7 +1429,7 @@ dummy_server(Caller, SocketType, Inet, Extra) -> end. dummy_server_init(Caller, ip_comm, Inet, _) -> - BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], + BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {keepalive, true}, {active, false}], {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), {ok, Port} = inet:port(ListenSocket), Caller ! {port, Port}, @@ -1680,6 +1711,12 @@ handle_uri(_,"/ensure_host_header_with_port.html",_,Headers,_,_) -> "HTTP/1.1 500 Internal Server Error\r\n" ++ "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B end; +handle_uri(_,"/redirect_ensure_host_header_with_port.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/ensure_host_header_with_port.html", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; handle_uri(_,"/300.html",Port,_,Socket,_) -> NewUri = url_start(Socket) ++ @@ -1968,6 +2005,16 @@ handle_uri(_,"/missing_CR.html",_,_,_,_) -> "Content-Length:32\r\n\n" ++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/multipart_chunks.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:chunked\r\n" ++ + "Date: " ++ httpd_util:rfc1123_date() ++ "\r\n" + "Connection: Keep-Alive\r\n" ++ + "Content-Type: multipart/x-mixed-replace; boundary=chunk_boundary\r\n" ++ + "\r\n", + send(Socket, Head), + send_multipart_chunks(Socket), + http_chunk:encode_last(); handle_uri("HEAD",_,_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "Content-Length:0\r\n\r\n"; @@ -2264,3 +2311,21 @@ otp_8739_dummy_server_main(_Parent, ListenSocket) -> Error -> exit(Error) end. + +send_multipart_chunks(Socket) -> + send(Socket, http_chunk:encode("--chunk_boundary\r\n")), + send(Socket, http_chunk:encode("Content-Type: text/plain\r\nContent-Length: 4\r\n\r\n")), + send(Socket, http_chunk:encode("test\r\n")), + ct:sleep(500), + send_multipart_chunks(Socket). + +receive_stream_n(_, 0) -> + ok; +receive_stream_n(Ref, N) -> + receive + {http, {Ref, stream_start, _}} -> + receive_stream_n(Ref, N); + {http, {Ref,stream, Data}} -> + ct:pal("Data: ~p", [Data]), + receive_stream_n(Ref, N-1) + end. diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 28e77151f2..aae4ce5256 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -521,6 +521,9 @@ do_auth_api(AuthPrefix, Config) -> "two", "group1"), add_group_member(Node, ServerRoot, Port, AuthPrefix, "secret", "Aladdin", "group2"), + {ok, Members} = list_group_members(Node, ServerRoot, Port, AuthPrefix, "secret", "group1"), + true = lists:member("one", Members), + true = lists:member("two", Members), ok = auth_status(auth_request("/" ++ AuthPrefix ++ "secret/", "one", "onePassword", Version, Host), Config, [{statuscode, 200}]), @@ -2155,6 +2158,10 @@ add_group_member(Node, Root, Port, AuthPrefix, Dir, User, Group) -> Directory = filename:join([Root, "htdocs", AuthPrefix ++ Dir]), rpc:call(Node, mod_auth, add_group_member, [Group, User, Addr, Port, Directory]). +list_group_members(Node, Root, Port, AuthPrefix, Dir, Group) -> + Directory = filename:join([Root, "htdocs", AuthPrefix ++ Dir]), + rpc:call(Node, mod_auth, list_group_members, [Group, [{port, Port}, {dir, Directory}]]). + getaddr() -> {ok,HostName} = inet:gethostname(), {ok,{A1,A2,A3,A4}} = inet:getaddr(HostName,inet), diff --git a/lib/inets/test/inets_socketwrap_SUITE.erl b/lib/inets/test/inets_socketwrap_SUITE.erl index 18df995215..7ea7e08ed1 100644 --- a/lib/inets/test/inets_socketwrap_SUITE.erl +++ b/lib/inets/test/inets_socketwrap_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index f668ef106c..eef5abd610 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.3.3 +INETS_VSN = 6.3.4 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index f881fd76fd..878a450f0f 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -258,7 +258,7 @@ zip:create("mnesia-4.4.7.ez", both strings and atoms, but a future release will probably only allow the arguments that are documented.</p> - <p>As from Erlang/OTP R12B, functions in this module generally fail with an + <p>Functions in this module generally fail with an exception if they are passed an incorrect type (for example, an integer or a tuple where an atom is expected). An error tuple is returned if the argument type is correct, but there are some other errors (for example, a non-existing directory diff --git a/lib/kernel/doc/src/config.xml b/lib/kernel/doc/src/config.xml index c5f37fd036..c10f11b187 100644 --- a/lib/kernel/doc/src/config.xml +++ b/lib/kernel/doc/src/config.xml @@ -77,8 +77,8 @@ to update the application configurations.</p> <p>This means that specifying another <c>.config</c> file, or more <c>.config</c> files, leads to inconsistent update of application - configurations. Therefore, in Erlang 5.4/OTP R10B, the syntax of - <c>sys.config</c> was extended to allow pointing out other + configurations. There is, however, a syntax for + <c>sys.config</c> that allows pointing out other <c>.config</c> files:</p> <code type="none"> [{Application, [{Par, Val}]} | File].</code> diff --git a/lib/kernel/doc/src/disk_log.xml b/lib/kernel/doc/src/disk_log.xml index 0b6ee1e6a5..aebeacee28 100644 --- a/lib/kernel/doc/src/disk_log.xml +++ b/lib/kernel/doc/src/disk_log.xml @@ -43,7 +43,7 @@ <taglist> <tag>halt logs</tag> <item><p>Appends items to a single file, which size can - be limited by the disk log module.</p></item> + be limited by the <c>disk_log</c> module.</p></item> <tag>wrap logs</tag> <item><p>Uses a sequence of wrap log files of limited size. As a wrap log file is filled up, further items are logged on to the next @@ -62,8 +62,8 @@ An item logged to an internally formatted log must not occupy more than 4 GB of disk space (the size must fit in 4 bytes).</p></item> <tag>external format</tag> - <item><p>Leaves it up to the user to read the logged deep byte lists. - The disk log module cannot repair externally formatted logs.</p></item> + <item><p>Leaves it up to the user to read and interpret the logged data. + The <c>disk_log</c> module cannot repair externally formatted logs.</p></item> </taglist> <p>For each open disk log, one process handles requests @@ -109,8 +109,7 @@ These functions log one or more Erlang terms. By prefixing each of the functions with a <c>b</c> (for "binary"), we get the corresponding <c>blog()</c> functions for the external format. - These functions log one or more deep lists of bytes or, alternatively, - binaries of deep lists of bytes. + These functions log one or more chunks of bytes. For example, to log the string <c>"hello"</c> in ASCII format, you can use <c>disk_log:blog(Log, "hello")</c>, or <c>disk_log:blog(Log, list_to_binary("hello"))</c>. The two @@ -219,9 +218,6 @@ <name name="dlog_head_opt"/> </datatype> <datatype> - <name name="dlog_byte"/> - </datatype> - <datatype> <name name="dlog_mode"/> </datatype> <datatype> @@ -234,9 +230,6 @@ </desc> </datatype> <datatype> - <name name="bytes"/> - </datatype> - <datatype> <name name="invalid_header"/> </datatype> <datatype> @@ -953,7 +946,7 @@ written first on the log file. If the log is a wrap log, the item <c><anno>Head</anno></c> is written first in each new file. <c><anno>Head</anno></c> is to be a term if the format is - <c>internal</c>, otherwise a deep list of bytes (or a binary). + <c>internal</c>, otherwise a sequence of bytes. Defaults to <c>none</c>, which means that no header is written first on the file. </p> @@ -965,7 +958,7 @@ The call <c>M:F(A)</c> is assumed to return <c>{ok, Head}</c>. The item <c>Head</c> is written first in each file. <c>Head</c> is to be a term if the format is - <c>internal</c>, otherwise a deep list of bytes (or a binary). + <c>internal</c>, otherwise a sequence of bytes. </p> </item> <tag><c>{mode, <anno>Mode</anno>}</c></tag> diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index 59a046bf4d..5b5b71e521 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -37,10 +37,7 @@ the <c>heart</c> port program is to check that the Erlang runtime system it is supervising is still running. If the port program has not received any heartbeats within <c>HEART_BEAT_TIMEOUT</c> seconds - (defaults to 60 seconds), the system can be rebooted. Also, if - the system is equipped with a hardware watchdog timer and is - running Solaris, the watchdog can be used to supervise the entire - system.</p> + (defaults to 60 seconds), the system can be rebooted.</p> <p>An Erlang runtime system to be monitored by a heart program is to be started with command-line flag <c>-heart</c> (see also <seealso marker="erts:erl"><c>erl(1)</c></seealso>). @@ -51,17 +48,13 @@ or a terminated Erlang runtime system, environment variable <c>HEART_COMMAND</c> must be set before the system is started. If this variable is not set, a warning text is printed but - the system does not reboot. However, if the hardware watchdog is - used, it still triggers a reboot <c>HEART_BEAT_BOOT_DELAY</c> - seconds later (defaults to 60 seconds).</p> + the system does not reboot.</p> <p>To reboot on Windows, <c>HEART_COMMAND</c> can be set to <c>heart -shutdown</c> (included in the Erlang delivery) or to any other suitable program that can activate a reboot.</p> - <p>The hardware watchdog is not started under Solaris if - environment variable <c>HW_WD_DISABLE</c> is set.</p> - <p>The environment variables <c>HEART_BEAT_TIMEOUT</c> and - <c>HEART_BEAT_BOOT_DELAY</c> can be used to configure the heart - time-outs; they can be set in the operating system shell before Erlang + <p>The environment variable <c>HEART_BEAT_TIMEOUT</c> + can be used to configure the heart + time-outs; it can be set in the operating system shell before Erlang is started or be specified at the command line:</p> <pre> % <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 5bcc0b7c09..9277c2d353 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,6 +31,39 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 5.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + <c>code:add_pathsa/1</c> and command line option + <c>-pa</c> both revert the given list of directories when + adding it at the beginning of the code path. This is now + documented.</p> + <p> + Own Id: OTP-13920 Aux Id: ERL-267 </p> + </item> + <item> + <p> + Add lost runtime dependency to erts-8.1. This should have + been done in kernel-5.1 (OTP-19.1) as it cannot run + without at least erts-8.1 (OTP-19.1).</p> + <p> + Own Id: OTP-14003</p> + </item> + <item> + <p> + Type and doc for gen_{tcp,udp,sctp}:controlling_process/2 + has been improved.</p> + <p> + Own Id: OTP-14022 Aux Id: PR-1208 </p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 5.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index ba7259219d..b80e87c118 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -427,12 +427,6 @@ prev_cnt := tcurr</code> built with <c>Erl_Interface</c> only maintains one trace token, which means that the C-node appears as one process from the sequential tracing point of view.</p> - <p>To be able to perform sequential tracing between - distributed Erlang nodes, the distribution protocol has been - extended (in a backward compatible way). An Erlang node - supporting sequential tracing can communicate with an older - (Erlang/OTP R3B) node but messages passed within that node can - not be traced.</p> </section> <section> diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 9b44021872..2ade7fd77a 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -67,7 +67,7 @@ %%-define(PROFILE(C), C). -define(PROFILE(C), void). --compile({inline,[{log_loop,5},{log_end_sync,2},{replies,2},{rflat,1}]}). +-compile({inline,[{log_loop,6},{log_end_sync,2},{replies,2},{rflat,1}]}). %%%---------------------------------------------------------------------- %%% Contract type specifications @@ -75,8 +75,6 @@ -opaque continuation() :: #continuation{}. --type bytes() :: binary() | [byte()]. - -type file_error() :: term(). % XXX: refine -type invalid_header() :: term(). % XXX: refine @@ -127,28 +125,28 @@ open(A) -> Log :: log(), Term :: term(). log(Log, Term) -> - req(Log, {log, term_to_binary(Term)}). + req(Log, {log, internal, [term_to_binary(Term)]}). -spec blog(Log, Bytes) -> ok | {error, Reason :: log_error_rsn()} when Log :: log(), - Bytes :: bytes(). + Bytes :: iodata(). blog(Log, Bytes) -> - req(Log, {blog, check_bytes(Bytes)}). + req(Log, {log, external, [ensure_binary(Bytes)]}). -spec log_terms(Log, TermList) -> ok | {error, Resaon :: log_error_rsn()} when Log :: log(), TermList :: [term()]. log_terms(Log, Terms) -> Bs = terms2bins(Terms), - req(Log, {log, Bs}). + req(Log, {log, internal, Bs}). -spec blog_terms(Log, BytesList) -> ok | {error, Reason :: log_error_rsn()} when Log :: log(), - BytesList :: [bytes()]. + BytesList :: [iodata()]. blog_terms(Log, Bytess) -> - Bs = check_bytes_list(Bytess, Bytess), - req(Log, {blog, Bs}). + Bs = ensure_binary_list(Bytess), + req(Log, {log, external, Bs}). -type notify_ret() :: 'ok' | {'error', 'no_such_log'}. @@ -156,27 +154,27 @@ blog_terms(Log, Bytess) -> Log :: log(), Term :: term(). alog(Log, Term) -> - notify(Log, {alog, term_to_binary(Term)}). + notify(Log, {alog, internal, [term_to_binary(Term)]}). -spec alog_terms(Log, TermList) -> notify_ret() when Log :: log(), TermList :: [term()]. alog_terms(Log, Terms) -> Bs = terms2bins(Terms), - notify(Log, {alog, Bs}). + notify(Log, {alog, internal, Bs}). -spec balog(Log, Bytes) -> notify_ret() when Log :: log(), - Bytes :: bytes(). + Bytes :: iodata(). balog(Log, Bytes) -> - notify(Log, {balog, check_bytes(Bytes)}). + notify(Log, {alog, external, [ensure_binary(Bytes)]}). -spec balog_terms(Log, ByteList) -> notify_ret() when Log :: log(), - ByteList :: [bytes()]. + ByteList :: [iodata()]. balog_terms(Log, Bytess) -> - Bs = check_bytes_list(Bytess, Bytess), - notify(Log, {balog, Bs}). + Bs = ensure_binary_list(Bytess), + notify(Log, {alog, external, Bs}). -type close_error_rsn() ::'no_such_log' | 'nonode' | {'file_error', file:filename(), file_error()}. @@ -219,9 +217,9 @@ truncate(Log, Head) -> -spec btruncate(Log, BHead) -> 'ok' | {'error', trunc_error_rsn()} when Log :: log(), - BHead :: bytes(). + BHead :: iodata(). btruncate(Log, Head) -> - req(Log, {truncate, {ok, check_bytes(Head)}, btruncate, 2}). + req(Log, {truncate, {ok, ensure_binary(Head)}, btruncate, 2}). -type reopen_error_rsn() :: no_such_log | nonode @@ -248,9 +246,9 @@ reopen(Log, NewFile, NewHead) -> -spec breopen(Log, File, BHead) -> 'ok' | {'error', reopen_error_rsn()} when Log :: log(), File :: file:filename(), - BHead :: bytes(). + BHead :: iodata(). breopen(Log, NewFile, NewHead) -> - req(Log, {reopen, NewFile, {ok, check_bytes(NewHead)}, breopen, 3}). + req(Log, {reopen, NewFile, {ok, ensure_binary(NewHead)}, breopen, 3}). -type inc_wrap_error_rsn() :: 'no_such_log' | 'nonode' | {'read_only_mode', log()} @@ -670,13 +668,12 @@ init(Parent, Server) -> process_flag(trap_exit, true), loop(#state{parent = Parent, server = Server}). -loop(State) when State#state.messages =:= [] -> +loop(#state{messages = []}=State) -> receive Message -> handle(Message, State) end; -loop(State) -> - [M | Ms] = State#state.messages, +loop(#state{messages = [M | Ms]}=State) -> handle(M, State#state{messages = Ms}). handle({From, write_cache}, S) when From =:= self() -> @@ -686,106 +683,79 @@ handle({From, write_cache}, S) when From =:= self() -> Error -> loop(S#state{cache_error = Error}) end; -handle({From, {log, B}}, S) -> +handle({From, {log, Format, B}}=Message, S) -> case get(log) of - L when L#log.mode =:= read_only -> + #log{mode = read_only}=L -> reply(From, {error, {read_only_mode, L#log.name}}, S); - L when L#log.status =:= ok, L#log.format =:= internal -> - log_loop(S, From, [B], [], iolist_size(B)); - L when L#log.status =:= ok, L#log.format =:= external -> + #log{status = ok, format=external}=L when Format =:= internal -> reply(From, {error, {format_external, L#log.name}}, S); - L when L#log.status =:= {blocked, false} -> - reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> - reply(From, {error, {blocked_log, L#log.name}}, S); - _ -> - loop(S#state{queue = [{From, {log, B}} | S#state.queue]}) - end; -handle({From, {blog, B}}, S) -> - case get(log) of - L when L#log.mode =:= read_only -> - reply(From, {error, {read_only_mode, L#log.name}}, S); - L when L#log.status =:= ok -> - log_loop(S, From, [B], [], iolist_size(B)); - L when L#log.status =:= {blocked, false} -> + #log{status = ok, format=LogFormat} -> + log_loop(S, From, [B], [], iolist_size(B), LogFormat); + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, {blog, B}} | S#state.queue]}) + enqueue(Message, S) end; -handle({alog, B}, S) -> +handle({alog, Format, B}=Message, S) -> case get(log) of - L when L#log.mode =:= read_only -> + #log{mode = read_only} -> notify_owners({read_only,B}), loop(S); - L when L#log.status =:= ok, L#log.format =:= internal -> - log_loop(S, [], [B], [], iolist_size(B)); - L when L#log.status =:= ok -> + #log{status = ok, format = external} when Format =:= internal -> notify_owners({format_external, B}), loop(S); - L when L#log.status =:= {blocked, false} -> + #log{status = ok, format=LogFormat} -> + log_loop(S, [], [B], [], iolist_size(B), LogFormat); + #log{status = {blocked, false}} -> notify_owners({blocked_log, B}), loop(S); _ -> - loop(S#state{queue = [{alog, B} | S#state.queue]}) + enqueue(Message, S) end; -handle({balog, B}, S) -> +handle({From, {block, QueueLogRecs}}=Message, S) -> case get(log) of - L when L#log.mode =:= read_only -> - notify_owners({read_only,B}), - loop(S); - L when L#log.status =:= ok -> - log_loop(S, [], [B], [], iolist_size(B)); - L when L#log.status =:= {blocked, false} -> - notify_owners({blocked_log, B}), - loop(S); - _ -> - loop(S#state{queue = [{balog, B} | S#state.queue]}) - end; -handle({From, {block, QueueLogRecs}}, S) -> - case get(log) of - L when L#log.status =:= ok -> + #log{status = ok}=L -> do_block(From, QueueLogRecs, L), reply(From, ok, S); - L when L#log.status =:= {blocked, false} -> + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, {block, QueueLogRecs}} | - S#state.queue]}) + enqueue(Message, S) end; handle({From, unblock}, S) -> case get(log) of - L when L#log.status =:= ok -> + #log{status = ok}=L -> reply(From, {error, {not_blocked, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> S2 = do_unblock(L, S), reply(From, ok, S2); L -> reply(From, {error, {not_blocked_by_pid, L#log.name}}, S) end; -handle({From, sync}, S) -> +handle({From, sync}=Message, S) -> case get(log) of - L when L#log.mode =:= read_only -> + #log{mode = read_only}=L -> reply(From, {error, {read_only_mode, L#log.name}}, S); - L when L#log.status =:= ok -> - sync_loop([From], S); - L when L#log.status =:= {blocked, false} -> + #log{status = ok, format=LogFormat} -> + log_loop(S, [], [], [From], 0, LogFormat); + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, sync} | S#state.queue]}) + enqueue(Message, S) end; -handle({From, {truncate, Head, F, A}}, S) -> +handle({From, {truncate, Head, F, A}}=Message, S) -> case get(log) of - L when L#log.mode =:= read_only -> + #log{mode = read_only}=L -> reply(From, {error, {read_only_mode, L#log.name}}, S); - L when L#log.status =:= ok, S#state.cache_error =/= ok -> + #log{status = ok} when S#state.cache_error =/= ok -> loop(cache_error(S, [From])); - L when L#log.status =:= ok -> + #log{status = ok}=L -> H = merge_head(Head, L#log.head), case catch do_trunc(L, H) of ok -> @@ -796,48 +766,46 @@ handle({From, {truncate, Head, F, A}}, S) -> Error -> do_exit(S, From, Error, ?failure(Error, F, A)) end; - L when L#log.status =:= {blocked, false} -> + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, {truncate, Head, F, A}} - | S#state.queue]}) + enqueue(Message, S) end; -handle({From, {chunk, Pos, B, N}}, S) -> +handle({From, {chunk, Pos, B, N}}=Message, S) -> case get(log) of - L when L#log.status =:= ok, S#state.cache_error =/= ok -> + #log{status = ok} when S#state.cache_error =/= ok -> loop(cache_error(S, [From])); - L when L#log.status =:= ok -> + #log{status = ok}=L -> R = do_chunk(L, Pos, B, N), reply(From, R, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> R = do_chunk(L, Pos, B, N), reply(From, R, S); - L when L#log.status =:= {blocked, false} -> + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _L -> - loop(S#state{queue = [{From, {chunk, Pos, B, N}} | S#state.queue]}) + enqueue(Message, S) end; -handle({From, {chunk_step, Pos, N}}, S) -> +handle({From, {chunk_step, Pos, N}}=Message, S) -> case get(log) of - L when L#log.status =:= ok, S#state.cache_error =/= ok -> + #log{status = ok} when S#state.cache_error =/= ok -> loop(cache_error(S, [From])); - L when L#log.status =:= ok -> + #log{status = ok}=L -> R = do_chunk_step(L, Pos, N), reply(From, R, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> R = do_chunk_step(L, Pos, N), reply(From, R, S); - L when L#log.status =:= {blocked, false} -> + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, {chunk_step, Pos, N}} - | S#state.queue]}) + enqueue(Message, S) end; -handle({From, {change_notify, Pid, NewNotify}}, S) -> +handle({From, {change_notify, Pid, NewNotify}}=Message, S) -> case get(log) of - L when L#log.status =:= ok -> + #log{status = ok}=L -> case do_change_notify(L, Pid, NewNotify) of {ok, L1} -> put(log, L1), @@ -845,39 +813,37 @@ handle({From, {change_notify, Pid, NewNotify}}, S) -> Error -> reply(From, Error, S) end; - L when L#log.status =:= {blocked, false} -> + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, {change_notify, Pid, NewNotify}} - | S#state.queue]}) + enqueue(Message, S) end; -handle({From, {change_header, NewHead}}, S) -> +handle({From, {change_header, NewHead}}=Message, S) -> case get(log) of - L when L#log.mode =:= read_only -> + #log{mode = read_only}=L -> reply(From, {error, {read_only_mode, L#log.name}}, S); - L when L#log.status =:= ok -> - case check_head(NewHead, L#log.format) of + #log{status = ok, format = Format}=L -> + case check_head(NewHead, Format) of {ok, Head} -> - put(log, L#log{head = mk_head(Head, L#log.format)}), + put(log, L#log{head = mk_head(Head, Format)}), reply(From, ok, S); Error -> reply(From, Error, S) end; - L when L#log.status =:= {blocked, false} -> + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, {change_header, NewHead}} - | S#state.queue]}) + enqueue(Message, S) end; -handle({From, {change_size, NewSize}}, S) -> +handle({From, {change_size, NewSize}}=Message, S) -> case get(log) of - L when L#log.mode =:= read_only -> + #log{mode = read_only}=L -> reply(From, {error, {read_only_mode, L#log.name}}, S); - L when L#log.status =:= ok -> + #log{status = ok}=L -> case check_size(L#log.type, NewSize) of ok -> case catch do_change_size(L, NewSize) of % does the put @@ -894,23 +860,22 @@ handle({From, {change_size, NewSize}}, S) -> not_ok -> reply(From, {error, {badarg, size}}, S) end; - L when L#log.status =:= {blocked, false} -> + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, {change_size, NewSize}} - | S#state.queue]}) + enqueue(Message, S) end; -handle({From, inc_wrap_file}, S) -> +handle({From, inc_wrap_file}=Message, S) -> case get(log) of - L when L#log.mode =:= read_only -> + #log{mode = read_only}=L -> reply(From, {error, {read_only_mode, L#log.name}}, S); - L when L#log.type =:= halt -> + #log{type = halt}=L -> reply(From, {error, {halt_log, L#log.name}}, S); - L when L#log.status =:= ok, S#state.cache_error =/= ok -> + #log{status = ok} when S#state.cache_error =/= ok -> loop(cache_error(S, [From])); - L when L#log.status =:= ok -> + #log{status = ok}=L -> case catch do_inc_wrap_file(L) of {ok, L2, Lost} -> put(log, L2), @@ -920,20 +885,22 @@ handle({From, inc_wrap_file}, S) -> put(log, L2), reply(From, Error, state_err(S, Error)) end; - L when L#log.status =:= {blocked, false} -> + #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); - L when L#log.blocked_by =:= From -> + #log{blocked_by = From}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); _ -> - loop(S#state{queue = [{From, inc_wrap_file} | S#state.queue]}) + enqueue(Message, S) end; handle({From, {reopen, NewFile, Head, F, A}}, S) -> case get(log) of - L when L#log.mode =:= read_only -> + #log{mode = read_only}=L -> reply(From, {error, {read_only_mode, L#log.name}}, S); - L when L#log.status =:= ok, S#state.cache_error =/= ok -> + #log{status = ok} when S#state.cache_error =/= ok -> loop(cache_error(S, [From])); - L when L#log.status =:= ok, L#log.filename =/= NewFile -> + #log{status = ok, filename = NewFile}=L -> + reply(From, {error, {same_file_name, L#log.name}}, S); + #log{status = ok}=L -> case catch close_disk_log2(L) of closed -> File = L#log.filename, @@ -966,8 +933,6 @@ handle({From, {reopen, NewFile, Head, F, A}}, S) -> Error -> do_exit(S, From, Error, ?failure(Error, F, A)) end; - L when L#log.status =:= ok -> - reply(From, {error, {same_file_name, L#log.name}}, S); L -> reply(From, {error, {blocked_log, L#log.name}}, S) end; @@ -1005,11 +970,11 @@ handle({From, close}, S) -> end; handle({From, info}, S) -> reply(From, do_info(get(log), S#state.cnt), S); -handle({'EXIT', From, Reason}, S) when From =:= S#state.parent -> +handle({'EXIT', From, Reason}, #state{parent=From}=S) -> %% Parent orders shutdown. _ = do_stop(S), exit(Reason); -handle({'EXIT', From, Reason}, S) when From =:= S#state.server -> +handle({'EXIT', From, Reason}, #state{server=From}=S) -> %% The server is gone. _ = do_stop(S), exit(Reason); @@ -1034,57 +999,59 @@ handle({system, From, Req}, S) -> handle(_, S) -> loop(S). -sync_loop(From, S) -> - log_loop(S, [], [], From, 0). +enqueue(Message, #state{queue = Queue}=S) -> + loop(S#state{queue = [Message | Queue]}). + +%% Collect further log and sync requests already in the mailbox or queued -define(MAX_LOOK_AHEAD, 64*1024). %% Inlined. -log_loop(#state{cache_error = CE}=S, Pids, _Bins, _Sync, _Sz) when CE =/= ok -> +log_loop(#state{cache_error = CE}=S, Pids, _Bins, _Sync, _Sz, _F) when CE =/= ok -> loop(cache_error(S, Pids)); -log_loop(#state{}=S, Pids, Bins, Sync, Sz) when Sz > ?MAX_LOOK_AHEAD -> - loop(log_end(S, Pids, Bins, Sync)); -log_loop(#state{messages = []}=S, Pids, Bins, Sync, Sz) -> - receive +log_loop(#state{}=S, Pids, Bins, Sync, Sz, _F) when Sz > ?MAX_LOOK_AHEAD -> + loop(log_end(S, Pids, Bins, Sync, Sz)); +log_loop(#state{messages = []}=S, Pids, Bins, Sync, Sz, F) -> + receive Message -> - log_loop(Message, Pids, Bins, Sync, Sz, S, get(log)) + log_loop(Message, Pids, Bins, Sync, Sz, F, S) after 0 -> - loop(log_end(S, Pids, Bins, Sync)) + loop(log_end(S, Pids, Bins, Sync, Sz)) end; -log_loop(#state{messages = [M | Ms]}=S, Pids, Bins, Sync, Sz) -> +log_loop(#state{messages = [M | Ms]}=S, Pids, Bins, Sync, Sz, F) -> S1 = S#state{messages = Ms}, - log_loop(M, Pids, Bins, Sync, Sz, S1, get(log)). + log_loop(M, Pids, Bins, Sync, Sz, F, S1). %% Items logged after the last sync request found are sync:ed as well. -log_loop({alog,B}, Pids, Bins, Sync, Sz, S, #log{format = internal}) -> - %% {alog, _} allowed for the internal format only. - log_loop(S, Pids, [B | Bins], Sync, Sz+iolist_size(B)); -log_loop({balog, B}, Pids, Bins, Sync, Sz, S, _L) -> - log_loop(S, Pids, [B | Bins], Sync, Sz+iolist_size(B)); -log_loop({From, {log, B}}, Pids, Bins, Sync, Sz, S, #log{format = internal}) -> - %% {log, _} allowed for the internal format only. - log_loop(S, [From | Pids], [B | Bins], Sync, Sz+iolist_size(B)); -log_loop({From, {blog, B}}, Pids, Bins, Sync, Sz, S, _L) -> - log_loop(S, [From | Pids], [B | Bins], Sync, Sz+iolist_size(B)); -log_loop({From, sync}, Pids, Bins, Sync, Sz, S, _L) -> - log_loop(S, Pids, Bins, [From | Sync], Sz); -log_loop(Message, Pids, Bins, Sync, _Sz, S, _L) -> - NS = log_end(S, Pids, Bins, Sync), +log_loop({alog, internal, B}, Pids, Bins, Sync, Sz, internal=F, S) -> + %% alog of terms allowed for the internal format only + log_loop(S, Pids, [B | Bins], Sync, Sz+iolist_size(B), F); +log_loop({alog, binary, B}, Pids, Bins, Sync, Sz, F, S) -> + log_loop(S, Pids, [B | Bins], Sync, Sz+iolist_size(B), F); +log_loop({From, {log, internal, B}}, Pids, Bins, Sync, Sz, internal=F, S) -> + %% log of terms allowed for the internal format only + log_loop(S, [From | Pids], [B | Bins], Sync, Sz+iolist_size(B), F); +log_loop({From, {log, binary, B}}, Pids, Bins, Sync, Sz, F, S) -> + log_loop(S, [From | Pids], [B | Bins], Sync, Sz+iolist_size(B), F); +log_loop({From, sync}, Pids, Bins, Sync, Sz, F, S) -> + log_loop(S, Pids, Bins, [From | Sync], Sz, F); +log_loop(Message, Pids, Bins, Sync, Sz, _F, S) -> + NS = log_end(S, Pids, Bins, Sync, Sz), handle(Message, NS). -log_end(S, [], [], Sync) -> +log_end(S, [], [], Sync, _Sz) -> log_end_sync(S, Sync); -log_end(S, Pids, Bins, Sync) -> - case do_log(get(log), rflat(Bins)) of +log_end(#state{cnt = Cnt}=S, Pids, Bins, Sync, Sz) -> + case do_log(get(log), rflat(Bins), Sz) of N when is_integer(N) -> ok = replies(Pids, ok), - S1 = (state_ok(S))#state{cnt = S#state.cnt+N}, + S1 = (state_ok(S))#state{cnt = Cnt + N}, log_end_sync(S1, Sync); {error, {error, {full, _Name}}, N} when Pids =:= [] -> - log_end_sync(state_ok(S#state{cnt = S#state.cnt + N}), Sync); + log_end_sync(state_ok(S#state{cnt = Cnt + N}), Sync); {error, Error, N} -> ok = replies(Pids, Error), - state_err(S#state{cnt = S#state.cnt + N}, Error) + state_err(S#state{cnt = Cnt + N}, Error) end. %% Inlined. @@ -1096,12 +1063,9 @@ log_end_sync(S, Sync) -> state_err(S, Res). %% Inlined. -rflat([B]=L) when is_binary(B) -> L; rflat([B]) -> B; rflat(B) -> rflat(B, []). -rflat([B | Bs], L) when is_binary(B) -> - rflat(Bs, [B | L]); rflat([B | Bs], L) -> rflat(Bs, B ++ L); rflat([], L) -> L. @@ -1138,17 +1102,17 @@ close_owner(Pid, L, S) -> S2 = do_unblock(Pid, get(log), S), unlink(Pid), do_close2(L1, S2). - + %% -> {stop, S} | {continue, S} -close_user(Pid, L, S) when L#log.users > 0 -> - L1 = L#log{users = L#log.users - 1}, +close_user(Pid, #log{users=Users}=L, S) when Users > 0 -> + L1 = L#log{users = Users - 1}, put(log, L1), S2 = do_unblock(Pid, get(log), S), do_close2(L1, S2); close_user(_Pid, _L, S) -> {continue, S}. -do_close2(L, S) when L#log.users =:= 0, L#log.owners =:= [] -> +do_close2(#log{users = 0, owners = []}, S) -> {stop, S}; do_close2(_L, S) -> {continue, S}. @@ -1227,14 +1191,14 @@ add_pid(Pid, Notify, L) when is_pid(Pid) -> add_pid(_NotAPid, _Notify, L) -> {ok, L#log{users = L#log.users + 1}}. -unblock_pid(L) when L#log.blocked_by =:= none -> +unblock_pid(#log{blocked_by = none}) -> ok; -unblock_pid(L) -> - case is_owner(L#log.blocked_by, L) of +unblock_pid(#log{blocked_by = Pid}=L) -> + case is_owner(Pid, L) of {true, _Notify} -> ok; false -> - unlink(L#log.blocked_by) + unlink(Pid) end. %% -> true | false @@ -1326,7 +1290,7 @@ do_open(A) -> end. mk_head({head, Term}, internal) -> {ok, term_to_binary(Term)}; -mk_head({head, Bytes}, external) -> {ok, check_bytes(Bytes)}; +mk_head({head, Bytes}, external) -> {ok, ensure_binary(Bytes)}; mk_head(H, _) -> H. terms2bins([T | Ts]) -> @@ -1334,30 +1298,29 @@ terms2bins([T | Ts]) -> terms2bins([]) -> []. -check_bytes_list([B | Bs], Bs0) when is_binary(B) -> - check_bytes_list(Bs, Bs0); -check_bytes_list([], Bs0) -> +ensure_binary_list(Bs) -> + ensure_binary_list(Bs, Bs). + +ensure_binary_list([B | Bs], Bs0) when is_binary(B) -> + ensure_binary_list(Bs, Bs0); +ensure_binary_list([], Bs0) -> Bs0; -check_bytes_list(_, Bs0) -> - check_bytes_list(Bs0). - -check_bytes_list([B | Bs]) when is_binary(B) -> - [B | check_bytes_list(Bs)]; -check_bytes_list([B | Bs]) -> - [list_to_binary(B) | check_bytes_list(Bs)]; -check_bytes_list([]) -> +ensure_binary_list(_, Bs0) -> + make_binary_list(Bs0). + +make_binary_list([B | Bs]) -> + [ensure_binary(B) | make_binary_list(Bs)]; +make_binary_list([]) -> []. -check_bytes(Binary) when is_binary(Binary) -> - Binary; -check_bytes(Bytes) -> - list_to_binary(Bytes). +ensure_binary(Bytes) -> + iolist_to_binary(Bytes). %%----------------------------------------------------------------- %% Change size of the logs in runtime. %%----------------------------------------------------------------- %% -> ok | {big, CurSize} | throw(Error) -do_change_size(L, NewSize) when L#log.type =:= halt -> +do_change_size(#log{type = halt}=L, NewSize) -> Halt = L#log.extra, CurB = Halt#halt.curB, NewLog = L#log{extra = Halt#halt{size = NewSize}}, @@ -1373,7 +1336,7 @@ do_change_size(L, NewSize) when L#log.type =:= halt -> true -> {big, CurB} end; -do_change_size(L, NewSize) when L#log.type =:= wrap -> +do_change_size(#log{type = wrap}=L, NewSize) -> #log{extra = Extra, version = Version} = L, {ok, Handle} = disk_log_1:change_size_wrap(Extra, NewSize, Version), erase(is_full), @@ -1388,7 +1351,7 @@ check_head({head_func, {M, F, A}}, _Format) when is_atom(M), is_list(A) -> {ok, {M, F, A}}; check_head({head, Head}, external) -> - case catch check_bytes(Head) of + case catch ensure_binary(Head) of {'EXIT', _} -> {error, {badarg, head}}; _ -> @@ -1674,7 +1637,7 @@ do_block(Pid, QueueLogRecs, L) -> link(Pid) end. -do_unblock(Pid, L, S) when L#log.blocked_by =:= Pid -> +do_unblock(Pid, #log{blocked_by = Pid}=L, S) -> do_unblock(L, S); do_unblock(_Pid, _L, S) -> S. @@ -1692,10 +1655,13 @@ do_unblock(L, S) -> -spec do_log(#log{}, [binary()]) -> integer() | {'error', _, integer()}. -do_log(L, B) when L#log.type =:= halt -> +do_log(L, B) -> + do_log(L, B, iolist_size(B)). + +do_log(#log{type = halt}=L, B, BSz) -> #log{format = Format, extra = Halt} = L, #halt{curB = CurSize, size = Sz} = Halt, - {Bs, BSize} = bsize(B, Format), + {Bs, BSize} = logl(B, Format, BSz), case get(is_full) of true -> {error, {error, {full, L#log.name}}, 0}; @@ -1704,7 +1670,7 @@ do_log(L, B) when L#log.type =:= halt -> undefined -> halt_write_full(L, B, Format, 0) end; -do_log(L, B) when L#log.format_type =:= wrap_int -> +do_log(#log{format_type = wrap_int}=L, B, _BSz) -> case disk_log_1:mf_int_log(L#log.extra, B, L#log.head) of {ok, Handle, Logged, Lost, Wraps} -> notify_owners_wrap(Wraps), @@ -1717,7 +1683,7 @@ do_log(L, B) when L#log.format_type =:= wrap_int -> put(log, L#log{extra = Handle}), {error, Error, Logged - Lost} end; -do_log(L, B) when L#log.format_type =:= wrap_ext -> +do_log(#log{format_type = wrap_ext}=L, B, _BSz) -> case disk_log_1:mf_ext_log(L#log.extra, B, L#log.head) of {ok, Handle, Logged, Lost, Wraps} -> notify_owners_wrap(Wraps), @@ -1731,17 +1697,16 @@ do_log(L, B) when L#log.format_type =:= wrap_ext -> {error, Error, Logged - Lost} end. -bsize(B, external) -> - {B, xsz(B, 0)}; -bsize(B, internal) -> +logl(B, external, undefined) -> + {B, iolist_size(B)}; +logl(B, external, Sz) -> + {B, Sz}; +logl(B, internal, _Sz) -> disk_log_1:logl(B). -xsz([B|T], Sz) -> xsz(T, byte_size(B) + Sz); -xsz([], Sz) -> Sz. - halt_write_full(L, [Bin | Bins], Format, N) -> B = [Bin], - {Bs, BSize} = bsize(B, Format), + {Bs, BSize} = logl(B, Format, undefined), Halt = L#log.extra, #halt{curB = CurSize, size = Sz} = Halt, if @@ -1793,7 +1758,7 @@ do_sync(#log{type = wrap, extra = Handle} = Log) -> Reply. %% -> ok | Error | throw(Error) -do_trunc(L, Head) when L#log.type =:= halt -> +do_trunc(#log{type = halt}=L, Head) -> #log{filename = FName, extra = Halt} = L, FdC = Halt#halt.fdc, {Reply1, FdC2} = @@ -1822,7 +1787,7 @@ do_trunc(L, Head) when L#log.type =:= halt -> end, put(log, L#log{extra = NewHalt}), Reply; -do_trunc(L, Head) when L#log.type =:= wrap -> +do_trunc(#log{type = wrap}=L, Head) -> Handle = L#log.extra, OldHead = L#log.head, {MaxB, MaxF} = disk_log_1:get_wrap_size(Handle), @@ -2016,8 +1981,7 @@ notify_owners(Note) -> (_) -> ok end, L#log.owners). -cache_error(S, Pids) -> - Error = S#state.cache_error, +cache_error(#state{cache_error=Error}=S, Pids) -> ok = replies(Pids, Error), state_err(S#state{cache_error = ok}, Error). diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl index 3262d979ee..593dbb31ab 100644 --- a/lib/kernel/src/disk_log.hrl +++ b/lib/kernel/src/disk_log.hrl @@ -39,6 +39,7 @@ -define(MAX_FILES, 65000). -define(MAX_BYTES, ((1 bsl 64) - 1)). -define(MAX_CHUNK_SIZE, 65536). +-define(MAX_FWRITE_CACHE, 65536). %% Object defines -define(LOGMAGIC, <<1,2,3,4>>). @@ -54,11 +55,10 @@ %% Types -- alphabetically %%------------------------------------------------------------------------ --type dlog_byte() :: [dlog_byte()] | byte(). -type dlog_format() :: 'external' | 'internal'. -type dlog_format_type() :: 'halt_ext' | 'halt_int' | 'wrap_ext' | 'wrap_int'. -type dlog_head() :: 'none' | {'ok', binary()} | mfa(). --type dlog_head_opt() :: none | term() | binary() | [dlog_byte()]. +-type dlog_head_opt() :: none | term() | iodata(). -type log() :: term(). % XXX: refine -type dlog_mode() :: 'read_only' | 'read_write'. -type dlog_name() :: atom() | string(). diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index 2e61363aa6..d83c30f35f 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -1416,24 +1416,36 @@ open_truncate(FileName) -> %%% Functions that access files, and throw on error. --define(MAX, 16384). % bytes -define(TIMEOUT, 2000). % ms %% -> {Reply, cache()}; Reply = ok | Error -fwrite(#cache{c = []} = FdC, _FN, B, Size) -> +fwrite(FdC, _FN, _B, 0) -> + {ok, FdC}; % avoid starting a timer for empty writes +fwrite(#cache{fd = Fd, c = C, sz = Sz} = FdC, FileName, B, Size) -> + Sz1 = Sz + Size, + C1 = cache_append(C, B), + if Sz1 > ?MAX_FWRITE_CACHE -> + write_cache(Fd, FileName, C1); + true -> + maybe_start_timer(C), + {ok, FdC#cache{sz = Sz1, c = C1}} + end. + +cache_append([], B) -> B; +cache_append(C, B) -> [C | B]. + +%% if the cache was empty, start timer (unless it's already running) +maybe_start_timer([]) -> case get(write_cache_timer_is_running) of - true -> + true -> ok; - _ -> + _ -> put(write_cache_timer_is_running, true), erlang:send_after(?TIMEOUT, self(), {self(), write_cache}), ok - end, - {ok, FdC#cache{sz = Size, c = B}}; -fwrite(#cache{sz = Sz, c = C} = FdC, _FN, B, Size) when Sz < ?MAX -> - {ok, FdC#cache{sz = Sz+Size, c = [C | B]}}; -fwrite(#cache{fd = Fd, c = C}, FileName, B, _Size) -> - write_cache(Fd, FileName, [C | B]). + end; +maybe_start_timer(_C) -> + ok. fwrite_header(Fd, B, Size) -> {ok, #cache{fd = Fd, sz = Size, c = B}}. diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 7b3f1e313a..ad92aafc2f 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -35,7 +35,8 @@ dump_monitors/1, dump_links/1, flat_size/1, get_internal_state/1, instructions/0, lock_counters/1, map_info/1, same/2, set_internal_state/2, - size_shared/1, copy_shared/1]). + size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, + dirty/3]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -182,6 +183,28 @@ same(_, _) -> set_internal_state(_, _) -> erlang:nif_error(undef). +-spec dirty_cpu(Term1, Term2) -> term() when + Term1 :: term(), + Term2 :: term(). + +dirty_cpu(_, _) -> + erlang:nif_error(undef). + +-spec dirty_io(Term1, Term2) -> term() when + Term1 :: term(), + Term2 :: term(). + +dirty_io(_, _) -> + erlang:nif_error(undef). + +-spec dirty(Term1, Term2, Term3) -> term() when + Term1 :: term(), + Term2 :: term(), + Term3 :: term(). + +dirty(_, _, _) -> + erlang:nif_error(undef). + %%% End of BIFs %% size(Term) diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl index 8ac0bd9551..f5ead2a4c5 100644 --- a/lib/kernel/src/global_group.erl +++ b/lib/kernel/src/global_group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% Copyright Ericsson AB 1998-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. diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index eea78aabdf..8fa48d56fb 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -198,16 +198,11 @@ start_portprogram() -> end. get_heart_timeouts() -> - HeartOpts = case os:getenv("HEART_BEAT_TIMEOUT") of - false -> ""; - H when is_list(H) -> - "-ht " ++ H - end, - HeartOpts ++ case os:getenv("HEART_BEAT_BOOT_DELAY") of - false -> ""; - W when is_list(W) -> - " -wt " ++ W - end. + case os:getenv("HEART_BEAT_TIMEOUT") of + false -> ""; + H when is_list(H) -> + "-ht " ++ H + end. check_start_heart() -> case init:get_argument(heart) of diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl index 3084bd599a..8c8fe86811 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index f7ad9c0c04..23fe975ef7 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -421,7 +421,7 @@ halt_ro_alog(Conf) when is_list(Conf) -> halt_ro_alog_wait_notify(Log, T) -> Term = term_to_binary(T), receive - {disk_log, _, Log,{read_only, Term}} -> + {disk_log, _, Log,{read_only, [Term]}} -> ok; Other -> Other @@ -449,7 +449,7 @@ halt_ro_balog(Conf) when is_list(Conf) -> halt_ro_balog_wait_notify(Log, T) -> Term = list_to_binary(T), receive - {disk_log, _, Log,{read_only, Term}} -> + {disk_log, _, Log,{read_only, [Term]}} -> ok; Other -> Other @@ -1385,15 +1385,15 @@ blocked_notif(Conf) when is_list(Conf) -> "The requested operation" ++ _ = format_error(Error1), ok = disk_log:blog(n, B), ok = disk_log:alog(n, B), - rec(1, {disk_log, node(), n, {format_external, term_to_binary(B)}}), + rec(1, {disk_log, node(), n, {format_external, [term_to_binary(B)]}}), ok = disk_log:alog_terms(n, [B,B,B,B]), rec(1, {disk_log, node(), n, {format_external, lists:map(fun term_to_binary/1, [B,B,B,B])}}), ok = disk_log:block(n, false), ok = disk_log:alog(n, B), - rec(1, {disk_log, node(), n, {blocked_log, term_to_binary(B)}}), + rec(1, {disk_log, node(), n, {blocked_log, [term_to_binary(B)]}}), ok = disk_log:balog(n, B), - rec(1, {disk_log, node(), n, {blocked_log, list_to_binary(B)}}), + rec(1, {disk_log, node(), n, {blocked_log, [list_to_binary(B)]}}), ok = disk_log:balog_terms(n, [B,B,B,B]), disk_log:close(n), rec(1, {disk_log, node(), n, {blocked_log, @@ -4666,7 +4666,7 @@ other_groups(Conf) when is_list(Conf) -> ok. --define(MAX, 16384). % MAX in disk_log_1.erl +-define(MAX, ?MAX_FWRITE_CACHE). % as in disk_log_1.erl %% Evil cases such as closed file descriptor port. evil(Conf) when is_list(Conf) -> Dir = ?privdir(Conf), @@ -4690,7 +4690,7 @@ evil(Conf) when is_list(Conf) -> {size,?MAX+50},{format,external}]), [Fd] = erlang:ports() -- Ports0, {B,_} = x_mk_bytes(30), - ok = disk_log:blog(Log, <<0:(?MAX+1)/unit:8>>), + ok = disk_log:blog(Log, <<0:(?MAX-1)/unit:8>>), exit(Fd, kill), {error, {file_error,_,einval}} = disk_log:blog_terms(Log, [B,B]), ok= disk_log:close(Log), diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index d3b2d18ae5..8d2517e680 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 5.1 +KERNEL_VSN = 5.1.1 diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 46da79cfe3..9c73ab8072 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% Copyright Ericsson AB 2001-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. diff --git a/lib/megaco/test/megaco_app_test.erl b/lib/megaco/test/megaco_app_test.erl index 346a123c66..981d93f5dd 100644 --- a/lib/megaco/test/megaco_app_test.erl +++ b/lib/megaco/test/megaco_app_test.erl @@ -17,8 +17,6 @@ %% %% %CopyrightEnd% %% - -%% %%---------------------------------------------------------------------- %% Purpose: Verify the application specifics of the Megaco application %%---------------------------------------------------------------------- @@ -26,296 +24,26 @@ -compile(export_all). --include("megaco_test_lib.hrl"). - - -t() -> megaco_test_lib:t(?MODULE). -t(Case) -> megaco_test_lib:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(undef_funcs = Case, Config) -> - NewConfig = [{tc_timeout, ?MINUTES(10)} | Config], - megaco_test_lib:init_per_testcase(Case, NewConfig); -init_per_testcase(Case, Config) -> - megaco_test_lib:init_per_testcase(Case, Config). - -end_per_testcase(Case, Config) -> - megaco_test_lib:end_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-include_lib("common_test/include/ct.hrl"). +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- all() -> [ - fields, - modules, - exportall, - app_depend, - undef_funcs + app, + appup ]. -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - case is_app(megaco) of - {ok, AppFile} -> - io:format("AppFile: ~n~p~n", [AppFile]), - case megaco_flex_scanner:is_enabled() of - true -> - case megaco_flex_scanner:is_reentrant_enabled() of - true -> - io:format("~nMegaco reentrant flex scanner enabled~n~n", []); - false -> - io:format("~nMegaco non-reentrant flex scanner enabled~n~n", []) - end; - false -> - io:format("~nMegaco flex scanner disabled~n~n", []) - end, - megaco:print_version_info(), - [{app_file, AppFile}|Config]; - {error, Reason} -> - fail(Reason) - end. - -is_app(App) -> - LibDir = code:lib_dir(App), - File = filename:join([LibDir, "ebin", atom_to_list(App) ++ ".app"]), - case file:consult(File) of - {ok, [{application, App, AppFile}]} -> - {ok, AppFile}; - {error, {LineNo, Mod, Code}} -> - IoList = lists:concat([File, ":", LineNo, ": ", - Mod:format_error(Code)]), - {error, list_to_atom(lists:flatten(IoList))}; - Error -> - {error, {invalid_format, Error}} - end. - - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fields(suite) -> - []; -fields(doc) -> - []; -fields(Config) when is_list(Config) -> - AppFile = key1search(app_file, Config), - Fields = [vsn, description, modules, registered, applications], - case check_fields(Fields, AppFile, []) of - [] -> - ok; - Missing -> - fail({missing_fields, Missing}) - end. - -check_fields([], _AppFile, Missing) -> - Missing; -check_fields([Field|Fields], AppFile, Missing) -> - check_fields(Fields, AppFile, check_field(Field, AppFile, Missing)). - -check_field(Name, AppFile, Missing) -> - io:format("checking field: ~p~n", [Name]), - case lists:keymember(Name, 1, AppFile) of - true -> - Missing; - false -> - [Name|Missing] - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -modules(suite) -> - []; -modules(doc) -> - []; -modules(Config) when is_list(Config) -> - AppFile = key1search(app_file, Config), - Mods = key1search(modules, AppFile), - EbinList = get_ebin_mods(megaco), - case missing_modules(Mods, EbinList, []) of - [] -> - ok; - Missing -> - throw({error, {missing_modules, Missing}}) - end, - case extra_modules(Mods, EbinList, []) of - [] -> - ok; - Extra -> - throw({error, {extra_modules, Extra}}) - end, - {ok, Mods}. - -get_ebin_mods(App) -> - LibDir = code:lib_dir(App), - EbinDir = filename:join([LibDir,"ebin"]), - {ok, Files0} = file:list_dir(EbinDir), - Files1 = [lists:reverse(File) || File <- Files0], - [list_to_atom(lists:reverse(Name)) || [$m,$a,$e,$b,$.|Name] <- Files1]. - - -missing_modules([], _Ebins, Missing) -> - Missing; -missing_modules([Mod|Mods], Ebins, Missing) -> - case lists:member(Mod, Ebins) of - true -> - missing_modules(Mods, Ebins, Missing); - false -> - io:format("missing module: ~p~n", [Mod]), - missing_modules(Mods, Ebins, [Mod|Missing]) - end. - - -extra_modules(_Mods, [], Extra) -> - Extra; -extra_modules(Mods, [Mod|Ebins], Extra) -> - case lists:member(Mod, Mods) of - true -> - extra_modules(Mods, Ebins, Extra); - false -> - io:format("supefluous module: ~p~n", [Mod]), - extra_modules(Mods, Ebins, [Mod|Extra]) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -exportall(suite) -> - []; -exportall(doc) -> - []; -exportall(Config) when is_list(Config) -> - AppFile = key1search(app_file, Config), - Mods = key1search(modules, AppFile), - check_export_all(Mods). - - -check_export_all([]) -> - ok; -check_export_all([Mod|Mods]) -> - case (catch apply(Mod, module_info, [compile])) of - {'EXIT', {undef, _}} -> - check_export_all(Mods); - O -> - case lists:keysearch(options, 1, O) of - false -> - check_export_all(Mods); - {value, {options, List}} -> - case lists:member(export_all, List) of - true -> - throw({error, {export_all, Mod}}); - false -> - check_export_all(Mods) - end - end - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -app_depend(suite) -> - []; -app_depend(doc) -> - []; -app_depend(Config) when is_list(Config) -> - AppFile = key1search(app_file, Config), - Apps = key1search(applications, AppFile), - check_apps(Apps). - - -check_apps([]) -> - ok; -check_apps([App|Apps]) -> - case is_app(App) of - {ok, _} -> - check_apps(Apps); - Error -> - throw({error, {missing_app, {App, Error}}}) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -undef_funcs(suite) -> - []; -undef_funcs(doc) -> - []; -undef_funcs(Config) when is_list(Config) -> - App = megaco, - AppFile = key1search(app_file, Config), - Mods = key1search(modules, AppFile), - Root = code:root_dir(), - LibDir = code:lib_dir(App), - EbinDir = filename:join([LibDir,"ebin"]), - XRefTestName = undef_funcs_make_name(App, xref_test_name), - {ok, XRef} = xref:start(XRefTestName), - ok = xref:set_default(XRef, - [{verbose,false},{warnings,false}]), - XRefName = undef_funcs_make_name(App, xref_name), - {ok, XRefName} = xref:add_release(XRef, Root, {name,XRefName}), - {ok, App} = xref:replace_application(XRef, App, EbinDir), - {ok, Undefs} = xref:analyze(XRef, undefined_function_calls), - xref:stop(XRef), - analyze_undefined_function_calls(Undefs, Mods, []). - -analyze_undefined_function_calls([], _, []) -> - ok; -analyze_undefined_function_calls([], _, AppUndefs) -> - exit({suite_failed, {undefined_function_calls, AppUndefs}}); -analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs], - AppModules, AppUndefs) -> - %% Check that this module is our's - case lists:member(Mod,AppModules) of - true -> - {Calling,Called} = AppUndef, - {Mod1,Func1,Ar1} = Calling, - {Mod2,Func2,Ar2} = Called, - io:format("undefined function call: " - "~n ~w:~w/~w calls ~w:~w/~w~n", - [Mod1,Func1,Ar1,Mod2,Func2,Ar2]), - analyze_undefined_function_calls(Undefs, AppModules, - [AppUndef|AppUndefs]); - false -> - io:format("dropping ~p~n", [Mod]), - analyze_undefined_function_calls(Undefs, AppModules, AppUndefs) - end. - -%% This function is used simply to avoid cut-and-paste errors later... -undef_funcs_make_name(App, PostFix) -> - list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -fail(Reason) -> - exit({suite_failed, Reason}). - -key1search(Key, L) -> - case lists:keysearch(Key, 1, L) of - undefined -> - fail({not_found, Key, L}); - {value, {Key, Value}} -> - Value - end. +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +app() -> + [{doc, "Test that the megaco app file is ok"}]. +app(Config) when is_list(Config) -> + ok = test_server:app_test(megaco). +%%-------------------------------------------------------------------- +appup() -> + [{doc, "Test that the megaco appup file is ok"}]. +appup(Config) when is_list(Config) -> + ok = test_server:appup_test(megaco). diff --git a/lib/megaco/test/megaco_appup_test.erl b/lib/megaco/test/megaco_appup_test.erl index 325e7a6096..8dc3ad51a0 100644 --- a/lib/megaco/test/megaco_appup_test.erl +++ b/lib/megaco/test/megaco_appup_test.erl @@ -17,8 +17,6 @@ %% %% %CopyrightEnd% %% - -%% %%---------------------------------------------------------------------- %% Purpose: Verify the application specifics of the Megaco application %%---------------------------------------------------------------------- @@ -27,26 +25,18 @@ -compile(export_all). -compile({no_auto_import,[error/1]}). +-include_lib("common_test/include/ct.hrl"). -include("megaco_test_lib.hrl"). --define(APPLICATION, megaco). - -t() -> megaco_test_lib:t(?MODULE). -t(Case) -> megaco_test_lib:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - megaco_test_lib:init_per_testcase(Case, Config). - -end_per_testcase(Case, Config) -> - megaco_test_lib:end_per_testcase(Case, Config). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% all() -> - [appup]. + Cases = + [ + appup_file + ], + Cases. groups() -> []. @@ -64,16 +54,9 @@ end_per_group(_GroupName, Config) -> init_per_suite(suite) -> []; init_per_suite(doc) -> []; init_per_suite(Config) when is_list(Config) -> - AppFile = file_name(?APPLICATION, ".app"), - AppupFile = file_name(?APPLICATION, ".appup"), - [{app_file, AppFile}, {appup_file, AppupFile}|Config]. + Config. -file_name(App, Ext) -> - LibDir = code:lib_dir(App), - filename:join([LibDir, "ebin", atom_to_list(App) ++ Ext]). - - end_per_suite(suite) -> []; end_per_suite(doc) -> []; end_per_suite(Config) when is_list(Config) -> @@ -82,468 +65,17 @@ end_per_suite(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -appup(suite) -> - []; -appup(doc) -> - "perform a simple check of the appup file"; -appup(Config) when is_list(Config) -> - AppupFile = key1search(appup_file, Config), - AppFile = key1search(app_file, Config), - Modules = modules(AppFile), - check_appup(AppupFile, Modules). - -modules(File) -> - case file:consult(File) of - {ok, [{application,megaco,Info}]} -> - case lists:keysearch(modules,1,Info) of - {value, {modules, Modules}} -> - Modules; - false -> - fail({bad_appinfo, Info}) - end; - Error -> - fail({bad_appfile, Error}) - end. - - -check_appup(AppupFile, Modules) -> - case file:consult(AppupFile) of - {ok, [{V, UpFrom, DownTo}]} -> - check_appup(V, UpFrom, DownTo, Modules); - Else -> - fail({bad_appupfile, Else}) - end. - - -check_appup(V, UpFrom, DownTo, Modules) -> - check_version(V), - check_depends(up, UpFrom, Modules), - check_depends(down, DownTo, Modules), - check_module_subset(UpFrom), - check_module_subset(DownTo), - ok. - - -check_depends(_, [], _) -> - ok; -check_depends(UpDown, [Dep|Deps], Modules) -> - check_depend(UpDown, Dep, Modules), - check_depends(UpDown, Deps, Modules). - - -check_depend(up = UpDown, {add_application, ?APPLICATION} = Instr, Modules) -> - d("check_instructions(~w) -> entry with" - "~n Instruction: ~p" - "~n Modules: ~p", [UpDown, Instr, Modules]), - ok; -check_depend(down = UpDown, {remove_application, ?APPLICATION} = Instr, - Modules) -> - d("check_instructions(~w) -> entry with" - "~n Instruction: ~p" - "~n Modules: ~p", [UpDown, Instr, Modules]), - ok; -check_depend(UpDown, {V, Instructions}, Modules) -> - d("check_instructions(~w) -> entry with" - "~n V: ~p" - "~n Modules: ~p", [UpDown, V, Modules]), - check_version(V), - case check_instructions(UpDown, - Instructions, Instructions, [], [], Modules) of - {_Good, []} -> - ok; - {_, Bad} -> - fail({bad_instructions, Bad, UpDown}) - end. - - -check_instructions(_, [], _, Good, Bad, _) -> - {lists:reverse(Good), lists:reverse(Bad)}; -check_instructions(UpDown, [Instr|Instrs], AllInstr, Good, Bad, Modules) -> - d("check_instructions(~w) -> entry with" - "~n Instr: ~p", [UpDown,Instr]), - case (catch check_instruction(UpDown, Instr, AllInstr, Modules)) of - ok -> - check_instructions(UpDown, Instrs, AllInstr, - [Instr|Good], Bad, Modules); - {error, Reason} -> - d("check_instructions(~w) -> bad instruction: " - "~n Reason: ~p", [UpDown,Reason]), - check_instructions(UpDown, Instrs, AllInstr, Good, - [{Instr, Reason}|Bad], Modules) - end. - -%% A new module is added -check_instruction(up, {add_module, Module}, _, Modules) - when is_atom(Module) -> - d("check_instruction -> entry when up-add_module instruction with" - "~n Module: ~p", [Module]), - check_module(Module, Modules); - -%% An old module is re-added -check_instruction(down, {add_module, Module}, _, Modules) - when is_atom(Module) -> - d("check_instruction -> entry when down-add_module instruction with" - "~n Module: ~p", [Module]), - case (catch check_module(Module, Modules)) of - {error, {unknown_module, Module, Modules}} -> - ok; - ok -> - error({existing_readded_module, Module}) - end; - -%% Removing a module on upgrade: -%% - the module has been removed from the app-file. -%% - check that no module depends on this (removed) module -check_instruction(up, {remove, {Module, Pre, Post}}, _, Modules) - when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) -> - d("check_instruction -> entry when up-remove instruction with" - "~n Module: ~p" - "~n Pre: ~p" - "~n Post: ~p", [Module, Pre, Post]), - case (catch check_module(Module, Modules)) of - {error, {unknown_module, Module, Modules}} -> - check_purge(Pre), - check_purge(Post); - ok -> - error({existing_removed_module, Module}) - end; - -%% Removing a module on downgrade: the module exist -%% in the app-file. -check_instruction(down, {remove, {Module, Pre, Post}}, AllInstr, Modules) - when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) -> - d("check_instruction -> entry when down-remove instruction with" - "~n Module: ~p" - "~n Pre: ~p" - "~n Post: ~p", [Module, Pre, Post]), - case (catch check_module(Module, Modules)) of - ok -> - check_purge(Pre), - check_purge(Post), - check_no_remove_depends(Module, AllInstr); - {error, {unknown_module, Module, Modules}} -> - error({nonexisting_removed_module, Module}) - end; - -check_instruction(_, {load_module, Module, Pre, Post, Depend}, - AllInstr, Modules) - when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) andalso is_list(Depend) -> - d("check_instruction -> entry when load_module instruction with" - "~n Module: ~p" - "~n Pre: ~p" - "~n Post: ~p" - "~n Depend: ~p", [Module, Pre, Post, Depend]), - check_module(Module, Modules), - check_module_depend(Module, Depend, Modules), - check_module_depend(Module, Depend, updated_modules(AllInstr, [])), - check_purge(Pre), - check_purge(Post); - -check_instruction(_, {update, Module, Change, Pre, Post, Depend}, - AllInstr, Modules) - when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) andalso is_list(Depend) -> - d("check_instruction -> entry when update instruction with" - "~n Module: ~p" - "~n Change: ~p" - "~n Pre: ~p" - "~n Post: ~p" - "~n Depend: ~p", [Module, Change, Pre, Post, Depend]), - check_module(Module, Modules), - check_module_depend(Module, Depend, Modules), - check_module_depend(Module, Depend, updated_modules(AllInstr, [])), - check_change(Change), - check_purge(Pre), - check_purge(Post); - -check_instruction(_, {update, Module, supervisor}, _, Modules) - when is_atom(Module) -> - check_module(Module, Modules); - -check_instruction(_, {apply, {Module, Function, Args}}, _, Modules) - when is_atom(Module) andalso is_atom(Function) andalso is_list(Args) -> - d("check_instruction -> entry when down-apply instruction with" - "~n Module: ~p" - "~n Function: ~p" - "~n Args: ~p", [Module, Function, Args]), - check_module(Module, Modules), - check_apply(Module, Function, Args); - -check_instruction(_, {restart_application, ?APPLICATION}, _AllInstr, _Modules) -> - ok; - -check_instruction(_, Instr, _AllInstr, _Modules) -> - d("check_instruction -> entry when unknown instruction with" - "~n Instr: ~p", [Instr]), - error({error, {unknown_instruction, Instr}}). - - -%% If Module X depends on Module Y, then module Y must have an update -%% instruction of some sort (otherwise the depend is faulty). -updated_modules([], Modules) -> - d("update_modules -> entry when done with" - "~n Modules: ~p", [Modules]), - Modules; -updated_modules([Instr|Instrs], Modules) -> - d("update_modules -> entry with" - "~n Instr: ~p" - "~n Modules: ~p", [Instr,Modules]), - Module = instruction_module(Instr), - d("update_modules -> Module: ~p", [Module]), - updated_modules(Instrs, [Module|Modules]). - -instruction_module({add_module, Module}) -> - Module; -instruction_module({remove, {Module, _, _}}) -> - Module; -instruction_module({load_module, Module, _, _, _}) -> - Module; -instruction_module({update, Module, _, _, _, _}) -> - Module; -instruction_module({apply, {Module, _, _}}) -> - Module; -instruction_module(Instr) -> - d("instruction_module -> entry when unknown instruction with" - "~n Instr: ~p", [Instr]), - error({error, {unknown_instruction, Instr}}). - - -%% Check that the modules handled in an instruction set for version X -%% is a subset of the instruction set for version X-1. -check_module_subset(Instructions) -> - %% io:format("check_module_subset -> " - %% "~n Instructions: ~p" - %% "~n", [Instructions]), - do_check_module_subset(modules_of(Instructions)). - -do_check_module_subset([]) -> - ok; -do_check_module_subset([_]) -> - ok; -do_check_module_subset([{_V1, Mods1}|T]) -> - %% io:format("do_check_module_subset -> " - %% "~n V1: ~p" - %% "~n Mods1: ~p" - %% "~n T: ~p" - %% "~n", [_V1, Mods1, T]), - {V2, Mods2} = hd(T), - %% Check that the modules in V1 is a subset of V2 - case do_check_module_subset2(Mods1, Mods2) of - ok -> - do_check_module_subset(T); - {error, Modules} -> - fail({subset_missing_instructions, V2, Modules}) - end. - -do_check_module_subset2(Mods1, Mods2) -> - do_check_module_subset2(Mods1, Mods2, []). - -do_check_module_subset2([], _, []) -> - ok; -do_check_module_subset2([], _, Acc) -> - {error, lists:reverse(Acc)}; -do_check_module_subset2([Mod|Mods], Mods2, Acc) -> - case lists:member(Mod, Mods2) of - true -> - do_check_module_subset2(Mods, Mods2, Acc); - false -> - do_check_module_subset2(Mods, Mods2, [Mod|Acc]) - end. - - -modules_of(Instructions) -> - modules_of(Instructions, []). - -modules_of([], Acc) -> - lists:reverse(Acc); -modules_of([{V,Instructions}|T], Acc) -> - %% io:format("modules_of -> " - %% "~n V: ~p" - %% "~n Instructions: ~p" - %% "~n", [V, Instructions]), - case modules_of2(Instructions, []) of - Mods when is_list(Mods) -> - %% io:format("modules_of -> " - %% "~n Mods: ~p" - %% "~n", [Mods]), - modules_of(T, [{V, Mods}|Acc]); - skip -> - %% io:format("modules_of -> skip" - %% "~n", []), - modules_of(T, Acc) - end. - -modules_of2([], Acc) -> - lists:reverse(Acc); -modules_of2([Instr|Instructions], Acc) -> - case module_of(Instr) of - {value, Mod} -> - modules_of2(Instructions, [Mod|Acc]); - skip -> - skip; - false -> - modules_of2(Instructions, Acc) - end. - -module_of({add_module, Module}) -> - {value, Module}; -module_of({remove, {Module, _Pre, _Post}}) -> - {value, Module}; -module_of({load_module, Module, _Pre, _Post, _Depend}) -> - {value, Module}; -module_of({update, Module, _Change, _Pre, _Post, _Depend}) -> - {value, Module}; -module_of({restart_application, _App}) -> - skip; -module_of(_) -> - false. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% The version is a string consting of numbers separated by dots: "." -%% Example: "3.3.3" -%% -check_version(V) when is_list(V) -> - case do_check_version(string:tokens(V, [$.])) of - ok -> - ok; - {error, BadVersionPart} -> - throw({error, {bad_version, V, BadVersionPart}}) - end; -check_version(V) -> - error({bad_version, V}). - -do_check_version([]) -> - ok; -do_check_version([H|T]) -> - case (catch list_to_integer(H)) of - I when is_integer(I) -> - do_check_version(T); - _ -> - {error, H} - end. - -check_module(M, Modules) when is_atom(M) -> - case lists:member(M,Modules) of - true -> - ok; - false -> - error({unknown_module, M, Modules}) - end; -check_module(M, _) -> - error({bad_module, M}). - - -check_module_depend(M, [], _) when is_atom(M) -> - d("check_module_depend -> entry with" - "~n M: ~p", [M]), - ok; -check_module_depend(M, Deps, Modules) when is_atom(M) andalso is_list(Deps) -> - d("check_module_depend -> entry with" - "~n M: ~p" - "~n Deps: ~p" - "~n Modules: ~p", [M, Deps, Modules]), - case [Dep || Dep <- Deps, lists:member(Dep, Modules) == false] of - [] -> - ok; - Unknown -> - error({unknown_depend_modules, Unknown}) - end; -check_module_depend(_M, D, _Modules) -> - d("check_module_depend -> entry when bad depend with" - "~n D: ~p", [D]), - error({bad_depend, D}). - - -check_no_remove_depends(_Module, []) -> - ok; -check_no_remove_depends(Module, [Instr|Instrs]) -> - check_no_remove_depend(Module, Instr), - check_no_remove_depends(Module, Instrs). - -check_no_remove_depend(Module, {load_module, Mod, _Pre, _Post, Depend}) -> - case lists:member(Module, Depend) of - true -> - error({removed_module_in_depend, load_module, Mod, Module}); - false -> - ok - end; -check_no_remove_depend(Module, {update, Mod, _Change, _Pre, _Post, Depend}) -> - case lists:member(Module, Depend) of - true -> - error({removed_module_in_depend, update, Mod, Module}); - false -> - ok - end; -check_no_remove_depend(_, _) -> - ok. - - -check_change(soft) -> - ok; -check_change({advanced, _Something}) -> - ok; -check_change(Change) -> - error({bad_change, Change}). - - -check_purge(soft_purge) -> - ok; -check_purge(brutal_purge) -> - ok; -check_purge(Purge) -> - error({bad_purge, Purge}). - - -check_apply(Module, Function, Args) -> - case (catch Module:module_info()) of - Info when is_list(Info) -> - check_exported(Function, Args, Info); - {'EXIT', {undef, _}} -> - error({not_existing_module, Module}) - end. - -check_exported(Function, Args, Info) -> - case lists:keysearch(exports, 1, Info) of - {value, {exports, FuncList}} -> - Arity = length(Args), - Arities = [A || {F, A} <- FuncList, F == Function], - case lists:member(Arity, Arities) of - true -> - ok; - false -> - error({not_exported_function, Function, Arity}) - end; - _ -> - error({bad_export, Info}) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -error(Reason) -> - throw({error, Reason}). - -fail(Reason) -> - exit({suite_failed, Reason}). +%% Test server callbacks +init_per_testcase(_Case, Config) when is_list(Config) -> + Config. -key1search(Key, L) -> - case lists:keysearch(Key, 1, L) of - undefined -> - fail({not_found, Key, L}); - {value, {Key, Value}} -> - Value - end. +end_per_testcase(_Case, Config) when is_list(Config) -> + Config. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -d(F, A) -> - d(false, F, A). +%% Perform a simple check of the appup file +appup_file(Config) when is_list(Config) -> + ok = ?t:appup_test(megaco). -d(true, F, A) -> - io:format(F ++ "~n", A); -d(_, _, _) -> - ok. - - diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index b95cd66a81..0d40f863b2 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2015. All Rights Reserved. +# Copyright Ericsson AB 1997-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. diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index e621bd593c..51c98d0d3e 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -39,7 +39,39 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.14.1</title> + <section><title>Mnesia 4.14.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A continuation returned by mnesia:select/[14] should be + reusable in different, non-transactional activities.</p> + <p> + Own Id: OTP-13944 Aux Id: PR-1184 </p> + </item> + <item> + <p> + Fixed crash when calling block_table multiple times. + Could happen when having locks for a long time and + restarting mnesia.</p> + <p> + Own Id: OTP-13970 Aux Id: Seq-13198 </p> + </item> + <item> + <p> + Change mnesia_tm process to have off-heap messages since + mnesia_tm can be the receiver of many non-synchronized + message from other nodes.</p> + <p> + Own Id: OTP-14074</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.14.1</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 7b0e4976a0..6de7214776 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -2062,9 +2062,10 @@ any_table_info(Tab, Item) when is_atom(Tab) -> [] -> abort({no_exists, Tab, Item}); Props -> - lists:map(fun({setorbag, Type}) -> {type, Type}; - (Prop) -> Prop end, - Props) + Rename = fun ({setorbag, Type}) -> {type, Type}; + (Prop) -> Prop + end, + lists:sort(lists:map(Rename, Props)) end; name -> Tab; diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index 388b42cf15..305bf14bcf 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -80,6 +80,7 @@ start() -> init(Parent) -> register(?MODULE, self()), process_flag(trap_exit, true), + process_flag(message_queue_data, off_heap), %% Initialize the schema IgnoreFallback = mnesia_monitor:get_env(ignore_fallback_at_startup), diff --git a/lib/mnesia/test/ext_test.erl b/lib/mnesia/test/ext_test.erl index b7904c95ac..ad32245a11 100644 --- a/lib/mnesia/test/ext_test.erl +++ b/lib/mnesia/test/ext_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index f08e364276..439b21e58c 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.14.1 +MNESIA_VSN = 4.14.2 diff --git a/lib/observer/doc/src/notes.xml b/lib/observer/doc/src/notes.xml index 659eb28292..8f3ebcb4de 100644 --- a/lib/observer/doc/src/notes.xml +++ b/lib/observer/doc/src/notes.xml @@ -32,6 +32,60 @@ <p>This document describes the changes made to the Observer application.</p> +<section><title>Observer 2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The shell script (priv/bin/cdv) and bat file + (priv/bin/cdv.bat) which can be used for starting + crashdump_viewer both started a distributed erlang node. + This would cause any attempt at starting a second + instance of the crashdump_viewer to fail. To solve this + problem, cdv and cdv.bat now use non-distributed nodes + when starting the crashdump_viewer.</p> + <p> + Own Id: OTP-14010</p> + </item> + <item> + <p> + A bug caused the number of buckets to be shown in the + 'Objects' column, and the number of objects to be shown + in the 'Memory' column for ets table in crashdump_viewer. + This is now corrected.</p> + <p> + Own Id: OTP-14064</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add option <c>queue_size</c> to ttb:tracer/2. This sets + the maximum queue size for the IP trace driver which is + used when tracing to shell and/or <c>{local,File}</c>.</p> + <p> + The default value for <c>queue_size</c> is specified by + <c>dbg</c>, and it is now changed from 50 to 200.</p> + <p> + Own Id: OTP-13829 Aux Id: seq13171 </p> + </item> + <item> + <p> + The port information page is updated to show more + information per port.</p> + <p> + Own Id: OTP-13948 Aux Id: ERL-272 </p> + </item> + </list> + </section> + +</section> + <section><title>Observer 2.2.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/observer/priv/bin/cdv b/lib/observer/priv/bin/cdv index 1c44785ac2..d14fd47e41 100755 --- a/lib/observer/priv/bin/cdv +++ b/lib/observer/priv/bin/cdv @@ -1,4 +1,4 @@ #!/bin/sh -erl -sname cdv -noinput -s crashdump_viewer script_start $@ +erl -noinput -s crashdump_viewer script_start $@ diff --git a/lib/observer/priv/bin/cdv.bat b/lib/observer/priv/bin/cdv.bat index efa8bf8687..18136a30d6 100644 --- a/lib/observer/priv/bin/cdv.bat +++ b/lib/observer/priv/bin/cdv.bat @@ -1,2 +1,2 @@ @ECHO OFF -CALL werl -sname cdv -s crashdump_viewer script_start %* +CALL werl -s crashdump_viewer script_start %* diff --git a/lib/observer/priv/crashdump_viewer.tool b/lib/observer/priv/crashdump_viewer.tool deleted file mode 100644 index b6bd6bbdef..0000000000 --- a/lib/observer/priv/crashdump_viewer.tool +++ /dev/null @@ -1,2 +0,0 @@ -{version,"1.2"}. -[{config_func,{crashdump_viewer,configData,[]}}]. diff --git a/lib/observer/priv/crashdump_viewer/collapsd.gif b/lib/observer/priv/crashdump_viewer/collapsd.gif Binary files differdeleted file mode 100644 index 0b90c08a9a..0000000000 --- a/lib/observer/priv/crashdump_viewer/collapsd.gif +++ /dev/null diff --git a/lib/observer/priv/crashdump_viewer/exploded.gif b/lib/observer/priv/crashdump_viewer/exploded.gif Binary files differdeleted file mode 100644 index e3ab5ca2e9..0000000000 --- a/lib/observer/priv/crashdump_viewer/exploded.gif +++ /dev/null diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile index dd7831fa2b..ff2bcbdb99 100644 --- a/lib/observer/src/Makefile +++ b/lib/observer/src/Makefile @@ -92,7 +92,7 @@ EXAMPLE_FILES= multitrace.erl TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) PRIVDIR= ../priv -WEBTOOLFILES= $(PRIVDIR)/crashdump_viewer.tool $(PRIVDIR)/erlang_observer.png +PNGFILES= $(PRIVDIR)/erlang_observer.png BINDIR= $(PRIVDIR)/bin ifeq ($(findstring win32,$(TARGET)),win32) WIN32_EXECUTABLES= $(BINDIR)/etop.bat $(BINDIR)/cdv.bat @@ -103,10 +103,6 @@ EXECUTABLES= \ $(BINDIR)/etop \ $(BINDIR)/cdv \ $(WIN32_EXECUTABLES) -CDVDIR= $(PRIVDIR)/crashdump_viewer -GIF_FILES= \ - $(CDVDIR)/collapsd.gif \ - $(CDVDIR)/exploded.gif APP_FILE= observer.app @@ -163,9 +159,7 @@ release_spec: opt $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" $(INSTALL_DIR) "$(RELSYSDIR)/priv/bin" $(INSTALL_SCRIPT) $(EXECUTABLES) "$(RELSYSDIR)/priv/bin" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/crashdump_viewer" - $(INSTALL_DATA) $(WEBTOOLFILES) "$(RELSYSDIR)/priv" - $(INSTALL_DATA) $(GIF_FILES) "$(RELSYSDIR)/priv/crashdump_viewer" + $(INSTALL_DATA) $(PNGFILES) "$(RELSYSDIR)/priv" release_docs_spec: diff --git a/lib/observer/src/cdv_ets_cb.erl b/lib/observer/src/cdv_ets_cb.erl index 52a90b093b..ddd2d42df6 100644 --- a/lib/observer/src/cdv_ets_cb.erl +++ b/lib/observer/src/cdv_ets_cb.erl @@ -34,10 +34,8 @@ -define(COL_NAME, ?COL_ID+1). -define(COL_SLOT, ?COL_NAME+1). -define(COL_OWNER, ?COL_SLOT+1). --define(COL_BUCK, ?COL_OWNER+1). --define(COL_OBJ, ?COL_BUCK+1). +-define(COL_OBJ, ?COL_OWNER+1). -define(COL_MEM, ?COL_OBJ+1). --define(COL_TYPE, ?COL_MEM+1). %% Callbacks for cdv_virtual_list_wx col_to_elem(id) -> col_to_elem(?COL_ID); @@ -45,8 +43,6 @@ col_to_elem(?COL_ID) -> #ets_table.id; col_to_elem(?COL_NAME) -> #ets_table.name; col_to_elem(?COL_SLOT) -> #ets_table.slot; col_to_elem(?COL_OWNER) -> #ets_table.pid; -col_to_elem(?COL_TYPE) -> #ets_table.data_type; -col_to_elem(?COL_BUCK) -> #ets_table.buckets; col_to_elem(?COL_OBJ) -> #ets_table.size; col_to_elem(?COL_MEM) -> #ets_table.memory. @@ -57,7 +53,6 @@ col_spec() -> {"Owner", ?wxLIST_FORMAT_CENTRE, 120}, {"Objects", ?wxLIST_FORMAT_RIGHT, 80}, {"Memory", ?wxLIST_FORMAT_RIGHT, 80} -% {"Type", ?wxLIST_FORMAT_LEFT, 50} ]. get_info(Owner) -> diff --git a/lib/observer/src/cdv_mem_cb.erl b/lib/observer/src/cdv_mem_cb.erl index ba972d6963..abeddc7335 100644 --- a/lib/observer/src/cdv_mem_cb.erl +++ b/lib/observer/src/cdv_mem_cb.erl @@ -77,6 +77,10 @@ fix_alloc([{Title,Columns,Data}|Tables]) -> fix_alloc(Tables)]; fix_alloc([{Title,[{_,V}|_]=Data}|Tables]) -> fix_alloc([{Title,lists:duplicate(length(V),[]),Data}|Tables]); +fix_alloc([{"",[]}|Tables]) -> % no name and no data, probably truncated dump + fix_alloc(Tables); +fix_alloc([{Title,[]=Data}|Tables]) -> % no data, probably truncated dump + fix_alloc([{Title,[],Data}|Tables]); fix_alloc([]) -> []. diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl index 2587a6e64e..1e3fb6289e 100644 --- a/lib/observer/src/cdv_wx.erl +++ b/lib/observer/src/cdv_wx.erl @@ -17,7 +17,7 @@ %% %% %CopyrightEnd% -module(cdv_wx). --compile(export_all). + -behaviour(wx_object). -export([start/1]). diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index 9268dac180..13e73f027d 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -90,6 +90,7 @@ %% All possible tags - use macros in order to avoid misspelling in the code +-define(abort,abort). -define(allocated_areas,allocated_areas). -define(allocator,allocator). -define(atoms,atoms). @@ -321,8 +322,16 @@ handle_call(general_info,_From,State=#state{file=File}) -> NumAtoms = GenInfo#general_info.num_atoms, WS = parse_vsn_str(GenInfo#general_info.system_vsn,4), TW = case get(truncated) of - true -> ["WARNING: The crash dump is truncated. " - "Some information might be missing."]; + true -> + case get(truncated_reason) of + undefined -> + ["WARNING: The crash dump is truncated. " + "Some information might be missing."]; + Reason -> + ["WARNING: The crash dump is truncated " + "("++Reason++"). " + "Some information might be missing."] + end; false -> [] end, ets:insert(cdv_reg_proc_table, @@ -515,8 +524,15 @@ truncated_warning([Tag|Tags]) -> false -> truncated_warning(Tags) end. truncated_warning() -> - ["WARNING: The crash dump is truncated here. " - "Some information might be missing."]. + case get(truncated_reason) of + undefined -> + ["WARNING: The crash dump is truncated here. " + "Some information might be missing."]; + Reason -> + ["WARNING: The crash dump is truncated here " + "("++Reason++"). " + "Some information might be missing."] + end. truncated_here(Tag) -> case get(truncated) of @@ -692,6 +708,7 @@ val(Fd, NoExist) -> {eof,[]} -> NoExist; [] -> NoExist; {eof,Val} -> Val; + "=abort:"++_ -> NoExist; Val -> Val end. @@ -787,7 +804,7 @@ do_read_file(File) -> ?erl_crash_dump -> reset_index_table(), insert_index(Tag,Id,N1+1), - put(last_tag,{Tag,""}), + put_last_tag(Tag,""), indexify(Fd,Rest,N1), end_progress(), check_if_truncated(), @@ -831,7 +848,7 @@ indexify(Fd,Bin,N) -> <<_:Pos/binary,TagAndRest/binary>> = Bin, {Tag,Id,Rest,N1} = tag(Fd,TagAndRest,N+Pos), insert_index(Tag,Id,N1+1), % +1 to get past newline - put(last_tag,{Tag,Id}), + put_last_tag(Tag,Id), indexify(Fd,Rest,N1); nomatch -> case progress_read(Fd) of @@ -911,7 +928,10 @@ general_info(File) -> WholeLine -> WholeLine end, - GI = get_general_info(Fd,#general_info{created=Created}), + {Slogan,SysVsn} = get_slogan_and_sysvsn(Fd,[]), + GI = get_general_info(Fd,#general_info{created=Created, + slogan=Slogan, + system_vsn=SysVsn}), {MemTot,MemMax} = case lookup_index(?memory) of @@ -965,12 +985,20 @@ general_info(File) -> mem_max=MemMax, instr_info=InstrInfo}. +get_slogan_and_sysvsn(Fd,Acc) -> + case val(Fd,eof) of + "Slogan: " ++ SloganPart when Acc==[] -> + get_slogan_and_sysvsn(Fd,[SloganPart]); + "System version: " ++ SystemVsn -> + {lists:append(lists:reverse(Acc)),SystemVsn}; + eof -> + {lists:append(lists:reverse(Acc)),"-1"}; + SloganPart -> + get_slogan_and_sysvsn(Fd,[[$\n|SloganPart]|Acc]) + end. + get_general_info(Fd,GenInfo) -> case line_head(Fd) of - "Slogan" -> - get_general_info(Fd,GenInfo#general_info{slogan=val(Fd)}); - "System version" -> - get_general_info(Fd,GenInfo#general_info{system_vsn=val(Fd)}); "Compiled" -> get_general_info(Fd,GenInfo#general_info{compile_time=val(Fd)}); "Taints" -> @@ -1174,7 +1202,11 @@ parse_link_list("{from,"++Str,Links,Monitors,MonitoredBy) -> parse_link_list(", "++Rest,Links,Monitors,MonitoredBy) -> parse_link_list(Rest,Links,Monitors,MonitoredBy); parse_link_list([],Links,Monitors,MonitoredBy) -> - {lists:reverse(Links),lists:reverse(Monitors),lists:reverse(MonitoredBy)}. + {lists:reverse(Links),lists:reverse(Monitors),lists:reverse(MonitoredBy)}; +parse_link_list(Unexpected,Links,Monitors,MonitoredBy) -> + io:format("WARNING: found unexpected data in link list:~n~s~n",[Unexpected]), + parse_link_list([],Links,Monitors,MonitoredBy). + parse_port(Str) -> {Port,Rest} = parse_link(Str,[]), @@ -1813,16 +1845,16 @@ main_modinfo(_Fd,LM,_LineHead) -> all_modinfo(Fd,LM,LineHead) -> case LineHead of "Current attributes" -> - Str = hex_to_str(val(Fd)), + Str = hex_to_str(val(Fd,"")), LM#loaded_mod{current_attrib=Str}; "Current compilation info" -> - Str = hex_to_str(val(Fd)), + Str = hex_to_str(val(Fd,"")), LM#loaded_mod{current_comp_info=Str}; "Old attributes" -> - Str = hex_to_str(val(Fd)), + Str = hex_to_str(val(Fd,"")), LM#loaded_mod{old_attrib=Str}; "Old compilation info" -> - Str = hex_to_str(val(Fd)), + Str = hex_to_str(val(Fd,"")), LM#loaded_mod{old_comp_info=Str}; Other -> unexpected(Fd,Other,"loaded modules info"), @@ -1848,7 +1880,12 @@ hex_to_term([],Acc) -> Bin}; Term -> Term - end. + end; +hex_to_term(Rest,Acc) -> + {"WARNING: The term is probably truncated!", + "I can not convert hex to term.", + Rest,list_to_binary(lists:reverse(Acc))}. + hex_to_dec("F") -> 15; hex_to_dec("E") -> 14; @@ -2159,7 +2196,8 @@ sort_allocator_types([{Name,Data}|Allocators],Acc,DoTotal) -> Type = case string:tokens(Name,"[]") of [T,_Id] -> T; - [Name] -> Name + [Name] -> Name; + Other -> Other end, TypeData = proplists:get_value(Type,Acc,[]), {NewTypeData,NewDoTotal} = sort_type_data(Type,Data,TypeData,DoTotal), @@ -2686,6 +2724,7 @@ count_index(Tag) -> %%----------------------------------------------------------------- %% Convert tags read from crashdump to atoms used as first part of key %% in cdv_dump_index_table +tag_to_atom("abort") -> ?abort; tag_to_atom("allocated_areas") -> ?allocated_areas; tag_to_atom("allocator") -> ?allocator; tag_to_atom("atoms") -> ?atoms; @@ -2720,6 +2759,14 @@ tag_to_atom(UnknownTag) -> list_to_atom(UnknownTag). %%%----------------------------------------------------------------- +%%% Store last tag for use when truncated, and reason if aborted +put_last_tag(?abort,Reason) -> + %% Don't overwrite the real last tag + put(truncated_reason,Reason); +put_last_tag(Tag,Id) -> + put(last_tag,{Tag,Id}). + +%%%----------------------------------------------------------------- %%% Fetch next chunk from crashdump file lookup_and_parse_index(File,What,ParseFun,Str) when is_list(File) -> Indices = lookup_index(What), @@ -2815,7 +2862,16 @@ collect(Pids,Acc) -> update_progress(), collect(Pids,Acc); {'DOWN', _Ref, process, Pid, {pmap_done,Result}} -> - collect(lists:delete(Pid,Pids),[Result|Acc]) + collect(lists:delete(Pid,Pids),[Result|Acc]); + {'DOWN', _Ref, process, Pid, _Error} -> + Warning = + "WARNING: an error occured while parsing data.\n" ++ + case get(truncated) of + true -> "This might be because the dump is truncated.\n"; + false -> "" + end, + io:format(Warning), + collect(lists:delete(Pid,Pids),Acc) end. %%%----------------------------------------------------------------- diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl index fcb900960b..925f4456bb 100644 --- a/lib/observer/src/etop.erl +++ b/lib/observer/src/etop.erl @@ -23,7 +23,7 @@ -export([start/0, start/1, config/2, stop/0, dump/1, help/0]). %% Internal -export([update/1]). --export([loadinfo/1, meminfo/2, getopt/2]). +-export([loadinfo/2, meminfo/2, getopt/2]). -include("etop.hrl"). -include("etop_defs.hrl"). @@ -319,18 +319,18 @@ output(graphical) -> exit({deprecated, "Use observer instead"}); output(text) -> etop_txt. -loadinfo(SysI) -> +loadinfo(SysI,Prev) -> #etop_info{n_procs = Procs, run_queue = RQ, now = Now, wall_clock = WC, runtime = RT} = SysI, - Cpu = calculate_cpu_utilization(WC,RT), + Cpu = calculate_cpu_utilization(WC,RT,Prev#etop_info.runtime), Clock = io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w", tuple_to_list(element(2,calendar:now_to_datetime(Now)))), {Cpu,Procs,RQ,Clock}. -calculate_cpu_utilization({_,WC},{_,RT}) -> +calculate_cpu_utilization({_,WC},{_,RT},_) -> %% Old version of observer_backend, using statistics(wall_clock) %% and statistics(runtime) case {WC,RT} of @@ -341,15 +341,23 @@ calculate_cpu_utilization({_,WC},{_,RT}) -> _ -> round(100*RT/WC) end; -calculate_cpu_utilization(_,undefined) -> +calculate_cpu_utilization(_,undefined,_) -> %% First time collecting - no cpu utilization has been measured %% since scheduler_wall_time flag is not yet on 0; -calculate_cpu_utilization(_,RTInfo) -> +calculate_cpu_utilization(WC,RTInfo,undefined) -> + %% Second time collecting - RTInfo shows scheduler_wall_time since + %% flag was set to true. Faking previous values by setting + %% everything to zero. + ZeroRT = [{Id,0,0} || {Id,_,_} <- RTInfo], + calculate_cpu_utilization(WC,RTInfo,ZeroRT); +calculate_cpu_utilization(_,RTInfo,PrevRTInfo) -> %% New version of observer_backend, using statistics(scheduler_wall_time) - Sum = lists:foldl(fun({_,A,T},{AAcc,TAcc}) -> {A+AAcc,T+TAcc} end, + Sum = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}},{AAcc,TAcc}) -> + {(A1 - A0)+AAcc,(T1 - T0)+TAcc} + end, {0,0}, - RTInfo), + lists:zip(PrevRTInfo,RTInfo)), case Sum of {0,0} -> 0; diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl index 3b4c176478..6b8f9df24f 100644 --- a/lib/observer/src/etop_txt.erl +++ b/lib/observer/src/etop_txt.erl @@ -22,35 +22,35 @@ %%-compile(export_all). -export([init/1,stop/1]). --export([do_update/3]). +-export([do_update/4]). -include("etop.hrl"). -include("etop_defs.hrl"). --import(etop,[loadinfo/1,meminfo/2]). +-import(etop,[loadinfo/2,meminfo/2]). -define(PROCFORM,"~-15w~-20s~8w~8w~8w~8w ~-20s~n"). stop(Pid) -> Pid ! stop. init(Config) -> - loop(Config). + loop(#etop_info{},Config). -loop(Config) -> - Info = do_update(Config), +loop(Prev,Config) -> + Info = do_update(Prev,Config), receive stop -> stopped; - {dump,Fd} -> do_update(Fd,Info,Config), loop(Config); - {config,_,Config1} -> loop(Config1) - after Config#opts.intv -> loop(Config) + {dump,Fd} -> do_update(Fd,Info,Prev,Config), loop(Info,Config); + {config,_,Config1} -> loop(Info,Config1) + after Config#opts.intv -> loop(Info,Config) end. -do_update(Config) -> +do_update(Prev,Config) -> Info = etop:update(Config), - do_update(standard_io,Info,Config). + do_update(standard_io,Info,Prev,Config). -do_update(Fd,Info,Config) -> - {Cpu,NProcs,RQ,Clock} = loadinfo(Info), +do_update(Fd,Info,Prev,Config) -> + {Cpu,NProcs,RQ,Clock} = loadinfo(Info,Prev), io:nl(Fd), writedoubleline(Fd), case Info#etop_info.memi of diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index 77609b11ce..ca54080e15 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 7c1337025f..1eaba31a3a 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -25,7 +25,7 @@ wait_for_progress/0, report_progress/1, user_term/3, user_term_multiline/3, interval_dialog/4, start_timer/1, stop_timer/1, - display_info/2, fill_info/2, update_info/2, to_str/1, + display_info/2, display_info/3, fill_info/2, update_info/2, to_str/1, create_menus/3, create_menu_item/3, create_attrs/0, set_listctrl_col_size/2, @@ -124,6 +124,11 @@ display_info(Frame, Info) -> Panel = wxPanel:new(Frame), wxWindow:setBackgroundStyle(Panel, ?wxBG_STYLE_SYSTEM), Sizer = wxBoxSizer:new(?wxVERTICAL), + InfoFs = display_info(Panel, Sizer, Info), + wxWindow:setSizerAndFit(Panel, Sizer), + {Panel, Sizer, InfoFs}. + +display_info(Panel, Sizer, Info) -> wxSizer:addSpacer(Sizer, 5), Add = fun(BoxInfo) -> case create_box(Panel, BoxInfo) of @@ -136,9 +141,7 @@ display_info(Frame, Info) -> [] end end, - InfoFs = [Add(I) || I <- Info], - wxWindow:setSizerAndFit(Panel, Sizer), - {Panel, Sizer, InfoFs}. + [Add(I) || I <- Info]. fill_info([{dynamic, Key}|Rest], Data) when is_atom(Key); is_function(Key) -> @@ -254,6 +257,11 @@ to_str({func, {F,A}}) when is_atom(F), is_integer(A) -> lists:concat([F, "/", A]); to_str({func, {F,'_'}}) when is_atom(F) -> atom_to_list(F); +to_str({inet, Addr}) -> + case inet:ntoa(Addr) of + {error,einval} -> to_str(Addr); + AddrStr -> AddrStr + end; to_str({{format,Fun},Value}) when is_function(Fun) -> Fun(Value); to_str({A, B}) when is_atom(A), is_atom(B) -> @@ -453,14 +461,16 @@ create_box(Parent, Data) -> link_entry(Panel,Value); _ -> Value = to_str(Value0), - case length(Value) > 100 of - true -> - Shown = lists:sublist(Value, 80), + case string:sub_word(lists:sublist(Value, 80),1,$\n) of + Value -> + %% Short string, no newlines - show all + wxStaticText:new(Panel, ?wxID_ANY, Value); + Shown -> + %% Long or with newlines, + %% use tooltip to show all TCtrl = wxStaticText:new(Panel, ?wxID_ANY, [Shown,"..."]), wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)), - TCtrl; - false -> - wxStaticText:new(Panel, ?wxID_ANY, Value) + TCtrl end end, wxSizer:add(Line, 10, 0), % space of size 10 horisontally diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index 6a1aac92c7..b0ead42e3f 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -383,8 +383,8 @@ lmax(MState, Values, State) -> init_data(runq, {stats, _, T0, _, _}) -> {mk_max(),lists:sort(T0)}; init_data(io, {stats, _, _, {{_,In0}, {_,Out0}}, _}) -> {mk_max(), {In0,Out0}}; init_data(memory, _) -> {mk_max(), info(memory, undefined)}; -init_data(alloc, _) -> {mk_max(), ok}; -init_data(utilz, _) -> {mk_max(), ok}. +init_data(alloc, _) -> {mk_max(), unused}; +init_data(utilz, _) -> {mk_max(), unused}. info(runq, {stats, _, T0, _, _}) -> lists:seq(1, length(T0)); info(memory, _) -> [total, processes, atom, binary, code, ets]; @@ -410,11 +410,11 @@ collect_data(memory, {stats, _, _, _, MemInfo}, {Max, MemTypes}) -> collect_data(alloc, MemInfo, Max) -> Vs = [Carrier || {_Type,_Block,Carrier} <- MemInfo], Sample = list_to_tuple(Vs), - {Sample, lmax(Max, Vs, Sample)}; + {Sample, {lmax(Max, Vs, Sample),unused}}; collect_data(utilz, MemInfo, Max) -> Vs = [round(100*Block/Carrier) || {_Type,Block,Carrier} <- MemInfo], Sample = list_to_tuple(Vs), - {Sample, lmax(Max,Vs,Sample)}. + {Sample, {lmax(Max,Vs,Sample),unused}}. calc_delta([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> [100*(WN-WP) div (TN-TP)|calc_delta(Ss, Ps)]; diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl index 3b788642cc..53ba3fa607 100644 --- a/lib/observer/src/observer_port_wx.erl +++ b/lib/observer/src/observer_port_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2014. All Rights Reserved. +%% Copyright Ericsson AB 2011-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. @@ -52,7 +52,13 @@ slot, id_str, links, - monitors}). + monitors, + monitored_by, + parallelism, + locking, + queue_size, + memory, + inet}). -record(opt, {sort_key=2, sort_incr=true @@ -358,7 +364,13 @@ list_to_portrec(PL) -> links = proplists:get_value(links, PL, []), name = proplists:get_value(registered_name, PL, []), monitors = proplists:get_value(monitors, PL, []), - controls = proplists:get_value(name, PL)}. + monitored_by = proplists:get_value(monitored_by, PL, []), + controls = proplists:get_value(name, PL), + parallelism = proplists:get_value(parallelism, PL), + locking = proplists:get_value(locking, PL), + queue_size = proplists:get_value(queue_size, PL, 0), + memory = proplists:get_value(memory, PL, 0), + inet = proplists:get_value(inet, PL, [])}. portrec_to_list(#port{id = Id, slot = Slot, @@ -366,14 +378,26 @@ portrec_to_list(#port{id = Id, links = Links, name = Name, monitors = Monitors, - controls = Controls}) -> + monitored_by = MonitoredBy, + controls = Controls, + parallelism = Parallelism, + locking = Locking, + queue_size = QueueSize, + memory = Memory, + inet = Inet}) -> [{id,Id}, {slot,Slot}, {connected,Connected}, {links,Links}, {name,Name}, {monitors,Monitors}, - {controls,Controls}]. + {monitored_by,MonitoredBy}, + {controls,Controls}, + {parallelism,Parallelism}, + {locking,Locking}, + {queue_size,QueueSize}, + {memory,Memory} | + Inet]. display_port_info(Parent, PortRec, Opened) -> PortIdStr = PortRec#port.id_str, @@ -391,29 +415,86 @@ do_display_port_info(Parent0, PortRec) -> Title = "Port Info: " ++ PortRec#port.id_str, Frame = wxMiniFrame:new(Parent, ?wxID_ANY, Title, [{style, ?wxSYSTEM_MENU bor ?wxCAPTION - bor ?wxCLOSE_BOX bor ?wxRESIZE_BORDER}]), - + bor ?wxCLOSE_BOX bor ?wxRESIZE_BORDER}, + {size,{600,400}}]), + ScrolledWin = wxScrolledWindow:new(Frame,[{style,?wxHSCROLL bor ?wxVSCROLL}]), + wxScrolledWindow:enableScrolling(ScrolledWin,true,true), + wxScrolledWindow:setScrollbars(ScrolledWin,20,20,0,0), + Sizer = wxBoxSizer:new(?wxVERTICAL), + wxWindow:setSizer(ScrolledWin,Sizer), Port = portrec_to_list(PortRec), Fields0 = port_info_fields(Port), - {_FPanel, _Sizer, _UpFields} = observer_lib:display_info(Frame, Fields0), + _UpFields = observer_lib:display_info(ScrolledWin, Sizer, Fields0), wxFrame:center(Frame), wxFrame:connect(Frame, close_window, [{skip, true}]), wxFrame:show(Frame), Frame. -port_info_fields(Port) -> + +port_info_fields(Port0) -> + {InetStruct,Port} = inet_extra_fields(Port0), Struct = [{"Overview", - [{"Name", name}, + [{"Registered Name", name}, {"Connected", {click,connected}}, {"Slot", slot}, - {"Controls", controls}]}, + {"Controls", controls}, + {"Parallelism", parallelism}, + {"Locking", locking}, + {"Queue Size", {bytes,queue_size}}, + {"Memory", {bytes,memory}}]}, {scroll_boxes, [{"Links",1,{click,links}}, - {"Monitors",1,{click,filter_monitor_info()}}]}], + {"Monitors",1,{click,filter_monitor_info()}}, + {"Monitored by",1,{click,monitored_by}}]} | InetStruct], observer_lib:fill_info(Struct, Port). +inet_extra_fields(Port) -> + Statistics = proplists:get_value(statistics,Port,[]), + Options = proplists:get_value(options,Port,[]), + Struct = + case proplists:get_value(controls,Port) of + Inet when Inet=="tcp_inet"; Inet=="udp_inet"; Inet=="sctp_inet" -> + [{"Inet", + [{"Local Address", {inet,local_address}}, + {"Local Port Number", local_port}, + {"Remote Address", {inet,remote_address}}, + {"Remote Port Number", remote_port}]}, + {"Statistics", + [stat_name_and_unit(Key) || {Key,_} <- Statistics]}, + {"Options", + [{atom_to_list(Key),Key} || {Key,_} <- Options]}]; + _ -> + [] + end, + Port1 = lists:keydelete(statistics,1,Port), + Port2 = lists:keydelete(options,1,Port1), + {Struct,Port2 ++ Statistics ++ Options}. + +stat_name_and_unit(recv_avg) -> + {"Average package size received", {bytes,recv_avg}}; +stat_name_and_unit(recv_cnt) -> + {"Number of packets received", recv_cnt}; +stat_name_and_unit(recv_dvi) -> + {"Average packet size deviation received", {bytes,recv_dvi}}; +stat_name_and_unit(recv_max) -> + {"Largest packet received", {bytes,recv_max}}; +stat_name_and_unit(recv_oct) -> + {"Total received", {bytes,recv_oct}}; +stat_name_and_unit(send_avg) -> + {"Average packet size sent", {bytes, send_avg}}; +stat_name_and_unit(send_cnt) -> + {"Number of packets sent", send_cnt}; +stat_name_and_unit(send_max) -> + {"Largest packet sent", {bytes, send_max}}; +stat_name_and_unit(send_oct) -> + {"Total sent", {bytes, send_oct}}; +stat_name_and_unit(send_pend) -> + {"Data waiting to be sent from driver", {bytes,send_pend}}; +stat_name_and_unit(Key) -> + {atom_to_list(Key), Key}. + filter_monitor_info() -> fun(Data) -> Ms = proplists:get_value(monitors, Data), diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index ee6829b847..f07b9e295a 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -511,7 +511,13 @@ table_holder(#holder{info=Info, attrs=Attrs, table_holder(S0); {dump, Fd} -> EtopInfo = (S0#holder.etop)#etop_info{procinfo=array:to_list(Info)}, - etop_txt:do_update(Fd, EtopInfo, #opts{node=Node}), + %% The empty #etop_info{} below is a dummy previous info + %% value. It is used by etop to calculate the scheduler + %% utilization since last update. When dumping to file, + %% there is no previous measurement to use, so we just add + %% a dummy here, and the value shown will be since the + %% tool was started. + etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}), file:close(Fd), table_holder(S0); stop -> diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 620979dcc9..c13b164ff9 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -434,7 +434,7 @@ get_gc_info(Arg) -> filter_monitor_info() -> fun(Data) -> Ms = proplists:get_value(monitors, Data), - [Pid || {process, Pid} <- Ms] + [Id || {_Type, Id} <- Ms] % Type is process or port end. stringify_bins(Data) -> diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 1947341ebe..1fd94ffb3c 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -423,6 +423,10 @@ special(File,Procs) -> %% ".trunc" -> %% %% ???? %% ok; + ".trunc.bytes" -> + {ok,_,[TW]} = crashdump_viewer:general_info(), + {match,_} = re:run(TW,"CRASH DUMP SIZE LIMIT REACHED"), + ok; _ -> ok end, @@ -484,7 +488,11 @@ do_create_dumps(DataDir,Rel) -> current -> CD3 = dump_with_args(DataDir,Rel,"instr","+Mim true"), CD4 = dump_with_strange_module_name(DataDir,Rel,"strangemodname"), - {[CD1,CD2,CD3,CD4], DosDump}; + Bytes = rand:uniform(300000) + 100, + CD5 = dump_with_args(DataDir,Rel,"trunc.bytes", + "-env ERL_CRASH_DUMP_BYTES " ++ + integer_to_list(Bytes)), + {[CD1,CD2,CD3,CD4,CD5], DosDump}; _ -> {[CD1,CD2], DosDump} end. diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk index 444089151e..dd23b08484 100644 --- a/lib/observer/vsn.mk +++ b/lib/observer/vsn.mk @@ -1 +1 @@ -OBSERVER_VSN = 2.2.2 +OBSERVER_VSN = 2.3 diff --git a/lib/odbc/doc/src/notes.xml b/lib/odbc/doc/src/notes.xml index 7fb19a072e..cc25a21c74 100644 --- a/lib/odbc/doc/src/notes.xml +++ b/lib/odbc/doc/src/notes.xml @@ -32,7 +32,28 @@ <p>This document describes the changes made to the odbc application. </p> - <section><title>ODBC 2.11.3</title> + <section><title>ODBC 2.12</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Change configure to skip odbc for old MACs, the change in + PR-1227 is not backwards compatible with old MACs, and we + do not see a need to continue support for such old + versions. However it is still possible to make it work on + such machines using the --with-odbc configure option.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-14083</p> + </item> + </list> + </section> + +</section> + +<section><title>ODBC 2.11.3</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index a7c8f8079b..2e313570e1 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.11.3 +ODBC_VSN = 2.12 diff --git a/lib/os_mon/src/Makefile b/lib/os_mon/src/Makefile index 3ff63204c6..fc2eb22393 100644 --- a/lib/os_mon/src/Makefile +++ b/lib/os_mon/src/Makefile @@ -60,7 +60,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard -I$(INCLUDE) -Werror +ERL_COMPILE_FLAGS += -I$(INCLUDE) -Werror # ---------------------------------------------------- # Targets diff --git a/lib/otp_mibs/src/Makefile b/lib/otp_mibs/src/Makefile index 4023f50d48..5c7af39c3f 100644 --- a/lib/otp_mibs/src/Makefile +++ b/lib/otp_mibs/src/Makefile @@ -64,7 +64,7 @@ TARGETS = $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -I$(INCLUDE) +warn_obsolete_guard +ERL_COMPILE_FLAGS += -I$(INCLUDE) # ---------------------------------------------------- # Targets diff --git a/lib/parsetools/doc/src/notes.xml b/lib/parsetools/doc/src/notes.xml index 30a9374e81..5a16445577 100644 --- a/lib/parsetools/doc/src/notes.xml +++ b/lib/parsetools/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <p>This document describes the changes made to the Parsetools application.</p> +<section><title>Parsetools 2.1.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Correct counting of newlines when rules with newlines + are used in Leex. </p> + <p> + Own Id: OTP-13916 Aux Id: ERL-263 </p> + </item> + <item> + <p> Correct handling of Unicode in Leex. </p> + <p> + Own Id: OTP-13919</p> + </item> + </list> + </section> + +</section> + <section><title>Parsetools 2.1.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/parsetools/src/Makefile b/lib/parsetools/src/Makefile index dea29bee4c..ba206904ec 100644 --- a/lib/parsetools/src/Makefile +++ b/lib/parsetools/src/Makefile @@ -59,7 +59,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard -I$(ERL_TOP)/lib/stdlib/include \ +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/stdlib/include \ -Werror # ---------------------------------------------------- diff --git a/lib/parsetools/vsn.mk b/lib/parsetools/vsn.mk index 07cd959c98..d102c63730 100644 --- a/lib/parsetools/vsn.mk +++ b/lib/parsetools/vsn.mk @@ -1 +1 @@ -PARSETOOLS_VSN = 2.1.3 +PARSETOOLS_VSN = 2.1.4 diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index c4d930c01f..74d1a57936 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -35,6 +35,23 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 1.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + New function + <c>public_key:ssh_hostkey_fingerprint/1,2</c> to + calculate the SSH host key fingerprint string.</p> + <p> + Own Id: OTP-13888 Aux Id: OTP-13887 </p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 1.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index edebfe0f84..c503230d70 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2008</year> - <year>2015</year> + <year>2016</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index fed3b09f36..3d6238d998 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. @@ -1029,19 +1029,16 @@ do_pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, Revo end. sort_dp_crls(DpsAndCrls, FreshCB) -> - Sorted = do_sort_dp_crls(DpsAndCrls, dict:new()), - sort_crls(Sorted, FreshCB, []). - -do_sort_dp_crls([], Dict) -> - dict:to_list(Dict); -do_sort_dp_crls([{DP, CRL} | Rest], Dict0) -> - Dict = try dict:fetch(DP, Dict0) of - _ -> - dict:append(DP, CRL, Dict0) - catch _:_ -> - dict:store(DP, [CRL], Dict0) - end, - do_sort_dp_crls(Rest, Dict). + sort_crls(maps:to_list(lists:foldl(fun group_dp_crls/2, + #{}, + DpsAndCrls)), + FreshCB, []). + +group_dp_crls({DP,CRL}, M) -> + case M of + #{DP := CRLs} -> M#{DP := [CRL|CRLs]}; + _ -> M#{DP => [CRL]} + end. sort_crls([], _, Acc) -> Acc; diff --git a/lib/public_key/test/public_key.cover b/lib/public_key/test/public_key.cover index ec00814578..6c46492bec 100644 --- a/lib/public_key/test/public_key.cover +++ b/lib/public_key/test/public_key.cover @@ -1,4 +1,4 @@ {incl_app,public_key,details}. -{excl_mods, public_key, ['OTP-PUB-KEY']}. +{excl_mods, public_key, ['OTP-PUB-KEY', 'PKCS-FRAME']}. diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index 84f6a659b5..2f541d8d84 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 1.2 +PUBLIC_KEY_VSN = 1.3 diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml index f735d914ea..83eee6017a 100644 --- a/lib/reltool/doc/src/reltool_examples.xml +++ b/lib/reltool/doc/src/reltool_examples.xml @@ -277,7 +277,7 @@ Eshell V5.7.3 (abort with ^G) disk_log_sup,dist_ac,dist_util,erl_boot_server|...]}, {path,["$ROOT/lib/stdlib-1.16/ebin"]}, {primLoad,[array,base64,beam_lib,c,calendar,dets, - dets_server,dets_sup,dets_utils,dets_v8,dets_v9,dict|...]}, + dets_server,dets_sup,dets_utils,dets_v9,dict|...]}, {path,["$ROOT/lib/sasl-2.1.6/ebin"]}, {primLoad,[alarm_handler,erlsrv,format_lib_supp,misc_supp, overload,rb,rb_format_supp,release_handler, diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl index 89b5f3a997..3b1e868757 100644 --- a/lib/reltool/src/reltool.hrl +++ b/lib/reltool/src/reltool.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2015. All Rights Reserved. +%% Copyright Ericsson AB 2009-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. diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml index 0b830593b4..4c79a560ec 100644 --- a/lib/runtime_tools/doc/src/notes.xml +++ b/lib/runtime_tools/doc/src/notes.xml @@ -32,6 +32,33 @@ <p>This document describes the changes made to the Runtime_Tools application.</p> +<section><title>Runtime_Tools 1.11</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add option <c>queue_size</c> to ttb:tracer/2. This sets + the maximum queue size for the IP trace driver which is + used when tracing to shell and/or <c>{local,File}</c>.</p> + <p> + The default value for <c>queue_size</c> is specified by + <c>dbg</c>, and it is now changed from 50 to 200.</p> + <p> + Own Id: OTP-13829 Aux Id: seq13171 </p> + </item> + <item> + <p> + The port information page is updated to show more + information per port.</p> + <p> + Own Id: OTP-13948 Aux Id: ERL-272 </p> + </item> + </list> + </section> + +</section> + <section><title>Runtime_Tools 1.10.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl index 4db5dbec91..0d9b2690e5 100644 --- a/lib/runtime_tools/src/msacc.erl +++ b/lib/runtime_tools/src/msacc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014-2015. All Rights Reserved. +%% Copyright Ericsson AB 2014-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. diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index cedb677178..b27bc63d15 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -141,14 +141,59 @@ get_mnesia_loop(Parent, {Match, Cont}) -> get_mnesia_loop(Parent, mnesia:select(Cont)). get_port_list() -> + ExtraItems = [monitors,monitored_by,parallelism,locking,queue_size,memory], [begin [{port_id,P}|erlang:port_info(P)] ++ - case erlang:port_info(P,monitors) of - undefined -> []; - Monitors -> [Monitors] - end + port_info(P,ExtraItems) ++ + inet_port_extra(erlang:port_info(P, name), P) end || P <- erlang:ports()]. +port_info(P,[Item|Items]) -> + case erlang:port_info(P,Item) of + undefined -> port_info(P,Items); + Value -> [Value|port_info(P,Items)] + end; +port_info(_,[]) -> + []. + +inet_port_extra({_,Type},Port) when Type =:= "udp_inet"; + Type =:= "tcp_inet"; + Type =:= "sctp_inet" -> + Data = + case inet:getstat(Port) of + {ok, Stats} -> [{statistics, Stats}]; + _ -> [] + end ++ + case inet:peername(Port) of + {ok, {RAddr,RPort}} when is_tuple(RAddr), is_integer(RPort) -> + [{remote_address,RAddr},{remote_port,RPort}]; + {ok, RAddr} -> + [{remote_address,RAddr}]; + {error, _} -> [] + end ++ + case inet:sockname(Port) of + {ok, {LAddr,LPort}} when is_tuple(LAddr), is_integer(LPort) -> + [{local_address,LAddr},{local_port,LPort}]; + {ok, LAddr} -> + [{local_address,LAddr}]; + {error, _} -> [] + end ++ + case inet:getopts(Port, + [active, broadcast, buffer, delay_send, + deliver, dontroute, exit_on_close, + header, high_msgq_watermark, high_watermark, + ipv6_v6only, keepalive, linger, low_msgq_watermark, + low_watermark, mode, netns, nodelay, packet, + packet_size, priority, read_packets, recbuf, + reuseaddr, send_timeout, send_timeout_close, + show_econnreset, sndbuf, tos, tclass]) of + {ok, Opts} -> [{options, Opts}]; + {error, _} -> [] + end, + [{inet,Data}]; +inet_port_extra(_,_) -> + []. + get_table_list(ets, Opts) -> HideUnread = proplists:get_value(unread_hidden, Opts, true), HideSys = proplists:get_value(sys_hidden, Opts, true), @@ -269,13 +314,12 @@ etop_collect(Collector) -> case SchedulerWallTime of undefined -> - spawn(fun() -> flag_holder_proc(Collector) end), + erlang:system_flag(scheduler_wall_time,true), + spawn(fun() -> flag_holder_proc(Collector) end), ok; _ -> ok - end, - - erlang:system_flag(scheduler_wall_time,true). + end. flag_holder_proc(Collector) -> Ref = erlang:monitor(process,Collector), diff --git a/lib/runtime_tools/test/dbg_SUITE_data/dbg_SUITE.c b/lib/runtime_tools/test/dbg_SUITE_data/dbg_SUITE.c index ad90af4da0..e402791607 100644 --- a/lib/runtime_tools/test/dbg_SUITE_data/dbg_SUITE.c +++ b/lib/runtime_tools/test/dbg_SUITE_data/dbg_SUITE.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-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. diff --git a/lib/runtime_tools/test/system_information_SUITE_data/information_test_report.dat b/lib/runtime_tools/test/system_information_SUITE_data/information_test_report.dat index bdc510e838..a0e3806981 100644 --- a/lib/runtime_tools/test/system_information_SUITE_data/information_test_report.dat +++ b/lib/runtime_tools/test/system_information_SUITE_data/information_test_report.dat @@ -447,11 +447,6 @@ {native,false}, {compiler,"4.9.1"}, {md5,"a64e0220f855e6e97d53a9bc4f0a111b"}]}, - {dets_v8, - [{loaded,false}, - {native,false}, - {compiler,"4.9.1"}, - {md5,"ebf2c94f62d180c3159b663ba2094189"}]}, {dets_v9, [{loaded,false}, {native,false}, diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index 0fc86e42f7..53fc51c198 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.10.1 +RUNTIME_TOOLS_VSN = 1.11 diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml index 055d433524..190b937f03 100644 --- a/lib/sasl/doc/src/notes.xml +++ b/lib/sasl/doc/src/notes.xml @@ -31,6 +31,24 @@ </header> <p>This document describes the changes made to the SASL application.</p> +<section><title>SASL 3.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + <c>code:add_pathsa/1</c> and command line option + <c>-pa</c> both revert the given list of directories when + adding it at the beginning of the code path. This is now + documented.</p> + <p> + Own Id: OTP-13920 Aux Id: ERL-267 </p> + </item> + </list> + </section> + +</section> + <section><title>SASL 3.0.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index 10d2539b7f..7093158502 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2015. All Rights Reserved. +%% Copyright Ericsson AB 2011-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. diff --git a/lib/sasl/test/release_handler_SUITE_data/start b/lib/sasl/test/release_handler_SUITE_data/start index 87275045b1..eab2b77aed 100755 --- a/lib/sasl/test/release_handler_SUITE_data/start +++ b/lib/sasl/test/release_handler_SUITE_data/start @@ -21,8 +21,7 @@ then fi HEART_COMMAND=$ROOTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND +export HEART_COMMAND START_ERL_DATA=${1:-$RELDIR/start_erl.data} diff --git a/lib/sasl/test/release_handler_SUITE_data/start_client b/lib/sasl/test/release_handler_SUITE_data/start_client index 5ea94d6f7c..05d744f06e 100755 --- a/lib/sasl/test/release_handler_SUITE_data/start_client +++ b/lib/sasl/test/release_handler_SUITE_data/start_client @@ -24,8 +24,7 @@ RELDIR=$CLIENTDIR/releases # Note that this scripts is modified an copied to $CLIENTDIR/bin/start # in release_handler_SUITE:copy_client - therefore HEART_COMMAND is as follows: HEART_COMMAND=$CLIENTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND +export HEART_COMMAND START_ERL_DATA=${1:-$RELDIR/start_erl.data} diff --git a/lib/sasl/vsn.mk b/lib/sasl/vsn.mk index a7d7c09cde..e35a0c2977 100644 --- a/lib/sasl/vsn.mk +++ b/lib/sasl/vsn.mk @@ -1 +1 @@ -SASL_VSN = 3.0.1 +SASL_VSN = 3.0.2 diff --git a/lib/snmp/src/app/snmp.app.src b/lib/snmp/src/app/snmp.app.src index d25f66f44a..d4bf0de61a 100644 --- a/lib/snmp/src/app/snmp.app.src +++ b/lib/snmp/src/app/snmp.app.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index ca61782639..db09ec3dc5 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -8,6 +8,10 @@ %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ + {<<"5\\.2\\.4">>, + [{load_module, snmp, soft_purge, soft_purge, []}, + {load_module, snmpc_lib, soft_purge, soft_purge, []}, + {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ], @@ -17,6 +21,10 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ + {<<"5\\.2\\.4">>, + [{load_module, snmp, soft_purge, soft_purge, []}, + {load_module, snmpc_lib, soft_purge, soft_purge, []}, + {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ] diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl index df3933ea01..8a736f688b 100644 --- a/lib/snmp/src/app/snmp.erl +++ b/lib/snmp/src/app/snmp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. 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. @@ -573,9 +573,16 @@ print_mod_info(Prefix, {Module, Info}) -> CompDate = case key1search(compile_time, Info) of {value, {Year, Month, Day, Hour, Min, Sec}} -> - lists:flatten( - io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", - [Year, Month, Day, Hour, Min, Sec])); + io_lib:format( + "~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", + [Year, Month, Day, Hour, Min, Sec]); + _ -> + "Not found" + end, + Digest = + case key1search(md5, Info) of + {value, MD5} when is_binary(MD5) -> + [io_lib:format("~2.16.0b", [Byte]) || <<Byte>> <= MD5]; _ -> "Not found" end, @@ -583,12 +590,14 @@ print_mod_info(Prefix, {Module, Info}) -> "~s Vsn: ~s~n" "~s App vsn: ~s~n" "~s Compiler ver: ~s~n" - "~s Compile time: ~s~n", + "~s Compile time: ~s~n" + "~s MD5 digest: ~s~n", [Prefix, Module, Prefix, Vsn, Prefix, AppVsn, - Prefix, CompVer, - Prefix, CompDate]), + Prefix, CompVer, + Prefix, CompDate, + Prefix, Digest]), ok. key1search(Key, Vals) -> @@ -617,7 +626,7 @@ versions1() -> Error -> Error end. - + versions2() -> case ms2() of {ok, Mods} -> @@ -625,25 +634,56 @@ versions2() -> Error -> Error end. - + version_info(Mods) -> SysInfo = sys_info(), OsInfo = os_info(), ModInfo = [mod_version_info(Mod) || Mod <- Mods], [{sys_info, SysInfo}, {os_info, OsInfo}, {mod_info, ModInfo}]. - + mod_version_info(Mod) -> Info = Mod:module_info(), - {value, {attributes, Attr}} = lists:keysearch(attributes, 1, Info), - {value, {vsn, [Vsn]}} = lists:keysearch(vsn, 1, Attr), - {value, {app_vsn, AppVsn}} = lists:keysearch(app_vsn, 1, Attr), - {value, {compile, Comp}} = lists:keysearch(compile, 1, Info), - {value, {version, Ver}} = lists:keysearch(version, 1, Comp), - {value, {time, Time}} = lists:keysearch(time, 1, Comp), - {Mod, [{vsn, Vsn}, - {app_vsn, AppVsn}, - {compiler_version, Ver}, - {compile_time, Time}]}. + {Mod, + case key1search(attributes, Info) of + {value, Attr} -> + case key1search(vsn, Attr) of + {value, [Vsn]} -> + [{vsn, Vsn}]; + not_found -> + [] + end ++ + case key1search(app_vsn, Attr) of + {value, AppVsn} -> + [{app_vsn, AppVsn}]; + not_found -> + [] + end; + not_found -> + [] + end ++ + case key1search(compile, Info) of + {value, Comp} -> + case key1search(version, Comp) of + {value, Ver} -> + [{compiler_version, Ver}]; + not_found -> + [] + end ++ + case key1search(time, Comp) of + {value, Ver} -> + [{compile_time, Ver}]; + not_found -> + [] + end; + not_found -> + [] + end ++ + case key1search(md5, Info) of + {value, Bin} -> + [{md5, Bin}]; + not_found -> + [] + end}. sys_info() -> SysArch = string:strip(erlang:system_info(system_architecture),right,$\n), diff --git a/lib/snmp/src/compile/snmpc.erl b/lib/snmp/src/compile/snmpc.erl index d86692aaf6..416353508e 100644 --- a/lib/snmp/src/compile/snmpc.erl +++ b/lib/snmp/src/compile/snmpc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl index 51690b6e7e..33ddd78308 100644 --- a/lib/snmp/src/compile/snmpc_lib.erl +++ b/lib/snmp/src/compile/snmpc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. 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. @@ -99,7 +99,7 @@ make_ASN1type({{type_with_size,Type,{range,Lo,Hi}},Line}) -> print_error("Undefined type '~w'",[Type],Line), guess_string_type() end; -make_ASN1type({{integer_with_enum,Type,Enums},Line}) -> +make_ASN1type({{type_with_enum,Type,Enums},Line}) -> case lookup_vartype(Type) of {value,ASN1type} -> ASN1type#asn1_type{assocList = [{enums, Enums}]}; false -> diff --git a/lib/snmp/src/compile/snmpc_mib_gram.yrl b/lib/snmp/src/compile/snmpc_mib_gram.yrl index 743c3a6550..14a668127e 100644 --- a/lib/snmp/src/compile/snmpc_mib_gram.yrl +++ b/lib/snmp/src/compile/snmpc_mib_gram.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. 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. @@ -387,10 +387,12 @@ syntax -> type : {{type, cat('$1')},line_of('$1')}. syntax -> type size : {{type_with_size, cat('$1'), '$2'},line_of('$1')}. syntax -> usertype size : {{type_with_size,val('$1'), '$2'},line_of('$1')}. syntax -> 'INTEGER' '{' namedbits '}' : - {{integer_with_enum, 'INTEGER', '$3'}, line_of('$1')}. + {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}. syntax -> 'BITS' '{' namedbits '}' : ensure_ver(2,'$1'), {{bits, '$3'}, line_of('$1')}. +syntax -> usertype '{' namedbits '}' : + {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}. syntax -> 'SEQUENCE' 'OF' usertype : {{sequence_of,val('$3')},line_of('$1')}. diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 2c8851c2a7..9b3c2bfd2c 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-2017. 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. @@ -56,7 +56,8 @@ otp_8574/1, otp_8595/1, otp_10799/1, - otp_10808/1 + otp_10808/1, + otp_14145/1 ]). @@ -135,7 +136,8 @@ all() -> ]. groups() -> - [{tickets, [], [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808]}]. + [{tickets, [], + [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808, otp_14145]}]. init_per_group(_GroupName, Config) -> Config. @@ -431,6 +433,30 @@ otp_10808(Config) when is_list(Config) -> %%====================================================================== +otp_14145(suite) -> + []; +otp_14145(Config) when is_list(Config) -> + put(tname, otp10808), + p("starting with Config: ~p~n", [Config]), + + Dir = ?config(case_top_dir, Config), + MibDir = ?config(mib_dir, Config), + MibName = "OTP14145-MIB", + MibFile = join(MibDir, MibName++".mib"), + ?line {ok, MibBin} = + snmpc:compile(MibFile, [{outdir, Dir}, + {verbosity, trace}, + {group_check, false}, + module_compliance]), + p("Mib: ~n~p~n", [MibBin]), + MIB = read_mib(MibBin), + Oid = [1,3,6,1,2,1,67,4], + check_mib(MIB#mib.mes, Oid, undefined), + ok. + + +%%====================================================================== + augments_extra_info(suite) -> []; augments_extra_info(Config) when is_list(Config) -> diff --git a/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib new file mode 100644 index 0000000000..f29c65c4c2 --- /dev/null +++ b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib @@ -0,0 +1,44 @@ +OTP14145-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, + mib-2 FROM SNMPv2-SMI + InetAddressType, InetAddress FROM INET-ADDRESS-MIB + MODULE-COMPLIANCE, OBJECT-GROUP FROM SNMPv2-CONF; + +testMibId MODULE-IDENTITY + LAST-UPDATED "200608210000Z" -- 21 August 2006 + ORGANIZATION "a" + CONTACT-INFO "a" + DESCRIPTION "a" + REVISION "200608210000Z" -- 21 August 2006 + DESCRIPTION "a" + ::= { mib-2 67 } + +testObj OBJECT-TYPE + SYNTAX InetAddressType + -- SYNTAX InetAddress + MAX-ACCESS read-only + STATUS current + DESCRIPTION "a" + ::= { testMibId 2 } + +testObjId OBJECT IDENTIFIER ::= { testMibId 3 } + +testMibCompliance MODULE-COMPLIANCE + STATUS current + DESCRIPTION "a" + MODULE + OBJECT testObj + SYNTAX InetAddressType { ipv4(1), ipv6(2) } + -- SYNTAX InetAddress ( SIZE(4|16) ) + DESCRIPTION "a" + ::= { testMibId 4 } + +testObjGroup OBJECT-GROUP + OBJECTS { testObj } + STATUS current + DESCRIPTION "a" + ::= { testObjId 1 } + +END diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 28eba0d0d6..30b8ee1124 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-2017. 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. @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.2.4 +SNMP_VSN = 5.2.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index f5a67bc00e..1837350284 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,50 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A file read with an sftp client could loose data if the + packet_size is set to larger than 64k. This is corrected + now in such a way that the packet_size is silently + lowered if there is a risk for data loss.</p> + <p> + Own Id: OTP-13857 Aux Id: ERL-238, OTP-13858 </p> + </item> + <item> + <p> + When user defined SSH shell REPL process exits with + reason normal, the SSH channel callback module should + report successful exit status to the SSH client. This + provides simple way for SSH clients to check for + successful completion of executed commands. (Thanks to + isvilen)</p> + <p> + Own Id: OTP-13905 Aux Id: PR-1173 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Extended the option <c>silently_accept_hosts</c> for + <c>ssh:connect</c> to make it possible for the client to + check the SSH host key fingerprint string. Se the + reference manual for SSH.</p> + <p> + Own Id: OTP-13887 Aux Id: OTP-13888 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.3.6</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh_protocol.xml b/lib/ssh/doc/src/ssh_protocol.xml index 013823b4df..a0032ab449 100644 --- a/lib/ssh/doc/src/ssh_protocol.xml +++ b/lib/ssh/doc/src/ssh_protocol.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2013</year><year>2013</year> + <year>2013</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 4cda8fee95..2540720c41 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 9f3e60bd62..13c9d9af4a 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index ac35b70209..9b54ecb2dd 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -406,7 +406,11 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, kb_tries_left = KbTriesLeft, user = User, userauth_supported_methods = Methods} = Ssh) -> - SendOneEmpty = proplists:get_value(tstflg, Opts) == one_empty, + SendOneEmpty = + (proplists:get_value(tstflg,Opts) == one_empty) + orelse + proplists:get_value(one_empty, proplists:get_value(tstflg,Opts,[]), false), + case check_password(User, unicode:characters_to_list(Password), Opts, Ssh) of {true,Ssh1} when SendOneEmpty==true -> Msg = #ssh_msg_userauth_info_request{name = "", diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 1153095135..c7a2c92670 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index 0c24c09887..d464def6fa 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index afc2fb88ff..b937f0412d 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -37,7 +37,7 @@ -export([open/3, open_tar/3, opendir/2, close/2, readdir/2, pread/4, read/3, open/4, open_tar/4, opendir/3, close/3, readdir/3, pread/5, read/4, apread/4, aread/3, pwrite/4, write/3, apwrite/4, awrite/3, - pwrite/5, write/4, + pwrite/5, write/4, position/3, real_path/2, read_file_info/2, get_file_info/2, position/4, real_path/3, read_file_info/3, get_file_info/3, write_file_info/3, read_link_info/2, read_link/2, make_symlink/3, @@ -52,7 +52,7 @@ %% TODO: Should be placed elsewhere ssh_sftpd should not call functions in ssh_sftp! -export([info_to_attr/1, attr_to_info/1]). --record(state, +-record(state, { xf, rep_buf = <<>>, @@ -64,7 +64,7 @@ -record(fileinf, { - handle, + handle, offset, size, mode @@ -81,7 +81,7 @@ enc_text_buf = <<>>, % Encrypted text plain_text_buf = <<>> % Decrypted text }). - + -define(FILEOP_TIMEOUT, infinity). -define(NEXT_REQID(S), @@ -98,7 +98,7 @@ start_channel(Cm) when is_pid(Cm) -> start_channel(Socket) when is_port(Socket) -> start_channel(Socket, []); start_channel(Host) when is_list(Host) -> - start_channel(Host, []). + start_channel(Host, []). start_channel(Socket, Options) when is_port(Socket) -> Timeout = @@ -110,7 +110,7 @@ start_channel(Socket, Options) when is_port(Socket) -> TO end, case ssh:connect(Socket, Options, Timeout) of - {ok,Cm} -> + {ok,Cm} -> case start_channel(Cm, Options) of {ok, Pid} -> {ok, Pid, Cm}; @@ -124,13 +124,13 @@ start_channel(Cm, Opts) when is_pid(Cm) -> Timeout = proplists:get_value(timeout, Opts, infinity), {_, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), case ssh_xfer:attach(Cm, [], ChanOpts) of - {ok, ChannelId, Cm} -> - case ssh_channel:start(Cm, ChannelId, + {ok, ChannelId, Cm} -> + case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of ok -> - {ok, Pid}; + {ok, Pid}; TimeOut -> TimeOut end; @@ -150,7 +150,7 @@ start_channel(Host, Port, Opts) -> Timeout = proplists:get_value(timeout, SftpOpts, infinity), case ssh_xfer:connect(Host, Port, SshOpts, ChanOpts, Timeout) of {ok, ChannelId, Cm} -> - case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, + case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of @@ -165,7 +165,7 @@ start_channel(Host, Port, Opts) -> {error, ignore} end; Error -> - Error + Error end. stop_channel(Pid) -> @@ -174,12 +174,12 @@ stop_channel(Pid) -> OldValue = process_flag(trap_exit, true), link(Pid), exit(Pid, ssh_sftp_stop_channel), - receive + receive {'EXIT', Pid, normal} -> ok after 5000 -> exit(Pid, kill), - receive + receive {'EXIT', Pid, killed} -> ok end @@ -209,9 +209,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, write, fun(write, {_,Data}) -> write_to_remote_tar(Pid, Handle, to_bin(Data), FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position(Pid, Handle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> close(Pid, Handle, FileOpTimeout) end); {true,false,[{crypto,{CryptoInitFun,CryptoEncryptFun,CryptoEndFun}}]} -> @@ -245,9 +245,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, read, fun(read2, {_,Len}) -> read_repeat(Pid, Handle, Len, FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position(Pid, Handle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> close(Pid, Handle, FileOpTimeout) end); {false,true,[{crypto,{CryptoInitFun,CryptoDecryptFun}}]} -> @@ -258,9 +258,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, read, fun(read2, {_,Len}) -> read_buf(Pid, SftpHandle, BufHandle, Len, FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position_buf(Pid, SftpHandle, BufHandle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> call(Pid, {erase_bufinf,BufHandle}, FileOpTimeout), close(Pid, SftpHandle, FileOpTimeout) end); @@ -292,7 +292,7 @@ pread(Pid, Handle, Offset, Len, FileOpTimeout) -> read(Pid, Handle, Len) -> read(Pid, Handle, Len, ?FILEOP_TIMEOUT). read(Pid, Handle, Len, FileOpTimeout) -> - call(Pid, {read,false,Handle, Len}, FileOpTimeout). + call(Pid, {read,false,Handle, Len}, FileOpTimeout). %% TODO this ought to be a cast! Is so in all practial meaning %% even if it is obscure! @@ -301,7 +301,7 @@ apread(Pid, Handle, Offset, Len) -> %% TODO this ought to be a cast! aread(Pid, Handle, Len) -> - call(Pid, {read,true,Handle, Len}, infinity). + call(Pid, {read,true,Handle, Len}, infinity). pwrite(Pid, Handle, Offset, Data) -> pwrite(Pid, Handle, Offset, Data, ?FILEOP_TIMEOUT). @@ -367,7 +367,7 @@ make_symlink(Pid, Name, Target) -> make_symlink(Pid, Name, Target, ?FILEOP_TIMEOUT). make_symlink(Pid, Name, Target, FileOpTimeout) -> call(Pid, {make_symlink,false, Name, Target}, FileOpTimeout). - + rename(Pid, FromFile, ToFile) -> rename(Pid, FromFile, ToFile, ?FILEOP_TIMEOUT). rename(Pid, FromFile, ToFile, FileOpTimeout) -> @@ -411,8 +411,8 @@ list_dir(Pid, Name, FileOpTimeout) -> close(Pid, Handle, FileOpTimeout), case Res of {ok, List} -> - NList = lists:foldl(fun({Nm, _Info},Acc) -> - [Nm|Acc] end, + NList = lists:foldl(fun({Nm, _Info},Acc) -> + [Nm|Acc] end, [], List), {ok,NList}; Error -> Error @@ -482,7 +482,7 @@ write_file_loop(Pid, Handle, Pos, Bin, Remain, PacketSz, FileOpTimeout) -> <<_:Pos/binary, Data:PacketSz/binary, _/binary>> = Bin, case write(Pid, Handle, Data, FileOpTimeout) of ok -> - write_file_loop(Pid, Handle, + write_file_loop(Pid, Handle, Pos+PacketSz, Bin, Remain-PacketSz, PacketSz, FileOpTimeout); Error -> @@ -510,7 +510,7 @@ init([Cm, ChannelId, Options]) -> Xf = #ssh_xfer{cm = Cm, channel = ChannelId}, {ok, #state{xf = Xf, - req_id = 0, + req_id = 0, rep_buf = <<>>, inf = new_inf(), opts = Options}}; @@ -519,7 +519,7 @@ init([Cm, ChannelId, Options]) -> Error -> {stop, {shutdown, Error}} end. - + %%-------------------------------------------------------------------- %% Function: handle_call/3 %% Description: Handling call messages @@ -541,7 +541,7 @@ handle_call({{timeout, Timeout}, wait_for_version_negotiation}, From, handle_call({_, wait_for_version_negotiation}, _, State) -> {reply, ok, State}; - + handle_call({{timeout, infinity}, Msg}, From, State) -> do_handle_call(Msg, From, State); handle_call({{timeout, Timeout}, Msg}, From, #state{req_id = Id} = State) -> @@ -555,13 +555,13 @@ code_change(_OldVsn, State, _Extra) -> {ok, State}. do_handle_call({get_bufinf,BufHandle}, _From, S=#state{inf=I0}) -> - {reply, dict:find(BufHandle,I0), S}; + {reply, maps:find(BufHandle,I0), S}; do_handle_call({put_bufinf,BufHandle,B}, _From, S=#state{inf=I0}) -> - {reply, ok, S#state{inf=dict:store(BufHandle,B,I0)}}; + {reply, ok, S#state{inf=maps:put(BufHandle,B,I0)}}; do_handle_call({erase_bufinf,BufHandle}, _From, S=#state{inf=I0}) -> - {reply, ok, S#state{inf=dict:erase(BufHandle,I0)}}; + {reply, ok, S#state{inf=maps:remove(BufHandle,I0)}}; do_handle_call({open, Async,FileName,Mode}, From, #state{xf = XF} = State) -> {Access,Flags,Attrs} = open_mode(XF#ssh_xfer.vsn, Mode), @@ -636,7 +636,7 @@ do_handle_call({pread,Async,Handle,At,Length}, From, State) -> binary -> {{ok,Data}, State2}; text -> {{ok,binary_to_list(Data)}, State2} end; - (Rep, State2) -> + (Rep, State2) -> {Rep, State2} end); Error -> @@ -777,7 +777,7 @@ do_handle_call(recv_window, _From, State) -> do_handle_call(stop, _From, State) -> {stop, shutdown, ok, State}; -do_handle_call(Call, _From, State) -> +do_handle_call(Call, _From, State) -> {reply, {error, bad_call, Call, State}, State}. %%-------------------------------------------------------------------- @@ -785,13 +785,13 @@ do_handle_call(Call, _From, State) -> %% %% Description: Handles channel messages %%-------------------------------------------------------------------- -handle_ssh_msg({ssh_cm, _ConnectionManager, - {data, _ChannelId, 0, Data}}, #state{rep_buf = Data0} = +handle_ssh_msg({ssh_cm, _ConnectionManager, + {data, _ChannelId, 0, Data}}, #state{rep_buf = Data0} = State0) -> State = handle_reply(State0, <<Data0/binary,Data/binary>>), {ok, State}; -handle_ssh_msg({ssh_cm, _ConnectionManager, +handle_ssh_msg({ssh_cm, _ConnectionManager, {data, _ChannelId, 1, Data}}, State) -> error_logger:format("ssh: STDERR: ~s\n", [binary_to_list(Data)]), {ok, State}; @@ -803,7 +803,7 @@ handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> %% Ignore signals according to RFC 4254 section 6.9. {ok, State}; -handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, Error, _}}, +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, Error, _}}, State0) -> State = reply_all(State0, {error, Error}), {stop, ChannelId, State}; @@ -823,7 +823,7 @@ handle_msg({ssh_channel_up, _, _}, #state{opts = Options, xf = Xf} = State) -> {ok, State}; %% Version negotiation timed out -handle_msg({timeout, undefined, From}, +handle_msg({timeout, undefined, From}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> ssh_channel:reply(From, {error, timeout}), {stop, ChannelId, State}; @@ -839,12 +839,12 @@ handle_msg({timeout, Id, From}, #state{req_list = ReqList0} = State) -> end; %% Connection manager goes down -handle_msg({'DOWN', _Ref, _Type, _Process, _}, +handle_msg({'DOWN', _Ref, _Type, _Process, _}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> {stop, ChannelId, State}; - + %% Stopped by user -handle_msg({'EXIT', _, ssh_sftp_stop_channel}, +handle_msg({'EXIT', _, ssh_sftp_stop_channel}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> {stop, ChannelId, State}; @@ -883,10 +883,10 @@ call(Pid, Msg, TimeOut) -> handle_reply(State, <<?UINT32(Len),Reply:Len/binary,Rest/binary>>) -> do_handle_reply(State, Reply, Rest); -handle_reply(State, Data) -> +handle_reply(State, Data) -> State#state{rep_buf = Data}. -do_handle_reply(#state{xf = Xf} = State, +do_handle_reply(#state{xf = Xf} = State, <<?SSH_FXP_VERSION, ?UINT32(Version), BinExt/binary>>, Rest) -> Ext = ssh_xfer:decode_ext(BinExt), case Xf#ssh_xfer.vsn of @@ -899,7 +899,7 @@ do_handle_reply(#state{xf = Xf} = State, ok end, ssh_channel:reply(From, ok) - end, + end, State#state{xf = Xf#ssh_xfer{vsn = Version, ext = Ext}, rep_buf = Rest}; do_handle_reply(State0, Data, Rest) -> @@ -919,9 +919,9 @@ handle_req_reply(State0, {_, ReqID, _} = XfReply) -> List = lists:keydelete(ReqID, 1, State0#state.req_list), State1 = State0#state { req_list = List }, case catch Fun(xreply(XfReply),State1) of - {'EXIT', _} -> + {'EXIT', _} -> State1; - State -> + State -> State end end. @@ -998,15 +998,15 @@ reply_all(State, Reply) -> make_reply(ReqID, true, From, State) -> {reply, {async, ReqID}, update_request_info(ReqID, State, - fun(Reply,State1) -> + fun(Reply,State1) -> async_reply(ReqID,Reply,From,State1) end)}; make_reply(ReqID, false, From, State) -> {noreply, update_request_info(ReqID, State, - fun(Reply,State1) -> - sync_reply(Reply, From, State1) + fun(Reply,State1) -> + sync_reply(Reply, From, State1) end)}. make_reply_post(ReqID, true, From, State, PostFun) -> @@ -1074,13 +1074,13 @@ attr_to_info(A) when is_record(A, ssh_xfer_attr) -> unix_to_datetime(undefined) -> undefined; unix_to_datetime(UTCSecs) -> - UTCDateTime = + UTCDateTime = calendar:gregorian_seconds_to_datetime(UTCSecs + 62167219200), erlang:universaltime_to_localtime(UTCDateTime). datetime_to_unix(undefined) -> undefined; -datetime_to_unix(LocalDateTime) -> +datetime_to_unix(LocalDateTime) -> UTCDateTime = erlang:localtime_to_universaltime(LocalDateTime), calendar:datetime_to_gregorian_seconds(UTCDateTime) - 62167219200. @@ -1128,11 +1128,11 @@ open_mode3(Modes) -> end, {[], Fl, A}. -%% accessors for inf dict -new_inf() -> dict:new(). +%% accessors for inf map +new_inf() -> #{}. add_new_handle(Handle, FileMode, Inf) -> - dict:store(Handle, #fileinf{offset=0, size=0, mode=FileMode}, Inf). + maps:put(Handle, #fileinf{offset=0, size=0, mode=FileMode}, Inf). update_size(Handle, NewSize, State) -> OldSize = get_size(Handle, State), @@ -1152,27 +1152,24 @@ update_offset(Handle, NewOffset, State0) -> %% access size and offset for handle put_size(Handle, Size, State) -> Inf0 = State#state.inf, - case dict:find(Handle, Inf0) of + case maps:find(Handle, Inf0) of {ok, FI} -> - State#state{inf=dict:store(Handle, FI#fileinf{size=Size}, Inf0)}; + State#state{inf=maps:put(Handle, FI#fileinf{size=Size}, Inf0)}; _ -> - State#state{inf=dict:store(Handle, #fileinf{size=Size,offset=0}, - Inf0)} + State#state{inf=maps:put(Handle, #fileinf{size=Size,offset=0}, Inf0)} end. put_offset(Handle, Offset, State) -> Inf0 = State#state.inf, - case dict:find(Handle, Inf0) of + case maps:find(Handle, Inf0) of {ok, FI} -> - State#state{inf=dict:store(Handle, FI#fileinf{offset=Offset}, - Inf0)}; + State#state{inf=maps:put(Handle, FI#fileinf{offset=Offset}, Inf0)}; _ -> - State#state{inf=dict:store(Handle, #fileinf{size=Offset, - offset=Offset}, Inf0)} + State#state{inf=maps:put(Handle, #fileinf{size=Offset, offset=Offset}, Inf0)} end. get_size(Handle, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, FI} -> FI#fileinf.size; _ -> @@ -1180,11 +1177,11 @@ get_size(Handle, State) -> end. %% get_offset(Handle, State) -> -%% {ok, FI} = dict:find(Handle, State#state.inf), +%% {ok, FI} = maps:find(Handle, State#state.inf), %% FI#fileinf.offset. get_mode(Handle, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, FI} -> FI#fileinf.mode; _ -> @@ -1192,14 +1189,14 @@ get_mode(Handle, State) -> end. erase_handle(Handle, State) -> - FI = dict:erase(Handle, State#state.inf), + FI = maps:remove(Handle, State#state.inf), State#state{inf = FI}. %% %% Caluclate a integer offset %% lseek_position(Handle, Pos, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, #fileinf{offset=O, size=S}} -> lseek_pos(Pos, O, S); _ -> @@ -1229,7 +1226,7 @@ lseek_pos({cur, Offset}, CurOffset, _CurSize) true -> {ok, NewOffset} end; -lseek_pos({eof, Offset}, _CurOffset, CurSize) +lseek_pos({eof, Offset}, _CurOffset, CurSize) when is_integer(Offset) andalso -(?SSH_FILEXFER_LARGEFILESIZE) =< Offset andalso Offset < ?SSH_FILEXFER_LARGEFILESIZE -> NewOffset = CurSize + Offset, @@ -1239,7 +1236,7 @@ lseek_pos({eof, Offset}, _CurOffset, CurSize) {ok, NewOffset} end; lseek_pos(_, _, _) -> - {error, einval}. + {error, einval}. %%%================================================================ %%% @@ -1277,13 +1274,13 @@ position_buf(Pid, SftpHandle, BufHandle, Pos, FileOpTimeout) -> case Pos of {cur,0} when Mode==write -> {ok,Size+size(Buf0)}; - + {cur,0} when Mode==read -> {ok,Size}; - + _ when Mode==read, is_integer(Pos) -> Skip = Pos-Size, - if + if Skip < 0 -> {error, cannot_rewind}; Skip == 0 -> @@ -1318,7 +1315,7 @@ read_buf(Pid, SftpHandle, BufHandle, WantedLen, FileOpTimeout) -> eof end. -do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, +do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, B=#bufinf{plain_text_buf=PlainBuf0, size = Size}) when size(PlainBuf0) >= WantedLen -> @@ -1327,7 +1324,7 @@ do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, {ok,ResultBin,B#bufinf{plain_text_buf=PlainBuf, size = Size + WantedLen}}; -do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, +do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B0=#bufinf{plain_text_buf = PlainBuf0, enc_text_buf = EncBuf0, chunksize = undefined @@ -1335,12 +1332,12 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, when size(EncBuf0) > 0 -> %% We have (at least) one decodable byte waiting for decodeing. {ok,DecodedBin,B} = apply_crypto(EncBuf0, B0), - do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B#bufinf{plain_text_buf = <<PlainBuf0/binary, DecodedBin/binary>>, enc_text_buf = <<>> }); - -do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + +do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B0=#bufinf{plain_text_buf = PlainBuf0, enc_text_buf = EncBuf0, chunksize = ChunkSize0 @@ -1349,11 +1346,11 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, %% We have (at least) one chunk of decodable bytes waiting for decodeing. <<ToDecode:ChunkSize0/binary, EncBuf/binary>> = EncBuf0, {ok,DecodedBin,B} = apply_crypto(ToDecode, B0), - do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B#bufinf{plain_text_buf = <<PlainBuf0/binary, DecodedBin/binary>>, enc_text_buf = EncBuf }); - + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B=#bufinf{enc_text_buf = EncBuf0}) -> %% We must read more bytes and append to the buffer of encoded bytes. case read(Pid, SftpHandle, Packet, FileOpTimeout) of @@ -1370,7 +1367,7 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B=#bufinf{enc write_buf(Pid, SftpHandle, BufHandle, PlainBin, FileOpTimeout) -> {ok,{_Window,Packet}} = send_window(Pid, FileOpTimeout), {ok,B0=#bufinf{plain_text_buf=PTB}} = call(Pid, {get_bufinf,BufHandle}, FileOpTimeout), - case do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, + case do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, B0#bufinf{plain_text_buf = <<PTB/binary,PlainBin/binary>>}) of {ok, B} -> call(Pid, {put_bufinf,BufHandle,B}, FileOpTimeout), @@ -1379,7 +1376,7 @@ write_buf(Pid, SftpHandle, BufHandle, PlainBin, FileOpTimeout) -> {error,Error} end. -do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, +do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, B=#bufinf{enc_text_buf = EncBuf0, size = Size}) when size(EncBuf0) >= Packet -> @@ -1421,9 +1418,9 @@ do_the_write_buf(_Pid, _SftpHandle, _Packet, _FileOpTimeout, B) -> apply_crypto(In, B=#bufinf{crypto_state = CState0, crypto_fun = F}) -> case F(In,CState0) of - {ok,EncodedBin,CState} -> + {ok,EncodedBin,CState} -> {ok, EncodedBin, B#bufinf{crypto_state=CState}}; - {ok,EncodedBin,CState,ChunkSize} -> + {ok,EncodedBin,CState,ChunkSize} -> {ok, EncodedBin, B#bufinf{crypto_state=CState, chunksize=ChunkSize}} end. diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index dca018f20f..b739955836 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2015. All Rights Reserved. +%% Copyright Ericsson AB 2005-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. diff --git a/lib/ssh/src/ssh_sftpd_file_api.erl b/lib/ssh/src/ssh_sftpd_file_api.erl index 78f452df67..e444e52ac0 100644 --- a/lib/ssh/src/ssh_sftpd_file_api.erl +++ b/lib/ssh/src/ssh_sftpd_file_api.erl @@ -36,7 +36,7 @@ -callback list_dir(file:name(), State::term()) -> {{ok, Filenames::term()}, State::term()} | {{error, Reason::term()}, State::term()}. -callback make_dir(Dir::term(), State::term()) -> - {{ok, State::term()},State::term()} | {{error, Reason::term()}, State::term()}. + {ok, State::term()} | {{error, Reason::term()}, State::term()}. -callback make_symlink(Path2::term(), Path::term(), State::term()) -> {ok, State::term()} | {{error, Reason::term()}, State::term()}. -callback open(Path::term(), Flags::term(), State::term()) -> diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl index dc3b7dc7e6..0f8a838f97 100644 --- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -54,15 +54,18 @@ -endif. -endif. +%% Public key records: +-include_lib("public_key/include/public_key.hrl"). %%% Properties: prop_ssh_decode() -> - ?FORALL(Msg, ssh_msg(), - try ssh_message:decode(Msg) + ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ), + try ssh_message:decode(decode_state(Msg,KexFam)) of _ -> true catch + C:E -> io:format('~p:~p~n',[C,E]), false end @@ -71,122 +74,101 @@ prop_ssh_decode() -> %%% This fails because ssh_message is not symmetric in encode and decode regarding data types prop_ssh_decode_encode() -> - ?FORALL(Msg, ssh_msg(), - Msg == ssh_message:encode(ssh_message:decode(Msg)) + ?FORALL({Msg,KexFam}, ?LET(KF, kex_family(), {ssh_msg(KF),KF} ), + Msg == ssh_message:encode( + fix_asym( + ssh_message:decode(decode_state(Msg,KexFam)))) ). %%%================================================================ %%% -%%% Scripts to generate message generators -%%% - -%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt - -%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt - -%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt - -%%%================================================================ -%%% %%% Generators %%% -ssh_msg() -> ?LET(M,oneof( -[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], - [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], - [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], -%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], -%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], - [msg_code('SSH_MSG_IGNORE'),gen_string( )], - %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], - %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )], - %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], - [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()], - [msg_code('SSH_MSG_NEWKEYS')], - [msg_code('SSH_MSG_REQUEST_FAILURE')], - [msg_code('SSH_MSG_REQUEST_SUCCESS')], - [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], - [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], - [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], - [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], - [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], - [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], - [msg_code('SSH_MSG_USERAUTH_SUCCESS')] -] - -), list_to_binary(M)). - - -%%%================================================================ -%%% -%%% Generator -%%% - -do() -> - io_lib:format('[~s~n]', - [write_gen( - files(["rfc4254.txt", - "rfc4253.txt", - "rfc4419.txt", - "rfc4252.txt", - "rfc4256.txt"]))]). - - -write_gen(L) when is_list(L) -> - string:join(lists:map(fun write_gen/1, L), ",\n "); -write_gen({MsgName,Args}) -> - lists:flatten(["[",generate_args([MsgName|Args]),"]"]). - -generate_args(As) -> string:join([generate_arg(A) || A <- As], ","). - -generate_arg({<<"string">>, <<"\"",B/binary>>}) -> - S = get_string($",B), - ["gen_string(\"",S,"\")"]; -generate_arg({<<"string">>, _}) -> "gen_string( )"; -generate_arg({<<"byte[",B/binary>>, _}) -> - io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]); -generate_arg({<<"byte">> ,_}) -> "gen_byte()"; -generate_arg({<<"uint16">>,_}) -> "gen_uint16()"; -generate_arg({<<"uint32">>,_}) -> "gen_uint32()"; -generate_arg({<<"uint64">>,_}) -> "gen_uint64()"; -generate_arg({<<"mpint">>,_}) -> "gen_mpint()"; -generate_arg({<<"name-list">>,_}) -> "gen_name_list()"; -generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0"; -generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1"; -generate_arg({<<"boolean">>,_}) -> "gen_boolean()"; -generate_arg({<<"....">>,_}) -> ""; %% FIXME -generate_arg(Name) when is_binary(Name) -> - lists:flatten(["msg_code('",binary_to_list(Name),"')"]). - +ssh_msg(<<"dh">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], % 30 + [msg_code('SSH_MSG_KEXDH_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)); + +ssh_msg(<<"dh_gex">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST_OLD'),gen_uint32()], % 30 + [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)); + + ssh_msg(<<"ecdh">>) -> + ?LET(M,oneof( + [ + [msg_code('SSH_MSG_KEX_ECDH_INIT'),gen_mpint()], % 30 + [msg_code('SSH_MSG_KEX_ECDH_REPLY'),gen_pubkey_string(ecdsa),gen_mpint(),gen_signature_string(ecdsa)] % 31 + | rest_ssh_msgs() + ]), + list_to_binary(M)). + + +rest_ssh_msgs() -> + [%% SSH_MSG_USERAUTH_INFO_RESPONSE + %% hard args SSH_MSG_USERAUTH_INFO_REQUEST + %% rfc4252 p12 error SSH_MSG_USERAUTH_REQUEST + [msg_code('SSH_MSG_KEX_DH_GEX_REQUEST'),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_KEX_DH_GEX_INIT'),gen_mpint()], + [msg_code('SSH_MSG_KEX_DH_GEX_REPLY'),gen_pubkey_string(rsa),gen_mpint(),gen_signature_string(rsa)], + [msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_IGNORE'),gen_string( )], + [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], + [msg_code('SSH_MSG_NEWKEYS')], + [msg_code('SSH_MSG_REQUEST_FAILURE')], + [msg_code('SSH_MSG_REQUEST_SUCCESS')], + [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], + [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], + [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], + [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], + [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_SUCCESS')] + ]. + +kex_family() -> oneof([<<"dh">>, <<"dh_gex">>, <<"ecdh">>]). gen_boolean() -> choose(0,1). @@ -230,13 +212,22 @@ gen_name() -> gen_string(). uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>). -%%%---- -get_string(Delim, B) -> - binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ). - -count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc; -count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1). +gen_pubkey_string(Type) -> + PubKey = case Type of + rsa -> #'RSAPublicKey'{modulus = 12345,publicExponent = 2}; + ecdsa -> {#'ECPoint'{point=[1,2,3,4,5]}, + {namedCurve,{1,2,840,10045,3,1,7}}} % 'secp256r1' nistp256 + end, + gen_string(public_key:ssh_encode(PubKey, ssh2_pubkey)). + +gen_signature_string(Type) -> + Signature = <<"hejhopp">>, + Id = case Type of + rsa -> "ssh-rsa"; + ecdsa -> "ecdsa-sha2-nistp256" + end, + gen_string(gen_string(Id) ++ gen_string(Signature)). -define(MSG_CODE(Name,Num), msg_code(Name) -> Num; @@ -273,124 +264,34 @@ msg_code(Num) -> Name ?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100); ?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60); ?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61); +?MSG_CODE('SSH_MSG_KEXDH_INIT', 30); +?MSG_CODE('SSH_MSG_KEXDH_REPLY', 31); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31); ?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32); -?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33). - -%%%============================================================================= -%%%============================================================================= -%%%============================================================================= - -files(Fs) -> - Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))), - DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]), - WantedIDs = lists:usort(wanted_messages()), - Missing = WantedIDs -- DefinedIDs, - case Missing of - [] -> ok; - _ -> io:format('%% Warning: missing ~p~n', [Missing]) - end, - Defs. - - -file(F) -> - {ok,B} = file:read_file(F), - hunt_msg_def(B). - - -hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B)); -hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B); -hunt_msg_def(<<>>) -> []. - -some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B)); -some_hope(B) -> hunt_msg_def(B). - -try_message(B = <<"SSH_MSG_",_/binary>>) -> - {ID,Rest} = get_id(B), - case lists:member(binary_to_list(ID), wanted_messages()) of - true -> - {Lines,More} = get_def_lines(skip_blanks(Rest), []), - [{ID,lists:reverse(Lines)} | hunt_msg_def(More)]; - false -> - hunt_msg_def(Rest) - end; -try_message(B) -> hunt_msg_def(B). - - -skip_blanks(<<32, B/binary>>) -> skip_blanks(B); -skip_blanks(<< 9, B/binary>>) -> skip_blanks(B); -skip_blanks(B) -> B. - -get_def_lines(B0 = <<"\n",B/binary>>, Acc) -> - {ID,Rest} = get_id(skip_blanks(B)), - case {size(ID), skip_blanks(Rest)} of - {0,<<"....",More/binary>>} -> - {Text,LineEnd} = get_to_eol(skip_blanks(More)), - get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]); - {0,_} -> - {Acc,B0}; - {_,Rest1} -> - {Text,LineEnd} = get_to_eol(Rest1), - get_def_lines(LineEnd, [{ID,Text}|Acc]) - end; -get_def_lines(B, Acc) -> - {Acc,B}. - - -get_to_eol(B) -> split_binary(B, count_to_eol(B,0)). - -count_to_eol(<<"\n",_/binary>>, Acc) -> Acc; -count_to_eol(<<>>, Acc) -> Acc; -count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1). - - -get_id(B) -> split_binary(B, count_id_chars(B,0)). - -count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1); -count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1); -count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1); -count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1); -count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list -count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] -count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] -count_id_chars(_, Acc) -> Acc. - -wanted_messages() -> - ["SSH_MSG_CHANNEL_CLOSE", - "SSH_MSG_CHANNEL_DATA", - "SSH_MSG_CHANNEL_EOF", - "SSH_MSG_CHANNEL_EXTENDED_DATA", - "SSH_MSG_CHANNEL_FAILURE", - "SSH_MSG_CHANNEL_OPEN", - "SSH_MSG_CHANNEL_OPEN_CONFIRMATION", - "SSH_MSG_CHANNEL_OPEN_FAILURE", - "SSH_MSG_CHANNEL_REQUEST", - "SSH_MSG_CHANNEL_SUCCESS", - "SSH_MSG_CHANNEL_WINDOW_ADJUST", - "SSH_MSG_DEBUG", - "SSH_MSG_DISCONNECT", - "SSH_MSG_GLOBAL_REQUEST", - "SSH_MSG_IGNORE", - "SSH_MSG_KEXDH_INIT", - "SSH_MSG_KEXDH_REPLY", - "SSH_MSG_KEXINIT", - "SSH_MSG_KEX_DH_GEX_GROUP", - "SSH_MSG_KEX_DH_GEX_REQUEST", - "SSH_MSG_KEX_DH_GEX_REQUEST_OLD", - "SSH_MSG_NEWKEYS", - "SSH_MSG_REQUEST_FAILURE", - "SSH_MSG_REQUEST_SUCCESS", - "SSH_MSG_SERVICE_ACCEPT", - "SSH_MSG_SERVICE_REQUEST", - "SSH_MSG_UNIMPLEMENTED", - "SSH_MSG_USERAUTH_BANNER", - "SSH_MSG_USERAUTH_FAILURE", -%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST", -%% "SSH_MSG_USERAUTH_INFO_RESPONSE", - "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ", - "SSH_MSG_USERAUTH_PK_OK", -%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST", - "SSH_MSG_USERAUTH_SUCCESS"]. +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33); +?MSG_CODE('SSH_MSG_KEX_ECDH_INIT', 30); +?MSG_CODE('SSH_MSG_KEX_ECDH_REPLY', 31). + +%%%==================================================== +%%%=== WARNING: Knowledge of the test object ahead! === +%%%==================================================== + +%% SSH message records: +-include_lib("ssh/src/ssh_connect.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). + +%%% Encoding and decodeing is asymetric so out=binary in=string. Sometimes. :( +fix_asym(#ssh_msg_global_request{name=N} = M) -> M#ssh_msg_global_request{name = binary_to_list(N)}; +fix_asym(#ssh_msg_debug{message=D,language=L} = M) -> M#ssh_msg_debug{message = binary_to_list(D), + language = binary_to_list(L)}; +fix_asym(#ssh_msg_kexinit{cookie=C} = M) -> M#ssh_msg_kexinit{cookie = <<C:128>>}; +fix_asym(M) -> M. + +%%% Message codes 30 and 31 are overloaded depending on kex family so arrange the decoder +%%% input as the test object does +decode_state(<<30,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>; +decode_state(<<31,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>; +decode_state(Msg, _) -> Msg. diff --git a/lib/ssh/test/ssh.cover b/lib/ssh/test/ssh.cover index a4221fbbbe..69d2a1c4f8 100644 --- a/lib/ssh/test/ssh.cover +++ b/lib/ssh/test/ssh.cover @@ -1,2 +1,3 @@ {incl_app,ssh,details}. +{excl_mods, ssh, [ssh_dbg, ssh_info, ssh_server_key_api, ssh_sftpd_file_api]}.
\ No newline at end of file diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 8b2db0e1a8..14605ee44f 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -198,7 +198,7 @@ try_exec_simple_group(Group, Config) -> %%-------------------------------------------------------------------- %% Testing all default groups -simple_exec_groups() -> [{timetrap,{minutes,5}}]. +simple_exec_groups() -> [{timetrap,{minutes,8}}]. simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), @@ -206,10 +206,8 @@ simple_exec_groups(Config) -> fun(Sz) -> ct:log("Try size ~p",[Sz]), ct:comment(Sz), - case simple_exec_group(Sz, Config) of - expected -> ct:log("Size ~p ok",[Sz]); - _ -> ct:log("Size ~p not ok",[Sz]) - end + simple_exec_group(Sz, Config), + ct:log("Size ~p ok",[Sz]) end, Sizes), ct:comment("~p",[lists:map(fun({_,I,_}) -> I; (I) -> I diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 8f060bebd8..86f5cb1746 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -831,10 +831,13 @@ supported_hash(HashAlg) -> really_do_hostkey_fingerprint_check(Config, HashAlg) -> PrivDir = proplists:get_value(priv_dir, Config), - UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth - file:make_dir(UserDir), + UserDirServer = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDirServer), SysDir = proplists:get_value(data_dir, Config), + UserDirClient = + ssh_test_lib:create_random_dir(Config), % Ensure no 'known_hosts' disturbs + %% All host key fingerprints. Trust that public_key has checked the ssh_hostkey_fingerprint %% function since that function is used by the ssh client... FPs = [case HashAlg of @@ -857,7 +860,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) -> %% Start daemon with the public keys that we got fingerprints from {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, + {user_dir, UserDirServer}, {password, "morot"}]), FP_check_fun = fun(PeerName, FP) -> @@ -876,7 +879,7 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) -> end}, {user, "foo"}, {password, "morot"}, - {user_dir, UserDir}, + {user_dir, UserDirClient}, {user_interaction, false}]), ssh:stop_daemon(Pid). diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl index 7ba2732a88..9b2a84d8e4 100644 --- a/lib/ssh/test/ssh_property_test_SUITE.erl +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -68,9 +68,6 @@ init_per_group(_, Config) -> end_per_group(_, Config) -> Config. -%%% Always skip the testcase that is not quite in phase with the -%%% ssh_message.erl code -init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"}; init_per_testcase(_TestCase, Config) -> Config. end_per_testcase(_TestCase, Config) -> Config. diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 70662f5d93..acf76157a2 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -1038,7 +1038,7 @@ oldprep(Config) -> prepare(Config0) -> PrivDir = proplists:get_value(priv_dir, Config0), - Dir = filename:join(PrivDir, random_chars(10)), + Dir = filename:join(PrivDir, ssh_test_lib:random_chars(10)), file:make_dir(Dir), Keys = [filename, testfile, @@ -1058,8 +1058,6 @@ prepare(Config0) -> [{sftp_priv_dir,Dir} | Config2]. -random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. - foldl_keydelete(Keys, L) -> lists:foldl(fun(K,E) -> lists:keydelete(K,1,E) end, L, diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index f93237f3e7..286ac6e882 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -113,19 +113,27 @@ std_simple_exec(Host, Port, Config) -> std_simple_exec(Host, Port, Config, []). std_simple_exec(Host, Port, Config, Opts) -> + ct:log("~p:~p std_simple_exec",[?MODULE,?LINE]), ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts), + ct:log("~p:~p connected! ~p",[?MODULE,?LINE,ConnectionRef]), {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - success = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity), - Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"42\n">>}}, - case ssh_test_lib:receive_exec_result(Data) of - expected -> - ok; - Other -> - ct:fail(Other) - end, - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), - ssh:close(ConnectionRef). - + ct:log("~p:~p session_channel ok ~p",[?MODULE,?LINE,ChannelId]), + ExecResult = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity), + ct:log("~p:~p exec ~p",[?MODULE,?LINE,ExecResult]), + case ExecResult of + success -> + Expected = {ssh_cm, ConnectionRef, {data,ChannelId,0,<<"42\n">>}}, + case receive_exec_result(Expected) of + expected -> + ok; + Other -> + ct:fail(Other) + end, + receive_exec_end(ConnectionRef, ChannelId), + ssh:close(ConnectionRef); + _ -> + ct:fail(ExecResult) + end. start_shell(Port, IOServer) -> start_shell(Port, IOServer, []). @@ -834,3 +842,20 @@ get_kex_init(Conn, Ref, TRef) -> end end. +%%%---------------------------------------------------------------- +%%% Return a string with N random characters +%%% +random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. + + +create_random_dir(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Name = filename:join(PrivDir, random_chars(15)), + case file:make_dir(Name) of + ok -> + Name; + {error,eexist} -> + %% The Name already denotes an existing file system object, try again. + %% The likelyhood of always generating an existing file name is low + create_random_dir(Config) + end. diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index e34071af99..bc86000d81 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. 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 diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index b5b27c369a..7b9b109fa1 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -199,6 +199,4 @@ close(#state{server = Server, connection = undefined}. -random_contents() -> list_to_binary( random_chars(3) ). - -random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. +random_contents() -> list_to_binary( ssh_test_lib:random_chars(3) ). diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index c023429056..c6a5990f41 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.3.6 +SSH_VSN = 4.4 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index c7f50777a8..29b8e8ff67 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -28,6 +28,42 @@ <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + List of possible anonymous suites, never supported by + default, where incorrect for some TLS versions.</p> + <p> + Own Id: OTP-13926</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Experimental version of DTLS. It is runnable but not + complete and cannot be considered reliable for production + usage.</p> + <p> + Own Id: OTP-12982</p> + </item> + <item> + <p> + Add API options to handle ECC curve selection.</p> + <p> + Own Id: OTP-13959</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 8.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index edc7e0d8b2..916b41742e 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -424,6 +424,14 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid </taglist> </item> + + <tag><c>max_handshake_size</c></tag> + <item> + <p>Integer (24 bits unsigned). Used to limit the size of + valid TLS handshake packets to avoid DoS attacks. + Defaults to 256*1024.</p> + </item> + </taglist> </item> diff --git a/lib/ssl/doc/src/ssl_crl_cache_api.xml b/lib/ssl/doc/src/ssl_crl_cache_api.xml index 7440b6ef04..c6774b4df6 100644 --- a/lib/ssl/doc/src/ssl_crl_cache_api.xml +++ b/lib/ssl/doc/src/ssl_crl_cache_api.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2015</year><year>2015</year> + <year>2015</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index b625db0656..3dda1a3316 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2015. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -50,6 +50,7 @@ MODULES= \ ssl_app \ ssl_dist_sup\ ssl_sup \ + dtls_udp_sup \ inet_tls_dist \ inet6_tls_dist \ ssl_certificate\ @@ -71,7 +72,9 @@ MODULES= \ ssl_crl\ ssl_crl_cache \ ssl_crl_hash_dir \ - ssl_socket \ + tls_socket \ + dtls_socket \ + dtls_udp_listener\ ssl_listen_tracker_sup \ tls_record \ dtls_record \ diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 4f1f050e4b..070a90d481 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2015. All Rights Reserved. +%% Copyright Ericsson AB 2013-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. @@ -48,12 +48,12 @@ select_sni_extension/1]). %% Alert and close handling --export([send_alert/2, close/5]). +-export([encode_alert/3,send_alert/2, close/5]). %% Data handling --export([passive_receive/2, next_record_if_active/1, handle_common_event/4 - ]). +-export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4, + send/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -93,61 +93,120 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Error end. -send_handshake(Handshake, State) -> - send_handshake_flight(queue_handshake(Handshake, State)). +send_handshake(Handshake, #state{connection_states = ConnectionStates} = States) -> + #{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write), + send_handshake_flight(queue_handshake(Handshake, States), Epoch). + +queue_handshake(Handshake0, #state{tls_handshake_history = Hist0, + negotiated_version = Version, + flight_buffer = #{handshakes := HsBuffer0, + change_cipher_spec := undefined, + next_sequence := Seq} = Flight0} = State) -> + Handshake = dtls_handshake:encode_handshake(Handshake0, Version, Seq), + Hist = update_handshake_history(Handshake0, Handshake, Hist0), + State#state{flight_buffer = Flight0#{handshakes => [Handshake | HsBuffer0], + next_sequence => Seq +1}, + tls_handshake_history = Hist}; + +queue_handshake(Handshake0, #state{tls_handshake_history = Hist0, + negotiated_version = Version, + flight_buffer = #{handshakes_after_change_cipher_spec := Buffer0, + next_sequence := Seq} = Flight0} = State) -> + Handshake = dtls_handshake:encode_handshake(Handshake0, Version, Seq), + Hist = update_handshake_history(Handshake0, Handshake, Hist0), + State#state{flight_buffer = Flight0#{handshakes_after_change_cipher_spec => [Handshake | Buffer0], + next_sequence => Seq +1}, + tls_handshake_history = Hist}. -queue_flight_buffer(Msg, #state{negotiated_version = Version, - connection_states = ConnectionStates, - flight_buffer = Flight} = State) -> - ConnectionState = - ssl_record:current_connection_state(ConnectionStates, write), - Epoch = maps:get(epoch, ConnectionState), - State#state{flight_buffer = Flight ++ [{Version, Epoch, Msg}]}. - -queue_handshake(Handshake, #state{negotiated_version = Version, - tls_handshake_history = Hist0, - connection_states = ConnectionStates0} = State0) -> - {Frag, ConnectionStates, Hist} = - encode_handshake(Handshake, Version, ConnectionStates0, Hist0), - queue_flight_buffer(Frag, State0#state{connection_states = ConnectionStates, - tls_handshake_history = Hist}). send_handshake_flight(#state{socket = Socket, transport_cb = Transport, - flight_buffer = Flight, - connection_states = ConnectionStates0} = State0) -> - + flight_buffer = #{handshakes := Flight, + change_cipher_spec := undefined}, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Epoch) -> + %% TODO remove hardcoded Max size {Encoded, ConnectionStates} = - encode_handshake_flight(Flight, ConnectionStates0), + encode_handshake_flight(lists:reverse(Flight), Version, 1400, Epoch, ConnectionStates0), + send(Transport, Socket, Encoded), + start_flight(State0#state{connection_states = ConnectionStates}); + +send_handshake_flight(#state{socket = Socket, + transport_cb = Transport, + flight_buffer = #{handshakes := [_|_] = Flight0, + change_cipher_spec := ChangeCipher, + handshakes_after_change_cipher_spec := []}, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Epoch) -> + {HsBefore, ConnectionStates1} = + encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch, ConnectionStates0), + {EncChangeCipher, ConnectionStates} = encode_change_cipher(ChangeCipher, Version, Epoch, ConnectionStates1), + + send(Transport, Socket, [HsBefore, EncChangeCipher]), + start_flight(State0#state{connection_states = ConnectionStates}); - Transport:send(Socket, Encoded), - State0#state{flight_buffer = [], connection_states = ConnectionStates}. +send_handshake_flight(#state{socket = Socket, + transport_cb = Transport, + flight_buffer = #{handshakes := [_|_] = Flight0, + change_cipher_spec := ChangeCipher, + handshakes_after_change_cipher_spec := Flight1}, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Epoch) -> + {HsBefore, ConnectionStates1} = + encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch-1, ConnectionStates0), + {EncChangeCipher, ConnectionStates2} = + encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates1), + {HsAfter, ConnectionStates} = + encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates2), + send(Transport, Socket, [HsBefore, EncChangeCipher, HsAfter]), + start_flight(State0#state{connection_states = ConnectionStates}); -queue_change_cipher(Msg, State) -> - queue_flight_buffer(Msg, State). +send_handshake_flight(#state{socket = Socket, + transport_cb = Transport, + flight_buffer = #{handshakes := [], + change_cipher_spec := ChangeCipher, + handshakes_after_change_cipher_spec := Flight1}, + negotiated_version = Version, + connection_states = ConnectionStates0} = State0, Epoch) -> + {EncChangeCipher, ConnectionStates1} = + encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates0), + {HsAfter, ConnectionStates} = + encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates1), + send(Transport, Socket, [EncChangeCipher, HsAfter]), + start_flight(State0#state{connection_states = ConnectionStates}). + +queue_change_cipher(ChangeCipher, #state{flight_buffer = Flight, + connection_states = ConnectionStates0} = State) -> + ConnectionStates = + dtls_record:next_epoch(ConnectionStates0, write), + State#state{flight_buffer = Flight#{change_cipher_spec => ChangeCipher}, + connection_states = ConnectionStates}. send_alert(Alert, #state{negotiated_version = Version, socket = Socket, transport_cb = Transport, connection_states = ConnectionStates0} = State0) -> {BinMsg, ConnectionStates} = - ssl_alert:encode(Alert, Version, ConnectionStates0), - Transport:send(Socket, BinMsg), + encode_alert(Alert, Version, ConnectionStates0), + send(Transport, Socket, BinMsg), State0#state{connection_states = ConnectionStates}. close(downgrade, _,_,_,_) -> ok; %% Other close(_, Socket, Transport, _,_) -> - Transport:close(Socket). + dtls_socket:close(Transport,Socket). 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(), protocol_buffers = - Buffers#protocol_buffers{dtls_fragment_state = - dtls_handshake:dtls_handshake_new_flight(0)}}. + Buffers#protocol_buffers{ + dtls_handshake_next_seq = 0, + dtls_handshake_next_fragments = [], + dtls_handshake_later_fragments = [] + }}. select_sni_extension(#client_hello{extensions = HelloExtensions}) -> HelloExtensions#hello_extensions.sni; @@ -160,7 +219,7 @@ select_sni_extension(_) -> %%-------------------------------------------------------------------- -spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> - {ok, pid()} | ignore | {error, reason()}. + {ok, pid()} | ignore | {error, reason()}. %% %% Description: Creates a gen_fsm process which calls Module:init/1 to %% initialize. To ensure a synchronized start-up procedure, this function @@ -191,7 +250,6 @@ init({call, From}, {start, Timeout}, #state{host = Host, port = Port, role = client, ssl_options = SslOpts, session = #session{own_certificate = Cert} = Session0, - transport_cb = Transport, socket = Socket, connection_states = ConnectionStates0, renegotiation = {Renegotiation, _}, session_cache = Cache, @@ -199,23 +257,26 @@ init({call, From}, {start, Timeout}, } = State0) -> Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From), Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, - Cache, CacheCb, Renegotiation, Cert), - + Cache, CacheCb, Renegotiation, Cert), + Version = Hello#client_hello.client_version, HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), - Handshake0 = ssl_handshake:init_handshake_history(), - {BinMsg, ConnectionStates, Handshake} = - encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0), - Transport:send(Socket, BinMsg), - State1 = State0#state{connection_states = ConnectionStates, - negotiated_version = Version, %% Requested version + State1 = prepare_flight(State0#state{negotiated_version = Version}), + State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), + State3 = State2#state{negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, - tls_handshake_history = Handshake, start_or_recv_from = From, timer = Timer}, - {Record, State} = next_record(State1), + {Record, State} = next_record(State3), next_event(hello, Record, State); +init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = State) -> + ssl_connection:init(Type, Event, + State#state{flight_state = {waiting, undefined, ?INITIAL_RETRANSMIT_TIMEOUT}}, + ?MODULE); +init({call, _} = Type, Event, #state{role = server} = State) -> + %% I.E. DTLS over sctp + ssl_connection:init(Type, Event, State#state{flight_state = reliable}, ?MODULE); init(Type, Event, State) -> ssl_connection:init(Type, Event, State, ?MODULE). @@ -232,34 +293,53 @@ error(_, _, _) -> #state{}) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- -hello(internal, #client_hello{client_version = ClientVersion} = Hello, - State = #state{connection_states = ConnectionStates0, - port = Port, session = #session{own_certificate = Cert} = Session0, - renegotiation = {Renegotiation, _}, - session_cache = Cache, - session_cache_cb = CacheCb, - negotiated_protocol = CurrentProtocol, - key_algorithm = KeyExAlg, - ssl_options = SslOpts}) -> - - case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, - ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, ClientVersion, hello, State); - {Version, {Type, Session}, - ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> - Protocol = case Protocol0 of - undefined -> CurrentProtocol; - _ -> Protocol0 - end, - - ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt}, - State#state{connection_states = ConnectionStates, - negotiated_version = Version, - hashsign_algorithm = HashSign, - session = Session, - negotiated_protocol = Protocol}, ?MODULE) +hello(internal, #client_hello{cookie = <<>>, + client_version = Version} = Hello, #state{role = server, + transport_cb = Transport, + socket = Socket} = State0) -> + %% TODO: not hard code key + {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket), + Cookie = dtls_handshake:cookie(<<"secret">>, IP, Port, Hello), + VerifyRequest = dtls_handshake:hello_verify_request(Cookie, Version), + State1 = prepare_flight(State0#state{negotiated_version = Version}), + State2 = send_handshake(VerifyRequest, State1), + {Record, State} = next_record(State2), + next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}); +hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server, + transport_cb = Transport, + socket = Socket} = State0) -> + {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket), + %% TODO: not hard code key + case dtls_handshake:cookie(<<"secret">>, IP, Port, Hello) of + Cookie -> + handle_client_hello(Hello, State0); + _ -> + %% Handle bad cookie as new cookie request RFC 6347 4.1.2 + hello(internal, Hello#client_hello{cookie = <<>>}, State0) end; +hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client, + host = Host, port = Port, + ssl_options = SslOpts, + session = #session{own_certificate = OwnCert} + = Session0, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb + } = State0) -> + State1 = prepare_flight(State0#state{tls_handshake_history = ssl_handshake:init_handshake_history()}), + Hello = dtls_handshake:client_hello(Host, Port, Cookie, ConnectionStates0, + SslOpts, + Cache, CacheCb, Renegotiation, OwnCert), + Version = Hello#client_hello.client_version, + HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), + State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), + State3 = State2#state{negotiated_version = Version, %% Requested version + session = + Session0#session{session_id = + Hello#client_hello.session_id}}, + {Record, State} = next_record(State3), + next_event(hello, Record, State); hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, @@ -273,24 +353,49 @@ hello(internal, #server_hello{} = Hello, ssl_connection:handle_session(Hello, Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; +hello(internal, {handshake, {#client_hello{cookie = <<>>} = Handshake, _}}, State) -> + %% Initial hello should not be in handshake history + {next_state, hello, State, [{next_event, internal, Handshake}]}; + +hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) -> + %% hello_verify should not be in handshake history + {next_state, hello, State, [{next_event, internal, Handshake}]}; + hello(info, Event, State) -> handle_info(Event, hello, State); - hello(Type, Event, State) -> ssl_connection:hello(Type, Event, State, ?MODULE). abbreviated(info, Event, State) -> handle_info(Event, abbreviated, State); +abbreviated(internal = Type, + #change_cipher_spec{type = <<1>>} = Event, + #state{connection_states = ConnectionStates0} = State) -> + ConnectionStates1 = dtls_record:save_current_connection_state(ConnectionStates0, read), + ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read), + ssl_connection:abbreviated(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE); +abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) -> + ssl_connection:cipher(Type, Event, prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE); abbreviated(Type, Event, State) -> ssl_connection:abbreviated(Type, Event, State, ?MODULE). certify(info, Event, State) -> handle_info(Event, certify, State); +certify(internal = Type, #server_hello_done{} = Event, State) -> + ssl_connection:certify(Type, Event, prepare_flight(State), ?MODULE); certify(Type, Event, State) -> ssl_connection:certify(Type, Event, State, ?MODULE). cipher(info, Event, State) -> handle_info(Event, cipher, State); +cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event, + #state{connection_states = ConnectionStates0} = State) -> + ConnectionStates1 = dtls_record:save_current_connection_state(ConnectionStates0, read), + ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read), + ssl_connection:cipher(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE); +cipher(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) -> + ssl_connection:cipher(Type, Event, + prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE); cipher(Type, Event, State) -> ssl_connection:cipher(Type, Event, State, ?MODULE). @@ -310,7 +415,6 @@ connection(internal, #hello_request{}, #state{host = Host, port = Port, State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), next_event(hello, Record, State); - connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html @@ -319,14 +423,11 @@ connection(internal, #client_hello{} = Hello, #state{role = server, allow_renego %% renegotiations immediately after each other. erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), {next_state, hello, State#state{allow_renegotiate = false}, [{next_event, internal, Hello}]}; - - connection(internal, #client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), State1 = send_alert(Alert, State0), {Record, State} = ssl_connection:prepare_connection(State1, ?MODULE), next_event(connection, Record, State); - connection(Type, Event, State) -> ssl_connection:connection(Type, Event, State, ?MODULE). @@ -341,15 +442,25 @@ downgrade(Type, Event, State) -> %%-------------------------------------------------------------------- %% raw data from socket, unpack records -handle_info({Protocol, _, Data}, StateName, +handle_info({_,flight_retransmission_timeout}, connection, _) -> + {next_state, keep_state_and_data}; +handle_info({Ref, flight_retransmission_timeout}, StateName, + #state{flight_state = {waiting, Ref, NextTimeout}} = State0) -> + State1 = send_handshake_flight(State0#state{flight_state = {retransmit_timer, NextTimeout}}, + retransmit_epoch(StateName, State0)), + {Record, State} = next_record(State1), + next_event(StateName, Record, State); +handle_info({_, flight_retransmission_timeout}, _, _) -> + {next_state, keep_state_and_data}; +handle_info({Protocol, _, _, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - case next_tls_record(Data, State0) of + case next_dtls_record(Data, State0) of {Record, State} -> next_event(StateName, Record, State); #alert{} = Alert -> ssl_connection:handle_normal_shutdown(Alert, StateName, State0), {stop, {shutdown, own_alert}} - end; + end; handle_info({CloseTag, Socket}, StateName, #state{socket = Socket, close_tag = CloseTag, negotiated_version = Version} = State) -> @@ -380,23 +491,26 @@ handle_common_event(internal, #alert{} = Alert, StateName, ssl_connection:handle_own_alert(Alert, Version, StateName, State); %%% DTLS record protocol level handshake messages -handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE} = Record, +handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, + fragment = Data}, StateName, - #state{protocol_buffers = - #protocol_buffers{dtls_packets = Packets0, - dtls_fragment_state = HsState0} = Buffers, + #state{protocol_buffers = Buffers0, negotiated_version = Version} = State0) -> try - {Packets1, HsState} = dtls_handshake:get_dtls_handshake(Record, HsState0), - State = - State0#state{protocol_buffers = - Buffers#protocol_buffers{dtls_fragment_state = HsState}}, - Events = dtls_handshake_events(Packets0 ++ Packets1), - case StateName of - connection -> - ssl_connection:hibernate_after(StateName, State, Events); - _ -> - {next_state, StateName, State, Events} + case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of + {more_data, Buffers} -> + {Record, State} = next_record(State0#state{protocol_buffers = Buffers}), + next_event(StateName, Record, State); + {Packets, Buffers} -> + State = State0#state{protocol_buffers = Buffers}, + Events = dtls_handshake_events(Packets), + case StateName of + connection -> + ssl_connection:hibernate_after(StateName, State, Events); + _ -> + {next_state, StateName, + State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} + end end catch throw:#alert{} = Alert -> ssl_connection:handle_own_alert(Alert, Version, StateName, State0) @@ -420,6 +534,10 @@ handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, Sta handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> {next_state, StateName, State}. +send(Transport, {_, {{_,_}, _} = Socket}, Data) -> + send(Transport, Socket, Data); +send(Transport, Socket, Data) -> + dtls_socket:send(Transport, Socket, Data). %%-------------------------------------------------------------------- %% Description:This function is called by a gen_fsm when it is about %% to terminate. It should be the opposite of Module:init/1 and do any @@ -442,96 +560,56 @@ format_status(Type, Data) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, + #state{connection_states = ConnectionStates0, + port = Port, session = #session{own_certificate = Cert} = Session0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb, + negotiated_protocol = CurrentProtocol, + key_algorithm = KeyExAlg, + ssl_options = SslOpts} = State0) -> + + case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, + ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of + #alert{} = Alert -> + ssl_connection:handle_own_alert(Alert, ClientVersion, hello, State0); + {Version, {Type, Session}, + ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> + Protocol = case Protocol0 of + undefined -> CurrentProtocol; + _ -> Protocol0 + end, -dtls_handshake_events([]) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake)); -dtls_handshake_events(Packets) -> - lists:map(fun(Packet) -> - {next_event, internal, {handshake, Packet}} - end, Packets). - - -encode_handshake(Handshake, Version, ConnectionStates0, Hist0) -> - {Seq, ConnectionStates} = sequence(ConnectionStates0), - {EncHandshake, Frag} = dtls_handshake:encode_handshake(Handshake, Version, Seq), - %% DTLS does not have an equivalent version to SSLv2. So v2 hello compatibility - %% will always be false - Hist = ssl_handshake:update_handshake_history(Hist0, EncHandshake, false), - {Frag, ConnectionStates, Hist}. - -encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> - dtls_record:encode_change_cipher_spec(Version, ConnectionStates). + State = prepare_flight(State0#state{connection_states = ConnectionStates, + negotiated_version = Version, + hashsign_algorithm = HashSign, + session = Session, + negotiated_protocol = Protocol}), + + ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt}, + State, ?MODULE) + end. -encode_handshake_flight(Flight, ConnectionStates) -> - MSS = 1400, - encode_handshake_records(Flight, ConnectionStates, MSS, init_pack_records()). +encode_handshake_flight(Flight, Version, MaxFragmentSize, Epoch, ConnectionStates) -> + Fragments = lists:map(fun(Handshake) -> + dtls_handshake:fragment_handshake(Handshake, MaxFragmentSize) + end, Flight), + dtls_record:encode_handshake(Fragments, Version, Epoch, ConnectionStates). -encode_handshake_records([], CS, _MSS, Recs) -> - {finish_pack_records(Recs), CS}; +encode_change_cipher(#change_cipher_spec{}, Version, Epoch, ConnectionStates) -> + dtls_record:encode_change_cipher_spec(Version, Epoch, ConnectionStates). -encode_handshake_records([{Version, _Epoch, Frag = #change_cipher_spec{}}|Tail], ConnectionStates0, MSS, Recs0) -> - {Encoded, ConnectionStates} = - encode_change_cipher(Frag, Version, ConnectionStates0), - Recs = append_pack_records([Encoded], MSS, Recs0), - encode_handshake_records(Tail, ConnectionStates, MSS, Recs); - -encode_handshake_records([{Version, Epoch, {MsgType, MsgSeq, Bin}}|Tail], CS0, MSS, Recs0 = {Buf0, _}) -> - Space = MSS - iolist_size(Buf0), - Len = byte_size(Bin), - {Encoded, CS} = - encode_handshake_record(Version, Epoch, Space, MsgType, MsgSeq, Len, Bin, 0, MSS, [], CS0), - Recs = append_pack_records(Encoded, MSS, Recs0), - encode_handshake_records(Tail, CS, MSS, Recs). - -%% TODO: move to dtls_handshake???? -encode_handshake_record(_Version, _Epoch, _Space, _MsgType, _MsgSeq, _Len, <<>>, _Offset, _MRS, Encoded, CS) - when length(Encoded) > 0 -> - %% make sure we encode at least one segment (for empty messages like Server Hello Done - {lists:reverse(Encoded), CS}; - -encode_handshake_record(Version, Epoch, Space, MsgType, MsgSeq, Len, Bin, - Offset, MRS, Encoded0, CS0) -> - MaxFragmentLen = Space - 25, - {BinFragment, Rest} = - case Bin of - <<BinFragment0:MaxFragmentLen/bytes, Rest0/binary>> -> - {BinFragment0, Rest0}; - _ -> - {Bin, <<>>} - end, - FragLength = byte_size(BinFragment), - Frag = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(Offset), ?uint24(FragLength), BinFragment], - %% TODO Real solution, now avoid dialyzer error {Encoded, CS} = ssl_record:encode_handshake({Epoch, Frag}, Version, CS0), - {Encoded, CS} = ssl_record:encode_handshake(Frag, Version, CS0), - encode_handshake_record(Version, Epoch, MRS, MsgType, MsgSeq, Len, Rest, Offset + FragLength, MRS, [Encoded|Encoded0], CS). - -init_pack_records() -> - {[], []}. - -append_pack_records([], MSS, Recs = {Buf0, Acc0}) -> - Remaining = MSS - iolist_size(Buf0), - if Remaining < 12 -> - {[], [lists:reverse(Buf0)|Acc0]}; - true -> - Recs - end; -append_pack_records([Head|Tail], MSS, {Buf0, Acc0}) -> - TotLen = iolist_size(Buf0) + iolist_size(Head), - if TotLen > MSS -> - append_pack_records(Tail, MSS, {[Head], [lists:reverse(Buf0)|Acc0]}); - true -> - append_pack_records(Tail, MSS, {[Head|Buf0], Acc0}) - end. +encode_data(Data, Version, ConnectionStates0)-> + dtls_record:encode_data(Data, Version, ConnectionStates0). -finish_pack_records({[], Acc}) -> - lists:reverse(Acc); -finish_pack_records({Buf, Acc}) -> - lists:reverse([lists:reverse(Buf)|Acc]). +encode_alert(#alert{} = Alert, Version, ConnectionStates) -> + dtls_record:encode_alert_record(Alert, Version, ConnectionStates). decode_alerts(Bin) -> ssl_alert:decode(Bin). -initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, +initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, {CbModule, DataTag, CloseTag, ErrorTag}) -> #ssl_options{beast_mitigation = BeastMitigation} = SSLOptions, ConnectionStates = dtls_record:init_connection_states(Role, BeastMitigation), @@ -566,10 +644,11 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, renegotiation = {false, first}, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, - protocol_cb = ?MODULE + protocol_cb = ?MODULE, + flight_buffer = new_flight() }. -next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{ +next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ dtls_record_buffer = Buf0, dtls_cipher_texts = CT0} = Buffers} = State0) -> case dtls_record:get_dtls_records(Data, Buf0) of @@ -578,14 +657,15 @@ next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{ next_record(State0#state{protocol_buffers = Buffers#protocol_buffers{dtls_record_buffer = Buf1, dtls_cipher_texts = CT1}}); - #alert{} = Alert -> Alert - end. + end. -next_record(#state{%%flight = #flight{state = finished}, - protocol_buffers = - #protocol_buffers{dtls_packets = [], dtls_cipher_texts = [CT | Rest]} +next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> + {no_record, State#state{unprocessed_handshake_events = N-1}}; + +next_record(#state{protocol_buffers = + #protocol_buffers{dtls_cipher_texts = [CT | Rest]} = Buffers, connection_states = ConnStates0} = State) -> case dtls_record:decode_cipher_text(CT, ConnStates0) of @@ -596,9 +676,15 @@ next_record(#state{%%flight = #flight{state = finished}, #alert{} = Alert -> {Alert, State} end; -next_record(#state{socket = Socket, - transport_cb = Transport} = State) -> %% when FlightState =/= finished - ssl_socket:setopts(Transport, Socket, [{active,once}]), +next_record(#state{role = server, + socket = {Listener, {Client, _}}, + transport_cb = gen_udp} = State) -> + dtls_udp_listener:active_once(Listener, Client, self()), + {no_record, State}; +next_record(#state{role = client, + socket = {_Server, Socket}, + transport_cb = Transport} = State) -> + dtls_socket:setopts(Transport, Socket, [{active,once}]), {no_record, State}; next_record(State) -> {no_record, State}. @@ -624,75 +710,89 @@ passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> next_event(StateName, Record, State) -> next_event(StateName, Record, State, []). -next_event(connection = StateName, no_record, State0, Actions) -> +next_event(connection = StateName, no_record, + #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> case next_record_if_active(State0) of {no_record, State} -> ssl_connection:hibernate_after(StateName, State, Actions); - {#ssl_tls{} = Record, State} -> + {#ssl_tls{epoch = CurrentEpoch} = Record, State} -> {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; + {#ssl_tls{epoch = Epoch, + type = ?HANDSHAKE, + version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> + State = send_handshake_flight(State1, Epoch), + {next_state, StateName, State, Actions}; + {#ssl_tls{epoch = _Epoch, + version = _Version}, State} -> + %% TODO maybe buffer later epoch + {next_state, StateName, State, Actions}; {#alert{} = Alert, State} -> {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end; -next_event(StateName, Record, State, Actions) -> +next_event(StateName, Record, + #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State, Actions) -> case Record of no_record -> {next_state, StateName, State, Actions}; - #ssl_tls{} = Record -> - {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; + #ssl_tls{epoch = CurrentEpoch, + version = Version} = Record -> + {next_state, StateName, + dtls_version(StateName, Version, State), + [{next_event, internal, {protocol_record, Record}} | Actions]}; + #ssl_tls{epoch = _Epoch, + version = _Version} = _Record -> + %% TODO maybe buffer later epoch + {next_state, StateName, State, Actions}; #alert{} = Alert -> {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. -%% TODO This generates dialyzer warnings, has to be handled differently. -%% handle_packet(Address, Port, Packet) -> -%% try dtls_record:get_dtls_records(Packet, <<>>) of -%% %% expect client hello -%% {[#ssl_tls{type = ?HANDSHAKE, version = {254, _}} = Record], <<>>} -> -%% handle_dtls_client_hello(Address, Port, Record); -%% _Other -> -%% {error, not_dtls} -%% catch -%% _Class:_Error -> -%% {error, not_dtls} -%% end. - -%% handle_dtls_client_hello(Address, Port, -%% #ssl_tls{epoch = Epoch, sequence_number = Seq, -%% version = Version} = Record) -> -%% {[{Hello, _}], _} = -%% dtls_handshake:get_dtls_handshake(Record, -%% dtls_handshake:dtls_handshake_new_flight(undefined)), -%% #client_hello{client_version = {Major, Minor}, -%% random = Random, -%% session_id = SessionId, -%% cipher_suites = CipherSuites, -%% compression_methods = CompressionMethods} = Hello, -%% CookieData = [address_to_bin(Address, Port), -%% <<?BYTE(Major), ?BYTE(Minor)>>, -%% Random, SessionId, CipherSuites, CompressionMethods], -%% Cookie = crypto:hmac(sha, <<"secret">>, CookieData), - -%% case Hello of -%% #client_hello{cookie = Cookie} -> -%% accept; - -%% _ -> -%% %% generate HelloVerifyRequest -%% {RequestFragment, _} = dtls_handshake:encode_handshake( -%% dtls_handshake:hello_verify_request(Cookie), -%% Version, 0), -%% HelloVerifyRequest = -%% dtls_record:encode_tls_cipher_text(?HANDSHAKE, Version, Epoch, Seq, RequestFragment), -%% {reply, HelloVerifyRequest} -%% end. - -%% address_to_bin({A,B,C,D}, Port) -> -%% <<0:80,16#ffff:16,A,B,C,D,Port:16>>; -%% address_to_bin({A,B,C,D,E,F,G,H}, Port) -> -%% <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,Port:16>>. - -sequence(#{write_msg_seq := Seq} = ConnectionState) -> - {Seq, ConnectionState#{write_msg_seq => Seq + 1}}. +dtls_version(hello, Version, #state{role = server} = State) -> + State#state{negotiated_version = Version}; %%Inital version +dtls_version(_,_, State) -> + State. + +prepare_flight(#state{flight_buffer = Flight, + connection_states = ConnectionStates0, + protocol_buffers = + #protocol_buffers{} = Buffers} = State) -> + ConnectionStates = dtls_record:save_current_connection_state(ConnectionStates0, write), + State#state{flight_buffer = next_flight(Flight), + connection_states = ConnectionStates, + protocol_buffers = Buffers#protocol_buffers{ + dtls_handshake_next_fragments = [], + dtls_handshake_later_fragments = []}}. +new_flight() -> + #{next_sequence => 0, + handshakes => [], + change_cipher_spec => undefined, + handshakes_after_change_cipher_spec => []}. + +next_flight(Flight) -> + Flight#{handshakes => [], + change_cipher_spec => undefined, + handshakes_after_change_cipher_spec => []}. + + +start_flight(#state{transport_cb = gen_udp, + flight_state = {retransmit_timer, Timeout}} = State) -> + Ref = erlang:make_ref(), + _ = erlang:send_after(Timeout, self(), {Ref, flight_retransmission_timeout}), + State#state{flight_state = {waiting, Ref, new_timeout(Timeout)}}; + +start_flight(State) -> + %% No retransmision needed i.e DTLS over SCTP + State#state{flight_state = reliable}. + +new_timeout(N) when N =< 30 -> + N * 2; +new_timeout(_) -> + 60. + +dtls_handshake_events(Packets) -> + lists:map(fun(Packet) -> + {next_event, internal, {handshake, Packet}} + end, Packets). renegotiate(#state{role = client} = State, Actions) -> %% Handle same way as if server requested @@ -722,3 +822,27 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)); handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)). + +retransmit_epoch(StateName, #state{connection_states = ConnectionStates}) -> + #{epoch := Epoch} = + ssl_record:current_connection_state(ConnectionStates, write), + case StateName of + connection -> + Epoch-1; + _ -> + Epoch + end. + +update_handshake_history(#hello_verify_request{}, _, Hist) -> + Hist; +update_handshake_history(_, Handshake, Hist) -> + %% DTLS never needs option "v2_hello_compatible" to be true + ssl_handshake:update_handshake_history(Hist, iolist_to_binary(Handshake), false). + +unprocessed_events(Events) -> + %% The first handshake event will be processed immediately + %% as it is entered first in the event queue and + %% when it is processed there will be length(Events)-1 + %% handshake events left to process before we should + %% process more TLS-records received on the socket. + erlang:length(Events)-1. diff --git a/lib/ssl/src/dtls_connection.hrl b/lib/ssl/src/dtls_connection.hrl index ee3daa3c14..3dd78235d0 100644 --- a/lib/ssl/src/dtls_connection.hrl +++ b/lib/ssl/src/dtls_connection.hrl @@ -29,20 +29,14 @@ -include("ssl_connection.hrl"). -record(protocol_buffers, { - dtls_packets = [], %%::[binary()], % Not yet handled decode ssl/tls packets. - dtls_record_buffer = <<>>, %%:: binary(), % Buffer of incomplete records - dtls_fragment_state, %%:: [], % DTLS fragments - dtls_handshake_buffer = <<>>, %%:: binary(), % Buffer of incomplete handshakes - dtls_cipher_texts = [], %%:: [binary()], - dtls_cipher_texts_next %%:: [binary()] % Received for Epoch not yet active + dtls_record_buffer = <<>>, %% Buffer of incomplete records + dtls_handshake_next_seq = 0, + dtls_flight_last, + dtls_handshake_next_fragments = [], %% Fragments of the next handshake message + dtls_handshake_later_fragments = [], %% Fragments of handsake messages come after the one in next buffer + dtls_cipher_texts = [] %%:: [binary()], }). --record(flight, { - last_retransmit, - last_read_seq, - msl_timer, - state, - buffer % buffer of not yet ACKed TLS records - }). +-define(INITIAL_RETRANSMIT_TIMEOUT, 1000). %1 sec -endif. % -ifdef(dtls_connection). diff --git a/lib/ssl/src/dtls_connection_sup.erl b/lib/ssl/src/dtls_connection_sup.erl index dc7601a684..7d7be5743d 100644 --- a/lib/ssl/src/dtls_connection_sup.erl +++ b/lib/ssl/src/dtls_connection_sup.erl @@ -60,7 +60,7 @@ init(_O) -> StartFunc = {dtls_connection, start_link, []}, Restart = temporary, % E.g. should not be restarted Shutdown = 4000, - Modules = [dtls_connection], + Modules = [dtls_connection, ssl_connection], Type = worker, ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index c6535d5928..af3708ddb7 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -18,15 +18,15 @@ %% %CopyrightEnd% -module(dtls_handshake). +-include("dtls_connection.hrl"). -include("dtls_handshake.hrl"). -include("dtls_record.hrl"). -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). --export([client_hello/8, client_hello/9, hello/4, - hello_verify_request/1, get_dtls_handshake/2, - dtls_handshake_new_flight/1, dtls_handshake_new_epoch/1, - encode_handshake/3]). +-export([client_hello/8, client_hello/9, cookie/4, hello/4, + hello_verify_request/2, get_dtls_handshake/3, fragment_handshake/2, + handshake_bin/2, encode_handshake/3]). -type dtls_handshake() :: #client_hello{} | #hello_verify_request{} | ssl_handshake:ssl_handshake(). @@ -62,9 +62,10 @@ client_hello(Host, Port, Cookie, ConnectionStates, Version = dtls_record:highest_protocol_version(Versions), Pending = ssl_record:pending_connection_state(ConnectionStates, read), SecParams = maps:get(security_parameters, Pending), - CipherSuites = ssl_handshake:available_suites(UserSuites, Version), + TLSVersion = dtls_v1:corresponding_tls_version(Version), + CipherSuites = ssl_handshake:available_suites(UserSuites, TLSVersion), - Extensions = ssl_handshake:client_hello_extensions(Host, dtls_v1:corresponding_tls_version(Version), CipherSuites, + Extensions = ssl_handshake:client_hello_extensions(Host, TLSVersion, CipherSuites, SslOpts, ConnectionStates, Renegotiation), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), @@ -96,72 +97,51 @@ hello(#client_hello{client_version = ClientVersion} = Hello, #ssl_options{versions = Versions} = SslOpts, Info, Renegotiation) -> Version = ssl_handshake:select_version(dtls_record, ClientVersion, Versions), - %% - %% TODO: handle Cipher Fallback - %% handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation). --spec hello_verify_request(binary()) -> #hello_verify_request{}. +cookie(Key, Address, Port, #client_hello{client_version = {Major, Minor}, + random = Random, + session_id = SessionId, + cipher_suites = CipherSuites, + compression_methods = CompressionMethods}) -> + CookieData = [address_to_bin(Address, Port), + <<?BYTE(Major), ?BYTE(Minor)>>, + Random, SessionId, CipherSuites, CompressionMethods], + crypto:hmac(sha, Key, CookieData). + +-spec hello_verify_request(binary(), dtls_record:dtls_version()) -> #hello_verify_request{}. %% %% Description: Creates a hello verify request message sent by server to %% verify client %%-------------------------------------------------------------------- -hello_verify_request(Cookie) -> - %% TODO: DTLS Versions????? - #hello_verify_request{protocol_version = {254, 255}, cookie = Cookie}. +hello_verify_request(Cookie, Version) -> + #hello_verify_request{protocol_version = Version, cookie = Cookie}. %%-------------------------------------------------------------------- -%% %%-------------------------------------------------------------------- -encode_handshake(Handshake, Version, MsgSeq) -> +encode_handshake(Handshake, Version, Seq) -> {MsgType, Bin} = enc_handshake(Handshake, Version), Len = byte_size(Bin), - Enc = [MsgType, ?uint24(Len), ?uint16(MsgSeq), ?uint24(0), ?uint24(Len), Bin], - Frag = {MsgType, MsgSeq, Bin}, - {Enc, Frag}. + [MsgType, ?uint24(Len), ?uint16(Seq), ?uint24(0), ?uint24(Len), Bin]. -%%-------------------------------------------------------------------- --spec get_dtls_handshake(#ssl_tls{}, #dtls_hs_state{} | undefined) -> - {[dtls_handshake()], #dtls_hs_state{}} | {retransmit, #dtls_hs_state{}}. -%% -%% Description: Given a DTLS state and new data from ssl_record, collects -%% and returns it as a list of handshake messages, also returns a new -%% DTLS state -%%-------------------------------------------------------------------- -get_dtls_handshake(Records, undefined) -> - HsState = #dtls_hs_state{highest_record_seq = 0, - starting_read_seq = 0, - fragments = gb_trees:empty(), - completed = []}, - get_dtls_handshake(Records, HsState); -get_dtls_handshake(Records, HsState0) when is_list(Records) -> - HsState1 = lists:foldr(fun get_dtls_handshake_aux/2, HsState0, Records), - get_dtls_handshake_completed(HsState1); -get_dtls_handshake(Record, HsState0) when is_record(Record, ssl_tls) -> - HsState1 = get_dtls_handshake_aux(Record, HsState0), - get_dtls_handshake_completed(HsState1). +fragment_handshake(Bin, _) when is_binary(Bin)-> + %% This is the change_cipher_spec not a "real handshake" but part of the flight + Bin; +fragment_handshake([MsgType, Len, Seq, _, Len, Bin], Size) -> + Bins = bin_fragments(Bin, Size), + handshake_fragments(MsgType, Seq, Len, Bins, []). +handshake_bin([Type, Length, Data], Seq) -> + handshake_bin(Type, Length, Seq, Data). + %%-------------------------------------------------------------------- --spec dtls_handshake_new_epoch(#dtls_hs_state{}) -> #dtls_hs_state{}. +-spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) -> + {[{dtls_handshake(), binary()}], #protocol_buffers{}} | {more_data, #protocol_buffers{}}. %% -%% Description: Reset the DTLS decoder state for a new Epoch +%% Description: ... %%-------------------------------------------------------------------- -%% dtls_handshake_new_epoch(<<>>) -> -%% dtls_hs_state_init(); -dtls_handshake_new_epoch(HsState) -> - HsState#dtls_hs_state{highest_record_seq = 0, - starting_read_seq = HsState#dtls_hs_state.current_read_seq, - fragments = gb_trees:empty(), completed = []}. - -%-------------------------------------------------------------------- --spec dtls_handshake_new_flight(integer() | undefined) -> #dtls_hs_state{}. -% -% Description: Init the DTLS decoder state for a new Flight -dtls_handshake_new_flight(ExpectedReadReq) -> - #dtls_hs_state{current_read_seq = ExpectedReadReq, - highest_record_seq = 0, - starting_read_seq = 0, - fragments = gb_trees:empty(), completed = []}. +get_dtls_handshake(Version, Fragment, ProtocolBuffers) -> + handle_fragments(Version, Fragment, ProtocolBuffers, []). %%-------------------------------------------------------------------- %%% Internal functions @@ -170,27 +150,29 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId, cipher_suites = CipherSuites, compression_methods = Compressions, random = Random, - extensions = #hello_extensions{elliptic_curves = Curves, - signature_algs = ClientHashSigns} = HelloExt}, + extensions = + #hello_extensions{elliptic_curves = Curves, + signature_algs = ClientHashSigns} = HelloExt}, #ssl_options{versions = Versions, signature_algs = SupportedHashSigns} = SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, Renegotiation) -> case dtls_record:is_acceptable_version(Version, Versions) of true -> + TLSVersion = dtls_v1:corresponding_tls_version(Version), AvailableHashSigns = ssl_handshake:available_signature_algs( - ClientHashSigns, SupportedHashSigns, Cert, - dtls_v1:corresponding_tls_version(Version)), - ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(Version)), + ClientHashSigns, SupportedHashSigns, Cert,TLSVersion), + ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(TLSVersion)), {Type, #session{cipher_suite = CipherSuite} = Session1} = ssl_handshake:select_session(SugesstedId, CipherSuites, AvailableHashSigns, Compressions, - Port, Session0#session{ecc = ECCCurve}, Version, + Port, Session0#session{ecc = ECCCurve}, TLSVersion, SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> {KeyExAlg,_,_,_} = ssl_cipher:suite_definition(CipherSuite), - case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, SupportedHashSigns, Version) of + case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, + SupportedHashSigns, TLSVersion) of #alert{} = Alert -> Alert; HashSign -> @@ -228,214 +210,15 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. -get_dtls_handshake_completed(HsState = #dtls_hs_state{completed = Completed}) -> - {lists:reverse(Completed), HsState#dtls_hs_state{completed = []}}. - -get_dtls_handshake_aux(#ssl_tls{version = Version, - sequence_number = SeqNo, - fragment = Data}, HsState) -> - get_dtls_handshake_aux(Version, SeqNo, Data, HsState). - -get_dtls_handshake_aux(Version, SeqNo, - <<?BYTE(Type), ?UINT24(Length), - ?UINT16(MessageSeq), - ?UINT24(FragmentOffset), ?UINT24(FragmentLength), - Body:FragmentLength/binary, Rest/binary>>, - HsState0) -> - case reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, HsState0) of - {HsState1, HighestSeqNo, MsgBody} -> - HsState2 = dec_dtls_fragment(Version, HighestSeqNo, Type, Length, MessageSeq, MsgBody, HsState1), - HsState3 = process_dtls_fragments(Version, HsState2), - get_dtls_handshake_aux(Version, SeqNo, Rest, HsState3); - - HsState2 -> - HsState3 = process_dtls_fragments(Version, HsState2), - get_dtls_handshake_aux(Version, SeqNo, Rest, HsState3) - end; - -get_dtls_handshake_aux(_Version, _SeqNo, <<>>, HsState) -> - HsState. - -dec_dtls_fragment(Version, SeqNo, Type, Length, MessageSeq, MsgBody, - HsState = #dtls_hs_state{highest_record_seq = HighestSeqNo, completed = Acc}) -> - Raw = <<?BYTE(Type), ?UINT24(Length), ?UINT16(MessageSeq), ?UINT24(0), ?UINT24(Length), MsgBody/binary>>, - H = decode_handshake(Version, Type, MsgBody), - HsState#dtls_hs_state{completed = [{H,Raw}|Acc], highest_record_seq = erlang:max(HighestSeqNo, SeqNo)}. - -process_dtls_fragments(Version, - HsState0 = #dtls_hs_state{current_read_seq = CurrentReadSeq, - fragments = Fragments0}) -> - case gb_trees:is_empty(Fragments0) of - true -> - HsState0; - _ -> - case gb_trees:smallest(Fragments0) of - {CurrentReadSeq, {SeqNo, Type, Length, CurrentReadSeq, {Length, [{0, Length}], MsgBody}}} -> - HsState1 = dtls_hs_state_process_seq(HsState0), - HsState2 = dec_dtls_fragment(Version, SeqNo, Type, Length, CurrentReadSeq, MsgBody, HsState1), - process_dtls_fragments(Version, HsState2); - _ -> - HsState0 - end - end. - -dtls_hs_state_process_seq(HsState0 = #dtls_hs_state{current_read_seq = CurrentReadSeq, - fragments = Fragments0}) -> - Fragments1 = gb_trees:delete_any(CurrentReadSeq, Fragments0), - HsState0#dtls_hs_state{current_read_seq = CurrentReadSeq + 1, - fragments = Fragments1}. - -dtls_hs_state_add_fragment(MessageSeq, Fragment, HsState0 = #dtls_hs_state{fragments = Fragments0}) -> - Fragments1 = gb_trees:enter(MessageSeq, Fragment, Fragments0), - HsState0#dtls_hs_state{fragments = Fragments1}. - -reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, 0, Length, - Body, HsState0 = #dtls_hs_state{current_read_seq = undefined}) - when Type == ?CLIENT_HELLO; - Type == ?SERVER_HELLO; - Type == ?HELLO_VERIFY_REQUEST -> - %% First message, should be client hello - %% return the current message and set the next expected Sequence - %% - %% Note: this could (should?) be restricted further, ClientHello and - %% HelloVerifyRequest have to have message_seq = 0, ServerHello - %% can have a message_seq of 0 or 1 - %% - {HsState0#dtls_hs_state{current_read_seq = MessageSeq + 1}, SeqNo, Body}; - -reassemble_dtls_fragment(_SeqNo, _Type, Length, _MessageSeq, _, Length, - _Body, HsState = #dtls_hs_state{current_read_seq = undefined}) -> - %% not what we expected, drop it - HsState; - -reassemble_dtls_fragment(SeqNo, _Type, Length, MessageSeq, 0, Length, - Body, HsState0 = - #dtls_hs_state{starting_read_seq = StartingReadSeq}) - when MessageSeq < StartingReadSeq -> - %% this has to be the start of a new flight, let it through - %% - %% Note: this could (should?) be restricted further, the first message of a - %% new flight has to have message_seq = 0 - %% - HsState = dtls_hs_state_process_seq(HsState0), - {HsState, SeqNo, Body}; - -reassemble_dtls_fragment(_SeqNo, _Type, Length, MessageSeq, 0, Length, - _Body, HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) - when MessageSeq < CurrentReadSeq -> - HsState; - -reassemble_dtls_fragment(SeqNo, _Type, Length, MessageSeq, 0, Length, - Body, HsState0 = #dtls_hs_state{current_read_seq = MessageSeq}) -> - %% Message fully contained and it's the current seq - HsState1 = dtls_hs_state_process_seq(HsState0), - {HsState1, SeqNo, Body}; - -reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, 0, Length, - Body, HsState) -> - %% Message fully contained and it's the NOT the current seq -> buffer - Fragment = {SeqNo, Type, Length, MessageSeq, - dtls_fragment_init(Length, 0, Length, Body)}, - dtls_hs_state_add_fragment(MessageSeq, Fragment, HsState); - -reassemble_dtls_fragment(_SeqNo, _Type, Length, MessageSeq, FragmentOffset, FragmentLength, - _Body, - HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) - when FragmentOffset + FragmentLength == Length andalso MessageSeq == (CurrentReadSeq - 1) -> - {retransmit, HsState}; - -reassemble_dtls_fragment(_SeqNo, _Type, _Length, MessageSeq, _FragmentOffset, _FragmentLength, - _Body, - HsState = #dtls_hs_state{current_read_seq = CurrentReadSeq}) - when MessageSeq < CurrentReadSeq -> - HsState; - -reassemble_dtls_fragment(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, - HsState = #dtls_hs_state{fragments = Fragments0}) -> - case gb_trees:lookup(MessageSeq, Fragments0) of - {value, Fragment} -> - dtls_fragment_reassemble(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, Fragment, HsState); - none -> - dtls_fragment_start(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, HsState) - end. -dtls_fragment_start(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, HsState = #dtls_hs_state{fragments = Fragments0}) -> - Fragment = {SeqNo, Type, Length, MessageSeq, - dtls_fragment_init(Length, FragmentOffset, FragmentLength, Body)}, - Fragments1 = gb_trees:insert(MessageSeq, Fragment, Fragments0), - HsState#dtls_hs_state{fragments = Fragments1}. - -dtls_fragment_reassemble(SeqNo, Type, Length, MessageSeq, - FragmentOffset, FragmentLength, - Body, - {LastSeqNo, Type, Length, MessageSeq, FragBuffer0}, - HsState = #dtls_hs_state{fragments = Fragments0}) -> - FragBuffer1 = dtls_fragment_add(FragBuffer0, FragmentOffset, FragmentLength, Body), - Fragment = {erlang:max(SeqNo, LastSeqNo), Type, Length, MessageSeq, FragBuffer1}, - Fragments1 = gb_trees:enter(MessageSeq, Fragment, Fragments0), - HsState#dtls_hs_state{fragments = Fragments1}; - -%% Type, Length or Seq mismatch, drop everything... -%% Note: the RFC is not clear on how to handle this... -dtls_fragment_reassemble(_SeqNo, _Type, _Length, MessageSeq, - _FragmentOffset, _FragmentLength, _Body, _Fragment, - HsState = #dtls_hs_state{fragments = Fragments0}) -> - Fragments1 = gb_trees:delete_any(MessageSeq, Fragments0), - HsState#dtls_hs_state{fragments = Fragments1}. - -dtls_fragment_add({Length, FragmentList0, Bin0}, FragmentOffset, FragmentLength, Body) -> - Bin1 = dtls_fragment_bin_add(FragmentOffset, FragmentLength, Body, Bin0), - FragmentList1 = add_fragment(FragmentList0, {FragmentOffset, FragmentLength}), - {Length, FragmentList1, Bin1}. - -dtls_fragment_init(Length, 0, Length, Body) -> - {Length, [{0, Length}], Body}; -dtls_fragment_init(Length, FragmentOffset, FragmentLength, Body) -> - Bin = dtls_fragment_bin_add(FragmentOffset, FragmentLength, Body, <<0:(Length*8)>>), - {Length, [{FragmentOffset, FragmentOffset + FragmentLength}], Bin}. - -dtls_fragment_bin_add(FragmentOffset, FragmentLength, Add, Buffer) -> - <<First:FragmentOffset/bytes, _:FragmentLength/bytes, Rest/binary>> = Buffer, - <<First/binary, Add/binary, Rest/binary>>. - -merge_fragment_list([], Fragment, Acc) -> - lists:reverse([Fragment|Acc]); - -merge_fragment_list([H = {_, HEnd}|Rest], Frag = {FStart, _}, Acc) - when FStart > HEnd -> - merge_fragment_list(Rest, Frag, [H|Acc]); - -merge_fragment_list(Rest = [{HStart, _HEnd}|_], Frag = {_FStart, FEnd}, Acc) - when FEnd < HStart -> - lists:reverse(Acc) ++ [Frag|Rest]; - -merge_fragment_list([{HStart, HEnd}|Rest], _Frag = {FStart, FEnd}, Acc) - when - FStart =< HEnd orelse FEnd >= HStart -> - Start = erlang:min(HStart, FStart), - End = erlang:max(HEnd, FEnd), - NewFrag = {Start, End}, - merge_fragment_list(Rest, NewFrag, Acc). - -add_fragment(List, {FragmentOffset, FragmentLength}) -> - merge_fragment_list(List, {FragmentOffset, FragmentOffset + FragmentLength}, []). +%%%%%%% Encodeing %%%%%%%%%%%%% enc_handshake(#hello_verify_request{protocol_version = {Major, Minor}, cookie = Cookie}, _Version) -> - CookieLength = byte_size(Cookie), + CookieLength = byte_size(Cookie), {?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor), ?BYTE(CookieLength), - Cookie/binary>>}; + Cookie:CookieLength/binary>>}; enc_handshake(#hello_request{}, _Version) -> {?HELLO_REQUEST, <<>>}; @@ -459,38 +242,246 @@ enc_handshake(#client_hello{client_version = {Major, Minor}, ?BYTE(CookieLength), Cookie/binary, ?UINT16(CsLength), BinCipherSuites/binary, ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; + +enc_handshake(#server_hello{} = HandshakeMsg, Version) -> + {Type, <<?BYTE(Major), ?BYTE(Minor), Rest/binary>>} = + ssl_handshake:encode_handshake(HandshakeMsg, Version), + {DTLSMajor, DTLSMinor} = dtls_v1:corresponding_dtls_version({Major, Minor}), + {Type, <<?BYTE(DTLSMajor), ?BYTE(DTLSMinor), Rest/binary>>}; + enc_handshake(HandshakeMsg, Version) -> ssl_handshake:encode_handshake(HandshakeMsg, Version). -decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, +bin_fragments(Bin, Size) -> + bin_fragments(Bin, size(Bin), Size, 0, []). + +bin_fragments(Bin, BinSize, FragSize, Offset, Fragments) -> + case (BinSize - Offset - FragSize) > 0 of + true -> + Frag = binary:part(Bin, {Offset, FragSize}), + bin_fragments(Bin, BinSize, FragSize, Offset + FragSize, [{Frag, Offset} | Fragments]); + false -> + Frag = binary:part(Bin, {Offset, BinSize-Offset}), + lists:reverse([{Frag, Offset} | Fragments]) + end. + +handshake_fragments(_, _, _, [], Acc) -> + lists:reverse(Acc); +handshake_fragments(MsgType, Seq, Len, [{Bin, Offset} | Bins], Acc) -> + FragLen = size(Bin), + handshake_fragments(MsgType, Seq, Len, Bins, + [<<?BYTE(MsgType), Len/binary, Seq/binary, ?UINT24(Offset), + ?UINT24(FragLen), Bin/binary>> | Acc]). + +address_to_bin({A,B,C,D}, Port) -> + <<0:80,16#ffff:16,A,B,C,D,Port:16>>; +address_to_bin({A,B,C,D,E,F,G,H}, Port) -> + <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,Port:16>>. + +%%%%%%% Decodeing %%%%%%%%%%%%% + +handle_fragments(Version, FragmentData, Buffers0, Acc) -> + Fragments = decode_handshake_fragments(FragmentData), + do_handle_fragments(Version, Fragments, Buffers0, Acc). + +do_handle_fragments(_, [], Buffers, Acc) -> + {lists:reverse(Acc), Buffers}; +do_handle_fragments(Version, [Fragment | Fragments], Buffers0, Acc) -> + case reassemble(Version, Fragment, Buffers0) of + {more_data, _} = More when Acc == []-> + More; + {more_data, Buffers} when Fragments == [] -> + {lists:reverse(Acc), Buffers}; + {more_data, Buffers} -> + do_handle_fragments(Version, Fragments, Buffers, Acc); + {HsPacket, Buffers} -> + do_handle_fragments(Version, Fragments, Buffers, [HsPacket | Acc]) + end. + +decode_handshake(Version, <<?BYTE(Type), Bin/binary>>) -> + decode_handshake(Version, Type, Bin). + +decode_handshake(_, ?HELLO_REQUEST, <<>>) -> + #hello_request{}; +decode_handshake(_Version, ?CLIENT_HELLO, <<?UINT24(_), ?UINT16(_), + ?UINT24(_), ?UINT24(_), + ?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, - ?BYTE(Cookie_length), Cookie:Cookie_length/binary, + ?BYTE(CookieLength), Cookie:CookieLength/binary, ?UINT16(Cs_length), CipherSuites:Cs_length/binary, ?BYTE(Cm_length), Comp_methods:Cm_length/binary, Extensions/binary>>) -> - DecodedExtensions = ssl_handshake:decode_hello_extensions(Extensions), - + DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}), + #client_hello{ client_version = {Major,Minor}, random = Random, - session_id = Session_ID, cookie = Cookie, + session_id = Session_ID, cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites), compression_methods = Comp_methods, extensions = DecodedExtensions - }; + }; + +decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?UINT24(_), ?UINT16(_), + ?UINT24(_), ?UINT24(_), + ?BYTE(Major), ?BYTE(Minor), + ?BYTE(CookieLength), + Cookie:CookieLength/binary>>) -> + #hello_verify_request{protocol_version = {Major, Minor}, + cookie = Cookie}; + +decode_handshake(Version, Tag, <<?UINT24(_), ?UINT16(_), + ?UINT24(_), ?UINT24(_), Msg/binary>>) -> + %% DTLS specifics stripped + decode_tls_thandshake(Version, Tag, Msg). + +decode_tls_thandshake(Version, Tag, Msg) -> + TLSVersion = dtls_v1:corresponding_tls_version(Version), + ssl_handshake:decode_handshake(TLSVersion, Tag, Msg). + +decode_handshake_fragments(<<>>) -> + [<<>>]; +decode_handshake_fragments(<<?BYTE(Type), ?UINT24(Length), + ?UINT16(MessageSeq), + ?UINT24(FragmentOffset), ?UINT24(FragmentLength), + Fragment:FragmentLength/binary, Rest/binary>>) -> + [#handshake_fragment{type = Type, + length = Length, + message_seq = MessageSeq, + fragment_offset = FragmentOffset, + fragment_length = FragmentLength, + fragment = Fragment} | decode_handshake_fragments(Rest)]. + +reassemble(Version, #handshake_fragment{message_seq = Seq} = Fragment, + #protocol_buffers{dtls_handshake_next_seq = Seq, + dtls_handshake_next_fragments = Fragments0, + dtls_handshake_later_fragments = LaterFragments0} = + Buffers0)-> + case reassemble_fragments(Fragment, Fragments0) of + {more_data, Fragments} -> + {more_data, Buffers0#protocol_buffers{dtls_handshake_next_fragments = Fragments}}; + {raw, RawHandshake} -> + Handshake = decode_handshake(Version, RawHandshake), + {NextFragments, LaterFragments} = next_fragments(LaterFragments0), + {{Handshake, RawHandshake}, Buffers0#protocol_buffers{dtls_handshake_next_seq = Seq + 1, + dtls_handshake_next_fragments = NextFragments, + dtls_handshake_later_fragments = LaterFragments}} + end; +reassemble(_, #handshake_fragment{message_seq = FragSeq} = Fragment, + #protocol_buffers{dtls_handshake_next_seq = Seq, + dtls_handshake_later_fragments = LaterFragments} = Buffers0) when FragSeq > Seq-> + {more_data, + Buffers0#protocol_buffers{dtls_handshake_later_fragments = [Fragment | LaterFragments]}}; +reassemble(_, _, Buffers) -> + %% Disregard fragments FragSeq < Seq + {more_data, Buffers}. + +reassemble_fragments(Current, Fragments0) -> + [Frag1 | Frags] = lists:keysort(#handshake_fragment.fragment_offset, [Current | Fragments0]), + [Fragment | _] = Fragments = merge_fragment(Frag1, Frags), + case is_complete_handshake(Fragment) of + true -> + {raw, handshake_bin(Fragment)}; + false -> + {more_data, Fragments} + end. -decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor), - ?BYTE(CookieLength), Cookie:CookieLength/binary>>) -> +merge_fragment(Frag0, []) -> + [Frag0]; +merge_fragment(Frag0, [Frag1 | Rest]) -> + case merge_fragments(Frag0, Frag1) of + [_|_] = Frags -> + Frags ++ Rest; + Frag -> + merge_fragment(Frag, Rest) + end. - #hello_verify_request{ - protocol_version = {Major,Minor}, - cookie = Cookie}; -decode_handshake(Version, Tag, Msg) -> - ssl_handshake:decode_handshake(Version, Tag, Msg). +is_complete_handshake(#handshake_fragment{length = Length, fragment_length = Length}) -> + true; +is_complete_handshake(_) -> + false. + +next_fragments(LaterFragments) -> + case lists:keysort(#handshake_fragment.message_seq, LaterFragments) of + [] -> + {[], []}; + [#handshake_fragment{message_seq = Seq} | _] = Fragments -> + split_frags(Fragments, Seq, []) + end. -%% address_to_bin({A,B,C,D}, Port) -> -%% <<0:80,16#ffff:16,A,B,C,D,Port:16>>; -%% address_to_bin({A,B,C,D,E,F,G,H}, Port) -> -%% <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,Port:16>>. +split_frags([#handshake_fragment{message_seq = Seq} = Frag | Rest], Seq, Acc) -> + split_frags(Rest, Seq, [Frag | Acc]); +split_frags(Frags, _, Acc) -> + {lists:reverse(Acc), Frags}. + + +%% Duplicate +merge_fragments(#handshake_fragment{ + fragment_offset = PreviousOffSet, + fragment_length = PreviousLen, + fragment = PreviousData + } = Previous, + #handshake_fragment{ + fragment_offset = PreviousOffSet, + fragment_length = PreviousLen, + fragment = PreviousData}) -> + Previous; + +%% Lager fragment save new data +merge_fragments(#handshake_fragment{ + fragment_offset = PreviousOffSet, + fragment_length = PreviousLen, + fragment = PreviousData + } = Previous, + #handshake_fragment{ + fragment_offset = PreviousOffSet, + fragment_length = CurrentLen, + fragment = CurrentData}) when CurrentLen > PreviousLen -> + NewLength = CurrentLen - PreviousLen, + <<_:PreviousLen/binary, NewData/binary>> = CurrentData, + Previous#handshake_fragment{ + fragment_length = PreviousLen + NewLength, + fragment = <<PreviousData/binary, NewData/binary>> + }; + +%% Smaller fragment +merge_fragments(#handshake_fragment{ + fragment_offset = PreviousOffSet, + fragment_length = PreviousLen + } = Previous, + #handshake_fragment{ + fragment_offset = PreviousOffSet, + fragment_length = CurrentLen}) when CurrentLen < PreviousLen -> + Previous; +%% Next fragment +merge_fragments(#handshake_fragment{ + fragment_offset = PreviousOffSet, + fragment_length = PreviousLen, + fragment = PreviousData + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffSet, + fragment_length = CurrentLen, + fragment = CurrentData}) when PreviousOffSet + PreviousLen == CurrentOffSet-> + Previous#handshake_fragment{ + fragment_length = PreviousLen + CurrentLen, + fragment = <<PreviousData/binary, CurrentData/binary>>}; +%% No merge there is a gap +merge_fragments(Previous, Current) -> + [Previous, Current]. + +handshake_bin(#handshake_fragment{ + type = Type, + length = Len, + message_seq = Seq, + fragment_length = Len, + fragment_offset = 0, + fragment = Fragment}) -> + handshake_bin(Type, Len, Seq, Fragment). + +handshake_bin(Type, Length, Seq, FragmentData) -> + <<?BYTE(Type), ?UINT24(Length), + ?UINT16(Seq), ?UINT24(0), ?UINT24(Length), + FragmentData:Length/binary>>. diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl index 0298fd3105..0a980c5f31 100644 --- a/lib/ssl/src/dtls_handshake.hrl +++ b/lib/ssl/src/dtls_handshake.hrl @@ -46,12 +46,13 @@ cookie }). --record(dtls_hs_state, - {current_read_seq, - starting_read_seq, - highest_record_seq, - fragments, - completed - }). +-record(handshake_fragment, { + type, + length, + message_seq, + fragment_offset, + fragment_length, + fragment + }). -endif. % -ifdef(dtls_handshake). diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 8a6e2d315c..f447897d59 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2015. All Rights Reserved. +%% Copyright Ericsson AB 2013-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. @@ -36,7 +36,9 @@ -export([decode_cipher_text/2]). %% Encoding --export([encode_plain_text/4, encode_tls_cipher_text/5, encode_change_cipher_spec/2]). +-export([encode_handshake/4, encode_alert_record/3, + encode_change_cipher_spec/3, encode_data/3]). +-export([encode_plain_text/5]). %% Protocol version handling -export([protocol_version/1, lowest_protocol_version/1, lowest_protocol_version/2, @@ -44,9 +46,9 @@ is_higher/2, supported_protocol_versions/0, is_acceptable_version/2]). -%% DTLS Epoch handling --export([init_connection_state_seq/2, current_connection_state_epoch/2, - set_connection_state_by_epoch/3, connection_state_by_epoch/3]). +-export([save_current_connection_state/2, next_epoch/2]). + +-export([init_connection_state_seq/2, current_connection_state_epoch/2]). -export_type([dtls_version/0, dtls_atom_version/0]). @@ -68,16 +70,64 @@ %%-------------------------------------------------------------------- init_connection_states(Role, BeastMitigation) -> ConnectionEnd = ssl_record:record_protocol_role(Role), - Current = initial_connection_state(ConnectionEnd, BeastMitigation), - Pending = ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation), - #{write_msg_seq => 0, - prvious_read => undefined, + Initial = initial_connection_state(ConnectionEnd, BeastMitigation), + Current = Initial#{epoch := 0}, + InitialPending = ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation), + Pending = InitialPending#{epoch => undefined}, + #{saved_read => Current, current_read => Current, pending_read => Pending, - prvious_write => undefined, + saved_write => Current, current_write => Current, pending_write => Pending}. - + +%%-------------------------------------------------------------------- +-spec save_current_connection_state(ssl_record:connection_states(), read | write) -> + ssl_record:connection_states(). +%% +%% Description: Returns the instance of the connection_state map +%% where the current read|write state has been copied to the save state. +%%-------------------------------------------------------------------- +save_current_connection_state(#{current_read := Current} = States, read) -> + States#{saved_read := Current}; + +save_current_connection_state(#{current_write := Current} = States, write) -> + States#{saved_write := Current}. + +next_epoch(#{pending_read := Pending, + current_read := #{epoch := Epoch}} = States, read) -> + States#{pending_read := Pending#{epoch := Epoch + 1}}; + +next_epoch(#{pending_write := Pending, + current_write := #{epoch := Epoch}} = States, write) -> + States#{pending_write := Pending#{epoch := Epoch + 1}}. + +get_connection_state_by_epoch(Epoch, #{current_write := #{epoch := Epoch} = Current}, + write) -> + Current; +get_connection_state_by_epoch(Epoch, #{saved_write := #{epoch := Epoch} = Saved}, + write) -> + Saved; +get_connection_state_by_epoch(Epoch, #{current_read := #{epoch := Epoch} = Current}, + read) -> + Current; +get_connection_state_by_epoch(Epoch, #{saved_read := #{epoch := Epoch} = Saved}, + read) -> + Saved. + +set_connection_state_by_epoch(WriteState, Epoch, #{current_write := #{epoch := Epoch}} = States, + write) -> + States#{current_write := WriteState}; +set_connection_state_by_epoch(WriteState, Epoch, #{saved_write := #{epoch := Epoch}} = States, + write) -> + States#{saved_write := WriteState}; +set_connection_state_by_epoch(ReadState, Epoch, #{current_read := #{epoch := Epoch}} = States, + read) -> + States#{current_read := ReadState}; +set_connection_state_by_epoch(ReadState, Epoch, #{saved_read := #{epoch := Epoch}} = States, + read) -> + States#{saved_read := ReadState}. + %%-------------------------------------------------------------------- -spec get_dtls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. %% @@ -140,98 +190,57 @@ get_dtls_records_aux(Data, Acc) -> ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) end. -encode_plain_text(Type, Version, Data, - #{current_write := - #{epoch := Epoch, - sequence_number := Seq, - compression_state := CompS0, - security_parameters := - #security_parameters{ - cipher_type = ?AEAD, - compression_algorithm = CompAlg} - }= WriteState0} = ConnectionStates) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), - WriteState1 = WriteState0#{compression_state => CompS1}, - AAD = calc_aad(Type, Version, Epoch, Seq), - {CipherFragment, WriteState} = ssl_record:cipher_aead(dtls_v1:corresponding_tls_version(Version), - Comp, WriteState1, AAD), - CipherText = encode_tls_cipher_text(Type, Version, Epoch, Seq, CipherFragment), - {CipherText, ConnectionStates#{current_write => WriteState#{sequence_number => Seq +1}}}; - -encode_plain_text(Type, Version, Data, - #{current_write := - #{epoch := Epoch, - sequence_number := Seq, - compression_state := CompS0, - security_parameters := - #security_parameters{compression_algorithm = CompAlg} - }= WriteState0} = ConnectionStates) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), - WriteState1 = WriteState0#{compression_state => CompS1}, - MacHash = calc_mac_hash(WriteState1, Type, Version, Epoch, Seq, Comp), - {CipherFragment, WriteState} = ssl_record:cipher(dtls_v1:corresponding_tls_version(Version), - Comp, WriteState1, MacHash), - CipherText = encode_tls_cipher_text(Type, Version, Epoch, Seq, CipherFragment), - {CipherText, ConnectionStates#{current_write => WriteState#{sequence_number => Seq +1}}}. +%%-------------------------------------------------------------------- +-spec encode_handshake(iolist(), dtls_version(), integer(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +% +%% Description: Encodes a handshake message to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_handshake(Frag, Version, Epoch, ConnectionStates) -> + encode_plain_text(?HANDSHAKE, Version, Epoch, Frag, ConnectionStates). -decode_cipher_text(#ssl_tls{type = Type, version = Version, - epoch = Epoch, - sequence_number = Seq, - fragment = CipherFragment} = CipherText, - #{current_read := - #{compression_state := CompressionS0, - security_parameters := - #security_parameters{ - cipher_type = ?AEAD, - compression_algorithm = CompAlg} - } = ReadState0} = ConnnectionStates0) -> - AAD = calc_aad(Type, Version, Epoch, Seq), - case ssl_record:decipher_aead(dtls_v1:corresponding_tls_version(Version), - CipherFragment, ReadState0, AAD) of - {PlainFragment, ReadState1} -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - ConnnectionStates = ConnnectionStates0#{ - current_read => ReadState1#{ - compression_state => CompressionS1}}, - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; - #alert{} = Alert -> - Alert - end; -decode_cipher_text(#ssl_tls{type = Type, version = Version, - epoch = Epoch, - sequence_number = Seq, - fragment = CipherFragment} = CipherText, - #{current_read := - #{compression_state := CompressionS0, - security_parameters := - #security_parameters{ - compression_algorithm = CompAlg} - } = ReadState0}= ConnnectionStates0) -> - {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), - CipherFragment, ReadState0, true), - MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment), - case ssl_record:is_correct_mac(Mac, MacHash) of - true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - ConnnectionStates = ConnnectionStates0#{ - current_read => ReadState1#{ - compression_state => CompressionS1}}, - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; - false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) - end. +%%-------------------------------------------------------------------- +-spec encode_alert_record(#alert{}, dtls_version(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +%% +%% Description: Encodes an alert message to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_alert_record(#alert{level = Level, description = Description}, + Version, ConnectionStates) -> + #{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write), + encode_plain_text(?ALERT, Version, Epoch, <<?BYTE(Level), ?BYTE(Description)>>, + ConnectionStates). %%-------------------------------------------------------------------- --spec encode_change_cipher_spec(dtls_version(), ssl_record:connection_states()) -> +-spec encode_change_cipher_spec(dtls_version(), integer(), ssl_record:connection_states()) -> {iolist(), ssl_record:connection_states()}. %% %% Description: Encodes a change_cipher_spec-message to send on the ssl socket. %%-------------------------------------------------------------------- -encode_change_cipher_spec(Version, ConnectionStates) -> - encode_plain_text(?CHANGE_CIPHER_SPEC, Version, <<1:8>>, ConnectionStates). +encode_change_cipher_spec(Version, Epoch, ConnectionStates) -> + encode_plain_text(?CHANGE_CIPHER_SPEC, Version, Epoch, ?byte(?CHANGE_CIPHER_SPEC_PROTO), ConnectionStates). + +%%-------------------------------------------------------------------- +-spec encode_data(binary(), dtls_version(), ssl_record:connection_states()) -> + {iolist(),ssl_record:connection_states()}. +%% +%% Description: Encodes data to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_data(Data, Version, ConnectionStates) -> + #{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write), + encode_plain_text(?APPLICATION_DATA, Version, Epoch, Data, ConnectionStates). + +encode_plain_text(Type, Version, Epoch, Data, ConnectionStates) -> + Write0 = get_connection_state_by_epoch(Epoch, ConnectionStates, write), + {CipherFragment, Write1} = encode_plain_text(Type, Version, Data, Write0), + {CipherText, Write} = encode_dtls_cipher_text(Type, Version, CipherFragment, Write1), + {CipherText, set_connection_state_by_epoch(Write, Epoch, ConnectionStates, write)}. + + +decode_cipher_text(#ssl_tls{epoch = Epoch} = CipherText, ConnnectionStates0) -> + ReadState = get_connection_state_by_epoch(Epoch, ConnnectionStates0, read), + decode_cipher_text(CipherText, ReadState, ConnnectionStates0). %%-------------------------------------------------------------------- -spec protocol_version(dtls_atom_version() | dtls_version()) -> @@ -373,12 +382,11 @@ is_acceptable_version(Version, Versions) -> %% This is only valid for DTLS in the first client_hello %%-------------------------------------------------------------------- init_connection_state_seq({254, _}, - #{current_read := #{epoch := 0} = Read, - current_write := #{epoch := 0} = Write} = CS0) -> - Seq = maps:get(sequence_number, Read), - CS0#{current_write => Write#{sequence_number => Seq}}; -init_connection_state_seq(_, CS) -> - CS. + #{current_read := #{epoch := 0, sequence_number := Seq}, + current_write := #{epoch := 0} = Write} = ConnnectionStates0) -> + ConnnectionStates0#{current_write => Write#{sequence_number => Seq}}; +init_connection_state_seq(_, ConnnectionStates) -> + ConnnectionStates. %%-------------------------------------------------------- -spec current_connection_state_epoch(ssl_record:connection_states(), read | write) -> @@ -387,49 +395,12 @@ init_connection_state_seq(_, CS) -> %% Description: Returns the epoch the connection_state record %% that is currently defined as the current conection state. %%-------------------------------------------------------------------- -current_connection_state_epoch(#{current_read := Current}, +current_connection_state_epoch(#{current_read := #{epoch := Epoch}}, read) -> - maps:get(epoch, Current); -current_connection_state_epoch(#{current_write := Current}, + Epoch; +current_connection_state_epoch(#{current_write := #{epoch := Epoch}}, write) -> - maps:get(epoch, Current). - -%%-------------------------------------------------------------------- - --spec connection_state_by_epoch(ssl_record:connection_states(), integer(), read | write) -> - ssl_record:connection_state(). -%% -%% Description: Returns the instance of the connection_state record -%% that is defined by the Epoch. -%%-------------------------------------------------------------------- -connection_state_by_epoch(#{current_read := #{epoch := Epoch}} = CS, Epoch, read) -> - CS; -connection_state_by_epoch(#{pending_read := #{epoch := Epoch}} = CS, Epoch, read) -> - CS; -connection_state_by_epoch(#{current_write := #{epoch := Epoch}} = CS, Epoch, write) -> - CS; -connection_state_by_epoch(#{pending_write := #{epoch := Epoch}} = CS, Epoch, write) -> - CS. -%%-------------------------------------------------------------------- --spec set_connection_state_by_epoch(ssl_record:connection_states(), - ssl_record:connection_state(), read | write) - -> ssl_record:connection_states(). -%% -%% Description: Returns the instance of the connection_state record -%% that is defined by the Epoch. -%%-------------------------------------------------------------------- -set_connection_state_by_epoch(#{current_read := #{epoch := Epoch}} = ConnectionStates0, - NewCS = #{epoch := Epoch}, read) -> - ConnectionStates0#{current_read => NewCS}; -set_connection_state_by_epoch(#{pending_read := #{epoch := Epoch}} = ConnectionStates0, - NewCS = #{epoch := Epoch}, read) -> - ConnectionStates0#{pending_read => NewCS}; -set_connection_state_by_epoch(#{current_write := #{epoch := Epoch}} = ConnectionStates0, - NewCS = #{epoch := Epoch}, write) -> - ConnectionStates0#{current_write => NewCS}; -set_connection_state_by_epoch(#{pending_write := #{epoch := Epoch}} = ConnectionStates0, -NewCS = #{epoch := Epoch}, write) -> - ConnectionStates0#{pending_write => NewCS}. + Epoch. %%-------------------------------------------------------------------- %%% Internal functions @@ -437,8 +408,8 @@ NewCS = #{epoch := Epoch}, write) -> initial_connection_state(ConnectionEnd, BeastMitigation) -> #{security_parameters => ssl_record:initial_security_params(ConnectionEnd), - epoch => 0, - sequence_number => 1, + epoch => undefined, + sequence_number => 0, beast_mitigation => BeastMitigation, compression_state => undefined, cipher_state => undefined, @@ -458,14 +429,85 @@ highest_list_protocol_version(Ver, []) -> highest_list_protocol_version(Ver1, [Ver2 | Rest]) -> highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest). -encode_tls_cipher_text(Type, {MajVer, MinVer}, Epoch, Seq, Fragment) -> +encode_dtls_cipher_text(Type, {MajVer, MinVer}, Fragment, + #{epoch := Epoch, sequence_number := Seq} = WriteState) -> Length = erlang:iolist_size(Fragment), - [<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Epoch), - ?UINT48(Seq), ?UINT16(Length)>>, Fragment]. + {[<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Epoch), + ?UINT48(Seq), ?UINT16(Length)>>, Fragment], + WriteState#{sequence_number => Seq + 1}}. + +encode_plain_text(Type, Version, Data, #{compression_state := CompS0, + epoch := Epoch, + sequence_number := Seq, + security_parameters := + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm = CompAlg} + } = WriteState0) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#{compression_state => CompS1}, + AAD = calc_aad(Type, Version, Epoch, Seq), + ssl_record:cipher_aead(dtls_v1:corresponding_tls_version(Version), Comp, WriteState1, AAD); +encode_plain_text(Type, Version, Data, #{compression_state := CompS0, + epoch := Epoch, + sequence_number := Seq, + security_parameters := + #security_parameters{compression_algorithm = CompAlg} + }= WriteState0) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#{compression_state => CompS1}, + MacHash = calc_mac_hash(Type, Version, WriteState1, Epoch, Seq, Comp), + ssl_record:cipher(dtls_v1:corresponding_tls_version(Version), Comp, WriteState1, MacHash). + +decode_cipher_text(#ssl_tls{type = Type, version = Version, + epoch = Epoch, + sequence_number = Seq, + fragment = CipherFragment} = CipherText, + #{compression_state := CompressionS0, + security_parameters := + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm = CompAlg}} = ReadState0, + ConnnectionStates0) -> + AAD = calc_aad(Type, Version, Epoch, Seq), + case ssl_record:decipher_aead(dtls_v1:corresponding_tls_version(Version), + CipherFragment, ReadState0, AAD) of + {PlainFragment, ReadState1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ReadState = ReadState1#{compression_state => CompressionS1}, + ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + #alert{} = Alert -> + Alert + end; +decode_cipher_text(#ssl_tls{type = Type, version = Version, + epoch = Epoch, + sequence_number = Seq, + fragment = CipherFragment} = CipherText, + #{compression_state := CompressionS0, + security_parameters := + #security_parameters{ + compression_algorithm = CompAlg}} = ReadState0, + ConnnectionStates0) -> + {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), + CipherFragment, ReadState0, true), + MacHash = calc_mac_hash(Type, Version, ReadState1, Epoch, Seq, PlainFragment), + case ssl_record:is_correct_mac(Mac, MacHash) of + true -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + + ReadState = ReadState1#{compression_state => CompressionS1}, + ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end. -calc_mac_hash(#{mac_secret := MacSecret, - security_parameters := #security_parameters{mac_algorithm = MacAlg}}, - Type, Version, Epoch, SeqNo, Fragment) -> +calc_mac_hash(Type, Version, #{mac_secret := MacSecret, + security_parameters := #security_parameters{mac_algorithm = MacAlg}}, + Epoch, SeqNo, Fragment) -> Length = erlang:iolist_size(Fragment), NewSeq = (Epoch bsl 48) + SeqNo, mac_hash(Version, MacAlg, MacSecret, NewSeq, Type, diff --git a/lib/ssl/src/dtls_record.hrl b/lib/ssl/src/dtls_record.hrl index b9f84cbe7f..373481c3f8 100644 --- a/lib/ssl/src/dtls_record.hrl +++ b/lib/ssl/src/dtls_record.hrl @@ -34,11 +34,10 @@ -record(ssl_tls, { type, version, - epoch, - sequence_number, - offset, - length, - fragment + %%length, + fragment, + epoch, + sequence_number }). -endif. % -ifdef(dtls_record). diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl new file mode 100644 index 0000000000..570b3ae83a --- /dev/null +++ b/lib/ssl/src/dtls_socket.erl @@ -0,0 +1,148 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016-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% +%% +-module(dtls_socket). + +-include("ssl_internal.hrl"). +-include("ssl_api.hrl"). + +-export([send/3, listen/3, accept/3, connect/4, socket/4, setopts/3, getopts/3, getstat/3, + peername/2, sockname/2, port/2, close/2]). +-export([emulated_options/0, internal_inet_values/0, default_inet_values/0, default_cb_info/0]). + +send(Transport, {{IP,Port},Socket}, Data) -> + Transport:send(Socket, IP, Port, Data). + +listen(gen_udp = Transport, Port, #config{transport_info = {Transport, _, _, _}, + ssl = SslOpts, + emulated = EmOpts, + inet_user = Options} = Config) -> + + + case dtls_udp_sup:start_child([Port, emulated_socket_options(EmOpts, #socket_options{}), + Options ++ internal_inet_values(), SslOpts]) of + {ok, Pid} -> + {ok, #sslsocket{pid = {udp, Config#config{udp_handler = {Pid, Port}}}}}; + Err = {error, _} -> + Err + end. + +accept(udp, #config{transport_info = {Transport = gen_udp,_,_,_}, + connection_cb = ConnectionCb, + udp_handler = {Listner, _}}, _Timeout) -> + case dtls_udp_listener:accept(Listner, self()) of + {ok, Pid, Socket} -> + {ok, socket(Pid, Transport, {Listner, Socket}, ConnectionCb)}; + {error, Reason} -> + {error, Reason} + end. + +connect(Address, Port, #config{transport_info = {Transport, _, _, _} = CbInfo, + connection_cb = ConnectionCb, + ssl = SslOpts, + emulated = EmOpts, + inet_ssl = SocketOpts}, Timeout) -> + case Transport:open(0, SocketOpts ++ internal_inet_values()) of + {ok, Socket} -> + ssl_connection:connect(ConnectionCb, Address, Port, {{Address, Port},Socket}, + {SslOpts, + emulated_socket_options(EmOpts, #socket_options{}), undefined}, + self(), CbInfo, Timeout); + {error, _} = Error-> + Error + end. + +close(gen_udp, {_Client, _Socket}) -> + ok. + +socket(Pid, Transport, Socket, ConnectionCb) -> + #sslsocket{pid = Pid, + %% "The name "fd" is keept for backwards compatibility + fd = {Transport, Socket, ConnectionCb}}. + +%% Vad göra med emulerade +setopts(gen_udp, #sslsocket{pid = {Socket, _}}, Options) -> + {SockOpts, _} = tls_socket:split_options(Options), + inet:setopts(Socket, SockOpts); +setopts(_, #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}, Options) -> + {SockOpts, _} = tls_socket:split_options(Options), + Transport:setopts(ListenSocket, SockOpts); +%%% Following clauses will not be called for emulated options, they are handled in the connection process +setopts(gen_udp, Socket, Options) -> + inet:setopts(Socket, Options); +setopts(Transport, Socket, Options) -> + Transport:setopts(Socket, Options). + +getopts(gen_udp, #sslsocket{pid = {Socket, #config{emulated = EmOpts}}}, Options) -> + {SockOptNames, EmulatedOptNames} = tls_socket:split_options(Options), + EmulatedOpts = get_emulated_opts(EmOpts, EmulatedOptNames), + SocketOpts = tls_socket:get_socket_opts(Socket, SockOptNames, inet), + {ok, EmulatedOpts ++ SocketOpts}; +getopts(Transport, #sslsocket{pid = {ListenSocket, #config{emulated = EmOpts}}}, Options) -> + {SockOptNames, EmulatedOptNames} = tls_socket:split_options(Options), + EmulatedOpts = get_emulated_opts(EmOpts, EmulatedOptNames), + SocketOpts = tls_socket:get_socket_opts(ListenSocket, SockOptNames, Transport), + {ok, EmulatedOpts ++ SocketOpts}; +%%% Following clauses will not be called for emulated options, they are handled in the connection process +getopts(gen_udp, {_,Socket}, Options) -> + inet:getopts(Socket, Options); +getopts(Transport, Socket, Options) -> + Transport:getopts(Socket, Options). +getstat(gen_udp, {_,Socket}, Options) -> + inet:getstat(Socket, Options); +getstat(Transport, Socket, Options) -> + Transport:getstat(Socket, Options). +peername(gen_udp, {_, {Client, _Socket}}) -> + {ok, Client}; +peername(Transport, Socket) -> + Transport:peername(Socket). +sockname(gen_udp, {_,Socket}) -> + inet:sockname(Socket); +sockname(Transport, Socket) -> + Transport:sockname(Socket). + +port(gen_udp, {_,Socket}) -> + inet:port(Socket); +port(Transport, Socket) -> + Transport:port(Socket). + +emulated_options() -> + [mode, active, packet, packet_size]. + +internal_inet_values() -> + [{active, false}, {mode,binary}]. + +default_inet_values() -> + [{active, true}, {mode, list}]. + +default_cb_info() -> + {gen_udp, udp, udp_closed, udp_error}. + +get_emulated_opts(EmOpts, EmOptNames) -> + lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts), + Value end, + EmOptNames). + +emulated_socket_options(InetValues, #socket_options{ + mode = Mode, + active = Active}) -> + #socket_options{ + mode = proplists:get_value(mode, InetValues, Mode), + active = proplists:get_value(active, InetValues, Active) + }. diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl new file mode 100644 index 0000000000..b7f115582e --- /dev/null +++ b/lib/ssl/src/dtls_udp_listener.erl @@ -0,0 +1,205 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016-2016. 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(dtls_udp_listener). + +-behaviour(gen_server). + +%% API +-export([start_link/4, active_once/3, accept/2, sockname/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-record(state, + {port, + listner, + dtls_options, + emulated_options, + dtls_msq_queues = kv_new(), + clients = set_new(), + dtls_processes = kv_new(), + accepters = queue:new(), + first + }). + +%%%=================================================================== +%%% API +%%%=================================================================== + +start_link(Port, EmOpts, InetOptions, DTLSOptions) -> + gen_server:start_link(?MODULE, [Port, EmOpts, InetOptions, DTLSOptions], []). + +active_once(UDPConnection, Client, Pid) -> + gen_server:cast(UDPConnection, {active_once, Client, Pid}). + +accept(UDPConnection, Accepter) -> + gen_server:call(UDPConnection, {accept, Accepter}, infinity). + +sockname(UDPConnection) -> + gen_server:call(UDPConnection, sockname, infinity). + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== + +init([Port, EmOpts, InetOptions, DTLSOptions]) -> + try + {ok, Socket} = gen_udp:open(Port, InetOptions), + {ok, #state{port = Port, + first = true, + dtls_options = DTLSOptions, + emulated_options = EmOpts, + listner = Socket}} + catch _:_ -> + {error, closed} + end. + +handle_call({accept, Accepter}, From, #state{first = true, + accepters = Accepters, + listner = Socket} = State0) -> + next_datagram(Socket), + State = State0#state{first = false, + accepters = queue:in({Accepter, From}, Accepters)}, + {noreply, State}; + +handle_call({accept, Accepter}, From, #state{accepters = Accepters} = State0) -> + State = State0#state{accepters = queue:in({Accepter, From}, Accepters)}, + {noreply, State}; +handle_call(sockname, _, #state{listner = Socket} = State) -> + Reply = inet:sockname(Socket), + {reply, Reply, State}. + +handle_cast({active_once, Client, Pid}, State0) -> + State = handle_active_once(Client, Pid, State0), + {noreply, State}. + +handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = State0) -> + State = handle_datagram({IP, InPortNo}, Msg, State0), + next_datagram(Socket), + {noreply, State}; + +handle_info({'DOWN', _, process, Pid, _}, #state{clients = Clients, + dtls_processes = Processes0} = State) -> + Client = kv_get(Pid, Processes0), + Processes = kv_delete(Pid, Processes0), + {noreply, State#state{clients = set_delete(Client, Clients), + dtls_processes = Processes}}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== +handle_datagram(Client, Msg, #state{clients = Clients, + accepters = AcceptorsQueue0} = State) -> + case set_is_member(Client, Clients) of + false -> + case queue:out(AcceptorsQueue0) of + {{value, {UserPid, From}}, AcceptorsQueue} -> + setup_new_connection(UserPid, From, Client, Msg, + State#state{accepters = AcceptorsQueue}); + {empty, _} -> + %% Drop packet client will resend + State + end; + true -> + dispatch(Client, Msg, State) + end. + +dispatch(Client, Msg, #state{dtls_msq_queues = MsgQueues} = State) -> + case kv_lookup(Client, MsgQueues) of + {value, Queue0} -> + case queue:out(Queue0) of + {{value, Pid}, Queue} when is_pid(Pid) -> + Pid ! Msg, + State#state{dtls_msq_queues = + kv_update(Client, Queue, MsgQueues)}; + {{value, _}, Queue} -> + State#state{dtls_msq_queues = + kv_update(Client, queue:in(Msg, Queue), MsgQueues)}; + {empty, Queue} -> + State#state{dtls_msq_queues = + kv_update(Client, queue:in(Msg, Queue), MsgQueues)} + end + end. +next_datagram(Socket) -> + inet:setopts(Socket, [{active, once}]). + +handle_active_once(Client, Pid, #state{dtls_msq_queues = MsgQueues} = State0) -> + Queue0 = kv_get(Client, MsgQueues), + case queue:out(Queue0) of + {{value, Pid}, _} when is_pid(Pid) -> + State0; + {{value, Msg}, Queue} -> + Pid ! Msg, + State0#state{dtls_msq_queues = kv_update(Client, Queue, MsgQueues)}; + {empty, Queue0} -> + State0#state{dtls_msq_queues = kv_update(Client, queue:in(Pid, Queue0), MsgQueues)} + end. + +setup_new_connection(User, From, Client, Msg, #state{dtls_processes = Processes, + clients = Clients, + dtls_msq_queues = MsgQueues, + dtls_options = DTLSOpts, + port = Port, + listner = Socket, + emulated_options = EmOpts} = State) -> + ConnArgs = [server, "localhost", Port, {self(), {Client, Socket}}, + {DTLSOpts, EmOpts, udp_listner}, User, dtls_socket:default_cb_info()], + case dtls_connection_sup:start_child(ConnArgs) of + {ok, Pid} -> + erlang:monitor(process, Pid), + gen_server:reply(From, {ok, Pid, {Client, Socket}}), + Pid ! Msg, + State#state{clients = set_insert(Client, Clients), + dtls_msq_queues = kv_insert(Client, queue:new(), MsgQueues), + dtls_processes = kv_insert(Pid, Client, Processes)}; + {error, Reason} -> + gen_server:reply(From, {error, Reason}), + State + end. +kv_update(Key, Value, Store) -> + gb_trees:update(Key, Value, Store). +kv_lookup(Key, Store) -> + gb_trees:lookup(Key, Store). +kv_insert(Key, Value, Store) -> + gb_trees:insert(Key, Value, Store). +kv_get(Key, Store) -> + gb_trees:get(Key, Store). +kv_delete(Key, Store) -> + gb_trees:delete(Key, Store). +kv_new() -> + gb_trees:empty(). + +set_new() -> + gb_sets:empty(). +set_insert(Item, Set) -> + gb_sets:insert(Item, Set). +set_delete(Item, Set) -> + gb_sets:delete(Item, Set). +set_is_member(Item, Set) -> + gb_sets:is_member(Item, Set). diff --git a/lib/ssl/src/dtls_udp_sup.erl b/lib/ssl/src/dtls_udp_sup.erl new file mode 100644 index 0000000000..197882e92f --- /dev/null +++ b/lib/ssl/src/dtls_udp_sup.erl @@ -0,0 +1,62 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016-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: Supervisor for a procsses dispatching upd datagrams to +%% correct DTLS handler +%%---------------------------------------------------------------------- +-module(dtls_udp_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). +-export([start_child/1]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +start_child(Args) -> + supervisor:start_child(?MODULE, Args). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init(_O) -> + RestartStrategy = simple_one_for_one, + MaxR = 0, + MaxT = 3600, + + Name = undefined, % As simple_one_for_one is used. + StartFunc = {dtls_udp_listener, start_link, []}, + Restart = temporary, % E.g. should not be restarted + Shutdown = 4000, + Modules = [dtls_udp_listener], + Type = worker, + + ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, + {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}. diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index 8c03bda513..ffd3e4b833 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -21,7 +21,7 @@ -include("ssl_cipher.hrl"). --export([suites/1, mac_hash/7, ecc_curves/1, corresponding_tls_version/1]). +-export([suites/1, mac_hash/7, ecc_curves/1, corresponding_tls_version/1, corresponding_dtls_version/1]). -spec suites(Minor:: 253|255) -> [ssl_cipher:cipher_suite()]. @@ -29,7 +29,7 @@ suites(Minor) -> tls_v1:suites(corresponding_minor_tls_version(Minor)). mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> - tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, corresponding_tls_version(Version), + tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, Length, Fragment). ecc_curves({_Major, Minor}) -> @@ -42,3 +42,11 @@ corresponding_minor_tls_version(255) -> 2; corresponding_minor_tls_version(253) -> 3. + +corresponding_dtls_version({3, Minor}) -> + {254, corresponding_minor_dtls_version(Minor)}. + +corresponding_minor_dtls_version(2) -> + 255; +corresponding_minor_dtls_version(3) -> + 253. diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 00b0513891..9c5d795848 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -6,6 +6,7 @@ tls_connection, tls_handshake, tls_record, + tls_socket, tls_v1, ssl_v3, ssl_v2, @@ -13,7 +14,10 @@ dtls_connection, dtls_handshake, dtls_record, + dtls_socket, dtls_v1, + dtls_udp_listener, + dtls_udp_sup, %% API ssl, %% Main API tls, %% TLS specific @@ -27,7 +31,6 @@ ssl_cipher, ssl_srp_primes, ssl_alert, - ssl_socket, ssl_listen_tracker_sup, %% Erlang Distribution over SSL/TLS inet_tls_dist, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index aa62ab8865..0b7229b67e 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -101,33 +101,27 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, {gen_tcp, tcp, tcp_closed, tcp_error}), - EmulatedOptions = ssl_socket:emulated_options(), - {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), + EmulatedOptions = tls_socket:emulated_options(), + {ok, SocketValues} = tls_socket:getopts(Transport, Socket, EmulatedOptions), try handle_options(SslOptions0 ++ SocketValues, client) of - {ok, #config{transport_info = CbInfo, ssl = SslOptions, emulated = EmOpts, - connection_cb = ConnectionCb}} -> - - ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), - case ssl_socket:peername(Transport, Socket) of - {ok, {Address, Port}} -> - ssl_connection:connect(ConnectionCb, Address, Port, Socket, - {SslOptions, emulated_socket_options(EmOpts, #socket_options{}), undefined}, - self(), CbInfo, Timeout); - {error, Error} -> - {error, Error} - end + {ok, Config} -> + tls_socket:upgrade(Socket, Config, Timeout) catch _:{error, Reason} -> {error, Reason} end; - connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> - try handle_options(Options, client) of - {ok, Config} -> - do_connect(Host,Port,Config,Timeout) + try + {ok, Config} = handle_options(Options, client), + case Config#config.connection_cb of + tls_connection -> + tls_socket:connect(Host,Port,Config,Timeout); + dtls_connection -> + dtls_socket:connect(Host,Port,Config,Timeout) + end catch throw:Error -> Error @@ -144,17 +138,7 @@ listen(_Port, []) -> listen(Port, Options0) -> try {ok, Config} = handle_options(Options0, server), - ConnectionCb = connection_cb(Options0), - #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb, - ssl = SslOpts, emulated = EmOpts} = Config, - case Transport:listen(Port, Options) of - {ok, ListenSocket} -> - ok = ssl_socket:setopts(Transport, ListenSocket, ssl_socket:internal_inet_values()), - {ok, Tracker} = ssl_socket:inherit_tracker(ListenSocket, EmOpts, SslOpts), - {ok, #sslsocket{pid = {ListenSocket, Config#config{emulated = Tracker}}}}; - Err = {error, _} -> - Err - end + do_listen(Port, Config, connection_cb(Options0)) catch Error = {error, _} -> Error @@ -171,27 +155,15 @@ transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). transport_accept(#sslsocket{pid = {ListenSocket, - #config{transport_info = {Transport,_,_, _} =CbInfo, - connection_cb = ConnectionCb, - ssl = SslOpts, - emulated = Tracker}}}, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> - case Transport:accept(ListenSocket, Timeout) of - {ok, Socket} -> - {ok, EmOpts} = ssl_socket:get_emulated_opts(Tracker), - {ok, Port} = ssl_socket:port(Transport, Socket), - ConnArgs = [server, "localhost", Port, Socket, - {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), Tracker}, self(), CbInfo], - ConnectionSup = connection_sup(ConnectionCb), - case ConnectionSup:start_child(ConnArgs) of - {ok, Pid} -> - ssl_connection:socket_control(ConnectionCb, Socket, Pid, Transport, Tracker); - {error, Reason} -> - {error, Reason} - end; - {error, Reason} -> - {error, Reason} + #config{connection_cb = ConnectionCb} = Config}}, Timeout) + when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> + case ConnectionCb of + tls_connection -> + tls_socket:accept(ListenSocket, Config, Timeout); + dtls_connection -> + dtls_socket:accept(ListenSocket, Config, Timeout) end. - + %%-------------------------------------------------------------------- -spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. -spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() @@ -214,13 +186,14 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(ListenSocket, SslOptions, infinity). ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> - ssl_accept(#sslsocket{} = Socket, Timeout); + ssl_accept(Socket, Timeout); ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> try - {ok, EmOpts, InheritedSslOpts} = ssl_socket:get_all_opts(Tracker), + {ok, EmOpts, InheritedSslOpts} = tls_socket:get_all_opts(Tracker), SslOpts = handle_options(SslOpts0, InheritedSslOpts), - ssl_connection:handshake(Socket, {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, Timeout) + ssl_connection:handshake(Socket, {SslOpts, + tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout) catch Error = {error, _Reason} -> Error end; @@ -228,15 +201,16 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), - EmulatedOptions = ssl_socket:emulated_options(), - {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), + EmulatedOptions = tls_socket:emulated_options(), + {ok, SocketValues} = tls_socket:getopts(Transport, Socket, EmulatedOptions), ConnetionCb = connection_cb(SslOptions), try handle_options(SslOptions ++ SocketValues, server) of {ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> - ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), - {ok, Port} = ssl_socket:port(Transport, Socket), + ok = tls_socket:setopts(Transport, Socket, tls_socket:internal_inet_values()), + {ok, Port} = tls_socket:port(Transport, Socket), ssl_connection:ssl_accept(ConnetionCb, Port, Socket, - {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), undefined}, + {SslOpts, + tls_socket:emulated_socket_options(EmOpts, #socket_options{}), undefined}, self(), CbInfo, Timeout) catch Error = {error, _Reason} -> Error @@ -275,6 +249,8 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _} %%-------------------------------------------------------------------- send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> ssl_connection:send(Pid, Data); +send(#sslsocket{pid = {_, #config{transport_info={gen_udp, _, _, _}}}}, _) -> + {error,enotconn}; %% Emulate connection behaviour send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _}}}}, Data) -> Transport:send(ListenSocket, Data). %% {error,enotconn} @@ -358,9 +334,9 @@ connection_info(#sslsocket{} = SSLSocket) -> %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> - ssl_socket:peername(Transport, Socket); + tls_socket:peername(Transport, Socket); peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) -> - ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} + tls_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} %%-------------------------------------------------------------------- -spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. @@ -456,7 +432,7 @@ getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ssl_connection:get_opts(Pid, OptionTags); getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> - try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of + try tls_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> Result; {error, InetError} -> @@ -484,7 +460,7 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> end; setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> - try ssl_socket:setopts(Transport, ListenSocket, Options) of + try tls_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; {error, InetError} -> @@ -517,10 +493,10 @@ getstat(Socket) -> %% Description: Get one or more statistic options for a socket. %%-------------------------------------------------------------------- getstat(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, Options) when is_port(Listen), is_list(Options) -> - ssl_socket:getstat(Transport, Listen, Options); + tls_socket:getstat(Transport, Listen, Options); getstat(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}, Options) when is_pid(Pid), is_list(Options) -> - ssl_socket:getstat(Transport, Socket, Options). + tls_socket:getstat(Transport, Socket, Options). %%--------------------------------------------------------------- -spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. @@ -539,10 +515,13 @@ shutdown(#sslsocket{pid = Pid}, How) -> %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}) when is_port(Listen) -> - ssl_socket:sockname(Transport, Listen); - + tls_socket:sockname(Transport, Listen); +sockname(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) -> + dtls_udp_listener:sockname(Pid); +sockname(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) -> + dtls_socket:sockname(Transport, Socket); sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> - ssl_socket:sockname(Transport, Socket). + tls_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- -spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. @@ -652,27 +631,12 @@ available_suites(all) -> Version = tls_record:highest_protocol_version([]), ssl_cipher:filter_suites(ssl_cipher:all_suites(Version)). -do_connect(Address, Port, - #config{transport_info = CbInfo, inet_user = UserOpts, ssl = SslOpts, - emulated = EmOpts, inet_ssl = SocketOpts, connection_cb = ConnetionCb}, - Timeout) -> - {Transport, _, _, _} = CbInfo, - try Transport:connect(Address, Port, SocketOpts, Timeout) of - {ok, Socket} -> - ssl_connection:connect(ConnetionCb, Address, Port, Socket, - {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), undefined}, - self(), CbInfo, Timeout); - {error, Reason} -> - {error, Reason} - catch - exit:{function_clause, _} -> - {error, {options, {cb_info, CbInfo}}}; - exit:badarg -> - {error, {options, {socket_options, UserOpts}}}; - exit:{badarg, _} -> - {error, {options, {socket_options, UserOpts}}} - end. +do_listen(Port, #config{transport_info = {Transport, _, _, _}} = Config, tls_connection) -> + tls_socket:listen(Transport, Port, Config); +do_listen(Port, #config{transport_info = {Transport, _, _, _}} = Config, dtls_connection) -> + dtls_socket:listen(Transport, Port, Config). + %% Handle extra ssl options given to ssl_accept -spec handle_options([any()], #ssl_options{}) -> #ssl_options{} ; ([any()], client | server) -> {ok, #config{}}. @@ -732,6 +696,8 @@ handle_options(Opts0, Role) -> [RecordCb:protocol_version(Vsn) || Vsn <- Vsns] end, + Protocol = proplists:get_value(protocol, Opts, tls), + SSLOptions = #ssl_options{ versions = Versions, verify = validate_option(verify, Verify), @@ -759,7 +725,7 @@ handle_options(Opts0, Role) -> signature_algs = handle_hashsigns_option(proplists:get_value(signature_algs, Opts, default_option_role(server, tls_v1:default_signature_algs(Versions), Role)), - RecordCb:highest_protocol_version(Versions)), + tls_version(RecordCb:highest_protocol_version(Versions))), %% Server side option reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), @@ -789,7 +755,7 @@ handle_options(Opts0, Role) -> honor_ecc_order = handle_option(honor_ecc_order, Opts, default_option_role(server, false, Role), server, Role), - protocol = proplists:get_value(protocol, Opts, tls), + protocol = Protocol, padding_check = proplists:get_value(padding_check, Opts, true), beast_mitigation = handle_option(beast_mitigation, Opts, one_n_minus_one), fallback = handle_option(fallback, Opts, @@ -799,10 +765,11 @@ handle_options(Opts0, Role) -> client, Role), crl_check = handle_option(crl_check, Opts, false), crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}), - v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false) + v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false), + max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE) }, - CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), + CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)), SslOptions = [protocol, versions, verify, verify_fun, partial_chain, fail_if_no_peer_cert, verify_client_once, depth, cert, certfile, key, keyfile, @@ -814,13 +781,14 @@ handle_options(Opts0, Role) -> alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, - fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible], + fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible, + max_handshake_size], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) end, Opts, SslOptions), - {Sock, Emulated} = emulated_options(SockOpts), + {Sock, Emulated} = emulated_options(Protocol, SockOpts), ConnetionCb = connection_cb(Opts), {ok, #config{ssl = SSLOptions, emulated = Emulated, inet_ssl = Sock, @@ -1062,6 +1030,8 @@ validate_option(beast_mitigation, Value) when Value == one_n_minus_one orelse Value; validate_option(v2_hello_compatible, Value) when is_boolean(Value) -> Value; +validate_option(max_handshake_size, Value) when is_integer(Value) andalso Value =< ?MAX_UNIT24 -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). @@ -1139,8 +1109,13 @@ ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) -> %% some trusted certs. ca_cert_default(verify_peer, undefined, _) -> "". -emulated_options(Opts) -> - emulated_options(Opts, ssl_socket:internal_inet_values(), ssl_socket:default_inet_values()). +emulated_options(Protocol, Opts) -> + case Protocol of + tls -> + emulated_options(Opts, tls_socket:internal_inet_values(), tls_socket:default_inet_values()); + dtls -> + emulated_options(Opts, dtls_socket:internal_inet_values(), dtls_socket:default_inet_values()) + end. emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) -> validate_inet_option(mode, Value), @@ -1281,11 +1256,6 @@ record_cb(dtls) -> record_cb(Opts) -> record_cb(proplists:get_value(protocol, Opts, tls)). -connection_sup(tls_connection) -> - tls_connection_sup; -connection_sup(dtls_connection) -> - dtls_connection_sup. - binary_filename(FileName) -> Enc = file:native_name_encoding(), unicode:characters_to_binary(FileName, unicode, Enc). @@ -1304,20 +1274,6 @@ assert_proplist([inet6 | Rest]) -> assert_proplist([Value | _]) -> throw({option_not_a_key_value_tuple, Value}). -emulated_socket_options(InetValues, #socket_options{ - mode = Mode, - header = Header, - active = Active, - packet = Packet, - packet_size = Size}) -> - #socket_options{ - mode = proplists:get_value(mode, InetValues, Mode), - header = proplists:get_value(header, InetValues, Header), - active = proplists:get_value(active, InetValues, Active), - packet = proplists:get_value(packet, InetValues, Packet), - packet_size = proplists:get_value(packet_size, InetValues, Size) - }. - new_ssl_options([], #ssl_options{} = Opts, _) -> Opts; new_ssl_options([{verify_client_once, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> @@ -1390,7 +1346,7 @@ new_ssl_options([{signature_algs, Value} | Rest], #ssl_options{} = Opts, RecordC new_ssl_options(Rest, Opts#ssl_options{signature_algs = handle_hashsigns_option(Value, - RecordCB:highest_protocol_version())}, + tls_version(RecordCB:highest_protocol_version()))}, RecordCB); new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) -> @@ -1454,3 +1410,8 @@ default_option_role(Role, Value, Role) -> Value; default_option_role(_,_,_) -> undefined. + +default_cb_info(tls) -> + {gen_tcp, tcp, tcp_closed, tcp_error}; +default_cb_info(dtls) -> + {gen_udp, udp, udp_closed, udp_error}. diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 05dfb4c1b3..696a55e4b9 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. @@ -32,22 +32,13 @@ -include("ssl_record.hrl"). -include("ssl_internal.hrl"). --export([encode/3, decode/1, alert_txt/1, reason_code/2]). +-export([decode/1, alert_txt/1, reason_code/2]). %%==================================================================== %% Internal application API %%==================================================================== %%-------------------------------------------------------------------- --spec encode(#alert{}, ssl_record:ssl_version(), ssl_record:connection_states()) -> - {iolist(), ssl_record:connection_states()}. -%% -%% Description: Encodes an alert -%%-------------------------------------------------------------------- -encode(#alert{} = Alert, Version, ConnectionStates) -> - ssl_record:encode_alert_record(Alert, Version, ConnectionStates). - -%%-------------------------------------------------------------------- -spec decode(binary()) -> [#alert{}] | #alert{}. %% %% Description: Decode alert(s), will return a singel own alert if peer diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index 38facb964f..f3743ba0f0 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 605bbd859a..32fec03b8e 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -40,7 +40,7 @@ ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, - random_bytes/1]). + random_bytes/1, calc_aad/3, calc_mac_hash/4]). -export_type([cipher_suite/0, erl_cipher_suite/0, openssl_cipher_suite/0, @@ -311,7 +311,9 @@ aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState, suites({3, 0}) -> ssl_v3:suites(); suites({3, N}) -> - tls_v1:suites(N). + tls_v1:suites(N); +suites(Version) -> + suites(dtls_v1:corresponding_tls_version(Version)). all_suites(Version) -> suites(Version) @@ -1525,9 +1527,32 @@ is_fallback(CipherSuites)-> random_bytes(N) -> crypto:strong_rand_bytes(N). +calc_aad(Type, {MajVer, MinVer}, + #{sequence_number := SeqNo}) -> + <<SeqNo:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. + +calc_mac_hash(Type, Version, + PlainFragment, #{sequence_number := SeqNo, + mac_secret := MacSecret, + security_parameters:= + SecPars}) -> + Length = erlang:iolist_size(PlainFragment), + mac_hash(Version, SecPars#security_parameters.mac_algorithm, + MacSecret, SeqNo, Type, + Length, PlainFragment). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type, + _Length, _Fragment) -> + <<>>; +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 -> + tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, + Length, Fragment). bulk_cipher_algorithm(null) -> ?NULL; diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index b6e4d5b433..6ed2fc83da 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -44,7 +44,7 @@ -export([send/2, recv/3, close/2, shutdown/2, new_user/2, get_opts/2, set_opts/2, session_info/1, peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5, - connection_information/1 + connection_information/1, handle_common_event/5 ]). %% General gen_statem state functions with extra callback argument @@ -71,7 +71,8 @@ %%==================================================================== %%-------------------------------------------------------------------- -spec connect(tls_connection | dtls_connection, - host(), inet:port_number(), port(), + host(), inet:port_number(), + port() | {tuple(), port()}, %% TLS | DTLS {#ssl_options{}, #socket_options{}, %% Tracker only needed on server side undefined}, @@ -145,14 +146,24 @@ socket_control(Connection, Socket, Pid, Transport) -> -spec socket_control(tls_connection | dtls_connection, port(), pid(), atom(), pid()| undefined) -> {ok, #sslsocket{}} | {error, reason()}. %%-------------------------------------------------------------------- -socket_control(Connection, Socket, Pid, Transport, ListenTracker) -> +socket_control(Connection, Socket, Pid, Transport, udp_listner) -> + %% dtls listner process must have the socket control + {ok, dtls_socket:socket(Pid, Transport, Socket, Connection)}; + +socket_control(tls_connection = Connection, Socket, Pid, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, ssl_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; + {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; + {error, Reason} -> + {error, Reason} + end; +socket_control(dtls_connection = Connection, {_, Socket}, Pid, Transport, ListenTracker) -> + case Transport:controlling_process(Socket, Pid) of + ok -> + {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end. - %%-------------------------------------------------------------------- -spec send(pid(), iodata()) -> ok | {error, reason()}. %% @@ -461,7 +472,7 @@ certify(internal, #certificate{asn1_certificates = []}, #state{role = server, negotiated_version = Version, ssl_options = #ssl_options{verify = verify_peer, fail_if_no_peer_cert = true}} = - State, _Connection) -> + State, _) -> Alert = ?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE), handle_own_alert(Alert, Version, certify, State); @@ -478,7 +489,7 @@ certify(internal, #certificate{}, #state{role = server, negotiated_version = Version, ssl_options = #ssl_options{verify = verify_none}} = - State, _Connection) -> + State, _) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, unrequested_certificate), handle_own_alert(Alert, Version, certify, State); @@ -788,7 +799,7 @@ connection(Type, Msg, State, Connection) -> downgrade(internal, #alert{description = ?CLOSE_NOTIFY}, #state{transport_cb = Transport, socket = Socket, downgrade = {Pid, From}} = State, _) -> - ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]), + tls_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]), Transport:controlling_process(Socket, Pid), gen_statem:reply(From, {ok, Socket}), {stop, normal, State}; @@ -819,7 +830,7 @@ handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName, %% a client_hello, which needs to be determined by the connection callback. %% In other cases this is a noop State = handle_sni_extension(PossibleSNI, State0), - HsHist = ssl_handshake:update_handshake_history(Hs0, Raw, V2HComp), + HsHist = ssl_handshake:update_handshake_history(Hs0, iolist_to_binary(Raw), V2HComp), {next_state, StateName, State#state{tls_handshake_history = HsHist}, [{next_event, internal, Handshake}]}; handle_common_event(internal, {protocol_record, TLSorDTLSRecord}, StateName, State, Connection) -> @@ -853,24 +864,24 @@ handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when i %% When downgrading an TLS connection to a transport connection %% we must recive the close alert from the peer before releasing the %% transport socket. - {next_state, downgrade, State, [{timeout, Timeout, downgrade}]}; + {next_state, downgrade, State#state{terminated = true}, [{timeout, Timeout, downgrade}]}; handle_call({close, _} = Close, From, StateName, State, Connection) -> %% Run terminate before returning so that the reuseaddr - %% inet-option - Result = Connection:terminate(Close, StateName, State), + %% inet-option works properly + Result = Connection:terminate(Close, StateName, State#state{terminated = true}), {stop_and_reply, {shutdown, normal}, {reply, From, Result}, State}; handle_call({shutdown, How0}, From, _, #state{transport_cb = Transport, negotiated_version = Version, connection_states = ConnectionStates, - socket = Socket}, _) -> + socket = Socket}, Connection) -> case How0 of How when How == write; How == both -> Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), {BinMsg, _} = - ssl_alert:encode(Alert, Version, ConnectionStates), - Transport:send(Socket, BinMsg); + Connection:encode_alert(Alert, Version, ConnectionStates), + Connection:send(Transport, Socket, BinMsg); _ -> ok end, @@ -999,7 +1010,10 @@ handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) -> terminate(_, _, #state{terminated = true}) -> %% Happens when user closes the connection using ssl:close/1 %% we want to guarantee that Transport:close has been called - %% when ssl:close/1 returns. + %% when ssl:close/1 returns unless it is a downgrade where + %% we want to guarantee that close alert is recived before + %% returning. In both cases terminate has been run manually + %% before run by gen_statem which will end up here ok; terminate({shutdown, transport_closed} = Reason, @@ -1025,8 +1039,8 @@ terminate(Reason, connection, #state{negotiated_version = Version, transport_cb = Transport, socket = Socket } = State) -> handle_trusted_certs_db(State), - {BinAlert, ConnectionStates} = terminate_alert(Reason, Version, ConnectionStates0), - Transport:send(Socket, BinAlert), + {BinAlert, ConnectionStates} = terminate_alert(Reason, Version, ConnectionStates0, Connection), + Connection:send(Transport, Socket, BinAlert), Connection:close(Reason, Socket, Transport, ConnectionStates, Check); terminate(Reason, _StateName, #state{transport_cb = Transport, protocol_cb = Connection, @@ -1079,8 +1093,8 @@ write_application_data(Data0, From, Connection:renegotiate(State#state{renegotiation = {true, internal}}, [{next_event, {call, From}, {application_data, Data0}}]); false -> - {Msgs, ConnectionStates} = ssl_record:encode_data(Data, Version, ConnectionStates0), - Result = Transport:send(Socket, Msgs), + {Msgs, ConnectionStates} = Connection:encode_data(Data, Version, ConnectionStates0), + Result = Connection:send(Transport, Socket, Msgs), ssl_connection:hibernate_after(connection, State#state{connection_states = ConnectionStates}, [{reply, From, Result}]) end. @@ -1913,7 +1927,7 @@ get_socket_opts(Transport, Socket, [active | Tags], SockOpts, Acc) -> get_socket_opts(Transport, Socket, Tags, SockOpts, [{active, SockOpts#socket_options.active} | Acc]); get_socket_opts(Transport, Socket, [Tag | Tags], SockOpts, Acc) -> - try ssl_socket:getopts(Transport, Socket, [Tag]) of + try tls_socket:getopts(Transport, Socket, [Tag]) of {ok, [Opt]} -> get_socket_opts(Transport, Socket, Tags, SockOpts, [Opt | Acc]); {error, Error} -> @@ -1929,7 +1943,7 @@ set_socket_opts(_,_, [], SockOpts, []) -> {ok, SockOpts}; set_socket_opts(Transport, Socket, [], SockOpts, Other) -> %% Set non emulated options - try ssl_socket:setopts(Transport, Socket, Other) of + try tls_socket:setopts(Transport, Socket, Other) of ok -> {ok, SockOpts}; {error, InetError} -> @@ -1995,17 +2009,17 @@ hibernate_after(connection = StateName, hibernate_after(StateName, State, Actions) -> {next_state, StateName, State, Actions}. -terminate_alert(normal, Version, ConnectionStates) -> - ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), +terminate_alert(normal, Version, ConnectionStates, Connection) -> + Connection:encode_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), Version, ConnectionStates); -terminate_alert({Reason, _}, Version, ConnectionStates) when Reason == close; - Reason == shutdown -> - ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), +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) -> - {BinAlert, _} = ssl_alert:encode(?ALERT_REC(?FATAL, ?INTERNAL_ERROR), - Version, ConnectionStates), +terminate_alert(_, Version, ConnectionStates, Connection) -> + {BinAlert, _} = Connection:encode_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR), + Version, ConnectionStates), BinAlert. handle_trusted_certs_db(#state{ssl_options = @@ -2285,7 +2299,7 @@ format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet, {ok, do_format_reply(Mode, Packet, Header, Data)}; format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, header = Header}, Data, Tracker, Connection) -> - {ssl, ssl_socket:socket(self(), Transport, Socket, Connection, Tracker), + {ssl, tls_socket:socket(self(), 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) -> @@ -2294,7 +2308,7 @@ deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Da 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, ssl_socket:socket(self(), Transport, Socket, Connection, Tracker), + {ssl_error, tls_socket:socket(self(), Transport, Socket, Connection, Tracker), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode @@ -2349,11 +2363,11 @@ alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connectio case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, - {ssl_closed, ssl_socket:socket(self(), + {ssl_closed, tls_socket:socket(self(), Transport, Socket, Connection, Tracker)}); ReasonCode -> send_or_reply(Active, Pid, From, - {ssl_error, ssl_socket:socket(self(), + {ssl_error, tls_socket:socket(self(), Transport, Socket, Connection, Tracker), ReasonCode}) end. @@ -2366,12 +2380,13 @@ log_alert(false, _, _) -> handle_own_alert(Alert, Version, StateName, #state{transport_cb = Transport, socket = Socket, + protocol_cb = Connection, connection_states = ConnectionStates, ssl_options = SslOpts} = State) -> try %% Try to tell the other side {BinMsg, _} = - ssl_alert:encode(Alert, Version, ConnectionStates), - Transport:send(Socket, BinMsg) + Connection:encode_alert(Alert, Version, ConnectionStates), + Connection:send(Transport, Socket, BinMsg) catch _:_ -> %% Can crash if we are in a uninitialized state ignore end, diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index fca3e11894..b597c059af 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2015. All Rights Reserved. +%% Copyright Ericsson AB 2013-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. @@ -43,7 +43,7 @@ error_tag :: atom(), % ex tcp_error host :: string() | inet:ip_address(), port :: integer(), - socket :: port(), + socket :: port() | tuple(), %% TODO: dtls socket ssl_options :: #ssl_options{}, socket_options :: #socket_options{}, connection_states :: ssl_record:connection_states() | secret_printout(), @@ -81,17 +81,18 @@ allow_renegotiate = true ::boolean(), expecting_next_protocol_negotiation = false ::boolean(), expecting_finished = false ::boolean(), - negotiated_protocol = undefined :: undefined | binary(), + next_protocol = undefined :: undefined | binary(), + negotiated_protocol, tracker :: pid() | 'undefined', %% Tracker process for listen socket sni_hostname = undefined, downgrade, - flight_buffer = [] :: list() %% Buffer of TLS/DTLS records, used during the TLS handshake - %% to when possible pack more than on TLS record into the - %% underlaying packet format. Introduced by DTLS - RFC 4347. - %% The mecahnism is also usefull in TLS although we do not - %% need to worry about packet loss in TLS. + flight_buffer = [] :: list() | map(), %% Buffer of TLS/DTLS records, used during the TLS handshake + %% to when possible pack more than on TLS record into the + %% underlaying packet format. Introduced by DTLS - RFC 4347. + %% The mecahnism is also usefull in TLS although we do not + %% need to worry about packet loss in TLS. In DTLS we need to track DTLS handshake seqnr + flight_state = reliable %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp. }). - -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, #'DHParameter'{prime = ?DEFAULT_DIFFIE_HELLMAN_PRIME, base = ?DEFAULT_DIFFIE_HELLMAN_GENERATOR}). diff --git a/lib/ssl/src/ssl_crl.erl b/lib/ssl/src/ssl_crl.erl index 01be1fb9ab..fc60bdba67 100644 --- a/lib/ssl/src/ssl_crl.erl +++ b/lib/ssl/src/ssl_crl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl index 647e0465fe..86c0207515 100644 --- a/lib/ssl/src/ssl_crl_cache.erl +++ b/lib/ssl/src/ssl_crl_cache.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/ssl/src/ssl_crl_cache_api.erl b/lib/ssl/src/ssl_crl_cache_api.erl index c3a57e2f49..d5380583e7 100644 --- a/lib/ssl/src/ssl_crl_cache_api.erl +++ b/lib/ssl/src/ssl_crl_cache_api.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl index a6eb1be1f6..d47cd76bf5 100644 --- a/lib/ssl/src/ssl_dist_sup.erl +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -85,10 +85,10 @@ proxy_server_child_spec() -> {Name, StartFunc, Restart, Shutdown, Type, Modules}. listen_options_tracker_child_spec() -> - Name = ssl_socket_dist, + Name = tls_socket_dist, StartFunc = {ssl_listen_tracker_sup, start_link_dist, []}, Restart = permanent, Shutdown = 4000, - Modules = [ssl_socket], + Modules = [tls_socket], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index fde92035a2..324b7dbde3 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -80,6 +80,9 @@ -define(CLIENT_KEY_EXCHANGE, 16). -define(FINISHED, 20). +-define(MAX_UNIT24, 8388607). +-define(DEFAULT_MAX_HANDSHAKE_SIZE, (256*1024)). + -record(random, { gmt_unix_time, % uint32 random_bytes % opaque random_bytes[28] diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 487d1fa096..c34af9f82c 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. @@ -142,7 +142,8 @@ signature_algs, eccs, honor_ecc_order :: boolean(), - v2_hello_compatible :: boolean() + v2_hello_compatible :: boolean(), + max_handshake_size :: integer() }). -record(socket_options, @@ -156,7 +157,8 @@ -record(config, {ssl, %% SSL parameters inet_user, %% User set inet options - emulated, %% Emulated option list or "inherit_tracker" pid + emulated, %% Emulated option list or "inherit_tracker" pid + udp_handler, inet_ssl, %% inet options for internal ssl socket transport_info, %% Callback info connection_cb diff --git a/lib/ssl/src/ssl_listen_tracker_sup.erl b/lib/ssl/src/ssl_listen_tracker_sup.erl index 7f685a2ead..f7e97bcb76 100644 --- a/lib/ssl/src/ssl_listen_tracker_sup.erl +++ b/lib/ssl/src/ssl_listen_tracker_sup.erl @@ -57,10 +57,10 @@ init(_O) -> MaxT = 3600, Name = undefined, % As simple_one_for_one is used. - StartFunc = {ssl_socket, start_link, []}, + StartFunc = {tls_socket, start_link, []}, Restart = temporary, % E.g. should not be restarted Shutdown = 4000, - Modules = [ssl_socket], + Modules = [tls_socket], Type = worker, ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index 0006ce14d9..b4299969e4 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 71cd0279f3..b10069c3cb 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -41,10 +41,6 @@ set_server_verify_data/3, empty_connection_state/2, initial_connection_state/2, record_protocol_role/1]). -%% Encoding records --export([encode_handshake/3, encode_alert_record/3, - encode_change_cipher_spec/2, encode_data/3]). - %% Compression -export([compress/3, uncompress/3, compressions/0]). @@ -52,6 +48,9 @@ -export([cipher/4, decipher/4, is_correct_mac/2, cipher_aead/4, decipher_aead/4]). +%% Encoding +-export([encode_plain_text/4]). + -export_type([ssl_version/0, ssl_atom_version/0, connection_states/0, connection_state/0]). -type ssl_version() :: {integer(), integer()}. @@ -272,70 +271,26 @@ set_pending_cipher_state(#{pending_read := Read, pending_read => Read#{cipher_state => ServerState}, pending_write => Write#{cipher_state => ClientState}}. - -%%-------------------------------------------------------------------- --spec encode_handshake(iolist(), ssl_version(), connection_states()) -> - {iolist(), connection_states()}. -%% -%% Description: Encodes a handshake message to send on the ssl-socket. -%%-------------------------------------------------------------------- -encode_handshake(Frag, Version, - #{current_write := - #{beast_mitigation := BeastMitigation, - security_parameters := - #security_parameters{bulk_cipher_algorithm = BCA}}} = - ConnectionStates) - when is_list(Frag) -> - case iolist_size(Frag) of - N when N > ?MAX_PLAIN_TEXT_LENGTH -> - Data = split_bin(iolist_to_binary(Frag), ?MAX_PLAIN_TEXT_LENGTH, Version, BCA, BeastMitigation), - encode_iolist(?HANDSHAKE, Data, Version, ConnectionStates); - _ -> - encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates) - end; -%% TODO: this is a workarround for DTLS -%% -%% DTLS need to select the connection write state based on Epoch it wants to -%% send this fragment in. That Epoch does not nessarily has to be the same -%% as the current_write epoch. -%% The right solution might be to pass the WriteState instead of the ConnectionStates, -%% however, this will require substantion API changes. -encode_handshake(Frag, Version, ConnectionStates) -> - encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). - -%%-------------------------------------------------------------------- --spec encode_alert_record(#alert{}, ssl_version(), connection_states()) -> - {iolist(), connection_states()}. -%% -%% Description: Encodes an alert message to send on the ssl-socket. -%%-------------------------------------------------------------------- -encode_alert_record(#alert{level = Level, description = Description}, - Version, ConnectionStates) -> - encode_plain_text(?ALERT, Version, <<?BYTE(Level), ?BYTE(Description)>>, - ConnectionStates). - -%%-------------------------------------------------------------------- --spec encode_change_cipher_spec(ssl_version(), connection_states()) -> - {iolist(), connection_states()}. -%% -%% Description: Encodes a change_cipher_spec-message to send on the ssl socket. -%%-------------------------------------------------------------------- -encode_change_cipher_spec(Version, ConnectionStates) -> - encode_plain_text(?CHANGE_CIPHER_SPEC, Version, <<1:8>>, ConnectionStates). - -%%-------------------------------------------------------------------- --spec encode_data(binary(), ssl_version(), connection_states()) -> - {iolist(), connection_states()}. -%% -%% Description: Encodes data to send on the ssl-socket. -%%-------------------------------------------------------------------- -encode_data(Frag, Version, - #{current_write := #{beast_mitigation := BeastMitigation, - security_parameters := - #security_parameters{bulk_cipher_algorithm = BCA}}} = - ConnectionStates) -> - Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version, BCA, BeastMitigation), - encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates). +encode_plain_text(Type, Version, Data, #{compression_state := CompS0, + security_parameters := + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm = CompAlg} + } = WriteState0) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#{compression_state => CompS1}, + AAD = ssl_cipher:calc_aad(Type, Version, WriteState1), + ssl_record:cipher_aead(Version, Comp, WriteState1, AAD); +encode_plain_text(Type, Version, Data, #{compression_state := CompS0, + security_parameters := + #security_parameters{compression_algorithm = CompAlg} + }= WriteState0) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#{compression_state => CompS1}, + MacHash = ssl_cipher:calc_mac_hash(Type, Version, Comp, WriteState1), + ssl_record:cipher(Version, Comp, WriteState1, MacHash); +encode_plain_text(_,_,_,CS) -> + exit({cs, CS}). uncompress(?NULL, Data, CS) -> {Data, CS}. @@ -451,11 +406,6 @@ random() -> Random_28_bytes = ssl_cipher:random_bytes(28), <<?UINT32(Secs_since_1970), Random_28_bytes/binary>>. -%% dtls_next_epoch(#connection_state{epoch = undefined}) -> %% SSL/TLS -%% undefined; -%% dtls_next_epoch(#connection_state{epoch = Epoch}) -> %% DTLS -%% Epoch + 1. - is_correct_mac(Mac, Mac) -> true; is_correct_mac(_M,_H) -> @@ -484,47 +434,3 @@ initial_security_params(ConnectionEnd) -> compression_algorithm = ?NULL}, ssl_cipher:security_parameters(?TLS_NULL_WITH_NULL_NULL, SecParams). - -encode_plain_text(Type, Version, Data, ConnectionStates) -> - RecordCB = protocol_module(Version), - RecordCB:encode_plain_text(Type, Version, Data, ConnectionStates). - -encode_iolist(Type, Data, Version, ConnectionStates0) -> - RecordCB = protocol_module(Version), - {ConnectionStates, EncodedMsg} = - lists:foldl(fun(Text, {CS0, Encoded}) -> - {Enc, CS1} = - RecordCB:encode_plain_text(Type, Version, Text, CS0), - {CS1, [Enc | Encoded]} - end, {ConnectionStates0, []}, Data), - {lists:reverse(EncodedMsg), ConnectionStates}. - -%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are -%% not vulnerable to this attack. -split_bin(<<FirstByte:8, Rest/binary>>, ChunkSize, Version, BCA, one_n_minus_one) when - BCA =/= ?RC4 andalso ({3, 1} == Version orelse - {3, 0} == Version) -> - do_split_bin(Rest, ChunkSize, [[FirstByte]]); -%% 0/n splitting countermeasure for clients that are incompatible with 1/n-1 -%% splitting. -split_bin(Bin, ChunkSize, Version, BCA, zero_n) when - BCA =/= ?RC4 andalso ({3, 1} == Version orelse - {3, 0} == Version) -> - do_split_bin(Bin, ChunkSize, [[<<>>]]); -split_bin(Bin, ChunkSize, _, _, _) -> - do_split_bin(Bin, ChunkSize, []). - -do_split_bin(<<>>, _, Acc) -> - lists:reverse(Acc); -do_split_bin(Bin, ChunkSize, Acc) -> - case Bin of - <<Chunk:ChunkSize/binary, Rest/binary>> -> - do_split_bin(Rest, ChunkSize, [Chunk | Acc]); - _ -> - lists:reverse(Acc, [Bin]) - end. - -protocol_module({3, _}) -> - tls_record; -protocol_module({254, _}) -> - dtls_record. diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index ba20f65f44..8245801139 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -46,14 +46,17 @@ start_link() -> init([]) -> SessionCertManager = session_and_cert_manager_child_spec(), TLSConnetionManager = tls_connection_manager_child_spec(), - %% Not supported yet - %%DTLSConnetionManager = dtls_connection_manager_child_spec(), - %% Handles emulated options so that they inherited by the accept socket, even when setopts is performed on - %% the listen socket + %% Handles emulated options so that they inherited by the accept + %% socket, even when setopts is performed on the listen socket ListenOptionsTracker = listen_options_tracker_child_spec(), + + DTLSConnetionManager = dtls_connection_manager_child_spec(), + DTLSUdpListeners = dtls_udp_listeners_spec(), + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager, - %%DTLSConnetionManager, - ListenOptionsTracker]}}. + ListenOptionsTracker, + DTLSConnetionManager, DTLSUdpListeners + ]}}. manager_opts() -> @@ -94,24 +97,32 @@ tls_connection_manager_child_spec() -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -%% dtls_connection_manager_child_spec() -> -%% Name = dtls_connection, -%% StartFunc = {dtls_connection_sup, start_link, []}, -%% Restart = permanent, -%% Shutdown = 4000, -%% Modules = [dtls_connection, ssl_connection], -%% Type = supervisor, -%% {Name, StartFunc, Restart, Shutdown, Type, Modules}. +dtls_connection_manager_child_spec() -> + Name = dtls_connection, + StartFunc = {dtls_connection_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [dtls_connection_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. listen_options_tracker_child_spec() -> - Name = ssl_socket, + Name = tls_socket, StartFunc = {ssl_listen_tracker_sup, start_link, []}, Restart = permanent, Shutdown = 4000, - Modules = [ssl_socket], + Modules = [tls_socket], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. +dtls_udp_listeners_spec() -> + Name = dtls_udp_listener, + StartFunc = {dtls_udp_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. session_cb_init_args() -> case application:get_env(ssl, session_cb_init_args) of diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 932bb139c1..77606911be 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -45,6 +45,8 @@ %% Setup -export([start_fsm/8, start_link/7, init/1]). +-export([encode_data/3, encode_alert/3]). + %% State transition handling -export([next_record/1, next_event/3]). @@ -57,7 +59,7 @@ -export([send_alert/2, close/5]). %% Data handling --export([passive_receive/2, next_record_if_active/1, handle_common_event/4]). +-export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -114,7 +116,7 @@ queue_handshake(Handshake, #state{negotiated_version = Version, send_handshake_flight(#state{socket = Socket, transport_cb = Transport, flight_buffer = Flight} = State0) -> - Transport:send(Socket, Flight), + send(Transport, Socket, Flight), State0#state{flight_buffer = []}. queue_change_cipher(Msg, #state{negotiated_version = Version, @@ -130,8 +132,8 @@ send_alert(Alert, #state{negotiated_version = Version, transport_cb = Transport, connection_states = ConnectionStates0} = State0) -> {BinMsg, ConnectionStates} = - ssl_alert:encode(Alert, Version, ConnectionStates0), - Transport:send(Socket, BinMsg), + encode_alert(Alert, Version, ConnectionStates0), + send(Transport, Socket, BinMsg), State0#state{connection_states = ConnectionStates}. reinit_handshake_data(State) -> @@ -149,6 +151,18 @@ select_sni_extension(#client_hello{extensions = HelloExtensions}) -> select_sni_extension(_) -> undefined. +encode_data(Data, Version, ConnectionStates0)-> + tls_record:encode_data(Data, Version, ConnectionStates0). + +%%-------------------------------------------------------------------- +-spec encode_alert(#alert{}, ssl_record:ssl_version(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +%% +%% Description: Encodes an alert +%%-------------------------------------------------------------------- +encode_alert(#alert{} = Alert, Version, ConnectionStates) -> + tls_record:encode_alert_record(Alert, Version, ConnectionStates). + %%==================================================================== %% tls_connection_sup API %%==================================================================== @@ -205,7 +219,7 @@ init({call, From}, {start, Timeout}, Handshake0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0, V2HComp), - Transport:send(Socket, BinMsg), + send(Transport, Socket, BinMsg), State1 = State0#state{connection_states = ConnectionStates, negotiated_version = Version, %% Requested version session = @@ -410,18 +424,26 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, ssl_options = Options} = State0) -> try {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options), - State = + State1 = State0#state{protocol_buffers = Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, - Events = tls_handshake_events(Packets), - case StateName of - connection -> - ssl_connection:hibernate_after(StateName, State, Events); - _ -> - {next_state, StateName, State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} - end + case Packets of + [] -> + assert_buffer_sanity(Buf, Options), + {Record, State} = next_record(State1), + next_event(StateName, Record, State); + _ -> + Events = tls_handshake_events(Packets), + case StateName of + connection -> + ssl_connection:hibernate_after(StateName, State1, Events); + _ -> + {next_state, StateName, + State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} + end + end catch throw:#alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State0) + ssl_connection:handle_own_alert(Alert, Version, StateName, State0) end; %%% TLS record protocol level application data messages handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> @@ -450,6 +472,9 @@ handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, Sta handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> {next_state, StateName, State}. +send(Transport, Socket, Data) -> + tls_socket:send(Transport, Socket, Data). + %%-------------------------------------------------------------------- %% gen_statem callbacks %%-------------------------------------------------------------------- @@ -476,11 +501,11 @@ encode_handshake(Handshake, Version, ConnectionStates0, Hist0, V2HComp) -> Frag = tls_handshake:encode_handshake(Handshake, Version), Hist = ssl_handshake:update_handshake_history(Hist0, Frag, V2HComp), {Encoded, ConnectionStates} = - ssl_record:encode_handshake(Frag, Version, ConnectionStates0), + tls_record:encode_handshake(Frag, Version, ConnectionStates0), {Encoded, ConnectionStates, Hist}. encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> - ssl_record:encode_change_cipher_spec(Version, ConnectionStates). + tls_record:encode_change_cipher_spec(Version, ConnectionStates). decode_alerts(Bin) -> ssl_alert:decode(Bin). @@ -553,7 +578,7 @@ next_record(#state{protocol_buffers = next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []}, socket = Socket, transport_cb = Transport} = State) -> - ssl_socket:setopts(Transport, Socket, [{active,once}]), + tls_socket:setopts(Transport, Socket, [{active,once}]), {no_record, State}; next_record(State) -> {no_record, State}. @@ -598,8 +623,6 @@ next_event(StateName, Record, State, Actions) -> {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. -tls_handshake_events([]) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake)); tls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -622,8 +645,8 @@ renegotiate(#state{role = server, Frag = tls_handshake:encode_handshake(HelloRequest, Version), Hs0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates} = - ssl_record:encode_handshake(Frag, Version, ConnectionStates0), - Transport:send(Socket, BinMsg), + tls_record:encode_handshake(Frag, Version, ConnectionStates0), + send(Transport, Socket, BinMsg), State1 = State0#state{connection_states = ConnectionStates, tls_handshake_history = Hs0}, @@ -642,7 +665,7 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> %% User closes or recursive call! close({close, Timeout}, Socket, Transport = gen_tcp, _,_) -> - ssl_socket:setopts(Transport, Socket, [{active, false}]), + tls_socket:setopts(Transport, Socket, [{active, false}]), Transport:shutdown(Socket, write), _ = Transport:recv(Socket, 0, Timeout), ok; @@ -684,7 +707,7 @@ gen_handshake(GenConnection, StateName, Type, Event, Result catch _:_ -> - ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data), Version, StateName, State) end. @@ -718,3 +741,25 @@ unprocessed_events(Events) -> %% handshake events left to process before we should %% process more TLS-records received on the socket. erlang:length(Events)-1. + + +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 -> + true; + N when N > Length -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + too_big_handshake_data)); + _ -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data)) + end; +assert_buffer_sanity(Bin, _) -> + case size(Bin) of + N when N < 3 -> + true; + _ -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data)) + end. diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 2bd103c18a..2800ee6537 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 5331dd1303..993a1622fe 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. @@ -34,10 +34,9 @@ %% Handling of incoming data -export([get_tls_records/2, init_connection_states/2]). -%% Decoding --export([decode_cipher_text/3]). - -%% Encoding +%% Encoding TLS records +-export([encode_handshake/3, encode_alert_record/3, + encode_change_cipher_spec/2, encode_data/3]). -export([encode_plain_text/4]). %% Protocol version handling @@ -46,6 +45,9 @@ is_higher/2, supported_protocol_versions/0, is_acceptable_version/1, is_acceptable_version/2]). +%% Decoding +-export([decode_cipher_text/3]). + -export_type([tls_version/0, tls_atom_version/0]). -type tls_version() :: ssl_record:ssl_version(). @@ -85,152 +87,61 @@ get_tls_records(Data, <<>>) -> get_tls_records(Data, Buffer) -> get_tls_records_aux(list_to_binary([Buffer, Data]), []). -get_tls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Length), Data:Length/binary, Rest/binary>>, - Acc) -> - get_tls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA, - version = {MajVer, MinVer}, - fragment = Data} | Acc]); -get_tls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Length), - Data:Length/binary, Rest/binary>>, Acc) -> - get_tls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE, - version = {MajVer, MinVer}, - fragment = Data} | Acc]); -get_tls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Length), Data:Length/binary, - Rest/binary>>, Acc) -> - get_tls_records_aux(Rest, [#ssl_tls{type = ?ALERT, - version = {MajVer, MinVer}, - fragment = Data} | Acc]); -get_tls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Length), Data:Length/binary, Rest/binary>>, - Acc) -> - get_tls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC, - version = {MajVer, MinVer}, - fragment = Data} | Acc]); -%% Matches an ssl v2 client hello message. -%% The server must be able to receive such messages, from clients that -%% are willing to use ssl v3 or higher, but have ssl v2 compatibility. -get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, - Acc) -> - case Data0 of - <<?BYTE(?CLIENT_HELLO), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>> -> - Length = Length0-1, - <<?BYTE(_), Data1:Length/binary>> = Data0, - Data = <<?BYTE(?CLIENT_HELLO), ?UINT24(Length), Data1/binary>>, - get_tls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE, - version = {MajVer, MinVer}, - fragment = Data} | Acc]); - _ -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) - - end; - -get_tls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), - ?UINT16(Length), _/binary>>, - _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> - ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - -get_tls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) - when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> - ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); +%%-------------------------------------------------------------------- +-spec encode_handshake(iolist(), tls_version(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +% +%% Description: Encodes a handshake message to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_handshake(Frag, Version, + #{current_write := + #{beast_mitigation := BeastMitigation, + security_parameters := + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + case iolist_size(Frag) of + N when N > ?MAX_PLAIN_TEXT_LENGTH -> + Data = split_bin(iolist_to_binary(Frag), ?MAX_PLAIN_TEXT_LENGTH, Version, BCA, BeastMitigation), + encode_iolist(?HANDSHAKE, Data, Version, ConnectionStates); + _ -> + encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates) + end. -get_tls_records_aux(Data, Acc) -> - case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of - true -> - {lists:reverse(Acc), Data}; - false -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) - end. +%%-------------------------------------------------------------------- +-spec encode_alert_record(#alert{}, tls_version(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +%% +%% Description: Encodes an alert message to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_alert_record(#alert{level = Level, description = Description}, + Version, ConnectionStates) -> + encode_plain_text(?ALERT, Version, <<?BYTE(Level), ?BYTE(Description)>>, + ConnectionStates). -encode_plain_text(Type, Version, Data, - #{current_write := - #{sequence_number := Seq, - compression_state := CompS0, - security_parameters := - #security_parameters{ - cipher_type = ?AEAD, - compression_algorithm = CompAlg} - }= WriteState0} = ConnectionStates) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), - WriteState1 = WriteState0#{compression_state => CompS1}, - AAD = calc_aad(Type, Version, WriteState1), - {CipherFragment, WriteState} = ssl_record:cipher_aead(Version, Comp, WriteState1, AAD), - CipherText = encode_tls_cipher_text(Type, Version, CipherFragment), - {CipherText, ConnectionStates#{current_write => WriteState#{sequence_number => Seq +1}}}; - -encode_plain_text(Type, Version, Data, - #{current_write := - #{sequence_number := Seq, - compression_state := CompS0, - security_parameters := - #security_parameters{compression_algorithm = CompAlg} - }= WriteState0} = ConnectionStates) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), - WriteState1 = WriteState0#{compression_state => CompS1}, - MacHash = calc_mac_hash(Type, Version, Comp, WriteState1), - {CipherFragment, WriteState} = ssl_record:cipher(Version, Comp, WriteState1, MacHash), - CipherText = encode_tls_cipher_text(Type, Version, CipherFragment), - {CipherText, ConnectionStates#{current_write => WriteState#{sequence_number => Seq +1}}}; -encode_plain_text(_,_,_, CS) -> - exit({cs, CS}). +%%-------------------------------------------------------------------- +-spec encode_change_cipher_spec(tls_version(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +%% +%% Description: Encodes a change_cipher_spec-message to send on the ssl socket. +%%-------------------------------------------------------------------- +encode_change_cipher_spec(Version, ConnectionStates) -> + encode_plain_text(?CHANGE_CIPHER_SPEC, Version, ?byte(?CHANGE_CIPHER_SPEC_PROTO), ConnectionStates). %%-------------------------------------------------------------------- --spec decode_cipher_text(#ssl_tls{}, ssl_record:connection_states(), boolean()) -> - {#ssl_tls{}, ssl_record:connection_states()}| #alert{}. +-spec encode_data(binary(), tls_version(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. %% -%% Description: Decode cipher text +%% Description: Encodes data to send on the ssl-socket. %%-------------------------------------------------------------------- -decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, - #{current_read := - #{compression_state := CompressionS0, - sequence_number := Seq, - security_parameters := - #security_parameters{ - cipher_type = ?AEAD, - compression_algorithm = CompAlg} - } = ReadState0} = ConnnectionStates0, _) -> - AAD = calc_aad(Type, Version, ReadState0), - case ssl_record:decipher_aead(Version, CipherFragment, ReadState0, AAD) of - {PlainFragment, ReadState1} -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - ConnnectionStates = ConnnectionStates0#{ - current_read => ReadState1#{sequence_number => Seq + 1, - compression_state => CompressionS1}}, - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; - #alert{} = Alert -> - Alert - end; +encode_data(Frag, Version, + #{current_write := #{beast_mitigation := BeastMitigation, + security_parameters := + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version, BCA, BeastMitigation), + encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates). + -decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, - #{current_read := - #{compression_state := CompressionS0, - sequence_number := Seq, - security_parameters := - #security_parameters{compression_algorithm = CompAlg} - } = ReadState0} = ConnnectionStates0, PaddingCheck) -> - case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of - {PlainFragment, Mac, ReadState1} -> - MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), - case ssl_record:is_correct_mac(Mac, MacHash) of - true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - ConnnectionStates = ConnnectionStates0#{ - current_read => ReadState1#{ - sequence_number => Seq + 1, - compression_state => CompressionS1}}, - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; - false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) - end; - #alert{} = Alert -> - Alert - end. %%-------------------------------------------------------------------- -spec protocol_version(tls_atom_version() | tls_version()) -> tls_version() | tls_atom_version(). @@ -401,6 +312,70 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> server_verify_data => undefined }. +get_tls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Length), Data:Length/binary, Rest/binary>>, + Acc) -> + get_tls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA, + version = {MajVer, MinVer}, + fragment = Data} | Acc]); +get_tls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Length), + Data:Length/binary, Rest/binary>>, Acc) -> + get_tls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE, + version = {MajVer, MinVer}, + fragment = Data} | Acc]); +get_tls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Length), Data:Length/binary, + Rest/binary>>, Acc) -> + get_tls_records_aux(Rest, [#ssl_tls{type = ?ALERT, + version = {MajVer, MinVer}, + fragment = Data} | Acc]); +get_tls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), + ?UINT16(Length), Data:Length/binary, Rest/binary>>, + Acc) -> + get_tls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC, + version = {MajVer, MinVer}, + fragment = Data} | Acc]); +%% Matches an ssl v2 client hello message. +%% The server must be able to receive such messages, from clients that +%% are willing to use ssl v3 or higher, but have ssl v2 compatibility. +get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, + Acc) -> + case Data0 of + <<?BYTE(?CLIENT_HELLO), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>> -> + Length = Length0-1, + <<?BYTE(_), Data1:Length/binary>> = Data0, + Data = <<?BYTE(?CLIENT_HELLO), ?UINT24(Length), Data1/binary>>, + get_tls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE, + version = {MajVer, MinVer}, + fragment = Data} | Acc]); + _ -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + + end; + +get_tls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), + ?UINT16(Length), _/binary>>, + _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> + ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); + +get_tls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) + when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> + ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); + +get_tls_records_aux(Data, Acc) -> + case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of + true -> + {lists:reverse(Acc), Data}; + false -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) + end. + +encode_plain_text(Type, Version, Data, #{current_write := Write0} = ConnectionStates) -> + {CipherFragment, Write1} = ssl_record:encode_plain_text(Type, Version, Data, Write0), + {CipherText, Write} = encode_tls_cipher_text(Type, Version, CipherFragment, Write1), + {CipherText, ConnectionStates#{current_write => Write}}. + lowest_list_protocol_version(Ver, []) -> Ver; lowest_list_protocol_version(Ver1, [Ver2 | Rest]) -> @@ -411,20 +386,10 @@ highest_list_protocol_version(Ver, []) -> highest_list_protocol_version(Ver1, [Ver2 | Rest]) -> highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest). -encode_tls_cipher_text(Type, {MajVer, MinVer}, Fragment) -> +encode_tls_cipher_text(Type, {MajVer, MinVer}, Fragment, #{sequence_number := Seq} = Write) -> Length = erlang:iolist_size(Fragment), - [<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Fragment]. - - -mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type, - _Length, _Fragment) -> - <<>>; -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 -> - tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, - Length, Fragment). + {[<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Fragment], + Write#{sequence_number => Seq +1}}. highest_protocol_version() -> highest_protocol_version(supported_protocol_versions()). @@ -432,21 +397,96 @@ highest_protocol_version() -> lowest_protocol_version() -> lowest_protocol_version(supported_protocol_versions()). - sufficient_tlsv1_2_crypto_support() -> CryptoSupport = crypto:supports(), proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)). -calc_mac_hash(Type, Version, - PlainFragment, #{sequence_number := SeqNo, - mac_secret := MacSecret, - security_parameters:= - SecPars}) -> - Length = erlang:iolist_size(PlainFragment), - mac_hash(Version, SecPars#security_parameters.mac_algorithm, - MacSecret, SeqNo, Type, - Length, PlainFragment). - -calc_aad(Type, {MajVer, MinVer}, - #{sequence_number := SeqNo}) -> - <<SeqNo:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. +encode_iolist(Type, Data, Version, ConnectionStates0) -> + {ConnectionStates, EncodedMsg} = + lists:foldl(fun(Text, {CS0, Encoded}) -> + {Enc, CS1} = + encode_plain_text(Type, Version, Text, CS0), + {CS1, [Enc | Encoded]} + end, {ConnectionStates0, []}, Data), + {lists:reverse(EncodedMsg), ConnectionStates}. + +%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are +%% not vulnerable to this attack. +split_bin(<<FirstByte:8, Rest/binary>>, ChunkSize, Version, BCA, one_n_minus_one) when + BCA =/= ?RC4 andalso ({3, 1} == Version orelse + {3, 0} == Version) -> + do_split_bin(Rest, ChunkSize, [[FirstByte]]); +%% 0/n splitting countermeasure for clients that are incompatible with 1/n-1 +%% splitting. +split_bin(Bin, ChunkSize, Version, BCA, zero_n) when + BCA =/= ?RC4 andalso ({3, 1} == Version orelse + {3, 0} == Version) -> + do_split_bin(Bin, ChunkSize, [[<<>>]]); +split_bin(Bin, ChunkSize, _, _, _) -> + do_split_bin(Bin, ChunkSize, []). + +do_split_bin(<<>>, _, Acc) -> + lists:reverse(Acc); +do_split_bin(Bin, ChunkSize, Acc) -> + case Bin of + <<Chunk:ChunkSize/binary, Rest/binary>> -> + do_split_bin(Rest, ChunkSize, [Chunk | Acc]); + _ -> + lists:reverse(Acc, [Bin]) + end. + +%%-------------------------------------------------------------------- +-spec decode_cipher_text(#ssl_tls{}, ssl_record:connection_states(), boolean()) -> + {#ssl_tls{}, ssl_record:connection_states()}| #alert{}. +%% +%% Description: Decode cipher text +%%-------------------------------------------------------------------- +decode_cipher_text(#ssl_tls{type = Type, version = Version, + fragment = CipherFragment} = CipherText, + #{current_read := + #{compression_state := CompressionS0, + sequence_number := Seq, + security_parameters := + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm = CompAlg} + } = ReadState0} = ConnnectionStates0, _) -> + AAD = ssl_cipher:calc_aad(Type, Version, ReadState0), + case ssl_record:decipher_aead(Version, CipherFragment, ReadState0, AAD) of + {PlainFragment, ReadState1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#{ + current_read => ReadState1#{sequence_number => Seq + 1, + compression_state => CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + #alert{} = Alert -> + Alert + end; + +decode_cipher_text(#ssl_tls{type = Type, version = Version, + fragment = CipherFragment} = CipherText, + #{current_read := + #{compression_state := CompressionS0, + sequence_number := Seq, + security_parameters := + #security_parameters{compression_algorithm = CompAlg} + } = ReadState0} = ConnnectionStates0, PaddingCheck) -> + case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of + {PlainFragment, Mac, ReadState1} -> + MacHash = ssl_cipher:calc_mac_hash(Type, Version, PlainFragment, ReadState1), + case ssl_record:is_correct_mac(Mac, MacHash) of + true -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#{ + current_read => ReadState1#{ + sequence_number => Seq + 1, + compression_state => CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + #alert{} = Alert -> + Alert + end. diff --git a/lib/ssl/src/ssl_socket.erl b/lib/ssl/src/tls_socket.erl index b2aea2ba9c..e76d9c100a 100644 --- a/lib/ssl/src/ssl_socket.erl +++ b/lib/ssl/src/tls_socket.erl @@ -17,16 +17,19 @@ %% %% %CopyrightEnd% %% --module(ssl_socket). +-module(tls_socket). -behaviour(gen_server). -include("ssl_internal.hrl"). -include("ssl_api.hrl"). --export([socket/5, setopts/3, getopts/3, getstat/3, peername/2, sockname/2, port/2]). +-export([send/3, listen/3, accept/3, socket/5, connect/4, upgrade/3, + setopts/3, getopts/3, getstat/3, peername/2, sockname/2, port/2]). +-export([split_options/1, get_socket_opts/3]). -export([emulated_options/0, internal_inet_values/0, default_inet_values/0, - init/1, start_link/3, terminate/2, inherit_tracker/3, get_emulated_opts/1, + init/1, start_link/3, terminate/2, inherit_tracker/3, + emulated_socket_options/2, get_emulated_opts/1, set_emulated_opts/2, get_all_opts/1, handle_call/3, handle_cast/2, handle_info/2, code_change/3]). @@ -39,6 +42,76 @@ %%-------------------------------------------------------------------- %%% Internal API %%-------------------------------------------------------------------- +send(Transport, Socket, Data) -> + Transport:send(Socket, Data). + +listen(Transport, Port, #config{transport_info = {Transport, _, _, _}, + inet_user = Options, + ssl = SslOpts, emulated = EmOpts} = Config) -> + case Transport:listen(Port, Options ++ internal_inet_values()) of + {ok, ListenSocket} -> + {ok, Tracker} = inherit_tracker(ListenSocket, EmOpts, SslOpts), + {ok, #sslsocket{pid = {ListenSocket, Config#config{emulated = Tracker}}}}; + Err = {error, _} -> + Err + end. + +accept(ListenSocket, #config{transport_info = {Transport,_,_,_} = CbInfo, + connection_cb = ConnectionCb, + ssl = SslOpts, + emulated = Tracker}, Timeout) -> + case Transport:accept(ListenSocket, Timeout) of + {ok, Socket} -> + {ok, EmOpts} = get_emulated_opts(Tracker), + {ok, Port} = tls_socket:port(Transport, Socket), + ConnArgs = [server, "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); + {error, Reason} -> + {error, Reason} + end; + {error, Reason} -> + {error, Reason} + end. + +upgrade(Socket, #config{transport_info = {Transport,_,_,_}= CbInfo, + ssl = SslOptions, + emulated = EmOpts, connection_cb = ConnectionCb}, Timeout) -> + ok = setopts(Transport, Socket, tls_socket:internal_inet_values()), + case peername(Transport, Socket) of + {ok, {Address, Port}} -> + ssl_connection:connect(ConnectionCb, Address, Port, Socket, + {SslOptions, + emulated_socket_options(EmOpts, #socket_options{}), undefined}, + self(), CbInfo, Timeout); + {error, Error} -> + {error, Error} + end. + +connect(Address, Port, + #config{transport_info = CbInfo, inet_user = UserOpts, ssl = SslOpts, + emulated = EmOpts, inet_ssl = SocketOpts, connection_cb = ConnetionCb}, + Timeout) -> + {Transport, _, _, _} = CbInfo, + try Transport:connect(Address, Port, SocketOpts, Timeout) of + {ok, Socket} -> + ssl_connection:connect(ConnetionCb, Address, Port, Socket, + {SslOpts, + emulated_socket_options(EmOpts, #socket_options{}), undefined}, + self(), CbInfo, Timeout); + {error, Reason} -> + {error, Reason} + catch + exit:{function_clause, _} -> + {error, {options, {cb_info, CbInfo}}}; + exit:badarg -> + {error, {options, {socket_options, UserOpts}}}; + exit:{badarg, _} -> + {error, {options, {socket_options, UserOpts}}} + end. + socket(Pid, Transport, Socket, ConnectionCb, Tracker) -> #sslsocket{pid = Pid, %% "The name "fd" is keept for backwards compatibility @@ -241,3 +314,17 @@ get_emulated_opts(TrackerPid, EmOptNames) -> lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts), Value end, EmOptNames). + +emulated_socket_options(InetValues, #socket_options{ + mode = Mode, + header = Header, + active = Active, + packet = Packet, + packet_size = Size}) -> + #socket_options{ + mode = proplists:get_value(mode, InetValues, Mode), + header = proplists:get_value(header, InetValues, Header), + active = proplists:get_value(active, InetValues, Active), + packet = proplists:get_value(packet, InetValues, Packet), + packet_size = proplists:get_value(packet_size, InetValues, Size) + }. diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index 009bcd81ad..d85be6c69e 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index 76999185b6..f779765b18 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -387,6 +387,7 @@ basic_test(ClientCert, ClientKey, ClientCA, ServerCert, ServerKey, ServerCA, Con check_result(Server, SType, Client, CType), close(Server, Client). + ecc_test(Expect, COpts, SOpts, CECCOpts, SECCOpts, Config) -> CCA = proplists:get_value(cacertfile, COpts), CCert = proplists:get_value(certfile, COpts), @@ -411,8 +412,10 @@ ecc_test_error(COpts, SOpts, CECCOpts, SECCOpts, Config) -> Error = {error, {tls_alert, "insufficient security"}}, ssl_test_lib:check_result(Server, Error, Client, Error). -start_client(openssl, Port, PeerCA, OwnCa, Cert, Key, _Config) -> - CA = new_openssl_ca("openssl_client_ca", PeerCA, OwnCa), + +start_client(openssl, Port, PeerCA, OwnCa, Cert, Key, Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + CA = new_openssl_ca(filename:join(PrivDir, "openssl_client_ca.pem"), PeerCA, OwnCa), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Exe = "openssl", Args = ["s_client", "-verify", "2", "-port", integer_to_list(Port), @@ -424,7 +427,8 @@ start_client(openssl, Port, PeerCA, OwnCa, Cert, Key, _Config) -> true = port_command(OpenSslPort, "Hello world"), OpenSslPort; start_client(erlang, Port, PeerCA, OwnCa, Cert, Key, Config) -> - CA = new_ca("erlang_client_ca", PeerCA, OwnCa), + PrivDir = proplists:get_value(priv_dir, Config), + CA = new_ca(filename:join(PrivDir,"erlang_client_ca.pem"), PeerCA, OwnCa), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -434,6 +438,7 @@ start_client(erlang, Port, PeerCA, OwnCa, Cert, Key, Config) -> {cacertfile, CA}, {certfile, Cert}, {keyfile, Key}]}]). + start_client_ecc(erlang, Port, PeerCA, OwnCa, Cert, Key, Expect, ECCOpts, Config) -> CA = new_ca("erlang_client_ca", PeerCA, OwnCa), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -459,8 +464,10 @@ start_client_ecc_error(erlang, Port, PeerCA, OwnCa, Cert, Key, ECCOpts, Config) {cacertfile, CA}, {certfile, Cert}, {keyfile, Key}]}]). -start_server(openssl, PeerCA, OwnCa, Cert, Key, _Config) -> - CA = new_openssl_ca("openssl_server_ca", PeerCA, OwnCa), + +start_server(openssl, PeerCA, OwnCa, Cert, Key, Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + CA = new_openssl_ca(filename:join(PrivDir,"openssl_server_ca.pem"), PeerCA, OwnCa), Port = ssl_test_lib:inet_port(node()), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Exe = "openssl", @@ -471,7 +478,8 @@ start_server(openssl, PeerCA, OwnCa, Cert, Key, _Config) -> true = port_command(OpenSslPort, "Hello world"), {OpenSslPort, Port}; start_server(erlang, PeerCA, OwnCa, Cert, Key, Config) -> - CA = new_ca("erlang_server_ca", PeerCA, OwnCa), + PrivDir = proplists:get_value(priv_dir, Config), + CA = new_ca(filename:join(PrivDir,"erlang_server_ca.pem"), PeerCA, OwnCa), {_, ServerNode, _} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -484,16 +492,17 @@ start_server(erlang, PeerCA, OwnCa, Cert, Key, Config) -> {Server, ssl_test_lib:inet_port(Server)}. start_server_with_raw_key(erlang, PeerCA, OwnCa, Cert, Key, Config) -> - CA = new_ca("erlang_server_ca", PeerCA, OwnCa), + PrivDir = proplists:get_value(priv_dir, Config), + CA = new_ca(filename:join(PrivDir, "erlang_server_ca.pem"), PeerCA, OwnCa), {_, ServerNode, _} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, - send_recv_result_active, - []}}, - {options, - [{verify, verify_peer}, {cacertfile, CA}, - {certfile, Cert}, {key, Key}]}]), + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, + []}}, + {options, + [{verify, verify_peer}, {cacertfile, CA}, + {certfile, Cert}, {key, Key}]}]), {Server, ssl_test_lib:inet_port(Server)}. start_server_ecc(erlang, PeerCA, OwnCa, Cert, Key, Expect, ECCOpts, Config) -> diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl index 9d57e89b9b..158b3524ac 100644 --- a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 392da738ec..de5895d7ba 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -52,7 +52,7 @@ all() -> {group, options}, {group, options_tls}, {group, session}, - %%{group, 'dtlsv1.2'}, + {group, 'dtlsv1.2'}, %%{group, 'dtlsv1'}, {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, @@ -66,6 +66,7 @@ groups() -> {options, [], options_tests()}, {options_tls, [], options_tests_tls()}, %%{'dtlsv1.2', [], all_versions_groups()}, + {'dtlsv1.2', [], [connection_information]}, %%{'dtlsv1', [], all_versions_groups()}, {'tlsv1.2', [], all_versions_groups() ++ tls_versions_groups() ++ [conf_signature_algs, no_common_signature_algs]}, {'tlsv1.1', [], all_versions_groups() ++ tls_versions_groups()}, @@ -135,7 +136,8 @@ options_tests() -> honor_server_cipher_order, honor_client_cipher_order, unordered_protocol_versions_server, - unordered_protocol_versions_client + unordered_protocol_versions_client, + max_handshake_size ]. options_tests_tls() -> @@ -3859,6 +3861,29 @@ unordered_protocol_versions_client(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). %%-------------------------------------------------------------------- +max_handshake_size() -> + [{doc,"Test that we can set max_handshake_size to max value."}]. + +max_handshake_size(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{max_handshake_size, 8388607} |ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{max_handshake_size, 8388607} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +%%-------------------------------------------------------------------- server_name_indication_option() -> [{doc,"Test API server_name_indication option to connect."}]. diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 51f0651568..74b14145dd 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% Copyright Ericsson AB 2008-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. diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl index 02c98fc40f..f10d27fbc6 100644 --- a/lib/ssl/test/ssl_pem_cache_SUITE.erl +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-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. diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index 28637fc32d..9862b3ce64 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl index f6af1e6182..875399db76 100644 --- a/lib/ssl/test/ssl_upgrade_SUITE.erl +++ b/lib/ssl/test/ssl_upgrade_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014-2015. All Rights Reserved. +%% Copyright Ericsson AB 2014-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. diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 59732c7926..2cdb825d75 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 8.0.3 +SSL_VSN = 8.1 diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml index e2dfc2ab9b..57bb5207df 100644 --- a/lib/stdlib/doc/src/assert_hrl.xml +++ b/lib/stdlib/doc/src/assert_hrl.xml @@ -4,7 +4,7 @@ <fileref> <header> <copyright> - <year>2012</year><year>2015</year> + <year>2012</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -28,7 +28,7 @@ <date></date> <rev></rev> </header> - <file>assert.hrl.xml</file> + <file>assert.hrl</file> <filesummary>Assert macros.</filesummary> <description> <p>The include file <c>assert.hrl</c> provides macros for inserting @@ -49,25 +49,33 @@ entries in the <c>Info</c> list are optional; do not rely programatically on any of them being present.</p> + <p>Each assert macro has a corresponding version with an extra argument, + for adding comments to assertions. These can for example be printed as + part of error reports, to clarify the meaning of the check that + failed. For example, <c>?assertEqual(0, fib(0), "Fibonacci is defined + for zero")</c>. The comment text can be any character data (string, + UTF8-binary, or deep list of such data), and will be included in the + error term as <c>{comment, Text}</c>.</p> + <p>If the macro <c>NOASSERT</c> is defined when <c>assert.hrl</c> is read by the compiler, the macros are defined as equivalent to the atom - <c>ok</c>. The test is not performed and there is no cost at runtime.</p> + <c>ok</c>. The test will not be performed and there is no cost at runtime.</p> <p>For example, using <c>erlc</c> to compile your modules, the following - disable all assertions:</p> + disables all assertions:</p> <code type="none"> erlc -DNOASSERT=true *.erl</code> - <p>The value of <c>NOASSERT</c> does not matter, only the fact that it is - defined.</p> + <p>(The value of <c>NOASSERT</c> does not matter, only the fact that it is + defined.)</p> <p>A few other macros also have effect on the enabling or disabling of assertions:</p> <list type="bulleted"> - <item><p>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c>, unless - <c>DEBUG</c> is also defined, which is assumed to take precedence.</p> + <item><p>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c> (unless + <c>DEBUG</c> is also defined, which overrides <c>NODEBUG</c>).</p> </item> <item><p>If <c>ASSERT</c> is defined, it overrides <c>NOASSERT</c>, that is, the assertions remain enabled.</p></item> @@ -84,16 +92,19 @@ erlc -DNOASSERT=true *.erl</code> <title>Macros</title> <taglist> <tag><c>assert(BoolExpr)</c></tag> + <tag><c>assert(BoolExpr, Comment)</c></tag> <item> <p>Tests that <c>BoolExpr</c> completes normally returning <c>true</c>.</p> </item> <tag><c>assertNot(BoolExpr)</c></tag> + <tag><c>assertNot(BoolExpr, Comment)</c></tag> <item> <p>Tests that <c>BoolExpr</c> completes normally returning <c>false</c>.</p> </item> <tag><c>assertMatch(GuardedPattern, Expr)</c></tag> + <tag><c>assertMatch(GuardedPattern, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes normally yielding a value that matches <c>GuardedPattern</c>, for example:</p> @@ -104,6 +115,7 @@ erlc -DNOASSERT=true *.erl</code> ?assertMatch({bork, X} when X > 0, f())</code> </item> <tag><c>assertNotMatch(GuardedPattern, Expr)</c></tag> + <tag><c>assertNotMatch(GuardedPattern, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes normally yielding a value that does not match <c>GuardedPattern</c>.</p> @@ -111,16 +123,19 @@ erlc -DNOASSERT=true *.erl</code> <c>when</c> part.</p> </item> <tag><c>assertEqual(ExpectedValue, Expr)</c></tag> + <tag><c>assertEqual(ExpectedValue, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes normally yielding a value that is exactly equal to <c>ExpectedValue</c>.</p> </item> <tag><c>assertNotEqual(ExpectedValue, Expr)</c></tag> + <tag><c>assertNotEqual(ExpectedValue, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes normally yielding a value that is not exactly equal to <c>ExpectedValue</c>.</p> </item> <tag><c>assertException(Class, Term, Expr)</c></tag> + <tag><c>assertException(Class, Term, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes abnormally with an exception of type <c>Class</c> and with the associated <c>Term</c>. The assertion fails @@ -130,6 +145,7 @@ erlc -DNOASSERT=true *.erl</code> patterns, as in <c>assertMatch</c>.</p> </item> <tag><c>assertNotException(Class, Term, Expr)</c></tag> + <tag><c>assertNotException(Class, Term, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> does not evaluate abnormally with an exception of type <c>Class</c> and with the associated <c>Term</c>. @@ -139,14 +155,17 @@ erlc -DNOASSERT=true *.erl</code> be guarded patterns.</p> </item> <tag><c>assertError(Term, Expr)</c></tag> + <tag><c>assertError(Term, Expr, Comment)</c></tag> <item> <p>Equivalent to <c>assertException(error, Term, Expr)</c></p> </item> <tag><c>assertExit(Term, Expr)</c></tag> + <tag><c>assertExit(Term, Expr, Comment)</c></tag> <item> <p>Equivalent to <c>assertException(exit, Term, Expr)</c></p> </item> <tag><c>assertThrow(Term, Expr)</c></tag> + <tag><c>assertThrow(Term, Expr, Comment)</c></tag> <item> <p>Equivalent to <c>assertException(throw, Term, Expr)</c></p> </item> diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml index 2e4261d72e..eb6e32aecf 100644 --- a/lib/stdlib/doc/src/dets.xml +++ b/lib/stdlib/doc/src/dets.xml @@ -100,18 +100,12 @@ provided by Dets, neither is the limited support for concurrent updates that makes a sequence of <c>first</c> and <c>next</c> calls safe to use on fixed ETS tables. Both these - features will be provided by Dets in a future release of + features may be provided by Dets in a future release of Erlang/OTP. Until then, the Mnesia application (or some user-implemented method for locking) must be used to implement safe concurrency. Currently, no Erlang/OTP library has support for ordered disk-based term storage.</p> - <p>Two versions of the format used for storing objects on file are - supported by Dets. The first version, 8, is the format always used - for tables created by Erlang/OTP R7 and earlier. The second version, 9, - is the default version of tables created by Erlang/OTP R8 (and later - releases). Erlang/OTP R8 can create version 8 tables, and convert version - 8 tables to version 9, and conversely, upon request.</p> <p>All Dets functions return <c>{error, Reason}</c> if an error occurs (<seealso marker="#first/1"><c>first/1</c></seealso> and <seealso marker="#next/2"><c>next/2</c></seealso> are exceptions, they @@ -190,9 +184,6 @@ <datatype> <name name="type"/> </datatype> - <datatype> - <name name="version"/> - </datatype> </datatypes> <funcs> @@ -385,8 +376,7 @@ <p><c>{bchunk_format, binary()}</c> - An opaque binary describing the format of the objects returned by <c>bchunk/2</c>. The binary can be used as argument to - <c>is_compatible_chunk_format/2</c>. Only available for - version 9 tables.</p> + <c>is_compatible_chunk_format/2</c>.</p> </item> <item> <p><c>{hash, Hash}</c> - Describes which BIF is @@ -394,10 +384,6 @@ Dets table. Possible values of <c>Hash</c>:</p> <list> <item> - <p><c>hash</c> - Implies that the <c>erlang:hash/2</c> BIF - is used.</p> - </item> - <item> <p><c>phash</c> - Implies that the <c>erlang:phash/2</c> BIF is used.</p> </item> @@ -413,8 +399,7 @@ </item> <item> <p><c>{no_keys, integer >= 0()}</c> - The number of different - keys stored in the table. Only available for version 9 - tables.</p> + keys stored in the table.</p> </item> <item> <p><c>{no_objects, integer >= 0()}</c> - The number of objects @@ -424,8 +409,7 @@ <p><c>{no_slots, {Min, Used, Max}}</c> - The number of slots of the table. <c>Min</c> is the minimum number of slots, <c>Used</c> is the number of currently used slots, - and <c>Max</c> is the maximum number of slots. Only - available for version 9 tables.</p> + and <c>Max</c> is the maximum number of slots.</p> </item> <item> <p><c>{owner, pid()}</c> - The pid of the process that @@ -466,10 +450,6 @@ time warp safe</seealso>. Time warp safe code must use <c>safe_fixed_monotonic_time</c> instead.</p> </item> - <item> - <p><c>{version, integer()}</c> - The version of the format of - the table.</p> - </item> </list> </desc> </func> @@ -662,8 +642,8 @@ ok objects at a time, until at least one object matches or the end of the table is reached. The default, indicated by giving <c><anno>N</anno></c> the value <c>default</c>, is to let - the number of objects vary depending on the sizes of the objects. If - <c><anno>Name</anno></c> is a version 9 table, all objects with the + the number of objects vary depending on the sizes of the objects. + All objects with the same key are always matched at the same time, which implies that more than <anno>N</anno> objects can sometimes be matched.</p> <p>The table is always to be protected using @@ -743,9 +723,9 @@ ok end of the table is reached. The default, indicated by giving <c><anno>N</anno></c> the value <c>default</c>, is to let the number - of objects vary depending on the sizes of the objects. If - <c><anno>Name</anno></c> is a version 9 table, all matching objects - with the same key are always returned in the same reply, which implies + of objects vary depending on the sizes of the objects. All + matching objects with the same key are always returned + in the same reply, which implies that more than <anno>N</anno> objects can sometimes be returned.</p> <p>The table is always to be protected using <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso> @@ -842,8 +822,7 @@ ok maximal value. Notice that a higher value can increase the table fragmentation, and a smaller value can decrease the fragmentation, at - the expense of execution time. Only available for version - 9 tables.</p> + the expense of execution time.</p> </item> <item> <p><c>{min_no_slots, </c><seealso marker="#type-no_slots"> @@ -880,12 +859,7 @@ ok FileName}}</c> is returned if the table must be repaired.</p> <p>Value <c>force</c> means that a reparation is made even if the table is properly closed. - This is how to convert tables created by older versions of - STDLIB. An example is tables hashed with the deprecated - <c>erlang:hash/2</c> BIF. Tables created with Dets from - STDLIB version 1.8.2 or later use function - <c>erlang:phash/2</c> or function <c>erlang:phash2/1</c>, - which is preferred.</p> + This is a seldom needed option.</p> <p>Option <c>repair</c> is ignored if the table is already open.</p> </item> <item> @@ -893,15 +867,6 @@ ok <c>type()</c></seealso><c>}</c> - The table type. Defaults to <c>set</c>.</p> </item> - <item> - <p><c>{version, </c><seealso marker="#type-version"> - <c>version()</c></seealso><c>}</c> - The version of the format - used for the table. Defaults to <c>9</c>. Tables on the format - used before Erlang/OTP R8 can be created by specifying value - <c>8</c>. A version 8 table can be converted to a version 9 - table by specifying options <c>{version,9}</c> - and <c>{repair,force}</c>.</p> - </item> </list> </desc> </func> @@ -1041,8 +1006,8 @@ ok a time, until at least one object matches or the end of the table is reached. The default, indicated by giving <c><anno>N</anno></c> the value <c>default</c>, is to let the number - of objects vary depending on the sizes of the objects. If - <c><anno>Name</anno></c> is a version 9 table, all objects with the + of objects vary depending on the sizes of the objects. All + objects with the same key are always handled at the same time, which implies that the match specification can be applied to more than <anno>N</anno> objects.</p> diff --git a/lib/stdlib/doc/src/dict.xml b/lib/stdlib/doc/src/dict.xml index c926ff1b5b..c229a18721 100644 --- a/lib/stdlib/doc/src/dict.xml +++ b/lib/stdlib/doc/src/dict.xml @@ -106,6 +106,16 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Return value and new dictionary without element with this value.</fsummary> + <desc> + <p>This function returns value from dictionary and a + new dictionary without this value. + Returns <c>error</c> if the key is not present in the dictionary.</p> + </desc> + </func> + + <func> <name name="filter" arity="2"/> <fsummary>Select elements that satisfy a predicate.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 5f5d2b7f36..05401a2d40 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -541,10 +541,6 @@ Error: fun containing local Erlang function calls <c><anno>Tab</anno></c> is not of the correct type, or if <c><anno>Item</anno></c> is not one of the allowed values, a <c>badarg</c> exception is raised.</p> - <warning> - <p>In Erlang/OTP R11B and earlier, this function would not fail but - return <c>undefined</c> for invalid values for <c>Item</c>.</p> - </warning> <p>In addition to the <c>{<anno>Item</anno>,<anno>Value</anno>}</c> pairs defined for <seealso marker="#info/1"><c>info/1</c></seealso>, the following items are allowed:</p> diff --git a/lib/stdlib/doc/src/gb_sets.xml b/lib/stdlib/doc/src/gb_sets.xml index d677dd6f83..7bfe477a11 100644 --- a/lib/stdlib/doc/src/gb_sets.xml +++ b/lib/stdlib/doc/src/gb_sets.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2001</year><year>2015</year> + <year>2001</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/stdlib/doc/src/gb_trees.xml b/lib/stdlib/doc/src/gb_trees.xml index 9a49d66820..5cfff021c1 100644 --- a/lib/stdlib/doc/src/gb_trees.xml +++ b/lib/stdlib/doc/src/gb_trees.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2001</year><year>2015</year> + <year>2001</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -109,6 +109,28 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Returns a value and new tree without node with key <c>Key</c>.</fsummary> + <desc> + <p>Returns a value <c><anno>Value</anno></c> from node with key <c><anno>Key</anno></c> + and new <c><anno>Tree2</anno></c> without the node with this value. + Assumes that the node with key is present in the tree, + crashes otherwise.</p> + </desc> + </func> + + <func> + <name name="take_any" arity="2"/> + <fsummary>Returns a value and new tree without node with key <c>Key</c>.</fsummary> + <desc> + <p>Returns a value <c><anno>Value</anno></c> from node with key <c><anno>Key</anno></c> + and new <c><anno>Tree2</anno></c> without the node with this value. + Returns <c>error</c> if the node with the key is not present in + the tree.</p> + </desc> + </func> + + <func> <name name="empty" arity="0"/> <fsummary>Return an empty tree.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index c24542002a..42e952fd46 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -350,13 +350,18 @@ gen_event:stop -----> Module:terminate/2 <func> <name>start() -> Result</name> - <name>start(EventMgrName) -> Result</name> + <name>start(EventMgrName | Options) -> Result</name> + <name>start(EventMgrName, Options) -> Result</name> <fsummary>Create a stand-alone event manager process.</fsummary> <type> - <v>EventMgrName = {local,Name} | {global,GlobalName} - | {via,Module,ViaName}</v> + <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v> <v> Name = atom()</v> <v> GlobalName = ViaName = term()</v> + <v>Options = [Option]</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Dbgs = [Dbg]</v> + <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> + <v> SOpts = [term()]</v> <v>Result = {ok,Pid} | {error,{already_started,Pid}}</v> <v> Pid = pid()</v> </type> @@ -371,14 +376,19 @@ gen_event:stop -----> Module:terminate/2 <func> <name>start_link() -> Result</name> - <name>start_link(EventMgrName) -> Result</name> + <name>start_link(EventMgrName | Options) -> Result</name> + <name>start_link(EventMgrName, Options) -> Result</name> <fsummary>Create a generic event manager process in a supervision tree. </fsummary> <type> - <v>EventMgrName = {local,Name} | {global,GlobalName} - | {via,Module,ViaName}</v> + <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v> <v> Name = atom()</v> <v> GlobalName = ViaName = term()</v> + <v>Options = [Option]</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Dbgs = [Dbg]</v> + <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> + <v> SOpts = [term()]</v> <v>Result = {ok,Pid} | {error,{already_started,Pid}}</v> <v> Pid = pid()</v> </type> diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index de06987d38..719ab2b558 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -534,11 +534,6 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 the function call fails.</p> <p>Return value <c>Reply</c> is defined in the return value of <c>Module:StateName/3</c>.</p> - <note> - <p>The ancient behavior of sometimes consuming the server - exit message if the server died during the call while - linked to the client was removed in Erlang 5.6/OTP R12B.</p> - </note> </desc> </func> </funcs> diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 4a7dd60858..662076b5f0 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -162,11 +162,6 @@ gen_server:abcast -----> Module:handle_cast/2 of <c>Module:handle_call/3</c>.</p> <p>The call can fail for many reasons, including time-out and the called <c>gen_server</c> process dying before or during the call.</p> - <note> - <p>The ancient behavior of sometimes consuming the server - exit message if the server died during the call while - linked to the client was removed in Erlang 5.6/OTP R12B.</p> - </note> </desc> </func> diff --git a/lib/stdlib/doc/src/introduction.xml b/lib/stdlib/doc/src/introduction.xml index 5bf545c65f..642ca02430 100644 --- a/lib/stdlib/doc/src/introduction.xml +++ b/lib/stdlib/doc/src/introduction.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1999</year> - <year>2013</year> + <year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 554150380f..0143686bb2 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -31,6 +31,48 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When a simple_one_for_one supervisor is shutting down, + and a child exits with an exit reason of the form + {shutdown, Term}, an error report was earlier printed. + This is now corrected.</p> + <p> + Own Id: OTP-13907 Aux Id: PR-1158, ERL-163 </p> + </item> + <item> + <p> Allow empty list as parameter of the fun used with + <c>dbg:fun2ms/1</c>. </p> + <p> + Own Id: OTP-13974</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The new behaviour gen_statem has been improved with 3 new + features: the possibility to use old style non-proxy + timeouts for gen_statem:call/2,3, state entry code, and + state timeouts. These are backwards compatible. Minor + code and documentation improvements has been performed + including a borderline semantics correction of timeout + zero handling.</p> + <p> + Own Id: OTP-13929 Aux Id: PR-1170, ERL-284 </p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/doc/src/orddict.xml b/lib/stdlib/doc/src/orddict.xml index 39b43809b6..26bbf499c6 100644 --- a/lib/stdlib/doc/src/orddict.xml +++ b/lib/stdlib/doc/src/orddict.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2000</year><year>2015</year> + <year>2000</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -113,6 +113,15 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Return value and new dictionary without element with this value.</fsummary> + <desc> + <p>This function returns value from dictionary and new dictionary without this value. + Returns <c>error</c> if the key is not present in the dictionary.</p> + </desc> + </func> + + <func> <name name="filter" arity="2"/> <fsummary>Select elements that satisfy a predicate.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml index 1364a3277b..8745e16908 100644 --- a/lib/stdlib/doc/src/rand.xml +++ b/lib/stdlib/doc/src/rand.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2015</year> + <year>2015</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/stdlib/doc/src/sets.xml b/lib/stdlib/doc/src/sets.xml index f7668af1ed..44dc104645 100644 --- a/lib/stdlib/doc/src/sets.xml +++ b/lib/stdlib/doc/src/sets.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2000</year><year>2015</year> + <year>2000</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index 1120b926d5..9091a46df9 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2014</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl index 82b3907693..2fbaeba0b2 100644 --- a/lib/stdlib/include/assert.hrl +++ b/lib/stdlib/include/assert.hrl @@ -50,7 +50,8 @@ %% It is not possible to nest assert macros. -ifdef(NOASSERT). --define(assert(BoolExpr),ok). +-define(assert(BoolExpr), ok). +-define(assert(BoolExpr, Comment), ok). -else. %% The assert macro is written the way it is so as not to cause warnings %% for clauses that cannot match, even if the expression is a constant or @@ -73,11 +74,31 @@ end end)()) end). +-define(assert(BoolExpr, Comment), + begin + ((fun () -> + __T = is_process_alive(self()), % cheap source of truth + case (BoolExpr) of + __T -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??BoolExpr)}, + {expected, true}, + case not __T of + __V -> {value, false}; + _ -> {not_boolean, __V} + end]}) + end + end)()) + end). -endif. %% This is the inverse case of assert, for convenience. -ifdef(NOASSERT). -define(assertNot(BoolExpr),ok). +-define(assertNot(BoolExpr, Comment), ok). -else. -define(assertNot(BoolExpr), begin @@ -97,12 +118,32 @@ end end)()) end). +-define(assertNot(BoolExpr, Comment), + begin + ((fun () -> + __F = not is_process_alive(self()), + case (BoolExpr) of + __F -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??BoolExpr)}, + {expected, false}, + case not __F of + __V -> {value, true}; + _ -> {not_boolean, __V} + end]}) + end + end)()) + end). -endif. %% This is mostly a convenience which gives more detailed reports. %% Note: Guard is a guarded pattern, and can not be used for value. -ifdef(NOASSERT). -define(assertMatch(Guard, Expr), ok). +-define(assertMatch(Guard, Expr, Comment), ok). -else. -define(assertMatch(Guard, Expr), begin @@ -118,11 +159,27 @@ end end)()) end). +-define(assertMatch(Guard, Expr, Comment), + begin + ((fun () -> + case (Expr) of + Guard -> ok; + __V -> erlang:error({assertMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}) + end + end)()) + end). -endif. %% This is the inverse case of assertMatch, for convenience. -ifdef(NOASSERT). -define(assertNotMatch(Guard, Expr), ok). +-define(assertNotMatch(Guard, Expr, Comment), ok). -else. -define(assertNotMatch(Guard, Expr), begin @@ -139,12 +196,29 @@ end end)()) end). +-define(assertNotMatch(Guard, Expr, Comment), + begin + ((fun () -> + __V = (Expr), + case __V of + Guard -> erlang:error({assertNotMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}); + _ -> ok + end + end)()) + end). -endif. %% This is a convenience macro which gives more detailed reports when %% the expected LHS value is not a pattern, but a computed value -ifdef(NOASSERT). -define(assertEqual(Expect, Expr), ok). +-define(assertEqual(Expect, Expr, Comment), ok). -else. -define(assertEqual(Expect, Expr), begin @@ -161,11 +235,28 @@ end end)()) end). +-define(assertEqual(Expect, Expr, Comment), + begin + ((fun () -> + __X = (Expect), + case (Expr) of + __X -> ok; + __V -> erlang:error({assertEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {expected, __X}, + {value, __V}]}) + end + end)()) + end). -endif. %% This is the inverse case of assertEqual, for convenience. -ifdef(NOASSERT). -define(assertNotEqual(Unexpected, Expr), ok). +-define(assertNotEqual(Unexpected, Expr, Comment), ok). -else. -define(assertNotEqual(Unexpected, Expr), begin @@ -181,12 +272,28 @@ end end)()) end). +-define(assertNotEqual(Unexpected, Expr, Comment), + begin + ((fun () -> + __X = (Unexpected), + case (Expr) of + __X -> erlang:error({assertNotEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {value, __X}]}); + _ -> ok + end + end)()) + end). -endif. %% Note: Class and Term are patterns, and can not be used for value. %% Term can be a guarded pattern, but Class cannot. -ifdef(NOASSERT). -define(assertException(Class, Term, Expr), ok). +-define(assertException(Class, Term, Expr, Comment), ok). -else. -define(assertException(Class, Term, Expr), begin @@ -216,17 +323,54 @@ end end)()) end). +-define(assertException(Class, Term, Expr, Comment), + begin + ((fun () -> + try (Expr) of + __V -> erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_success, __V}]}) + catch + Class:Term -> ok; + __C:__T -> + erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace()}}]}) + end + end)()) + end). -endif. -define(assertError(Term, Expr), ?assertException(error, Term, Expr)). +-define(assertError(Term, Expr, Comment), + ?assertException(error, Term, Expr, Comment)). -define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). +-define(assertExit(Term, Expr, Comment), + ?assertException(exit, Term, Expr, Comment)). -define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). +-define(assertThrow(Term, Expr, Comment), + ?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. %% Both Class and Term can be guarded patterns. -ifdef(NOASSERT). -define(assertNotException(Class, Term, Expr), ok). +-define(assertNotException(Class, Term, Expr, Comment), ok). -else. -define(assertNotException(Class, Term, Expr), begin @@ -257,6 +401,36 @@ end end)()) end). +-define(assertNotException(Class, Term, Expr, Comment), + begin + ((fun () -> + try (Expr) of + _ -> ok + catch + __C:__T -> + case __C of + Class -> + case __T of + Term -> + erlang:error({assertNotException, + [{module, ?MODULE}, + {line, ?LINE}, + {comment, (Comment)}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , " + ++(??Term)++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace() + }}]}); + _ -> ok + end; + _ -> ok + end + end + end)()) + end). -endif. -endif. % ASSERT_HRL diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 302834f9d0..d6c0ff8d8d 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -51,7 +51,6 @@ MODULES= \ dets_server \ dets_sup \ dets_utils \ - dets_v8 \ dets_v9 \ dict \ digraph \ @@ -225,7 +224,6 @@ $(EBIN)/beam_lib.beam: ../include/erl_compile.hrl ../../kernel/include/file.hrl $(EBIN)/dets.beam: dets.hrl ../../kernel/include/file.hrl $(EBIN)/dets_server.beam: dets.hrl $(EBIN)/dets_utils.beam: dets.hrl -$(EBIN)/dets_v8.beam: dets.hrl $(EBIN)/dets_v9.beam: dets.hrl $(EBIN)/erl_bits.beam: ../include/erl_bits.hrl $(EBIN)/erl_compile.beam: ../include/erl_compile.hrl ../../kernel/include/file.hrl diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 8ce29f23d3..5bc9475fc8 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -105,9 +105,6 @@ %%% the file with the split indicator, size etc is held in ram by the %%% server at all times. %%% -%%% The parts specific for formats up to and including 8(c) are -%%% implemented in dets_v8.erl, parts specific for format 9 are -%%% implemented in dets_v9.erl. %% The method of hashing is the so called linear hashing algorithm %% with segments. @@ -140,28 +137,33 @@ %%% written, and a repair is forced next time the file is opened. -record(dets_cont, { - what, % object | bindings | select | bchunk - no_objs, % requested number of objects: default | integer() > 0 - bin, % small chunk not consumed, or 'eof' at end-of-file - alloc, % the part of the file not yet scanned, mostly a binary - tab, - proc, % the pid of the Dets process - match_program % true | compiled_match_spec() | undefined + what :: 'undefined' | 'bchunk' | 'bindings' | 'object' | 'select', + no_objs :: 'default' | pos_integer(), % requested number of objects + bin :: 'eof' | binary(), % small chunk not consumed, + % or 'eof' at end-of-file + alloc :: binary() % the part of the file not yet scanned + | {From :: non_neg_integer(), + To :: non_neg_integer, + binary()}, + tab :: tab_name(), + proc :: 'undefined' | pid(), % the pid of the Dets process + match_program :: 'true' + | 'undefined' + | {'match_spec', ets:comp_match_spec()} }). -record(open_args, { - file, - type, - keypos, - repair, - min_no_slots, - max_no_slots, - ram_file, - delayed_write, - auto_save, - access, - version, - debug + file :: list(), + type :: type(), + keypos :: keypos(), + repair :: 'force' | boolean(), + min_no_slots :: no_slots(), + max_no_slots :: no_slots(), + ram_file :: boolean(), + delayed_write :: cache_parms(), + auto_save :: auto_save(), + access :: access(), + debug :: boolean() }). -define(PATTERN_TO_OBJECT_MATCH_SPEC(Pat), [{Pat,[],['$_']}]). @@ -177,20 +179,13 @@ %%-define(PROFILE(C), C). -define(PROFILE(C), void). --type access() :: 'read' | 'read_write'. --type auto_save() :: 'infinity' | non_neg_integer(). -opaque bindings_cont() :: #dets_cont{}. -opaque cont() :: #dets_cont{}. --type keypos() :: pos_integer(). -type match_spec() :: ets:match_spec(). -type object() :: tuple(). --type no_slots() :: non_neg_integer() | 'default'. -opaque object_cont() :: #dets_cont{}. -type pattern() :: atom() | tuple(). -opaque select_cont() :: #dets_cont{}. --type tab_name() :: term(). --type type() :: 'bag' | 'duplicate_bag' | 'set'. --type version() :: 8 | 9 | 'default'. %%% Some further debug code was added in R12B-1 (stdlib-1.15.1): %%% - there is a new open_file() option 'debug'; @@ -273,19 +268,20 @@ delete_all_objects(Tab) -> delete_object(Tab, O) -> badarg(treq(Tab, {delete_object, [O]}), [Tab, O]). +%% Backwards compatibility. +fsck(Fname, _Version) -> + fsck(Fname). + %% Given a filename, fsck it. Debug. fsck(Fname) -> - fsck(Fname, default). - -fsck(Fname, Version) -> catch begin {ok, Fd, FH} = read_file_header(Fname, read, false), ?DEBUGF("FileHeader: ~p~n", [FH]), - case (FH#fileheader.mod):check_file_header(FH, Fd) of + case dets_v9:check_file_header(FH, Fd) of {error, not_closed} -> - fsck(Fd, make_ref(), Fname, FH, default, default, Version); - {ok, _Head, _Extra} -> - fsck(Fd, make_ref(), Fname, FH, default, default, Version); + fsck(Fd, make_ref(), Fname, FH, default, default); + {ok, _Head} -> + fsck(Fd, make_ref(), Fname, FH, default, default); Error -> Error end @@ -372,7 +368,7 @@ info(Tab) -> Item :: 'access' | 'auto_save' | 'bchunk_format' | 'hash' | 'file_size' | 'filename' | 'keypos' | 'memory' | 'no_keys' | 'no_objects' | 'no_slots' | 'owner' | 'ram_file' - | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type' | 'version', + | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type', Value :: term(). info(Tab, owner) -> @@ -640,8 +636,7 @@ open_file(File) -> | {'keypos', keypos()} | {'ram_file', boolean()} | {'repair', boolean() | 'force'} - | {'type', type()} - | {'version', version()}, + | {'type', type()}, Reason :: term(). open_file(Tab, Args) when is_list(Args) -> @@ -674,13 +669,13 @@ remove_user(Pid, From) -> Continuation2 :: select_cont(), MatchSpec :: match_spec(). -repair_continuation(#dets_cont{match_program = B}=Cont, MS) - when is_binary(B) -> +repair_continuation(#dets_cont{match_program = {match_spec, B}}=Cont, MS) -> case ets:is_compiled_ms(B) of true -> Cont; false -> - Cont#dets_cont{match_program = ets:match_spec_compile(MS)} + Cont#dets_cont{match_program = {match_spec, + ets:match_spec_compile(MS)}} end; repair_continuation(#dets_cont{}=Cont, _MS) -> Cont; @@ -999,7 +994,9 @@ init_chunk_match(Tab, Pat, What, N, Safe) when is_integer(N), N >= 0; case req(Proc, {match, MP, Spec, N, Safe}) of {done, L} -> {L, #dets_cont{tab = Tab, proc = Proc, - what = What, bin = eof}}; + what = What, bin = eof, + no_objs = default, + alloc = <<>>}}; {cont, State} -> chunk_match(State#dets_cont{what = What, tab = Tab, @@ -1041,17 +1038,17 @@ chunk_match(#dets_cont{proc = Proc}=State, Safe) -> do_foldl_bins(Bins, true) -> foldl_bins(Bins, []); -do_foldl_bins(Bins, MP) -> +do_foldl_bins(Bins, {match_spec, MP}) -> foldl_bins(Bins, MP, []). foldl_bins([], Terms) -> - %% Preserve time order (version 9). + %% Preserve time order. Terms; foldl_bins([Bin | Bins], Terms) -> foldl_bins(Bins, [binary_to_term(Bin) | Terms]). foldl_bins([], _MP, Terms) -> - %% Preserve time order (version 9). + %% Preserve time order. Terms; foldl_bins([Bin | Bins], MP, Terms) -> Term = binary_to_term(Bin), @@ -1068,7 +1065,7 @@ compile_match_spec(select, ?PATTERN_TO_OBJECT_MATCH_SPEC('_') = Spec) -> compile_match_spec(select, Spec) -> case catch ets:match_spec_compile(Spec) of X when is_binary(X) -> - {Spec, X}; + {Spec, {match_spec, X}}; _ -> badarg end; @@ -1091,16 +1088,10 @@ defaults(Tab, Args) -> delayed_write = ?DEFAULT_CACHE, auto_save = timer:minutes(?DEFAULT_AUTOSAVE), access = read_write, - version = default, debug = false}, Fun = fun repl/2, Defaults = lists:foldl(Fun, Defaults0, Args), - case Defaults#open_args.version of - 8 -> - Defaults#open_args{max_no_slots = default}; - _ -> - is_comp_min_max(Defaults) - end. + is_comp_min_max(Defaults). to_list(T) when is_atom(T) -> atom_to_list(T); to_list(T) -> T. @@ -1131,7 +1122,6 @@ repl({file, File}, Defs) when is_atom(File) -> repl({keypos, P}, Defs) when is_integer(P), P > 0 -> Defs#open_args{keypos =P}; repl({max_no_slots, I}, Defs) -> - %% Version 9 only. MaxSlots = is_max_no_slots(I), Defs#open_args{max_no_slots = MaxSlots}; repl({min_no_slots, I}, Defs) -> @@ -1147,8 +1137,9 @@ repl({type, T}, Defs) -> mem(T, [set, bag, duplicate_bag]), Defs#open_args{type =T}; repl({version, Version}, Defs) -> - V = is_version(Version), - Defs#open_args{version = V}; + %% Backwards compatibility. + is_version(Version), + Defs; repl({debug, Bool}, Defs) -> %% Not documented. mem(Bool, [true, false]), @@ -1164,16 +1155,15 @@ is_max_no_slots(default) -> default; is_max_no_slots(I) when is_integer(I), I > 0, I < 1 bsl 31 -> I. is_comp_min_max(Defs) -> - #open_args{max_no_slots = Max, min_no_slots = Min, version = V} = Defs, - case V of - _ when Min =:= default -> Defs; - _ when Max =:= default -> Defs; - _ -> true = Min =< Max, Defs + #open_args{max_no_slots = Max, min_no_slots = Min} = Defs, + if + Min =:= default -> Defs; + Max =:= default -> Defs; + true -> true = Min =< Max, Defs end. -is_version(default) -> default; -is_version(8) -> 8; -is_version(9) -> 9. +is_version(default) -> true; +is_version(9) -> true. mem(X, L) -> case lists:member(X, L) of @@ -1288,17 +1278,23 @@ badarg_exit(Reply, _A) -> init(Parent, Server) -> process_flag(trap_exit, true), - open_file_loop(#head{parent = Parent, server = Server}). - -open_file_loop(Head) -> %% The Dets server pretends the file is open before %% internal_open() has been called, which means that unless the %% internal_open message is applied first, other processes can %% find the pid by calling dets_server:get_pid() and do things %% before Head has been initialized properly. receive - ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) -> - do_apply_op(Op, From, Head, 0) + ?DETS_CALL(From, {internal_open, Ref, Args}=Op) -> + try do_internal_open(Parent, Server, From, Ref, Args) of + Head -> + open_file_loop(Head, 0) + catch + exit:normal -> + exit(normal); + _:Bad -> + bug_found(no_name, Op, Bad, From), + exit(Bad) % give up + end end. open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error -> @@ -1379,28 +1375,7 @@ do_apply_op(Op, From, Head, N) -> exit:normal -> exit(normal); _:Bad -> - Name = Head#head.name, - case dets_utils:debug_mode() of - true -> - %% If stream_op/5 found more requests, this is not - %% the last operation. - error_logger:format - ("** dets: Bug was found when accessing table ~w,~n" - "** dets: operation was ~p and reply was ~w.~n" - "** dets: Stacktrace: ~w~n", - [Name, Op, Bad, erlang:get_stacktrace()]); - false -> - error_logger:format - ("** dets: Bug was found when accessing table ~w~n", - [Name]) - end, - if - From =/= self() -> - From ! {self(), {error, {dets_bug, Name, Op, Bad}}}, - ok; - true -> % auto_save | may_grow | {delayed_write, _} - ok - end, + bug_found(Head#head.name, Op, Bad, From), open_file_loop(Head, N) end. @@ -1408,10 +1383,7 @@ apply_op(Op, From, Head, N) -> case Op of {add_user, Tab, OpenArgs}-> #open_args{file = Fname, type = Type, keypos = Keypos, - ram_file = Ram, access = Access, - version = Version} = OpenArgs, - VersionOK = (Version =:= default) or - (Head#head.version =:= Version), + ram_file = Ram, access = Access} = OpenArgs, %% min_no_slots and max_no_slots are not tested Res = if Tab =:= Head#head.name, @@ -1419,7 +1391,6 @@ apply_op(Op, From, Head, N) -> Head#head.type =:= Type, Head#head.ram_file =:= Ram, Head#head.access =:= Access, - VersionOK, Fname =:= Head#head.filename -> ok; true -> @@ -1475,21 +1446,14 @@ apply_op(Op, From, Head, N) -> From ! {self(), Res}, ok; {internal_open, Ref, Args} -> - ?PROFILE(ep:do()), - case do_open_file(Args, Head#head.parent, Head#head.server,Ref) of - {ok, H2} -> - From ! {self(), ok}, - H2; - Error -> - From ! {self(), Error}, - exit(normal) - end; + do_internal_open(Head#head.parent, Head#head.server, From, + Ref, Args); may_grow when Head#head.update_mode =/= saved -> if Head#head.update_mode =:= dirty -> %% Won't grow more if the table is full. {H2, _Res} = - (Head#head.mod):may_grow(Head, 0, many_times), + dets_v9:may_grow(Head, 0, many_times), {N + 1, H2}; true -> ok @@ -1519,21 +1483,10 @@ apply_op(Op, From, Head, N) -> From ! {self(), Res}, erlang:garbage_collect(), {0, H2}; - {delete_key, Keys} when Head#head.update_mode =:= dirty -> - if - Head#head.version =:= 8 -> - {H2, Res} = fdelete_key(Head, Keys), - From ! {self(), Res}, - {N + 1, H2}; - true -> - stream_op(Op, From, [], Head, N) - end; + {delete_key, _Keys} when Head#head.update_mode =:= dirty -> + stream_op(Op, From, [], Head, N); {delete_object, Objs} when Head#head.update_mode =:= dirty -> case check_objects(Objs, Head#head.keypos) of - true when Head#head.version =:= 8 -> - {H2, Res} = fdelete_object(Head, Objs), - From ! {self(), Res}, - {N + 1, H2}; true -> stream_op(Op, From, [], Head, N); false -> @@ -1551,10 +1504,6 @@ apply_op(Op, From, Head, N) -> H2; {insert, Objs} when Head#head.update_mode =:= dirty -> case check_objects(Objs, Head#head.keypos) of - true when Head#head.version =:= 8 -> - {H2, Res} = finsert(Head, Objs), - From ! {self(), Res}, - {N + 1, H2}; true -> stream_op(Op, From, [], Head, N); false -> @@ -1565,10 +1514,6 @@ apply_op(Op, From, Head, N) -> {H2, Res} = finsert_new(Head, Objs), From ! {self(), Res}, {N + 1, H2}; - {lookup_keys, Keys} when Head#head.version =:= 8 -> - {H2, Res} = flookup_keys(Head, Keys), - From ! {self(), Res}, - H2; {lookup_keys, _Keys} -> stream_op(Op, From, [], Head, N); {match_init, State, Safe} -> @@ -1584,10 +1529,6 @@ apply_op(Op, From, Head, N) -> {H2, Res} = fmatch(Head, MP, Spec, NObjs, Safe, From), From ! {self(), Res}, H2; - {member, Key} when Head#head.version =:= 8 -> - {H2, Res} = fmember(Head, Key), - From ! {self(), Res}, - H2; {member, _Key} = Op -> stream_op(Op, From, [], Head, N); {next, Key} -> @@ -1628,7 +1569,7 @@ apply_op(Op, From, Head, N) -> apply_op(WriteOp, From, H2, 0); WriteOp when Head#head.access =:= read_write, Head#head.update_mode =:= saved -> - case catch (Head#head.mod):mark_dirty(Head) of + case catch dets_v9:mark_dirty(Head) of ok -> start_auto_save_timer(Head), H2 = Head#head{update_mode = dirty}, @@ -1643,6 +1584,40 @@ apply_op(Op, From, Head, N) -> ok end. +bug_found(Name, Op, Bad, From) -> + case dets_utils:debug_mode() of + true -> + %% If stream_op/5 found more requests, this is not + %% the last operation. + error_logger:format + ("** dets: Bug was found when accessing table ~w,~n" + "** dets: operation was ~p and reply was ~w.~n" + "** dets: Stacktrace: ~w~n", + [Name, Op, Bad, erlang:get_stacktrace()]); + false -> + error_logger:format + ("** dets: Bug was found when accessing table ~w~n", + [Name]) + end, + if + From =/= self() -> + From ! {self(), {error, {dets_bug, Name, Op, Bad}}}, + ok; + true -> % auto_save | may_grow | {delayed_write, _} + ok + end. + +do_internal_open(Parent, Server, From, Ref, Args) -> + ?PROFILE(ep:do()), + case do_open_file(Args, Parent, Server, Ref) of + {ok, Head} -> + From ! {self(), ok}, + Head; + Error -> + From ! {self(), Error}, + exit(normal) + end. + start_auto_save_timer(Head) when Head#head.auto_save =:= infinity -> ok; start_auto_save_timer(Head) -> @@ -1650,7 +1625,7 @@ start_auto_save_timer(Head) -> _Ref = erlang:send_after(Millis, self(), ?DETS_CALL(self(), auto_save)), ok. -%% Version 9: Peek the message queue and try to evaluate several +%% Peek the message queue and try to evaluate several %% lookup requests in parallel. Evalute delete_object, delete and %% insert as well. stream_op(Op, Pid, Pids, Head, N) -> @@ -1760,7 +1735,7 @@ lookup_reply(P, O) -> %% Callback functions for system messages handling. %%----------------------------------------------------------------- system_continue(_Parent, _, Head) -> - open_file_loop(Head). + open_file_loop(Head, 0). system_terminate(Reason, _Parent, _, Head) -> _NewHead = do_stop(Head), @@ -1793,7 +1768,8 @@ read_file_header(FileName, Access, RamFile) -> dets_utils:pread_close(Fd, FileName, ?FILE_FORMAT_VERSION_POS, 4), if Version =< 8 -> - dets_v8:read_file_header(Fd, FileName); + _ = file:close(Fd), + throw({error, {format_8_no_longer_supported, FileName}}); Version =:= 9 -> dets_v9:read_file_header(Fd, FileName); true -> @@ -1820,7 +1796,7 @@ perform_save(Head, DoSync) when Head#head.update_mode =:= dirty; Head#head.update_mode =:= new_dirty -> case catch begin {Head1, []} = write_cache(Head), - {Head2, ok} = (Head1#head.mod):do_perform_save(Head1), + {Head2, ok} = dets_v9:do_perform_save(Head1), ok = ensure_written(Head2, DoSync), {Head2#head{update_mode = saved}, ok} end of @@ -1853,7 +1829,7 @@ ensure_written(Head, false) when not Head#head.ram_file -> do_bchunk_init(Head, Tab) -> case catch write_cache(Head) of {H2, []} -> - case (H2#head.mod):table_parameters(H2) of + case dets_v9:table_parameters(H2) of undefined -> {H2, {error, old_version}}; Parms -> @@ -1862,9 +1838,9 @@ do_bchunk_init(Head, Tab) -> L =:= <<>> -> eof; true -> <<>> end, - C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L}, BinParms = term_to_binary(Parms), - {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk}, + {H2, {#dets_cont{no_objs = default, bin = Bin, alloc = L, + tab = Tab, proc = self(),what = bchunk}, [BinParms]}} end; {NewHead, _} = HeadError when is_record(NewHead, head) -> @@ -1904,16 +1880,8 @@ do_delete_all_objects(Head) -> max_no_slots = MaxSlots, cache = Cache} = Head, CacheSz = dets_utils:cache_size(Cache), ok = dets_utils:truncate(Fd, Fname, bof), - (Head#head.mod):initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, - Ram, CacheSz, Auto, true). - -%% -> {NewHead, Reply}, Reply = ok | Error. -fdelete_key(Head, Keys) -> - do_delete(Head, Keys, delete_key). - -%% -> {NewHead, Reply}, Reply = ok | badarg | Error. -fdelete_object(Head, Objects) -> - do_delete(Head, Objects, delete_object). + dets_v9:initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, + Ram, CacheSz, Auto, true). ffirst(H) -> Ref = make_ref(), @@ -1930,7 +1898,7 @@ ffirst1(H) -> ffirst(NH, 0). ffirst(H, Slot) -> - case (H#head.mod):slot_objs(H, Slot) of + case dets_v9:slot_objs(H, Slot) of '$end_of_table' -> {H, '$end_of_table'}; [] -> ffirst(H, Slot+1); [X|_] -> {H, element(H#head.keypos, X)} @@ -2067,7 +2035,7 @@ finfo(H, auto_save) -> {H, H#head.auto_save}; finfo(H, bchunk_format) -> case catch write_cache(H) of {H2, []} -> - case (H2#head.mod):table_parameters(H2) of + case dets_v9:table_parameters(H2) of undefined = Undef -> {H2, Undef}; Parms -> @@ -2100,7 +2068,7 @@ finfo(H, no_keys) -> {H2, _} = HeadError when is_record(H2, head) -> HeadError end; -finfo(H, no_slots) -> {H, (H#head.mod):no_slots(H)}; +finfo(H, no_slots) -> {H, dets_v9:no_slots(H)}; finfo(H, pid) -> {H, self()}; finfo(H, ram_file) -> {H, H#head.ram_file}; finfo(H, safe_fixed) -> @@ -2127,7 +2095,7 @@ finfo(H, size) -> HeadError end; finfo(H, type) -> {H, H#head.type}; -finfo(H, version) -> {H, H#head.version}; +finfo(H, version) -> {H, 9}; finfo(H, _) -> {H, undefined}. file_size(Fd, FileName) -> @@ -2136,8 +2104,6 @@ file_size(Fd, FileName) -> test_bchunk_format(_Head, undefined) -> false; -test_bchunk_format(Head, _Term) when Head#head.version =:= 8 -> - false; test_bchunk_format(Head, Term) -> dets_v9:try_bchunk_header(Term, Head) =/= not_ok. @@ -2206,7 +2172,7 @@ do_finit(Head, Init, Format, NoSlots) -> #head{fptr = Fd, type = Type, keypos = Kp, auto_save = Auto, cache = Cache, filename = Fname, ram_file = Ram, min_no_slots = MinSlots0, max_no_slots = MaxSlots, - name = Tab, update_mode = UpdateMode, mod = HMod} = Head, + name = Tab, update_mode = UpdateMode} = Head, CacheSz = dets_utils:cache_size(Cache), {How, Head1} = case Format of @@ -2219,9 +2185,10 @@ do_finit(Head, Init, Format, NoSlots) -> {general_init, Head}; true -> ok = dets_utils:truncate(Fd, Fname, bof), - {ok, H} = HMod:initiate_file(Fd, Tab, Fname, Type, Kp, - MinSlots, MaxSlots, Ram, - CacheSz, Auto, false), + {ok, H} = + dets_v9:initiate_file(Fd, Tab, Fname, Type, Kp, + MinSlots, MaxSlots, Ram, + CacheSz, Auto, false), {general_init, H} end; bchunk -> @@ -2230,7 +2197,7 @@ do_finit(Head, Init, Format, NoSlots) -> end, case How of bchunk_init -> - case HMod:bchunk_init(Head1, Init) of + case dets_v9:bchunk_init(Head1, Init) of {ok, NewHead} -> {ok, NewHead#head{update_mode = dirty}}; Error -> @@ -2238,10 +2205,10 @@ do_finit(Head, Init, Format, NoSlots) -> end; general_init -> Cntrs = ets:new(dets_init, []), - Input = HMod:bulk_input(Head1, Init, Cntrs), + Input = dets_v9:bulk_input(Head1, Init, Cntrs), SlotNumbers = {Head1#head.min_no_slots, bulk_init, MaxSlots}, {Reply, SizeData} = - do_sort(Head1, SlotNumbers, Input, Cntrs, Fname, not_used), + do_sort(Head1, SlotNumbers, Input, Cntrs, Fname), Bulk = true, case Reply of {ok, NoDups, H1} -> @@ -2297,7 +2264,8 @@ fmatch(Head, MP, Spec, N, Safe, From) -> {NewHead, Reply} = flookup_keys(Head, Keys), case Reply of Objs when is_list(Objs) -> - MatchingObjs = ets:match_spec_run(Objs, MP), + {match_spec, MS} = MP, + MatchingObjs = ets:match_spec_run(Objs, MS), {NewHead, {done, MatchingObjs}}; Error -> {NewHead, Error} @@ -2377,7 +2345,7 @@ fmatch_delete(Head, C) -> {[], _} -> {Head, {done, 0}}; {RTs, NC} -> - MP = C#dets_cont.match_program, + {match_spec, MP} = C#dets_cont.match_program, case catch filter_binary_terms(RTs, MP, []) of {'EXIT', _} -> Bad = dets_utils:bad_object(fmatch_delete, RTs), @@ -2405,7 +2373,7 @@ do_fmatch_delete_var_keys(Head, MP, _Spec, From) -> C0 = init_scan(NewHead, default), {NewHead, {cont, C0#dets_cont{match_program = MP}, 0}}. -do_fmatch_constant_keys(Head, Keys, MP) -> +do_fmatch_constant_keys(Head, Keys, {match_spec, MP}) -> case flookup_keys(Head, Keys) of {NewHead, ReadTerms} when is_list(ReadTerms) -> Terms = filter_terms(ReadTerms, MP, []), @@ -2454,18 +2422,8 @@ do_delete(Head, Things, What) -> HeadError end. -fmember(Head, Key) -> - case catch begin - {Head2, [{_NoPid,Objs}]} = - update_cache(Head, [Key], {lookup, nopid}), - {Head2, Objs =/= []} - end of - {NewHead, _} = Reply when is_record(NewHead, head) -> - Reply - end. - fnext(Head, Key) -> - Slot = (Head#head.mod):db_hash(Key, Head), + Slot = dets_v9:db_hash(Key, Head), Ref = make_ref(), case catch {Ref, fnext(Head, Key, Slot)} of {Ref, {H, R}} -> @@ -2476,7 +2434,7 @@ fnext(Head, Key) -> fnext(H, Key, Slot) -> {NH, []} = write_cache(H), - case (H#head.mod):slot_objs(NH, Slot) of + case dets_v9:slot_objs(NH, Slot) of '$end_of_table' -> {NH, '$end_of_table'}; L -> fnext_search(NH, Key, Slot, L) end. @@ -2490,7 +2448,7 @@ fnext_search(H, K, Slot, L) -> %% We've got to continue to search for the next key in the next slot fnext_slot(H, K, Slot) -> - case (H#head.mod):slot_objs(H, Slot) of + case dets_v9:slot_objs(H, Slot) of '$end_of_table' -> {H, '$end_of_table'}; [] -> fnext_slot(H, K, Slot+1); L -> {H, element(H#head.keypos, hd(L))} @@ -2518,11 +2476,10 @@ fopen2(Fname, Tab) -> Acc = read_write, Ram = false, {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), - Mod = FH#fileheader.mod, - Do = case Mod:check_file_header(FH, Fd) of - {ok, Head1, ExtraInfo} -> + Do = case dets_v9:check_file_header(FH, Fd) of + {ok, Head1} -> Head2 = Head1#head{filename = Fname}, - try {ok, Mod:init_freelist(Head2, ExtraInfo)} + try {ok, dets_v9:init_freelist(Head2)} catch throw:_ -> {repair, " has bad free lists, repairing ..."} @@ -2536,8 +2493,7 @@ fopen2(Fname, Tab) -> case Do of {repair, Mess} -> io:format(user, "dets: file ~tp~s~n", [Fname, Mess]), - Version = default, - case fsck(Fd, Tab, Fname, FH, default, default, Version) of + case fsck(Fd, Tab, Fname, FH, default, default) of ok -> fopen2(Fname, Tab); Error -> @@ -2570,33 +2526,23 @@ fopen_existing_file(Tab, OpenArgs) -> #open_args{file = Fname, type = Type, keypos = Kp, repair = Rep, min_no_slots = MinSlots, max_no_slots = MaxSlots, ram_file = Ram, delayed_write = CacheSz, auto_save = - Auto, access = Acc, version = Version, debug = Debug} = + Auto, access = Acc, debug = Debug} = OpenArgs, {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), - V9 = (Version =:= 9) or (Version =:= default), MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots), MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots), - Mod = (FH#fileheader.mod), - Wh = case Mod:check_file_header(FH, Fd) of - {ok, Head, true} when Rep =:= force, Acc =:= read_write, - FH#fileheader.version =:= 9, - FH#fileheader.no_colls =/= undefined, - MinF, MaxF, V9 -> - {compact, Head, true}; - {ok, _Head, _Extra} when Rep =:= force, Acc =:= read -> + Wh = case dets_v9:check_file_header(FH, Fd) of + {ok, Head} when Rep =:= force, Acc =:= read_write, + FH#fileheader.no_colls =/= undefined, + MinF, MaxF -> + {compact, Head}; + {ok, _Head} when Rep =:= force, Acc =:= read -> throw({error, {access_mode, Fname}}); - {ok, Head, need_compacting} when Acc =:= read -> - {final, Head, true}; % Version 8 only. - {ok, _Head, need_compacting} when Rep =:= true -> - %% The file needs to be compacted due to a very big - %% and fragmented free_list. Version 8 only. - M = " is now compacted ...", - {repair, M}; - {ok, _Head, _Extra} when Rep =:= force -> + {ok, _Head} when Rep =:= force -> M = ", repair forced.", {repair, M}; - {ok, Head, ExtraInfo} -> - {final, Head, ExtraInfo}; + {ok, Head} -> + {final, Head}; {error, not_closed} when Rep =:= force, Acc =:= read_write -> M = ", repair forced.", {repair, M}; @@ -2605,17 +2551,13 @@ fopen_existing_file(Tab, OpenArgs) -> {repair, M}; {error, not_closed} when Rep =:= false -> throw({error, {needs_repair, Fname}}); - {error, version_bump} when Rep =:= true, Acc =:= read_write -> - %% Version 8 only - M = " old version, upgrading ...", - {repair, M}; {error, Reason} -> throw({error, {Reason, Fname}}) end, Do = case Wh of - {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact -> + {Tag, Hd} when Tag =:= final; Tag =:= compact -> Hd1 = Hd#head{filename = Fname}, - try {Tag, Mod:init_freelist(Hd1, Extra)} + try {Tag, dets_v9:init_freelist(Hd1)} catch throw:_ -> {repair, " has bad free lists, repairing ..."} @@ -2643,23 +2585,20 @@ fopen_existing_file(Tab, OpenArgs) -> "now repairing ...~n", [Fname]), {ok, Fd2, _FH} = read_file_header(Fname, Acc, Ram), do_repair(Fd2, Tab, Fname, FH, MinSlots, MaxSlots, - Version, OpenArgs) + OpenArgs) end; {repair, Mess} -> io:format(user, "dets: file ~tp~s~n", [Fname, Mess]), do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, - Version, OpenArgs); - _ when FH#fileheader.version =/= Version, Version =/= default -> - throw({error, {version_mismatch, Fname}}); + OpenArgs); {final, H} -> H1 = H#head{auto_save = Auto}, open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug) end. -do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> - case fsck(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version) of +do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, OpenArgs) -> + case fsck(Fd, Tab, Fname, FH, MinSlots, MaxSlots) of ok -> - %% No need to update 'version'. erlang:garbage_collect(), fopen3(Tab, OpenArgs#open_args{repair = false}); Error -> @@ -2673,8 +2612,8 @@ open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) -> filename = Fname, name = Tab, cache = dets_utils:new_cache(CacheSz)}, - init_disk_map(Head1#head.version, Tab, Debug), - (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next), + init_disk_map(Tab, Debug), + dets_v9:cache_segps(Head1#head.fptr, Fname, Head1#head.next), check_growth(Head1), {ok, Head1}. @@ -2683,7 +2622,7 @@ fopen_init_file(Tab, OpenArgs) -> #open_args{file = Fname, type = Type, keypos = Kp, min_no_slots = MinSlotsArg, max_no_slots = MaxSlotsArg, ram_file = Ram, delayed_write = CacheSz, auto_save = Auto, - version = UseVersion, debug = Debug} = OpenArgs, + debug = Debug} = OpenArgs, MinSlots = choose_no_slots(MinSlotsArg, ?DEFAULT_MIN_NO_SLOTS), MaxSlots = choose_no_slots(MaxSlotsArg, ?DEFAULT_MAX_NO_SLOTS), FileSpec = if @@ -2691,20 +2630,11 @@ fopen_init_file(Tab, OpenArgs) -> true -> Fname end, {ok, Fd} = dets_utils:open(FileSpec, open_args(read_write, Ram)), - Version = if - UseVersion =:= default -> - case os:getenv("DETS_USE_FILE_FORMAT") of - "8" -> 8; - _ -> 9 - end; - true -> - UseVersion - end, - Mod = version2module(Version), %% No need to truncate an empty file. - init_disk_map(Version, Tab, Debug), - case catch Mod:initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, - Ram, CacheSz, Auto, true) of + init_disk_map(Tab, Debug), + case catch dets_v9:initiate_file(Fd, Tab, Fname, Type, Kp, + MinSlots, MaxSlots, + Ram, CacheSz, Auto, true) of {error, Reason} when Ram -> _ = file:close(Fd), throw({error, Reason}); @@ -2719,15 +2649,13 @@ fopen_init_file(Tab, OpenArgs) -> end. %% Debug. -init_disk_map(9, Name, Debug) -> +init_disk_map(Name, Debug) -> case Debug orelse dets_utils:debug_mode() of true -> dets_utils:init_disk_map(Name); false -> ok - end; -init_disk_map(_Version, _Name, _Debug) -> - ok. + end. open_args(Access, RamFile) -> A1 = case Access of @@ -2740,15 +2668,7 @@ open_args(Access, RamFile) -> end, A1 ++ A2 ++ [binary, read]. -version2module(V) when V =< 8 -> dets_v8; -version2module(9) -> dets_v9. - -module2version(dets_v8) -> 8; -module2version(dets_v9) -> 9; -module2version(not_used) -> 9. - %% -> ok | throw(Error) -%% For version 9 tables only. compact(SourceHead) -> #head{name = Tab, filename = Fname, fptr = SFd, type = Type, keypos = Kp, ram_file = Ram, auto_save = Auto} = SourceHead, @@ -2759,7 +2679,7 @@ compact(SourceHead) -> %% It is normally not possible to have two open tables in the same %% process since the process dictionary is used for caching %% segment pointers, but here is works anyway--when reading a file - %% serially the pointers to not need to be used. + %% serially the pointers do not need to be used. Head = case catch dets_v9:prep_table_copy(Fd, Tab, Tmp, Type, Kp, Ram, CacheSz, Auto, TblParms) of {ok, H} -> @@ -2794,7 +2714,7 @@ compact(SourceHead) -> %% -> ok | Error %% Closes Fd. -fsck(Fd, Tab, Fname, FH, MinSlotsArg, MaxSlotsArg, Version) -> +fsck(Fd, Tab, Fname, FH, MinSlotsArg, MaxSlotsArg) -> %% MinSlots and MaxSlots are the option values. #fileheader{min_no_slots = MinSlotsFile, max_no_slots = MaxSlotsFile} = FH, @@ -2807,10 +2727,10 @@ fsck(Fd, Tab, Fname, FH, MinSlotsArg, MaxSlotsArg, Version) -> %% If the number of objects (keys) turns out to be significantly %% different from NoSlots, we try again with the correct number of %% objects (keys). - case fsck_try(Fd, Tab, FH, Fname, SlotNumbers, Version) of + case fsck_try(Fd, Tab, FH, Fname, SlotNumbers) of {try_again, BetterNoSlots} -> BetterSlotNumbers = {MinSlots, BetterNoSlots, MaxSlots}, - case fsck_try(Fd, Tab, FH, Fname, BetterSlotNumbers, Version) of + case fsck_try(Fd, Tab, FH, Fname, BetterSlotNumbers) of {try_again, _} -> _ = file:close(Fd), {error, {cannot_repair, Fname}}; @@ -2829,7 +2749,7 @@ choose_no_slots(NoSlots, _) -> NoSlots. %% Initiating a table using a fun and repairing (or converting) a %% file are completely different things, but nevertheless the same %% method is used in both cases... -fsck_try(Fd, Tab, FH, Fname, SlotNumbers, Version) -> +fsck_try(Fd, Tab, FH, Fname, SlotNumbers) -> Tmp = tempfile(Fname), #fileheader{type = Type, keypos = KeyPos} = FH, {_MinSlots, EstNoSlots, MaxSlots} = SlotNumbers, @@ -2838,7 +2758,7 @@ fsck_try(Fd, Tab, FH, Fname, SlotNumbers, Version) -> max_no_slots = MaxSlots, ram_file = false, delayed_write = ?DEFAULT_CACHE, auto_save = infinity, access = read_write, - version = Version, debug = false}, + debug = false}, case catch fopen3(Tab, OpenArgs) of {ok, Head} -> case fsck_try_est(Head, Fd, Fname, SlotNumbers, FH) of @@ -2888,10 +2808,9 @@ assure_no_file(File) -> %% -> {ok, NewHead} | {try_again, integer()} | Error fsck_try_est(Head, Fd, Fname, SlotNumbers, FH) -> %% Mod is the module to use for reading input when repairing. - Mod = FH#fileheader.mod, Cntrs = ets:new(dets_repair, []), - Input = Mod:fsck_input(Head, Fd, Cntrs, FH), - {Reply, SizeData} = do_sort(Head, SlotNumbers, Input, Cntrs, Fname, Mod), + Input = dets_v9:fsck_input(Head, Fd, Cntrs, FH), + {Reply, SizeData} = do_sort(Head, SlotNumbers, Input, Cntrs, Fname), Bulk = false, case Reply of {ok, NoDups, H1} -> @@ -2906,14 +2825,13 @@ fsck_try_est(Head, Fd, Fname, SlotNumbers, FH) -> Else end. -do_sort(Head, SlotNumbers, Input, Cntrs, Fname, Mod) -> - OldV = module2version(Mod), +do_sort(Head, SlotNumbers, Input, Cntrs, Fname) -> %% output_objs/4 replaces {LogSize,NoObjects} in Cntrs by %% {LogSize,Position,Data,NoObjects | NoCollections}. %% Data = {FileName,FileDescriptor} | [object()] - %% For small tables Data may be a list of objects which is more + %% For small tables Data can be a list of objects which is more %% efficient since no temporary files are created. - Output = (Head#head.mod):output_objs(OldV, Head, SlotNumbers, Cntrs), + Output = dets_v9:output_objs(Head, SlotNumbers, Cntrs), TmpDir = filename:dirname(Fname), Reply = (catch file_sorter:sort(Input, Output, [{format, binary},{tmpdir, TmpDir}])), @@ -2954,13 +2872,6 @@ fsck_copy1([SzData | L], Head, Bulk, NoDups) -> {ok, Copied} when Copied =:= ExpectedSize; NoObjects =:= 0 -> % the segments fsck_copy1(L, Head, Bulk, NoDups); - {ok, Copied} when Bulk, Head#head.version =:= 8 -> - NoZeros = ExpectedSize - Copied, - Dups = NoZeros div Size, - Addr = Pos+Copied, - NewHead = free_n_objects(Head, Addr, Size-1, NoDups), - NewNoDups = NoDups - Dups, - fsck_copy1(L, NewHead, Bulk, NewNoDups); {ok, _Copied} -> % should never happen close_files(Bulk, L, Head), Reason = if Bulk -> initialization_failed; @@ -2975,13 +2886,6 @@ fsck_copy1([], Head, _Bulk, NoDups) when NoDups =/= 0 -> fsck_copy1([], Head, _Bulk, _NoDups) -> {ok, Head#head{update_mode = dirty}}. -free_n_objects(Head, _Addr, _Size, 0) -> - Head; -free_n_objects(Head, Addr, Size, N) -> - {NewHead, _} = dets_utils:free(Head, Addr, Size), - NewAddr = Addr + Size + 1, - free_n_objects(NewHead, NewAddr, Size, N-1). - close_files(false, SizeData, Head) -> _ = file:close(Head#head.fptr), close_files(true, SizeData, Head); @@ -3000,7 +2904,7 @@ close_tmp(Fd) -> fslot(H, Slot) -> case catch begin {NH, []} = write_cache(H), - Objs = (NH#head.mod):slot_objs(NH, Slot), + Objs = dets_v9:slot_objs(NH, Slot), {NH, Objs} end of {NewHead, _Objects} = Reply when is_record(NewHead, head) -> @@ -3050,7 +2954,7 @@ where_is_object(Head, Object) -> true -> case catch write_cache(Head) of {NewHead, []} -> - {NewHead, (Head#head.mod):find_object(NewHead, Object)}; + {NewHead, dets_v9:find_object(NewHead, Object)}; {NewHead, _} = HeadError when is_record(NewHead, head) -> HeadError end; @@ -3063,13 +2967,9 @@ check_objects([T | Ts], Kp) when tuple_size(T) >= Kp -> check_objects(L, _Kp) -> L =:= []. -no_things(Head) when Head#head.no_keys =:= undefined -> - Head#head.no_objects; no_things(Head) -> Head#head.no_keys. -file_no_things(FH) when FH#fileheader.no_keys =:= undefined -> - FH#fileheader.no_objects; file_no_things(FH) -> FH#fileheader.no_keys. @@ -3110,7 +3010,7 @@ update_cache(Head, ToAdd) -> if Lookup; NewSize >= Cache#cache.tsize -> %% The cache is considered full, or some lookup. - {NewHead, LU, PwriteList} = (Head#head.mod):write_cache(Head1), + {NewHead, LU, PwriteList} = dets_v9:write_cache(Head1), {NewHead, Found ++ LU, PwriteList}; NewC =:= [] -> {Head1, Found, []}; @@ -3195,7 +3095,7 @@ delayed_write(Head, WrTime) -> %% -> {NewHead, [LookedUpObject]} | throw({NewHead, Error}) write_cache(Head) -> - {Head1, LU, PwriteList} = (Head#head.mod):write_cache(Head), + {Head1, LU, PwriteList} = dets_v9:write_cache(Head), {NewHead, ok} = dets_utils:pwrite(Head1, PwriteList), {NewHead, LU}. @@ -3248,7 +3148,7 @@ scan(Head, C) -> % when is_record(C, dets_cont) scan(Bin, Head, From, To, L, [], R, {C, Head#head.type}). scan(Bin, H, From, To, L, Ts, R, {C0, Type} = C) -> - case (H#head.mod):scan_objs(H, Bin, From, To, L, Ts, R, Type) of + case dets_v9:scan_objs(H, Bin, From, To, L, Ts, R, Type) of {more, NFrom, NTo, NL, NTs, NR, Sz} -> scan_read(H, NFrom, NTo, Sz, NL, NTs, NR, C); {stop, <<>>=B, NFrom, NTo, <<>>=NL, NTs} -> @@ -3317,7 +3217,7 @@ file_info(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> _ = file:close(Fd), - (FH#fileheader.mod):file_info(FH); + dets_v9:file_info(FH); Other -> Other end. @@ -3332,15 +3232,13 @@ get_head_field(Fd, Field) -> view(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> - Mod = FH#fileheader.mod, - try Mod:check_file_header(FH, Fd) of - {ok, H0, ExtraInfo} -> - Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {ok, H0, ExtraInfo} -> - H = Mod:init_freelist(H0, ExtraInfo), + try dets_v9:check_file_header(FH, Fd) of + {ok, H0} -> + case dets_v9:check_file_header(FH, Fd) of + {ok, H0} -> + H = dets_v9:init_freelist(H0), v_free_list(H), - Mod:v_segments(H), + dets_v9:v_segments(H), ok; X -> X diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl index 6ebeb96156..b5e732b08f 100644 --- a/lib/stdlib/src/dets.hrl +++ b/lib/stdlib/src/dets.hrl @@ -21,7 +21,7 @@ -define(DEFAULT_MIN_NO_SLOTS, 256). -define(DEFAULT_MAX_NO_SLOTS, 32*1024*1024). -define(DEFAULT_AUTOSAVE, 3). % minutes --define(DEFAULT_CACHE, {3000, 14000}). % {delay,size} in {milliseconds,bytes} +-define(DEFAULT_CACHE, {3000, 14000}). % cache_parms() %% Type. -define(SET, 1). @@ -46,83 +46,111 @@ -define(DETS_CALL(Pid, Req), {'$dets_call', Pid, Req}). +-type access() :: 'read' | 'read_write'. +-type auto_save() :: 'infinity' | non_neg_integer(). +-type hash_bif() :: 'phash' | 'phash2'. +-type keypos() :: pos_integer(). +-type no_colls() :: [{LogSize :: non_neg_integer(), + NoCollections :: non_neg_integer()}]. +-type no_slots() :: 'default' | non_neg_integer(). +-type tab_name() :: term(). +-type type() :: 'bag' | 'duplicate_bag' | 'set'. +-type update_mode() :: 'dirty' + | 'new_dirty' + | 'saved' + | {'error', Reason :: term()}. + %% Record holding the file header and more. -record(head, { - m, % size - m2, % m * 2 - next, % next position for growth (segm mgmt only) - fptr, % the file descriptor - no_objects, % number of objects in table, - no_keys, % number of keys (version 9 only) - maxobjsize, % 2-log of the size of the biggest object - % collection (version 9 only) + m :: non_neg_integer(), % size + m2 :: non_neg_integer(), % m * 2 + next :: non_neg_integer(), % next position for growth + % (segm mgmt only) + fptr :: file:fd(), % the file descriptor + no_objects :: non_neg_integer() , % number of objects in table, + no_keys :: non_neg_integer(), % number of keys + maxobjsize :: 'undefined' | non_neg_integer(), % 2-log of + % the size of the biggest object collection n, % split indicator - type, % set | bag | duplicate_bag - keypos, % default is 1 as for ets - freelists, % tuple of free lists of buddies - % if fixed =/= false, then a pair of freelists - freelists_p, % cached FreelistsPointer - no_collections, % [{LogSize,NoCollections}] | undefined; number of - % object collections per size (version 9(b)) - auto_save, % Integer | infinity - update_mode, % saved | dirty | new_dirty | {error, Reason} - fixed = false, % false | {now_time(), [{pid(),Counter}]} - % time of first fix, and number of fixes per process - hash_bif, % hash bif used for this file (phash2, phash, hash) - has_md5, % whether the header has an MD5 sum (version 9(c)) - min_no_slots, % minimum number of slots (default or integer) - max_no_slots, % maximum number of slots (default or integer) - cache, % cache(). Write cache. - - filename, % name of the file being used - access = read_write, % read | read_write - ram_file = false, % true | false - name, % the name of the table - - parent, % The supervisor of Dets processes. - server, % The creator of Dets processes. - - %% Depending on the file format: - version, - mod, - bump, - base + type :: type(), + keypos :: keypos(), % default is 1 as for ets + freelists :: 'undefined' + | tuple(), % tuple of free lists of buddies + % if fixed =/= false, then a pair of freelists + freelists_p :: 'undefined' + | non_neg_integer(), % cached FreelistsPointer + no_collections :: 'undefined' + | no_colls(), % number of object collections + % per size (version 9(b)) + auto_save :: auto_save(), + update_mode :: update_mode(), + fixed = false :: 'false' + | {{integer(), integer()}, % time of first fix, + [{pid(), % and number of fixes per process + non_neg_integer()}]}, + hash_bif :: hash_bif(), % hash bif used for this file + has_md5 :: boolean(), % whether the header has + % an MD5 sum (version 9(c)) + min_no_slots :: no_slots(), % minimum number of slots + max_no_slots :: no_slots(), % maximum number of slots + cache :: 'undefined' | cache(), % Write cache. + + filename :: file:name(), % name of the file being used + access = read_write :: access(), + ram_file = false :: boolean(), + name :: tab_name(), % the name of the table + + parent :: 'undefined' | pid(), % The supervisor of Dets processes. + server :: 'undefined' | pid(), % The creator of Dets processes. + + bump :: non_neg_integer(), + base :: non_neg_integer() }). %% Info extracted from the file header. -record(fileheader, { - freelist, - fl_base, - cookie, - closed_properly, - type, - version, - m, - next, - keypos, - no_objects, - no_keys, - min_no_slots, - max_no_slots, - no_colls, - hash_method, - read_md5, - has_md5, - md5, - trailer, - eof, - n, - mod + freelist :: non_neg_integer(), + fl_base :: non_neg_integer(), + cookie :: non_neg_integer(), + closed_properly :: non_neg_integer(), + type :: 'badtype' | type(), + version :: non_neg_integer(), + m :: non_neg_integer(), + next :: non_neg_integer(), + keypos :: keypos(), + no_objects :: non_neg_integer(), + no_keys :: non_neg_integer(), + min_no_slots :: non_neg_integer(), + max_no_slots :: non_neg_integer(), + no_colls :: 'undefined' | no_colls(), + hash_method :: non_neg_integer(), + read_md5 :: binary(), + has_md5 :: boolean(), + md5 :: binary(), + trailer :: non_neg_integer(), + eof :: non_neg_integer(), + n }). +-type delay() :: non_neg_integer(). +-type threshold() :: non_neg_integer(). +-type cache_parms() :: + {Delay :: delay(), % max time items are kept in RAM only, + % in milliseconds + Size :: threshold()}. % threshold size of cache, in bytes + %% Write Cache. -record(cache, { - cache, % [{Key,{Seq,Item}}], write cache, last item first - csize, % current size of the cached items - inserts, % upper limit on number of inserted keys - wrtime, % last write or update time - tsize, % threshold size of cache, in bytes - delay % max time items are kept in RAM only, in milliseconds + cache :: % write cache, last item first + [{Key :: term(), + {Seq :: non_neg_integer(), Item :: term()}}], + csize :: non_neg_integer(), % current size of the cached items + inserts :: % upper limit on number of inserted keys + non_neg_integer(), + wrtime :: 'undefined' | integer(), % last write or update time + tsize :: threshold(), % threshold size of cache + delay :: delay() % max time items are kept in RAM only }). +-type cache() :: #cache{}. diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 34a8ddddaa..da6ebd18f2 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -20,13 +20,13 @@ -module(dets_utils). %% Utility functions common to several dets file formats. -%% To be used from dets, dets_v8 and dets_v9 only. +%% To be used from modules dets and dets_v9 only. -export([cmp/2, msort/1, mkeysort/2, mkeysearch/3, family/1]). -export([rename/2, pread/2, pread/4, ipread/3, pwrite/2, write/2, truncate/2, position/2, sync/1, open/2, truncate/3, fwrite/3, - write_file/2, position/3, position_close/3, pwrite/4, + write_file/2, position/3, position_close/3, pwrite/3, pread_close/4, read_n/2, pread_n/3, read_4/2]). -export([code_to_type/1, type_to_code/1]). @@ -44,8 +44,6 @@ all_allocated_as_list/1, find_allocated/4, find_next_allocated/3, log2/1, make_zeros/1]). --export([init_slots_from_old_file/2]). - -export([list_to_tree/1, tree_to_bin/5]). -compile({inline, [{sz2pos,1}, {adjust_addr,3}]}). @@ -308,12 +306,6 @@ position_close(Fd, FileName, Pos) -> OK -> OK end. -pwrite(Fd, FileName, Position, B) -> - case file:pwrite(Fd, Position, B) of - ok -> ok; - Error -> file_error(FileName, {error, Error}) - end. - pwrite(Fd, FileName, Bins) -> case file:pwrite(Fd, Bins) of ok -> @@ -478,20 +470,6 @@ new_cache({Delay, Size}) -> %%% Ullman. I think buddy systems were invented by Knuth, a long %%% time ago. -init_slots_from_old_file([{Slot,Addr} | T], Ftab) -> - init_slot(Slot+1,[{Slot,Addr} | T], Ftab); -init_slots_from_old_file([], Ftab) -> - Ftab. - -init_slot(_Slot,[], Ftab) -> - Ftab; % should never happen -init_slot(_Slot,[{_Addr,0}|T], Ftab) -> - init_slots_from_old_file(T, Ftab); -init_slot(Slot,[{_Slot1,Addr}|T], Ftab) -> - Stree = element(Slot, Ftab), - %% io:format("init_slot ~p:~p~n",[Slot, Addr]), - init_slot(Slot,T,setelement(Slot, Ftab, bplus_insert(Stree, Addr))). - %%% The free lists are kept in RAM, and written to the end of the file %%% from time to time. It is possible that a considerable amount of %%% memory is used for a fragmented file. diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl deleted file mode 100644 index 1bf53d91b1..0000000000 --- a/lib/stdlib/src/dets_v8.erl +++ /dev/null @@ -1,1594 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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% -%% --module(dets_v8). - -%% Dets files, implementation part. This module handles versions up to -%% and including 8(c). To be called from dets.erl only. - --export([mark_dirty/1, read_file_header/2, - check_file_header/2, do_perform_save/1, initiate_file/11, - init_freelist/2, fsck_input/4, - bulk_input/3, output_objs/4, write_cache/1, may_grow/3, - find_object/2, re_hash/2, slot_objs/2, scan_objs/8, - db_hash/2, no_slots/1, table_parameters/1]). - --export([file_info/1, v_segments/1]). - --export([cache_segps/3]). - -%% For backward compatibility. --export([sz2pos/1]). - --dialyzer(no_improper_lists). - --compile({inline, [{sz2pos,1},{scan_skip,7}]}). --compile({inline, [{skip_bytes,5}, {get_segp,1}]}). --compile({inline, [{wl_lookup,5}]}). --compile({inline, [{actual_seg_size,0}]}). - --include("dets.hrl"). - -%% The layout of the file is : -%% -%% bytes decsription -%% ---------------------- File header -%% 4 FreelistsPointer -%% 4 Cookie -%% 4 ClosedProperly (pos=8) -%% 4 Type (pos=12) -%% 4 Version (pos=16) -%% 4 M -%% 4 Next -%% 4 KeyPos -%% 4 NoObjects -%% 4 N -%% ------------------ end of file header -%% 4*8192 SegmentArray -%% ------------------ -%% 4*256 First segment -%% ----------------------------- This is BASE. -%% ??? Objects (free and alive) -%% 4*256 Second segment (2 kB now, due to a bug) -%% ??? Objects (free and alive) -%% ... more objects and segments ... -%% ----------------------------- -%% ??? Free lists -%% ----------------------------- -%% 4 File size, in bytes. - -%% The first slot (0) in the segment array always points to the -%% pre-allocated first segment. -%% Before we can find an object we must find the slot where the -%% object resides. Each slot is a (possibly empty) list (or chain) of -%% objects that hash to the same slot. If the value stored in the -%% slot is zero, the slot chain is empty. If the slot value is -%% non-zero, the value points to a position in the file where the -%% chain starts. Each object in a chain has the following layout: -%% -%% bytes decsription -%% -------------------- -%% 4 Pointer to the next object of the chain. -%% 4 Size of the object in bytes (Sz). -%% 4 Status (FREE or ACTIVE) -%% Sz Binary representing the object -%% -%% The status field is used while repairing a file (but not next or size). -%% -%%|---------------| -%%| head | -%%| | -%%| | -%%|_______________| -%%| |------| -%%|___seg ptr1____| | -%%| | | -%%|__ seg ptr 2___| | -%%| | | segment 1 -%%| .... | V _____________ -%% | | -%% | | -%% |___slot 0 ____| -%% | | -%% |___slot 1 ____|-----| -%% | | | -%% | ..... | | 1:st obj in slot 1 -%% V segment 1 -%% |-----------| -%% | next | -%% |___________| -%% | size | -%% |___________| -%% | status | -%% |___________| -%% | | -%% | | -%% | obj | -%% | | - -%%% -%%% File header -%%% - --define(HEADSZ, 40). % The size of the file header, in bytes. --define(SEGSZ, 256). % Size of a segment, in words. --define(SEGSZ_LOG2, 8). --define(SEGARRSZ, 8192). % Maximal number of segments. --define(SEGADDR(SegN), (?HEADSZ + (4 * (SegN)))). --define(BASE, ?SEGADDR((?SEGSZ + ?SEGARRSZ))). --define(MAXOBJS, (?SEGSZ * ?SEGARRSZ)). % 2 M objects - --define(SLOT2SEG(S), ((S) bsr ?SEGSZ_LOG2)). - -%% BIG is used for hashing. BIG must be greater than the maximum -%% number of slots, currently MAXOBJS. --define(BIG, 16#ffffff). - -%% Hard coded positions into the file header: --define(FREELIST_POS, 0). --define(CLOSED_PROPERLY_POS, 8). --define(D_POS, 20). --define(NO_OBJECTS_POS, (?D_POS + 12)). - -%% The version of a dets file is indicated by the ClosedProperly -%% field. Version 6 was used in the R1A release, and version 7 in the -%% R1B release up to and including the R3B01 release. Both version 6 -%% and version 7 indicate properly closed files by the value -%% CLOSED_PROPERLY. -%% -%% The current version, 8, has three sub-versions: -%% -%% - 8(a), indicated by the value CLOSED_PROPERLY (same as in versions 6 -%% and 7), introduced in R3B02; -%% - 8(b), indicated by the value CLOSED_PROPERLY2(_NEED_COMPACTING), -%% introduced in R5A and used up to and including R6A; -%% - 8(c), indicated by the value CLOSED_PROPERLY_NEW_HASH(_NEED_COMPACTING), -%% in use since R6B. -%% -%% The difference between the 8(a) and the 8(b) versions is the format -%% used for free lists saved on dets files. -%% The 8(c) version uses a different hashing algorithm, erlang:phash -%% (former versions use erlang:hash). -%% Version 8(b) files are only converted to version 8(c) if repair is -%% done, so we need compatibility with 8(b) for a _long_ time. -%% -%% There are known bugs due to the fact that keys and objects are -%% sometimes compared (==) and sometimes matched (=:=). The version -%% used by default (9, see dets_v9.erl) does not have this problem. - --define(NOT_PROPERLY_CLOSED,0). --define(CLOSED_PROPERLY,1). --define(CLOSED_PROPERLY2,2). --define(CLOSED_PROPERLY2_NEED_COMPACTING,3). --define(CLOSED_PROPERLY_NEW_HASH,4). --define(CLOSED_PROPERLY_NEW_HASH_NEED_COMPACTING,5). - --define(FILE_FORMAT_VERSION, 8). --define(CAN_BUMP_BY_REPAIR, [6, 7]). --define(CAN_CONVERT_FREELIST, [8]). - -%%% -%%% Object header (next, size, status). -%%% - --define(OHDSZ, 12). % The size of the object header, in bytes. --define(STATUS_POS, 8). % Position of the status field. - -%% The size of each object is a multiple of 16. -%% BUMP is used when repairing files. --define(BUMP, 16). - --define(ReadAhead, 512). - -%%-define(DEBUGF(X,Y), io:format(X, Y)). --define(DEBUGF(X,Y), void). - -%% -> ok | throw({NewHead,Error}) -mark_dirty(Head) -> - Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], - {_NewHead, ok} = dets_utils:pwrite(Head, Dirty), - ok = dets_utils:sync(Head), - {ok, _Pos} = dets_utils:position(Head, Head#head.freelists_p), - ok = dets_utils:truncate(Head, cur). - -%% -> {ok, head()} | throw(Error) -initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, - Ram, CacheSz, Auto, _DoInitSegments) -> - Freelist = 0, - Cookie = ?MAGIC, - ClosedProperly = ?NOT_PROPERLY_CLOSED, % immediately overwritten - Version = ?FILE_FORMAT_VERSION, - Factor = est_no_segments(MinSlots), - N = 0, - M = Next = ?SEGSZ * Factor, - NoObjects = 0, - dets_utils:pwrite(Fd, Fname, 0, - <<Freelist:32, - Cookie:32, - ClosedProperly:32, - (dets_utils:type_to_code(Type)):32, - Version:32, - M:32, - Next:32, - Kp:32, - NoObjects:32, - N:32, - 0:(?SEGARRSZ*4)/unit:8, % Initialize SegmentArray - 0:(?SEGSZ*4)/unit:8>>), % Initialize first segment - %% We must set the first slot of the segment pointer array to - %% point to the first segment - Pos = ?SEGADDR(0), - SegP = (?HEADSZ + (4 * ?SEGARRSZ)), - dets_utils:pwrite(Fd, Fname, Pos, <<SegP:32>>), - segp_cache(Pos, SegP), - - Ftab = dets_utils:init_alloc(?BASE), - H0 = #head{freelists=Ftab, fptr = Fd, base = ?BASE}, - {H1, Ws} = init_more_segments(H0, 1, Factor, undefined, []), - - %% This is not optimal but simple: always initiate the segments. - dets_utils:pwrite(Fd, Fname, Ws), - - %% Return a new nice head structure - Head = #head{ - m = M, - m2 = M * 2, - next = Next, - fptr = Fd, - no_objects = NoObjects, - n = N, - type = Type, - update_mode = dirty, - freelists = H1#head.freelists, - auto_save = Auto, - hash_bif = phash, - keypos = Kp, - min_no_slots = Factor * ?SEGSZ, - max_no_slots = no_segs(MaxSlots) * ?SEGSZ, - - ram_file = Ram, - filename = Fname, - name = Tab, - cache = dets_utils:new_cache(CacheSz), - version = Version, - bump = ?BUMP, - base = ?BASE, - mod = ?MODULE - }, - {ok, Head}. - -est_no_segments(MinSlots) when 1 + ?SLOT2SEG(MinSlots) > ?SEGARRSZ -> - ?SEGARRSZ; -est_no_segments(MinSlots) -> - 1 + ?SLOT2SEG(MinSlots). - -init_more_segments(Head, SegNo, Factor, undefined, Ws) when SegNo < Factor -> - init_more_segments(Head, SegNo, Factor, seg_zero(), Ws); -init_more_segments(Head, SegNo, Factor, SegZero, Ws) when SegNo < Factor -> - {NewHead, W} = allocate_segment(Head, SegZero, SegNo), - init_more_segments(NewHead, SegNo+1, Factor, SegZero, W++Ws); -init_more_segments(Head, _SegNo, _Factor, _SegZero, Ws) -> - {Head, Ws}. - -allocate_segment(Head, SegZero, SegNo) -> - %% may throw error: - {NewHead, Segment, _} = dets_utils:alloc(Head, 4 * ?SEGSZ), - InitSegment = {Segment, SegZero}, - Pos = ?SEGADDR(SegNo), - segp_cache(Pos, Segment), - SegPointer = {Pos, <<Segment:32>>}, - {NewHead, [InitSegment, SegPointer]}. - -%% Read free lists (using a Buddy System) from file. -init_freelist(Head, {convert_freelist,_Version}) -> - %% This function converts the saved freelist of the form - %% [{Slot1,Addr1},{Addr1,Addr2},...,{AddrN,0},{Slot2,Addr},...] - %% i.e each slot is a linked list which ends with a 0. - %% This is stored in a bplus_tree per Slot. - %% Each Slot is a position in a tuple. - - Ftab = dets_utils:empty_free_lists(), - Pos = Head#head.freelists_p, - case catch prterm(Head, Pos, ?OHDSZ) of - {0, _Sz, Term} -> - FreeList1 = lists:reverse(Term), - FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab), - Head#head{freelists = FreeList, base = ?BASE}; - _ -> - throw({error, {bad_freelists, Head#head.filename}}) - end; -init_freelist(Head, _) -> - %% bplus_tree stored as is - Pos = Head#head.freelists_p, - case catch prterm(Head, Pos, ?OHDSZ) of - {0, _Sz, Term} -> - Head#head{freelists = Term, base = ?BASE}; - _ -> - throw({error, {bad_freelists, Head#head.filename}}) - end. - -%% -> {ok, Fd, fileheader()} | throw(Error) -read_file_header(Fd, FileName) -> - {ok, Bin} = dets_utils:pread_close(Fd, FileName, 0, ?HEADSZ), - [Freelist, Cookie, CP, Type2, Version, M, Next, Kp, NoObjects, N] = - bin2ints(Bin), - {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), - {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), - FH = #fileheader{freelist = Freelist, - fl_base = ?BASE, - cookie = Cookie, - closed_properly = CP, - type = dets_utils:code_to_type(Type2), - version = Version, - m = M, - next = Next, - keypos = Kp, - no_objects = NoObjects, - min_no_slots = ?DEFAULT_MIN_NO_SLOTS, - max_no_slots = ?DEFAULT_MAX_NO_SLOTS, - trailer = FileSize, - eof = EOF, - n = N, - mod = ?MODULE}, - {ok, Fd, FH}. - -%% -> {ok, head(), ExtraInfo} | {error, Reason} (Reason lacking file name) -%% ExtraInfo = {convert_freelist, Version} | true | need_compacting -check_file_header(FH, Fd) -> - Test = - if - FH#fileheader.cookie =/= ?MAGIC -> - {error, not_a_dets_file}; - FH#fileheader.type =:= badtype -> - {error, invalid_type_code}; - FH#fileheader.version =/= ?FILE_FORMAT_VERSION -> - case lists:member(FH#fileheader.version, - ?CAN_BUMP_BY_REPAIR) of - true -> - {error, version_bump}; - false -> - {error, bad_version} - end; - FH#fileheader.trailer =/= FH#fileheader.eof -> - {error, not_closed}; - FH#fileheader.closed_properly =:= ?CLOSED_PROPERLY -> - case lists:member(FH#fileheader.version, - ?CAN_CONVERT_FREELIST) of - true -> - {ok, {convert_freelist, FH#fileheader.version}, hash}; - false -> - {error, not_closed} % should not happen - end; - FH#fileheader.closed_properly =:= ?CLOSED_PROPERLY2 -> - {ok, true, hash}; - FH#fileheader.closed_properly =:= - ?CLOSED_PROPERLY2_NEED_COMPACTING -> - {ok, need_compacting, hash}; - FH#fileheader.closed_properly =:= ?CLOSED_PROPERLY_NEW_HASH -> - {ok, true, phash}; - FH#fileheader.closed_properly =:= - ?CLOSED_PROPERLY_NEW_HASH_NEED_COMPACTING -> - {ok, need_compacting, phash}; - FH#fileheader.closed_properly =:= ?NOT_PROPERLY_CLOSED -> - {error, not_closed}; - FH#fileheader.closed_properly > - ?CLOSED_PROPERLY_NEW_HASH_NEED_COMPACTING -> - {error, not_closed}; - true -> - {error, not_a_dets_file} - end, - case Test of - {ok, ExtraInfo, HashAlg} -> - H = #head{ - m = FH#fileheader.m, - m2 = FH#fileheader.m * 2, - next = FH#fileheader.next, - fptr = Fd, - no_objects= FH#fileheader.no_objects, - n = FH#fileheader.n, - type = FH#fileheader.type, - update_mode = saved, - auto_save = infinity, % not saved on file - fixed = false, % not saved on file - freelists_p = FH#fileheader.freelist, - hash_bif = HashAlg, - keypos = FH#fileheader.keypos, - min_no_slots = FH#fileheader.min_no_slots, - max_no_slots = FH#fileheader.max_no_slots, - version = ?FILE_FORMAT_VERSION, - mod = ?MODULE, - bump = ?BUMP, - base = FH#fileheader.fl_base}, - {ok, H, ExtraInfo}; - Error -> - Error - end. - -cache_segps(Fd, FileName, M) -> - NSegs = no_segs(M), - {ok, Bin} = dets_utils:pread_close(Fd, FileName, ?HEADSZ, 4 * NSegs), - Fun = fun(S, P) -> segp_cache(P, S), P+4 end, - lists:foldl(Fun, ?HEADSZ, bin2ints(Bin)). - -no_segs(NoSlots) -> - ?SLOT2SEG(NoSlots - 1) + 1. - -bin2ints(<<Int:32, B/binary>>) -> - [Int | bin2ints(B)]; -bin2ints(<<>>) -> - []. - -%%% -%%% Repair, conversion and initialization of a dets file. -%%% - -bulk_input(Head, InitFun, Cntrs) -> - bulk_input(Head, InitFun, Cntrs, make_ref()). - -bulk_input(Head, InitFun, Cntrs, Ref) -> - fun(close) -> - ok; - (read) -> - case catch {Ref, InitFun(read)} of - {Ref, end_of_input} -> - end_of_input; - {Ref, {L0, NewInitFun}} when is_list(L0), - is_function(NewInitFun) -> - Kp = Head#head.keypos, - case catch bulk_objects(L0, Head, Cntrs, Kp, []) of - {'EXIT', _Error} -> - _ = (catch NewInitFun(close)), - {error, invalid_objects_list}; - L -> - {L, bulk_input(Head, NewInitFun, Cntrs, Ref)} - end; - {Ref, Value} -> - {error, {init_fun, Value}}; - Error -> - throw({thrown, Error}) - end - end. - -bulk_objects([T | Ts], Head, Cntrs, Kp, L) -> - BT = term_to_binary(T), - Sz = byte_size(BT), - LogSz = sz2pos(Sz+?OHDSZ), - count_object(Cntrs, LogSz), - Key = element(Kp, T), - bulk_objects(Ts, Head, Cntrs, Kp, [make_object(Head, Key, LogSz, BT) | L]); -bulk_objects([], _Head, _Cntrs, _Kp, L) -> - L. - --define(FSCK_SEGMENT, 10000). - --define(DCT(D, CT), [D | CT]). - --define(VNEW(N, E), erlang:make_tuple(N, E)). --define(VSET(I, V, E), setelement(I, V, E)). --define(VGET(I, V), element(I, V)). - -%% OldVersion not used, assuming later versions have been converted already. -output_objs(OldVersion, Head, SlotNumbers, Cntrs) -> - fun(close) -> - {ok, 0, Head}; - ([]) -> - output_objs(OldVersion, Head, SlotNumbers, Cntrs); - (L) -> - %% Descending sizes. - Count = lists:sort(ets:tab2list(Cntrs)), - RCount = lists:reverse(Count), - NoObjects = lists:foldl(fun({_Sz,No}, A) -> A + No end, 0, Count), - {_, MinSlots, _} = SlotNumbers, - if - %% Using number of objects for bags and duplicate bags - %% is not ideal; number of (unique) keys should be - %% used instead. The effect is that there will be more - %% segments than "necessary". - MinSlots =/= bulk_init, - abs(?SLOT2SEG(NoObjects) - ?SLOT2SEG(MinSlots)) > 5, - (NoObjects < ?MAXOBJS) -> - {try_again, NoObjects}; - true -> - Head1 = Head#head{no_objects = NoObjects}, - SegSz = actual_seg_size(), - {_, End, _} = dets_utils:alloc(Head, SegSz-1), - %% Now {LogSize,NoObjects} in Cntrs is replaced by - %% {LogSize,Position,{FileName,FileDescriptor},NoObjects}. - {Head2, CT} = allocate_all_objects(Head1, RCount, Cntrs), - [E | Es] = bin2term(L, []), - {NE, Acc, DCT1} = - output_slots(E, Es, [E], Head2, ?DCT(0, CT)), - NDCT = write_all_sizes(DCT1, Cntrs), - Max = ets:info(Cntrs, size), - output_objs2(NE, Acc, Head2, Cntrs, NDCT, End, Max,Max) - end - end. - -output_objs2(E, Acc, Head, Cntrs, DCT, End, 0, MaxNoChunks) -> - NDCT = write_all_sizes(DCT, Cntrs), - output_objs2(E, Acc, Head, Cntrs, NDCT, End, MaxNoChunks, MaxNoChunks); -output_objs2(E, Acc, Head, Cntrs, DCT, End, ChunkI, MaxNoChunks) -> - fun(close) -> - DCT1 = output_slot(Acc, Head, DCT), - NDCT = write_all_sizes(DCT1, Cntrs), - ?DCT(NoDups, CT) = NDCT, - [SegAddr | []] = ?VGET(tuple_size(CT), CT), - FinalZ = End - SegAddr, - [{?FSCK_SEGMENT, _, {FileName, Fd}, _}] = - ets:lookup(Cntrs, ?FSCK_SEGMENT), - ok = dets_utils:fwrite(Fd, FileName, - dets_utils:make_zeros(FinalZ)), - NewHead = Head#head{no_objects = Head#head.no_objects - NoDups}, - {ok, NoDups, NewHead}; - (L) -> - Es = bin2term(L, []), - {NE, NAcc, NDCT} = output_slots(E, Es, Acc, Head, DCT), - output_objs2(NE, NAcc, Head, Cntrs, NDCT, End, - ChunkI-1, MaxNoChunks) - end. - -%% By allocating bigger objects before smaller ones, holes in the -%% buddy system memory map are avoided. Unfortunately, the segments -%% are always allocated first, so if there are objects bigger than a -%% segment, there is a hole to handle. (Haven't considered placing the -%% segments among other objects of the same size.) -allocate_all_objects(Head, Count, Cntrs) -> - SegSize = actual_seg_size(), - {Head1, HSz, HN, HA} = alloc_hole(Count, Head, SegSize), - {Max, _} = hd(Count), - CT = ?VNEW(Max+1, not_used), - {Head2, NCT} = allocate_all(Head1, Count, Cntrs, CT), - Head3 = free_hole(Head2, HSz, HN, HA), - {Head3, NCT}. - -alloc_hole([{LSize,_} | _], Head, SegSz) when ?POW(LSize-1) > SegSz -> - {_, SegAddr, _} = dets_utils:alloc(Head, SegSz-1), - Size = ?POW(LSize-1)-1, - {_, Addr, _} = dets_utils:alloc(Head, Size), - N = (Addr - SegAddr) div SegSz, - Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr), - {Head1, SegSz-1, N, SegAddr}; -alloc_hole(_Count, Head, _SegSz) -> - {Head, 0, 0, 0}. - -free_hole(Head, _Size, 0, _Addr) -> - Head; -free_hole(Head, Size, N, Addr) -> - {Head1, _} = dets_utils:free(Head, Addr, Size), - free_hole(Head1, Size, N-1, Addr+Size+1). - -%% One (temporary) file for each buddy size, write all objects of that -%% size to the file. -allocate_all(Head, [{LSize,NoObjects} | Count], Cntrs, CT) -> - Size = ?POW(LSize-1)-1, - {_Head, Addr, _} = dets_utils:alloc(Head, Size), - NewHead = dets_utils:alloc_many(Head, Size+1, NoObjects, Addr), - {FileName, Fd} = temp_file(Head, LSize), - true = ets:insert(Cntrs, {LSize, Addr, {FileName, Fd}, NoObjects}), - NCT = ?VSET(LSize, CT, [Addr | []]), - allocate_all(NewHead, Count, Cntrs, NCT); -allocate_all(Head, [], Cntrs, CT) -> - %% Note that space for the segments has been allocated already. - %% And one file for the segments... - {FileName, Fd} = temp_file(Head, ?FSCK_SEGMENT), - Addr = ?SEGADDR(?SEGARRSZ), - true = ets:insert(Cntrs, {?FSCK_SEGMENT, Addr, {FileName, Fd}, 0}), - NCT = ?VSET(tuple_size(CT), CT, [Addr | []]), - {Head, NCT}. - -temp_file(Head, N) -> - TmpName = lists:concat([Head#head.filename, '.', N]), - {ok, Fd} = dets_utils:open(TmpName, [raw, binary, write]), - {TmpName, Fd}. - -bin2term([<<Slot:32, LogSize:8, BinTerm/binary>> | BTs], L) -> - bin2term(BTs, [{Slot, LogSize, BinTerm} | L]); -bin2term([], L) -> - lists:reverse(L). - -write_all_sizes(?DCT(D, CT), Cntrs) -> - ?DCT(D, write_sizes(1, tuple_size(CT), CT, Cntrs)). - -write_sizes(Sz, Sz, CT, Cntrs) -> - write_size(Sz, ?FSCK_SEGMENT, CT, Cntrs); -write_sizes(Sz, MaxSz, CT, Cntrs) -> - NCT = write_size(Sz, Sz, CT, Cntrs), - write_sizes(Sz+1, MaxSz, NCT, Cntrs). - -write_size(Sz, I, CT, Cntrs) -> - case ?VGET(Sz, CT) of - not_used -> - CT; - [Addr | L] -> - {FileName, Fd} = ets:lookup_element(Cntrs, I, 3), - case file:write(Fd, lists:reverse(L)) of - ok -> - ?VSET(Sz, CT, [Addr | []]); - Error -> - dets_utils:file_error(FileName, Error) - end - end. - -output_slots(E, [E1 | Es], Acc, Head, DCT) - when element(1, E) =:= element(1, E1) -> - output_slots(E1, Es, [E1 | Acc], Head, DCT); -output_slots(_E, [E | L], Acc, Head, DCT) -> - NDCT = output_slot(Acc, Head, DCT), - output_slots(E, L, [E], Head, NDCT); -output_slots(E, [], Acc, _Head, DCT) -> - {E, Acc, DCT}. - -output_slot([E], _Head, ?DCT(D, CT)) -> - ?DCT(D, output_slot([{foo, E}], 0, foo, CT)); -output_slot(Es0, Head, ?DCT(D, CT)) -> - Kp = Head#head.keypos, - Fun = fun({_Slot, _LSize, BinTerm} = E) -> - Key = element(Kp, binary_to_term(BinTerm)), - {Key, E} - end, - Es = lists:map(Fun, Es0), - NEs = case Head#head.type of - set -> - [{Key0,_} = E | L0] = lists:sort(Es), - choose_one(lists:sort(L0), Key0, [E]); - bag -> - lists:usort(Es); - duplicate_bag -> - lists:sort(Es) - end, - Dups = D + length(Es) - length(NEs), - ?DCT(Dups, output_slot(NEs, 0, foo, CT)). - -choose_one([{Key,_} | Es], Key, L) -> - choose_one(Es, Key, L); -choose_one([{Key,_} = E | Es], _Key, L) -> - choose_one(Es, Key, [E | L]); -choose_one([], _Key, L) -> - L. - -output_slot([E | Es], Next, _Slot, CT) -> - {_Key, {Slot, LSize, BinTerm}} = E, - Size = byte_size(BinTerm), - Size2 = ?POW(LSize-1), - Pad = <<0:(Size2-Size-?OHDSZ)/unit:8>>, - BinObject = [<<Next:32, Size:32, ?ACTIVE:32>>, BinTerm | Pad], - [Addr | L] = ?VGET(LSize, CT), - NCT = ?VSET(LSize, CT, [Addr+Size2 | [BinObject | L]]), - output_slot(Es, Addr, Slot, NCT); -output_slot([], Next, Slot, CT) -> - I = tuple_size(CT), - [Addr | L] = ?VGET(I, CT), - {Pos, _} = slot_position(Slot), - NoZeros = Pos - Addr, - BinObject = if - NoZeros > 100 -> - [dets_utils:make_zeros(NoZeros) | <<Next:32>>]; - true -> - <<0:NoZeros/unit:8,Next:32>> - end, - Size = NoZeros+4, - ?VSET(I, CT, [Addr+Size | [BinObject | L]]). - -%% Does not close Fd. -fsck_input(Head, Fd, Cntrs, _FileHeader) -> - %% The file is not compressed, so the object size cannot exceed - %% the filesize, for all objects. - MaxSz = case file:position(Fd, eof) of - {ok, Pos} -> - Pos; - _ -> - (1 bsl 32) - 1 - end, - State0 = fsck_read(?BASE, Fd, []), - fsck_input1(Head, State0, Fd, MaxSz, Cntrs). - -fsck_input1(Head, State, Fd, MaxSz, Cntrs) -> - fun(close) -> - ok; - (read) -> - case State of - done -> - end_of_input; - {done, L} -> - R = count_input(Cntrs, L, []), - {R, fsck_input1(Head, done, Fd, MaxSz, Cntrs)}; - {cont, L, Bin, Pos} -> - R = count_input(Cntrs, L, []), - FR = fsck_objs(Bin, Head#head.keypos, Head, []), - NewState = fsck_read(FR, Pos, Fd, MaxSz, Head), - {R, fsck_input1(Head, NewState, Fd, MaxSz, Cntrs)} - end - end. - -%% The ets table Cntrs is used for counting objects per size. -count_input(Cntrs, [[LogSz | B] | Ts], L) -> - count_object(Cntrs, LogSz), - count_input(Cntrs, Ts, [B | L]); -count_input(_Cntrs, [], L) -> - L. - -count_object(Cntrs, LogSz) -> - case catch ets:update_counter(Cntrs, LogSz, 1) of - N when is_integer(N) -> ok; - _Badarg -> true = ets:insert(Cntrs, {LogSz, 1}) - end. - -fsck_read(Pos, F, L) -> - case file:position(F, Pos) of - {ok, _} -> - read_more_bytes(<<>>, 0, Pos, F, L); - _Error -> - {done, L} - end. - -fsck_read({more, Bin, Sz, L}, Pos, F, MaxSz, Head) when Sz > MaxSz -> - FR = skip_bytes(Bin, ?BUMP, Head#head.keypos, Head, L), - fsck_read(FR, Pos, F, MaxSz, Head); -fsck_read({more, Bin, Sz, L}, Pos, F, _MaxSz, _Head) -> - read_more_bytes(Bin, Sz, Pos, F, L); -fsck_read({new, Skip, L}, Pos, F, _MaxSz, _Head) -> - NewPos = Pos + Skip, - fsck_read(NewPos, F, L). - -read_more_bytes(B, Min, Pos, F, L) -> - Max = if - Min < ?CHUNK_SIZE -> ?CHUNK_SIZE; - true -> Min - end, - case dets_utils:read_n(F, Max) of - eof -> - {done, L}; - Bin -> - NewPos = Pos + byte_size(Bin), - {cont, L, list_to_binary([B, Bin]), NewPos} - end. - -fsck_objs(Bin = <<_N:32, Sz:32, Status:32, Tail/binary>>, Kp, Head, L) -> - if - Status =:= ?ACTIVE -> - case Tail of - <<BinTerm:Sz/binary, Tail2/binary>> -> - case catch element(Kp, binary_to_term(BinTerm)) of - {'EXIT', _} -> - skip_bytes(Bin, ?BUMP, Kp, Head, L); - Key -> - LogSz = sz2pos(Sz+?OHDSZ), - Obj = make_object(Head, Key, LogSz, BinTerm), - NL = [[LogSz | Obj] | L], - Skip = ?POW(LogSz-1) - Sz - ?OHDSZ, - skip_bytes(Tail2, Skip, Kp, Head, NL) - end; - _ -> - {more, Bin, Sz, L} - end; - true -> - skip_bytes(Bin, ?BUMP, Kp, Head, L) - end; -fsck_objs(Bin, _Kp, _Head, L) -> - {more, Bin, 0, L}. - -%% Version 8 has to know about version 9. -make_object(Head, Key, _LogSz, BT) when Head#head.version =:= 9 -> - Slot = dets_v9:db_hash(Key, Head), - <<Slot:32, BT/binary>>; -make_object(Head, Key, LogSz, BT) -> - Slot = db_hash(Key, Head), - <<Slot:32, LogSz:8, BT/binary>>. - -%% Inlined. -skip_bytes(Bin, Skip, Kp, Head, L) -> - case Bin of - <<_:Skip/binary, Tail/binary>> -> - fsck_objs(Tail, Kp, Head, L); - _ -> - {new, Skip - byte_size(Bin), L} - end. - -%% -> {NewHead, ok} | throw({Head, Error}) -do_perform_save(H) -> - FL = dets_utils:get_freelists(H), - B = term_to_binary(FL), - Size = byte_size(B), - ?DEBUGF("size of freelist = ~p~n", [Size]), - ?DEBUGF("head.m = ~p~n", [H#head.m]), - ?DEBUGF("head.no_objects = ~p~n", [H#head.no_objects]), - - {ok, Pos} = dets_utils:position(H, eof), - H1 = H#head{freelists_p = Pos}, - W1 = {?FREELIST_POS, <<Pos:32>>}, - W2 = {Pos, [<<0:32, Size:32, ?FREE:32>>, B]}, - - W3 = {?D_POS, <<(H1#head.m):32, - (H1#head.next):32, - (H1#head.keypos):32, - (H1#head.no_objects):32, - (H1#head.n):32>>}, - {ClosedProperly, ClosedProperlyNeedCompacitng} = - case H1#head.hash_bif of - hash -> - {?CLOSED_PROPERLY2, ?CLOSED_PROPERLY2_NEED_COMPACTING}; - phash -> - {?CLOSED_PROPERLY_NEW_HASH, - ?CLOSED_PROPERLY_NEW_HASH_NEED_COMPACTING} - end, - W4 = - if - Size > 1000, Size > H1#head.no_objects -> - {?CLOSED_PROPERLY_POS, - <<ClosedProperlyNeedCompacitng:32>>}; - true -> - {?CLOSED_PROPERLY_POS, <<ClosedProperly:32>>} - end, - W5 = {?FILE_FORMAT_VERSION_POS, <<?FILE_FORMAT_VERSION:32>>}, - {H2, ok} = dets_utils:pwrite(H1, [W1,W2,W3,W4,W5]), - {ok, Pos2} = dets_utils:position(H2, eof), - ?DEBUGF("Writing file size ~p, eof at ~p~n", [Pos2+4, Pos2]), - dets_utils:pwrite(H2, [{Pos2, <<(Pos2 + 4):32>>}]). - -%% -> [term()] | throw({Head, Error}) -slot_objs(H, Slot) when Slot >= H#head.next -> - '$end_of_table'; -slot_objs(H, Slot) -> - {_Pos, Chain} = chain(H, Slot), - collect_chain(H, Chain). - -collect_chain(_H, 0) -> []; -collect_chain(H, Pos) -> - {Next, _Sz, Term} = prterm(H, Pos, ?ReadAhead), - [Term | collect_chain(H, Next)]. - -db_hash(Key, Head) -> - H = h(Key, Head#head.hash_bif), - Hash = H rem Head#head.m, - if - Hash < Head#head.n -> - H rem (Head#head.m2); % H rem (2 * m) - true -> - Hash - end. - -h(I, phash) -> erlang:phash(I, ?BIG) - 1; -h(I, HF) -> erlang:HF(I, ?BIG) - 1. %% stupid BIF has 1 counts. - -no_slots(_Head) -> - undefined. - -table_parameters(_Head) -> - undefined. - -%% Re-hashing a segment, starting with SlotStart. -%% -%% On the average, half of the objects of the chain are put into a new -%% chain. If the slot of the old chain is i, then the slot of the new -%% chain is i+m. -%% Note that the insertion of objects into the new chain is simplified -%% by the fact that the chains are not sorted on key, which means that -%% each moved object can be inserted first in the new chain. -%% (It is also a fact that the objects with the same key are not sorted.) -%% -%% -> {ok, Writes} | throw({Head, Error}) -re_hash(Head, SlotStart) -> - {SlotPos, _4} = slot_position(SlotStart), - {ok, Bin} = dets_utils:pread(Head, SlotPos, 4*?SEGSZ, 0), - {Read, Cs} = split_bin(SlotPos, Bin, [], []), - re_hash_read(Head, [], Read, Cs). - -split_bin(Pos, <<P:32, B/binary>>, R, Cs) -> - if - P =:= 0 -> - split_bin(Pos+4, B, R, Cs); - true -> - split_bin(Pos+4, B, [{P,?ReadAhead} | R], [[Pos] | Cs]) - end; -split_bin(_Pos, <<>>, R, Cs) -> - {R, Cs}. - -re_hash_read(Head, Cs, R, RCs) -> - {ok, Bins} = dets_utils:pread(R, Head), - re_hash_read(Head, R, RCs, Bins, Cs, [], []). - -re_hash_read(Head, [{Pos, Size} | Ps], [C | Cs], - [<<Next:32, Sz:32, _Status:32, Bin0/binary>> | Bins], - DoneCs, R, RCs) -> - case byte_size(Bin0) of - BinSz when BinSz >= Sz -> - case catch binary_to_term(Bin0) of - {'EXIT', _Error} -> - throw(dets_utils:corrupt_reason(Head, bad_object)); - Term -> - Key = element(Head#head.keypos, Term), - New = h(Key, Head#head.hash_bif) rem Head#head.m2, - NC = case New >= Head#head.m of - true -> [{Pos,New} | C]; - false -> [Pos | C] - end, - if - Next =:= 0 -> - NDoneCs = [NC | DoneCs], - re_hash_read(Head, Ps, Cs, Bins, NDoneCs, R, RCs); - true -> - NR = [{Next,?ReadAhead} | R], - NRCs = [NC | RCs], - re_hash_read(Head, Ps, Cs, Bins, DoneCs, NR, NRCs) - end - end; - BinSz when Size =:= BinSz+?OHDSZ -> - NR = [{Pos, Sz+?OHDSZ} | R], - re_hash_read(Head, Ps, Cs, Bins, DoneCs, NR, [C | RCs]); - _BinSz -> - throw({Head, {error, {premature_eof, Head#head.filename}}}) - end; -re_hash_read(Head, [], [], [], Cs, [], []) -> - re_hash_traverse_chains(Cs, Head, [], [], []); -re_hash_read(Head, [], [], [], Cs, R, RCs) -> - re_hash_read(Head, Cs, R, RCs). - -re_hash_traverse_chains([C | Cs], Head, Rs, Ns, Ws) -> - case re_hash_find_new(C, Rs, start, start) of - false -> - re_hash_traverse_chains(Cs, Head, Rs, Ns, Ws); - {NRs, FirstNew, LastNew} -> - LastInNew = case C of - [{_,_} | _] -> true; - _ -> false - end, - N = {FirstNew, LastNew, LastInNew}, - NWs = re_hash_link(C, start, start, start, Ws), - re_hash_traverse_chains(Cs, Head, NRs, [N | Ns], NWs) - end; -re_hash_traverse_chains([], Head, Rs, Ns, Ws) -> - {ok, Bins} = dets_utils:pread(Rs, Head), - {ok, insert_new(Rs, Bins, Ns, Ws)}. - -re_hash_find_new([{Pos,NewSlot} | C], R, start, start) -> - {SPos, _4} = slot_position(NewSlot), - re_hash_find_new(C, [{SPos,4} | R], Pos, Pos); -re_hash_find_new([{Pos,_SPos} | C], R, _FirstNew, LastNew) -> - re_hash_find_new(C, R, Pos, LastNew); -re_hash_find_new([_Pos | C], R, FirstNew, LastNew) -> - re_hash_find_new(C, R, FirstNew, LastNew); -re_hash_find_new([], _R, start, start) -> - false; -re_hash_find_new([], R, FirstNew, LastNew) -> - {R, FirstNew, LastNew}. - -re_hash_link([{Pos,_SPos} | C], LastOld, start, _LastInNew, Ws) -> - re_hash_link(C, LastOld, Pos, true, Ws); -re_hash_link([{Pos,_SPos} | C], LastOld, LastNew, false, Ws) -> - re_hash_link(C, LastOld, Pos, true, [{Pos,<<LastNew:32>>} | Ws]); -re_hash_link([{Pos,_SPos} | C], LastOld, _LastNew, LastInNew, Ws) -> - re_hash_link(C, LastOld, Pos, LastInNew, Ws); -re_hash_link([Pos | C], start, LastNew, true, Ws) -> - re_hash_link(C, Pos, LastNew, false, [{Pos,<<0:32>>} | Ws]); -re_hash_link([Pos | C], LastOld, LastNew, true, Ws) -> - re_hash_link(C, Pos, LastNew, false, [{Pos,<<LastOld:32>>} | Ws]); -re_hash_link([Pos | C], _LastOld, LastNew, LastInNew, Ws) -> - re_hash_link(C, Pos, LastNew, LastInNew, Ws); -re_hash_link([], _LastOld, _LastNew, _LastInNew, Ws) -> - Ws. - -insert_new([{NewSlotPos,_4} | Rs], [<<P:32>> = PB | Bins], [N | Ns], Ws) -> - {FirstNew, LastNew, LastInNew} = N, - Ws1 = case P of - 0 when LastInNew -> - Ws; - 0 -> - [{LastNew, <<0:32>>} | Ws]; - _ -> - [{LastNew, PB} | Ws] - end, - NWs = [{NewSlotPos, <<FirstNew:32>>} | Ws1], - insert_new(Rs, Bins, Ns, NWs); -insert_new([], [], [], Ws) -> - Ws. - -%% When writing the cache, a 'work list' is first created: -%% WorkList = [{Key, {Delete,Lookup,[Inserted]}}] -%% Delete = keep | delete -%% Lookup = skip | lookup -%% Inserted = {object(), No} -%% No = integer() -%% If No =< 0 then there will be -No instances of object() on the file -%% when the cache has been written. If No > 0 then No instances of -%% object() will be added to the file. -%% If Delete has the value 'delete', then all objects with the key Key -%% have been deleted. (This could be viewed as a shorthand for {Object,0} -%% for each object Object on the file not mentioned in some Inserted.) -%% If Lookup has the value 'lookup', all objects with the key Key will -%% be returned. -%% - -%% -> {NewHead, [LookedUpObject], pwrite_list()} | throw({NewHead, Error}) -write_cache(Head) -> - #head{cache = C, type = Type} = Head, - case dets_utils:is_empty_cache(C) of - true -> {Head, [], []}; - false -> - {NewC, _MaxInserts, PerKey} = dets_utils:reset_cache(C), - %% NoInsertedKeys is an upper limit on the number of new keys. - {WL, NoInsertedKeys} = make_wl(PerKey, Type), - Head1 = Head#head{cache = NewC}, - case may_grow(Head1, NoInsertedKeys, once) of - {Head2, ok} -> - eval_work_list(Head2, WL); - HeadError -> - throw(HeadError) - end - end. - -make_wl(PerKey, Type) -> - make_wl(PerKey, Type, [], 0). - -make_wl([{Key,L} | PerKey], Type, WL, Ins) -> - [Cs | I] = wl(L, Type), - make_wl(PerKey, Type, [{Key,Cs} | WL], Ins+I); -make_wl([], _Type, WL, Ins) -> - {WL, Ins}. - -wl(L, Type) -> - wl(L, Type, keep, skip, 0, []). - -wl([{_Seq, delete_key} | Cs], Type, _Del, Lookup, _I, _Objs) -> - wl(Cs, Type, delete, Lookup, 0, []); -wl([{_Seq, {delete_object, Object}} | Cs], Type, Del, Lookup, I, Objs) -> - NObjs = lists:keydelete(Object, 1, Objs), - wl(Cs, Type, Del, Lookup, I, [{Object,0} | NObjs]); -wl([{_Seq, {insert, Object}} | Cs], Type, _Del, Lookup, _I, _Objs) - when Type =:= set -> - wl(Cs, Type, delete, Lookup, 1, [{Object,-1}]); -wl([{_Seq, {insert, Object}} | Cs], Type, Del, Lookup, _I, Objs) -> - NObjs = - case lists:keyfind(Object, 1, Objs) of - {_, 0} -> - lists:keyreplace(Object, 1, Objs, {Object,-1}); - {_, _C} when Type =:= bag -> % C =:= 1; C =:= -1 - Objs; - {_, C} when C < 0 -> % when Type =:= duplicate_bag - lists:keyreplace(Object, 1, Objs, {Object,C-1}); - {_, C} -> % when C > 0, Type =:= duplicate_bag - lists:keyreplace(Object, 1, Objs, {Object,C+1}); - false when Del =:= delete -> - [{Object, -1} | Objs]; - false -> - [{Object, 1} | Objs] - end, - wl(Cs, Type, Del, Lookup, 1, NObjs); -wl([{_Seq, {lookup,_Pid}=Lookup} | Cs], Type, Del, _Lookup, I, Objs) -> - wl(Cs, Type, Del, Lookup, I, Objs); -wl([], _Type, Del, Lookup, I, Objs) -> - [{Del, Lookup, Objs} | I]. - -%% -> {NewHead, ok} | {NewHead, Error} -may_grow(Head, 0, once) -> - {Head, ok}; -may_grow(Head, _N, _How) when Head#head.fixed =/= false -> - {Head, ok}; -may_grow(#head{access = read}=Head, _N, _How) -> - {Head, ok}; -may_grow(Head, _N, _How) when Head#head.next >= ?MAXOBJS -> - {Head, ok}; -may_grow(Head, N, How) -> - Extra = erlang:min(2*?SEGSZ, Head#head.no_objects + N - Head#head.next), - case catch may_grow1(Head, Extra, How) of - {error, Reason} -> % alloc may throw error - {Head, {error, Reason}}; - Reply -> - Reply - end. - -may_grow1(Head, Extra, many_times) when Extra > ?SEGSZ -> - Reply = grow(Head, 1, undefined), - self() ! ?DETS_CALL(self(), may_grow), - Reply; -may_grow1(Head, Extra, _How) -> - grow(Head, Extra, undefined). - -%% -> {Head, ok} | throw({Head, Error}) -grow(Head, Extra, _SegZero) when Extra =< 0 -> - {Head, ok}; -grow(Head, Extra, undefined) -> - grow(Head, Extra, seg_zero()); -grow(Head, Extra, SegZero) -> - #head{n = N, next = Next, m = M} = Head, - SegNum = ?SLOT2SEG(Next), - {Head0, Ws1} = allocate_segment(Head, SegZero, SegNum), - {Head1, ok} = dets_utils:pwrite(Head0, Ws1), - %% If re_hash fails, segp_cache has been called, but it does not matter. - {ok, Ws2} = re_hash(Head1, N), - {Head2, ok} = dets_utils:pwrite(Head1, Ws2), - NewHead = - if - N + ?SEGSZ =:= M -> - Head2#head{n = 0, next = Next + ?SEGSZ, m = 2 * M, m2 = 4 * M}; - true -> - Head2#head{n = N + ?SEGSZ, next = Next + ?SEGSZ} - end, - grow(NewHead, Extra - ?SEGSZ, SegZero). - -seg_zero() -> - <<0:(4*?SEGSZ)/unit:8>>. - -find_object(Head, Object) -> - Key = element(Head#head.keypos, Object), - Slot = db_hash(Key, Head), - find_object(Head, Object, Slot). - -find_object(H, _Obj, Slot) when Slot >= H#head.next -> - false; -find_object(H, Obj, Slot) -> - {_Pos, Chain} = chain(H, Slot), - case catch find_obj(H, Obj, Chain) of - {ok, Pos} -> - {ok, Pos}; - _Else -> - false - end. - -find_obj(H, Obj, Pos) when Pos > 0 -> - {Next, _Sz, Term} = prterm(H, Pos, ?ReadAhead), - if - Term == Obj -> - {ok, Pos}; - true -> - find_obj(H, Obj, Next) - end. - -%% Given, a slot, return the {Pos, Chain} in the file where the -%% objects hashed to this slot reside. Pos is the position in the -%% file where the chain pointer is written and Chain is the position -%% in the file where the first object resides. -chain(Head, Slot) -> - Pos = ?SEGADDR(?SLOT2SEG(Slot)), - Segment = get_segp(Pos), - FinalPos = Segment + (4 * ?REM2(Slot, ?SEGSZ)), - {ok, <<Chain:32>>} = dets_utils:pread(Head, FinalPos, 4, 0), - {FinalPos, Chain}. - -%%% -%%% Cache routines depending on the dets file format. -%%% - -%% -> {Head, [LookedUpObject], pwrite_list()} | throw({Head, Error}) -eval_work_list(Head, WorkLists) -> - SWLs = tag_with_slot(WorkLists, Head, []), - P1 = dets_utils:family(SWLs), - {PerSlot, SlotPositions} = remove_slot_tag(P1, [], []), - {ok, Bins} = dets_utils:pread(SlotPositions, Head), - first_object(PerSlot, SlotPositions, Bins, Head, [], [], [], []). - -tag_with_slot([{K,_} = WL | WLs], Head, L) -> - tag_with_slot(WLs, Head, [{db_hash(K, Head), WL} | L]); -tag_with_slot([], _Head, L) -> - L. - -remove_slot_tag([{S,SWLs} | SSWLs], Ls, SPs) -> - remove_slot_tag(SSWLs, [SWLs | Ls], [slot_position(S) | SPs]); -remove_slot_tag([], Ls, SPs) -> - {Ls, SPs}. - -%% The initial chain pointers and the first object in each chain are -%% read "in parallel", that is, with one call to file:pread/2 (two -%% calls altogether). The following chain objects are read one by -%% one. This is a compromise: if the chains are long and threads are -%% active, it would be faster to keep a state for each chain and read -%% the objects of the chains in parallel, but the overhead would be -%% quite substantial. - -first_object([WorkLists | SPs], [{P1,_4} | Ss], [<<P2:32>> | Bs], Head, - ObjsToRead, ToRead, Ls, LU) when P2 =:= 0 -> - L0 = [{old,P1}], - {L, NLU} = eval_slot(Head, ?ReadAhead, P2, WorkLists, L0, LU), - first_object(SPs, Ss, Bs, Head, ObjsToRead, ToRead, [L | Ls], NLU); -first_object([WorkLists | SPs], [{P1,_4} | Ss], [<<P2:32>> | Bs], Head, - ObjsToRead, ToRead, Ls, LU) -> - E = {P1,P2,WorkLists}, - first_object(SPs, Ss, Bs, Head, - [E | ObjsToRead], [{P2, ?ReadAhead} | ToRead], Ls, LU); -first_object([], [], [], Head, ObjsToRead, ToRead, Ls, LU) -> - {ok, Bins} = dets_utils:pread(ToRead, Head), - case catch eval_first(Bins, ObjsToRead, Head, Ls, LU) of - {ok, NLs, NLU} -> - case create_writes(NLs, Head, [], 0) of - {Head1, [], 0} -> - {Head1, NLU, []}; - {Head1, Ws, No} -> - {NewHead, Ws2} = update_no_objects(Head1, Ws, No), - {NewHead, NLU, Ws2} - end; - _Error -> - throw(dets_utils:corrupt_reason(Head, bad_object)) - end. - -%% Update no_objects on the file too, if the number of segments that -%% dets:fsck/6 use for estimate has changed. -update_no_objects(Head, Ws, 0) -> {Head, Ws}; -update_no_objects(Head, Ws, Delta) -> - No = Head#head.no_objects, - NewNo = No + Delta, - NWs = - if - NewNo > ?MAXOBJS -> - Ws; - ?SLOT2SEG(No) =:= ?SLOT2SEG(NewNo) -> - Ws; - true -> - [{?NO_OBJECTS_POS, <<NewNo:32>>} | Ws] - end, - {Head#head{no_objects = NewNo}, NWs}. - -eval_first([<<Next:32, Sz:32, _Status:32, Bin/binary>> | Bins], - [SP | SPs], Head, Ls, LU) -> - {P1, P2, WLs} = SP, - L0 = [{old,P1}], - case byte_size(Bin) of - BinSz when BinSz >= Sz -> - Term = binary_to_term(Bin), - Key = element(Head#head.keypos, Term), - {L, NLU} = find_key(Head, P2, Next, Sz, Term, Key, WLs, L0, LU), - eval_first(Bins, SPs, Head, [L | Ls], NLU); - _BinSz -> - {L, NLU} = eval_slot(Head, Sz+?OHDSZ, P2, WLs, L0, LU), - eval_first(Bins, SPs, Head, [L | Ls], NLU) - end; -eval_first([], [], _Head, Ls, LU) -> - {ok, Ls, LU}. - -eval_slot(_Head, _TrySize, _Pos=0, [], L, LU) -> - {L, LU}; -eval_slot(Head, _TrySize, Pos=0, [WL | WLs], L, LU) -> - {_Key, {_Delete, LookUp, Objects}} = WL, - {NL, NLU} = end_of_key(Objects, LookUp, L, []), - eval_slot(Head, ?ReadAhead, Pos, WLs, NL, NLU++LU); -eval_slot(Head, TrySize, Pos, WLs, L, LU) -> - {NextPos, Size, Term} = prterm(Head, Pos, TrySize), - Key = element(Head#head.keypos, Term), - find_key(Head, Pos, NextPos, Size, Term, Key, WLs, L, LU). - -find_key(Head, Pos, NextPos, Size, Term, Key, WLs, L, LU) -> - case lists:keyfind(Key, 1, WLs) of - {_, {Delete, LookUp, Objects}} = WL -> - NWLs = lists:delete(WL, WLs), - {NewObjects, NL, LUK} = eval_object(Size, Term, Delete, LookUp, - Objects, Head, Pos, L, []), - eval_key(Key, Delete, LookUp, NewObjects, Head, NextPos, - NWLs, NL, LU, LUK); - false -> - L0 = [{old,Pos} | L], - eval_slot(Head, ?ReadAhead, NextPos, WLs, L0, LU) - end. - -eval_key(_Key, _Delete, Lookup, _Objects, Head, Pos, WLs, L, LU, LUK) - when Head#head.type =:= set -> - NLU = case Lookup of - {lookup, Pid} -> [{Pid,LUK} | LU]; - skip -> LU - end, - eval_slot(Head, ?ReadAhead, Pos, WLs, L, NLU); -eval_key(_Key, _Delete, LookUp, Objects, Head, Pos, WLs, L, LU, LUK) - when Pos =:= 0 -> - {NL, NLU} = end_of_key(Objects, LookUp, L, LUK), - eval_slot(Head, ?ReadAhead, Pos, WLs, NL, NLU++LU); -eval_key(Key, Delete, LookUp, Objects, Head, Pos, WLs, L, LU, LUK) -> - {NextPos, Size, Term} = prterm(Head, Pos, ?ReadAhead), - case element(Head#head.keypos, Term) of - Key -> - {NewObjects, NL, LUK1} = - eval_object(Size, Term, Delete, LookUp,Objects,Head,Pos,L,LUK), - eval_key(Key, Delete, LookUp, NewObjects, Head, NextPos, WLs, - NL, LU, LUK1); - Key2 -> - {L1, NLU} = end_of_key(Objects, LookUp, L, LUK), - find_key(Head, Pos, NextPos, Size, Term, Key2, WLs, L1, NLU++LU) - end. - -%% All objects in Objects have the key Key. -eval_object(Size, Term, Delete, LookUp, Objects, Head, Pos, L, LU) -> - Type = Head#head.type, - case lists:keyfind(Term, 1, Objects) of - {_Object, N} when N =:= 0 -> - L1 = [{delete,Pos,Size} | L], - {Objects, L1, LU}; - {_Object, N} when N < 0, Type =:= set -> - L1 = [{old,Pos} | L], - wl_lookup(LookUp, Objects, Term, L1, LU); - {Object, _N} when Type =:= bag -> % when N =:= 1; N =:= -1 - L1 = [{old,Pos} | L], - Objects1 = lists:keydelete(Object, 1, Objects), - wl_lookup(LookUp, Objects1, Term, L1, LU); - {Object, N} when N < 0, Type =:= duplicate_bag -> - L1 = [{old,Pos} | L], - Objects1 = lists:keyreplace(Object, 1, Objects, {Object,N+1}), - wl_lookup(LookUp, Objects1, Term, L1, LU); - {_Object, N} when N > 0, Type =:= duplicate_bag -> - L1 = [{old,Pos} | L], - wl_lookup(LookUp, Objects, Term, L1, LU); - false when Type =:= set, Delete =:= delete -> - case lists:keyfind(-1, 2, Objects) of - false -> % no inserted object, perhaps deleted objects - L1 = [{delete,Pos,Size} | L], - {[], L1, LU}; - {Term2, -1} -> - Bin2 = term_to_binary(Term2), - NSize = byte_size(Bin2), - Overwrite = - if - NSize =:= Size -> - true; - true -> - SizePos = sz2pos(Size+?OHDSZ), - NSizePos = sz2pos(NSize+?OHDSZ), - SizePos =:= NSizePos - end, - E = if - Overwrite -> - {overwrite,Bin2,Pos}; - true -> - {replace,Bin2,Pos,Size} - end, - wl_lookup(LookUp, [], Term2, [E | L], LU) - end; - false when Delete =:= delete -> - L1 = [{delete,Pos,Size} | L], - {Objects, L1, LU}; - false -> - L1 = [{old,Pos} | L], - wl_lookup(LookUp, Objects, Term, L1, LU) - end. - -%% Inlined. -wl_lookup({lookup,_}, Objects, Term, L, LU) -> - {Objects, L, [Term | LU]}; -wl_lookup(skip, Objects, _Term, L, LU) -> - {Objects, L, LU}. - -end_of_key([{Object,N0} | Objs], LookUp, L, LU) when N0 =/= 0 -> - N = abs(N0), - NL = [{insert,N,term_to_binary(Object)} | L], - NLU = case LookUp of - {lookup, _} -> - lists:duplicate(N, Object) ++ LU; - skip -> - LU - end, - end_of_key(Objs, LookUp, NL, NLU); -end_of_key([_ | Objects], LookUp, L, LU) -> - end_of_key(Objects, LookUp, L, LU); -end_of_key([], {lookup,Pid}, L, LU) -> - {L, [{Pid,LU}]}; -end_of_key([], skip, L, LU) -> - {L, LU}. - -create_writes([L | Ls], H, Ws, No) -> - {NH, NWs, NNo} = create_writes(L, H, Ws, No, 0, true), - create_writes(Ls, NH, NWs, NNo); -create_writes([], H, Ws, No) -> - {H, lists:reverse(Ws), No}. - -create_writes([{old,Pos} | L], H, Ws, No, _Next, true) -> - create_writes(L, H, Ws, No, Pos, true); -create_writes([{old,Pos} | L], H, Ws, No, Next, false) -> - W = {Pos, <<Next:32>>}, - create_writes(L, H, [W | Ws], No, Pos, true); -create_writes([{insert,N,Bin} | L], H, Ws, No, Next, _NextIsOld) -> - {NH, NWs, Pos} = create_inserts(N, H, Ws, Next, byte_size(Bin), Bin), - create_writes(L, NH, NWs, No+N, Pos, false); -create_writes([{overwrite,Bin,Pos} | L], H, Ws, No, Next, _) -> - Size = byte_size(Bin), - W = {Pos, [<<Next:32, Size:32, ?ACTIVE:32>>, Bin]}, - create_writes(L, H, [W | Ws], No, Pos, true); -create_writes([{replace,Bin,Pos,OSize} | L], H, Ws, No, Next, _) -> - Size = byte_size(Bin), - {H1, _} = dets_utils:free(H, Pos, OSize+?OHDSZ), - {NH, NewPos, _} = dets_utils:alloc(H1, ?OHDSZ + Size), - W1 = {NewPos, [<<Next:32, Size:32, ?ACTIVE:32>>, Bin]}, - NWs = if - Pos =:= NewPos -> - [W1 | Ws]; - true -> - W2 = {Pos+?STATUS_POS, <<?FREE:32>>}, - [W1,W2 | Ws] - end, - create_writes(L, NH, NWs, No, NewPos, false); -create_writes([{delete,Pos,Size} | L], H, Ws, No, Next, _) -> - {NH, _} = dets_utils:free(H, Pos, Size+?OHDSZ), - NWs = [{Pos+?STATUS_POS,<<?FREE:32>>} | Ws], - create_writes(L, NH, NWs, No-1, Next, false); -create_writes([], H, Ws, No, _Next, _NextIsOld) -> - {H, Ws, No}. - -create_inserts(0, H, Ws, Next, _Size, _Bin) -> - {H, Ws, Next}; -create_inserts(N, H, Ws, Next, Size, Bin) -> - {NH, Pos, _} = dets_utils:alloc(H, ?OHDSZ + Size), - W = {Pos, [<<Next:32, Size:32, ?ACTIVE:32>>, Bin]}, - create_inserts(N-1, NH, [W | Ws], Pos, Size, Bin). - -slot_position(S) -> - Pos = ?SEGADDR(?SLOT2SEG(S)), - Segment = get_segp(Pos), - FinalPos = Segment + (4 * ?REM2(S, ?SEGSZ)), - {FinalPos, 4}. - -%% Twice the size of a segment due to the bug in sz2pos/1. Inlined. -actual_seg_size() -> - ?POW(sz2pos(?SEGSZ*4)-1). - -segp_cache(Pos, Segment) -> - put(Pos, Segment). - -%% Inlined. -get_segp(Pos) -> - get(Pos). - -%% Bug: If Sz0 is equal to 2**k for some k, then 2**(k+1) bytes are -%% allocated (wasting 2**k bytes). -sz2pos(N) -> - 1 + dets_utils:log2(N+1). - -scan_objs(_Head, Bin, From, To, L, Ts, R, _Type) -> - scan_objs(Bin, From, To, L, Ts, R). - -scan_objs(Bin, From, To, L, Ts, -1) -> - {stop, Bin, From, To, L, Ts}; -scan_objs(B = <<_N:32, Sz:32, St:32, T/binary>>, From, To, L, Ts, R) -> - if - St =:= ?ACTIVE; - St =:= ?FREE -> % deleted after scanning started - case T of - <<BinTerm:Sz/binary, T2/binary>> -> - NTs = [BinTerm | Ts], - OSz = Sz + ?OHDSZ, - Skip = ?POW(sz2pos(OSz)-1) - OSz, - F2 = From + OSz, - NR = if - R < 0 -> - R + 1; - true -> - R + OSz + Skip - end, - scan_skip(T2, F2, To, Skip, L, NTs, NR); - _ -> - {more, From, To, L, Ts, R, Sz+?OHDSZ} - end; - true -> % a segment - scan_skip(B, From, To, actual_seg_size(), L, Ts, R) - end; -scan_objs(_B, From, To, L, Ts, R) -> - {more, From, To, L, Ts, R, 0}. - -scan_skip(Bin, From, To, Skip, L, Ts, R) when From + Skip < To -> - SkipPos = From + Skip, - case Bin of - <<_:Skip/binary, Tail/binary>> -> - scan_objs(Tail, SkipPos, To, L, Ts, R); - _ -> - {more, SkipPos, To, L, Ts, R, 0} - end; -scan_skip(Bin, From, To, Skip, L, Ts, R) when From + Skip =:= To -> - scan_next_allocated(Bin, From, To, L, Ts, R); -scan_skip(_Bin, From, _To, Skip, L, Ts, R) -> % when From + Skip > _To - From1 = From + Skip, - {more, From1, From1, L, Ts, R, 0}. - -scan_next_allocated(_Bin, _From, To, <<>>=L, Ts, R) -> - {more, To, To, L, Ts, R, 0}; -scan_next_allocated(Bin, From0, _To, <<From:32, To:32, L/binary>>, Ts, R) -> - Skip = From - From0, - scan_skip(Bin, From0, To, Skip, L, Ts, R). - -%% Read term from file at position Pos -prterm(Head, Pos, ReadAhead) -> - Res = dets_utils:pread(Head, Pos, ?OHDSZ, ReadAhead), - ?DEBUGF("file:pread(~tp, ~p, ?) -> ~p~n", [Head#head.filename, Pos, Res]), - {ok, <<Next:32, Sz:32, _Status:32, Bin0/binary>>} = Res, - ?DEBUGF("{Next, Sz} = ~p~n", [{Next, Sz}]), - Bin = case byte_size(Bin0) of - Actual when Actual >= Sz -> - Bin0; - _ -> - {ok, Bin1} = dets_utils:pread(Head, Pos + ?OHDSZ, Sz, 0), - Bin1 - end, - Term = binary_to_term(Bin), - {Next, Sz, Term}. - -%%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%% - -file_info(FH) -> - #fileheader{closed_properly = CP, keypos = Kp, - m = M, next = Next, n = N, version = Version, - type = Type, no_objects = NoObjects} - = FH, - if - CP =:= 0 -> - {error, not_closed}; - FH#fileheader.cookie =/= ?MAGIC -> - {error, not_a_dets_file}; - FH#fileheader.version =/= ?FILE_FORMAT_VERSION -> - {error, bad_version}; - true -> - {ok, [{closed_properly,CP},{keypos,Kp},{m, M}, - {n,N},{next,Next},{no_objects,NoObjects}, - {type,Type},{version,Version}]} - end. - -v_segments(H) -> - v_segments(H, 0). - -v_segments(_H, ?SEGARRSZ) -> - done; -v_segments(H, SegNo) -> - Seg = dets_utils:read_4(H#head.fptr, ?SEGADDR(SegNo)), - if - Seg =:= 0 -> - done; - true -> - io:format("SEGMENT ~w ", [SegNo]), - io:format("At position ~w~n", [Seg]), - v_segment(H, SegNo, Seg, 0), - v_segments(H, SegNo+1) - end. - -v_segment(_H, _, _SegPos, ?SEGSZ) -> - done; -v_segment(H, SegNo, SegPos, SegSlot) -> - Slot = SegSlot + (SegNo * ?SEGSZ), - Chain = dets_utils:read_4(H#head.fptr, SegPos + (4 * SegSlot)), - if - Chain =:= 0 -> %% don't print empty chains - true; - true -> - io:format(" <~p>~p: [",[SegPos + (4 * SegSlot), Slot]), - print_chain(H, Chain) - end, - v_segment(H, SegNo, SegPos, SegSlot+1). - -print_chain(_H, 0) -> - io:format("] \n", []); -print_chain(H, Pos) -> - {ok, _} = file:position(H#head.fptr, Pos), - case rterm(H#head.fptr) of - {ok, 0, _Sz, Term} -> - io:format("<~p>~p] \n",[Pos, Term]); - {ok, Next, _Sz, Term} -> - io:format("<~p>~p, ", [Pos, Term]), - print_chain(H, Next); - Other -> - io:format("~nERROR ~p~n", [Other]) - end. - -%% Can't be used at the bucket level!!!! -%% Only when we go down a chain -rterm(F) -> - case catch rterm2(F) of - {'EXIT', Reason} -> %% truncated DAT file - dets_utils:vformat("** dets: Corrupt or truncated dets file~n", - []), - {error, Reason}; - Other -> - Other - end. - -rterm2(F) -> - {ok, <<Next:32, Sz:32, _:32>>} = file:read(F, ?OHDSZ), - {ok, Bin} = file:read(F, Sz), - Term = binary_to_term(Bin), - {ok, Next, Sz, Term}. - - diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 6c406fc03a..3ab8f87ebf 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -24,8 +24,8 @@ -export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, - prep_table_copy/9, init_freelist/2, fsck_input/4, - bulk_input/3, output_objs/4, bchunk_init/2, + prep_table_copy/9, init_freelist/1, fsck_input/4, + bulk_input/3, output_objs/3, bchunk_init/2, try_bchunk_header/2, compact_init/3, read_bchunks/2, write_cache/1, may_grow/3, find_object/2, slot_objs/2, scan_objs/8, db_hash/2, no_slots/1, table_parameters/1]). @@ -228,8 +228,8 @@ -define(CLOSED_PROPERLY_POS, 8). -define(D_POS, 20). -%%% Dets file versions up to 8 are handled in dets_v8. This module -%%% handles version 9, introduced in R8. +%%% This module handles Dets file format version 9, introduced in +%%% Erlang/OTP R8. %%% %%% Version 9(a) tables have 256 reserved bytes in the file header, %%% all initialized to zero. @@ -249,32 +249,32 @@ -define(OHDSZ, 8). % The size of the object header, in bytes. -define(STATUS_POS, 4). % Position of the status field. --define(OHDSZ_v8, 12). % The size of the version 8 object header. - %% The size of each object is a multiple of 16. %% BUMP is used when repairing files. -define(BUMP, 16). -%%% '$hash' is the value of HASH_PARMS in R8, '$hash2' is the value in R9. +%%% '$hash' is the value of HASH_PARMS in Erlang/OTP R8, '$hash2' is +%%% the value in Erlang/OTP R9. %%% %%% The fields of the ?HASH_PARMS records are the same, but having -%%% different tags makes bchunk_init on R8 nodes reject data from R9 -%%% nodes, and vice versa. This is overkill, and due to an oversight. -%%% What should have been done in R8 was to check the hash method, not -%%% only the type of the table and the key position. R8 nodes cannot -%%% handle the phash2 method. +%%% different tags makes bchunk_init on Erlang/OTP R8 nodes reject +%%% data from Erlang/OTP R9 nodes, and vice versa. This is overkill, +%%% and due to an oversight. What should have been done in Erlang/OTP +%%% R8 was to check the hash method, not only the type of the table +%%% and the key position. Erlang/OTP R8 nodes cannot handle the phash2 +%%% method. -define(HASH_PARMS, '$hash2'). -define(BCHUNK_FORMAT_VERSION, 1). -record(?HASH_PARMS, { - file_format_version, + file_format_version, bchunk_format_version, file, type, keypos, hash_method, n,m,next, min,max, no_objects,no_keys, - no_colls % [{LogSz,NoColls}], NoColls >= 0 + no_colls :: no_colls() }). -define(ACTUAL_SEG_SIZE, (?SEGSZ*4)). @@ -364,10 +364,8 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, filename = Fname, name = Tab, cache = dets_utils:new_cache(CacheSz), - version = ?FILE_FORMAT_VERSION, bump = ?BUMP, - base = ?BASE, % to be overwritten - mod = ?MODULE + base = ?BASE % to be overwritten }, FreeListsPointer = 0, @@ -457,7 +455,7 @@ alloc_seg(Head, SegZero, SegNo, Part) -> {NewHead, InitSegment, [SegPointer]}. %% Read free lists (using a Buddy System) from file. -init_freelist(Head, true) -> +init_freelist(Head) -> Pos = Head#head.freelists_p, free_lists_from_file(Head, Pos). @@ -510,12 +508,10 @@ read_file_header(Fd, FileName) -> md5 = erlang:md5(MD5DigestedPart), trailer = FileSize + FlBase, eof = EOF, - n = N, - mod = ?MODULE}, + n = N}, {ok, Fd, FH}. -%% -> {ok, head(), ExtraInfo} | {error, Reason} (Reason lacking file name) -%% ExtraInfo = true +%% -> {ok, head()} | {error, Reason} (Reason lacking file name) check_file_header(FH, Fd) -> HashBif = code_to_hash_method(FH#fileheader.hash_method), Test = @@ -534,14 +530,14 @@ check_file_header(FH, Fd) -> HashBif =:= undefined -> {error, bad_hash_bif}; FH#fileheader.closed_properly =:= ?CLOSED_PROPERLY -> - {ok, true}; + ok; FH#fileheader.closed_properly =:= ?NOT_PROPERLY_CLOSED -> {error, not_closed}; true -> {error, not_a_dets_file} end, case Test of - {ok, ExtraInfo} -> + ok -> MaxObjSize = max_objsize(FH#fileheader.no_colls), H = #head{ m = FH#fileheader.m, @@ -563,11 +559,9 @@ check_file_header(FH, Fd) -> min_no_slots = FH#fileheader.min_no_slots, max_no_slots = FH#fileheader.max_no_slots, no_collections = FH#fileheader.no_colls, - version = ?FILE_FORMAT_VERSION, - mod = ?MODULE, bump = ?BUMP, base = FH#fileheader.fl_base}, - {ok, H, ExtraInfo}; + {ok, H}; Error -> Error end. @@ -621,7 +615,7 @@ no_segs(NoSlots) -> %%% %%% bulk_input/3. Initialization, the general case (any stream of objects). -%%% output_objs/4. Initialization (general case) and repair. +%%% output_objs/3. Initialization (general case) and repair. %%% bchunk_init/2. Initialization using bchunk. bulk_input(Head, InitFun, _Cntrs) -> @@ -678,7 +672,7 @@ bulk_objects([], _Head, Kp, Seq, L) when is_integer(Kp), is_integer(Seq) -> -define(OBJ_COUNTER, 2). -define(KEY_COUNTER, 3). -output_objs(OldV, Head, SlotNums, Cntrs) when OldV =< 9 -> +output_objs(Head, SlotNums, Cntrs) -> fun(close) -> %% Make sure that the segments are initialized in case %% init_table has been called. @@ -686,31 +680,31 @@ output_objs(OldV, Head, SlotNums, Cntrs) when OldV =< 9 -> Acc = [], % This is the only way Acc can be empty. true = ets:insert(Cntrs, {?FSCK_SEGMENT,0,[],0}), true = ets:insert(Cntrs, {?COUNTERS, 0, 0}), - Fun = output_objs2(foo, Acc, OldV, Head, Cache, Cntrs, + Fun = output_objs2(foo, Acc, Head, Cache, Cntrs, SlotNums, bar), Fun(close); ([]) -> - output_objs(OldV, Head, SlotNums, Cntrs); + output_objs(Head, SlotNums, Cntrs); (L) -> %% Information about number of objects per size is not %% relevant for version 9. It is the number of collections %% that matters. true = ets:delete_all_objects(Cntrs), true = ets:insert(Cntrs, {?COUNTERS, 0, 0}), - Es = bin2term(L, OldV, Head#head.keypos), + Es = bin2term(L, Head#head.keypos), %% The cache is a tuple indexed by the (log) size. An element %% is [BinaryObject]. Cache = ?VEMPTY, {NE, NAcc, NCache} = output_slots(Es, Head, Cache, Cntrs, 0, 0), - output_objs2(NE, NAcc, OldV, Head, NCache, Cntrs, SlotNums, 1) + output_objs2(NE, NAcc, Head, NCache, Cntrs, SlotNums, 1) end. -output_objs2(E, Acc, OldV, Head, Cache, SizeT, SlotNums, 0) -> +output_objs2(E, Acc, Head, Cache, SizeT, SlotNums, 0) -> NCache = write_all_sizes(Cache, SizeT, Head, more), %% Number of handled file_sorter chunks before writing: Max = erlang:max(1, erlang:min(tuple_size(NCache), 10)), - output_objs2(E, Acc, OldV, Head, NCache, SizeT, SlotNums, Max); -output_objs2(E, Acc, OldV, Head, Cache, SizeT, SlotNums, ChunkI) -> + output_objs2(E, Acc, Head, NCache, SizeT, SlotNums, Max); +output_objs2(E, Acc, Head, Cache, SizeT, SlotNums, ChunkI) -> fun(close) -> {_, [], Cache1} = if @@ -747,11 +741,10 @@ output_objs2(E, Acc, OldV, Head, Cache, SizeT, SlotNums, ChunkI) -> end end; (L) -> - Es = bin2term(L, OldV, Head#head.keypos), + Es = bin2term(L, Head#head.keypos), {NE, NAcc, NCache} = output_slots(E, Es, Acc, Head, Cache, SizeT, 0, 0), - output_objs2(NE, NAcc, OldV, Head, NCache, SizeT, SlotNums, - ChunkI-1) + output_objs2(NE, NAcc, Head, NCache, SizeT, SlotNums, ChunkI-1) end. %%% Compaction. @@ -1245,10 +1238,8 @@ allocate_all(Head, [{LSize,_,Data,NoCollections} | DTL], L) -> E = {LSize,Addr,Data,NoCollections}, allocate_all(NewHead, DTL, [E | L]). -bin2term(Bin, 9, Kp) -> - bin2term1(Bin, Kp, []); -bin2term(Bin, 8, Kp) -> - bin2term_v8(Bin, Kp, []). +bin2term(Bin, Kp) -> + bin2term1(Bin, Kp, []). bin2term1([<<Slot:32, Seq:32, BinTerm/binary>> | BTs], Kp, L) -> Term = binary_to_term(BinTerm), @@ -1257,13 +1248,6 @@ bin2term1([<<Slot:32, Seq:32, BinTerm/binary>> | BTs], Kp, L) -> bin2term1([], _Kp, L) -> lists:reverse(L). -bin2term_v8([<<Slot:32, BinTerm/binary>> | BTs], Kp, L) -> - Term = binary_to_term(BinTerm), - Key = element(Kp, Term), - bin2term_v8(BTs, Kp, [{Slot, Key, foo, Term, BinTerm} | L]); -bin2term_v8([], _Kp, L) -> - lists:reverse(L). - write_all_sizes({}=Cache, _SizeT, _Head, _More) -> Cache; write_all_sizes(Cache, SizeT, Head, More) -> @@ -1461,7 +1445,7 @@ temp_file(Head, SizeT, N) -> %% Does not close Fd. fsck_input(Head, Fd, Cntrs, FileHeader) -> MaxSz0 = case FileHeader#fileheader.has_md5 of - true when is_integer(FileHeader#fileheader.no_colls) -> + true when is_list(FileHeader#fileheader.no_colls) -> ?POW(max_objsize(FileHeader#fileheader.no_colls)); _ -> %% The file is not compressed, so the bucket size @@ -1485,10 +1469,10 @@ fsck_input(Head, State, Fd, MaxSz, Cntrs) -> done -> end_of_input; {done, L, _Seq} -> - R = count_input(Head, Cntrs, L), + R = count_input(L), {R, fsck_input(Head, done, Fd, MaxSz, Cntrs)}; {cont, L, Bin, Pos, Seq} -> - R = count_input(Head, Cntrs, L), + R = count_input(L), FR = fsck_objs(Bin, Head#head.keypos, Head, [], Seq), NewState = fsck_read(FR, Pos, Fd, MaxSz, Head), {R, fsck_input(Head, NewState, Fd, MaxSz, Cntrs)} @@ -1496,20 +1480,9 @@ fsck_input(Head, State, Fd, MaxSz, Cntrs) -> end. %% The ets table Cntrs is used for counting objects per size. -count_input(Head, Cntrs, L) when Head#head.version =:= 8 -> - count_input1(Cntrs, L, []); -count_input(_Head, _Cntrs, L) -> +count_input(L) -> lists:reverse(L). -count_input1(Cntrs, [[LogSz | B] | Ts], L) -> - case catch ets:update_counter(Cntrs, LogSz, 1) of - N when is_integer(N) -> ok; - _Badarg -> true = ets:insert(Cntrs, {LogSz, 1}) - end, - count_input1(Cntrs, Ts, [B | L]); -count_input1(_Cntrs, [], L) -> - L. - fsck_read(Pos, F, L, Seq) -> case file:position(F, Pos) of {ok, _} -> @@ -1564,11 +1537,6 @@ fsck_objs(Bin = <<Sz:32, Status:32, Tail/binary>>, Kp, Head, L, Seq) -> fsck_objs(Bin, _Kp, _Head, L, Seq) -> {more, Bin, 0, L, Seq}. -make_objects([{K,BT}|Os], Seq, Kp, Head, L) when Head#head.version =:= 8 -> - LogSz = dets_v8:sz2pos(byte_size(BT)+?OHDSZ_v8), - Slot = dets_v8:db_hash(K, Head), - Obj = [LogSz | <<Slot:32, LogSz:8, BT/binary>>], - make_objects(Os, Seq, Kp, Head, [Obj | L]); make_objects([{K,BT} | Os], Seq, Kp, Head, L) -> Obj = make_object(Head, K, Seq, BT), make_objects(Os, Seq+1, Kp, Head, [Obj | L]); @@ -1607,7 +1575,7 @@ do_perform_save(H) -> FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY), case dets_utils:debug_mode() of true -> - TmpHead0 = init_freelist(H1#head{fixed = false}, true), + TmpHead0 = init_freelist(H1#head{fixed = false}), TmpHead = TmpHead0#head{base = H1#head.base}, case catch dets_utils:all_allocated_as_list(TmpHead) @@ -1794,7 +1762,7 @@ table_parameters(Head) -> (E, A) -> [E | A] end, [], CL), NoColls = lists:reverse(NoColls0), - #?HASH_PARMS{file_format_version = Head#head.version, + #?HASH_PARMS{file_format_version = ?FILE_FORMAT_VERSION, bchunk_format_version = ?BCHUNK_FORMAT_VERSION, file = filename:basename(Head#head.filename), type = Head#head.type, diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index f921e28ef6..9449ba3dc2 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -38,7 +38,7 @@ %% Standard interface. -export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]). --export([fetch/2,find/2,fetch_keys/1,erase/2]). +-export([fetch/2,find/2,fetch_keys/1,erase/2,take/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). @@ -172,6 +172,27 @@ erase_key(Key, [E|Bkt0]) -> {[E|Bkt1],Dc}; erase_key(_, []) -> {[],0}. +-spec take(Key, Dict) -> {Value, Dict1} | error when + Dict :: dict(Key, Value), + Dict1 :: dict(Key, Value), + Key :: term(), + Value :: term(). + +take(Key, D0) -> + Slot = get_slot(D0, Key), + case on_bucket(fun (B0) -> take_key(Key, B0) end, D0, Slot) of + {D1,{Value,Dc}} -> + {Value, maybe_contract(D1, Dc)}; + {_,error} -> error + end. + +take_key(Key, [?kv(Key,Val)|Bkt]) -> + {Bkt,{Val,1}}; +take_key(Key, [E|Bkt0]) -> + {Bkt1,Res} = take_key(Key, Bkt0), + {[E|Bkt1],Res}; +take_key(_, []) -> {[],error}. + -spec store(Key, Value, Dict1) -> Dict2 when Dict1 :: dict(Key, Value), Dict2 :: dict(Key, Value). diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 40a34aa30f..eafee346eb 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1306,6 +1306,7 @@ partial_eval(Expr) -> ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R)); ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A)); ev_expr({integer,_,X}) -> X; +ev_expr({char,_,X}) -> X; ev_expr({float,_,X}) -> X; ev_expr({atom,_,X}) -> X; ev_expr({tuple,_,Es}) -> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 49b65069b7..1b84234fac 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -526,7 +526,7 @@ start(File, Opts) -> true, Opts)}, {export_all, bool_option(warn_export_all, nowarn_export_all, - false, Opts)}, + true, Opts)}, {export_vars, bool_option(warn_export_vars, nowarn_export_vars, false, Opts)}, diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 9cd95705af..922455a6f2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. 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. @@ -33,7 +33,6 @@ list tail list_comprehension lc_expr lc_exprs binary_comprehension tuple -%struct record_expr record_tuple record_field record_fields map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr @@ -108,9 +107,8 @@ type_sig -> fun_type 'when' type_guards : {type, ?anno('$1'), bounded_fun, type_guards -> type_guard : ['$1']. type_guards -> type_guard ',' type_guards : ['$1'|'$3']. -type_guard -> atom '(' top_types ')' : {type, ?anno('$1'), constraint, - ['$1', '$3']}. -type_guard -> var '::' top_type : build_def('$1', '$3'). +type_guard -> atom '(' top_types ')' : build_compat_constraint('$1', '$3'). +type_guard -> var '::' top_type : build_constraint('$1', '$3'). top_types -> top_type : ['$1']. top_types -> top_type ',' top_types : ['$1'|'$3']. @@ -156,6 +154,7 @@ type -> '#' atom '{' field_types '}' : {type, ?anno('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> integer : '$1'. +type -> char : '$1'. type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. @@ -268,7 +267,6 @@ expr_max -> binary : '$1'. expr_max -> list_comprehension : '$1'. expr_max -> binary_comprehension : '$1'. expr_max -> tuple : '$1'. -%%expr_max -> struct : '$1'. expr_max -> '(' expr ')' : '$2'. expr_max -> 'begin' exprs 'end' : {block,?anno('$1'),'$2'}. expr_max -> if_expr : '$1'. @@ -327,10 +325,6 @@ lc_expr -> binary '<=' expr : {b_generate,?anno('$2'),'$1','$3'}. tuple -> '{' '}' : {tuple,?anno('$1'),[]}. tuple -> '{' exprs '}' : {tuple,?anno('$1'),'$2'}. - -%%struct -> atom tuple : -%% {struct,?anno('$1'),element(3, '$1'),element(3, '$2')}. - map_expr -> '#' map_tuple : {map, ?anno('$1'),'$2'}. map_expr -> expr_max '#' map_tuple : @@ -1056,13 +1050,13 @@ build_typed_attribute({atom,Aa,Attr},_) -> end. build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs}) - when (Kind =:= spec) or (Kind =:= callback) -> + when Kind =:= spec ; Kind =:= callback -> NewSpecFun = case SpecFun of {atom, _, Fun} -> {Fun, find_arity_from_specs(TypeSpecs)}; - {{atom,_, Mod}, {atom,_, Fun}} -> - {Mod,Fun,find_arity_from_specs(TypeSpecs)} + {{atom, _, Mod}, {atom, _, Fun}} -> + {Mod, Fun, find_arity_from_specs(TypeSpecs)} end, {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}. @@ -1076,11 +1070,24 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). -build_def({var, A, '_'}, _Types) -> +%% The 'is_subtype(V, T)' syntax is not supported as of Erlang/OTP +%% 19.0, but is kept for backward compatibility. +build_compat_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) -> + build_constraint(LHS, Type); +build_compat_constraint({atom, _, is_subtype}, [LHS, _Type]) -> + ret_err(?anno(LHS), "bad type variable"); +build_compat_constraint({atom, A, Atom}, _Types) -> + ret_err(A, io_lib:format("unsupported constraint ~w", [Atom])). + +build_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) -> + build_constraint(LHS, Type); +build_constraint({atom, A, Atom}, _Foo) -> + ret_err(A, io_lib:format("unsupported constraint ~w", [Atom])); +build_constraint({var, A, '_'}, _Types) -> ret_err(A, "bad type variable"); -build_def(LHS, Types) -> +build_constraint(LHS, Type) -> IsSubType = {atom, ?anno(LHS), is_subtype}, - {type, ?anno(LHS), constraint, [IsSubType, [LHS, Types]]}. + {type, ?anno(LHS), constraint, [IsSubType, [LHS, Type]]}. lift_unions(T1, {type, _Aa, union, List}) -> {type, ?anno(T1), union, [T1|List]}; @@ -1573,13 +1580,17 @@ new_anno(Term) -> Abstr :: erl_parse_tree(). anno_to_term(Abstract) -> - map_anno(fun erl_anno:to_term/1, Abstract). + F = fun(Anno, Acc) -> {erl_anno:to_term(Anno), Acc} end, + {NewAbstract, []} = modify_anno1(Abstract, [], F), + NewAbstract. -spec anno_from_term(Term) -> erl_parse_tree() when Term :: term(). anno_from_term(Term) -> - map_anno(fun erl_anno:from_term/1, Term). + F = fun(T, Acc) -> {erl_anno:from_term(T), Acc} end, + {NewTerm, []} = modify_anno1(Term, [], F), + NewTerm. %% Forms. modify_anno1({function,F,A}, Ac, _Mf) -> diff --git a/lib/stdlib/src/error_logger_file_h.erl b/lib/stdlib/src/error_logger_file_h.erl index 665685d3ee..0b262de3ab 100644 --- a/lib/stdlib/src/error_logger_file_h.erl +++ b/lib/stdlib/src/error_logger_file_h.erl @@ -116,8 +116,8 @@ write_event(#st{fd=Fd}=State, Event) -> ignore -> ok; {Head,Pid,FormatList} -> - Time = maybe_utc(erlang:universaltime()), - Header = write_time(Time, Head), + Time = erlang:universaltime(), + Header = header(Time, Head), Body = format_body(State, FormatList), AtNode = if node(Pid) =/= node() -> @@ -125,7 +125,7 @@ write_event(#st{fd=Fd}=State, Event) -> true -> [] end, - io:put_chars(Fd, [Header,Body,AtNode]) + io:put_chars(Fd, [Header,AtNode,Body]) end. format_body(State, [{Format,Args}|T]) -> @@ -172,21 +172,6 @@ parse_event({warning_report, _GL, {Pid, std_warning, Args}}) -> {"WARNING REPORT",Pid,format_term(Args)}; parse_event(_) -> ignore. -maybe_utc(Time) -> - UTC = case application:get_env(sasl, utc_log) of - {ok, Val} -> Val; - undefined -> - %% Backwards compatible: - case application:get_env(stdlib, utc_log) of - {ok, Val} -> Val; - undefined -> false - end - end, - maybe_utc(Time, UTC). - -maybe_utc(Time, true) -> {utc, Time}; -maybe_utc(Time, _) -> {local, calendar:universal_time_to_local_time(Time)}. - format_term(Term) when is_list(Term) -> case string_p(Term) of true -> @@ -227,17 +212,33 @@ string_p1([H|T]) when is_list(H) -> string_p1([]) -> true; string_p1(_) -> false. -write_time({utc,{{Y,Mo,D},{H,Mi,S}}}, Type) -> - io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n", - [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]); -write_time({local, {{Y,Mo,D},{H,Mi,S}}}, Type) -> - io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ===~n", - [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]). +get_utc_config() -> + %% SASL utc_log configuration overrides stdlib config + %% in order to have uniform timestamps in log messages + case application:get_env(sasl, utc_log) of + {ok, Val} -> Val; + undefined -> + case application:get_env(stdlib, utc_log) of + {ok, Val} -> Val; + undefined -> false + end + end. + +header(Time, Title) -> + case get_utc_config() of + true -> + header(Time, Title, "UTC "); + _ -> + header(calendar:universal_time_to_local_time(Time), Title, "") + end. + +header({{Y,Mo,D},{H,Mi,S}}, Title, UTC) -> + io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ~s===~n", + [Title,D,month(Mo),Y,t(H),t(Mi),t(S),UTC]). t(X) when is_integer(X) -> - t1(integer_to_list(X)); -t(_) -> - "". + t1(integer_to_list(X)). + t1([X]) -> [$0,X]; t1(X) -> X. @@ -253,5 +254,3 @@ month(9) -> "Sep"; month(10) -> "Oct"; month(11) -> "Nov"; month(12) -> "Dec". - - diff --git a/lib/stdlib/src/error_logger_tty_h.erl b/lib/stdlib/src/error_logger_tty_h.erl index cb22a8c0b6..2f2fd65252 100644 --- a/lib/stdlib/src/error_logger_tty_h.erl +++ b/lib/stdlib/src/error_logger_tty_h.erl @@ -128,13 +128,12 @@ write_events(State, [Ev|Es]) -> write_events(_State, []) -> ok. -do_write_event(State, {Time0, Event}) -> +do_write_event(State, {Time, Event}) -> case parse_event(Event) of ignore -> ok; - {Head,Pid,FormatList} -> - Time = maybe_utc(Time0), - Header = write_time(Time, Head), + {Title,Pid,FormatList} -> + Header = header(Time, Title), Body = format_body(State, FormatList), AtNode = if node(Pid) =/= node() -> @@ -142,7 +141,7 @@ do_write_event(State, {Time0, Event}) -> true -> [] end, - Str = [Header,Body,AtNode], + Str = [Header,AtNode,Body], case State#st.io_mod of io_lib -> Str; @@ -197,21 +196,6 @@ parse_event({warning_report, _GL, {Pid, std_warning, Args}}) -> {"WARNING REPORT",Pid,format_term(Args)}; parse_event(_) -> ignore. -maybe_utc(Time) -> - UTC = case application:get_env(sasl, utc_log) of - {ok, Val} -> Val; - undefined -> - %% Backwards compatible: - case application:get_env(stdlib, utc_log) of - {ok, Val} -> Val; - undefined -> false - end - end, - maybe_utc(Time, UTC). - -maybe_utc(Time, true) -> {utc, Time}; -maybe_utc(Time, _) -> {local, calendar:universal_time_to_local_time(Time)}. - format_term(Term) when is_list(Term) -> case string_p(Term) of true -> @@ -255,12 +239,29 @@ string_p1([H|T]) when is_list(H) -> string_p1([]) -> true; string_p1(_) -> false. -write_time({utc,{{Y,Mo,D},{H,Mi,S}}},Type) -> - io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n", - [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]); -write_time({local, {{Y,Mo,D},{H,Mi,S}}},Type) -> - io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ===~n", - [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]). +get_utc_config() -> + %% SASL utc_log configuration overrides stdlib config + %% in order to have uniform timestamps in log messages + case application:get_env(sasl, utc_log) of + {ok, Val} -> Val; + undefined -> + case application:get_env(stdlib, utc_log) of + {ok, Val} -> Val; + undefined -> false + end + end. + +header(Time, Title) -> + case get_utc_config() of + true -> + header(Time, Title, "UTC "); + _ -> + header(calendar:universal_time_to_local_time(Time), Title, "") + end. + +header({{Y,Mo,D},{H,Mi,S}}, Title, UTC) -> + io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ~s===~n", + [Title,D,month(Mo),Y,t(H),t(Mi),t(S),UTC]). t(X) when is_integer(X) -> t1(integer_to_list(X)); @@ -281,8 +282,3 @@ month(9) -> "Sep"; month(10) -> "Oct"; month(11) -> "Nov"; month(12) -> "Dec". - - - - - diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index f53b0e2246..c42ae981e7 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. @@ -481,46 +481,49 @@ find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) -> %% Look for special comment on second line Line2 = get_line(Fd), {ok, HeaderSz2} = file:position(Fd, cur), - case classify_line(Line2) of - emu_args -> - %% Skip special comment on second line - Line3 = get_line(Fd), - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = undefined, - emu_args = Line2}}; - Line2Type -> - %% Look for special comment on third line - Line3 = get_line(Fd), - {ok, HeaderSz3} = file:position(Fd, cur), - Line3Type = classify_line(Line3), - if - Line3Type =:= emu_args -> - %% Skip special comment on third line - Line4 = get_line(Fd), - {HeaderSz3, LineNo + 3, Fd, - Sections#sections{type = guess_type(Line4), - comment = Line2, - emu_args = Line3}}; - Sections#sections.shebang =:= undefined, - KeepFirst =:= true -> - %% No shebang. Use the entire file - {HeaderSz0, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Sections#sections.shebang =:= undefined -> - %% No shebang. Skip the first line - {HeaderSz1, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Line2Type =:= comment -> - %% Skip shebang on first line and comment on second - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = Line2}}; - true -> - %% Just skip shebang on first line - {HeaderSz1, LineNo + 1, Fd, - Sections#sections{type = guess_type(Line2)}} - end + if + Sections#sections.shebang =:= undefined, + KeepFirst =:= true -> + %% No shebang. Use the entire file + {HeaderSz0, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Sections#sections.shebang =:= undefined -> + %% No shebang. Skip the first line + {HeaderSz1, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + true -> + case classify_line(Line2) of + emu_args -> + %% Skip special comment on second line + Line3 = get_line(Fd), + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = undefined, + emu_args = Line2}}; + comment -> + %% Look for special comment on third line + Line3 = get_line(Fd), + {ok, HeaderSz3} = file:position(Fd, cur), + Line3Type = classify_line(Line3), + if + Line3Type =:= emu_args -> + %% Skip special comment on third line + Line4 = get_line(Fd), + {HeaderSz3, LineNo + 3, Fd, + Sections#sections{type = guess_type(Line4), + comment = Line2, + emu_args = Line3}}; + true -> + %% Skip shebang on first line and comment on second + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = Line2}} + end; + _ -> + %% Just skip shebang on first line + {HeaderSz1, LineNo + 1, Fd, + Sections#sections{type = guess_type(Line2)}} + end end. classify_line(Line) -> diff --git a/lib/stdlib/src/gb_trees.erl b/lib/stdlib/src/gb_trees.erl index 457287fa52..c0cdde012e 100644 --- a/lib/stdlib/src/gb_trees.erl +++ b/lib/stdlib/src/gb_trees.erl @@ -52,6 +52,13 @@ %% - delete_any(X, T): removes key X from tree T if the key is present %% in the tree, otherwise does nothing; returns new tree. %% +%% - take(X, T): removes element with key X from tree T; returns new tree +%% without removed element. Assumes that the key is present in the tree. +%% +%% - take_any(X, T): removes element with key X from tree T and returns +%% a new tree if the key is present; otherwise does nothing and returns +%% 'error'. +%% %% - balance(T): rebalances tree T. Note that this is rarely necessary, %% but may be motivated when a large number of entries have been %% deleted from the tree without further insertions. Rebalancing could @@ -114,7 +121,8 @@ -export([empty/0, is_empty/1, size/1, lookup/2, get/2, insert/3, update/3, enter/3, delete/2, delete_any/2, balance/1, is_defined/2, keys/1, values/1, to_list/1, from_orddict/1, - smallest/1, largest/1, take_smallest/1, take_largest/1, + smallest/1, largest/1, take/2, take_any/2, + take_smallest/1, take_largest/1, iterator/1, iterator_from/2, next/1, map/2]). @@ -416,6 +424,41 @@ merge(Smaller, Larger) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec take_any(Key, Tree1) -> {Value, Tree2} | 'error' when + Tree1 :: tree(Key, _), + Tree2 :: tree(Key, _), + Key :: term(), + Value :: term(). + +take_any(Key, Tree) -> + case is_defined(Key, Tree) of + true -> take(Key, Tree); + false -> error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-spec take(Key, Tree1) -> {Value, Tree2} when + Tree1 :: tree(Key, _), + Tree2 :: tree(Key, _), + Key :: term(), + Value :: term(). + +take(Key, {S, T}) when is_integer(S), S >= 0 -> + {Value, Res} = take_1(Key, T), + {Value, {S - 1, Res}}. + +take_1(Key, {Key1, Value, Smaller, Larger}) when Key < Key1 -> + {Value2, Smaller1} = take_1(Key, Smaller), + {Value2, {Key1, Value, Smaller1, Larger}}; +take_1(Key, {Key1, Value, Smaller, Bigger}) when Key > Key1 -> + {Value2, Bigger1} = take_1(Key, Bigger), + {Value2, {Key1, Value, Smaller, Bigger1}}; +take_1(_, {_Key, Value, Smaller, Larger}) -> + {Value, merge(Smaller, Larger)}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + -spec take_smallest(Tree1) -> {Key, Value, Tree2} when Tree1 :: tree(Key, Value), Tree2 :: tree(Key, Value). diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index ccacf658e9..4839fe4f2c 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -32,7 +32,9 @@ %%% Modified by Martin - uses proc_lib, sys and gen! --export([start/0, start/1, start_link/0, start_link/1, stop/1, stop/3, +-export([start/0, start/1, start/2, + start_link/0, start_link/1, start_link/2, + stop/1, stop/3, notify/2, sync_notify/2, add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). @@ -117,30 +119,64 @@ -type del_handler_ret() :: ok | term() | {'EXIT',term()}. -type emgr_name() :: {'local', atom()} | {'global', atom()} - | {'via', atom(), term()}. + | {'via', atom(), term()}. +-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug' + | {'logfile', string()}. +-type option() :: {'timeout', timeout()} + | {'debug', [debug_flag()]} + | {'spawn_opt', [proc_lib:spawn_option()]}. -type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} - | {'via', atom(), term()} | pid(). + | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. %%--------------------------------------------------------------------------- -define(NO_CALLBACK, 'no callback module'). +%% ----------------------------------------------------------------- +%% Starts a generic event handler. +%% start() +%% start(MgrName | Options) +%% start(MgrName, Options) +%% start_link() +%% start_link(MgrName | Options) +%% start_link(MgrName, Options) +%% MgrName ::= {local, atom()} | {global, atom()} | {via, atom(), term()} +%% Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}] +%% Flag ::= trace | log | {logfile, File} | statistics | debug +%% (debug == log && statistics) +%% Returns: {ok, Pid} | +%% {error, {already_started, Pid}} | +%% {error, Reason} +%% ----------------------------------------------------------------- + -spec start() -> start_ret(). start() -> gen:start(?MODULE, nolink, ?NO_CALLBACK, [], []). --spec start(emgr_name()) -> start_ret(). -start(Name) -> - gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []). +-spec start(emgr_name() | [option()]) -> start_ret(). +start(Name) when is_tuple(Name) -> + gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []); +start(Options) when is_list(Options) -> + gen:start(?MODULE, nolink, ?NO_CALLBACK, [], Options). + +-spec start(emgr_name(), [option()]) -> start_ret(). +start(Name, Options) -> + gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], Options). -spec start_link() -> start_ret(). start_link() -> gen:start(?MODULE, link, ?NO_CALLBACK, [], []). --spec start_link(emgr_name()) -> start_ret(). -start_link(Name) -> - gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []). +-spec start_link(emgr_name() | [option()]) -> start_ret(). +start_link(Name) when is_tuple(Name) -> + gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []); +start_link(Options) when is_list(Options) -> + gen:start(?MODULE, link, ?NO_CALLBACK, [], Options). + +-spec start_link(emgr_name(), [option()]) -> start_ret(). +start_link(Name, Options) -> + gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], Options). %% -spec init_it(pid(), 'self' | pid(), emgr_name(), module(), [term()], [_]) -> init_it(Starter, self, Name, Mod, Args, Options) -> @@ -160,7 +196,7 @@ add_sup_handler(M, Handler, Args) -> rpc(M, {add_sup_handler, Handler, Args, self()}). -spec notify(emgr_ref(), term()) -> 'ok'. -notify(M, Event) -> send(M, {notify, Event}). +notify(M, Event) -> send(M, {notify, Event}). -spec sync_notify(emgr_ref(), term()) -> 'ok'. sync_notify(M, Event) -> rpc(M, {sync_notify, Event}). @@ -193,7 +229,7 @@ stop(M) -> stop(M, Reason, Timeout) -> gen:stop(M, Reason, Timeout). -rpc(M, Cmd) -> +rpc(M, Cmd) -> {ok, Reply} = gen:call(M, self(), Cmd, infinity), Reply. @@ -421,7 +457,7 @@ server_add_handler({Mod,Id}, Args, MSL) -> Handler = #handler{module = Mod, id = Id}, server_add_handler(Mod, Handler, Args, MSL); -server_add_handler(Mod, Args, MSL) -> +server_add_handler(Mod, Args, MSL) -> Handler = #handler{module = Mod}, server_add_handler(Mod, Handler, Args, MSL). @@ -446,7 +482,7 @@ server_add_sup_handler({Mod,Id}, Args, MSL, Parent) -> id = Id, supervised = Parent}, server_add_handler(Mod, Handler, Args, MSL); -server_add_sup_handler(Mod, Args, MSL, Parent) -> +server_add_sup_handler(Mod, Args, MSL, Parent) -> link(Parent), Handler = #handler{module = Mod, supervised = Parent}, @@ -454,7 +490,7 @@ server_add_sup_handler(Mod, Args, MSL, Parent) -> %% server_delete_handler(HandlerId, Args, MSL) -> {Ret, MSL'} -server_delete_handler(HandlerId, Args, MSL, SName) -> +server_delete_handler(HandlerId, Args, MSL, SName) -> case split(HandlerId, MSL) of {Mod, Handler, MSL1} -> {do_terminate(Mod, Handler, Args, @@ -511,7 +547,7 @@ split_and_terminate(HandlerId, Args, MSL, SName, Handler2, Sup) -> %% server_notify(Event, Func, MSL, SName) -> MSL' -server_notify(Event, Func, [Handler|T], SName) -> +server_notify(Event, Func, [Handler|T], SName) -> case server_update(Handler, Func, Event, SName) of {ok, Handler1} -> {Hib, NewHandlers} = server_notify(Event, Func, T, SName), @@ -531,9 +567,9 @@ server_update(Handler1, Func, Event, SName) -> Mod1 = Handler1#handler.module, State = Handler1#handler.state, case catch Mod1:Func(Event, State) of - {ok, State1} -> + {ok, State1} -> {ok, Handler1#handler{state = State1}}; - {ok, State1, hibernate} -> + {ok, State1, hibernate} -> {hibernate, Handler1#handler{state = State1}}; {swap_handler, Args1, State1, Handler2, Args2} -> do_swap(Mod1, Handler1, Args1, State1, Handler2, Args2, SName); @@ -644,14 +680,14 @@ server_call_update(Handler1, Query, SName) -> Mod1 = Handler1#handler.module, State = Handler1#handler.state, case catch Mod1:handle_call(Query, State) of - {ok, Reply, State1} -> + {ok, Reply, State1} -> {{ok, Handler1#handler{state = State1}}, Reply}; - {ok, Reply, State1, hibernate} -> - {{hibernate, Handler1#handler{state = State1}}, + {ok, Reply, State1, hibernate} -> + {{hibernate, Handler1#handler{state = State1}}, Reply}; {swap_handler, Reply, Args1, State1, Handler2, Args2} -> {do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName), Reply}; - {remove_handler, Reply} -> + {remove_handler, Reply} -> do_terminate(Mod1, Handler1, remove_handler, State, remove, SName, normal), {no, Reply}; @@ -686,7 +722,7 @@ report_error(_Handler, normal, _, _, _) -> ok; report_error(_Handler, shutdown, _, _, _) -> ok; report_error(_Handler, {swapped,_,_}, _, _, _) -> ok; report_error(Handler, Reason, State, LastIn, SName) -> - Reason1 = + Reason1 = case Reason of {'EXIT',{undef,[{M,F,A,L}|MFAs]}} -> case code:is_loaded(M) of diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 5800aca66f..284810c971 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -386,7 +386,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, [Name, State, Mod, Time], Hib); {'EXIT', Parent, Reason} -> - terminate(Reason, Name, Msg, Mod, State, Debug); + terminate(Reason, Name, undefined, Msg, Mod, State, Debug); _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, State, Mod); _Msg -> @@ -658,14 +658,14 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod) -> loop(Parent, Name, NState, Mod, Time1, []); {ok, {stop, Reason, Reply, NState}} -> {'EXIT', R} = - (catch terminate(Reason, Name, Msg, Mod, NState, [])), + (catch terminate(Reason, Name, From, Msg, Mod, NState, [])), reply(From, Reply), exit(R); - Other -> handle_common_reply(Other, Parent, Name, Msg, Mod, State) + Other -> handle_common_reply(Other, Parent, Name, From, Msg, Mod, State) end; handle_msg(Msg, Parent, Name, State, Mod) -> Reply = try_dispatch(Msg, Mod, State), - handle_common_reply(Reply, Parent, Name, Msg, Mod, State). + handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, State). handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> Result = try_handle_call(Mod, Msg, From, State), @@ -686,31 +686,31 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> loop(Parent, Name, NState, Mod, Time1, Debug1); {ok, {stop, Reason, Reply, NState}} -> {'EXIT', R} = - (catch terminate(Reason, Name, Msg, Mod, NState, Debug)), + (catch terminate(Reason, Name, From, Msg, Mod, NState, Debug)), _ = reply(Name, From, Reply, NState, Debug), exit(R); Other -> - handle_common_reply(Other, Parent, Name, Msg, Mod, State, Debug) + handle_common_reply(Other, Parent, Name, From, Msg, Mod, State, Debug) end; handle_msg(Msg, Parent, Name, State, Mod, Debug) -> Reply = try_dispatch(Msg, Mod, State), - handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug). + handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, State, Debug). -handle_common_reply(Reply, Parent, Name, Msg, Mod, State) -> +handle_common_reply(Reply, Parent, Name, From, Msg, Mod, State) -> case Reply of {ok, {noreply, NState}} -> loop(Parent, Name, NState, Mod, infinity, []); {ok, {noreply, NState, Time1}} -> loop(Parent, Name, NState, Mod, Time1, []); {ok, {stop, Reason, NState}} -> - terminate(Reason, Name, Msg, Mod, NState, []); + terminate(Reason, Name, From, Msg, Mod, NState, []); {'EXIT', ExitReason, ReportReason} -> - terminate(ExitReason, ReportReason, Name, Msg, Mod, State, []); + terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, []); {ok, BadReply} -> - terminate({bad_return_value, BadReply}, Name, Msg, Mod, State, []) + terminate({bad_return_value, BadReply}, Name, From, Msg, Mod, State, []) end. -handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) -> +handle_common_reply(Reply, Parent, Name, From, Msg, Mod, State, Debug) -> case Reply of {ok, {noreply, NState}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, @@ -721,11 +721,11 @@ handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) -> {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); {ok, {stop, Reason, NState}} -> - terminate(Reason, Name, Msg, Mod, NState, Debug); + terminate(Reason, Name, From, Msg, Mod, NState, Debug); {'EXIT', ExitReason, ReportReason} -> - terminate(ExitReason, ReportReason, Name, Msg, Mod, State, Debug); + terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, Debug); {ok, BadReply} -> - terminate({bad_return_value, BadReply}, Name, Msg, Mod, State, Debug) + terminate({bad_return_value, BadReply}, Name, From, Msg, Mod, State, Debug) end. reply(Name, {To, Tag}, Reply, State, Debug) -> @@ -743,7 +743,7 @@ system_continue(Parent, Debug, [Name, State, Mod, Time]) -> -spec system_terminate(_, _, _, [_]) -> no_return(). system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time]) -> - terminate(Reason, Name, [], Mod, State, Debug). + terminate(Reason, Name, undefined, [], Mod, State, Debug). system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> case catch Mod:code_change(OldVsn, State, Extra) of @@ -786,17 +786,17 @@ print_event(Dev, Event, Name) -> %%% Terminate the server. %%% --------------------------------------------------- --spec terminate(_, _, _, _, _, _) -> no_return(). -terminate(Reason, Name, Msg, Mod, State, Debug) -> - terminate(Reason, Reason, Name, Msg, Mod, State, Debug). - -spec terminate(_, _, _, _, _, _, _) -> no_return(). -terminate(ExitReason, ReportReason, Name, Msg, Mod, State, Debug) -> +terminate(Reason, Name, From, Msg, Mod, State, Debug) -> + terminate(Reason, Reason, Name, From, Msg, Mod, State, Debug). + +-spec terminate(_, _, _, _, _, _, _, _) -> no_return(). +terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, Debug) -> Reply = try_terminate(Mod, ExitReason, State), case Reply of {'EXIT', ExitReason1, ReportReason1} -> FmtState = format_status(terminate, Mod, get(), State), - error_info(ReportReason1, Name, Msg, FmtState, Debug), + error_info(ReportReason1, Name, From, Msg, FmtState, Debug), exit(ExitReason1); _ -> case ExitReason of @@ -808,17 +808,17 @@ terminate(ExitReason, ReportReason, Name, Msg, Mod, State, Debug) -> exit(Shutdown); _ -> FmtState = format_status(terminate, Mod, get(), State), - error_info(ReportReason, Name, Msg, FmtState, Debug), + error_info(ReportReason, Name, From, Msg, FmtState, Debug), exit(ExitReason) end end. -error_info(_Reason, application_controller, _Msg, _State, _Debug) -> +error_info(_Reason, application_controller, _From, _Msg, _State, _Debug) -> %% OTP-5811 Don't send an error report if it's the system process %% application_controller which is terminating - let init take care %% of it instead ok; -error_info(Reason, Name, Msg, State, Debug) -> +error_info(Reason, Name, From, Msg, State, Debug) -> Reason1 = case Reason of {undef,[{M,F,A,L}|MFAs]} -> @@ -835,15 +835,36 @@ error_info(Reason, Name, Msg, State, Debug) -> end; _ -> Reason - end, + end, + {ClientFmt, ClientArgs} = client_stacktrace(From), format("** Generic server ~p terminating \n" "** Last message in was ~p~n" "** When Server state == ~p~n" - "** Reason for termination == ~n** ~p~n", - [Name, Msg, State, Reason1]), + "** Reason for termination == ~n** ~p~n" ++ ClientFmt, + [Name, Msg, State, Reason1] ++ ClientArgs), sys:print_log(Debug), ok. +client_stacktrace(undefined) -> + {"", []}; +client_stacktrace({From, _Tag}) -> + client_stacktrace(From); +client_stacktrace(From) when is_pid(From), node(From) =:= node() -> + case process_info(From, [current_stacktrace, registered_name]) of + undefined -> + {"** Client ~p is dead~n", [From]}; + [{current_stacktrace, Stacktrace}, {registered_name, []}] -> + {"** Client ~p stacktrace~n" + "** ~p~n", + [From, Stacktrace]}; + [{current_stacktrace, Stacktrace}, {registered_name, Name}] -> + {"** Client ~p stacktrace~n" + "** ~p~n", + [Name, Stacktrace]} + end; +client_stacktrace(From) when is_pid(From) -> + {"** Client ~p is remote on node ~p~n", [From, node(From)]}. + %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 1da866dc88..c7b75961cb 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -343,7 +343,8 @@ term(T, F, Adj, P0, Pad) -> %% print(Term, Depth, Field, Adjust, Precision, PadChar, Encoding, %% Indentation) -%% Print a term. +%% Print a term. Field width sets maximum line length, Precision sets +%% initial indentation. print(T, D, none, Adj, P, Pad, E, Str, I) -> print(T, D, 80, Adj, P, Pad, E, Str, I); diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 16ca2f41dc..94376408d1 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -97,31 +97,42 @@ print(Term, Col, Ll, D, RecDefFun) -> print(Term, Col, Ll, D, M, RecDefFun) -> print(Term, Col, Ll, D, M, RecDefFun, latin1, true). +%% D = Depth, default -1 (infinite), or LINEMAX=30 when printing from shell +%% Col = current column, default 1 +%% Ll = line length/~p field width, default 80 +%% M = CHAR_MAX (-1 if no max, 60 when printing from shell) print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "..."; print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> + %% ensure Col is at least 1 print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); is_list(Term); is_map(Term); is_bitstring(Term) -> + %% preprocess and compute total number of chars If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str), + %% use Len as CHAR_MAX if M0 = -1 M = max_cs(M0, Len), if Len < Ll - Col, Len =< M -> + %% write the whole thing on a single line when there is room write(If); true -> + %% compute the indentation TInd for tagged tuples and records TInd = while_fail([-1, 4], fun(I) -> cind(If, Col, Ll, M, I, 0, 0) end, 1), pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) end; print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) -> + %% atomic data types (bignums, atoms, ...) are never truncated io_lib:write(Term). %%% %%% Local functions %%% +%% use M only if nonnegative, otherwise use Len as default value max_cs(M, Len) when M < 0 -> Len; max_cs(M, _Len) -> @@ -153,6 +164,7 @@ pp({S, _Len}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> %% Print a tagged tuple by indenting the rest of the elements %% differently to the tag. Tuple has size >= 2. pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) -> + %% this uses TInd TagInd = Tlen + 2, Tcol = Col + TagInd, S = $,, @@ -207,6 +219,7 @@ pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) -> {[Name, " = ", S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl rec_indent(RInd, TInd, Col0, Ind0, W0) -> + %% this uses TInd Nl = (TInd > 0) and (RInd > TInd), DCol = case Nl of true -> TInd; @@ -285,6 +298,7 @@ pp_binary(S, N, _N0, Ind) -> S end. +%% write the whole thing on a single line write({{tuple, _IsTagged, L}, _}) -> [${, write_list(L, $,), $}]; write({{list, L}, _}) -> @@ -344,8 +358,10 @@ print_length({}, _D, _RF, _Enc, _Str) -> print_length(#{}=M, _D, _RF, _Enc, _Str) when map_size(M) =:= 0 -> {"#{}", 3}; print_length(List, D, RF, Enc, Str) when is_list(List) -> + %% only flat lists are "printable" case Str andalso printable_list(List, D, Enc) of true -> + %% print as string, escaping double-quotes in the list S = write_string(List, Enc), {S, length(S)}; %% Truncated lists could break some existing code. @@ -401,6 +417,7 @@ print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) -> end; print_length(Term, _D, _RF, _Enc, _Str) -> S = io_lib:write(Term), + %% S can contain unicode, so iolist_size(S) cannot be used here {S, lists:flatlength(S)}. print_length_map(_Map, 1, _RF, _Enc, _Str) -> @@ -483,6 +500,7 @@ list_length_tail({_, Len}, Acc) -> %% ?CHARS printable characters has depth 1. -define(CHARS, 4). +%% only flat lists are "printable" printable_list(_L, 1, _Enc) -> false; printable_list(L, _D, latin1) -> @@ -736,9 +754,11 @@ while_fail([], _F, V) -> while_fail([A | As], F, V) -> try F(A) catch _ -> while_fail(As, F, V) end. +%% make a string of N spaces indent(N) when is_integer(N), N > 0 -> chars($\s, N-1). +%% prepend N spaces onto Ind indent(1, Ind) -> % Optimization of common case [$\s | Ind]; indent(4, Ind) -> % Optimization of common case diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl index 37cf0084f0..caa59099af 100644 --- a/lib/stdlib/src/orddict.erl +++ b/lib/stdlib/src/orddict.erl @@ -22,7 +22,7 @@ %% Standard interface. -export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]). --export([fetch/2,find/2,fetch_keys/1,erase/2]). +-export([fetch/2,find/2,fetch_keys/1,erase/2,take/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). @@ -106,6 +106,23 @@ erase(Key, [{K,_}=E|Dict]) when Key > K -> erase(_Key, [{_K,_Val}|Dict]) -> Dict; %Key == K erase(_, []) -> []. +-spec take(Key, Orddict) -> {Value, Orddict1} | error when + Orddict :: orddict(Key, Value), + Orddict1 :: orddict(Key, Value), + Key :: term(), + Value :: term(). + +take(Key, Dict) -> + take_1(Key, Dict, []). + +take_1(Key, [{K,_}|_], _Acc) when Key < K -> + error; +take_1(Key, [{K,_}=P|D], Acc) when Key > K -> + take_1(Key, D, [P|Acc]); +take_1(_Key, [{_K,Value}|D], Acc) -> + {Value,lists:reverse(Acc, D)}; +take_1(_, [], _) -> error. + -spec store(Key, Value, Orddict1) -> Orddict2 when Orddict1 :: orddict(Key, Value), Orddict2 :: orddict(Key, Value). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 4161ced9ab..f4257fb571 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -408,7 +408,7 @@ obsolete_1(docb_xml_check, _, _) -> %% Added in R15B obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> - {deprecated,"deprecated (will be removed in OTP 18); has no effect as drivers are no longer used"}; + {removed,"removed (will be removed in OTP 18); has no effect as drivers are no longer used"}; obsolete_1(ssl, pid, 1) -> {removed,"was removed in R16; is no longer needed"}; obsolete_1(inviso, _, _) -> @@ -463,21 +463,23 @@ obsolete_1(wxCursor, new, 4) -> %% Added in OTP 17. obsolete_1(asn1ct, decode,3) -> - {deprecated,"deprecated; use Mod:decode/2 instead"}; + {removed,"removed; use Mod:decode/2 instead"}; +obsolete_1(asn1ct, encode, 2) -> + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1ct, encode, 3) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, decode,3) -> - {deprecated,"deprecated; use Mod:decode/2 instead"}; + {removed,"removed; use Mod:decode/2 instead"}; obsolete_1(asn1rt, encode, 2) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, encode, 3) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, info, 1) -> - {deprecated,"deprecated; use Mod:info/0 instead"}; + {removed,"removed; use Mod:info/0 instead"}; obsolete_1(asn1rt, utf8_binary_to_list, 1) -> - {deprecated,{unicode,characters_to_list,1}}; + {removed,{unicode,characters_to_list,1},"OTP 20"}; obsolete_1(asn1rt, utf8_list_to_binary, 1) -> - {deprecated,{unicode,characters_to_binary,1}}; + {removed,{unicode,characters_to_binary,1},"OTP 20"}; %% Added in OTP 18. obsolete_1(core_lib, get_anno, 1) -> diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 8cf46482dd..82ab484ea6 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -31,7 +31,6 @@ dets_server, dets_sup, dets_utils, - dets_v8, dets_v9, dict, digraph, diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 8948f496c4..aa31fdde5a 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -35,26 +35,18 @@ -endif. -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - newly_started/1, basic_v8/1, basic_v9/1, - open_v8/1, open_v9/1, sets_v8/1, sets_v9/1, bags_v8/1, - bags_v9/1, duplicate_bags_v8/1, duplicate_bags_v9/1, - access_v8/1, access_v9/1, dirty_mark/1, dirty_mark2/1, - bag_next_v8/1, bag_next_v9/1, oldbugs_v8/1, oldbugs_v9/1, - unsafe_assumptions/1, truncated_segment_array_v8/1, - truncated_segment_array_v9/1, open_file_v8/1, open_file_v9/1, - init_table_v8/1, init_table_v9/1, repair_v8/1, repair_v9/1, - hash_v8b_v8c/1, phash/1, fold_v8/1, fold_v9/1, fixtable_v8/1, - fixtable_v9/1, match_v8/1, match_v9/1, select_v8/1, - select_v9/1, update_counter/1, badarg/1, cache_sets_v8/1, - cache_sets_v9/1, cache_bags_v8/1, cache_bags_v9/1, - cache_duplicate_bags_v8/1, cache_duplicate_bags_v9/1, + init_per_group/2,end_per_group/2, newly_started/1, basic/1, + open/1, sets/1, bags/1, duplicate_bags/1, access/1, dirty_mark/1, + dirty_mark2/1, bag_next/1, oldbugs/1, + truncated_segment_array/1, open_file/1, init_table/1, repair/1, + phash/1, fold/1, fixtable/1, match/1, select/1, update_counter/1, + badarg/1, cache_sets/1, cache_bags/1, cache_duplicate_bags/1, otp_4208/1, otp_4989/1, many_clients/1, otp_4906/1, otp_5402/1, simultaneous_open/1, insert_new/1, repair_continuation/1, otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1, otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1, otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1, - otp_13260/1]). + otp_13260/1, otp_13830/1]). -export([dets_dirty_loop/0]). @@ -73,8 +65,7 @@ -define(DETS_SERVER, dets). -%% HEADSZ taken from dets_v8.erl and dets_v9.erl. --define(HEADSZ_v8, 40). +%% HEADSZ taken from dets_v9.erl. -define(HEADSZ_v9, (56+28*4+16)). -define(NO_KEYS_POS_v9, 36). -define(CLOSED_PROPERLY_POS, 8). @@ -94,24 +85,16 @@ suite() -> all() -> [ - basic_v8, basic_v9, open_v8, open_v9, sets_v8, sets_v9, - bags_v8, bags_v9, duplicate_bags_v8, duplicate_bags_v9, - newly_started, open_file_v8, open_file_v9, - init_table_v8, init_table_v9, repair_v8, repair_v9, - access_v8, access_v9, oldbugs_v8, oldbugs_v9, - unsafe_assumptions, truncated_segment_array_v8, - truncated_segment_array_v9, dirty_mark, dirty_mark2, - bag_next_v8, bag_next_v9, hash_v8b_v8c, phash, fold_v8, - fold_v9, fixtable_v8, fixtable_v9, match_v8, match_v9, - select_v8, select_v9, update_counter, badarg, - cache_sets_v8, cache_sets_v9, cache_bags_v8, - cache_bags_v9, cache_duplicate_bags_v8, - cache_duplicate_bags_v9, otp_4208, otp_4989, + basic, open, sets, bags, duplicate_bags, newly_started, open_file, + init_table, repair, access, oldbugs, + truncated_segment_array, dirty_mark, dirty_mark2, bag_next, + phash, fold, fixtable, match, select, update_counter, badarg, + cache_sets, cache_bags, cache_duplicate_bags, otp_4208, otp_4989, many_clients, otp_4906, otp_5402, simultaneous_open, insert_new, repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898, otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709, - otp_13229, otp_13260 + otp_13229, otp_13260, otp_13830 ]. groups() -> @@ -137,20 +120,12 @@ newly_started(Config) when is_list(Config) -> test_server:stop_node(Node), ok. -%% Basic test case. -basic_v8(Config) when is_list(Config) -> - basic(Config, 8). - -%% Basic test case. -basic_v9(Config) when is_list(Config) -> - basic(Config, 9). - -basic(Config, Version) -> +basic(Config) when is_list(Config) -> Tab = dets_basic_test, FName = filename(Tab, Config), P0 = pps(), - {ok, _} = dets:open_file(Tab,[{file, FName},{version,Version}]), + {ok, _} = dets:open_file(Tab,[{file, FName}]), ok = dets:insert(Tab,{mazda,japan}), ok = dets:insert(Tab,{toyota,japan}), ok = dets:insert(Tab,{suzuki,japan}), @@ -174,13 +149,7 @@ basic(Config, Version) -> ok. -open_v8(Config) when is_list(Config) -> - open(Config, 8). - -open_v9(Config) when is_list(Config) -> - open(Config, 9). - -open(Config, Version) -> +open(Config) when is_list(Config) -> %% Running this test twice means that the Dets server is restarted %% twice. dets_sup specifies a maximum of 4 restarts in an hour. %% If this becomes a problem, one should consider running this @@ -194,14 +163,14 @@ open(Config, Version) -> Data = make_data(1), P0 = pps(), - Tabs = open_files(1, All, Version), + Tabs = open_files(1, All), initialize(Tabs, Data), check(Tabs, Data), foreach(fun(Tab) -> ok = dets:close(Tab) end, Tabs), %% Now reopen the files ?format("Reopening closed files \n", []), - Tabs = open_files(1, All, Version), + Tabs = open_files(1, All), ?format("Checking contents of reopened files \n", []), check(Tabs, Data), %% crash the dets server @@ -216,7 +185,7 @@ open(Config, Version) -> %% Now reopen the files again ?format("Reopening crashed files \n", []), - open_files(1, All, Version), + open_files(1, All), ?format("Checking contents of repaired files \n", []), check(Tabs, Data), @@ -266,20 +235,13 @@ bad(_Tab, _Item) -> exit(badtab). %% Perform traversal and match testing on set type dets tables. -sets_v8(Config) when is_list(Config) -> - sets(Config, 8). - -%% Perform traversal and match testing on set type dets tables. -sets_v9(Config) when is_list(Config) -> - sets(Config, 9). - -sets(Config, Version) -> +sets(Config) when is_list(Config) -> {Sets, _, _} = args(Config), Data = make_data(1), delete_files(Sets), P0 = pps(), - Tabs = open_files(1, Sets, Version), + Tabs = open_files(1, Sets), Bigger = [{17,q,w,w}, {48,q,w,w,w,w,w,w}], % 48 requires a bigger buddy initialize(Tabs, Data++Bigger++Data), % overwrite Len = length(Data), @@ -302,19 +264,12 @@ sets(Config, Version) -> ok. %% Perform traversal and match testing on bag type dets tables. -bags_v8(Config) when is_list(Config) -> - bags(Config, 8). - -%% Perform traversal and match testing on bag type dets tables. -bags_v9(Config) when is_list(Config) -> - bags(Config, 9). - -bags(Config, Version) -> +bags(Config) when is_list(Config) -> {_, Bags, _} = args(Config), Data = make_data(1, bag), %% gives twice as many objects delete_files(Bags), P0 = pps(), - Tabs = open_files(1, Bags, Version), + Tabs = open_files(1, Bags), initialize(Tabs, Data++Data), Len = length(Data), foreach(fun(Tab) -> trav_test(Data, Len, Tab) end, Tabs), @@ -336,19 +291,12 @@ bags(Config, Version) -> %% Perform traversal and match testing on duplicate_bag type dets tables. -duplicate_bags_v8(Config) when is_list(Config) -> - duplicate_bags(Config, 8). - -%% Perform traversal and match testing on duplicate_bag type dets tables. -duplicate_bags_v9(Config) when is_list(Config) -> - duplicate_bags(Config, 9). - -duplicate_bags(Config, Version) when is_list(Config) -> +duplicate_bags(Config) when is_list(Config) -> {_, _, Dups} = args(Config), Data = make_data(1, duplicate_bag), %% gives twice as many objects delete_files(Dups), P0 = pps(), - Tabs = open_files(1, Dups, Version), + Tabs = open_files(1, Dups), initialize(Tabs, Data), Len = length(Data), foreach(fun(Tab) -> trav_test(Data, Len, Tab) end, Tabs), @@ -369,13 +317,7 @@ duplicate_bags(Config, Version) when is_list(Config) -> ok. -access_v8(Config) when is_list(Config) -> - access(Config, 8). - -access_v9(Config) when is_list(Config) -> - access(Config, 9). - -access(Config, Version) -> +access(Config) when is_list(Config) -> Args_acc = [[{ram_file, true}, {access, read}], [{access, read}]], Args = [[{ram_file, true}], @@ -388,9 +330,9 @@ access(Config, Version) -> P0 = pps(), {error, {file_error,_,enoent}} = dets:open_file('1', hd(Args_acc_1)), - Tabs = open_files(1, Args_1, Version), + Tabs = open_files(1, Args_1), close_all(Tabs), - Tabs = open_files(1, Args_acc_1, Version), + Tabs = open_files(1, Args_acc_1), foreach(fun(Tab) -> {error, {access_mode,_}} = dets:insert(Tab, {1,2}), @@ -522,16 +464,12 @@ dets_dirty_loop() -> %% Check that bags and next work as expected. -bag_next_v8(Config) when is_list(Config) -> - bag_next(Config, 8). - -%% Check that bags and next work as expected. -bag_next_v9(Config) when is_list(Config) -> +bag_next(Config) when is_list(Config) -> Tab = dets_bag_next_test, FName = filename(Tab, Config), %% first and next crash upon error - dets:open_file(Tab,[{file, FName}, {type, bag},{version,9}]), + dets:open_file(Tab,[{file, FName}, {type, bag}]), ok = dets:insert(Tab, [{1,1},{2,2},{3,3},{4,4}]), FirstKey = dets:first(Tab), NextKey = dets:next(Tab, FirstKey), @@ -548,13 +486,8 @@ bag_next_v9(Config) when is_list(Config) -> dets:close(Tab), file:delete(FName), - bag_next(Config, 9). - -bag_next(Config, Version) -> - Tab = dets_bag_next_test, - FName = filename(Tab, Config), P0 = pps(), - dets:open_file(Tab,[{file, FName}, {type, bag},{version,Version}]), + dets:open_file(Tab,[{file, FName}, {type, bag}]), dets:insert(Tab,{698,hopp}), dets:insert(Tab,{186,hopp}), dets:insert(Tab,{hej,hopp}), @@ -578,17 +511,10 @@ bag_next(Config, Version) -> check_pps(P0), ok. -oldbugs_v8(Config) when is_list(Config) -> - oldbugs(Config, 8). - -oldbugs_v9(Config) when is_list(Config) -> - oldbugs(Config, 9). - -oldbugs(Config, Version) -> +oldbugs(Config) when is_list(Config) -> FName = filename(dets_suite_oldbugs_test, Config), P0 = pps(), - {ok, ob} = dets:open_file(ob, [{version, Version}, - {type, bag}, {file, FName}]), + {ok, ob} = dets:open_file(ob, [{type, bag}, {file, FName}]), ok = dets:insert(ob, {1, 2}), ok = dets:insert(ob, {1,3}), ok = dets:insert(ob, {1, 2}), @@ -598,56 +524,19 @@ oldbugs(Config, Version) -> check_pps(P0), ok. -%% Test that shrinking an object and then expanding it works. -unsafe_assumptions(Config) when is_list(Config) -> - FName = filename(dets_suite_unsafe_assumptions_test, Config), - file:delete(FName), - P0 = pps(), - {ok, a} = dets:open_file(a, [{version,8},{file, FName}]), - O0 = {2,false}, - O1 = {1, false}, - O2 = {1, true}, - O3 = {1, duplicate(20,false)}, - O4 = {1, duplicate(25,false)}, % same 2-log as O3 - ok = dets:insert(a, O1), - ok = dets:insert(a, O0), - true = [O1,O0] =:= sort(get_all_objects(a)), - true = [O1,O0] =:= sort(get_all_objects_fast(a)), - ok = dets:insert(a, O2), - true = [O2,O0] =:= sort(get_all_objects(a)), - true = [O2,O0] =:= sort(get_all_objects_fast(a)), - ok = dets:insert(a, O3), - true = [O3,O0] =:= sort(get_all_objects(a)), - true = [O3,O0] =:= sort(get_all_objects_fast(a)), - ok = dets:insert(a, O4), - true = [O4,O0] =:= sort(get_all_objects(a)), - true = [O4,O0] =:= sort(get_all_objects_fast(a)), - ok = dets:close(a), - file:delete(FName), - check_pps(P0), - ok. - -%% Test that a file where the segment array has been truncated -%% is possible to repair. -truncated_segment_array_v8(Config) when is_list(Config) -> - trunc_seg_array(Config, 8). - %% Test that a file where the segment array has been truncated %% is possible to repair. -truncated_segment_array_v9(Config) when is_list(Config) -> - trunc_seg_array(Config, 9). - -trunc_seg_array(Config, V) -> +truncated_segment_array(Config) when is_list(Config) -> TabRef = dets_suite_truncated_segment_array_test, Fname = filename(TabRef, Config), %% Create file that needs to be repaired file:delete(Fname), P0 = pps(), - {ok, TabRef} = dets:open_file(TabRef, [{file, Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file, Fname}]), ok = dets:close(TabRef), %% Truncate the file - HeadSize = headsz(V), + HeadSize = headsz(), truncate(Fname, HeadSize + 10), %% Open the truncated file @@ -660,19 +549,13 @@ trunc_seg_array(Config, V) -> ok. %% Test open_file/1. -open_file_v8(Config) when is_list(Config) -> - open_1(Config, 8). - -%% Test open_file/1. -open_file_v9(Config) when is_list(Config) -> +open_file(Config) when is_list(Config) -> T = open_v9, Fname = filename(T, Config), - {ok, _} = dets:open_file(T, [{file,Fname},{version,9}]), - 9 = dets:info(T, version), + {ok, _} = dets:open_file(T, [{file,Fname}]), + 9 = dets:info(T, version), % Backwards compatibility. true = [self()] =:= dets:info(T, users), - {ok, _} = dets:open_file(T, [{file,Fname},{version,9}]), - {error,incompatible_arguments} = - dets:open_file(T, [{file,Fname},{version,8}]), + {ok, _} = dets:open_file(T, [{file,Fname}]), true = [self(),self()] =:= dets:info(T, users), ok = dets:close(T), true = [self()] =:= dets:info(T, users), @@ -680,9 +563,9 @@ open_file_v9(Config) when is_list(Config) -> undefined = ets:info(T, users), file:delete(Fname), - open_1(Config, 9). + open_1(Config). -open_1(Config, V) -> +open_1(Config) -> TabRef = open_file_1_test, Fname = filename(TabRef, Config), file:delete(Fname), @@ -694,8 +577,8 @@ open_1(Config, V) -> {error,{not_a_dets_file,Fname}} = dets:open_file(Fname), file:delete(Fname), - HeadSize = headsz(V), - {ok, TabRef} = dets:open_file(TabRef, [{file, Fname},{version,V}]), + HeadSize = headsz(), + {ok, TabRef} = dets:open_file(TabRef, [{file, Fname}]), ok = dets:close(TabRef), truncate(Fname, HeadSize + 10), true = dets:is_dets_file(Fname), @@ -705,7 +588,7 @@ open_1(Config, V) -> file:delete(Fname), %% truncated file header, invalid type - {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]), ok = ins(TabRef, 3000), ok = dets:close(TabRef), TypePos = 12, @@ -714,7 +597,7 @@ open_1(Config, V) -> truncate(Fname, HeadSize - 10), {error,{not_a_dets_file,Fname}} = dets:open_file(Fname), {error,{not_a_dets_file,Fname}} = - dets:open_file(TabRef, [{file,Fname},{version,V}]), + dets:open_file(TabRef, [{file,Fname}]), file:delete(Fname), {error,{file_error,{foo,bar},_}} = dets:is_dets_file({foo,bar}), @@ -722,35 +605,30 @@ open_1(Config, V) -> ok. %% Test initialize_table/2 and from_ets/2. -init_table_v8(Config) when is_list(Config) -> - init_table(Config, 8). - -%% Test initialize_table/2 and from_ets/2. -init_table_v9(Config) when is_list(Config) -> +init_table(Config) when is_list(Config) -> %% Objects are returned in "time order". T = init_table_v9, Fname = filename(T, Config), file:delete(Fname), L = [{1,a},{2,b},{1,c},{2,c},{1,c},{2,a},{1,b}], Input = init([L]), - {ok, _} = dets:open_file(T, [{file,Fname},{version,9}, - {type,duplicate_bag}]), + {ok, _} = dets:open_file(T, [{file,Fname},{type,duplicate_bag}]), ok = dets:init_table(T, Input), [{1,a},{1,c},{1,c},{1,b}] = dets:lookup(T, 1), [{2,b},{2,c},{2,a}] = dets:lookup(T, 2), ok = dets:close(T), file:delete(Fname), - init_table(Config, 9), + init_table_1(Config), fast_init_table(Config). -init_table(Config, V) -> +init_table_1(Config) -> TabRef = init_table_test, Fname = filename(TabRef, Config), file:delete(Fname), P0 = pps(), - Args = [{file,Fname},{version,V},{auto_save,120000}], + Args = [{file,Fname},{auto_save,120000}], {ok, _} = dets:open_file(TabRef, Args), {'EXIT', _} = (catch dets:init_table(TabRef, fun(foo) -> bar end)), @@ -800,13 +678,13 @@ init_table(Config, V) -> file:delete(Fname), L1 = [[{1,a},{2,b}],[],[{3,c}],[{4,d}],[]], - bulk_init(L1, set, 4, Config, V), + bulk_init(L1, set, 4, Config), L2 = [[{1,a},{2,b}],[],[{2,q},{3,c}],[{4,d}],[{4,e},{2,q}]], - bulk_init(L2, set, 4, Config, V), - bulk_init(L2, bag, 6, Config, V), - bulk_init(L2, duplicate_bag, 7, Config, V), - bulk_init(L1, set, 4, 512, Config, V), - bulk_init([], set, 0, 10000, Config, V), + bulk_init(L2, set, 4, Config), + bulk_init(L2, bag, 6, Config), + bulk_init(L2, duplicate_bag, 7, Config), + bulk_init(L1, set, 4, 512, Config), + bulk_init([], set, 0, 10000, Config), file:delete(Fname), %% Initiate a file that contains a lot of objects. @@ -834,16 +712,16 @@ init_table(Config, V) -> check_pps(P0), ok. -bulk_init(Ls, Type, N, Config, V) -> - bulk_init(Ls, Type, N, 256, Config, V). +bulk_init(Ls, Type, N, Config) -> + bulk_init(Ls, Type, N, 256, Config). -bulk_init(Ls, Type, N, Est, Config, V) -> +bulk_init(Ls, Type, N, Est, Config) -> T = init_table_test, Fname = filename(T, Config), file:delete(Fname), Input = init(Ls), Args = [{ram_file,false}, {type,Type},{keypos,1},{file,Fname}, - {estimated_no_objects, Est},{version,V}], + {estimated_no_objects, Est}], {ok, T} = dets:open_file(T, Args), ok = dets:init_table(T, Input), All = sort(get_all_objects(T)), @@ -882,18 +760,17 @@ init_fun(I, N) -> end. fast_init_table(Config) -> - V = 9, TabRef = init_table_test, Fname = filename(TabRef, Config), file:delete(Fname), P0 = pps(), - Args = [{file,Fname},{version,V},{auto_save,120000}], + Args = [{file,Fname},{auto_save,120000}], Source = init_table_test_source, SourceFname = filename(Source, Config), file:delete(SourceFname), - SourceArgs = [{file,SourceFname},{version,V},{auto_save,120000}], + SourceArgs = [{file,SourceFname},{auto_save,120000}], {ok, Source} = dets:open_file(Source, SourceArgs), @@ -1015,13 +892,13 @@ fast_init_table(Config) -> file:delete(SourceFname), L1 = [{1,a},{2,b},{3,c},{4,d}], - fast_bulk_init(L1, set, 4, 4, Config, V), + fast_bulk_init(L1, set, 4, 4, Config), L2 = [{1,a},{2,b},{2,q},{3,c},{4,d},{4,e},{2,q}], - fast_bulk_init(L2, set, 4, 4, Config, V), - fast_bulk_init(L2, bag, 6, 4, Config, V), - fast_bulk_init(L2, duplicate_bag, 7, 4, Config, V), - fast_bulk_init(L1, set, 4, 4, 512, Config, V), - fast_bulk_init([], set, 0, 0, 10000, Config, V), + fast_bulk_init(L2, set, 4, 4, Config), + fast_bulk_init(L2, bag, 6, 4, Config), + fast_bulk_init(L2, duplicate_bag, 7, 4, Config), + fast_bulk_init(L1, set, 4, 4, 512, Config), + fast_bulk_init([], set, 0, 0, 10000, Config), file:delete(Fname), %% Initiate a file that contains a lot of objects. @@ -1112,16 +989,16 @@ fast_init_table(Config) -> check_pps(P0), ok. -fast_bulk_init(L, Type, N, NoKeys, Config, V) -> - fast_bulk_init(L, Type, N, NoKeys, 256, Config, V). +fast_bulk_init(L, Type, N, NoKeys, Config) -> + fast_bulk_init(L, Type, N, NoKeys, 256, Config). -fast_bulk_init(L, Type, N, NoKeys, Est, Config, V) -> +fast_bulk_init(L, Type, N, NoKeys, Est, Config) -> T = init_table_test, Fname = filename(T, Config), file:delete(Fname), Args0 = [{ram_file,false}, {type,Type},{keypos,1}, - {estimated_no_objects, Est},{version,V}], + {estimated_no_objects, Est}], Args = [{file,Fname} | Args0], S = init_table_test_source, SFname = filename(S, Config), @@ -1189,35 +1066,7 @@ items(I, N, C, L) -> items(I+1, N, C-1, [{I, item(I)} | L]). %% Test open_file and repair. -repair_v8(Config) when is_list(Config) -> - repair(Config, 8). - -%% Test open_file and repair. -repair_v9(Config) when is_list(Config) -> - %% Convert from format 9 to format 8. - T = convert_98, - Fname = filename(T, Config), - file:delete(Fname), - {ok, _} = dets:open_file(T, [{file,Fname},{version,9}, - {type,duplicate_bag}]), - 9 = dets:info(T, version), - true = is_binary(dets:info(T, bchunk_format)), - ok = dets:insert(T, [{1,a},{2,b},{1,c},{2,c},{1,c},{2,a},{1,b}]), - dets:close(T), - {error, {version_mismatch, _}} = - dets:open_file(T, [{file,Fname},{version,8},{type,duplicate_bag}]), - {ok, _} = dets:open_file(T, [{file,Fname},{version,8}, - {type,duplicate_bag},{repair,force}]), - 8 = dets:info(T, version), - true = undefined =:= dets:info(T, bchunk_format), - [{1,a},{1,b},{1,c},{1,c}] = sort(dets:lookup(T, 1)), - [{2,a},{2,b},{2,c}] = sort(dets:lookup(T, 2)), - 7 = dets:info(T, no_objects), - no_keys_test(T), - _ = histogram(T, silent), - ok = dets:close(T), - file:delete(Fname), - +repair(Config) when is_list(Config) -> %% The short lived format 9(a). %% Not very throughly tested here. A9 = a9, @@ -1238,13 +1087,13 @@ repair_v9(Config) when is_list(Config) -> ok = dets:close(A9), file:delete(Version9aT), - repair(Config, 9). + repair_1(Config). -repair(Config, V) -> +repair_1(Config) -> TabRef = repair_test, Fname = filename(TabRef, Config), file:delete(Fname), - HeadSize = headsz(V), + HeadSize = headsz(), P0 = pps(), {'EXIT', {badarg, _}} = @@ -1255,7 +1104,7 @@ repair(Config, V) -> dets:open_file(TabRef, [{file, Fname}, {access, read}]), %% compacting, and some kind of test that free lists are saved OK on file - {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]), 0 = dets:info(TabRef, size), ok = ins(TabRef, 30000), ok = del(TabRef, 30000, 3), @@ -1268,38 +1117,20 @@ repair(Config, V) -> 20000 = count_objects_quite_fast(Ref3), % actually a test of match no_keys_test(Ref3), ok = dets:close(Ref3), - if - V =:= 8 -> - {ok, TabRef} = dets:open_file(TabRef, - [{file, Fname},{version,V},{access,read}]), - ok = dets:close(TabRef), - io:format("Expect compacting repair:~n"), - {ok, TabRef} = dets:open_file(TabRef, - [{file, Fname},{version,V}]), - 20000 = dets:info(TabRef, size), - _ = histogram(TabRef, silent), - ok = dets:close(TabRef); - true -> - ok - end, {error,{keypos_mismatch,Fname}} = dets:open_file(TabRef, [{file, Fname},{keypos,17}]), {error,{type_mismatch,Fname}} = dets:open_file(TabRef, [{file, Fname},{type,duplicate_bag}]), %% make one of the temporary files unwritable - TmpFile = if - V =:= 8 -> - Fname ++ ".TMP.10000"; - true -> Fname ++ ".TMP.1" - end, + TmpFile = Fname ++ ".TMP.1", file:delete(TmpFile), {ok, TmpFd} = file:open(TmpFile, [read,write]), ok = file:close(TmpFd), unwritable(TmpFile), - {error,{file_error,TmpFile,eacces}} = dets:fsck(Fname, V), + {error,{file_error,TmpFile,eacces}} = dets:fsck(Fname), {ok, _} = dets:open_file(TabRef, - [{repair,false},{file, Fname},{version,V}]), + [{repair,false},{file, Fname}]), 20000 = length(get_all_objects(TabRef)), _ = histogram(TabRef, silent), 20000 = length(get_all_objects_fast(TabRef)), @@ -1318,68 +1149,15 @@ repair(Config, V) -> file:delete(Fname), %% truncated file header - {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]), ok = ins(TabRef, 100), ok = dets:close(TabRef), file:delete(Fname), - %% version bump (v8) - Version7S = filename:join(?datadir(Config), "version_r2d.dets"), - Version7T = filename('v2.dets', Config), - {ok, _} = file:copy(Version7S, Version7T), - {error,{version_bump, Version7T}} = dets:open_file(Version7T), - {error,{version_bump, Version7T}} = - dets:open_file(Version7T, [{file,Version7T},{repair,false}]), - {error,{version_bump, Version7T}} = - dets:open_file(Version7T, [{file, Version7T}, {access, read}]), - io:format("Expect upgrade:~n"), - {ok, _} = dets:open_file(Version7T, - [{file, Version7T},{version, V}]), - [{1,a},{2,b}] = sort(get_all_objects(Version7T)), - [{1,a},{2,b}] = sort(get_all_objects_fast(Version7T)), - Phash = if - V =:= 8 -> phash; - true -> phash2 - end, - Phash = dets:info(Version7T, hash), - _ = histogram(Version7T, silent), - ok = dets:close(Version7T), - {ok, _} = dets:open_file(Version7T, [{file, Version7T}]), - Phash = dets:info(Version7T, hash), - ok = dets:close(Version7T), - file:delete(Version7T), - - %% converting free lists - Version8aS = filename:join(?datadir(Config), "version_r3b02.dets"), - Version8aT = filename('v3.dets', Config), - {ok, _} = file:copy(Version8aS, Version8aT), - %% min_no_slots and max_no_slots are ignored - no repair is taking place - {ok, _} = dets:open_file(version_8a, - [{file, Version8aT},{min_no_slots,1000}, - {max_no_slots,100000}]), - [{1,b},{2,a},{a,1},{b,2}] = sort(get_all_objects(version_8a)), - [{1,b},{2,a},{a,1},{b,2}] = sort(get_all_objects_fast(version_8a)), - ok = ins(version_8a, 1000), - 1002 = dets:info(version_8a, size), - no_keys_test(version_8a), - All8a = sort(get_all_objects(version_8a)), - 1002 = length(All8a), - FAll8a = sort(get_all_objects_fast(version_8a)), - true = sort(All8a) =:= sort(FAll8a), - ok = del(version_8a, 300, 3), - 902 = dets:info(version_8a, size), - no_keys_test(version_8a), - All8a2 = sort(get_all_objects(version_8a)), - 902 = length(All8a2), - FAll8a2 = sort(get_all_objects_fast(version_8a)), - true = sort(All8a2) =:= sort(FAll8a2), - _ = histogram(version_8a, silent), - ok = dets:close(version_8a), - file:delete(Version8aT), - + %% FIXME. %% will fail unless the slots are properly sorted when repairing (v8) BArgs = [{file, Fname},{type,duplicate_bag}, - {delayed_write,{3000,10000}},{version,V}], + {delayed_write,{3000,10000}}], {ok, TabRef} = dets:open_file(TabRef, BArgs), Seq = seq(1, 500), Small = map(fun(X) -> {X,X} end, Seq), @@ -1393,18 +1171,14 @@ repair(Config, V) -> io:format("Expect forced repair:~n"), {ok, _} = dets:open_file(TabRef, [{repair,force},{min_no_slots,2000} | BArgs]), - if - V =:= 9 -> - {MinNoSlots,_,MaxNoSlots} = dets:info(TabRef, no_slots), - ok = dets:close(TabRef), - io:format("Expect compaction:~n"), - {ok, _} = - dets:open_file(TabRef, [{repair,force}, - {min_no_slots,MinNoSlots}, - {max_no_slots,MaxNoSlots} | BArgs]); - true -> - ok - end, + + {MinNoSlots,_,MaxNoSlots} = dets:info(TabRef, no_slots), + ok = dets:close(TabRef), + io:format("Expect compaction:~n"), + {ok, _} = + dets:open_file(TabRef, [{repair,force}, + {min_no_slots,MinNoSlots}, + {max_no_slots,MaxNoSlots} | BArgs]), All2 = get_all_objects(TabRef), true = All =:= sort(All2), FAll2 = get_all_objects_fast(TabRef), @@ -1418,35 +1192,15 @@ repair(Config, V) -> file:delete(Fname), %% object bigger than segments, the "hole" is taken care of - {ok, TabRef} = dets:open_file(TabRef, [{file, Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file, Fname}]), Tuple = erlang:make_tuple(1000, foobar), % > 2 kB ok = dets:insert(TabRef, Tuple), %% at least one full segment (objects smaller than 2 kB): ins(TabRef, 2000), ok = dets:close(TabRef), - if - V =:= 8 -> - %% first estimated number of objects is wrong, repair once more - {ok, Fd} = file:open(Fname, [read,write]), - NoPos = HeadSize - 8, % no_objects - file:pwrite(Fd, NoPos, <<0:32>>), % NoItems - ok = file:close(Fd), - dets:fsck(Fname, V), - {ok, _} = - dets:open_file(TabRef, - [{repair,false},{file, Fname},{version,V}]), - 2001 = length(get_all_objects(TabRef)), - _ = histogram(TabRef, silent), - 2001 = length(get_all_objects_fast(TabRef)), - ok = dets:close(TabRef); - true -> - ok - end, - {ok, _} = - dets:open_file(TabRef, - [{repair,false},{file, Fname},{version,V}]), + dets:open_file(TabRef, [{repair,false},{file, Fname}]), {ok, ObjPos} = dets:where(TabRef, {66,{item,number,66}}), ok = dets:close(TabRef), %% Damaged object. @@ -1454,25 +1208,24 @@ repair(Config, V) -> crash(Fname, ObjPos+Pos), io:format( "Expect forced repair (possibly after attempted compaction):~n"), - {ok, _} = - dets:open_file(TabRef, [{repair,force},{file, Fname},{version,V}]), + {ok, _} = dets:open_file(TabRef, [{repair,force},{file, Fname}]), true = dets:info(TabRef, size) < 2001, ok = dets:close(TabRef), file:delete(Fname), %% The file is smaller than the padded object. - {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]), ok = dets:insert(TabRef, Tuple), ok = dets:close(TabRef), io:format("Expect forced repair or compaction:~n"), {ok, _} = - dets:open_file(TabRef, [{repair,force},{file, Fname},{version,V}]), + dets:open_file(TabRef, [{repair,force},{file, Fname}]), true = 1 =:= dets:info(TabRef, size), ok = dets:close(TabRef), file:delete(Fname), %% Damaged free lists. - {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]), ok = ins(TabRef, 300), ok = dets:sync(TabRef), ok = del(TabRef, 300, 3), @@ -1481,48 +1234,42 @@ repair(Config, V) -> ok = dets:close(TabRef), crash(Fname, FileSize+20), %% Used to return bad_freelists, but that changed in OTP-9622 - {ok, TabRef} = - dets:open_file(TabRef, [{file,Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]), ok = dets:close(TabRef), file:delete(Fname), %% File not closed, opening with read and read_write access tried. - {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]), ok = ins(TabRef, 300), ok = dets:close(TabRef), crash(Fname, ?CLOSED_PROPERLY_POS+3, ?NOT_PROPERLY_CLOSED), {error, {not_closed, Fname}} = - dets:open_file(foo, [{file,Fname},{version,V},{repair,force}, + dets:open_file(foo, [{file,Fname},{repair,force}, {access,read}]), {error, {not_closed, Fname}} = - dets:open_file(foo, [{file,Fname},{version,V},{repair,true}, + dets:open_file(foo, [{file,Fname},{repair,true}, {access,read}]), io:format("Expect repair:~n"), {ok, TabRef} = - dets:open_file(TabRef, [{file,Fname},{version,V},{repair,true}, + dets:open_file(TabRef, [{file,Fname},{repair,true}, {access,read_write}]), ok = dets:close(TabRef), crash(Fname, ?CLOSED_PROPERLY_POS+3, ?NOT_PROPERLY_CLOSED), io:format("Expect forced repair:~n"), {ok, TabRef} = - dets:open_file(TabRef, [{file,Fname},{version,V},{repair,force}, + dets:open_file(TabRef, [{file,Fname},{repair,force}, {access,read_write}]), ok = dets:close(TabRef), file:delete(Fname), %% The size of an object is huge. - {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]), ok = dets:insert(TabRef, [{1,2,3},{2,3,4}]), {ok, ObjPos2} = dets:where(TabRef, {1,2,3}), ok = dets:close(TabRef), - ObjPos3 = if - V =:= 8 -> ObjPos2 + 4; - V =:= 9 -> ObjPos2 - end, - crash(Fname, ObjPos3, 255), + crash(Fname, ObjPos2, 255), io:format("Expect forced repair:~n"), - {ok, TabRef} = - dets:open_file(TabRef, [{file,Fname},{version,V},{repair,force}]), + {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{repair,force}]), ok = dets:close(TabRef), file:delete(Fname), @@ -1530,82 +1277,6 @@ repair(Config, V) -> ok. -%% Test the use of different hashing algorithms in v8b and v8c of the -%% Dets file format. -hash_v8b_v8c(Config) when is_list(Config) -> - Source = - filename:join(?datadir(Config), "dets_test_v8b.dets"), - %% Little endian version of old file (there is an endianess bug in - %% the old hash). This is all about version 8 of the dets file format. - - P0 = pps(), - SourceLE = - filename:join(?datadir(Config), - "dets_test_v8b_little_endian.dets"), - Target1 = filename('oldhash1.dets', Config), - Target1LE = filename('oldhash1le.dets', Config), - Target2 = filename('oldhash2.dets', Config), - {ok, Bin} = file:read_file(Source), - {ok, BinLE} = file:read_file(SourceLE), - ok = file:write_file(Target1,Bin), - ok = file:write_file(Target1LE,BinLE), - ok = file:write_file(Target2,Bin), - {ok, d1} = dets:open_file(d1,[{file,Target1}]), - {ok, d1le} = dets:open_file(d1le,[{file,Target1LE}]), - {ok, d2} = dets:open_file(d2,[{file,Target2},{repair,force}, - {version,8}]), - FF = fun(N,_F,_T) when N > 16#FFFFFFFFFFFFFFFF -> - ok; - (N,F,T) -> - V = integer_to_list(N), - case dets:lookup(T,N) of - [{N,V}] -> - F(N*2,F,T); - _Error -> - exit({failed,{lookup,T,N}}) - end - end, - Mess = case (catch FF(1,FF,d1)) of - {'EXIT', {failed, {lookup,_,_}}} -> - ok = dets:close(d1), - FF(1,FF,d1le), - hash = dets:info(d1le,hash), - dets:insert(d1le,{33333333333,hejsan}), - [{33333333333,hejsan}] = - dets:lookup(d1le,33333333333), - ok = dets:close(d1le), - {ok, d1le} = dets:open_file(d1le, - [{file,Target1LE}]), - [{33333333333,hejsan}] = - dets:lookup(d1le,33333333333), - FF(1,FF,d1le), - ok = dets:close(d1le), - "Seems to be a little endian machine"; - {'EXIT', Fault} -> - exit(Fault); - _ -> - ok = dets:close(d1le), - hash = dets:info(d1,hash), - dets:insert(d1,{33333333333,hejsan}), - [{33333333333,hejsan}] = - dets:lookup(d1,33333333333), - ok = dets:close(d1), - {ok, d1} = dets:open_file(d1,[{file,Target1}]), - [{33333333333,hejsan}] = - dets:lookup(d1,33333333333), - FF(1,FF,d1), - ok = dets:close(d1), - "Seems to be a big endian machine" - end, - FF(1,FF,d2), - phash = dets:info(d2,hash), - ok = dets:close(d2), - file:delete(Target1), - file:delete(Target1LE), - file:delete(Target2), - check_pps(P0), - {comment, Mess}. - %% Test version 9(b) with erlang:phash/2 as hash function. phash(Config) when is_list(Config) -> T = phash, @@ -1643,9 +1314,10 @@ phash(Config) when is_list(Config) -> ok = dets:close(T), %% One cannot use the bchunk format when copying between a phash - %% table and a phash2 table. (There is no test for the case an R9 - %% (or later) node (using phash2) copies a table to an R8 node - %% (using phash).) See also the comment on HASH_PARMS in dets_v9.erl. + %% table and a phash2 table. (There is no test for the case an + %% Erlang/OTP R9 (or later) node (using phash2) copies a table to + %% an Erlang/OTP R8 node (using phash).) See also the comment on + %% HASH_PARMS in dets_v9.erl. {ok, _} = file:copy(Phash_v9bS, Fname), {ok, T} = dets:open_file(T, [{file, Fname}]), Type = dets:info(T, type), @@ -1653,7 +1325,7 @@ phash(Config) when is_list(Config) -> Input = init_bchunk(T), T2 = phash_table, Fname2 = filename(T2, Config), - Args = [{type,Type},{keypos,KeyPos},{version,9},{file,Fname2}], + Args = [{type,Type},{keypos,KeyPos},{file,Fname2}], {ok, T2} = dets:open_file(T2, Args), {error, {init_fun, _}} = dets:init_table(T2, Input, {format,bchunk}), @@ -1665,21 +1337,14 @@ phash(Config) when is_list(Config) -> ok. %% Test foldl, foldr, to_ets. -fold_v8(Config) when is_list(Config) -> - fold(Config, 8). - -%% Test foldl, foldr, to_ets. -fold_v9(Config) when is_list(Config) -> - fold(Config, 9). - -fold(Config, Version) -> +fold(Config) when is_list(Config) -> T = test_table, N = 100, Fname = filename(T, Config), file:delete(Fname), P0 = pps(), - Args = [{version, Version}, {file,Fname}, {estimated_no_objects, N}], + Args = [{file,Fname}, {estimated_no_objects, N}], {ok, _} = dets:open_file(T, Args), ok = ins(T, N), @@ -1721,10 +1386,7 @@ fold(Config, Version) -> ok = dets:close(T), %% Damaged object. - Pos = if - Version =:= 8 -> 12; - Version =:= 9 -> 8 - end, + Pos = 8, crash(Fname, ObjPos+Pos), {ok, _} = dets:open_file(T, Args), io:format("Expect corrupt table:~n"), @@ -1738,18 +1400,11 @@ fold(Config, Version) -> ok. %% Add objects to a fixed table. -fixtable_v8(Config) when is_list(Config) -> - fixtable(Config, 8). - -%% Add objects to a fixed table. -fixtable_v9(Config) when is_list(Config) -> - fixtable(Config, 9). - -fixtable(Config, Version) when is_list(Config) -> +fixtable(Config) when is_list(Config) -> T = fixtable, Fname = filename(fixtable, Config), file:delete(Fname), - Args = [{version,Version},{file,Fname}], + Args = [{file,Fname}], P0 = pps(), {ok, _} = dets:open_file(T, Args), @@ -1832,21 +1487,13 @@ fixtable(Config, Version) when is_list(Config) -> ok. %% Matching objects of a fixed table. -match_v8(Config) when is_list(Config) -> - match(Config, 8). - -%% Matching objects of a fixed table. -match_v9(Config) when is_list(Config) -> - match(Config, 9). - -match(Config, Version) -> +match(Config) when is_list(Config) -> T = match, Fname = filename(match, Config), file:delete(Fname), P0 = pps(), - Args = [{version, Version}, {file,Fname}, {type, duplicate_bag}, - {estimated_no_objects,550}], + Args = [{file,Fname}, {type, duplicate_bag}, {estimated_no_objects,550}], {ok, _} = dets:open_file(T, Args), ok = dets:insert(T, {1, a, b}), ok = dets:insert(T, {1, b, a}), @@ -1901,7 +1548,7 @@ match(Config, Version) -> {_, TmpCont} = dets:match_object(T, '_', 200), {_, TmpCont1} = dets:match_object(TmpCont), {TTL, _} = dets:match_object(TmpCont1), - DI = if Version =:= 8 -> last(TTL); Version =:= 9 -> hd(TTL) end, + DI = hd(TTL), dets:safe_fixtable(T, true), {L1, C20} = dets:match_object(T, '_', 200), true = 200 =< length(L1), @@ -1957,8 +1604,7 @@ match(Config, Version) -> ok = dets:close(T), %% Damaged size of object. - %% In v8, there is a next pointer before the size. - CrashPos = if Version =:= 8 -> 5; Version =:= 9 -> 1 end, + CrashPos = 1, crash(Fname, ObjPos2+CrashPos), {ok, _} = dets:open_file(T, Args), case dets:insert_new(T, Obj) of % OTP-12024 @@ -1986,7 +1632,7 @@ match(Config, Version) -> ok = dets:close(T), %% match_delete finds an error - CrashPos3 = if Version =:= 8 -> 12; Version =:= 9 -> 16 end, + CrashPos3 = 16, crash(Fname, ObjPos3+CrashPos3), {ok, _} = dets:open_file(T, Args), bad_object(dets:match_delete(T, Spec), Fname), @@ -2008,21 +1654,13 @@ match(Config, Version) -> ok. %% Selecting objects of a fixed table. -select_v8(Config) when is_list(Config) -> - select(Config, 8). - -%% Selecting objects of a fixed table. -select_v9(Config) when is_list(Config) -> - select(Config, 9). - -select(Config, Version) -> +select(Config) when is_list(Config) -> T = select, Fname = filename(select, Config), file:delete(Fname), P0 = pps(), - Args = [{version,Version}, {file,Fname}, {type, duplicate_bag}, - {estimated_no_objects,550}], + Args = [{file,Fname}, {type, duplicate_bag},{estimated_no_objects,550}], {ok, _} = dets:open_file(T, Args), ok = dets:insert(T, {1, a, b}), ok = dets:insert(T, {1, b, a}), @@ -2074,7 +1712,7 @@ select(Config, Version) -> {_, TmpCont} = dets:match_object(T, '_', 200), {_, TmpCont1} = dets:match_object(TmpCont), {TTL, _} = dets:match_object(TmpCont1), - DI = if Version =:= 8 -> last(TTL); Version =:= 9 -> hd(TTL) end, + DI = hd(TTL), dets:safe_fixtable(T, true), {L1, C20} = dets:select(T, AllSpec, 200), true = 200 =< length(L1), @@ -2281,28 +1919,21 @@ badarg(Config) when is_list(Config) -> ok. %% Test the write cache for sets. -cache_sets_v8(Config) when is_list(Config) -> - cache_sets(Config, 8). - -%% Test the write cache for sets. -cache_sets_v9(Config) when is_list(Config) -> - cache_sets(Config, 9). - -cache_sets(Config, Version) -> +cache_sets(Config) when is_list(Config) -> Small = 2, - cache_sets(Config, {0,0}, false, Small, Version), - cache_sets(Config, {0,0}, true, Small, Version), - cache_sets(Config, {5000,5000}, false, Small, Version), - cache_sets(Config, {5000,5000}, true, Small, Version), + cache_sets(Config, {0,0}, false, Small), + cache_sets(Config, {0,0}, true, Small), + cache_sets(Config, {5000,5000}, false, Small), + cache_sets(Config, {5000,5000}, true, Small), %% Objects of size greater than 2 kB. Big = 1200, - cache_sets(Config, {0,0}, false, Big, Version), - cache_sets(Config, {0,0}, true, Big, Version), - cache_sets(Config, {5000,5000}, false, Big, Version), - cache_sets(Config, {5000,5000}, true, Big, Version), + cache_sets(Config, {0,0}, false, Big), + cache_sets(Config, {0,0}, true, Big), + cache_sets(Config, {5000,5000}, false, Big), + cache_sets(Config, {5000,5000}, true, Big), ok. -cache_sets(Config, DelayedWrite, Extra, Sz, Version) -> +cache_sets(Config, DelayedWrite, Extra, Sz) -> %% Extra = bool(). Insert tuples until the tested key is not alone. %% Sz = integer(). Size of the inserted tuples. @@ -2311,9 +1942,8 @@ cache_sets(Config, DelayedWrite, Extra, Sz, Version) -> file:delete(Fname), P0 = pps(), - {ok, _} = - dets:open_file(T,[{version, Version}, {file,Fname}, {type,set}, - {delayed_write, DelayedWrite}]), + {ok, _} = dets:open_file(T,[{file,Fname}, {type,set}, + {delayed_write, DelayedWrite}]), Dups = 1, {Key, OtherKeys} = @@ -2430,28 +2060,21 @@ cache_sets(Config, DelayedWrite, Extra, Sz, Version) -> ok. %% Test the write cache for bags. -cache_bags_v8(Config) when is_list(Config) -> - cache_bags(Config, 8). - -%% Test the write cache for bags. -cache_bags_v9(Config) when is_list(Config) -> - cache_bags(Config, 9). - -cache_bags(Config, Version) -> +cache_bags(Config) when is_list(Config) -> Small = 2, - cache_bags(Config, {0,0}, false, Small, Version), - cache_bags(Config, {0,0}, true, Small, Version), - cache_bags(Config, {5000,5000}, false, Small, Version), - cache_bags(Config, {5000,5000}, true, Small, Version), + cache_bags(Config, {0,0}, false, Small), + cache_bags(Config, {0,0}, true, Small), + cache_bags(Config, {5000,5000}, false, Small), + cache_bags(Config, {5000,5000}, true, Small), %% Objects of size greater than 2 kB. Big = 1200, - cache_bags(Config, {0,0}, false, Big, Version), - cache_bags(Config, {0,0}, true, Big, Version), - cache_bags(Config, {5000,5000}, false, Big, Version), - cache_bags(Config, {5000,5000}, true, Big, Version), + cache_bags(Config, {0,0}, false, Big), + cache_bags(Config, {0,0}, true, Big), + cache_bags(Config, {5000,5000}, false, Big), + cache_bags(Config, {5000,5000}, true, Big), ok. -cache_bags(Config, DelayedWrite, Extra, Sz, Version) -> +cache_bags(Config, DelayedWrite, Extra, Sz) -> %% Extra = bool(). Insert tuples until the tested key is not alone. %% Sz = integer(). Size of the inserted tuples. @@ -2460,9 +2083,8 @@ cache_bags(Config, DelayedWrite, Extra, Sz, Version) -> file:delete(Fname), P0 = pps(), - {ok, _} = - dets:open_file(T,[{version, Version}, {file,Fname}, {type,bag}, - {delayed_write, DelayedWrite}]), + {ok, _} = dets:open_file(T,[{file,Fname}, {type,bag}, + {delayed_write, DelayedWrite}]), Dups = 1, {Key, OtherKeys} = @@ -2588,8 +2210,7 @@ cache_bags(Config, DelayedWrite, Extra, Sz, Version) -> R1 = {index_test,1,2,3,4}, R2 = {index_test,2,2,13,14}, R3 = {index_test,1,12,13,14}, - {ok, _} = dets:open_file(T,[{version,Version},{type,bag}, - {keypos,2},{file,Fname}]), + {ok, _} = dets:open_file(T,[{type,bag}, {keypos,2},{file,Fname}]), ok = dets:insert(T,R1), ok = dets:sync(T), ok = dets:insert(T,R2), @@ -2606,27 +2227,20 @@ cache_bags(Config, DelayedWrite, Extra, Sz, Version) -> ok. %% Test the write cache for duplicate bags. -cache_duplicate_bags_v8(Config) when is_list(Config) -> - cache_duplicate_bags(Config, 8). - -%% Test the write cache for duplicate bags. -cache_duplicate_bags_v9(Config) when is_list(Config) -> - cache_duplicate_bags(Config, 9). - -cache_duplicate_bags(Config, Version) -> +cache_duplicate_bags(Config) when is_list(Config) -> Small = 2, - cache_dup_bags(Config, {0,0}, false, Small, Version), - cache_dup_bags(Config, {0,0}, true, Small, Version), - cache_dup_bags(Config, {5000,5000}, false, Small, Version), - cache_dup_bags(Config, {5000,5000}, true, Small, Version), + cache_dup_bags(Config, {0,0}, false, Small), + cache_dup_bags(Config, {0,0}, true, Small), + cache_dup_bags(Config, {5000,5000}, false, Small), + cache_dup_bags(Config, {5000,5000}, true, Small), %% Objects of size greater than 2 kB. Big = 1200, - cache_dup_bags(Config, {0,0}, false, Big, Version), - cache_dup_bags(Config, {0,0}, true, Big, Version), - cache_dup_bags(Config, {5000,5000}, false, Big, Version), - cache_dup_bags(Config, {5000,5000}, true, Big, Version). + cache_dup_bags(Config, {0,0}, false, Big), + cache_dup_bags(Config, {0,0}, true, Big), + cache_dup_bags(Config, {5000,5000}, false, Big), + cache_dup_bags(Config, {5000,5000}, true, Big). -cache_dup_bags(Config, DelayedWrite, Extra, Sz, Version) -> +cache_dup_bags(Config, DelayedWrite, Extra, Sz) -> %% Extra = bool(). Insert tuples until the tested key is not alone. %% Sz = integer(). Size of the inserted tuples. @@ -2635,10 +2249,8 @@ cache_dup_bags(Config, DelayedWrite, Extra, Sz, Version) -> file:delete(Fname), P0 = pps(), - {ok, _} = - dets:open_file(T,[{version, Version}, {file,Fname}, - {type,duplicate_bag}, - {delayed_write, DelayedWrite}]), + {ok, _} = dets:open_file(T,[{file,Fname}, {type,duplicate_bag}, + {delayed_write, DelayedWrite}]), Dups = 2, {Key, OtherKeys} = @@ -2869,7 +2481,7 @@ otp_8899(Config) when is_list(Config) -> Server = self(), file:delete(FName), - {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]), + {ok, _} = dets:open_file(Tab,[{file, FName}]), [P1,P2,P3,P4] = new_clients(4, Tab), MC = [Tab], @@ -2895,7 +2507,7 @@ many_clients(Config) when is_list(Config) -> file:delete(FName), P0 = pps(), - {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]), + {ok, _} = dets:open_file(Tab,[{file, FName}]), [P1,P2,P3,P4] = new_clients(4, Tab), %% dets:init_table/2 is used for making sure that all processes @@ -2954,14 +2566,14 @@ many_clients(Config) when is_list(Config) -> file:delete(FName), %% Check that errors are handled correctly by the streaming operators. - {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]), + {ok, _} = dets:open_file(Tab,[{file, FName}]), ok = ins(Tab, 100), Obj = {66,{item,number,66}}, {ok, ObjPos} = dets:where(Tab, Obj), ok = dets:close(Tab), %% Damaged object. crash(FName, ObjPos+12), - {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]), + {ok, _} = dets:open_file(Tab,[{file, FName}]), BadObject1 = dets:lookup_keys(Tab, [65,66,67,68,69]), bad_object(BadObject1, FName), _Error = dets:close(Tab), @@ -3415,18 +3027,13 @@ repair_continuation(Config) -> %% OTP-5487. Growth of read-only table (again). otp_5487(Config) -> - otp_5487(Config, 9), - otp_5487(Config, 8), - ok. - -otp_5487(Config, Version) -> Tab = otp_5487, Fname = filename(otp_5487, Config), file:delete(Fname), Ets = ets:new(otp_5487, [public, set]), lists:foreach(fun(I) -> ets:insert(Ets, {I,I+1}) end, lists:seq(0,1000)), - {ok, _} = dets:open_file(Tab, [{file,Fname},{version,Version}]), + {ok, _} = dets:open_file(Tab, [{file,Fname}]), ok = dets:from_ets(Tab, Ets), ok = dets:sync(Tab), ok = dets:close(Tab), @@ -3470,14 +3077,12 @@ otp_6359(Config) -> %% OTP-4738. ==/2 and =:=/2. otp_4738(Config) -> - %% Version 8 has not been corrected. - %% (The constant -12857447 is for version 9 only.) - otp_4738_set(9, Config), - otp_4738_bag(9, Config), - otp_4738_dupbag(9, Config), + otp_4738_set(Config), + otp_4738_bag(Config), + otp_4738_dupbag(Config), ok. -otp_4738_dupbag(Version, Config) -> +otp_4738_dupbag(Config) -> Tab = otp_4738, File = filename(Tab, Config), file:delete(File), @@ -3485,7 +3090,7 @@ otp_4738_dupbag(Version, Config) -> F = float(I), One = 1, FOne = float(One), - Args = [{file,File},{type,duplicate_bag},{version,Version}], + Args = [{file,File},{type,duplicate_bag}], {ok, Tab} = dets:open_file(Tab, Args), ok = dets:insert(Tab, [{I,One},{F,One},{I,FOne},{F,FOne}]), ok = dets:sync(Tab), @@ -3530,7 +3135,7 @@ otp_4738_dupbag(Version, Config) -> file:delete(File), ok. -otp_4738_bag(Version, Config) -> +otp_4738_bag(Config) -> Tab = otp_4738, File = filename(Tab, Config), file:delete(File), @@ -3538,7 +3143,7 @@ otp_4738_bag(Version, Config) -> F = float(I), One = 1, FOne = float(One), - Args = [{file,File},{type,bag},{version,Version}], + Args = [{file,File},{type,bag}], {ok, Tab} = dets:open_file(Tab, Args), ok = dets:insert(Tab, [{I,One},{F,One},{I,FOne},{F,FOne}]), ok = dets:sync(Tab), @@ -3561,11 +3166,11 @@ otp_4738_bag(Version, Config) -> ok = dets:close(Tab), file:delete(File). -otp_4738_set(Version, Config) -> +otp_4738_set(Config) -> Tab = otp_4738, File = filename(Tab, Config), file:delete(File), - Args = [{file,File},{type,set},{version,Version}], + Args = [{file,File},{type,set}], %% I and F share the same slot. I = -12857447, @@ -3864,6 +3469,19 @@ wait_for_close(Tab) -> wait_for_close(Tab) end. +%% OTP-13830. Format 8 is no longer supported. +otp_13830(Config) -> + Tab = otp_13830, + File8 = filename:join(?datadir(Config), "version_8.dets"), + {error,{format_8_no_longer_supported,_}} = + dets:open_file(Tab, [{file, File8}]), + File = filename(Tab, Config), + %% Check the 'version' option, for backwards compatibility: + {ok, Tab} = dets:open_file(Tab, [{file, File}, {version, 9}]), + ok = dets:close(Tab), + {ok, Tab} = dets:open_file(Tab, [{file, File}, {version, default}]), + ok = dets:close(Tab). + %% %% Parts common to several test cases %% @@ -4000,9 +3618,7 @@ match_test(Data, Tab) -> %% Utilities %% -headsz(8) -> - ?HEADSZ_v8; -headsz(_) -> +headsz() -> ?HEADSZ_v9. unwritable(Fname) -> @@ -4030,13 +3646,13 @@ filename(Name, Config) when is_atom(Name) -> filename(Name, _Config) -> filename:join(?privdir(_Config), Name). -open_files(_Name, [], _Version) -> +open_files(_Name, []) -> []; -open_files(Name0, [Args | Tail], Version) -> +open_files(Name0, [Args | Tail]) -> ?format("init ~p~n", [Args]), Name = list_to_atom(integer_to_list(Name0)), - {ok, Name} = dets:open_file(Name, [{version,Version} | Args]), - [Name | open_files(Name0+1, Tail, Version)]. + {ok, Name} = dets:open_file(Name, Args), + [Name | open_files(Name0+1, Tail)]. close_all(Tabs) -> foreach(fun(Tab) -> ok = dets:close(Tab) end, Tabs). @@ -4137,20 +3753,15 @@ no_keys_test([T | Ts]) -> no_keys_test([]) -> ok; no_keys_test(T) -> - case dets:info(T, version) of - 8 -> - ok; - 9 -> - Kp = dets:info(T, keypos), - All = dets:match_object(T, '_'), - L = lists:map(fun(X) -> element(Kp, X) end, All), - NoKeys = length(lists:usort(L)), - case {dets:info(T, no_keys), NoKeys} of - {N, N} -> - ok; - {N1, N2} -> - exit({no_keys_test, N1, N2}) - end + Kp = dets:info(T, keypos), + All = dets:match_object(T, '_'), + L = lists:map(fun(X) -> element(Kp, X) end, All), + NoKeys = length(lists:usort(L)), + case {dets:info(T, no_keys), NoKeys} of + {N, N} -> + ok; + {N1, N2} -> + exit({no_keys_test, N1, N2}) end. safe_get_all_objects(Tab) -> @@ -4182,7 +3793,6 @@ count_objs_1({Ts,C}, N) when is_list(Ts) -> get_all_objects_fast(Tab) -> dets:match_object(Tab, '_'). -%% Relevant for version 8. histogram(Tab) -> OnePercent = case dets:info(Tab, no_slots) of undefined -> undefined; @@ -4244,10 +3854,6 @@ ave_histogram([{S,N1} | H], N) -> ave_histogram([], N) -> N. -bad_object({error,{bad_object,FileName}}, FileName) -> - ok; % Version 8, no debug. -bad_object({error,{{bad_object,_,_},FileName}}, FileName) -> - ok; % Version 8, debug... bad_object({error,{{bad_object,_}, FileName}}, FileName) -> ok; % No debug. bad_object({error,{{{bad_object,_,_},_,_,_}, FileName}}, FileName) -> diff --git a/lib/stdlib/test/dets_SUITE_data/dets_test_v8b.dets b/lib/stdlib/test/dets_SUITE_data/dets_test_v8b.dets Binary files differdeleted file mode 100644 index d0aa20fe06..0000000000 --- a/lib/stdlib/test/dets_SUITE_data/dets_test_v8b.dets +++ /dev/null diff --git a/lib/stdlib/test/dets_SUITE_data/dets_test_v8b_little_endian.dets b/lib/stdlib/test/dets_SUITE_data/dets_test_v8b_little_endian.dets Binary files differdeleted file mode 100644 index bf490afa1a..0000000000 --- a/lib/stdlib/test/dets_SUITE_data/dets_test_v8b_little_endian.dets +++ /dev/null diff --git a/lib/stdlib/test/dets_SUITE_data/version_r2d.dets b/lib/stdlib/test/dets_SUITE_data/version_8.dets Binary files differindex 327072f99e..278187e85c 100644 --- a/lib/stdlib/test/dets_SUITE_data/version_r2d.dets +++ b/lib/stdlib/test/dets_SUITE_data/version_8.dets diff --git a/lib/stdlib/test/dets_SUITE_data/version_r3b02.dets b/lib/stdlib/test/dets_SUITE_data/version_r3b02.dets Binary files differdeleted file mode 100644 index 058cd15b31..0000000000 --- a/lib/stdlib/test/dets_SUITE_data/version_r3b02.dets +++ /dev/null diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl index 47358d729f..e99af9ad42 100644 --- a/lib/stdlib/test/dict_SUITE.erl +++ b/lib/stdlib/test/dict_SUITE.erl @@ -23,10 +23,10 @@ -module(dict_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - create/1,store/1,iterate/1]). + create/1,store/1,iterate/1,remove/1]). -include_lib("common_test/include/ct.hrl"). @@ -37,7 +37,7 @@ suite() -> {timetrap,{minutes,5}}]. all() -> - [create, store, iterate]. + [create, store, remove, iterate]. groups() -> []. @@ -92,6 +92,27 @@ store_1(List, M) -> end, D0. +remove(_Config) -> + test_all([{0,87}], fun remove_1/2). + +remove_1(List0, M) -> + %% Make sure that keys are unique. Randomize key order. + List1 = orddict:from_list(List0), + List2 = lists:sort([{rand:uniform(),E} || E <- List1]), + List = [E || {_,E} <- List2], + D0 = M(from_list, List), + remove_2(List, D0, M). + +remove_2([{Key,Val}|T], D0, M) -> + {Val,D1} = M(take, {Key,D0}), + error = M(take, {Key,D1}), + D2 = M(erase, {Key,D0}), + true = M(equal, {D1,D2}), + remove_2(T, D1, M); +remove_2([], D, M) -> + true = M(is_empty, D), + D. + %%% %%% Test specifics for gb_trees. %%% diff --git a/lib/stdlib/test/dict_test_lib.erl b/lib/stdlib/test/dict_test_lib.erl index 7c4c3572ae..f6fef7bdf4 100644 --- a/lib/stdlib/test/dict_test_lib.erl +++ b/lib/stdlib/test/dict_test_lib.erl @@ -33,7 +33,9 @@ new(Mod, Eq) -> (iterator, S) -> Mod:iterator(S); (iterator_from, {Start, S}) -> Mod:iterator_from(Start, S); (next, I) -> Mod:next(I); - (to_list, D) -> to_list(Mod, D) + (to_list, D) -> to_list(Mod, D); + (erase, {K,D}) -> erase(Mod, K, D); + (take, {K,D}) -> take(Mod, K, D) end. empty(Mod) -> @@ -67,3 +69,19 @@ enter(Mod, Key, Val, Dict) -> true -> Mod:store(Key, Val, Dict) end. + +erase(Mod, Key, Val) when Mod =:= dict; Mod =:= orddict -> + Mod:erase(Key, Val); +erase(gb_trees, Key, Val) -> + gb_trees:delete_any(Key, Val). + +take(gb_trees, Key, Val) -> + Res = try + gb_trees:take(Key, Val) + catch + error:_ -> + error + end, + Res = gb_trees:take_any(Key, Val); +take(Mod, Key, Val) -> + Mod:take(Key, Val). diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 4078513e38..71d6820c47 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -306,7 +306,7 @@ otp_5362(Config) when is_list(Config) -> File_Back_hrl = filename:join(Dir, "back_5362.hrl"), Back = <<"-module(back_5362). - -compile(export_all). + -export([foo/1]). -file(?FILE, 1). -include(\"back_5362.hrl\"). @@ -334,7 +334,7 @@ otp_5362(Config) when is_list(Config) -> -file(?FILE, 100). - -compile(export_all). + -export([foo/1,bar/1]). -file(\"other.file\", ?LINE). % like an included file... foo(A) -> % line 105 @@ -362,7 +362,7 @@ otp_5362(Config) when is_list(Config) -> Blank = <<"-module(blank_5362). - -compile(export_all). + -export([q/1,a/1,b/1,c/1]). - file(?FILE, 18). q(Q) -> foo. % line 18 @@ -1258,7 +1258,7 @@ do_otp_8911(Config) -> File = "i.erl", Cont = <<"-module(i). - -compile(export_all). + -export([t/0]). -file(\"fil1\", 100). -include(\"i1.erl\"). t() -> @@ -1391,7 +1391,7 @@ otp_11728(Config) when is_list(Config) -> HrlFile = filename:join(Dir, "otp_11728.hrl"), ok = file:write_file(HrlFile, H), C = <<"-module(otp_11728). - -compile(export_all). + -export([function_name/0]). -include(\"otp_11728.hrl\"). @@ -1599,12 +1599,12 @@ check_test(Config, Test) -> end. compile_test(Config, Test0) -> - Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0], + Test = [<<"-module(epp_test). ">>, Test0], Filename = "epp_test.erl", PrivDir = proplists:get_value(priv_dir, Config), File = filename:join(PrivDir, Filename), ok = file:write_file(File, Test), - Opts = [export_all,return,nowarn_unused_record,{outdir,PrivDir}], + Opts = [export_all,nowarn_export_all,return,nowarn_unused_record,{outdir,PrivDir}], case compile_file(File, Opts) of {ok, Ws} -> warnings(File, Ws); Else -> Else @@ -1653,7 +1653,7 @@ unopaque_forms(Forms) -> [erl_parse:anno_to_term(Form) || Form <- Forms]. run_test(Config, Test0) -> - Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0], + Test = [<<"-module(epp_test). -export([t/0]). ">>, Test0], Filename = "epp_test.erl", PrivDir = proplists:get_value(priv_dir, Config), File = filename:join(PrivDir, Filename), diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 4ee3950882..c90f855b3b 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -64,7 +64,7 @@ predef/1, maps/1,maps_type/1,maps_parallel_match/1, otp_11851/1,otp_11879/1,otp_13230/1, - record_errors/1]). + record_errors/1, otp_xxxxx/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -84,7 +84,7 @@ all() -> too_many_arguments, basic_errors, bin_syntax_errors, predef, maps, maps_type, maps_parallel_match, otp_11851, otp_11879, otp_13230, - record_errors]. + record_errors, otp_xxxxx]. groups() -> [{unused_vars_warn, [], @@ -1863,7 +1863,7 @@ otp_5276(Config) when is_list(Config) -> %% OTP-5917. Check the 'deprecated' attributed. otp_5917(Config) when is_list(Config) -> Ts = [{otp_5917_1, - <<"-compile(export_all). + <<"-export([t/0]). -deprecated({t,0}). @@ -1878,7 +1878,7 @@ otp_5917(Config) when is_list(Config) -> %% OTP-6585. Check the deprecated guards list/1, pid/1, .... otp_6585(Config) when is_list(Config) -> Ts = [{otp_6585_1, - <<"-compile(export_all). + <<"-export([t/0]). -record(r, {}). @@ -2627,7 +2627,7 @@ otp_11772(Config) when is_list(Config) -> Ts = <<" -module(newly). - -compile(export_all). + -export([t/0]). %% Built-in: -type node() :: node(). @@ -2652,7 +2652,7 @@ otp_11771(Config) when is_list(Config) -> Ts = <<" -module(newly). - -compile(export_all). + -export([t/0]). %% No longer allowed in 17.0: -type arity() :: atom(). @@ -2679,7 +2679,7 @@ otp_11872(Config) when is_list(Config) -> Ts = <<" -module(map). - -compile(export_all). + -export([t/0]). -export_type([map/0, product/0]). @@ -2702,9 +2702,9 @@ export_all(Config) when is_list(Config) -> id(I) -> I. ">>, - [] = run_test2(Config, Ts, []), + [] = run_test2(Config, Ts, [nowarn_export_all]), {warnings,[{2,erl_lint,export_all}]} = - run_test2(Config, Ts, [warn_export_all]), + run_test2(Config, Ts, []), ok. %% Test warnings for functions that clash with BIFs. @@ -3005,7 +3005,7 @@ behaviour_basic(Config) when is_list(Config) -> {behaviour4, <<"-behavior(application). %% Test callbacks with export_all - -compile(export_all). + -compile([export_all, nowarn_export_all]). stop(_) -> ok. ">>, [], @@ -3869,6 +3869,55 @@ record_errors(Config) when is_list(Config) -> {3,erl_lint,{redefine_field,r,a}}],[]}}], run(Config, Ts). +otp_xxxxx(Config) -> + Ts = [{constraint1, + <<"-export([t/1]). + -spec t(X) -> X when is_subtype(integer()). + t(a) -> foo:bar(). + ">>, + [], + {errors, + [{2,erl_parse,"unsupported constraint " ++ ["is_subtype"]}], + []}}, + {constraint2, + <<"-export([t/1]). + -spec t(X) -> X when bad_atom(X, integer()). + t(a) -> foo:bar(). + ">>, + [], + {errors, + [{2,erl_parse,"unsupported constraint " ++ ["bad_atom"]}], + []}}, + {constraint3, + <<"-export([t/1]). + -spec t(X) -> X when is_subtype(bad_variable, integer()). + t(a) -> foo:bar(). + ">>, + [], + {errors,[{2,erl_parse,"bad type variable"}],[]}}, + {constraint4, + <<"-export([t/1]). + -spec t(X) -> X when is_subtype(atom(), integer()). + t(a) -> foo:bar(). + ">>, + [], + {errors,[{2,erl_parse,"bad type variable"}],[]}}, + {constraint5, + <<"-export([t/1]). + -spec t(X) -> X when is_subtype(X, integer()). + t(a) -> foo:bar(). + ">>, + [], + []}, + {constraint6, + <<"-export([t/1]). + -spec t(X) -> X when X :: integer(). + t(a) -> foo:bar(). + ">>, + [], + []}], + run(Config, Ts). + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 13c5662741..31ea3210a8 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -825,12 +825,13 @@ type_examples() -> %% is_subtype(V, T) syntax, we need a few examples of the syntax. {ex31,<<"-spec t1(FooBar :: t99()) -> t99();" "(t2()) -> t2();" - "('\\'t::4'()) -> '\\'t::4'() when is_subtype('\\'t::4'(), t24);" - "(t23()) -> t23() when is_subtype(t23(), atom())," - " is_subtype(t23(), t14());" - "(t24()) -> t24() when is_subtype(t24(), atom())," - " is_subtype(t24(), t14())," - " is_subtype(t24(), '\\'t::4'()).">>}, + "('\\'t::4'()) -> {'\\'t::4'(), B}" + " when is_subtype(B, '\\'t::4'());" + "(t23()) -> C when is_subtype(C, atom())," + " is_subtype(C, t14());" + "(t24()) -> D when is_subtype(D, atom())," + " is_subtype(D, t14())," + " is_subtype(D, '\\'t::4'()).">>}, {ex32,<<"-spec mod:t2() -> any(). ">>}, {ex33,<<"-opaque attributes_data() :: " "[{'column', column()} | {'line', info_line()} |" diff --git a/lib/stdlib/test/error_logger_h_SUITE.erl b/lib/stdlib/test/error_logger_h_SUITE.erl index 2a34c7764f..30f96e0522 100644 --- a/lib/stdlib/test/error_logger_h_SUITE.erl +++ b/lib/stdlib/test/error_logger_h_SUITE.erl @@ -297,13 +297,13 @@ match_format(Tag, [Format,Args], [Head|Lines], AtNode, Depth) -> iolist_to_binary(S) end, Expected0 = binary:split(Bin, <<"\n">>, [global,trim]), - Expected = Expected0 ++ AtNode, + Expected = AtNode ++ Expected0, match_term_lines(Expected, Lines). match_term(Tag, [Arg], [Head|Lines], AtNode, Depth) -> match_head(Tag, Head), Expected0 = match_term_get_expected(Arg, Depth), - Expected = Expected0 ++ AtNode, + Expected = AtNode ++ Expected0, match_term_lines(Expected, Lines). match_term_get_expected(List, Depth) when is_list(List) -> diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index 28d69232a0..0b9106a99c 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -28,6 +28,7 @@ strange_name/1, emulator_flags/1, emulator_flags_no_shebang/1, + two_lines/1, module_script/1, beam_script/1, archive_script/1, @@ -49,7 +50,7 @@ suite() -> all() -> [basic, errors, strange_name, emulator_flags, - emulator_flags_no_shebang, + emulator_flags_no_shebang, two_lines, module_script, beam_script, archive_script, epp, create_and_extract, foldl, overflow, archive_script_file_access, unicode]. @@ -153,6 +154,18 @@ emulator_flags(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +two_lines(Config) when is_list(Config) -> + Data = proplists:get_value(data_dir, Config), + Dir = filename:absname(Data), %Get rid of trailing slash. + run(Dir, "two_lines -arg1 arg2 arg3", + [<<"main:[\"-arg1\",\"arg2\",\"arg3\"]\n" + "ERL_FLAGS=false\n" + "unknown:[]\n" + "ExitCode:0">>]), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + emulator_flags_no_shebang(Config) when is_list(Config) -> Data = proplists:get_value(data_dir, Config), Dir = filename:absname(Data), %Get rid of trailing slash. diff --git a/lib/stdlib/test/escript_SUITE_data/two_lines b/lib/stdlib/test/escript_SUITE_data/two_lines new file mode 100755 index 0000000000..cf4e99639c --- /dev/null +++ b/lib/stdlib/test/escript_SUITE_data/two_lines @@ -0,0 +1,2 @@ +#! /usr/bin/env escript +main(MainArgs) -> io:format("main:~p\n", [MainArgs]), ErlArgs = init:get_arguments(), io:format("ERL_FLAGS=~p\n", [os:getenv("ERL_FLAGS")]), io:format("unknown:~p\n",[[E || E <- ErlArgs, element(1, E) =:= unknown]]). diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 4415c2d09d..9a7400c84e 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -21,22 +21,24 @@ -include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([start/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, notify/1, sync_notify/1, call/1, info/1, hibernate/1, call_format_status/1, call_format_status_anon/1, - error_format_status/1, get_state/1, replace_state/1]). + error_format_status/1, get_state/1, replace_state/1, + start_opt/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [start, {group, test_all}, hibernate, call_format_status, call_format_status_anon, error_format_status, - get_state, replace_state]. + get_state, replace_state, + start_opt]. -groups() -> +groups() -> [{test_all, [], [add_handler, add_sup_handler, delete_handler, swap_handler, swap_sup_handler, notify, sync_notify, @@ -59,6 +61,9 @@ end_per_group(_GroupName, Config) -> %% Start an event manager. %% -------------------------------------- +-define(LMGR, {local, my_dummy_name}). +-define(GMGR, {global, my_dummy_name}). + start(Config) when is_list(Config) -> OldFl = process_flag(trap_exit, true), @@ -72,40 +77,36 @@ start(Config) when is_list(Config) -> [] = gen_event:which_handlers(Pid1), ok = gen_event:stop(Pid1), - {ok, Pid2} = gen_event:start({local, my_dummy_name}), + {ok, Pid2} = gen_event:start(?LMGR), [] = gen_event:which_handlers(my_dummy_name), [] = gen_event:which_handlers(Pid2), ok = gen_event:stop(my_dummy_name), - {ok, Pid3} = gen_event:start_link({local, my_dummy_name}), + {ok, Pid3} = gen_event:start_link(?LMGR), [] = gen_event:which_handlers(my_dummy_name), [] = gen_event:which_handlers(Pid3), ok = gen_event:stop(my_dummy_name), - {ok, Pid4} = gen_event:start_link({global, my_dummy_name}), - [] = gen_event:which_handlers({global, my_dummy_name}), + {ok, Pid4} = gen_event:start_link(?GMGR), + [] = gen_event:which_handlers(?GMGR), [] = gen_event:which_handlers(Pid4), - ok = gen_event:stop({global, my_dummy_name}), + ok = gen_event:stop(?GMGR), {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}), [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}), [] = gen_event:which_handlers(Pid5), ok = gen_event:stop({via, dummy_via, my_dummy_name}), - {ok, _} = gen_event:start_link({local, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({local, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({local, my_dummy_name}), + {ok, _} = gen_event:start_link(?LMGR), + {error, {already_started, _}} = gen_event:start_link(?LMGR), + {error, {already_started, _}} = gen_event:start(?LMGR), ok = gen_event:stop(my_dummy_name), - {ok, Pid6} = gen_event:start_link({global, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({global, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({global, my_dummy_name}), + {ok, Pid6} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start(?GMGR), - ok = gen_event:stop({global, my_dummy_name}, shutdown, 10000), + ok = gen_event:stop(?GMGR, shutdown, 10000), receive {'EXIT', Pid6, shutdown} -> ok after 10000 -> @@ -113,10 +114,8 @@ start(Config) when is_list(Config) -> end, {ok, Pid7} = gen_event:start_link({via, dummy_via, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({via, dummy_via, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}), exit(Pid7, shutdown), receive @@ -128,6 +127,83 @@ start(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +start_opt(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + + dummy_via:reset(), + + {ok, Pid0} = gen_event:start([]), %anonymous + [] = gen_event:which_handlers(Pid0), + ok = gen_event:stop(Pid0), + + {ok, Pid1} = gen_event:start_link([]), %anonymous + [] = gen_event:which_handlers(Pid1), + ok = gen_event:stop(Pid1), + + {ok, Pid2} = gen_event:start(?LMGR, []), + [] = gen_event:which_handlers(my_dummy_name), + [] = gen_event:which_handlers(Pid2), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid3} = gen_event:start_link(?LMGR, []), + [] = gen_event:which_handlers(my_dummy_name), + [] = gen_event:which_handlers(Pid3), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid4} = gen_event:start_link(?GMGR, []), + [] = gen_event:which_handlers(?GMGR), + [] = gen_event:which_handlers(Pid4), + ok = gen_event:stop(?GMGR), + + {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}, []), + [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}), + [] = gen_event:which_handlers(Pid5), + ok = gen_event:stop({via, dummy_via, my_dummy_name}), + + {ok, _} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid7} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start_link(?GMGR, []), + {error, {already_started, _}} = gen_event:start(?GMGR, []), + + ok = gen_event:stop(?GMGR, shutdown, 10000), + receive + {'EXIT', Pid7, shutdown} -> ok + after 10000 -> + ct:fail(exit_gen_event) + end, + + {ok, Pid8} = gen_event:start_link({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}, []), + {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}, []), + + exit(Pid8, shutdown), + receive + {'EXIT', Pid8, shutdown} -> ok + after 10000 -> + ct:fail(exit_gen_event) + end, + + %% test spawn_opt + MinHeapSz = 10000, + {ok, Pid9} = gen_event:start_link(?LMGR, [{spawn_opt, [{min_heap_size, MinHeapSz}]}]), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + {heap_size, HeapSz} = erlang:process_info(Pid9, heap_size), + true = HeapSz > MinHeapSz, + ok = gen_event:stop(my_dummy_name), + + %% test debug opt + {ok, _} = gen_event:start_link(?LMGR, [{debug,[debug]}]), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + ok = gen_event:stop(my_dummy_name), + + process_flag(trap_exit, OldFl), + ok. hibernate(Config) when is_list(Config) -> {ok,Pid} = gen_event:start({local, my_dummy_handler}), diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 338cd3dc0a..6888cb8c58 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -375,12 +375,14 @@ crash(Config) when is_list(Config) -> %% from gen_server. {ok,Pid4} = gen_server:start(?MODULE, {state,state4}, []), {'EXIT',{crashed,_}} = (catch gen_server:call(Pid4, crash)), + ClientPid = self(), receive {error,_GroupLeader4,{Pid4, "** Generic server"++_, [Pid4,crash,{formatted, state4}, {crashed,[{?MODULE,handle_call,3,_} - |_Stacktrace]}]}} -> + |_Stacktrace]}, + ClientPid, [_|_] = _ClientStack]}} -> ok; Other4a -> io:format("Unexpected: ~p", [Other4a]), @@ -1115,12 +1117,14 @@ error_format_status(Config) when is_list(Config) -> {'EXIT', Pid, crashed} -> ok end, + ClientPid = self(), receive {error,_GroupLeader,{Pid, "** Generic server"++_, [Pid,crash,{formatted, State}, {crashed,[{?MODULE,handle_call,3,_} - |_Stacktrace]}]}} -> + |_Stacktrace]}, + ClientPid, [_|_] = _ClientStack]}} -> ok; Other -> io:format("Unexpected: ~p", [Other]), @@ -1138,12 +1142,14 @@ terminate_crash_format(Config) when is_list(Config) -> {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []), gen_server:call(Pid, stop), receive {'EXIT', Pid, {crash, terminate}} -> ok end, + ClientPid = self(), receive {error,_GroupLeader,{Pid, "** Generic server"++_, [Pid,stop, {formatted, State}, - {{crash, terminate},[{?MODULE,terminate,2,_} - |_Stacktrace]}]}} -> + {{crash, terminate}, + [{?MODULE,terminate,2,_}|_Stacktrace]}, + ClientPid, [_|_] = _ClientStack]}} -> ok; Other -> io:format("Unexpected: ~p", [Other]), diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 8c7d5a5fcf..c08e138ad3 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -7936,7 +7936,6 @@ compile(Config, Tests, Fun) -> compile_file(Config, Test0, Opts0) -> {File, Mod} = compile_file_mod(Config), Test = list_to_binary(["-module(", atom_to_list(Mod), "). " - "-compile(export_all). " "-import(qlc_SUITE, [i/1,i/2,format_info/2]). " "-import(qlc_SUITE, [etsc/2, etsc/3]). " "-import(qlc_SUITE, [create_ets/2]). " @@ -7946,7 +7945,7 @@ compile_file(Config, Test0, Opts0) -> "-import(qlc_SUITE, [lookup_keys/1]). " "-include_lib(\"stdlib/include/qlc.hrl\"). ", Test0]), - Opts = [export_all,return,nowarn_unused_record,{outdir,?privdir}|Opts0], + Opts = [export_all,nowarn_export_all,return,nowarn_unused_record,{outdir,?privdir}|Opts0], ok = file:write_file(File, Test), case compile:file(File, Opts) of {ok, _M, Ws} -> warnings(File, Ws); diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 8e7ac223a7..fe5eaccda5 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -283,13 +283,13 @@ gen(_, _, Acc) -> lists:reverse(Acc). %% Check that the algorithms generate sound values. basic_stats_uniform_1(Config) when is_list(Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time [basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}])) || Alg <- algs()], ok. basic_stats_uniform_2(Config) when is_list(Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time [basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}])) || Alg <- algs()], ok. @@ -396,7 +396,7 @@ crypto_uniform_n(N, State0) -> %% Not a test but measures the time characteristics of the different algorithms measure(Suite) when is_atom(Suite) -> []; measure(_Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time Algos = [crypto64|algs()], io:format("RNG uniform integer performance~n",[]), _ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 07eb6772db..15ccdea284 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1794,7 +1794,7 @@ Test1_shell = Test2 = <<"-module(recs). -record(person, {name, age, phone = [], dict = []}). --compile(export_all). +-export([t/0]). t() -> ok. @@ -1961,7 +1961,7 @@ ok. progex_funs(Config) when is_list(Config) -> Test1 = <<"-module(funs). - -compile(export_all). + -export([t/0]). double([H|T]) -> [2*H|double(T)]; double([]) -> []. @@ -2326,7 +2326,7 @@ otp_6554(Config) when is_list(Config) -> "[unproper | list]).">>), %% Cheating: "exception error: no function clause matching " - "erl_eval:do_apply(4)" ++ _ = + "shell:apply_fun(4)" ++ _ = comm_err(<<"erlang:error(function_clause, [4]).">>), "exception error: no function clause matching " "lists:reverse(" ++ _ = @@ -3031,7 +3031,7 @@ run_file(Config, Module, Test) -> ok. compile_file(Config, File, Test, Opts0) -> - Opts = [export_all,return,{outdir,proplists:get_value(priv_dir, Config)}|Opts0], + Opts = [export_all,nowarn_export_all,return,{outdir,proplists:get_value(priv_dir, Config)}|Opts0], ok = file:write_file(File, Test), case compile:file(File, Opts) of {ok, _M, _Ws} -> ok; diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index c74343d9ca..e67cb9b08d 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 3.1 +STDLIB_VSN = 3.2 diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml index 82c4484d96..e8de0ffce2 100644 --- a/lib/syntax_tools/doc/src/notes.xml +++ b/lib/syntax_tools/doc/src/notes.xml @@ -32,6 +32,22 @@ <p>This document describes the changes made to the Syntax_Tools application.</p> +<section><title>Syntax_Tools 2.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The address to the FSF in the license header has been + updated.</p> + <p> + Own Id: OTP-14084</p> + </item> + </list> + </section> + +</section> + <section><title>Syntax_Tools 2.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk index c0ca083c38..c5e363112b 100644 --- a/lib/syntax_tools/vsn.mk +++ b/lib/syntax_tools/vsn.mk @@ -1 +1 @@ -SYNTAX_TOOLS_VSN = 2.1 +SYNTAX_TOOLS_VSN = 2.1.1 diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 2d9bee0dd1..415f1b8516 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -31,6 +31,42 @@ </header> <p>This document describes the changes made to the Tools application.</p> +<section><title>Tools 2.9</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix unhandled trace event send_to_non_existing_process in + fprof.</p> + <p> + Own Id: OTP-13998</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Improved edoc support in emacs erlang-mode.</p> + <p> + Own Id: OTP-13945 Aux Id: PR-1157 </p> + </item> + <item> + <p> + Added erldoc to emacs mode which opens html documentation + in browser from emacs. For example <c>M-x erldoc-browse + RET lists:foreach/2</c>.</p> + <p> + Own Id: OTP-14018 Aux Id: PR-1197 </p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.8.6</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/tools/emacs/erlang-edoc.el b/lib/tools/emacs/erlang-edoc.el index 034036ad04..2801aa8ae7 100644 --- a/lib/tools/emacs/erlang-edoc.el +++ b/lib/tools/emacs/erlang-edoc.el @@ -78,7 +78,7 @@ '(("^%+\\s-*\\(@\\w+\\)\\_>" 1 'erlang-edoc-tag prepend) ("^%+\\s-*" ("{\\(@\\w+\\)\\_>" nil nil (1 'erlang-edoc-macro prepend))) ("^%+\\s-*" ("\\(?:@@\\)*\\(@[@{}]\\)" nil nil (1 'escape-glyph prepend))) - ("^%+\\s-*@\\(deprecated\\)\\_>" 1 font-lock-warning-face prepend) + ("^%+\\s-*\\(@deprecated\\)\\_>" 1 font-lock-warning-face prepend) ;; http://www.erlang.org/doc/apps/edoc/chapter.html#Wiki_notation ("^%+\\s-*" ("[^`]`\\([^`]?\\|[^`].*?[^']\\)'" (forward-char -1) nil (1 'erlang-edoc-verbatim prepend))) diff --git a/lib/tools/emacs/erlang-flymake.el b/lib/tools/emacs/erlang-flymake.el index 2e447b55de..0b7936a81f 100644 --- a/lib/tools/emacs/erlang-flymake.el +++ b/lib/tools/emacs/erlang-flymake.el @@ -37,8 +37,7 @@ "Return a list of include directories to add to the compiler options.") (defvar erlang-flymake-extra-opts - (list "+warn_obsolete_guard" - "+warn_unused_import" + (list "+warn_unused_import" "+warn_shadow_vars" "+warn_export_vars" "+strong_validation" diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl index b833d96c19..fff67eb0fd 100644 --- a/lib/tools/src/tags.erl +++ b/lib/tools/src/tags.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index 18166cceb0..4c7dd24006 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index e066dbf5e9..07bc39f76e 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 2.8.6 +TOOLS_VSN = 2.9 diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 6aee749741..3bff546243 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -136,8 +136,9 @@ extract(#analysis{macros = Macros, MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1), CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2), - CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3), - dialyzer_contracts:process_contract_remote_types(CodeServer4) + {CodeServer4, RecordDict} = + dialyzer_utils:process_record_remote_types(CodeServer3), + dialyzer_contracts:process_contract_remote_types(CodeServer4, RecordDict) catch throw:{error, ErrorMsg} -> compile_error(ErrorMsg) @@ -149,7 +150,7 @@ extract(#analysis{macros = Macros, fun(Module, TmpPlt) -> {ok, ModuleContracts} = dict:find(Module, Contracts), SpecList = [{MFA, Contract} - || {MFA, {_FileLine, Contract}} <- dict:to_list(ModuleContracts)], + || {MFA, {_FileLine, Contract}} <- maps:to_list(ModuleContracts)], dialyzer_plt:insert_contract_list(TmpPlt, SpecList) end, NewTrustPLT = lists:foldl(FoldFun, TrustPLT, Modules), @@ -165,8 +166,10 @@ get_type_info(#analysis{callgraph = CallGraph, StrippedCallGraph = remove_external(CallGraph, TrustPLT), %% io:format("--- Analyzing callgraph... "), try - NewPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph, - TrustPLT, CodeServer), + NewMiniPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph, + TrustPLT, + CodeServer), + NewPlt = dialyzer_plt:restore_full_plt(NewMiniPlt), Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt} catch error:What -> @@ -217,7 +220,7 @@ get_external(Exts, Plt) -> -type fa() :: {atom(), arity()}. -type func_info() :: {line(), atom(), arity()}. --record(info, {records = map__new() :: map_dict(), +-record(info, {records = maps:new() :: erl_types:type_table(), functions = [] :: [func_info()], types = map__new() :: map_dict(), edoc = false :: boolean()}). @@ -260,7 +263,7 @@ write_inc_files(Inc) -> Functions = [Key || {Key, _} <- Val], Val1 = [{{F,A},Type} || {{_Line,F,A},Type} <- Val], Info = #info{types = map__from_list(Val1), - records = map__new(), + records = maps:new(), %% Note we need to sort functions here! functions = lists:keysort(1, Functions)}, %% io:format("Types ~p\n", [Info#info.types]), @@ -842,8 +845,9 @@ collect_info(Analysis) -> TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer), TmpCServer2 = dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), - TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), - dialyzer_contracts:process_contract_remote_types(TmpCServer3) + {TmpCServer3, RecordDict} = + dialyzer_utils:process_record_remote_types(TmpCServer2), + dialyzer_contracts:process_contract_remote_types(TmpCServer3, RecordDict) catch throw:{error, ErrorMsg} -> fatal_error(ErrorMsg) diff --git a/lib/wx/doc/src/notes.xml b/lib/wx/doc/src/notes.xml index 70ff0a92b7..9086117c81 100644 --- a/lib/wx/doc/src/notes.xml +++ b/lib/wx/doc/src/notes.xml @@ -32,6 +32,35 @@ <p>This document describes the changes made to the wxErlang application.</p> +<section><title>Wx 1.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Allow string arguments to be binaries as specified, i.e. + unicode:chardata().</p> + <p> + Own Id: OTP-13934 Aux Id: ERL-270 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add wxWindow:dragAcceptFiles/2 and wxDropFilesEvent to + support simple drag and drop from file browser.</p> + <p> + Own Id: OTP-13933</p> + </item> + </list> + </section> + +</section> + <section><title>Wx 1.7.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk index 0ce63d9f71..cfa256fb12 100644 --- a/lib/wx/vsn.mk +++ b/lib/wx/vsn.mk @@ -1 +1 @@ -WX_VSN = 1.7.1 +WX_VSN = 1.8 diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 5e0459ec21..9f6b27113e 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -2225,16 +2225,18 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook, AllAttrs = case S#xmerl_scanner.default_attrs of true -> - [ #xmlAttribute{name = AttName, - parents = [{Name, Pos} | Parents], - language = Lang, - nsinfo = NSI, - namespace = Namespace, - value = AttValue, - normalized = true} || - {AttName, AttValue} <- get_default_attrs(S, Name), - AttValue =/= no_value, - not lists:keymember(AttName, #xmlAttribute.name, Attrs) ]; + DefaultAttrs = + [ #xmlAttribute{name = AttName, + parents = [{Name, Pos} | Parents], + language = Lang, + nsinfo = NSI, + namespace = Namespace, + value = AttValue, + normalized = true} || + {AttName, AttValue} <- get_default_attrs(S, Name), + AttValue =/= no_value, + not lists:keymember(AttName, #xmlAttribute.name, Attrs) ], + lists:append(Attrs, DefaultAttrs); false -> Attrs end, diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index e97b8c6a4b..cf7c0b7548 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -54,7 +54,8 @@ groups() -> cpd_expl_provided_DTD]}, {misc, [], [latin1_alias, syntax_bug1, syntax_bug2, syntax_bug3, - pe_ref1, copyright, testXSEIF, export_simple1, export]}, + pe_ref1, copyright, testXSEIF, export_simple1, export, + default_attrs_bug]}, {eventp_tests, [], [sax_parse_and_export]}, {ticket_tests, [], [ticket_5998, ticket_7211, ticket_7214, ticket_7430, @@ -223,6 +224,21 @@ syntax_bug3(Config) -> Err -> Err end. +default_attrs_bug(Config) -> + file:set_cwd(datadir(Config)), + Doc = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n" + "<doc a=\"explicit\"/>", + {#xmlElement{attributes = [#xmlAttribute{name = a, value = "explicit"}, + #xmlAttribute{name = b, value = "default"}]}, + [] + } = xmerl_scan:string(Doc, [{default_attrs, true}]), + Doc2 = "<!DOCTYPE doc [<!ATTLIST doc b CDATA \"default\">]>\n" + "<doc b=\"also explicit\" a=\"explicit\"/>", + {#xmlElement{attributes = [#xmlAttribute{name = b, value = "also explicit"}, + #xmlAttribute{name = a, value = "explicit"}]}, + [] + } = xmerl_scan:string(Doc2, [{default_attrs, true}]). + pe_ref1(Config) -> file:set_cwd(datadir(Config)), {#xmlElement{},[]} = xmerl_scan:file(datadir_join(Config,[misc,"PE_ref1.xml"]),[{validation,true}]). diff --git a/otp_versions.table b/otp_versions.table index 793f7bcd28..575a358010 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,5 @@ +OTP-19.2.1 : erts-8.2.1 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 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.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.2 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : +OTP-19.2 : common_test-1.13 compiler-7.0.3 crypto-3.7.2 dialyzer-3.0.3 edoc-0.8.1 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2 eunit-2.3.2 hipe-3.15.3 inets-6.3.4 kernel-5.1.1 mnesia-4.14.2 observer-2.3 odbc-2.12 parsetools-2.1.4 public_key-1.3 runtime_tools-1.11 sasl-3.0.2 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 wx-1.8 # asn1-4.0.4 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 debugger-4.2.1 diameter-1.12.1 eldap-1.2.2 et-1.6 gs-1.6.2 ic-4.4.2 jinterface-1.7.1 megaco-3.18.1 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 percept-0.9 reltool-0.7.2 snmp-5.2.4 typer-0.9.11 xmerl-1.3.12 : OTP-19.1.6 : erts-8.1.1 # asn1-4.0.4 common_test-1.12.3 compiler-7.0.2 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.1 debugger-4.2.1 dialyzer-3.0.2 diameter-1.12.1 edoc-0.8 eldap-1.2.2 erl_docgen-0.6 erl_interface-3.9.1 et-1.6 eunit-2.3.1 gs-1.6.2 hipe-3.15.2 ic-4.4.2 inets-6.3.3 jinterface-1.7.1 kernel-5.1 megaco-3.18.1 mnesia-4.14.1 observer-2.2.2 odbc-2.11.3 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.3 percept-0.9 public_key-1.2 reltool-0.7.2 runtime_tools-1.10.1 sasl-3.0.1 snmp-5.2.4 ssh-4.3.6 ssl-8.0.3 stdlib-3.1 syntax_tools-2.1 tools-2.8.6 typer-0.9.11 wx-1.7.1 xmerl-1.3.12 : OTP-19.1.5 : ssh-4.3.6 # asn1-4.0.4 common_test-1.12.3 compiler-7.0.2 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.1 debugger-4.2.1 dialyzer-3.0.2 diameter-1.12.1 edoc-0.8 eldap-1.2.2 erl_docgen-0.6 erl_interface-3.9.1 erts-8.1 et-1.6 eunit-2.3.1 gs-1.6.2 hipe-3.15.2 ic-4.4.2 inets-6.3.3 jinterface-1.7.1 kernel-5.1 megaco-3.18.1 mnesia-4.14.1 observer-2.2.2 odbc-2.11.3 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.3 percept-0.9 public_key-1.2 reltool-0.7.2 runtime_tools-1.10.1 sasl-3.0.1 snmp-5.2.4 ssl-8.0.3 stdlib-3.1 syntax_tools-2.1 tools-2.8.6 typer-0.9.11 wx-1.7.1 xmerl-1.3.12 : OTP-19.1.4 : ssh-4.3.5 # asn1-4.0.4 common_test-1.12.3 compiler-7.0.2 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.1 debugger-4.2.1 dialyzer-3.0.2 diameter-1.12.1 edoc-0.8 eldap-1.2.2 erl_docgen-0.6 erl_interface-3.9.1 erts-8.1 et-1.6 eunit-2.3.1 gs-1.6.2 hipe-3.15.2 ic-4.4.2 inets-6.3.3 jinterface-1.7.1 kernel-5.1 megaco-3.18.1 mnesia-4.14.1 observer-2.2.2 odbc-2.11.3 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.3 percept-0.9 public_key-1.2 reltool-0.7.2 runtime_tools-1.10.1 sasl-3.0.1 snmp-5.2.4 ssl-8.0.3 stdlib-3.1 syntax_tools-2.1 tools-2.8.6 typer-0.9.11 wx-1.7.1 xmerl-1.3.12 : diff --git a/scripts/run-smoke-tests b/scripts/run-smoke-tests new file mode 100755 index 0000000000..c2333e7825 --- /dev/null +++ b/scripts/run-smoke-tests @@ -0,0 +1,10 @@ +#!/bin/bash +set -ev + +cd $ERL_TOP/release/tests/test_server +$ERL_TOP/bin/erl -s ts install -s ts smoke_test batch -s init stop + +if grep -q '=failed *[1-9]' ct_run.test_server@*/*/run.*/suite.log; then + echo "One or more tests failed." + exit 1 +fi diff --git a/system/doc/efficiency_guide/advanced.xml b/system/doc/efficiency_guide/advanced.xml index eee2648f34..e1760d0ded 100644 --- a/system/doc/efficiency_guide/advanced.xml +++ b/system/doc/efficiency_guide/advanced.xml @@ -87,15 +87,15 @@ </row> <row> <cell>Small Map</cell> - <cell>4 words + 2 words per entry (key and value) + the size of each key and value pair.</cell> + <cell>5 words + the size of all keys and values.</cell> </row> <row> - <cell>Large Map</cell> + <cell>Large Map (> 32 keys)</cell> <cell> - At least, 2 words + 2 x <c>N</c> words + 2 x log16(<c>N</c>) words + - the size of each key and value pair, where <c>N</c> is the number of pairs in the Map. - A large Map is represented as a tree internally where each node in the tree is a - "sparse tuple" of arity 16. + <c>N</c> x <c>F</c> words + the size of all keys and values.<br></br> + <c>N</c> is the number of keys in the Map.<br></br> + <c>F</c> is a sparsity factor that can vary between 1.6 and 1.8 + due to the probabilistic nature of the internal HAMT data structure. </cell> </row> <row> diff --git a/system/doc/efficiency_guide/binaryhandling.xml b/system/doc/efficiency_guide/binaryhandling.xml index 0295d18644..91fd9a7cd9 100644 --- a/system/doc/efficiency_guide/binaryhandling.xml +++ b/system/doc/efficiency_guide/binaryhandling.xml @@ -32,12 +32,9 @@ <file>binaryhandling.xml</file> </header> - <p>In R12B, the most natural way to construct and match binaries is - significantly faster than in earlier releases.</p> + <p>Binaries can be efficiently built in the following way:</p> - <p>To construct a binary, you can simply write as follows:</p> - - <p><em>DO</em> (in R12B) / <em>REALLY DO NOT</em> (in earlier releases)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_list_to_binary(List) -> my_list_to_binary(List, <<>>). @@ -47,21 +44,13 @@ my_list_to_binary([H|T], Acc) -> my_list_to_binary([], Acc) -> Acc.]]></code> - <p>In releases before R12B, <c>Acc</c> is copied in every iteration. - In R12B, <c>Acc</c> is copied only in the first iteration and extra - space is allocated at the end of the copied binary. In the next iteration, - <c>H</c> is written into the extra space. When the extra space runs out, - the binary is reallocated with more extra space. The extra space allocated - (or reallocated) is twice the size of the - existing binary data, or 256, whichever is larger.</p> - - <p>The most natural way to match binaries is now the fastest:</p> + <p>Binaries can be efficiently matched like this:</p> - <p><em>DO</em> (in R12B)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_binary_to_list(<<H,T/binary>>) -> [H|my_binary_to_list(T)]; -my_binary_to_list(<<>>) -> [].]]></code> +my_binary_to_list(<<>>) -> [].]]></code> <section> <title>How Binaries are Implemented</title> @@ -138,10 +127,7 @@ my_binary_to_list(<<>>) -> [].]]></code> pointer to the binary data. For each field that is matched out of a binary, the position in the match context is incremented.</p> - <p>In R11B, a match context was only used during a binary matching - operation.</p> - - <p>In R12B, the compiler tries to avoid generating code that + <p>The compiler tries to avoid generating code that creates a sub binary, only to shortly afterwards create a new match context and discard the sub binary. Instead of creating a sub binary, the match context is kept.</p> @@ -155,7 +141,7 @@ my_binary_to_list(<<>>) -> [].]]></code> <section> <title>Constructing Binaries</title> - <p>In R12B, appending to a binary or bitstring + <p>Appending to a binary or bitstring is specially optimized by the <em>runtime system</em>:</p> <code type="erl"><![CDATA[ @@ -292,7 +278,7 @@ Bin = <<Bin1,...>> %% Bin1 will be COPIED <p>Let us revisit the example in the beginning of the previous section:</p> - <p><em>DO</em> (in R12B)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_binary_to_list(<<H,T/binary>>) -> [H|my_binary_to_list(T)]; @@ -304,15 +290,14 @@ my_binary_to_list(<<>>) -> [].]]></code> byte of the binary. 1 byte is matched out and the match context is updated to point to the second byte in the binary.</p> - <p>In R11B, at this point a - <seealso marker="#sub_binary">sub binary</seealso> - would be created. In R12B, - the compiler sees that there is no point in creating a sub binary, - because there will soon be a call to a function (in this case, + <p>At this point it would make sense to create a + <seealso marker="#sub_binary">sub binary</seealso>, + but in this particular example the compiler sees that + there will soon be a call to a function (in this case, to <c>my_binary_to_list/1</c> itself) that immediately will create a new match context and discard the sub binary.</p> - <p>Therefore, in R12B, <c>my_binary_to_list/1</c> calls itself + <p>Therefore <c>my_binary_to_list/1</c> calls itself with the match context instead of with a sub binary. The instruction that initializes the matching operation basically does nothing when it sees that it was passed a match context instead of a binary.</p> @@ -321,34 +306,10 @@ my_binary_to_list(<<>>) -> [].]]></code> the match context will simply be discarded (removed in the next garbage collection, as there is no longer any reference to it).</p> - <p>To summarize, <c>my_binary_to_list/1</c> in R12B only needs to create - <em>one</em> match context and no sub binaries. In R11B, if the binary - contains <em>N</em> bytes, <em>N+1</em> match contexts and <em>N</em> - sub binaries are created.</p> - - <p>In R11B, the fastest way to match binaries is as follows:</p> + <p>To summarize, <c>my_binary_to_list/1</c> only needs to create + <em>one</em> match context and no sub binaries.</p> - <p><em>DO NOT</em> (in R12B)</p> - <code type="erl"><![CDATA[ -my_complicated_binary_to_list(Bin) -> - my_complicated_binary_to_list(Bin, 0). - -my_complicated_binary_to_list(Bin, Skip) -> - case Bin of - <<_:Skip/binary,Byte,_/binary>> -> - [Byte|my_complicated_binary_to_list(Bin, Skip+1)]; - <<_:Skip/binary>> -> - [] - end.]]></code> - - <p>This function cleverly avoids building sub binaries, but it cannot - avoid building a match context in each recursion step. - Therefore, in both R11B and R12B, - <c>my_complicated_binary_to_list/1</c> builds <em>N+1</em> match - contexts. (In a future Erlang/OTP release, the compiler might be able - to generate code that reuses the match context.)</p> - - <p>Returning to <c>my_binary_to_list/1</c>, notice that the match context + <p>Notice that the match context in <c>my_binary_to_list/1</c> was discarded when the entire binary had been traversed. What happens if the iteration stops before it has reached the end of the binary? Will the optimization still work?</p> @@ -544,5 +505,15 @@ count3(<<>>, Count) -> Count.]]></code> not matched out.</p> </section> </section> + + <section> + <title>Historical Note</title> + + <p>Binary handling was significantly improved in R12B. Because + code that was efficient in R11B might not be efficient in R12B, + and vice versa, earlier revisions of this Efficiency Guide contained + some information about binary handling in R11B.</p> + </section> + </chapter> diff --git a/system/doc/efficiency_guide/commoncaveats.xml b/system/doc/efficiency_guide/commoncaveats.xml index ecfeff0349..94b1c0b222 100644 --- a/system/doc/efficiency_guide/commoncaveats.xml +++ b/system/doc/efficiency_guide/commoncaveats.xml @@ -148,10 +148,10 @@ multiple_setelement(T0) -> <p><c>size/1</c> returns the size for both tuples and binaries.</p> - <p>Using the new BIFs <c>tuple_size/1</c> and <c>byte_size/1</c>, introduced - in R12B, gives the compiler and the runtime system more opportunities for - optimization. Another advantage is that the new BIFs can help Dialyzer to - find more bugs in your program.</p> + <p>Using the BIFs <c>tuple_size/1</c> and <c>byte_size/1</c> + gives the compiler and the runtime system more opportunities for + optimization. Another advantage is that the BIFs give Dialyzer more + type information.</p> </section> <section> diff --git a/system/doc/efficiency_guide/functions.xml b/system/doc/efficiency_guide/functions.xml index 4a8248e65c..1d0f1f68b7 100644 --- a/system/doc/efficiency_guide/functions.xml +++ b/system/doc/efficiency_guide/functions.xml @@ -65,7 +65,7 @@ atom_map1(six) -> 6.</code> thus, quite efficient even if there are many values) to select which one of the first three clauses to execute (if any).</item> - <item>>If none of the first three clauses match, the fourth clause + <item>If none of the first three clauses match, the fourth clause match as a variable always matches.</item> <item>If the guard test <c>is_integer(Int)</c> succeeds, the fourth @@ -183,15 +183,6 @@ explicit_map_pairs(Map, Xs0, Ys0) -> A fun contains an (indirect) pointer to the function that implements the fun.</p> - <warning><p><em>Tuples are not fun(s)</em>. - A "tuple fun", <c>{Module,Function}</c>, is not a fun. - The cost for calling a "tuple fun" is similar to that - of <c>apply/3</c> or worse. - Using "tuple funs" is <em>strongly discouraged</em>, - as they might not be supported in a future Erlang/OTP release, - and because there exists a superior alternative from R10B, - namely the <c>fun Module:Function/Arity</c> syntax.</p></warning> - <p><c>apply/3</c> must look up the code for the function to execute in a hash table. It is therefore always slower than a direct call or a fun call.</p> diff --git a/system/doc/efficiency_guide/introduction.xml b/system/doc/efficiency_guide/introduction.xml index ca4a41c798..b650008ae8 100644 --- a/system/doc/efficiency_guide/introduction.xml +++ b/system/doc/efficiency_guide/introduction.xml @@ -46,14 +46,6 @@ to find out where the performance bottlenecks are and optimize only the bottlenecks. Let other code stay as clean as possible.</p> - <p>Fortunately, compiler and runtime optimizations introduced in - Erlang/OTP R12B makes it easier to write code that is both clean and - efficient. For example, the ugly workarounds needed in R11B and earlier - releases to get the most speed out of binary pattern matching are - no longer necessary. In fact, the ugly code is slower - than the clean code (because the clean code has become faster, not - because the uglier code has become slower).</p> - <p>This Efficiency Guide cannot really teach you how to write efficient code. It can give you a few pointers about what to avoid and what to use, and some understanding of how certain language features are implemented. diff --git a/system/doc/efficiency_guide/listhandling.xml b/system/doc/efficiency_guide/listhandling.xml index 2ebc877820..ec258d7c2a 100644 --- a/system/doc/efficiency_guide/listhandling.xml +++ b/system/doc/efficiency_guide/listhandling.xml @@ -90,7 +90,7 @@ tail_recursive_fib(N, Current, Next, Fibs) -> <p>Lists comprehensions still have a reputation for being slow. They used to be implemented using funs, which used to be slow.</p> - <p>In recent Erlang/OTP releases (including R12B), a list comprehension:</p> + <p>A list comprehension:</p> <code type="erl"><![CDATA[ [Expr(E) || E <- List]]]></code> @@ -102,7 +102,7 @@ tail_recursive_fib(N, Current, Next, Fibs) -> [Expr(E)|'lc^0'(Tail, Expr)]; 'lc^0'([], _Expr) -> [].</code> - <p>In R12B, if the result of the list comprehension will <em>obviously</em> + <p>If the result of the list comprehension will <em>obviously</em> not be used, a list will not be constructed. For example, in this code:</p> <code type="erl"><![CDATA[ @@ -131,6 +131,14 @@ some_function(...), 'lc^0'(Tail, Expr); 'lc^0'([], _Expr) -> [].</code> + <p>The compiler also understands that assigning to '_' means that + the value will not used. Therefore, the code in the following example + will also be optimized:</p> + + <code type="erl"><![CDATA[ +_ = [io:put_chars(E) || E <- List], +ok.]]></code> + </section> <section> @@ -209,11 +217,11 @@ some_function(...), <section> <title>Recursive List Functions</title> - <p>In Section 7.2, the following myth was exposed: + <p>In section about myths, the following myth was exposed: <seealso marker="myths#tail_recursive">Tail-Recursive Functions are Much Faster Than Recursive Functions</seealso>.</p> - <p>To summarize, in R12B there is usually not much difference between + <p>There is usually not much difference between a body-recursive list function and tail-recursive function that reverses the list at the end. Therefore, concentrate on writing beautiful code and forget about the performance of your list functions. In the diff --git a/system/doc/efficiency_guide/myths.xml b/system/doc/efficiency_guide/myths.xml index 5d3ad78b23..778cd06c09 100644 --- a/system/doc/efficiency_guide/myths.xml +++ b/system/doc/efficiency_guide/myths.xml @@ -24,7 +24,7 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> - <title>The Eight Myths of Erlang Performance</title> + <title>The Seven Myths of Erlang Performance</title> <prepared>Bjorn Gustavsson</prepared> <docno></docno> <date>2007-11-10</date> @@ -35,80 +35,33 @@ <marker id="myths"></marker> <p>Some truths seem to live on well beyond their best-before date, perhaps because "information" spreads faster from person-to-person - than a single release note that says, for example, that funs - have become faster.</p> + than a single release note that says, for example, that body-recursive + calls have become faster.</p> <p>This section tries to kill the old truths (or semi-truths) that have become myths.</p> <section> - <title>Myth: Funs are Slow</title> - <p>Funs used to be very slow, slower than <c>apply/3</c>. - Originally, funs were implemented using nothing more than - compiler trickery, ordinary tuples, <c>apply/3</c>, and a great - deal of ingenuity.</p> - - <p>But that is history. Funs was given its own data type - in R6B and was further optimized in R7B. - Now the cost for a fun call falls roughly between the cost for a call - to a local function and <c>apply/3</c>.</p> - </section> - - <section> - <title>Myth: List Comprehensions are Slow</title> - - <p>List comprehensions used to be implemented using funs, and in the - old days funs were indeed slow.</p> - - <p>Nowadays, the compiler rewrites list comprehensions into an ordinary - recursive function. Using a tail-recursive function with - a reverse at the end would be still faster. Or would it? - That leads us to the next myth.</p> - </section> - - <section> <title>Myth: Tail-Recursive Functions are Much Faster Than Recursive Functions</title> <p><marker id="tail_recursive"></marker>According to the myth, - recursive functions leave references - to dead terms on the stack and the garbage collector has to copy - all those dead terms, while tail-recursive functions immediately - discard those terms.</p> - - <p>That used to be true before R7B. In R7B, the compiler started - to generate code that overwrites references to terms that will never - be used with an empty list, so that the garbage collector would not - keep dead values any longer than necessary.</p> - - <p>Even after that optimization, a tail-recursive function is - still most of the times faster than a body-recursive function. Why?</p> - - <p>It has to do with how many words of stack that are used in each - recursive call. In most cases, a recursive function uses more words - on the stack for each recursion than the number of words a tail-recursive - would allocate on the heap. As more memory is used, the garbage - collector is invoked more frequently, and it has more work traversing - the stack.</p> - - <p>In R12B and later releases, there is an optimization that - in many cases reduces the number of words used on the stack in - body-recursive calls. A body-recursive list function and a - tail-recursive function that calls <seealso - marker="stdlib:lists#reverse/1">lists:reverse/1</seealso> at - the end will use the same amount of memory. - <c>lists:map/2</c>, <c>lists:filter/2</c>, list comprehensions, - and many other recursive functions now use the same amount of space - as their tail-recursive equivalents.</p> - - <p>So, which is faster? - It depends. On Solaris/Sparc, the body-recursive function seems to - be slightly faster, even for lists with a lot of elements. On the x86 - architecture, tail-recursion was up to about 30% faster.</p> - - <p>So, the choice is now mostly a matter of taste. If you really do need - the utmost speed, you must <em>measure</em>. You can no longer be - sure that the tail-recursive list function always is the fastest.</p> + using a tail-recursive function that builds a list in reverse + followed by a call to <c>lists:reverse/1</c> is faster than + a body-recursive function that builds the list in correct order; + the reason being that body-recursive functions use more memory than + tail-recursive functions.</p> + + <p>That was true to some extent before R12B. It was even more true + before R7B. Today, not so much. A body-recursive function + generally uses the same amount of memory as a tail-recursive + function. It is generally not possible to predict whether the + tail-recursive or the body-recursive version will be + faster. Therefore, use the version that makes your code cleaner + (hint: it is usually the body-recursive version).</p> + + <p>For a more thorough discussion about tail and body recursion, + see <url href="http://ferd.ca/erlang-s-tail-recursion-is-not-a-silver-bullet.html">Erlang's Tail Recursion is Not a Silver Bullet</url>.</p> <note><p>A tail-recursive function that does not need to reverse the list at the end is faster than a body-recursive function, @@ -199,6 +152,29 @@ vanilla_reverse([], Acc) -> <p>That was once true, but from R6B the BEAM compiler can see that a variable is not used.</p> + + <p>Similarly, trivial transformations on the source-code level + such as converting a <c>case</c> statement to clauses at the + top-level of the function seldom makes any difference to the + generated code.</p> + </section> + + <section> + <title>Myth: A NIF Always Speeds Up Your Program</title> + + <p>Rewriting Erlang code to a NIF to make it faster should be + seen as a last resort. It is only guaranteed to be dangerous, + but not guaranteed to speed up the program.</p> + + <p>Doing too much work in each NIF call will + <seealso marker="erts:erl_nif#WARNING">degrade responsiveness + of the VM</seealso>. Doing too little work may mean that + the gain of the faster processing in the NIF is eaten up by + the overhead of calling the NIF and checking the arguments.</p> + + <p>Be sure to read about + <seealso marker="erts:erl_nif#lengthy_work">Long-running NIFs</seealso> + before writing a NIF.</p> </section> </chapter> diff --git a/system/doc/efficiency_guide/part.xml b/system/doc/efficiency_guide/part.xml index 6e10a0c031..5673ddd320 100644 --- a/system/doc/efficiency_guide/part.xml +++ b/system/doc/efficiency_guide/part.xml @@ -39,5 +39,6 @@ <xi:include href="drivers.xml"/> <xi:include href="advanced.xml"/> <xi:include href="profiling.xml"/> + <xi:include href="retired_myths.xml"/> </part> diff --git a/system/doc/efficiency_guide/processes.xml b/system/doc/efficiency_guide/processes.xml index f2d9712f51..bc9daa6666 100644 --- a/system/doc/efficiency_guide/processes.xml +++ b/system/doc/efficiency_guide/processes.xml @@ -146,14 +146,14 @@ loop() -> <section> <title>Constant Pool</title> - <p>Constant Erlang terms (also called <em>literals</em>) are now + <p>Constant Erlang terms (also called <em>literals</em>) are kept in constant pools; each loaded module has its own pool. - The following function does no longer build the tuple every time + The following function does not build the tuple every time it is called (only to have it discarded the next time the garbage collector was run), but the tuple is located in the module's constant pool:</p> - <p><em>DO</em> (in R12B and later)</p> + <p><em>DO</em></p> <code type="erl"> days_in_month(M) -> element(M, {31,28,31,30,31,30,31,31,30,31,30,31}).</code> @@ -235,9 +235,7 @@ true return the same value. Sharing has been lost.</p> <p>In a future Erlang/OTP release, it might be implemented a - way to (optionally) preserve sharing. There are no plans to make - preserving of sharing the default behaviour, as that would - penalize the vast majority of Erlang applications.</p> + way to (optionally) preserve sharing.</p> </section> </section> diff --git a/system/doc/efficiency_guide/retired_myths.xml b/system/doc/efficiency_guide/retired_myths.xml new file mode 100644 index 0000000000..37f46566cd --- /dev/null +++ b/system/doc/efficiency_guide/retired_myths.xml @@ -0,0 +1,63 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2016</year> + <year>2016</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + <marker id="retired_myths"/> + <title>Retired Myths</title> + <prepared>Bjorn Gustavsson</prepared> + <docno></docno> + <date>2016-06-07</date> + <rev></rev> + <file>retired_myths.xml</file> + </header> + + <p>We belive that the truth finally has caught with the following, + retired myths.</p> + + <section> + <title>Myth: Funs are Slow</title> + <p>Funs used to be very slow, slower than <c>apply/3</c>. + Originally, funs were implemented using nothing more than + compiler trickery, ordinary tuples, <c>apply/3</c>, and a great + deal of ingenuity.</p> + + <p>But that is history. Funs was given its own data type + in R6B and was further optimized in R7B. + Now the cost for a fun call falls roughly between the cost for a call + to a local function and <c>apply/3</c>.</p> + </section> + + <section> + <title>Myth: List Comprehensions are Slow</title> + + <p>List comprehensions used to be implemented using funs, and in the + old days funs were indeed slow.</p> + + <p>Nowadays, the compiler rewrites list comprehensions into an ordinary + recursive function. Using a tail-recursive function with + a reverse at the end would be still faster. Or would it? + That leads us to the myth that tail-recursive functions are faster + than body-recursive functions.</p> + </section> +</chapter> diff --git a/system/doc/reference_manual/character_set.xml b/system/doc/reference_manual/character_set.xml index d25f2c001d..f0f4c23608 100644 --- a/system/doc/reference_manual/character_set.xml +++ b/system/doc/reference_manual/character_set.xml @@ -32,9 +32,9 @@ <section> <title>Character Set</title> - <p>Since Erlang 4.8/OTP R5A, the syntax of Erlang tokens is extended to - allow the use of the full ISO-8859-1 (Latin-1) character set. This - is noticeable in the following ways:</p> + <p>The syntax of Erlang tokens allow the use of the full + ISO-8859-1 (Latin-1) character set. This is noticeable in the + following ways:</p> <list type="bulleted"> <item> <p>All the Latin-1 printable characters can be used and are diff --git a/system/doc/reference_manual/code_loading.xml b/system/doc/reference_manual/code_loading.xml index f6fd2911fa..f5e5e74841 100644 --- a/system/doc/reference_manual/code_loading.xml +++ b/system/doc/reference_manual/code_loading.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2015</year> + <year>2003</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/system/doc/reference_manual/data_types.xml b/system/doc/reference_manual/data_types.xml index e63825b97d..107e403903 100644 --- a/system/doc/reference_manual/data_types.xml +++ b/system/doc/reference_manual/data_types.xml @@ -50,10 +50,7 @@ <item><em><c>base</c></em><c>#</c><em><c>value</c></em> <br></br> Integer with the base <em><c>base</c></em>, that must be an - integer in the range 2..36. <br></br> - - In Erlang 5.2/OTP R9B and earlier versions, the allowed range - is 2..16.</item> + integer in the range 2..36.</item> </list> <p><em>Examples:</em></p> <pre> diff --git a/system/doc/reference_manual/errors.xml b/system/doc/reference_manual/errors.xml index e764cf431f..3e2d306561 100644 --- a/system/doc/reference_manual/errors.xml +++ b/system/doc/reference_manual/errors.xml @@ -49,8 +49,7 @@ The Erlang programming language has built-in features for handling of run-time errors.</p> <p>A run-time error can also be emulated by calling - <c>erlang:error(Reason)</c> or <c>erlang:error(Reason, Args)</c> - (those appeared in Erlang 5.4/OTP-R10).</p> + <c>erlang:error(Reason)</c> or <c>erlang:error(Reason, Args)</c>.</p> <p>A run-time error is another name for an exception of class <c>error</c>. </p> @@ -79,7 +78,6 @@ <p>Exceptions are run-time errors or generated errors and are of three different classes, with different origins. The <seealso marker="expressions#try">try</seealso> expression - (new in Erlang 5.4/OTP R10B) can distinguish between the different classes, whereas the <seealso marker="expressions#catch">catch</seealso> expression cannot. They are described in @@ -94,7 +92,7 @@ <cell align="left" valign="middle"><c>error</c></cell> <cell align="left" valign="middle">Run-time error, for example, <c>1+a</c>, or the process called - <c>erlang:error/1,2</c> (new in Erlang 5.4/OTP R10B)</cell> + <c>erlang:error/1,2</c></cell> </row> <row> <cell align="left" valign="middle"><c>exit</c></cell> @@ -111,7 +109,7 @@ and a stack trace (which aids in finding the code location of the exception).</p> <p>The stack trace can be retrieved using - <c>erlang:get_stacktrace/0</c> (new in Erlang 5.4/OTP R10B) + <c>erlang:get_stacktrace/0</c> from within a <c>try</c> expression, and is returned for exceptions of class <c>error</c> from a <c>catch</c> expression.</p> <p>An exception of class <c>error</c> is also known as a run-time diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 1a3d19aed1..acd1dec901 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -123,10 +123,9 @@ member(_Elem, []) -> or <c>receive</c> expression must be bound in all branches to have a value outside the expression. Otherwise they are regarded as 'unsafe' outside the expression.</p> - <p>For the <c>try</c> expression introduced in - Erlang 5.4/OTP R10B, variable scoping is limited so that + <p>For the <c>try</c> expression variable scoping is limited so that variables bound in the expression are always 'unsafe' outside - the expression. This is to be improved.</p> + the expression.</p> </section> <section> @@ -189,7 +188,6 @@ f([$p,$r,$e,$f,$i,$x | Str]) -> ...</pre> <pre> case {Value, Result} of {?THRESHOLD+1, ok} -> ...</pre> - <p>This feature was added in Erlang 5.0/OTP R7.</p> </section> </section> @@ -1348,8 +1346,8 @@ catch ExceptionBodyN end</code> <p>This is an enhancement of - <seealso marker="#catch">catch</seealso> that appeared in - Erlang 5.4/OTP R10B. It gives the possibility to:</p> + <seealso marker="#catch">catch</seealso>. + It gives the possibility to:</p> <list type="bulleted"> <item>Distinguish between different exception classes.</item> <item>Choose to handle only the desired ones.</item> diff --git a/system/doc/reference_manual/introduction.xml b/system/doc/reference_manual/introduction.xml index abb4ed407d..5701462443 100644 --- a/system/doc/reference_manual/introduction.xml +++ b/system/doc/reference_manual/introduction.xml @@ -80,8 +80,8 @@ <item>A <em>list</em> is any number of items. For example, an argument list can consist of zero, one, or more arguments.</item> </list> - <p>If a feature has been added recently, in Erlang 5.0/OTP R7 or - later, this is mentioned in the text.</p> + <p>If a feature has been added in R13A or later, + this is mentioned in the text.</p> </section> <section> diff --git a/system/doc/reference_manual/macros.xml b/system/doc/reference_manual/macros.xml index 350bb1d123..b6c740dd10 100644 --- a/system/doc/reference_manual/macros.xml +++ b/system/doc/reference_manual/macros.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2015</year> + <year>2003</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -286,7 +286,6 @@ t.erl:5: Warning: -warning("Macro VERSION not defined -- using default version." argument, is expanded to a string containing the tokens of the argument. This is similar to the <c>#arg</c> stringifying construction in C.</p> - <p>The feature was added in Erlang 5.0/OTP R7.</p> <p><em>Example:</em></p> <code type="none"> -define(TESTCALL(Call), io:format("Call ~s: ~w~n", [??Call, Call])). diff --git a/system/doc/reference_manual/records.xml b/system/doc/reference_manual/records.xml index 12a3e697cd..1eb13b353e 100644 --- a/system/doc/reference_manual/records.xml +++ b/system/doc/reference_manual/records.xml @@ -72,9 +72,9 @@ <pre> #Name{Field1=Expr1,...,FieldK=ExprK, _=ExprL}</pre> <p>Omitted fields then get the value of evaluating <c>ExprL</c> - instead of their default values. This feature was added in - Erlang 5.1/OTP R8 and is primarily intended to be used to create - patterns for ETS and Mnesia match functions.</p> + instead of their default values. This feature is primarily + intended to be used to create patterns for ETS and Mnesia match + functions.</p> <p><em>Example:</em></p> <pre> -record(person, {name, phone, address}). diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index ced584ed35..a0ea41cb3b 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -11,7 +11,7 @@ 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 @@ -63,7 +63,7 @@ Types consist of, and are built from, a set of predefined types, for example, <c>integer()</c>, <c>atom()</c>, and <c>pid()</c>. Predefined types represent a typically infinite set of Erlang terms that - belong to this type. For example, the type <c>atom()</c> stands for the + belong to this type. For example, the type <c>atom()</c> denotes the set of all Erlang atoms. </p> <p> @@ -131,19 +131,19 @@ | nonempty_improper_list(Type1, Type2) %% Type1 and Type2 as above | nonempty_list(Type) %% Proper non-empty list - Map :: map() %% stands for a map of any size - | #{} %% stands for the empty map + Map :: map() %% denotes a map of any size + | #{} %% denotes the empty map | #{PairList} - Tuple :: tuple() %% stands for a tuple of any size + Tuple :: tuple() %% denotes a tuple of any size | {} | {TList} PairList :: Pair | Pair, PairList - Pair :: Type := Type %% denotes a pair that must be present - | Type => Type + Pair :: Type := Type %% denotes a mandatory pair + | Type => Type %% denotes an optional pair TList :: Type | Type, TList @@ -161,7 +161,7 @@ that <c>M</c> or <c>N</c>, or both, are zero. </p> <p> - Because lists are commonly used, they have shorthand type notations. + Because lists are commonly used, they have shorthand type notations. The types <c>list(T)</c> and <c>nonempty_list(T)</c> have the shorthands <c>[T]</c> and <c>[T,...]</c>, respectively. The only difference between the two shorthands is that <c>[T]</c> can be an @@ -169,14 +169,18 @@ </p> <p> Notice that the shorthand for <c>list()</c>, that is, the list of - elements of unknown type, is <c>[_]</c> (or <c>[any()]</c>), not <c>[]</c>. + elements of unknown type, is <c>[_]</c> (or <c>[any()]</c>), not <c>[]</c>. The notation <c>[]</c> specifies the singleton type for the empty list. </p> <p> The general form of maps is <c>#{PairList}</c>. The key types in <c>PairList</c> are allowed to overlap, and if they do, the leftmost pair takes precedence. A map pair has a key in - <c>PairList</c> if it belongs to this type. + <c>PairList</c> if it belongs to this type. A <c>PairList</c> may contain + both 'mandatory' and 'optional' pairs where 'mandatory' denotes that + a key type, and its associated value type, must be present. + In the case of an 'optional' pair it is not required for the key type to + be present. </p> <p> Notice that the syntactic representation of <c>map()</c> is @@ -184,8 +188,8 @@ The notation <c>#{}</c> specifies the singleton type for the empty map. </p> <p> - For convenience, the following types are also built-in. - They can be thought as predefined aliases for the type unions also shown in + For convenience, the following types are also built-in. + They can be thought as predefined aliases for the type unions also shown in the table. </p> <table> @@ -201,37 +205,37 @@ <row> <cell><c>bitstring()</c></cell><cell><c><<_:_*1>></c></cell> </row> - <row> + <row> <cell><c>boolean()</c></cell><cell><c>'false' | 'true'</c></cell> </row> - <row> + <row> <cell><c>byte()</c></cell><cell><c>0..255</c></cell> </row> <row> <cell><c>char()</c></cell><cell><c>0..16#10ffff</c></cell> </row> - <row> + <row> <cell><c>nil()</c></cell><cell><c>[]</c></cell> </row> <row> <cell><c>number()</c></cell><cell><c>integer() | float()</c></cell> </row> - <row> + <row> <cell><c>list()</c></cell><cell><c>[any()]</c></cell> </row> - <row> + <row> <cell><c>maybe_improper_list()</c></cell><cell><c>maybe_improper_list(any(), any())</c></cell> </row> - <row> + <row> <cell><c>nonempty_list()</c></cell><cell><c>nonempty_list(any())</c></cell> </row> <row> <cell><c>string()</c></cell><cell><c>[char()]</c></cell> </row> - <row> + <row> <cell><c>nonempty_string()</c></cell><cell><c>[char(),...]</c></cell> </row> - <row> + <row> <cell><c>iodata()</c></cell><cell><c>iolist() | binary()</c></cell> </row> <row> @@ -243,7 +247,7 @@ <row> <cell><c>module()</c></cell><cell><c>atom()</c></cell> </row> - <row> + <row> <cell><c>mfa()</c></cell><cell><c>{module(),atom(),arity()}</c></cell> </row> <row> @@ -259,7 +263,7 @@ <cell><c>timeout()</c></cell><cell><c>'infinity' | non_neg_integer()</c></cell> </row> <row> - <cell><c>no_return()</c></cell><cell><c>none()</c></cell> + <cell><c>no_return()</c></cell><cell><c>none()</c></cell> </row> <tcaption>Built-in types, predefined aliases</tcaption> </table> @@ -284,11 +288,11 @@ </row> <tcaption>Additional built-in types</tcaption> </table> - + <p> Users are not allowed to define types with the same names as the predefined or built-in ones. This is checked by the compiler and - its violation results in a compilation error. + its violation results in a compilation error. </p> <note> <p> @@ -394,13 +398,13 @@ <pre> -record(rec, {field1 :: Type1, field2, field3 :: Type3}).</pre> <p> - For fields without type annotations, their type defaults to any(). + For fields without type annotations, their type defaults to any(). That is, the previous example is a shorthand for the following: </p> <pre> -record(rec, {field1 :: Type1, field2 :: any(), field3 :: Type3}).</pre> <p> - In the presence of initial values for fields, + In the presence of initial values for fields, the type must be declared after the initialization, as follows: </p> <pre> @@ -409,12 +413,12 @@ The initial values for fields are to be compatible with (that is, a member of) the corresponding types. This is checked by the compiler and results in a compilation error - if a violation is detected. + if a violation is detected. </p> <note> <p>Before Erlang/OTP 19, for fields without initial values, the singleton type <c>'undefined'</c> was added to all declared types. - In other words, the following two record declarations had identical + In other words, the following two record declarations had identical effects:</p> <pre> -record(rec, {f1 = 42 :: integer(), @@ -430,22 +434,22 @@ </p> </note> <p> - Any record, containing type information or not, once defined, + Any record, containing type information or not, once defined, can be used as a type using the following syntax: </p> <pre> #rec{}</pre> <p> - In addition, the record fields can be further specified when using + In addition, the record fields can be further specified when using a record type by adding type information about the field as follows: </p> <pre> #rec{some_field :: Type}</pre> <p> - Any unspecified fields are assumed to have the type in the original + Any unspecified fields are assumed to have the type in the original record declaration. </p> </section> - + <section> <title>Specifications for Functions</title> <p> @@ -459,9 +463,9 @@ else a compilation error occurs. </p> <p> - This form can also be used in header files (.hrl) to declare type - information for exported functions. - Then these header files can be included in files that (implicitly or + This form can also be used in header files (.hrl) to declare type + information for exported functions. + Then these header files can be included in files that (implicitly or explicitly) import these functions. </p> <p> @@ -475,14 +479,14 @@ <pre> -spec Function(ArgName1 :: Type1, ..., ArgNameN :: TypeN) -> RT.</pre> <p> - A function specification can be overloaded. + A function specification can be overloaded. That is, it can have several types, separated by a semicolon (<c>;</c>): </p> <pre> -spec foo(T1, T2) -> T3 ; (T4, T5) -> T6.</pre> <p> - A current restriction, which currently results in a warning + A current restriction, which currently results in a warning (not an error) by the compiler, is that the domains of the argument types cannot overlap. For example, the following specification results in a warning: @@ -491,9 +495,9 @@ -spec foo(pos_integer()) -> pos_integer() ; (integer()) -> integer().</pre> <p> - Type variables can be used in specifications to specify relations for - the input and output arguments of a function. - For example, the following specification defines the type of a + Type variables can be used in specifications to specify relations for + the input and output arguments of a function. + For example, the following specification defines the type of a polymorphic identity function: </p> <pre> @@ -542,8 +546,8 @@ -spec foo({X, integer()}) -> X when X :: atom() ; ([Y]) -> Y when Y :: number().</pre> <p> - Some functions in Erlang are not meant to return; - either because they define servers or because they are used to + Some functions in Erlang are not meant to return; + either because they define servers or because they are used to throw exceptions, as in the following function: </p> <pre> my_error(Err) -> erlang:throw({error, Err}).</pre> @@ -555,4 +559,3 @@ <pre> -spec my_error(term()) -> no_return().</pre> </section> </chapter> - diff --git a/system/doc/tutorial/c_port.xmlsrc b/system/doc/tutorial/c_port.xmlsrc index 3c3bc48044..ff0997fb54 100644 --- a/system/doc/tutorial/c_port.xmlsrc +++ b/system/doc/tutorial/c_port.xmlsrc @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2000</year><year>2015</year> + <year>2000</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/system/doc/tutorial/c_portdriver.xmlsrc b/system/doc/tutorial/c_portdriver.xmlsrc index 933e2395a3..da680642b6 100644 --- a/system/doc/tutorial/c_portdriver.xmlsrc +++ b/system/doc/tutorial/c_portdriver.xmlsrc @@ -161,8 +161,8 @@ decode([Int]) -> Int.</pre> <title>Running the Example</title> <p><em>Step 1.</em> Compile the C code:</p> <pre> -unix> <input>gcc -o exampledrv -fpic -shared complex.c port_driver.c</input> -windows> <input>cl -LD -MD -Fe exampledrv.dll complex.c port_driver.c</input></pre> +unix> <input>gcc -o example_drv.so -fpic -shared complex.c port_driver.c</input> +windows> <input>cl -LD -MD -Fe example_drv.dll complex.c port_driver.c</input></pre> <p><em>Step 2.</em> Start Erlang and compile the Erlang code:</p> <pre> > <input>erl</input> |
