diff options
256 files changed, 6932 insertions, 4171 deletions
diff --git a/bootstrap/bin/no_dot_erlang.boot b/bootstrap/bin/no_dot_erlang.boot Binary files differindex 1db265c2be..496654fcea 100644 --- a/bootstrap/bin/no_dot_erlang.boot +++ b/bootstrap/bin/no_dot_erlang.boot diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 1db265c2be..496654fcea 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 1db265c2be..496654fcea 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differindex 9dd7b52108..ceb83ba48b 100644 --- a/bootstrap/lib/compiler/ebin/beam_a.beam +++ b/bootstrap/lib/compiler/ebin/beam_a.beam diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 9ff718d0fb..232cc74188 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 25c9be7f53..1db56cb5f1 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_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex 592cd7e8c6..6b6b6d0f3f 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam Binary files differindex dfb320ea81..c76d41c58a 100644 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ b/bootstrap/lib/compiler/ebin/beam_except.beam diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex b0d8b97422..e23ff4e906 100644 --- a/bootstrap/lib/compiler/ebin/beam_jump.beam +++ b/bootstrap/lib/compiler/ebin/beam_jump.beam diff --git a/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam b/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam Binary files differindex 20fbc1adbe..b02630aed9 100644 --- a/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam +++ b/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam Binary files differindex e8f4dd5f1d..29016312bc 100644 --- a/bootstrap/lib/compiler/ebin/beam_peep.beam +++ b/bootstrap/lib/compiler/ebin/beam_peep.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa.beam b/bootstrap/lib/compiler/ebin/beam_ssa.beam Binary files differindex 271ef2437b..4f44f50dff 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam b/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam Binary files differindex 84438fe10d..cdbc969b92 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam Binary files differindex 546774520a..7a09803699 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam b/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam Binary files differindex 464c3a0d9c..edc5cc5679 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam Binary files differindex b2f2287db5..322653dfc7 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam Binary files differindex 67c4be2a14..d889add00d 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam Binary files differindex 7fc0a518dc..6e8f7ac648 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam b/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam Binary files differindex 05e8478d14..e86fa1831a 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam Binary files differindex adc14e8a9a..de9929bc92 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex 69cf8f12f5..00f3224106 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_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 82c431c5fe..74590b52d7 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.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex dc8c347148..254f94fd36 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex 6532cdb015..c20b40541c 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 5c5c132af9..fda55d4035 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 27216df05c..0a5e6de039 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -65,7 +65,6 @@ rec_env, sys_core_alias, sys_core_bsm, - sys_core_dsetel, sys_core_fold, sys_core_fold_lists, sys_core_inline, diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 399b1af1bb..8370664167 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"7.2.4", +{"7.3.1", [{<<".*">>,[{restart_application, compiler}]}], [{<<".*">>,[{restart_application, compiler}]}] }. diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam Binary files differindex eb7dca711d..19b0c3dfcb 100644 --- a/bootstrap/lib/compiler/ebin/core_lib.beam +++ b/bootstrap/lib/compiler/ebin/core_lib.beam diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex 377dd959ae..ecad4f33e0 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex fccc012deb..2423c9b2ea 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_alias.beam b/bootstrap/lib/compiler/ebin/sys_core_alias.beam Binary files differindex 8500415844..953776ebaa 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_alias.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_alias.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam Binary files differdeleted file mode 100644 index d5e62f8fe5..0000000000 --- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam +++ /dev/null diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 9a8bf6b706..98d24fc57a 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam Binary files differindex 127af4897b..d06f8d4823 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_inline.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_inline.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam Binary files differindex 4d19cfe43f..002b4f2914 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex cae2ed5789..a4da69abdf 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 e132c5495b..8fc867e66b 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam Binary files differindex 1442ca2935..e60bd7c722 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex f8f5816b7d..e0c3790efe 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam Binary files differindex ccf68d35a6..77bb9544e2 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam Binary files differindex f1baf955d0..a470129eff 100644 --- a/bootstrap/lib/kernel/ebin/auth.beam +++ b/bootstrap/lib/kernel/ebin/auth.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex 6d73a92bf0..0a35cf9036 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 69667b7af6..cb1b8374e0 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam Binary files differindex 72b7d89e62..35d41e0604 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 61fede428e..3884d05e0f 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 e43191c10a..bd40c824a6 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_server.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam Binary files differindex d2def86105..99f5c66998 100644 --- a/bootstrap/lib/kernel/ebin/dist_ac.beam +++ b/bootstrap/lib/kernel/ebin/dist_ac.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 54c6dcf06b..aec35239f6 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam Binary files differindex 54b0d734cb..00e4aba64d 100644 --- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam +++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam diff --git a/bootstrap/lib/kernel/ebin/erl_ddll.beam b/bootstrap/lib/kernel/ebin/erl_ddll.beam Binary files differindex b08f0ed2ab..9708d146f7 100644 --- a/bootstrap/lib/kernel/ebin/erl_ddll.beam +++ b/bootstrap/lib/kernel/ebin/erl_ddll.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex 4043e6b47f..5e43e48577 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam Binary files differindex 9095c3f586..f9b1dd2ed9 100644 --- a/bootstrap/lib/kernel/ebin/error_logger.beam +++ b/bootstrap/lib/kernel/ebin/error_logger.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex 8e25fe9c1c..3bf1cbeeaf 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 2bffa6122d..354fce8576 100644 --- a/bootstrap/lib/kernel/ebin/file_io_server.beam +++ b/bootstrap/lib/kernel/ebin/file_io_server.beam diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam Binary files differindex ae1f636232..bfbef9341d 100644 --- a/bootstrap/lib/kernel/ebin/file_server.beam +++ b/bootstrap/lib/kernel/ebin/file_server.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex f6006f36f6..4a9a6cd229 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam Binary files differindex 7668bbecfc..6252b1b3c2 100644 --- a/bootstrap/lib/kernel/ebin/global_group.beam +++ b/bootstrap/lib/kernel/ebin/global_group.beam diff --git a/bootstrap/lib/kernel/ebin/group_history.beam b/bootstrap/lib/kernel/ebin/group_history.beam Binary files differindex 9119e725de..5cfc7183f9 100644 --- a/bootstrap/lib/kernel/ebin/group_history.beam +++ b/bootstrap/lib/kernel/ebin/group_history.beam diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam Binary files differindex eb1c02f09f..d826f4f99d 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 018fbec5c0..fc80f2d1bd 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex d67885b378..29225eb473 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam Binary files differindex 6c1c562ded..7cacde3399 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_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam Binary files differindex 8a11329afa..f06a0d5c68 100644 --- a/bootstrap/lib/kernel/ebin/inet_config.beam +++ b/bootstrap/lib/kernel/ebin/inet_config.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex 339e0d8d40..dfc94974b9 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 977de31d4f..1af10a472f 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam Binary files differindex 9b1bc22a15..70af600524 100644 --- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam +++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam Binary files differindex 474faa0eb4..818c26d776 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 76d4039600..2a54ed84e8 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 49fdc129f4..c273d47012 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam Binary files differindex f95817a920..e2122ff2a3 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam diff --git a/bootstrap/lib/kernel/ebin/inet_udp.beam b/bootstrap/lib/kernel/ebin/inet_udp.beam Binary files differindex 35edff2393..62156a3284 100644 --- a/bootstrap/lib/kernel/ebin/inet_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet_udp.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index ac114f0354..59e716b2d0 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -16,13 +16,42 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"5.4.3", - %% Up from - max one major revision back - [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0 - {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.1+ - {<<"6\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-21 - %% Down to - max one major revision back - [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0 - {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.1+ - {<<"6\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-21 -}. +%% +%% We allow upgrade from, and downgrade to all previous +%% versions from the following OTP releases: +%% - OTP 20 +%% - OTP 21 +%% +%% We also allow upgrade from, and downgrade to all +%% versions that have branched off from the above +%% stated previous versions. +%% +{"6.2", + [{<<"^5\\.3$">>,[restart_new_emulator]}, + {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^5\\.4$">>,[restart_new_emulator]}, + {<<"^5\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^5\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^5\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^5\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.0$">>,[restart_new_emulator]}, + {<<"^6\\.0\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.1$">>,[restart_new_emulator]}, + {<<"^6\\.1\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + [{<<"^5\\.3$">>,[restart_new_emulator]}, + {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^5\\.4$">>,[restart_new_emulator]}, + {<<"^5\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^5\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^5\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^5\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.0$">>,[restart_new_emulator]}, + {<<"^6\\.0\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.1$">>,[restart_new_emulator]}, + {<<"^6\\.1\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex b3d5f24b87..75ff192576 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam Binary files differindex 9f29de109f..bcadaab5f1 100644 --- a/bootstrap/lib/kernel/ebin/kernel_config.beam +++ b/bootstrap/lib/kernel/ebin/kernel_config.beam diff --git a/bootstrap/lib/kernel/ebin/local_tcp.beam b/bootstrap/lib/kernel/ebin/local_tcp.beam Binary files differindex 5738a0058f..2958d19524 100644 --- a/bootstrap/lib/kernel/ebin/local_tcp.beam +++ b/bootstrap/lib/kernel/ebin/local_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/logger.beam b/bootstrap/lib/kernel/ebin/logger.beam Binary files differindex 8f16575df5..3865db9d89 100644 --- a/bootstrap/lib/kernel/ebin/logger.beam +++ b/bootstrap/lib/kernel/ebin/logger.beam diff --git a/bootstrap/lib/kernel/ebin/logger_filters.beam b/bootstrap/lib/kernel/ebin/logger_filters.beam Binary files differindex 712ebee110..2d8035278d 100644 --- a/bootstrap/lib/kernel/ebin/logger_filters.beam +++ b/bootstrap/lib/kernel/ebin/logger_filters.beam diff --git a/bootstrap/lib/kernel/ebin/logger_formatter.beam b/bootstrap/lib/kernel/ebin/logger_formatter.beam Binary files differindex cf92f9fc3c..c790d87569 100644 --- a/bootstrap/lib/kernel/ebin/logger_formatter.beam +++ b/bootstrap/lib/kernel/ebin/logger_formatter.beam diff --git a/bootstrap/lib/kernel/ebin/logger_h_common.beam b/bootstrap/lib/kernel/ebin/logger_h_common.beam Binary files differindex ba1d4f326a..7361625f7c 100644 --- a/bootstrap/lib/kernel/ebin/logger_h_common.beam +++ b/bootstrap/lib/kernel/ebin/logger_h_common.beam diff --git a/bootstrap/lib/kernel/ebin/logger_server.beam b/bootstrap/lib/kernel/ebin/logger_server.beam Binary files differindex 1919e43628..daa22aee33 100644 --- a/bootstrap/lib/kernel/ebin/logger_server.beam +++ b/bootstrap/lib/kernel/ebin/logger_server.beam diff --git a/bootstrap/lib/kernel/ebin/logger_simple_h.beam b/bootstrap/lib/kernel/ebin/logger_simple_h.beam Binary files differindex 1d747620a1..a6d0c9e17c 100644 --- a/bootstrap/lib/kernel/ebin/logger_simple_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_simple_h.beam diff --git a/bootstrap/lib/kernel/ebin/logger_std_h.beam b/bootstrap/lib/kernel/ebin/logger_std_h.beam Binary files differindex dd13496dd7..921e853f73 100644 --- a/bootstrap/lib/kernel/ebin/logger_std_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_std_h.beam diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam Binary files differindex 3ba16fbf3f..5810577c6a 100644 --- a/bootstrap/lib/kernel/ebin/net_adm.beam +++ b/bootstrap/lib/kernel/ebin/net_adm.beam diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam Binary files differindex 4be7d31fce..7f57ea3d77 100644 --- a/bootstrap/lib/kernel/ebin/net_kernel.beam +++ b/bootstrap/lib/kernel/ebin/net_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex 6788c8cd2f..d293ea18f3 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io.beam b/bootstrap/lib/kernel/ebin/raw_file_io.beam Binary files differindex 2e73087b25..7d3cc2e3c3 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam Binary files differindex 93b9d08e10..3c41f8528e 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam Binary files differindex 84bbe1e794..0ae74c7045 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam Binary files differindex c6c276e3b4..194f5fb507 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam Binary files differindex 73f072fb5f..b544fd394e 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam Binary files differindex 171855ddb4..3e7be39f5f 100644 --- a/bootstrap/lib/kernel/ebin/user.beam +++ b/bootstrap/lib/kernel/ebin/user.beam diff --git a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam Binary files differindex ba2d2618ac..6cfafbd750 100644 --- a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam +++ b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam diff --git a/bootstrap/lib/kernel/include/dist.hrl b/bootstrap/lib/kernel/include/dist.hrl index 003852f1b0..f06fc328d7 100644 --- a/bootstrap/lib/kernel/include/dist.hrl +++ b/bootstrap/lib/kernel/include/dist.hrl @@ -42,6 +42,9 @@ -define(DFLAG_BIG_CREATION, 16#40000). -define(DFLAG_SEND_SENDER, 16#80000). -define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000). +%% -define(DFLAG_NO_MAGIC, 16#200000). %% Used internally only +-define(DFLAG_EXIT_PAYLOAD, 16#400000). +-define(DFLAG_FRAGMENTS, 16#800000). %% Also update dflag2str() in ../src/dist_util.erl %% when adding flags... diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex d4e1c6613f..ac3193515c 100644 --- a/bootstrap/lib/stdlib/ebin/array.beam +++ b/bootstrap/lib/stdlib/ebin/array.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex dcf03fdcbf..4782583fd6 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 bc69543adb..9d9bf170a2 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 ec478abb3d..d0abc17e48 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 b41710ef9d..37f31e1945 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam Binary files differindex 4cc356bf6d..c5fabc5e98 100644 --- a/bootstrap/lib/stdlib/ebin/dets_server.beam +++ b/bootstrap/lib/stdlib/ebin/dets_server.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex 2a90041b22..b25999333b 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex f41cb91d67..1e12c7a8b8 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 a1d981a25c..dc390024a4 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 f5b0a79af7..999a3c5b7d 100644 --- a/bootstrap/lib/stdlib/ebin/digraph.beam +++ b/bootstrap/lib/stdlib/ebin/digraph.beam diff --git a/bootstrap/lib/stdlib/ebin/digraph_utils.beam b/bootstrap/lib/stdlib/ebin/digraph_utils.beam Binary files differindex 05828ef408..772332cd08 100644 --- a/bootstrap/lib/stdlib/ebin/digraph_utils.beam +++ b/bootstrap/lib/stdlib/ebin/digraph_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam Binary files differindex 370e1d233a..81d57e38d9 100644 --- a/bootstrap/lib/stdlib/ebin/edlin_expand.beam +++ b/bootstrap/lib/stdlib/ebin/edlin_expand.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex c78496f0e8..9611419792 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam Binary files differindex a829f275ab..a40fcb3f92 100644 --- a/bootstrap/lib/stdlib/ebin/erl_anno.beam +++ b/bootstrap/lib/stdlib/ebin/erl_anno.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_bits.beam b/bootstrap/lib/stdlib/ebin/erl_bits.beam Binary files differindex f1eaae037d..508da7ba8a 100644 --- a/bootstrap/lib/stdlib/ebin/erl_bits.beam +++ b/bootstrap/lib/stdlib/ebin/erl_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam Binary files differindex 2ed6addce2..07a8f1c9ac 100644 --- a/bootstrap/lib/stdlib/ebin/erl_compile.beam +++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex e98eed9810..ee6df8efcb 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex 5603ea5660..331a946757 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex ff0b6a9394..e50e44fc4b 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 e4f4617448..41369ca147 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 ccda57e243..64b26f2510 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex 7ce237eb42..8347f97ec1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam Binary files differindex 8b911cd506..79cddbdab2 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_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam Binary files differindex 71d23f3a61..bdb80ce1e4 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 6f1d4fd866..880fc090b2 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex 1864bb4f09..8d3538e7a7 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex 03e1b54857..65dcc78f23 100644 --- a/bootstrap/lib/stdlib/ebin/file_sorter.beam +++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 791425bca3..6efc5e219a 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 47f691dd48..b882b287c2 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 29756c9b46..4727efff99 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_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam Binary files differindex dd01a454b1..f5185696eb 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_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex 43843a8927..09e9be48f8 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex 2f170c497d..aa9d279a9e 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam Binary files differindex 7c310e3eda..408ee3a0c9 100644 --- a/bootstrap/lib/stdlib/ebin/pool.beam +++ b/bootstrap/lib/stdlib/ebin/pool.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex f24771a487..c49c165b13 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 5f86887907..de61165aae 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 49911afec9..653fa3e808 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 55118de953..571d4a13a5 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 1aeded3141..9636f4fbbf 100644 --- a/bootstrap/lib/stdlib/ebin/rand.beam +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam Binary files differindex 45e323bf48..7a010dbdd5 100644 --- a/bootstrap/lib/stdlib/ebin/re.beam +++ b/bootstrap/lib/stdlib/ebin/re.beam diff --git a/bootstrap/lib/stdlib/ebin/sets.beam b/bootstrap/lib/stdlib/ebin/sets.beam Binary files differindex 373c2d9135..e3609ea527 100644 --- a/bootstrap/lib/stdlib/ebin/sets.beam +++ b/bootstrap/lib/stdlib/ebin/sets.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 21360f8545..6bd3978bb4 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex 5b9d01daf7..3efc50d4a8 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 13f2b63e93..2bb0b06f12 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.7"}, + {vsn, "3.7.1"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 381b33c833..d22e917574 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -16,11 +16,42 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"3.4.5", - %% Up from - max one major revision back - [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.* - {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}],% OTP-21.* - %% Down to - max one major revision back - [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.* - {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.* -}. +%% +%% We allow upgrade from, and downgrade to all previous +%% versions from the following OTP releases: +%% - OTP 20 +%% - OTP 21 +%% +%% We also allow upgrade from, and downgrade to all +%% versions that have branched off from the above +%% stated previous versions. +%% +{"3.7.1", + [{<<"^3\\.4$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.4(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.5(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.5$">>,[restart_new_emulator]}, + {<<"^3\\.5\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.5\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.6$">>,[restart_new_emulator]}, + {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.7$">>,[restart_new_emulator]}, + {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], + [{<<"^3\\.4$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.4(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.4\\.5(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.5$">>,[restart_new_emulator]}, + {<<"^3\\.5\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.5\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.6$">>,[restart_new_emulator]}, + {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.7$">>,[restart_new_emulator]}, + {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam Binary files differindex 7babe829d8..da647da3ca 100644 --- a/bootstrap/lib/stdlib/ebin/string.beam +++ b/bootstrap/lib/stdlib/ebin/string.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex c24ebd0fbc..243a67008b 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam Binary files differindex 7f5647948e..63cfa4ab2e 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode_util.beam b/bootstrap/lib/stdlib/ebin/unicode_util.beam Binary files differindex 144512869e..7da23997df 100644 --- a/bootstrap/lib/stdlib/ebin/unicode_util.beam +++ b/bootstrap/lib/stdlib/ebin/unicode_util.beam diff --git a/bootstrap/lib/stdlib/ebin/uri_string.beam b/bootstrap/lib/stdlib/ebin/uri_string.beam Binary files differindex 2272fab616..001118f0b9 100644 --- a/bootstrap/lib/stdlib/ebin/uri_string.beam +++ b/bootstrap/lib/stdlib/ebin/uri_string.beam diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam Binary files differindex 80f8323890..84807f7e39 100644 --- a/bootstrap/lib/stdlib/ebin/zip.beam +++ b/bootstrap/lib/stdlib/ebin/zip.beam diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml index c90c8f9521..185c75fe84 100644 --- a/erts/doc/src/erl_dist_protocol.xml +++ b/erts/doc/src/erl_dist_protocol.xml @@ -532,11 +532,7 @@ io:format("old/unused name ~ts at port ~p, fd = ~p ~n", <marker id="distribution_handshake"/> <title>Distribution Handshake</title> <p>This section describes the distribution handshake protocol introduced - in Erlang/OTP R6. This description was previously located in - <c>$ERL_TOP/lib/kernel/internal_doc/distribution_handshake.txt</c> and - has more or less been copied and "formatted" here. It has been almost - unchanged since 1999, but the handshake has not changed much since then - either.</p> + in Erlang/OTP R6. The handshake has remained almost the same since then.</p> <section> <title>General</title> @@ -847,6 +843,18 @@ DiB == gen_digest(ChA, ICA)? of the <c>SEND_TT</c> control message. </p> </item> + <tag><c>-define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000).</c></tag> + <item> + <p>The node understands any term as the seqtrace label.</p> + </item> + <tag><c>-define(DFLAG_EXIT_PAYLOAD, 16#400000).</c></tag> + <item> + <p>Use the <c>PAYLOAD_EXIT</c>, <c>PAYLOAD_EXIT_TT</c>, + <c>PAYLOAD_EXIT2</c>, <c>PAYLOAD_EXIT2_TT</c> + and <c>PAYLOAD_MONITOR_P_EXIT</c> + <seealso marker="#control_message">control message</seealso>s + instead of the non-PAYLOAD variants.</p> + </item> </taglist> <p> There is also function <c>dist_util:strict_order_flags/0</c> @@ -859,7 +867,7 @@ DiB == gen_digest(ChA, ICA)? <section> <marker id="connected_nodes"/> <title>Protocol between Connected Nodes</title> - <p>As from ERTS 5.7.2 the runtime system passes a distribution flag + <p>Since ERTS 5.7.2 (OTP R13B) the runtime system passes a distribution flag in the handshake stage that enables the use of a <seealso marker="erl_ext_dist#distribution_header">distribution header </seealso> on all messages passed. Messages passed between nodes have in @@ -878,7 +886,7 @@ DiB == gen_digest(ChA, ICA)? <cell align="center"><c>ControlMessage</c></cell> <cell align="center"><c>Message</c></cell> </row> - <tcaption>Format of Messages Passed between Nodes (as from ERTS 5.7.2) + <tcaption>Format of Messages Passed between Nodes (as from ERTS 5.7.2 (OTP R13B)) </tcaption> </table> @@ -887,15 +895,23 @@ DiB == gen_digest(ChA, ICA)? <item> <p>Equal to d + n + m.</p> </item> + <tag><c>DistributionHeader</c></tag> + <item> + <p> + <seealso marker="erl_ext_dist#distribution_header">Distribution header + describing the atom cache and fragmented distribution messages. + </seealso> + </p> + </item> <tag><c>ControlMessage</c></tag> <item> <p>A tuple passed using the external format of Erlang.</p> </item> <tag><c>Message</c></tag> <item> - <p>The message sent to another node using the '!' (in external format). - Notice that <c>Message</c> is only passed in combination with a - <c>ControlMessage</c> encoding a send ('!').</p> + <p>The message sent to another node using the '!' + or the reason for a EXIT, EXIT2 or DOWN signal using + the external term format.</p> </item> </taglist> @@ -903,7 +919,7 @@ DiB == gen_digest(ChA, ICA)? number is omitted from the terms that follow a distribution header </seealso>.</p> - <p>Nodes with an ERTS version earlier than 5.7.2 does not pass the + <p>Nodes with an ERTS version earlier than 5.7.2 (OTP R13B) does not pass the distribution flag that enables the distribution header. Messages passed between nodes have in this case the following format:</p> @@ -920,7 +936,7 @@ DiB == gen_digest(ChA, ICA)? <cell align="center"><c>ControlMessage</c></cell> <cell align="center"><c>Message</c></cell> </row> - <tcaption>Format of Messages Passed between Nodes (before ERTS 5.7.2) + <tcaption>Format of Messages Passed between Nodes (before ERTS 5.7.2 (OTP R13B)) </tcaption> </table> @@ -963,6 +979,7 @@ DiB == gen_digest(ChA, ICA)? <tag><c>EXIT</c></tag> <item> <p><c>{3, FromPid, ToPid, Reason}</c></p> + <p>This signal is sent when a link has been broken</p> </item> <tag><c>UNLINK</c></tag> <item> @@ -985,6 +1002,7 @@ DiB == gen_digest(ChA, ICA)? <tag><c>EXIT2</c></tag> <item> <p><c>{8, FromPid, ToPid, Reason}</c></p> + <p>This signal is sent by a call to the erlang:exit/2 bif</p> </item> </taglist> </section> @@ -1007,7 +1025,7 @@ DiB == gen_digest(ChA, ICA)? <p><c>{16, FromPid, Unused, ToName, TraceToken}</c></p> <p>Followed by <c>Message</c>.</p> <p><c>Unused</c> is kept for backward compatibility.</p> - </item> + </item> <tag><c>EXIT2_TT</c></tag> <item> <p><c>{18, FromPid, ToPid, TraceToken, Reason}</c></p> @@ -1061,7 +1079,7 @@ DiB == gen_digest(ChA, ICA)? <p><c>{22, FromPid, ToPid}</c></p> <p>Followed by <c>Message</c>.</p> <p> - This control messages replace the <c>SEND</c> control + This control message replaces the <c>SEND</c> control message and will be sent when the distribution flag <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_SEND_SENDER</c></seealso> has been negotiated in the connection setup handshake. @@ -1080,7 +1098,7 @@ DiB == gen_digest(ChA, ICA)? <p><c>{23, FromPid, ToPid, TraceToken}</c></p> <p>Followed by <c>Message</c>.</p> <p> - This control messages replace the <c>SEND_TT</c> control + This control message replaces the <c>SEND_TT</c> control message and will be sent when the distribution flag <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_SEND_SENDER</c></seealso> has been negotiated in the connection setup handshake. @@ -1097,4 +1115,72 @@ DiB == gen_digest(ChA, ICA)? </taglist> </section> + <section> + <title>New Ctrlmessages for Erlang/OTP 22</title> + <note><p> + Messages encoded before the connection has + been set up may still use the non-PAYLOAD variant. + However, once a PAYLOAD control message has been sent, + no more non-PAYLOAD control messages will be sent in + the same direction on the connection. + </p></note> + <taglist> + <tag><c>PAYLOAD_EXIT</c></tag> + <item> + <p><c>{24, FromPid, ToPid}</c></p> + <p>Followed by <c>Reason</c>.</p> + <p> + This control message replaces the <c>EXIT</c> control + message and will be sent when the distribution flag + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso> + has been negotiated in the connection setup handshake. + </p> + </item> + <tag><c>PAYLOAD_EXIT_TT</c></tag> + <item> + <p><c>{25, FromPid, ToPid}</c></p> + <p>Followed by <c>Reason</c>.</p> + <p> + This control message replaces the <c>EXIT_TT</c> control + message and will be sent when the distribution flag + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso> + has been negotiated in the connection setup handshake. + </p> + </item> + <tag><c>PAYLOAD_EXIT2</c></tag> + <item> + <p><c>{26, FromPid, ToPid}</c></p> + <p>Followed by <c>Reason</c>.</p> + <p> + This control message replaces the <c>EXIT2</c> control + message and will be sent when the distribution flag + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso> + has been negotiated in the connection setup handshake. + </p> + </item> + <tag><c>PAYLOAD_EXIT2_TT</c></tag> + <item> + <p><c>{27, FromPid, ToPid}</c></p> + <p>Followed by <c>Reason</c>.</p> + <p> + This control message replaces the <c>EXIT2_TT</c> control + message and will be sent when the distribution flag + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso> + has been negotiated in the connection setup handshake. + </p> + </item> + <tag><c>PAYLOAD_MONITOR_P_EXIT</c></tag> + <item> + <p><c>{28, FromPid, ToPid, Ref}</c></p> + <p>Followed by <c>Reason</c>.</p> + <p> + This control message replaces the <c>MONITOR_P_EXIT</c> control + message and will be sent when the distribution flag + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso> + has been negotiated in the connection setup handshake. + </p> + </item> + </taglist> + </section> + </chapter> diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml index b7090d0472..29c6694a6b 100644 --- a/erts/doc/src/erl_ext_dist.xml +++ b/erts/doc/src/erl_ext_dist.xml @@ -136,16 +136,9 @@ </note> </section> - <section> + <section> <title>Distribution Header</title> <p> - <marker id="distribution_header"/> - As from ERTS 5.7.2 the old atom cache protocol was - dropped and a new one was introduced. This protocol - introduced the distribution header. Nodes with an ERTS version - earlier than 5.7.2 can still communicate with new nodes, - but no distribution header and no atom cache are used.</p> - <p> The distribution header only contains an atom cache reference section, but can in the future contain more information. The distribution header precedes one or more Erlang diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4ef06464f4..90162a6543 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -885,19 +885,22 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) #include "beam_warm.h" OpCase(normal_exit): { - SWAPOUT; + HEAVY_SWAPOUT; c_p->freason = EXC_NORMAL; c_p->arity = 0; /* In case this process will ever be garbed again. */ ERTS_UNREQ_PROC_MAIN_LOCK(c_p); erts_do_exit_process(c_p, am_normal); ERTS_REQ_PROC_MAIN_LOCK(c_p); + HEAVY_SWAPIN; goto do_schedule; } OpCase(continue_exit): { + HEAVY_SWAPOUT; ERTS_UNREQ_PROC_MAIN_LOCK(c_p); erts_continue_exit_process(c_p); ERTS_REQ_PROC_MAIN_LOCK(c_p); + HEAVY_SWAPIN; goto do_schedule; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 7ff55e8927..e9e294cd59 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -6108,7 +6108,8 @@ erts_release_literal_area(ErtsLiteralArea* literal_area) } default: ASSERT(is_external_header(oh->thing_word)); - erts_deref_node_entry(((ExternalThing*)oh)->node); + erts_deref_node_entry(((ExternalThing*)oh)->node, + make_boxed(&oh->thing_word)); } oh = oh->next; } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index ff7db0e742..a4c7af9a24 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -184,7 +184,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1) DistEntry *dep; ErtsLink *lnk; int code; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; dep = external_pid_dist_entry(BIF_ARG_1); if (dep == erts_this_dist_entry) @@ -201,9 +201,9 @@ BIF_RETTYPE link_1(BIF_ALIST_1) ldp = erts_link_to_data(lnk); - code = erts_dsig_prepare(&dsd, dep, BIF_P, + code = erts_dsig_prepare(&ctx, dep, BIF_P, ERTS_PROC_LOCK_MAIN, - ERTS_DSP_RLOCK, 0, 1); + ERTS_DSP_RLOCK, 0, 1, 1); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: @@ -222,9 +222,10 @@ BIF_RETTYPE link_1(BIF_ALIST_1) ASSERT(inserted); (void)inserted; erts_de_runlock(dep); - code = erts_dsig_send_link(&dsd, BIF_P->common.id, BIF_ARG_1); + code = erts_dsig_send_link(&ctx, BIF_P->common.id, BIF_ARG_1); if (code == ERTS_DSIG_SEND_YIELD) ERTS_BIF_YIELD_RETURN(BIF_P, am_true); + ASSERT(code == ERTS_DSIG_SEND_OK); BIF_RET(am_true); break; } @@ -306,7 +307,7 @@ demonitor(Process *c_p, Eterm ref, Eterm *multip) DistEntry *dep; int code = ERTS_DSIG_SEND_OK; int deleted; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; ASSERT(is_external_pid(to) || is_node_name_atom(to)); @@ -322,8 +323,8 @@ demonitor(Process *c_p, Eterm ref, Eterm *multip) } } - code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_PROC_LOCK_MAIN, - ERTS_DSP_RLOCK, 0, 0); + code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_RLOCK, 0, 1, 0); deleted = erts_monitor_dist_delete(&mdp->target); @@ -352,8 +353,8 @@ demonitor(Process *c_p, Eterm ref, Eterm *multip) * monitor list since in case of monitor name * the atom is stored there. Yield if necessary. */ - code = erts_dsig_send_demonitor(&dsd, c_p->common.id, - watched, mdp->ref, 0); + code = erts_dsig_send_demonitor(&ctx, c_p->common.id, + watched, mdp->ref); break; } @@ -533,7 +534,7 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2) } if (is_external_pid(target)) { - ErtsDSigData dsd; + ErtsDSigSendContext ctx; int code; dep = external_pid_dist_entry(target); @@ -551,9 +552,9 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2) BIF_P->common.id, id, name); erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P), &mdp->origin); - code = erts_dsig_prepare(&dsd, dep, + code = erts_dsig_prepare(&ctx, dep, BIF_P, ERTS_PROC_LOCK_MAIN, - ERTS_DSP_RLOCK, 0, 1); + ERTS_DSP_RLOCK, 0, 1, 1); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: @@ -568,7 +569,7 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2) ASSERT(inserted); (void)inserted; erts_de_runlock(dep); - code = erts_dsig_send_monitor(&dsd, BIF_P->common.id, target, ref); + code = erts_dsig_send_monitor(&ctx, BIF_P->common.id, target, ref); break; } @@ -914,7 +915,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) ErtsLinkData *ldp; DistEntry *dep; int code; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; dep = external_pid_dist_entry(BIF_ARG_1); if (dep == erts_this_dist_entry) @@ -932,15 +933,15 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) else erts_link_release(lnk); - code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN, - ERTS_DSP_NO_LOCK, 0, 0); + code = erts_dsig_prepare(&ctx, dep, BIF_P, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, 0, 1, 0); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: BIF_RET(am_true); case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: - code = erts_dsig_send_unlink(&dsd, BIF_P->common.id, BIF_ARG_1); + code = erts_dsig_send_unlink(&ctx, BIF_P->common.id, BIF_ARG_1); if (code == ERTS_DSIG_SEND_YIELD) ERTS_BIF_YIELD_RETURN(BIF_P, am_true); break; @@ -1301,10 +1302,11 @@ static BIF_RETTYPE send_exit_signal_bif(Process *c_p, Eterm id, Eterm reason, in ERTS_BIF_PREP_RET(ret_val, am_true); /* Old incarnation of this node... */ else { int code; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; + + code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, 0, 0, 1); - code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_PROC_LOCK_MAIN, - ERTS_DSP_NO_LOCK, 0, 1); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: @@ -1312,11 +1314,29 @@ static BIF_RETTYPE send_exit_signal_bif(Process *c_p, Eterm id, Eterm reason, in break; case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: - code = erts_dsig_send_exit2(&dsd, c_p->common.id, id, reason); - if (code == ERTS_DSIG_SEND_YIELD) + code = erts_dsig_send_exit2(&ctx, c_p->common.id, id, reason); + switch (code) { + case ERTS_DSIG_SEND_YIELD: ERTS_BIF_PREP_YIELD_RETURN(ret_val, c_p, am_true); - else + break; + case ERTS_DSIG_SEND_CONTINUE: + BUMP_ALL_REDS(c_p); + erts_set_gc_state(c_p, 0); + ERTS_BIF_PREP_TRAP1(ret_val, &dsend_continue_trap_export, c_p, + erts_dsend_export_trap_context(c_p, &ctx)); + break; + case ERTS_DSIG_SEND_OK: ERTS_BIF_PREP_RET(ret_val, am_true); + break; + case ERTS_DSIG_SEND_TOO_LRG: + erts_set_gc_state(c_p, 1); + ERTS_BIF_PREP_ERROR(ret_val, c_p, SYSTEM_LIMIT); + break; + default: + ASSERT(! "Invalid dsig send exit2 result"); + ERTS_BIF_PREP_ERROR(ret_val, c_p, EXC_INTERNAL_ERROR); + break; + } break; default: ASSERT(! "Invalid dsig prepare result"); @@ -1800,33 +1820,36 @@ ebif_bang_2(BIF_ALIST_2) static Sint remote_send(Process *p, DistEntry *dep, - Eterm to, Eterm full_to, Eterm msg, - ErtsSendContext* ctx) + Eterm to, Eterm node, Eterm full_to, Eterm msg, + Eterm return_term, Eterm *ctxpp, + int connect, int suspend) { Sint res; int code; + ErtsDSigSendContext ctx; ASSERT(is_atom(to) || is_external_pid(to)); - ctx->dep = dep; - code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_PROC_LOCK_MAIN, + code = erts_dsig_prepare(&ctx, dep, p, ERTS_PROC_LOCK_MAIN, ERTS_DSP_NO_LOCK, - !ctx->suspend, ctx->connect); + !suspend, 0, connect); + ctx.return_term = return_term; + ctx.node = node; switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: res = SEND_NOCONNECT; break; case ERTS_DSIG_PREP_WOULD_SUSPEND: - ASSERT(!ctx->suspend); + ASSERT(!suspend); res = SEND_YIELD; break; case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: { if (is_atom(to)) - code = erts_dsig_send_reg_msg(to, msg, ctx); + code = erts_dsig_send_reg_msg(&ctx, to, msg); else - code = erts_dsig_send_msg(to, msg, ctx); + code = erts_dsig_send_msg(&ctx, to, msg); /* * Note that reductions have been bumped on calling * process by erts_dsig_send_reg_msg() or @@ -1834,9 +1857,19 @@ static Sint remote_send(Process *p, DistEntry *dep, */ if (code == ERTS_DSIG_SEND_YIELD) res = SEND_YIELD_RETURN; - else if (code == ERTS_DSIG_SEND_CONTINUE) + else if (code == ERTS_DSIG_SEND_CONTINUE) { + erts_set_gc_state(p, 0); + + /* Keep a reference to the dist entry if the + name is an not a pid. */ + if (is_atom(to)) { + erts_ref_dist_entry(ctx.dep); + ctx.deref_dep = 1; + } + + *ctxpp = erts_dsend_export_trap_context(p, &ctx); res = SEND_YIELD_CONTINUE; - else if (code == ERTS_DSIG_SEND_TOO_LRG) + } else if (code == ERTS_DSIG_SEND_TOO_LRG) res = SEND_SYSTEM_LIMIT; else res = 0; @@ -1858,7 +1891,8 @@ static Sint remote_send(Process *p, DistEntry *dep, } static Sint -do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) +do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp, + Eterm *dist_ctx, int connect, int suspend) { Eterm portid; Port *pt; @@ -1890,7 +1924,8 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) erts_send_error_to_logger(p->group_leader, dsbufp); return 0; } - return remote_send(p, dep, to, to, msg, ctx); + return remote_send(p, dep, to, dep->sysname, to, msg, return_term, + dist_ctx, connect, suspend); } else if (is_atom(to)) { Eterm id = erts_whereis_name_to_id(p, to); @@ -1945,7 +1980,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) ret_val = 0; if (pt) { - int ps_flags = ctx->suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND; + int ps_flags = suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND; *refp = NIL; if (IS_TRACED_FL(p, F_TRACE_SEND)) /* trace once only !! */ @@ -1960,12 +1995,12 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) switch (erts_port_command(p, ps_flags, pt, msg, refp)) { case ERTS_PORT_OP_BUSY: /* Nothing has been sent */ - if (ctx->suspend) + if (suspend) erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt); return SEND_YIELD; case ERTS_PORT_OP_BUSY_SCHEDULED: /* Message was sent */ - if (ctx->suspend) { + if (suspend) { erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt); ret_val = SEND_YIELD_RETURN; break; @@ -2036,13 +2071,10 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) ASSERT(dep != erts_this_dist_entry); deref_dep = 1; } - ctx->dsd.node = tp[2]; - ret = remote_send(p, dep, tp[1], to, msg, ctx); - if (ret == SEND_YIELD_CONTINUE) { - erts_ref_dist_entry(ctx->dep); - ctx->deref_dep = 1; - } + ret = remote_send(p, dep, tp[1], tp[2], to, msg, return_term, + dist_ctx, connect, suspend); + if (deref_dep) erts_deref_dist_entry(dep); return ret; @@ -2081,25 +2113,16 @@ BIF_RETTYPE send_3(BIF_ALIST_3) Eterm l = opts; Sint result; - - DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P); + int connect = 1, suspend = 1; + Eterm ctx; ERTS_MSACC_PUSH_STATE_M_X(); - UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); - - ctx->suspend = !0; - ctx->connect = !0; - ctx->deref_dep = 0; - ctx->return_term = am_ok; - ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); - ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; - while (is_list(l)) { if (CAR(list_val(l)) == am_noconnect) { - ctx->connect = 0; + connect = 0; } else if (CAR(list_val(l)) == am_nosuspend) { - ctx->suspend = 0; + suspend = 0; } else { ERTS_BIF_PREP_ERROR(retval, p, BADARG); goto done; @@ -2116,7 +2139,7 @@ BIF_RETTYPE send_3(BIF_ALIST_3) #endif ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_SEND); - result = do_send(p, to, msg, &ref, ctx); + result = do_send(p, to, msg, am_ok, &ref, &ctx, connect, suspend); ERTS_MSACC_POP_STATE_M_X(); if (result >= 0) { @@ -2129,22 +2152,21 @@ BIF_RETTYPE send_3(BIF_ALIST_3) switch (result) { case SEND_NOCONNECT: - if (ctx->connect) { + if (connect) { ERTS_BIF_PREP_RET(retval, am_ok); } else { ERTS_BIF_PREP_RET(retval, am_noconnect); } break; case SEND_YIELD: - if (ctx->suspend) { - ERTS_BIF_PREP_YIELD3(retval, - bif_export[BIF_send_3], p, to, msg, opts); + if (suspend) { + ERTS_BIF_PREP_YIELD3(retval, bif_export[BIF_send_3], p, to, msg, opts); } else { ERTS_BIF_PREP_RET(retval, am_nosuspend); } break; case SEND_YIELD_RETURN: - if (!ctx->suspend) { + if (!suspend) { ERTS_BIF_PREP_RET(retval, am_nosuspend); break; } @@ -2169,9 +2191,7 @@ BIF_RETTYPE send_3(BIF_ALIST_3) break; case SEND_YIELD_CONTINUE: BUMP_ALL_REDS(p); - erts_set_gc_state(p, 0); - ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, - erts_dsend_export_trap_context(p, ctx)); + ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, ctx); break; default: erts_exit(ERTS_ABORT_EXIT, "send_3 invalid result %d\n", (int)result); @@ -2179,7 +2199,6 @@ BIF_RETTYPE send_3(BIF_ALIST_3) } done: - UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); return retval; } @@ -2193,14 +2212,14 @@ BIF_RETTYPE send_2(BIF_ALIST_2) static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1) { Binary* bin = erts_magic_ref2bin(BIF_ARG_1); - ErtsSendContext* ctx = (ErtsSendContext*) ERTS_MAGIC_BIN_DATA(bin); + ErtsDSigSendContext *ctx = (ErtsDSigSendContext*) ERTS_MAGIC_BIN_DATA(bin); Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(BIF_P) * TERM_TO_BINARY_LOOP_FACTOR); int result; ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dsend_context_dtor); - ctx->dss.reds = initial_reds; - result = erts_dsig_send(&ctx->dsd, &ctx->dss); + ctx->reds = initial_reds; + result = erts_dsig_send(ctx); switch (result) { case ERTS_DSIG_SEND_OK: @@ -2209,7 +2228,7 @@ static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1) break; case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/ erts_set_gc_state(BIF_P, 1); - if (!ctx->suspend) + if (ctx->no_suspend) BIF_RET(am_nosuspend); ERTS_BIF_YIELD_RETURN(BIF_P, ctx->return_term); @@ -2234,20 +2253,14 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) Eterm retval; Eterm ref; Sint result; - DeclareTypedTmpHeap(ErtsSendContext, ctx, p); + Eterm ctx; ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_SEND); - UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); + #ifdef DEBUG ref = NIL; #endif - ctx->suspend = !0; - ctx->connect = !0; - ctx->deref_dep = 0; - ctx->return_term = msg; - ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); - ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; - result = do_send(p, to, msg, &ref, ctx); + result = do_send(p, to, msg, msg, &ref, &ctx, 1, 1); ERTS_MSACC_POP_STATE_M_X(); @@ -2289,9 +2302,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) break; case SEND_YIELD_CONTINUE: BUMP_ALL_REDS(p); - erts_set_gc_state(p, 0); - ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, - erts_dsend_export_trap_context(p, ctx)); + ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, ctx); break; default: erts_exit(ERTS_ABORT_EXIT, "invalid send result %d\n", (int)result); @@ -2299,7 +2310,6 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) } done: - UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); return retval; } @@ -4053,10 +4063,12 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1) if (is_nil(dep->cid)) goto bad; - enp = erts_find_or_insert_node(dep->sysname, dep->creation); + etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1); + + enp = erts_find_or_insert_node(dep->sysname, dep->creation, + make_boxed(&etp->header)); ASSERT(enp != erts_this_node); - etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1); etp->header = make_external_pid_header(1); etp->next = MSO(BIF_P).first; etp->node = enp; @@ -4120,10 +4132,11 @@ BIF_RETTYPE list_to_port_1(BIF_ALIST_1) if (is_nil(dep->cid)) goto bad; - enp = erts_find_or_insert_node(dep->sysname, dep->creation); + etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1); + enp = erts_find_or_insert_node(dep->sysname, dep->creation, + make_boxed(&etp->header)); ASSERT(enp != erts_this_node); - etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1); etp->header = make_external_port_header(1); etp->next = MSO(BIF_P).first; etp->node = enp; @@ -4226,9 +4239,6 @@ BIF_RETTYPE list_to_ref_1(BIF_ALIST_1) if (is_nil(dep->cid)) goto bad; - enp = erts_find_or_insert_node(dep->sysname, dep->creation); - ASSERT(enp != erts_this_node); - hsz = EXTERNAL_THING_HEAD_SIZE; #if defined(ARCH_64) hsz += n/2 + 1; @@ -4237,6 +4247,11 @@ BIF_RETTYPE list_to_ref_1(BIF_ALIST_1) #endif etp = (ExternalThing *) HAlloc(BIF_P, hsz); + + enp = erts_find_or_insert_node(dep->sysname, dep->creation, + make_boxed(&etp->header)); + ASSERT(enp != erts_this_node); + etp->header = make_external_ref_header(n/2); etp->next = BIF_P->off_heap.first; etp->node = enp; @@ -4356,21 +4371,21 @@ BIF_RETTYPE erts_internal_group_leader_2(BIF_ALIST_2) if (is_external_pid(BIF_ARG_2)) { DistEntry *dep; int code; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; dep = external_pid_dist_entry(BIF_ARG_2); ERTS_ASSERT(dep); if(dep == erts_this_dist_entry) BIF_ERROR(BIF_P, BADARG); - code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN, - ERTS_DSP_NO_LOCK, 0, 1); + code = erts_dsig_prepare(&ctx, dep, BIF_P, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, 0, 1, 1); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: BIF_RET(am_true); case ERTS_DSIG_PREP_PENDING: case ERTS_DSIG_PREP_CONNECTED: - code = erts_dsig_send_group_leader(&dsd, BIF_ARG_1, BIF_ARG_2); + code = erts_dsig_send_group_leader(&ctx, BIF_ARG_1, BIF_ARG_2); if (code == ERTS_DSIG_SEND_YIELD) ERTS_BIF_YIELD_RETURN(BIF_P, am_true); BIF_RET(am_true); diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 273b598562..27bf2187c2 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -129,7 +129,7 @@ typedef struct { void *to_arg; } PrintMonitorContext; -static void doit_print_link(ErtsLink *lnk, void *vpcontext) +static int doit_print_link(ErtsLink *lnk, void *vpcontext, Sint reds) { PrintMonitorContext *pcontext = vpcontext; fmtfn_t to = pcontext->to; @@ -141,10 +141,11 @@ static void doit_print_link(ErtsLink *lnk, void *vpcontext) } else { erts_print(to, to_arg, ", %T", lnk->other.item); } + return 1; } -static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext) +static int doit_print_monitor(ErtsMonitor *mon, void *vpcontext, Sint reds) { ErtsMonitorData *mdp; PrintMonitorContext *pcontext = vpcontext; @@ -196,6 +197,7 @@ static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext) /* ignore other monitors... */ break; } + return 1; } /* Display info about an individual Erlang process */ diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index e7bd046e18..db74b06cc5 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -854,7 +854,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint case EXTERNAL_REF_SUBTAG: { ExternalThing *etp = (ExternalThing *) objp; - erts_refc_inc(&etp->node->refc, 2); + erts_ref_node_entry(etp->node, 2, make_boxed(htop)); } L_off_heap_node_container_common: { @@ -1660,7 +1660,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, case EXTERNAL_REF_SUBTAG: { ExternalThing *etp = (ExternalThing *) ptr; - erts_refc_inc(&etp->node->refc, 2); + erts_ref_node_entry(etp->node, 2, make_boxed(hp)); } off_heap_node_container_common: { @@ -1866,7 +1866,7 @@ Eterm copy_shallow(Eterm* ERTS_RESTRICT ptr, Uint sz, Eterm** hpp, case EXTERNAL_REF_SUBTAG: { ExternalThing* etp = (ExternalThing *) (tp-1); - erts_refc_inc(&etp->node->refc, 2); + erts_ref_node_entry(etp->node, 2, make_boxed(hp-1)); } off_heap_common: { diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 15642e1669..b50c8273b1 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -50,19 +50,26 @@ #define DIST_CTL_DEFAULT_SIZE 64 /* Turn this on to get printouts of all distribution messages - * which go on the line + * which go on the line. Enabling this may make some testcases + * fail. Especially the broken dist testcases in distribution_SUITE. */ #if 0 #define ERTS_DIST_MSG_DBG +FILE *dbg_file; #endif #if 0 +/* Enable this to print the dist debug messages to a file instead */ +#define ERTS_DIST_MSG_DBG_FILE "/tmp/dist_dbg.%d" +#endif +#if 0 +/* Enable this to print the raw bytes sent and received */ #define ERTS_RAW_DIST_MSG_DBG #endif #if defined(ERTS_DIST_MSG_DBG) || defined(ERTS_RAW_DIST_MSG_DBG) static void bw(byte *buf, ErlDrvSizeT sz) { - bin_write(ERTS_PRINT_STDERR, NULL, buf, sz); + bin_write(ERTS_PRINT_FILE, dbg_file, buf, sz); } #endif @@ -70,39 +77,93 @@ static void bw(byte *buf, ErlDrvSizeT sz) static void dist_msg_dbg(ErtsDistExternal *edep, char *what, byte *buf, int sz) { - ErtsHeapFactory factory; - DeclareTmpHeapNoproc(ctl_default,DIST_CTL_DEFAULT_SIZE); - Eterm* ctl = ctl_default; - byte *extp = edep->extp; + byte *extp = edep->data->extp; Eterm msg; Sint ctl_len; - Sint size = ctl_len = erts_decode_dist_ext_size(edep); + Sint size = ctl_len = erts_decode_dist_ext_size(edep, 0); if (size < 0) { - erts_fprintf(stderr, + erts_fprintf(dbg_file, "DIST MSG DEBUG: erts_decode_dist_ext_size(%s) failed:\n", what); bw(buf, sz); } else { - ErlHeapFragment *mbuf = new_message_buffer(size); - erts_factory_static_init(&factory, ctl, ctl_len, &mbuf->off_heap); - msg = erts_decode_dist_ext(&factory, edep); + ErtsHeapFactory factory; + ErtsMessage *mbuf = erts_factory_message_create(&factory, NULL, 0, ctl_len); + /* Set mbuf msg to NIL as erts_factory_undo will fail otherwise */ + ERL_MESSAGE_TERM(mbuf) = NIL; + msg = erts_decode_dist_ext(&factory, edep, 0); if (is_value(msg)) - erts_fprintf(stderr, " %s: %T\n", what, msg); + erts_fprintf(dbg_file, " %s: %.80T\n", what, msg); else { - erts_fprintf(stderr, + erts_fprintf(dbg_file, "DIST MSG DEBUG: erts_decode_dist_ext(%s) failed:\n", what); bw(buf, sz); } - free_message_buffer(mbuf); - edep->extp = extp; + erts_factory_undo(&factory); + edep->data->extp = extp; } } +static char *erts_dop_to_string(enum dop dop) { + if (dop == DOP_LINK) + return "LINK"; + if (dop == DOP_SEND) + return "SEND"; + if (dop == DOP_EXIT) + return "EXIT"; + if (dop == DOP_UNLINK) + return "UNLINK"; + if (dop == DOP_REG_SEND) + return "REG_SEND"; + if (dop == DOP_GROUP_LEADER) + return "GROUP_LEADER"; + if (dop == DOP_EXIT2) + return "EXIT2"; + if (dop == DOP_SEND_TT) + return "SEND_TT"; + if (dop == DOP_EXIT_TT) + return "EXIT_TT"; + if (dop == DOP_REG_SEND_TT) + return "REG_SEND_TT"; + if (dop == DOP_EXIT2_TT) + return "EXIT2_TT"; + if (dop == DOP_MONITOR_P) + return "MONITOR_P"; + if (dop == DOP_DEMONITOR_P) + return "DEMONITOR_P"; + if (dop == DOP_MONITOR_P_EXIT) + return "MONITOR_P_EXIT"; + if (dop == DOP_SEND_SENDER) + return "SEND_SENDER"; + if (dop == DOP_SEND_SENDER_TT) + return "SEND_SENDER_TT"; + if (dop == DOP_PAYLOAD_EXIT) + return "PAYLOAD_EXIT"; + if (dop == DOP_PAYLOAD_EXIT_TT) + return "PAYLOAD_EXIT_TT"; + if (dop == DOP_PAYLOAD_EXIT2) + return "PAYLOAD_EXIT2"; + if (dop == DOP_PAYLOAD_EXIT2_TT) + return "PAYLOAD_EXIT2_TT"; + if (dop == DOP_PAYLOAD_MONITOR_P_EXIT) + return "PAYLOAD_MONITOR_P_EXIT"; + ASSERT(0); + return "UNKNOWN"; +} + #endif +#if defined(VALGRIND) +#include <valgrind/valgrind.h> +#include <valgrind/memcheck.h> +# define PURIFY_MSG(msg) \ + VALGRIND_PRINTF("%s, line %d: %s", __FILE__, __LINE__, msg) +#else +# define PURIFY_MSG(msg) +#endif int erts_is_alive; /* System must be blocked on change */ int erts_dist_buf_busy_limit; @@ -116,12 +177,17 @@ static Export *dist_ctrl_put_data_trap; /* forward declarations */ -static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy); +static void erts_schedule_dist_command(Port *, DistEntry *); +static int dsig_send_exit(ErtsDSigSendContext *ctx, Eterm ctl, Eterm msg); +static int dsig_send_ctl(ErtsDSigSendContext *ctx, Eterm ctl); static void send_nodes_mon_msgs(Process *, Eterm, Eterm, Eterm, Eterm); static void init_nodes_monitors(void); static Sint abort_connection(DistEntry* dep, Uint32 conn_id); static ErtsDistOutputBuf* clear_de_out_queues(DistEntry*); static void free_de_out_queues(DistEntry*, ErtsDistOutputBuf*); +int erts_dist_seq_tree_foreach_delete_yielding(DistSeqNode **root, + void **vyspp, + Sint limit); static erts_atomic_t no_caches; static erts_atomic_t no_nodes; @@ -142,7 +208,6 @@ delete_cache(ErtsAtomCache *cache) } } - static void create_cache(DistEntry *dep) { @@ -185,32 +250,36 @@ get_suspended_on_de(DistEntry *dep, erts_aint32_t unset_qflgs) } } -#define ERTS_MON_LNK_FIRE_LIMIT 100 +#define ERTS_MON_LNK_FIRE_REDS 40 -static void monitor_connection_down(ErtsMonitor *mon, void *unused) +static int monitor_connection_down(ErtsMonitor *mon, void *unused, Sint reds) { if (erts_monitor_is_origin(mon)) erts_proc_sig_send_demonitor(mon); else erts_proc_sig_send_monitor_down(mon, am_noconnection); + return ERTS_MON_LNK_FIRE_REDS; } -static void link_connection_down(ErtsLink *lnk, void *vdist) +static int link_connection_down(ErtsLink *lnk, void *vdist, Sint reds) { erts_proc_sig_send_link_exit(NULL, THE_NON_VALUE, lnk, am_noconnection, NIL); + return ERTS_MON_LNK_FIRE_REDS; } typedef enum { ERTS_CML_CLEANUP_STATE_LINKS, ERTS_CML_CLEANUP_STATE_MONITORS, ERTS_CML_CLEANUP_STATE_ONAME_MONITORS, + ERTS_CML_CLEANUP_STATE_SEQUENCES, ERTS_CML_CLEANUP_STATE_NODE_MONITORS -} ErtsConMonLnkCleaupState; +} ErtsConMonLnkSeqCleanupState; typedef struct { - ErtsConMonLnkCleaupState state; + ErtsConMonLnkSeqCleanupState state; ErtsMonLnkDist *dist; + DistSeqNode *seq; void *yield_state; int trigger_node_monitors; Eterm nodename; @@ -218,49 +287,58 @@ typedef struct { Eterm reason; ErlOffHeap oh; Eterm heap[1]; -} ErtsConMonLnkCleanup; +} ErtsConMonLnkSeqCleanup; static void -con_monitor_link_cleanup(void *vcmlcp) +con_monitor_link_seq_cleanup(void *vcmlcp) { - ErtsConMonLnkCleanup *cmlcp = vcmlcp; + ErtsConMonLnkSeqCleanup *cmlcp = vcmlcp; ErtsMonLnkDist *dist = cmlcp->dist; ErtsSchedulerData *esdp; - int yield; + int reds = CONTEXT_REDS; switch (cmlcp->state) { case ERTS_CML_CLEANUP_STATE_LINKS: - yield = erts_link_list_foreach_delete_yielding(&dist->links, - link_connection_down, - NULL, &cmlcp->yield_state, - ERTS_MON_LNK_FIRE_LIMIT); - if (yield) + reds = erts_link_list_foreach_delete_yielding(&dist->links, + link_connection_down, + NULL, &cmlcp->yield_state, + reds); + if (reds <= 0) break; ASSERT(!cmlcp->yield_state); cmlcp->state = ERTS_CML_CLEANUP_STATE_MONITORS; case ERTS_CML_CLEANUP_STATE_MONITORS: - yield = erts_monitor_list_foreach_delete_yielding(&dist->monitors, - monitor_connection_down, - NULL, &cmlcp->yield_state, - ERTS_MON_LNK_FIRE_LIMIT); - if (yield) + reds = erts_monitor_list_foreach_delete_yielding(&dist->monitors, + monitor_connection_down, + NULL, &cmlcp->yield_state, + reds); + if (reds <= 0) break; ASSERT(!cmlcp->yield_state); cmlcp->state = ERTS_CML_CLEANUP_STATE_ONAME_MONITORS; case ERTS_CML_CLEANUP_STATE_ONAME_MONITORS: - yield = erts_monitor_tree_foreach_delete_yielding(&dist->orig_name_monitors, - monitor_connection_down, - NULL, &cmlcp->yield_state, - ERTS_MON_LNK_FIRE_LIMIT/2); - if (yield) + reds = erts_monitor_tree_foreach_delete_yielding(&dist->orig_name_monitors, + monitor_connection_down, + NULL, &cmlcp->yield_state, + reds); + if (reds <= 0) break; cmlcp->dist = NULL; erts_mon_link_dist_dec_refc(dist); ASSERT(!cmlcp->yield_state); + cmlcp->state = ERTS_CML_CLEANUP_STATE_SEQUENCES; + case ERTS_CML_CLEANUP_STATE_SEQUENCES: + reds = erts_dist_seq_tree_foreach_delete_yielding(&cmlcp->seq, + &cmlcp->yield_state, + reds); + if (reds <= 0) + break; + + ASSERT(!cmlcp->yield_state); cmlcp->state = ERTS_CML_CLEANUP_STATE_NODE_MONITORS; case ERTS_CML_CLEANUP_STATE_NODE_MONITORS: if (cmlcp->trigger_node_monitors) { @@ -280,22 +358,23 @@ con_monitor_link_cleanup(void *vcmlcp) esdp = erts_get_scheduler_data(); ASSERT(esdp && esdp->type == ERTS_SCHED_NORMAL); erts_schedule_misc_aux_work((int) esdp->no, - con_monitor_link_cleanup, + con_monitor_link_seq_cleanup, (void *) cmlcp); } static void -schedule_con_monitor_link_cleanup(ErtsMonLnkDist *dist, - Eterm nodename, - Eterm visability, - Eterm reason) +schedule_con_monitor_link_seq_cleanup(ErtsMonLnkDist *dist, + DistSeqNode *seq, + Eterm nodename, + Eterm visability, + Eterm reason) { - if (dist || is_value(nodename)) { + if (dist || is_value(nodename) || seq) { ErtsSchedulerData *esdp; - ErtsConMonLnkCleanup *cmlcp; + ErtsConMonLnkSeqCleanup *cmlcp; Uint rsz, size; - size = sizeof(ErtsConMonLnkCleanup); + size = sizeof(ErtsConMonLnkSeqCleanup); if (is_non_value(reason) || is_immed(reason)) { rsz = 0; @@ -322,6 +401,8 @@ schedule_con_monitor_link_cleanup(ErtsMonLnkDist *dist, erts_mtx_unlock(&dist->mtx); } + cmlcp->seq = seq; + cmlcp->trigger_node_monitors = is_value(nodename); cmlcp->nodename = nodename; cmlcp->visability = visability; @@ -335,13 +416,13 @@ schedule_con_monitor_link_cleanup(ErtsMonLnkDist *dist, esdp = erts_get_scheduler_data(); ASSERT(esdp && esdp->type == ERTS_SCHED_NORMAL); erts_schedule_misc_aux_work((int) esdp->no, - con_monitor_link_cleanup, + con_monitor_link_seq_cleanup, (void *) cmlcp); } } /* -** A full node name constists of a "n@h" +** A full node name consists of a "n@h" ** ** n must be a valid node name: string of ([a-z][A-Z][0-9]_-)+ ** @@ -558,6 +639,7 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) } else { /* Call from distribution controller (port/process) */ ErtsMonLnkDist *mld; + DistSeqNode *sequences; ErtsAtomCache *cache; ErtsProcList *suspendees; ErtsDistOutputBuf *obuf; @@ -587,6 +669,9 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) mld = dep->mld; dep->mld = NULL; + sequences = dep->sequences; + dep->sequences = NULL; + nodename = dep->sysname; flags = dep->flags; @@ -610,14 +695,15 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) erts_de_rwunlock(dep); - schedule_con_monitor_link_cleanup(mld, - nodename, - (flags & DFLAG_PUBLISHED - ? am_visible - : am_hidden), - (reason == am_normal - ? am_connection_closed - : reason)); + schedule_con_monitor_link_seq_cleanup(mld, + sequences, + nodename, + (flags & DFLAG_PUBLISHED + ? am_visible + : am_hidden), + (reason == am_normal + ? am_connection_closed + : reason)); erts_resume_processes(suspendees); @@ -651,6 +737,16 @@ void init_dist(void) { init_nodes_monitors(); +#ifdef ERTS_DIST_MSG_DBG_FILE + { + char buff[255]; + sprintf(buff, ERTS_DIST_MSG_DBG_FILE, getpid()); + dbg_file = fopen(buff,"w+"); + } +#elif defined (ERTS_DIST_MSG_DBG) + dbg_file = stderr; +#endif + nodedown.reason = NIL; nodedown.bp = NULL; @@ -674,21 +770,79 @@ void init_dist(void) } } -#define ErtsDistOutputBuf2Binary(OB) \ - ((Binary *) (((char *) (OB)) - offsetof(Binary, orig_bytes))) +#define ErtsDistOutputBuf2Binary(OB) OB->bin + +#ifdef DEBUG + +struct obuf_list; +struct obuf_list { + erts_refc_t refc; + struct obuf_list *next; + struct obuf_list *prev; +}; +#define obuf_list_size sizeof(struct obuf_list) +static struct obuf_list *erts_obuf_list = NULL; +static erts_mtx_t erts_obuf_list_mtx; + +static void +insert_obuf(struct obuf_list *obuf, erts_aint_t initial) { + erts_mtx_lock(&erts_obuf_list_mtx); + obuf->next = erts_obuf_list; + obuf->prev = NULL; + erts_refc_init(&obuf->refc, initial); + if (erts_obuf_list) + erts_obuf_list->prev = obuf; + erts_obuf_list = obuf; + erts_mtx_unlock(&erts_obuf_list_mtx); +} + +static void +remove_obuf(struct obuf_list *obuf) { + if (erts_refc_dectest(&obuf->refc, 0) == 0) { + erts_mtx_lock(&erts_obuf_list_mtx); + if (obuf->prev) { + obuf->prev->next = obuf->next; + } else { + erts_obuf_list = obuf->next; + } + if (obuf->next) obuf->next->prev = obuf->prev; + erts_mtx_unlock(&erts_obuf_list_mtx); + } +} + +void check_obuf(void); +void check_obuf(void) { + erts_mtx_lock(&erts_obuf_list_mtx); + ERTS_ASSERT(erts_obuf_list == NULL); + erts_mtx_unlock(&erts_obuf_list_mtx); +} +#else +#define insert_obuf(...) +#define remove_obuf(...) +#define obuf_list_size 0 +#endif static ERTS_INLINE ErtsDistOutputBuf * -alloc_dist_obuf(Uint size) +alloc_dist_obuf(Uint size, Uint headers) { + int i; ErtsDistOutputBuf *obuf; - Uint obuf_size = sizeof(ErtsDistOutputBuf)+sizeof(byte)*(size-1); + Uint obuf_size = sizeof(ErtsDistOutputBuf)*(headers) + + sizeof(byte)*size + obuf_list_size; Binary *bin = erts_bin_drv_alloc(obuf_size); - obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0]; + size += obuf_list_size; + obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[size]; + erts_refc_add(&bin->intern.refc, headers - 1, 1); + for (i = 0; i < headers; i++) { + obuf[i].bin = bin; + obuf[i].extp = (byte *)&bin->orig_bytes[0] + obuf_list_size; #ifdef DEBUG - obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN; - obuf->alloc_endp = obuf->data + size; - ASSERT(bin == ErtsDistOutputBuf2Binary(obuf)); + obuf[i].dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN; + obuf[i].alloc_endp = obuf->extp + size; + ASSERT(bin == ErtsDistOutputBuf2Binary(obuf)); #endif + } + insert_obuf((struct obuf_list*)&bin->orig_bytes[0], headers); return obuf; } @@ -697,14 +851,17 @@ free_dist_obuf(ErtsDistOutputBuf *obuf) { Binary *bin = ErtsDistOutputBuf2Binary(obuf); ASSERT(obuf->dbg_pattern == ERTS_DIST_OUTPUT_BUF_DBG_PATTERN); - erts_bin_release(bin); + remove_obuf((struct obuf_list*)&bin->orig_bytes[0]); + if (erts_refc_dectest(&bin->intern.refc, 0) == 0) { + erts_bin_free(bin); + } } static ERTS_INLINE Sint size_obuf(ErtsDistOutputBuf *obuf) { - Binary *bin = ErtsDistOutputBuf2Binary(obuf); - return bin->orig_size; + return sizeof(ErtsDistOutputBuf) + (obuf->ext_endp - obuf->ext_start) + + (obuf->hdr_endp - obuf->hdrp); } static ErtsDistOutputBuf* clear_de_out_queues(DistEntry* dep) @@ -758,18 +915,20 @@ static void free_de_out_queues(DistEntry* dep, ErtsDistOutputBuf *obuf) int erts_dsend_context_dtor(Binary* ctx_bin) { - ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin); - switch (ctx->dss.phase) { + ErtsDSigSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin); + switch (ctx->phase) { case ERTS_DSIG_SEND_PHASE_MSG_SIZE: - DESTROY_SAVED_WSTACK(&ctx->dss.u.sc.wstack); + DESTROY_SAVED_WSTACK(&ctx->u.sc.wstack); break; case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: - DESTROY_SAVED_WSTACK(&ctx->dss.u.ec.wstack); + DESTROY_SAVED_WSTACK(&ctx->u.ec.wstack); break; default:; } - if (ctx->dss.phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->dss.obuf) { - free_dist_obuf(ctx->dss.obuf); + if (ctx->phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->obuf) { + int i; + for (i = 0; i < ctx->fragments; i++) + free_dist_obuf(&ctx->obuf[i]); } if (ctx->deref_dep) erts_deref_dist_entry(ctx->dep); @@ -777,10 +936,10 @@ int erts_dsend_context_dtor(Binary* ctx_bin) return 1; } -Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) +Eterm erts_dsend_export_trap_context(Process* p, ErtsDSigSendContext* ctx) { struct exported_ctx { - ErtsSendContext ctx; + ErtsDSigSendContext ctx; ErtsAtomCacheMap acm; }; Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx), @@ -788,12 +947,12 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin); Eterm* hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); - sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext)); - ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap)); - dst->ctx.dss.ctl = make_tuple(dst->ctx.ctl_heap); - if (ctx->dss.acmp) { - sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap)); - dst->ctx.dss.acmp = &dst->acm; + sys_memcpy(&dst->ctx, ctx, sizeof(ErtsDSigSendContext)); + ASSERT(ctx->ctl == make_tuple(ctx->ctl_heap)); + dst->ctx.ctl = make_tuple(dst->ctx.ctl_heap); + if (ctx->acmp) { + sys_memcpy(&dst->acm, ctx->acmp, sizeof(ErtsAtomCacheMap)); + dst->ctx.acmp = &dst->acm; } return erts_mk_magic_ref(&hp, &MSO(p), ctx_bin); } @@ -814,71 +973,58 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) ** Send a DOP_LINK link message */ int -erts_dsig_send_link(ErtsDSigData *dsdp, Eterm local, Eterm remote) +erts_dsig_send_link(ErtsDSigSendContext *ctx, Eterm local, Eterm remote) { - DeclareTmpHeapNoproc(ctl_heap,4); - Eterm ctl = TUPLE3(&ctl_heap[0], make_small(DOP_LINK), local, remote); - int res; - UseTmpHeapNoproc(4); - - res = dsig_send_ctl(dsdp, ctl, 0); - UnUseTmpHeapNoproc(4); - return res; + Eterm ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_LINK), local, remote); + return dsig_send_ctl(ctx, ctl); } int -erts_dsig_send_unlink(ErtsDSigData *dsdp, Eterm local, Eterm remote) +erts_dsig_send_unlink(ErtsDSigSendContext *ctx, Eterm local, Eterm remote) { - DeclareTmpHeapNoproc(ctl_heap,4); - Eterm ctl = TUPLE3(&ctl_heap[0], make_small(DOP_UNLINK), local, remote); - int res; - - UseTmpHeapNoproc(4); - res = dsig_send_ctl(dsdp, ctl, 0); - UnUseTmpHeapNoproc(4); - return res; + Eterm ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_UNLINK), local, remote); + return dsig_send_ctl(ctx, ctl); } /* A local process that's being monitored by a remote one exits. We send: {DOP_MONITOR_P_EXIT, Local pid or name, Remote pid, ref, reason} */ int -erts_dsig_send_m_exit(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, - Eterm ref, Eterm reason) +erts_dsig_send_m_exit(ErtsDSigSendContext *ctx, Eterm watcher, Eterm watched, + Eterm ref, Eterm reason) { - Eterm ctl; - DeclareTmpHeapNoproc(ctl_heap,6); - int res; + Eterm ctl, msg; - if (~dsdp->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) { + if (~ctx->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) { /* * Receiver does not support DOP_MONITOR_P_EXIT (see dsig_send_monitor) */ return ERTS_DSIG_SEND_OK; } - UseTmpHeapNoproc(6); - - ctl = TUPLE5(&ctl_heap[0], make_small(DOP_MONITOR_P_EXIT), - watched, watcher, ref, reason); + if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) { + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_PAYLOAD_MONITOR_P_EXIT), + watched, watcher, ref); + msg = reason; + } else { + ctl = TUPLE5(&ctx->ctl_heap[0], make_small(DOP_MONITOR_P_EXIT), + watched, watcher, ref, reason); + msg = THE_NON_VALUE; + } - res = dsig_send_ctl(dsdp, ctl, 1); - UnUseTmpHeapNoproc(6); - return res; + return dsig_send_exit(ctx, ctl, msg); } /* We want to monitor a process (named or unnamed) on another node, we send: {DOP_MONITOR_P, Local pid, Remote pid or name, Ref}, which is exactly what's needed on the other side... */ int -erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, +erts_dsig_send_monitor(ErtsDSigSendContext *ctx, Eterm watcher, Eterm watched, Eterm ref) { Eterm ctl; - DeclareTmpHeapNoproc(ctl_heap,5); - int res; - if (~dsdp->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) { + if (~ctx->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) { /* * Receiver does not support DOP_MONITOR_P. * Just avoid sending it and by doing that reduce this monitor @@ -888,48 +1034,40 @@ erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, return ERTS_DSIG_SEND_OK; } - UseTmpHeapNoproc(5); - ctl = TUPLE4(&ctl_heap[0], + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_MONITOR_P), watcher, watched, ref); - res = dsig_send_ctl(dsdp, ctl, 0); - UnUseTmpHeapNoproc(5); - return res; + return dsig_send_ctl(ctx, ctl); } /* A local process monitoring a remote one wants to stop monitoring, either because of a demonitor bif call or because the local process died. We send {DOP_DEMONITOR_P, Local pid, Remote pid or name, ref} */ int -erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher, - Eterm watched, Eterm ref, int force) +erts_dsig_send_demonitor(ErtsDSigSendContext *ctx, Eterm watcher, + Eterm watched, Eterm ref) { Eterm ctl; - DeclareTmpHeapNoproc(ctl_heap,5); - int res; - if (~dsdp->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) { + if (~ctx->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) { /* * Receiver does not support DOP_DEMONITOR_P (see dsig_send_monitor) */ return ERTS_DSIG_SEND_OK; } - UseTmpHeapNoproc(5); - ctl = TUPLE4(&ctl_heap[0], + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_DEMONITOR_P), watcher, watched, ref); - res = dsig_send_ctl(dsdp, ctl, force); - UnUseTmpHeapNoproc(5); - return res; + return dsig_send_ctl(ctx, ctl); } -static int can_send_seqtrace_token(ErtsSendContext* ctx, Eterm token) { +static int can_send_seqtrace_token(ErtsDSigSendContext* ctx, Eterm token) { Eterm label; - if (ctx->dsd.flags & DFLAG_BIG_SEQTRACE_LABELS) { + if (ctx->flags & DFLAG_BIG_SEQTRACE_LABELS) { /* The other end is capable of handling arbitrary seq_trace labels. */ return 1; } @@ -945,11 +1083,11 @@ static int can_send_seqtrace_token(ErtsSendContext* ctx, Eterm token) { } int -erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) +erts_dsig_send_msg(ErtsDSigSendContext* ctx, Eterm remote, Eterm message) { Eterm ctl; Eterm token = NIL; - Process *sender = ctx->dsd.proc; + Process *sender = ctx->c_p; int res; #ifdef USE_VM_PROBES Sint tok_label = 0; @@ -970,7 +1108,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) *node_name = *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) { erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), - "%T", ctx->dsd.dep->sysname); + "%T", ctx->dep->sysname); erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), @@ -990,7 +1128,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) send_token = (token != NIL && can_send_seqtrace_token(ctx, token)); - if (ctx->dsd.flags & DFLAG_SEND_SENDER) { + if (ctx->flags & DFLAG_SEND_SENDER) { dist_op = make_small(send_token ? DOP_SEND_SENDER_TT : DOP_SEND_SENDER); @@ -1013,21 +1151,18 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); - ctx->dss.ctl = ctl; - ctx->dss.msg = message; - ctx->dss.force_busy = 0; - res = erts_dsig_send(&ctx->dsd, &ctx->dss); + ctx->ctl = ctl; + ctx->msg = message; + res = erts_dsig_send(ctx); return res; } int -erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, - ErtsSendContext* ctx) +erts_dsig_send_reg_msg(ErtsDSigSendContext* ctx, Eterm remote_name, Eterm message) { Eterm ctl; Eterm token = NIL; - Process *sender = ctx->dsd.proc; - int res; + Process *sender = ctx->c_p; #ifdef USE_VM_PROBES Sint tok_label = 0; Sint tok_lastcnt = 0; @@ -1047,7 +1182,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, *node_name = *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) { erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), - "%T", ctx->dsd.dep->sysname); + "%T", ctx->dep->sysname); erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), @@ -1072,23 +1207,19 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); - ctx->dss.ctl = ctl; - ctx->dss.msg = message; - ctx->dss.force_busy = 0; - res = erts_dsig_send(&ctx->dsd, &ctx->dss); - return res; + ctx->ctl = ctl; + ctx->msg = message; + return erts_dsig_send(ctx); } /* local has died, deliver the exit signal to remote */ int -erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, +erts_dsig_send_exit_tt(ErtsDSigSendContext *ctx, Eterm local, Eterm remote, Eterm reason, Eterm token) { - Eterm ctl; - DeclareTmpHeapNoproc(ctl_heap,6); - int res; + Eterm ctl, msg = THE_NON_VALUE; #ifdef USE_VM_PROBES - Process *sender = dsdp->proc; + Process *sender = ctx->c_p; Sint tok_label = 0; Sint tok_lastcnt = 0; Sint tok_serial = 0; @@ -1098,20 +1229,29 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, DTRACE_CHARBUF(reason_str, 128); #endif - UseTmpHeapNoproc(6); + if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) + msg = reason; + if (have_seqtrace(token)) { - seq_trace_update_send(dsdp->proc); + seq_trace_update_send(ctx->c_p); seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local); - ctl = TUPLE5(&ctl_heap[0], - make_small(DOP_EXIT_TT), local, remote, token, reason); + if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) { + ctl = TUPLE4(&ctx->ctl_heap[0], + make_small(DOP_PAYLOAD_EXIT_TT), local, remote, token); + } else + ctl = TUPLE5(&ctx->ctl_heap[0], + make_small(DOP_EXIT_TT), local, remote, token, reason); } else { - ctl = TUPLE4(&ctl_heap[0], make_small(DOP_EXIT), local, remote, reason); + if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) + ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_PAYLOAD_EXIT), local, remote); + else + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_EXIT), local, remote, reason); } #ifdef USE_VM_PROBES *node_name = *sender_name = *remote_name = '\0'; if (DTRACE_ENABLED(process_exit_signal_remote)) { erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), - "%T", dsdp->dep->sysname); + "%T", ctx->dep->sysname); erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); erts_snprintf(remote_name, sizeof(DTRACE_CHARBUF_NAME(remote_name)), @@ -1127,73 +1267,171 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, #endif DTRACE7(process_exit_signal_remote, sender_name, node_name, remote_name, reason_str, tok_label, tok_lastcnt, tok_serial); - /* forced, i.e ignore busy */ - res = dsig_send_ctl(dsdp, ctl, 1); - UnUseTmpHeapNoproc(6); - return res; + return dsig_send_exit(ctx, ctl, msg); } int -erts_dsig_send_exit(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason) +erts_dsig_send_exit(ErtsDSigSendContext *ctx, Eterm local, Eterm remote, Eterm reason) { - DeclareTmpHeapNoproc(ctl_heap,5); - int res; - Eterm ctl; + Eterm ctl, msg = ctx->dep->flags & DFLAG_EXIT_PAYLOAD ? reason : THE_NON_VALUE; - UseTmpHeapNoproc(5); - ctl = TUPLE4(&ctl_heap[0], - make_small(DOP_EXIT), local, remote, reason); - /* forced, i.e ignore busy */ - res = dsig_send_ctl(dsdp, ctl, 1); - UnUseTmpHeapNoproc(5); - return res; + if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) { + ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_PAYLOAD_EXIT), local, remote); + msg = reason; + } else { + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_EXIT), local, remote, reason); + msg = THE_NON_VALUE; + } + return dsig_send_exit(ctx, ctl, msg); } int -erts_dsig_send_exit2(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason) +erts_dsig_send_exit2(ErtsDSigSendContext *ctx, Eterm local, Eterm remote, Eterm reason) { - DeclareTmpHeapNoproc(ctl_heap,5); - int res; - Eterm ctl; + Eterm ctl, msg; - UseTmpHeapNoproc(5); - ctl = TUPLE4(&ctl_heap[0], - make_small(DOP_EXIT2), local, remote, reason); + if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) { + ctl = TUPLE3(&ctx->ctl_heap[0], + make_small(DOP_PAYLOAD_EXIT2), local, remote); + msg = reason; + } else { + ctl = TUPLE4(&ctx->ctl_heap[0], + make_small(DOP_EXIT2), local, remote, reason); + msg = THE_NON_VALUE; + } - res = dsig_send_ctl(dsdp, ctl, 0); - UnUseTmpHeapNoproc(5); - return res; + return dsig_send_exit(ctx, ctl, msg); } int -erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote) +erts_dsig_send_group_leader(ErtsDSigSendContext *ctx, Eterm leader, Eterm remote) { - DeclareTmpHeapNoproc(ctl_heap,4); - int res; Eterm ctl; - UseTmpHeapNoproc(4); - ctl = TUPLE3(&ctl_heap[0], + ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_GROUP_LEADER), leader, remote); - res = dsig_send_ctl(dsdp, ctl, 0); - UnUseTmpHeapNoproc(4); - return res; + return dsig_send_ctl(ctx, ctl); } -#if defined(PURIFY) -# define PURIFY_MSG(msg) \ - purify_printf("%s, line %d: %s", __FILE__, __LINE__, msg) -#elif defined(VALGRIND) -#include <valgrind/valgrind.h> -#include <valgrind/memcheck.h> +struct dist_sequences { + ErlHeapFragment hfrag; + struct dist_sequences *parent; + struct dist_sequences *left; + struct dist_sequences *right; + char is_red; -# define PURIFY_MSG(msg) \ - VALGRIND_PRINTF("%s, line %d: %s", __FILE__, __LINE__, msg) -#else -# define PURIFY_MSG(msg) -#endif + Uint64 seq_id; + int cnt; + Sint ctl_len; +}; + +#define ERTS_RBT_PREFIX dist_seq +#define ERTS_RBT_T DistSeqNode +#define ERTS_RBT_KEY_T Uint +#define ERTS_RBT_FLAGS_T int +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->parent = NULL; \ + (T)->left = NULL; \ + (T)->right = NULL; \ + (T)->is_red = 0; \ + } while(0) +#define ERTS_RBT_IS_RED(T) ((T)->is_red) +#define ERTS_RBT_SET_RED(T) ((T)->is_red = 1) +#define ERTS_RBT_IS_BLACK(T) (!ERTS_RBT_IS_RED(T)) +#define ERTS_RBT_SET_BLACK(T) ((T)->is_red = 0) +#define ERTS_RBT_GET_FLAGS(T) ((T)->is_red) +#define ERTS_RBT_SET_FLAGS(T, F) ((T)->is_red = F) +#define ERTS_RBT_GET_PARENT(T) ((T)->parent) +#define ERTS_RBT_SET_PARENT(T, P) ((T)->parent = P) +#define ERTS_RBT_GET_RIGHT(T) ((T)->right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->seq_id) +#define ERTS_RBT_IS_LT(KX, KY) (KX < KY) +#define ERTS_RBT_IS_EQ(KX, KY) (KX == KY) +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_LOOKUP_INSERT +#define ERTS_RBT_WANT_LOOKUP +#define ERTS_RBT_WANT_FOREACH +#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING + +#include "erl_rbtree.h" + +struct erts_dist_seq_tree_foreach_iter_arg { + int (*func)(ErtsDistExternal *, void *, Sint); + void *arg; +}; + +static int +erts_dist_seq_tree_foreach_iter(DistSeqNode *seq, void *arg, Sint reds) +{ + struct erts_dist_seq_tree_foreach_iter_arg *state = arg; + return state->func(erts_get_dist_ext(&seq->hfrag), state->arg, reds); +} + +void +erts_dist_seq_tree_foreach(DistEntry *dep, int (*func)(ErtsDistExternal *, void *, Sint), void *arg) +{ + struct erts_dist_seq_tree_foreach_iter_arg state; + state.func = func; + state.arg = arg; + dist_seq_rbt_foreach(dep->sequences, erts_dist_seq_tree_foreach_iter, &state); +} + +static int dist_seq_cleanup(DistSeqNode *seq, void *unused, Sint reds) +{ + erts_free_dist_ext_copy(erts_get_dist_ext(&seq->hfrag)); + free_message_buffer(&seq->hfrag); + return 1; +} + +typedef struct { + DistSeqNode *root; + dist_seq_rbt_yield_state_t rbt_ystate; +} DistSeqNodeYieldState; + +int +erts_dist_seq_tree_foreach_delete_yielding(DistSeqNode **root, + void **vyspp, + Sint limit) +{ + DistSeqNodeYieldState ys = {*root, ERTS_RBT_YIELD_STAT_INITER}; + DistSeqNodeYieldState *ysp; + int res; + + ysp = (DistSeqNodeYieldState *) *vyspp; + if (!ysp) { + *root = NULL; + ysp = &ys; + } + res = dist_seq_rbt_foreach_destroy_yielding(&ysp->root, + dist_seq_cleanup, + NULL, + &ysp->rbt_ystate, + limit); + if (res > 0) { + if (ysp != &ys) + erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp); + *vyspp = NULL; + } + else { + + if (ysp == &ys) { + ysp = erts_alloc(ERTS_ALC_T_SEQ_YIELD_STATE, + sizeof(DistSeqNodeYieldState)); + sys_memcpy((void *) ysp, (void *) &ys, + sizeof(DistSeqNodeYieldState)); + } + + *vyspp = (void *) ysp; + } + + return res; +} /* ** Input from distribution port. @@ -1210,10 +1448,13 @@ int erts_net_message(Port *prt, Uint32 conn_id, byte *hbuf, ErlDrvSizeT hlen, + Binary *bin, byte *buf, ErlDrvSizeT len) { - ErtsDistExternal ede; + ErtsDistExternal ede, *edep = &ede; + ErtsDistExternalData ede_data; + ErlHeapFragment *ede_hfrag = NULL; Sint ctl_len; Eterm arg; Eterm from, to; @@ -1225,10 +1466,8 @@ int erts_net_message(Port *prt, DeclareTmpHeapNoproc(ctl_default,DIST_CTL_DEFAULT_SIZE); Eterm* ctl = ctl_default; ErtsHeapFactory factory; - Eterm* hp; Sint type; Eterm token; - Eterm token_size; Uint tuple_arity; int res; #ifdef ERTS_DIST_MSG_DBG @@ -1254,69 +1493,182 @@ int erts_net_message(Port *prt, } #ifdef ERTS_RAW_DIST_MSG_DBG - erts_fprintf(stderr, "<< "); + erts_fprintf(dbg_file, "RECV: "); bw(buf, len); #endif - res = erts_prepare_dist_ext(&ede, buf, len, dep, conn_id, dep->cache); + ede.data = &ede_data; + + res = erts_prepare_dist_ext(&ede, buf, len, bin, dep, conn_id, dep->cache); switch (res) { case ERTS_PREP_DIST_EXT_CLOSED: return 0; /* Connection not alive; ignore signal... */ case ERTS_PREP_DIST_EXT_FAILED: #ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n"); + erts_fprintf(dbg_file, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n"); bw(buf, orig_len); #endif goto data_error; case ERTS_PREP_DIST_EXT_SUCCESS: - ctl_len = erts_decode_dist_ext_size(&ede); + ctl_len = erts_decode_dist_ext_size(&ede, 1); if (ctl_len < 0) { #ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n"); + erts_fprintf(dbg_file, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n"); bw(buf, orig_len); #endif PURIFY_MSG("data error"); goto data_error; } + + /* A non-fragmented message */ + if (!ede.data->seq_id) { + if (ctl_len > DIST_CTL_DEFAULT_SIZE) { + ctl = erts_alloc(ERTS_ALC_T_DCTRL_BUF, ctl_len * sizeof(Eterm)); + } + + erts_factory_tmp_init(&factory, ctl, ctl_len, ERTS_ALC_T_DCTRL_BUF); + break; + } else { + DistSeqNode *seq; + Uint sz = erts_dist_ext_size(&ede); + Uint used_sz = ctl_len * sizeof(Eterm); + + /* We calculate the size of the heap fragment to be allocated. + The used_size part has to be larger that the ctl data and the + DistSeqNode. */ + if (used_sz + (sizeof(ErlHeapFragment) - sizeof(Eterm)) < sizeof(DistSeqNode)) + used_sz = sizeof(DistSeqNode) - (sizeof(ErlHeapFragment) - sizeof(Eterm)); + + seq = (DistSeqNode *)new_message_buffer((sz + used_sz) / sizeof(Eterm)); + seq->hfrag.used_size = used_sz / sizeof(Eterm); + + seq->ctl_len = ctl_len; + seq->seq_id = ede.data->seq_id; + seq->cnt = ede.data->frag_id; + if (dist_seq_rbt_lookup_insert(&dep->sequences, seq) != NULL) { + free_message_buffer(&seq->hfrag); + goto data_error; + } + + erts_make_dist_ext_copy(&ede, erts_get_dist_ext(&seq->hfrag)); + + if (ede.data->frag_id > 1) { + seq->cnt--; + return 0; + } + } + + /* fall through, the first fragment in the sequence was the last fragment */ + case ERTS_PREP_DIST_EXT_FRAG_CONT: { + DistSeqNode *seq = dist_seq_rbt_lookup(dep->sequences, ede.data->seq_id); + + if (!seq) + goto data_error; + + /* If we did a fall-though we already did this */ + if (res == ERTS_PREP_DIST_EXT_FRAG_CONT) + erts_dist_ext_frag(&ede_data, erts_get_dist_ext(&seq->hfrag)); + + /* Verify that the fragments have arrived in the correct order */ + if (seq->cnt != ede.data->frag_id) + goto data_error; + + seq->cnt--; + + /* Check if this was the last fragment */ + if (ede.data->frag_id > 1) + return 0; + + /* Last fragment arrived, time to dispatch the signal */ + dist_seq_rbt_delete(&dep->sequences, seq); + ctl_len = seq->ctl_len; + + /* Now that we no longer need the DistSeqNode we re-use the heapfragment + to decode the ctl msg into. We don't need the ctl message to be in + the heapfragment, but we decode into the heapfragment speculatively + in case there is a trace token that we need. */ + erts_factory_heap_frag_init(&factory, &seq->hfrag); + edep = erts_get_dist_ext(&seq->hfrag); + ede_hfrag = &seq->hfrag; + + /* If the sequence consisted of more than 1 fragment we create one large + binary out of all of the fragments. This because erts_decode_ext + cannot handle a segmented buffer. + TODO: Move this copy to as late as possible, preferably in in the + erts_decode_dist_ext in the receiving process. + */ + if (edep->data->frag_id > 1) { + Uint sz = 0; + Binary *bin; + int i; + byte *ep; + + for (i = 0; i < edep->data->frag_id; i++) + sz += edep->data[i].ext_endp - edep->data[i].extp; + + bin = erts_bin_nrml_alloc(sz); + ep = (byte*)bin->orig_bytes; + + for (i = 0; i < edep->data->frag_id; i++) { + sys_memcpy(ep, edep->data[i].extp, edep->data[i].ext_endp - edep->data[i].extp); + ep += edep->data[i].ext_endp - edep->data[i].extp; + erts_bin_release(edep->data[i].binp); + edep->data[i].binp = NULL; + edep->data[i].extp = NULL; + edep->data[i].ext_endp = NULL; + } + + edep->data->frag_id = 1; + edep->data->extp = (byte*)bin->orig_bytes; + edep->data->ext_endp = ep; + edep->data->binp = bin; + } + break; + } default: ERTS_INTERNAL_ERROR("Unexpected result from erts_prepare_dist_ext()"); break; } - if (ctl_len > DIST_CTL_DEFAULT_SIZE) { - ctl = erts_alloc(ERTS_ALC_T_DCTRL_BUF, ctl_len * sizeof(Eterm)); - } - hp = ctl; - - erts_factory_tmp_init(&factory, ctl, ctl_len, ERTS_ALC_T_DCTRL_BUF); - arg = erts_decode_dist_ext(&factory, &ede); + arg = erts_decode_dist_ext(&factory, edep, 1); if (is_non_value(arg)) { #ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext(CTL) failed:\n"); + erts_fprintf(dbg_file, "DIST MSG DEBUG: erts_decode_dist_ext(CTL) failed:\n"); bw(buf, orig_len); #endif PURIFY_MSG("data error"); goto decode_error; } -#ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, "<< CTL: %T\n", arg); -#endif + /* Fill the unused part of the hfrag with a bignum header */ + if (ede_hfrag && ede_hfrag->mem + ede_hfrag->used_size > factory.hp) { + Uint slot = factory.hp - ede_hfrag->mem; + ede_hfrag->mem[slot] = make_pos_bignum_header(ede_hfrag->used_size - slot - 1); + } if (is_not_tuple(arg) || (tuple = tuple_val(arg), (tuple_arity = arityval(*tuple)) < 1) || is_not_small(tuple[1])) { +#ifdef ERTS_DIST_MSG_DBG + if (is_tuple(arg) && arityval(*tuple) > 1) + erts_fprintf(dbg_file, "RECV: CTL: %s: %.80T\n", + erts_dop_to_string(unsigned_val(tuple[1])), arg); +#endif goto invalid_message; } - token_size = 0; +#ifdef ERTS_DIST_MSG_DBG + erts_fprintf(dbg_file, "RECV: CTL: %s: %.80T\n", + erts_dop_to_string(unsigned_val(tuple[1])), arg); +#endif + token = NIL; switch (type = unsigned_val(tuple[1])) { case DOP_LINK: { - ErtsDSigData dsd; + ErtsDSigSendContext ctx; int code; if (tuple_arity != 3) { @@ -1354,9 +1706,9 @@ int erts_net_message(Port *prt, erts_link_release_both(ldp); } - code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0); + code = erts_dsig_prepare(&ctx, dep, NULL, 0, ERTS_DSP_NO_LOCK, 1, 1, 0); if (code == ERTS_DSIG_PREP_CONNECTED) { - code = erts_dsig_send_exit(&dsd, to, from, am_noproc); + code = erts_dsig_send_exit(&ctx, to, from, am_noproc); ASSERT(code == ERTS_DSIG_SEND_OK); } @@ -1389,7 +1741,7 @@ int erts_net_message(Port *prt, /* A remote process wants to monitor us, we get: {DOP_MONITOR_P, Remote pid, local pid or name, ref} */ Eterm pid, name; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; int code; if (tuple_arity != 4) { @@ -1444,10 +1796,9 @@ int erts_net_message(Port *prt, } - code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0); + code = erts_dsig_prepare(&ctx, dep, NULL, 0, ERTS_DSP_NO_LOCK, 1, 1, 0); if (code == ERTS_DSIG_PREP_CONNECTED) { - code = erts_dsig_send_m_exit(&dsd, watcher, watched, ref, - am_noproc); + code = erts_dsig_send_m_exit(&ctx, watcher, watched, ref, am_noproc); ASSERT(code == ERTS_DSIG_SEND_OK); } @@ -1506,7 +1857,6 @@ int erts_net_message(Port *prt, goto invalid_message; } - token_size = size_object(tuple[5]); /* Fall through ... */ case DOP_REG_SEND: /* {DOP_REG_SEND, From, Cookie, ToName} -- Message */ @@ -1521,7 +1871,7 @@ int erts_net_message(Port *prt, } #ifdef ERTS_DIST_MSG_DBG - dist_msg_dbg(&ede, "MSG", buf, orig_len); + dist_msg_dbg(edep, "MSG", buf, orig_len); #endif from = tuple[2]; @@ -1531,35 +1881,25 @@ int erts_net_message(Port *prt, } rp = erts_whereis_process(NULL, 0, to, 0, 0); if (rp) { - Uint xsize = (type == DOP_REG_SEND - ? 0 - : ERTS_HEAP_FRAG_SIZE(token_size)); ErtsProcLocks locks = 0; - ErtsDistExternal *ede_copy; - ede_copy = erts_make_dist_ext_copy(&ede, xsize); if (type == DOP_REG_SEND) { token = NIL; } else { - ErlHeapFragment *heap_frag; - ErlOffHeap *ohp; - ASSERT(xsize); - heap_frag = erts_dist_ext_trailer(ede_copy); - ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size); - hp = heap_frag->mem; - ohp = &heap_frag->off_heap; token = tuple[5]; - token = copy_struct(token, token_size, &hp, ohp); } - erts_queue_dist_message(rp, locks, ede_copy, token, from); + erts_queue_dist_message(rp, locks, edep, ede_hfrag, token, from); + if (locks) erts_proc_unlock(rp, locks); - } + } else if (ede_hfrag) { + erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag)); + free_message_buffer(ede_hfrag); + } break; case DOP_SEND_SENDER_TT: { - Uint xsize; case DOP_SEND_TT: if (tuple_arity != 4) { @@ -1567,15 +1907,12 @@ int erts_net_message(Port *prt, } token = tuple[4]; - token_size = size_object(token); - xsize = ERTS_HEAP_FRAG_SIZE(token_size); goto send_common; case DOP_SEND_SENDER: case DOP_SEND: token = NIL; - xsize = 0; if (tuple_arity != 3) goto invalid_message; @@ -1591,7 +1928,7 @@ int erts_net_message(Port *prt, : tuple[2] == am_Empty); #ifdef ERTS_DIST_MSG_DBG - dist_msg_dbg(&ede, "MSG", buf, orig_len); + dist_msg_dbg(edep, "MSG", buf, orig_len); #endif to = tuple[3]; if (is_not_pid(to)) { @@ -1600,39 +1937,38 @@ int erts_net_message(Port *prt, rp = erts_proc_lookup(to); if (rp) { ErtsProcLocks locks = 0; - ErtsDistExternal *ede_copy; - - ede_copy = erts_make_dist_ext_copy(&ede, xsize); - if (is_not_nil(token)) { - ErlHeapFragment *heap_frag; - ErlOffHeap *ohp; - ASSERT(xsize); - heap_frag = erts_dist_ext_trailer(ede_copy); - ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size); - hp = heap_frag->mem; - ohp = &heap_frag->off_heap; - token = copy_struct(token, token_size, &hp, ohp); - } - erts_queue_dist_message(rp, locks, ede_copy, token, am_Empty); + erts_queue_dist_message(rp, locks, edep, ede_hfrag, token, am_Empty); if (locks) erts_proc_unlock(rp, locks); - } + } else if (ede_hfrag) { + erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag)); + free_message_buffer(ede_hfrag); + } break; } + case DOP_PAYLOAD_MONITOR_P_EXIT: case DOP_MONITOR_P_EXIT: { + /* We are monitoring a process on the remote node which dies, we get {DOP_MONITOR_P_EXIT, Remote pid or name, Local pid, ref, reason} */ - - if (tuple_arity != 5) { - goto invalid_message; - } - watched = tuple[2]; /* remote proc or name which died */ - watcher = tuple[3]; + watched = tuple[2]; /* remote proc or name which died */ + watcher = tuple[3]; ref = tuple[4]; - reason = tuple[5]; + + if (type == DOP_PAYLOAD_MONITOR_P_EXIT) { + if (tuple_arity != 4) { + goto invalid_message; + } + reason = THE_NON_VALUE; + } else { + if (tuple_arity != 5) { + goto invalid_message; + } + reason = tuple[5]; + } if (is_not_ref(ref)) goto invalid_message; @@ -1648,70 +1984,125 @@ int erts_net_message(Port *prt, goto invalid_message; } - erts_proc_sig_send_dist_monitor_down(dep, ref, watched, - watcher, reason); + if (!erts_proc_lookup(watcher)) break; /* Process not alive */ + + if (reason == THE_NON_VALUE) { + +#ifdef ERTS_DIST_MSG_DBG + dist_msg_dbg(edep, "MSG", buf, orig_len); +#endif + + } + + erts_proc_sig_send_dist_monitor_down( + dep, ref, watched, watcher, edep, ede_hfrag, reason); break; } + case DOP_PAYLOAD_EXIT: + case DOP_PAYLOAD_EXIT_TT: case DOP_EXIT_TT: case DOP_EXIT: { + /* 'from', which 'to' is linked to, died */ + from = tuple[2]; + to = tuple[3]; + if (type == DOP_EXIT) { if (tuple_arity != 4) { goto invalid_message; } - - from = tuple[2]; - to = tuple[3]; - reason = tuple[4]; token = NIL; - } else { + reason = tuple[4]; + } else if (type == DOP_EXIT_TT){ if (tuple_arity != 5) { goto invalid_message; } - from = tuple[2]; - to = tuple[3]; token = tuple[4]; reason = tuple[5]; - } + } else if (type == DOP_PAYLOAD_EXIT) { + if (tuple_arity != 3) { + goto invalid_message; + } + token = NIL; + reason = THE_NON_VALUE; + } else { + if (tuple_arity != 4) { + goto invalid_message; + } + token = tuple[4]; + reason = THE_NON_VALUE; + } if (is_not_external_pid(from) || dep != external_pid_dist_entry(from) || is_not_internal_pid(to)) { goto invalid_message; } + if (!erts_proc_lookup(to)) break; /* Process not alive */ + + if (reason == THE_NON_VALUE) { +#ifdef ERTS_DIST_MSG_DBG + dist_msg_dbg(edep, "MSG", buf, orig_len); +#endif + } + erts_proc_sig_send_dist_link_exit(dep, - from, to, + from, to, edep, ede_hfrag, reason, token); break; } + case DOP_PAYLOAD_EXIT2_TT: + case DOP_PAYLOAD_EXIT2: case DOP_EXIT2_TT: - case DOP_EXIT2: + case DOP_EXIT2: { + /* 'from' is send an exit signal to 'to' */ + from = tuple[2]; + to = tuple[3]; + if (type == DOP_EXIT2) { if (tuple_arity != 4) { goto invalid_message; } - from = tuple[2]; - to = tuple[3]; reason = tuple[4]; token = NIL; - } else { + } else if (type == DOP_EXIT2_TT) { if (tuple_arity != 5) { goto invalid_message; } - from = tuple[2]; - to = tuple[3]; token = tuple[4]; reason = tuple[5]; - } - if (is_not_pid(from) || is_not_internal_pid(to)) { + } else if (type == DOP_PAYLOAD_EXIT2) { + if (tuple_arity != 3) { + goto invalid_message; + } + reason = THE_NON_VALUE; + token = NIL; + } else { + if (tuple_arity != 4) { + goto invalid_message; + } + reason = THE_NON_VALUE; + token = tuple[4]; + } + if (is_not_pid(from) + || dep != external_pid_dist_entry(from) + || is_not_internal_pid(to)) { goto invalid_message; } - erts_proc_sig_send_exit(NULL, from, to, reason, token, 0); - break; + if (!erts_proc_lookup(to)) break; /* Process not alive */ + if (reason == THE_NON_VALUE) { +#ifdef ERTS_DIST_MSG_DBG + dist_msg_dbg(edep, "MSG", buf, orig_len); +#endif + } + + erts_proc_sig_send_dist_exit(dep, from, to, edep, ede_hfrag, reason, token); + break; + } case DOP_GROUP_LEADER: if (tuple_arity != 3) { goto invalid_message; @@ -1725,13 +2116,15 @@ int erts_net_message(Port *prt, (void) erts_proc_sig_send_group_leader(NULL, to, from, NIL); break; - default: + default: goto invalid_message; } - erts_factory_close(&factory); - if (ctl != ctl_default) { - erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl); + if (ede_hfrag == NULL) { + erts_factory_close(&factory); + if (ctl != ctl_default) { + erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl); + } } UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); ERTS_CHK_NO_PROC_LOCKS; @@ -1744,9 +2137,14 @@ int erts_net_message(Port *prt, } decode_error: PURIFY_MSG("data error"); - erts_factory_close(&factory); - if (ctl != ctl_default) { - erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl); + if (ede_hfrag == NULL) { + erts_factory_close(&factory); + if (ctl != ctl_default) { + erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl); + } + } else { + erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag)); + free_message_buffer(ede_hfrag); } data_error: UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); @@ -1755,18 +2153,21 @@ data_error: return -1; } -static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy) +static int dsig_send_exit(ErtsDSigSendContext *ctx, Eterm ctl, Eterm msg) +{ + ctx->ctl = ctl; + ctx->msg = msg; + return erts_dsig_send(ctx); +} + +static int dsig_send_ctl(ErtsDSigSendContext *ctx, Eterm ctl) { - struct erts_dsig_send_context ctx; int ret; - ctx.ctl = ctl; - ctx.msg = THE_NON_VALUE; - ctx.force_busy = force_busy; - ctx.phase = ERTS_DSIG_SEND_PHASE_INIT; -#ifdef DEBUG - ctx.reds = 1; /* provoke assert below (no reduction count without msg) */ -#endif - ret = erts_dsig_send(dsdp, &ctx); + ctx->ctl = ctl; + ctx->msg = THE_NON_VALUE; + ctx->from = THE_NON_VALUE; + ctx->reds = 1; /* provoke assert below (no reduction count without msg) */ + ret = erts_dsig_send(ctx); ASSERT(ret != ERTS_DSIG_SEND_CONTINUE); return ret; } @@ -1797,7 +2198,117 @@ notify_dist_data(Process *c_p, Eterm pid) } int -erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) +erts_dsig_prepare(ErtsDSigSendContext *ctx, + DistEntry *dep, + Process *proc, + ErtsProcLocks proc_locks, + ErtsDSigPrepLock dspl, + int no_suspend, + int no_trap, + int connect) +{ + int res; + + if (!erts_is_alive) + return ERTS_DSIG_PREP_NOT_ALIVE; + if (!dep) { + ASSERT(!connect); + return ERTS_DSIG_PREP_NOT_CONNECTED; + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (connect) { + erts_proc_lc_might_unlock(proc, proc_locks); + } +#endif + +retry: + erts_de_rlock(dep); + + if (dep->state == ERTS_DE_STATE_CONNECTED) { + res = ERTS_DSIG_PREP_CONNECTED; + } + else if (dep->state == ERTS_DE_STATE_PENDING) { + res = ERTS_DSIG_PREP_PENDING; + } + else if (dep->state == ERTS_DE_STATE_EXITING) { + res = ERTS_DSIG_PREP_NOT_CONNECTED; + goto fail; + } + else if (connect) { + ASSERT(dep->state == ERTS_DE_STATE_IDLE); + erts_de_runlock(dep); + if (!erts_auto_connect(dep, proc, proc_locks)) { + return ERTS_DSIG_PREP_NOT_ALIVE; + } + goto retry; + } + else { + ASSERT(dep->state == ERTS_DE_STATE_IDLE); + res = ERTS_DSIG_PREP_NOT_CONNECTED; + goto fail; + } + + if (no_suspend) { + if (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY) { + res = ERTS_DSIG_PREP_WOULD_SUSPEND; + goto fail; + } + } + + ctx->c_p = proc; + ctx->dep = dep; + ctx->deref_dep = 0; + ctx->cid = dep->cid; + ctx->connection_id = dep->connection_id; + ctx->no_suspend = no_suspend; + ctx->no_trap = no_trap; + ctx->flags = dep->flags; + ctx->return_term = am_true; + ctx->phase = ERTS_DSIG_SEND_PHASE_INIT; + ctx->from = proc ? proc->common.id : am_undefined; + ctx->reds = no_trap ? 1 : (Sint) (ERTS_BIF_REDS_LEFT(proc) * TERM_TO_BINARY_LOOP_FACTOR); + if (dspl == ERTS_DSP_NO_LOCK) + erts_de_runlock(dep); + return res; + + fail: + erts_de_runlock(dep); + return res; +} + +static +void erts_schedule_dist_command(Port *prt, DistEntry *dist_entry) +{ + DistEntry *dep; + Eterm id; + + if (prt) { + ERTS_LC_ASSERT(erts_lc_is_port_locked(prt)); + ASSERT((erts_atomic32_read_nob(&prt->state) + & ERTS_PORT_SFLGS_DEAD) == 0); + + dep = (DistEntry*) erts_prtsd_get(prt, ERTS_PRTSD_DIST_ENTRY); + ASSERT(dep); + id = prt->common.id; + } + else { + ASSERT(dist_entry); + ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&dist_entry->rwmtx) + || erts_lc_rwmtx_is_rwlocked(&dist_entry->rwmtx)); + ASSERT(is_internal_port(dist_entry->cid)); + + dep = dist_entry; + id = dep->cid; + } + + if (!erts_atomic_xchg_mb(&dep->dist_cmd_scheduled, 1)) + erts_port_task_schedule(id, &dep->dist_cmd, ERTS_PORT_TASK_DIST_CMD); +} + + +int +erts_dsig_send(ErtsDSigSendContext *ctx) { int retval; Sint initial_reds = ctx->reds; @@ -1806,11 +2317,13 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) while (1) { switch (ctx->phase) { case ERTS_DSIG_SEND_PHASE_INIT: - ctx->flags = dsdp->flags; - ctx->c_p = dsdp->proc; + ctx->flags = ctx->flags; + ctx->c_p = ctx->c_p; - if (!ctx->c_p || dsdp->no_suspend) - ctx->force_busy = 1; + if (!ctx->c_p) { + ctx->no_trap = 1; + ctx->no_suspend = 1; + } ERTS_LC_ASSERT(!ctx->c_p || (ERTS_PROC_LOCK_MAIN @@ -1829,9 +2342,11 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) } #ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, ">> CTL: %T\n", ctx->ctl); + erts_fprintf(dbg_file, "SEND: CTL: %s: %.80T\n", + erts_dop_to_string(unsigned_val(tuple_val(ctx->ctl)[1])), + ctx->ctl); if (is_value(ctx->msg)) - erts_fprintf(stderr, " MSG: %T\n", ctx->msg); + erts_fprintf(dbg_file, " MSG: %.160T\n", ctx->msg); #endif ctx->data_size = ctx->max_finalize_prepend; @@ -1848,25 +2363,45 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE; case ERTS_DSIG_SEND_PHASE_MSG_SIZE: - if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) { - retval = ERTS_DSIG_SEND_CONTINUE; - goto done; - } + if (!ctx->no_trap) { + if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) { + retval = ERTS_DSIG_SEND_CONTINUE; + goto done; + } + } else { + erts_encode_dist_ext_size(ctx->msg, ctx->flags, ctx->acmp, &ctx->data_size); + } ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; case ERTS_DSIG_SEND_PHASE_ALLOC: erts_finalize_atom_cache_map(ctx->acmp, ctx->flags); - ctx->dhdr_ext_size = erts_encode_ext_dist_header_size(ctx->acmp); - ctx->data_size += ctx->dhdr_ext_size; + if (ctx->flags & DFLAG_FRAGMENTS && is_value(ctx->msg) && is_not_immed(ctx->msg)) { + /* Calculate the max number of fragments that are needed */ + ASSERT(is_pid(ctx->from) && + "from has to be a pid because it is used as sequence id"); + ctx->fragments = ctx->data_size / ERTS_DIST_FRAGMENT_SIZE + 1; + } else + ctx->fragments = 1; + + ctx->dhdr_ext_size = erts_encode_ext_dist_header_size(ctx->acmp, ctx->fragments); - ctx->obuf = alloc_dist_obuf(ctx->data_size); - ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->max_finalize_prepend + ctx->dhdr_ext_size; + ctx->obuf = alloc_dist_obuf( + ctx->dhdr_ext_size + ctx->data_size + + (ctx->fragments-1) * ERTS_DIST_FRAGMENT_HEADER_SIZE, + ctx->fragments); + ctx->obuf->ext_start = &ctx->obuf->extp[0]; + ctx->obuf->ext_endp = &ctx->obuf->extp[0] + ctx->max_finalize_prepend + ctx->dhdr_ext_size; /* Encode internal version of dist header */ - ctx->obuf->extp = erts_encode_ext_dist_header_setup(ctx->obuf->ext_endp, ctx->acmp); + ctx->obuf->extp = erts_encode_ext_dist_header_setup( + ctx->obuf->ext_endp, ctx->acmp, ctx->fragments, ctx->from); /* Encode control message */ erts_encode_dist_ext(ctx->ctl, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, NULL, NULL); + + ctx->obuf->hdrp = NULL; + ctx->obuf->hdr_endp = NULL; + if (is_non_value(ctx->msg)) { ctx->obuf->msg_start = NULL; ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; @@ -1880,50 +2415,137 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE; case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: - if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, &ctx->u.ec, &ctx->reds)) { - retval = ERTS_DSIG_SEND_CONTINUE; - goto done; - } + if (!ctx->no_trap) { + if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, + ctx->acmp, &ctx->u.ec, &ctx->reds)) { + retval = ERTS_DSIG_SEND_CONTINUE; + goto done; + } + } else { + erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, + ctx->acmp, NULL, NULL); + } - ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; + ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; case ERTS_DSIG_SEND_PHASE_FIN: { - DistEntry *dep = dsdp->dep; - int suspended = 0; - int resume = 0; ASSERT(ctx->obuf->extp < ctx->obuf->ext_endp); - ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->max_finalize_prepend); - ASSERT(ctx->obuf->ext_endp <= &ctx->obuf->data[0] + ctx->data_size); + ASSERT(((byte*)&ctx->obuf->bin->orig_bytes[0]+obuf_list_size) <= ctx->obuf->extp - ctx->max_finalize_prepend); + ASSERT(ctx->obuf->ext_endp <= ((byte*)ctx->obuf->bin->orig_bytes+obuf_list_size) + ctx->data_size + ctx->dhdr_ext_size); ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp; - if (ctx->data_size > (Uint) INT_MAX) { - free_dist_obuf(ctx->obuf); - ctx->obuf = NULL; - retval = ERTS_DSIG_SEND_TOO_LRG; - goto done; - } ctx->obuf->hopefull_flags = ctx->u.ec.hopefull_flags; - /* + + if (ctx->fragments > 1) { + int fin_fragments; + int i; + byte *msg = ctx->obuf->msg_start, + *msg_end = ctx->obuf->ext_endp, + *hdrp = msg_end; + + ASSERT((ctx->obuf->hopefull_flags & ctx->flags) == ctx->obuf->hopefull_flags); + ASSERT(get_int64(ctx->obuf->extp + 1 + 1 + 8) == ctx->fragments); + + /* Now that encoding is done we know how large the term will + be so we adjust the number of fragments to send. Note that + this can mean that only 1 fragment is sent. */ + fin_fragments = (ctx->obuf->ext_endp - ctx->obuf->msg_start + ERTS_DIST_FRAGMENT_SIZE-1) / + ERTS_DIST_FRAGMENT_SIZE - 1; + + /* Update the frag_id in the DIST_FRAG_HEADER */ + put_int64(fin_fragments+1, ctx->obuf->extp + 1 + 1 + 8); + + if (fin_fragments > 0) + msg += ERTS_DIST_FRAGMENT_SIZE; + else + msg = msg_end; + ctx->obuf->next = &ctx->obuf[1]; + ctx->obuf->ext_endp = msg; + + /* Loop through all fragments, updating the output buffers + to be correct and also writing the DIST_FRAG_CONT header. */ + for (i = 1; i < fin_fragments + 1; i++) { + ctx->obuf[i].hopefull_flags = 0; + ctx->obuf[i].extp = msg; + ctx->obuf[i].ext_start = msg; + if (msg + ERTS_DIST_FRAGMENT_SIZE > msg_end) + ctx->obuf[i].ext_endp = msg_end; + else { + msg += ERTS_DIST_FRAGMENT_SIZE; + ctx->obuf[i].ext_endp = msg; + } + ASSERT(ctx->obuf[i].ext_endp > ctx->obuf[i].extp); + ctx->obuf[i].hdrp = erts_encode_ext_dist_header_fragment( + &hdrp, fin_fragments - i + 1, ctx->from); + ctx->obuf[i].hdr_endp = hdrp; + ctx->obuf[i].next = &ctx->obuf[i+1]; + } + /* If the initial fragment calculation was incorrect we free the + remaining output buffers. */ + for (; i < ctx->fragments; i++) { + free_dist_obuf(&ctx->obuf[i]); + } + if (!ctx->no_trap && !ctx->no_suspend) + ctx->reds -= ctx->fragments; + ctx->fragments = fin_fragments + 1; + } + + ctx->phase = ERTS_DSIG_SEND_PHASE_SEND; + + if (ctx->reds <= 0) { + retval = ERTS_DSIG_SEND_CONTINUE; + goto done; + } + } + case ERTS_DSIG_SEND_PHASE_SEND: { + /* * Signal encoded; now verify that the connection still exists, * and if so enqueue the signal and schedule it for send. */ - ctx->obuf->next = NULL; + DistEntry *dep = ctx->dep; + int suspended = 0; + int resume = 0; + int i; erts_de_rlock(dep); cid = dep->cid; if (dep->state == ERTS_DE_STATE_EXITING || dep->state == ERTS_DE_STATE_IDLE - || dep->connection_id != dsdp->connection_id) { + || dep->connection_id != ctx->connection_id) { /* Not the same connection as when we started; drop message... */ erts_de_runlock(dep); - free_dist_obuf(ctx->obuf); + for (i = 0; i < ctx->fragments; i++) + free_dist_obuf(&ctx->obuf[i]); + ctx->fragments = 0; } else { - Sint qsize; + Sint qsize = erts_atomic_read_nob(&dep->qsize); erts_aint32_t qflgs; ErtsProcList *plp = NULL; Eterm notify_proc = NIL; - Sint obsz = size_obuf(ctx->obuf); + Sint obsz; + int fragments; + + /* Calculate how many fragments to send. This depends on + the available space in the distr queue and the amount + of remaining reductions. */ + for (fragments = 0, obsz = 0; + fragments < ctx->fragments && + ((ctx->reds > 0 && (qsize + obsz) < erts_dist_buf_busy_limit) || + ctx->no_trap || ctx->no_suspend); + fragments++) { +#ifdef DEBUG + int reds = 100; +#else + int reds = 10; +#endif + if (!ctx->no_trap && !ctx->no_suspend) + ctx->reds -= reds; + obsz += size_obuf(&ctx->obuf[fragments]); + } + + ASSERT(fragments == ctx->fragments || + (!ctx->no_trap && !ctx->no_suspend)); erts_mtx_lock(&dep->qlock); qsize = erts_atomic_add_read_nob(&dep->qsize, (erts_aint_t) obsz); @@ -1944,7 +2566,7 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) /* else: requester will send itself the message... */ qflgs &= ~ERTS_DE_QFLG_REQ_INFO; } - if (!ctx->force_busy && (qflgs & ERTS_DE_QFLG_BUSY)) { + if (!ctx->no_suspend && (qflgs & ERTS_DE_QFLG_BUSY)) { erts_mtx_unlock(&dep->qlock); plp = erts_proclist_create(ctx->c_p); @@ -1953,14 +2575,27 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) erts_mtx_lock(&dep->qlock); } - /* Enqueue obuf on dist entry */ - if (dep->out_queue.last) - dep->out_queue.last->next = ctx->obuf; - else - dep->out_queue.first = ctx->obuf; - dep->out_queue.last = ctx->obuf; + if (fragments > 1) { + if (!ctx->obuf->hdrp) { + ASSERT(get_int64(ctx->obuf->extp + 10) == ctx->fragments); + } else { + ASSERT(get_int64(ctx->obuf->hdrp + 10) == ctx->fragments); + } + } + + if (fragments) { + ctx->obuf[fragments-1].next = NULL; + if (dep->out_queue.last) + dep->out_queue.last->next = ctx->obuf; + else + dep->out_queue.first = ctx->obuf; + dep->out_queue.last = &ctx->obuf[fragments-1]; - if (!ctx->force_busy) { + ctx->fragments -= fragments; + ctx->obuf = &ctx->obuf[fragments]; + } + + if (!ctx->no_suspend) { qflgs = erts_atomic32_read_nob(&dep->qflgs); if (!(qflgs & ERTS_DE_QFLG_BUSY)) { if (suspended) @@ -2007,6 +2642,13 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) * erroneously scheduled when it shouldn't be. */ } + /* More fragments left to be sent, yield and re-schedule */ + if (ctx->fragments) { + retval = ERTS_DSIG_SEND_CONTINUE; + if (!resume && erts_system_monitor_flags.busy_dist_port) + monitor_generic(ctx->c_p, am_busy_dist_port, cid); + goto done; + } } ctx->obuf = NULL; @@ -2091,9 +2733,9 @@ static Uint dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) { int fpe_was_unmasked; - ErlDrvSizeT size; - SysIOVec iov[2]; - ErlDrvBinary* bv[2]; + ErlDrvSizeT size = 0; + SysIOVec iov[3]; + ErlDrvBinary* bv[3]; ErlIOVec eiov; ERTS_CHK_NO_PROC_LOCKS; @@ -2108,12 +2750,31 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) eiov.vsize = 1; } else { - size = obuf->ext_endp - obuf->extp; + int i = 1; eiov.vsize = 2; - iov[1].iov_base = obuf->extp; - iov[1].iov_len = size; - bv[1] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf)); + if (obuf->hdrp) { + eiov.vsize = 3; + iov[i].iov_base = obuf->hdrp; + iov[i].iov_len = obuf->hdr_endp - obuf->hdrp; + size += iov[i].iov_len; + bv[i] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf)); +#ifdef ERTS_RAW_DIST_MSG_DBG + erts_fprintf(dbg_file, "SEND: "); + bw(iov[i].iov_base, iov[i].iov_len); +#endif + i++; + + } + + iov[i].iov_base = obuf->extp; + iov[i].iov_len = obuf->ext_endp - obuf->extp; +#ifdef ERTS_RAW_DIST_MSG_DBG + erts_fprintf(dbg_file, "SEND: "); + bw(iov[i].iov_base, iov[i].iov_len); +#endif + size += iov[i].iov_len; + bv[i] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf)); } eiov.size = size; @@ -2220,6 +2881,23 @@ erts_dist_command(Port *prt, int initial_reds) dep->finalized_out_queue.first = NULL; dep->finalized_out_queue.last = NULL; +#ifdef DEBUG + { + Uint sz = 0; + ErtsDistOutputBuf *curr = oq.first; + while (curr) { + sz += size_obuf(curr); + curr = curr->next; + } + curr = foq.first; + while (curr) { + sz += size_obuf(curr); + curr = curr->next; + } + ASSERT(sz <= erts_atomic_read_nob(&dep->qsize)); + } +#endif + sched_flags = erts_atomic32_read_nob(&prt->sched.flags); if (reds < 0) @@ -2233,10 +2911,6 @@ erts_dist_command(Port *prt, int initial_reds) size = (*send)(prt, foq.first); erts_atomic64_inc_nob(&dep->out); esdp->io.out += (Uint64) size; -#ifdef ERTS_RAW_DIST_MSG_DBG - erts_fprintf(stderr, ">> "); - bw(foq.first->extp, size); -#endif reds -= ERTS_PORT_REDS_DIST_CMD_DATA(size); fob = foq.first; obufsize += size_obuf(fob); @@ -2305,15 +2979,11 @@ erts_dist_command(Port *prt, int initial_reds) preempt = 1; break; } - ASSERT(&oq.first->data[0] <= oq.first->extp - && oq.first->extp <= oq.first->ext_endp); + ASSERT(oq.first->bin->orig_bytes <= (char*)oq.first->extp + && oq.first->extp <= oq.first->ext_endp); size = (*send)(prt, oq.first); erts_atomic64_inc_nob(&dep->out); esdp->io.out += (Uint64) size; -#ifdef ERTS_RAW_DIST_MSG_DBG - erts_fprintf(stderr, ">> "); - bw(oq.first->extp, size); -#endif reds -= ERTS_PORT_REDS_DIST_CMD_DATA(size); fob = oq.first; obufsize += size_obuf(fob); @@ -2450,100 +3120,6 @@ erts_dist_command(Port *prt, int initial_reds) goto done; } -#if 0 - -int -dist_data_finalize(Process *c_p, int reds_limit) -{ - int reds = 5; - DistEntry *dep = ; - ErtsDistOutputQueue oq, foq; - ErtsDistOutputBuf *ob; - int preempt; - - - erts_mtx_lock(&dep->qlock); - flags = dep->flags; - oq.first = dep->out_queue.first; - oq.last = dep->out_queue.last; - dep->out_queue.first = NULL; - dep->out_queue.last = NULL; - erts_mtx_unlock(&dep->qlock); - - if (!oq.first) { - ASSERT(!oq.last); - oq.first = dep->tmp_out_queue.first; - oq.last = dep->tmp_out_queue.last; - } - else { - ErtsDistOutputBuf *f, *l; - ASSERT(oq.last); - if (dep->tmp_out_queue.last) { - dep->tmp_out_queue.last->next = oq.first; - oq.first = dep->tmp_out_queue.first; - } - } - - if (!oq.first) { - /* Nothing to do... */ - ASSERT(!oq.last); - return reds; - } - - foq.first = dep->finalized_out_queue.first; - foq.last = dep->finalized_out_queue.last; - - preempt = 0; - ob = oq.first; - ASSERT(ob); - - do { - ob->extp = erts_encode_ext_dist_header_finalize(ob->extp, - dep->cache, - flags); - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) - *--ob->extp = PASS_THROUGH; /* Old node; 'pass through' - needed */ - ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp); - reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; - preempt = reds > reds_limit; - if (preempt) - break; - ob = ob->next; - } while (ob); - /* - * At least one buffer was finalized; if we got preempted, - * ob points to the last buffer that we finalized. - */ - if (foq.last) - foq.last->next = oq.first; - else - foq.first = oq.first; - if (!preempt) { - /* All buffers finalized */ - foq.last = oq.last; - oq.first = oq.last = NULL; - } - else { - /* Not all buffers finalized; split oq. */ - foq.last = ob; - oq.first = ob->next; - if (oq.first) - ob->next = NULL; - else - oq.last = NULL; - } - - dep->finalized_out_queue.first = foq.first; - dep->finalized_out_queue.last = foq.last; - dep->tmp_out_queue.first = oq.first; - dep->tmp_out_queue.last = oq.last; - - return reds; -} - -#endif - BIF_RETTYPE dist_ctrl_get_data_notification_1(BIF_ALIST_1) { @@ -2612,6 +3188,7 @@ dist_ctrl_put_data_2(BIF_ALIST_2) ErlDrvSizeT size; Eterm input_handler; Uint32 conn_id; + Binary *bin = NULL; if (is_binary(BIF_ARG_2)) size = binary_size(BIF_ARG_2); @@ -2637,13 +3214,27 @@ dist_ctrl_put_data_2(BIF_ALIST_2) if (size != 0) { byte *data, *temp_alloc = NULL; - data = (byte *) erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc); + if (binary_bitoffset(BIF_ARG_2)) + data = (byte *) erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc); + else { + Eterm real_bin; + ProcBin *proc_bin; + Uint offset, bitoffs, bitsize; + + ERTS_GET_REAL_BIN(BIF_ARG_2, real_bin, offset, bitoffs, bitsize); + ASSERT(bitoffs == 0); + data = binary_bytes(real_bin) + offset; + proc_bin = (ProcBin *)binary_val(real_bin); + if (proc_bin->thing_word == HEADER_PROC_BIN) + bin = proc_bin->val; + } + if (!data) BIF_ERROR(BIF_P, BADARG); erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - (void) erts_net_message(NULL, dep, conn_id, NULL, 0, data, size); + (void) erts_net_message(NULL, dep, conn_id, NULL, 0, bin, data, size); /* * We ignore any decode failures. On fatal failures the * connection will be taken down by killing the @@ -2877,6 +3468,10 @@ static void kill_connection(DistEntry *dep) void erts_kill_dist_connection(DistEntry *dep, Uint32 conn_id) { +#ifdef ERTS_DIST_MSG_DBG + erts_fprintf(dbg_file, "INTR: kill dist conn to %T:%u\n", + dep->sysname, conn_id); +#endif erts_de_rwlock(dep); if (conn_id == dep->connection_id && dep->state == ERTS_DE_STATE_CONNECTED) { @@ -2891,7 +3486,7 @@ struct print_to_data { void *arg; }; -static void doit_print_monitor_info(ErtsMonitor *mon, void *vptdp) +static int doit_print_monitor_info(ErtsMonitor *mon, void *vptdp, Sint reds) { fmtfn_t to = ((struct print_to_data *) vptdp)->to; void *arg = ((struct print_to_data *) vptdp)->arg; @@ -2914,6 +3509,7 @@ static void doit_print_monitor_info(ErtsMonitor *mon, void *vptdp) else erts_print(to, arg, "%T\n", mdep->md.origin.other.item); } + return 1; } static void print_monitor_info(fmtfn_t to, void *arg, DistEntry *dep) @@ -2929,12 +3525,13 @@ static void print_monitor_info(fmtfn_t to, void *arg, DistEntry *dep) } } -static void doit_print_link_info(ErtsLink *lnk, void *vptdp) +static int doit_print_link_info(ErtsLink *lnk, void *vptdp, Sint reds) { struct print_to_data *ptdp = vptdp; ErtsLink *lnk2 = erts_link_to_other(lnk, NULL); erts_print(ptdp->to, ptdp->arg, "Remote link: %T %T\n", lnk2->other.item, lnk->other.item); + return 1; } static void print_link_info(fmtfn_t to, void *arg, DistEntry *dep) @@ -3536,8 +4133,9 @@ Sint erts_abort_connection_rwunlock(DistEntry* dep) erts_set_dist_entry_not_connected(dep); erts_de_rwunlock(dep); - schedule_con_monitor_link_cleanup(mld, THE_NON_VALUE, - THE_NON_VALUE, THE_NON_VALUE); + schedule_con_monitor_link_seq_cleanup( + mld, NULL, THE_NON_VALUE, + THE_NON_VALUE, THE_NON_VALUE); if (resume_procs) { int resumed = erts_resume_processes(resume_procs); @@ -3843,16 +4441,16 @@ monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options) } case am_true: { - ErtsDSigData dsd; - dsd.node = Node; + ErtsDSigSendContext ctx; + ctx.node = Node; dep = erts_find_or_insert_dist_entry(Node); if (dep == erts_this_dist_entry) break; - switch (erts_dsig_prepare(&dsd, dep, p, + switch (erts_dsig_prepare(&ctx, dep, p, ERTS_PROC_LOCK_MAIN, - ERTS_DSP_RLOCK, 0, async_connect)) { + ERTS_DSP_RLOCK, 0, 0, async_connect)) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: /* Trap to either send 'nodedown' or do passive connection attempt */ @@ -4009,6 +4607,10 @@ init_nodes_monitors(void) { erts_mtx_init(&nodes_monitors_mtx, "nodes_monitors", NIL, ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION); +#ifdef DEBUG + erts_mtx_init(&erts_obuf_list_mtx, "sad", NIL, + ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION); +#endif nodes_monitors = NULL; no_nodes_monitors = 0; } @@ -4150,8 +4752,8 @@ typedef struct { Uint i; } ErtsNodesMonitorContext; -static void -save_nodes_monitor(ErtsMonitor *mon, void *vctxt) +static int +save_nodes_monitor(ErtsMonitor *mon, void *vctxt, Sint reds) { ErtsNodesMonitorContext *ctxt = vctxt; ErtsMonitorData *mdp = erts_monitor_to_data(mon); @@ -4163,6 +4765,7 @@ save_nodes_monitor(ErtsMonitor *mon, void *vctxt) ctxt->nmdp[ctxt->i].options = mdp->origin.other.item; ctxt->i++; + return 1; } static void @@ -4295,8 +4898,8 @@ typedef struct { } ErtsNodesMonitorInfoContext; -static void -nodes_monitor_info(ErtsMonitor *mon, void *vctxt) +static int +nodes_monitor_info(ErtsMonitor *mon, void *vctxt, Sint reds) { ErtsMonitorDataExtended *mdep; ErtsNodesMonitorInfoContext *ctxt = vctxt; @@ -4343,6 +4946,7 @@ nodes_monitor_info(ErtsMonitor *mon, void *vctxt) ctxt->hpp = hpp; ctxt->szp = szp; ctxt->res = res; + return 1; } Eterm diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index 845fab229a..c4bb967592 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -47,6 +47,8 @@ #define DFLAG_SEND_SENDER 0x80000 #define DFLAG_BIG_SEQTRACE_LABELS 0x100000 #define DFLAG_NO_MAGIC 0x200000 /* internal for pending connection */ +#define DFLAG_EXIT_PAYLOAD 0x400000 +#define DFLAG_FRAGMENTS 0x800000 /* Mandatory flags for distribution */ #define DFLAG_DIST_MANDATORY (DFLAG_EXTENDED_REFERENCES \ @@ -75,7 +77,9 @@ | DFLAG_MAP_TAG \ | DFLAG_BIG_CREATION \ | DFLAG_SEND_SENDER \ - | DFLAG_BIG_SEQTRACE_LABELS) + | DFLAG_BIG_SEQTRACE_LABELS \ + | DFLAG_EXIT_PAYLOAD \ + | DFLAG_FRAGMENTS) /* Flags addable by local distr implementations */ #define DFLAG_DIST_ADDABLE DFLAG_DIST_DEFAULT @@ -99,26 +103,35 @@ | DFLAG_BIG_CREATION) /* opcodes used in distribution messages */ -#define DOP_LINK 1 -#define DOP_SEND 2 -#define DOP_EXIT 3 -#define DOP_UNLINK 4 +enum dop { + DOP_LINK = 1, + DOP_SEND = 2, + DOP_EXIT = 3, + DOP_UNLINK = 4, /* Ancient DOP_NODE_LINK (5) was here, can be reused */ -#define DOP_REG_SEND 6 -#define DOP_GROUP_LEADER 7 -#define DOP_EXIT2 8 - -#define DOP_SEND_TT 12 -#define DOP_EXIT_TT 13 -#define DOP_REG_SEND_TT 16 -#define DOP_EXIT2_TT 18 - -#define DOP_MONITOR_P 19 -#define DOP_DEMONITOR_P 20 -#define DOP_MONITOR_P_EXIT 21 - -#define DOP_SEND_SENDER 22 -#define DOP_SEND_SENDER_TT 23 + DOP_REG_SEND = 6, + DOP_GROUP_LEADER = 7, + DOP_EXIT2 = 8, + + DOP_SEND_TT = 12, + DOP_EXIT_TT = 13, + DOP_REG_SEND_TT = 16, + DOP_EXIT2_TT = 18, + + DOP_MONITOR_P = 19, + DOP_DEMONITOR_P = 20, + DOP_MONITOR_P_EXIT = 21, + + DOP_SEND_SENDER = 22, + DOP_SEND_SENDER_TT = 23, + + /* These are used when DFLAG_EXIT_PAYLOAD is detected */ + DOP_PAYLOAD_EXIT = 24, + DOP_PAYLOAD_EXIT_TT = 25, + DOP_PAYLOAD_EXIT2 = 26, + DOP_PAYLOAD_EXIT2_TT = 27, + DOP_PAYLOAD_MONITOR_P_EXIT = 28 +}; /* distribution trap functions */ extern Export* dmonitor_node_trap; @@ -129,15 +142,15 @@ typedef enum { } ErtsDSigPrepLock; -typedef struct { - Process *proc; - DistEntry *dep; - Eterm node; /* used if dep == NULL */ - Eterm cid; - Eterm connection_id; - int no_suspend; - Uint32 flags; -} ErtsDSigData; +/* Must be larger or equal to 16 */ +#ifdef DEBUG +#define ERTS_DIST_FRAGMENT_SIZE 16 +#else +/* This should be made configurable */ +#define ERTS_DIST_FRAGMENT_SIZE (64 * 1024) +#endif + +#define ERTS_DIST_FRAGMENT_HEADER_SIZE (1 + 1 + 8 + 8) /* magic, header, seq id, frag id*/ #define ERTS_DE_BUSY_LIMIT (1024*1024) extern int erts_dist_buf_busy_limit; @@ -159,124 +172,6 @@ extern int erts_is_alive; /* Pending connection; signals can be enqueued */ #define ERTS_DSIG_PREP_PENDING 4 -ERTS_GLB_INLINE int erts_dsig_prepare(ErtsDSigData *, - DistEntry*, - Process *, - ErtsProcLocks, - ErtsDSigPrepLock, - int, - int); - -ERTS_GLB_INLINE -void erts_schedule_dist_command(Port *, DistEntry *); - -int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE int -erts_dsig_prepare(ErtsDSigData *dsdp, - DistEntry *dep, - Process *proc, - ErtsProcLocks proc_locks, - ErtsDSigPrepLock dspl, - int no_suspend, - int connect) -{ - int res; - - if (!erts_is_alive) - return ERTS_DSIG_PREP_NOT_ALIVE; - if (!dep) { - ASSERT(!connect); - return ERTS_DSIG_PREP_NOT_CONNECTED; - } - -#ifdef ERTS_ENABLE_LOCK_CHECK - if (connect) { - erts_proc_lc_might_unlock(proc, proc_locks); - } -#endif - -retry: - erts_de_rlock(dep); - - if (dep->state == ERTS_DE_STATE_CONNECTED) { - res = ERTS_DSIG_PREP_CONNECTED; - } - else if (dep->state == ERTS_DE_STATE_PENDING) { - res = ERTS_DSIG_PREP_PENDING; - } - else if (dep->state == ERTS_DE_STATE_EXITING) { - res = ERTS_DSIG_PREP_NOT_CONNECTED; - goto fail; - } - else if (connect) { - ASSERT(dep->state == ERTS_DE_STATE_IDLE); - erts_de_runlock(dep); - if (!erts_auto_connect(dep, proc, proc_locks)) { - return ERTS_DSIG_PREP_NOT_ALIVE; - } - goto retry; - } - else { - ASSERT(dep->state == ERTS_DE_STATE_IDLE); - res = ERTS_DSIG_PREP_NOT_CONNECTED; - goto fail; - } - - if (no_suspend) { - if (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY) { - res = ERTS_DSIG_PREP_WOULD_SUSPEND; - goto fail; - } - } - dsdp->proc = proc; - dsdp->dep = dep; - dsdp->cid = dep->cid; - dsdp->connection_id = dep->connection_id; - dsdp->no_suspend = no_suspend; - dsdp->flags = dep->flags; - if (dspl == ERTS_DSP_NO_LOCK) - erts_de_runlock(dep); - return res; - - fail: - erts_de_runlock(dep); - return res; -} - -ERTS_GLB_INLINE -void erts_schedule_dist_command(Port *prt, DistEntry *dist_entry) -{ - DistEntry *dep; - Eterm id; - - if (prt) { - ERTS_LC_ASSERT(erts_lc_is_port_locked(prt)); - ASSERT((erts_atomic32_read_nob(&prt->state) - & ERTS_PORT_SFLGS_DEAD) == 0); - - dep = (DistEntry*) erts_prtsd_get(prt, ERTS_PRTSD_DIST_ENTRY); - ASSERT(dep); - id = prt->common.id; - } - else { - ASSERT(dist_entry); - ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&dist_entry->rwmtx) - || erts_lc_rwmtx_is_rwlocked(&dist_entry->rwmtx)); - ASSERT(is_internal_port(dist_entry->cid)); - - dep = dist_entry; - id = dep->cid; - } - - if (!erts_atomic_xchg_mb(&dep->dist_cmd_scheduled, 1)) - erts_port_task_schedule(id, &dep->dist_cmd, ERTS_PORT_TASK_DIST_CMD); -} - -#endif - #ifdef DEBUG #define ERTS_DBG_CHK_NO_DIST_LNK(D, R, L) \ erts_dbg_chk_no_dist_proc_link((D), (R), (L)) @@ -336,41 +231,45 @@ enum erts_dsig_send_phase { ERTS_DSIG_SEND_PHASE_MSG_SIZE, ERTS_DSIG_SEND_PHASE_ALLOC, ERTS_DSIG_SEND_PHASE_MSG_ENCODE, - ERTS_DSIG_SEND_PHASE_FIN + ERTS_DSIG_SEND_PHASE_FIN, + ERTS_DSIG_SEND_PHASE_SEND }; -struct erts_dsig_send_context { - enum erts_dsig_send_phase phase; - Sint reds; +typedef struct erts_dsig_send_context { + int connect; + int no_suspend; + int no_trap; Eterm ctl; Eterm msg; - int force_busy; + Eterm from; + Eterm ctl_heap[6]; + Eterm return_term; + + DistEntry *dep; + Eterm node; /* used if dep == NULL */ + Eterm cid; + Eterm connection_id; + int deref_dep; + + enum erts_dsig_send_phase phase; + Sint reds; + Uint32 max_finalize_prepend; Uint data_size, dhdr_ext_size; ErtsAtomCacheMap *acmp; ErtsDistOutputBuf *obuf; + Uint fragments; Uint32 flags; Process *c_p; union { TTBSizeContext sc; TTBEncodeContext ec; }u; -}; -typedef struct { - int suspend; - int connect; - - Eterm ctl_heap[6]; - ErtsDSigData dsd; - DistEntry *dep; - int deref_dep; - struct erts_dsig_send_context dss; - - Eterm return_term; -}ErtsSendContext; +} ErtsDSigSendContext; +typedef struct dist_sequences DistSeqNode; /* * erts_dsig_send_* return values. @@ -380,21 +279,21 @@ typedef struct { #define ERTS_DSIG_SEND_CONTINUE 2 #define ERTS_DSIG_SEND_TOO_LRG 3 -extern int erts_dsig_send_link(ErtsDSigData *, Eterm, Eterm); -extern int erts_dsig_send_msg(Eterm, Eterm, ErtsSendContext*); -extern int erts_dsig_send_exit_tt(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm); -extern int erts_dsig_send_unlink(ErtsDSigData *, Eterm, Eterm); -extern int erts_dsig_send_reg_msg(Eterm, Eterm, ErtsSendContext*); -extern int erts_dsig_send_group_leader(ErtsDSigData *, Eterm, Eterm); -extern int erts_dsig_send_exit(ErtsDSigData *, Eterm, Eterm, Eterm); -extern int erts_dsig_send_exit2(ErtsDSigData *, Eterm, Eterm, Eterm); -extern int erts_dsig_send_demonitor(ErtsDSigData *, Eterm, Eterm, Eterm, int); -extern int erts_dsig_send_monitor(ErtsDSigData *, Eterm, Eterm, Eterm); -extern int erts_dsig_send_m_exit(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm); - -extern int erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx); +extern int erts_dsig_send_msg(ErtsDSigSendContext*, Eterm, Eterm); +extern int erts_dsig_send_reg_msg(ErtsDSigSendContext*, Eterm, Eterm); +extern int erts_dsig_send_link(ErtsDSigSendContext *, Eterm, Eterm); +extern int erts_dsig_send_exit_tt(ErtsDSigSendContext *, Eterm, Eterm, Eterm, Eterm); +extern int erts_dsig_send_unlink(ErtsDSigSendContext *, Eterm, Eterm); +extern int erts_dsig_send_group_leader(ErtsDSigSendContext *, Eterm, Eterm); +extern int erts_dsig_send_exit(ErtsDSigSendContext *, Eterm, Eterm, Eterm); +extern int erts_dsig_send_exit2(ErtsDSigSendContext *, Eterm, Eterm, Eterm); +extern int erts_dsig_send_demonitor(ErtsDSigSendContext *, Eterm, Eterm, Eterm); +extern int erts_dsig_send_monitor(ErtsDSigSendContext *, Eterm, Eterm, Eterm); +extern int erts_dsig_send_m_exit(ErtsDSigSendContext *, Eterm, Eterm, Eterm, Eterm); + +extern int erts_dsig_send(ErtsDSigSendContext *dsdp); extern int erts_dsend_context_dtor(Binary*); -extern Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx); +extern Eterm erts_dsend_export_trap_context(Process* p, ErtsDSigSendContext* ctx); extern int erts_dist_command(Port *prt, int reds); extern void erts_dist_port_not_busy(Port *prt); @@ -404,5 +303,18 @@ extern Uint erts_dist_cache_size(void); extern Sint erts_abort_connection_rwunlock(DistEntry *dep); +extern void erts_dist_seq_tree_foreach( + DistEntry *dep, + int (*func)(ErtsDistExternal *, void*, Sint), void *args); + +extern int erts_dsig_prepare(ErtsDSigSendContext *, + DistEntry*, + Process *, + ErtsProcLocks, + ErtsDSigPrepLock, + int, + int, + int); +int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks); #endif diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 08dcc5ea9a..490a033b8a 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -275,6 +275,8 @@ type ML_DIST STANDARD SYSTEM monitor_link_dist type PF3_ARGS SHORT_LIVED PROCESSES process_flag_3_arguments type SETUP_CONN_ARG SHORT_LIVED PROCESSES setup_connection_argument type LIST_TRAP SHORT_LIVED PROCESSES list_bif_trap_state +type CONT_EXIT_TRAP SHORT_LIVED PROCESSES continue_exit_trap_state +type SEQ_YIELD_STATE SHORT_LIVED SYSTEM dist_seq_yield_state type ENVIRONMENT SYSTEM SYSTEM environment diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index d238d38d27..8d4464969a 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -7503,7 +7503,7 @@ static int gather_ahist_scan(Allctr_t *allocator, return blocks_scanned; } -static void gather_ahist_append_result(hist_tree_t *node, void *arg) +static int gather_ahist_append_result(hist_tree_t *node, void *arg, Sint reds) { gather_ahist_t *state = (gather_ahist_t*)arg; @@ -7537,6 +7537,7 @@ static void gather_ahist_append_result(hist_tree_t *node, void *arg) /* Plain free is intentional. */ free(node); + return 1; } static void gather_ahist_send(gather_ahist_t *state) @@ -7595,11 +7596,11 @@ static int gather_ahist_finish(void *arg) state->building_result = 1; } - if (hist_tree_rbt_foreach_destroy_yielding(&state->hist_tree, - &gather_ahist_append_result, - state, - &state->hist_tree_yield, - BLOCKSCAN_REDUCTIONS)) { + if (!hist_tree_rbt_foreach_destroy_yielding(&state->hist_tree, + &gather_ahist_append_result, + state, + &state->hist_tree_yield, + BLOCKSCAN_REDUCTIONS)) { return 1; } @@ -7608,10 +7609,11 @@ static int gather_ahist_finish(void *arg) return 0; } -static void gather_ahist_destroy_result(hist_tree_t *node, void *arg) +static int gather_ahist_destroy_result(hist_tree_t *node, void *arg, Sint reds) { (void)arg; free(node); + return 1; } static void gather_ahist_abort(void *arg) diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 6f4e34e1a8..74708b2caa 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -227,7 +227,7 @@ bld_magic_ref_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) }). */ -static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz) +static int do_calc_mon_size(ErtsMonitor *mon, void *vpsz, Sint reds) { ErtsMonitorData *mdp = erts_monitor_to_data(mon); Uint *psz = vpsz; @@ -238,7 +238,8 @@ static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz) else *psz += is_immed(mon->other.item) ? 0 : NC_HEAP_SIZE(mon->other.item); - *psz += 9; /* CONS + 6-tuple */ + *psz += 9; /* CONS + 6-tuple */ + return 1; } typedef struct { @@ -248,7 +249,7 @@ typedef struct { Eterm tag; } MonListContext; -static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc) +static int do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc, Sint reds) { ErtsMonitorData *mdp = erts_monitor_to_data(mon); MonListContext *pmlc = vpmlc; @@ -319,6 +320,7 @@ static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc) pmlc->hp += 7; pmlc->res = CONS(pmlc->hp, tup, pmlc->res); pmlc->hp += 2; + return 1; } static Eterm @@ -328,7 +330,7 @@ make_monitor_list(Process *p, int tree, ErtsMonitor *root, Eterm tail) Uint sz = 0; MonListContext mlc; void (*foreach)(ErtsMonitor *, - void (*)(ErtsMonitor *, void *), + ErtsMonitorFunc, void *); foreach = tree ? erts_monitor_tree_foreach : erts_monitor_list_foreach; @@ -354,7 +356,7 @@ make_monitor_list(Process *p, int tree, ErtsMonitor *root, Eterm tail) }). */ -static void calc_lnk_size(ErtsLink *lnk, void *vpsz) +static int calc_lnk_size(ErtsLink *lnk, void *vpsz, Sint reds) { Uint *psz = vpsz; Uint sz = 0; @@ -364,7 +366,8 @@ static void calc_lnk_size(ErtsLink *lnk, void *vpsz) *psz += sz; *psz += is_immed(lnk->other.item) ? 0 : size_object(lnk->other.item); - *psz += 7; /* CONS + 4-tuple */ + *psz += 7; /* CONS + 4-tuple */ + return 1; } typedef struct { @@ -374,7 +377,7 @@ typedef struct { Eterm tag; } LnkListContext; -static void make_one_lnk_element(ErtsLink *lnk, void * vpllc) +static int make_one_lnk_element(ErtsLink *lnk, void * vpllc, Sint reds) { LnkListContext *pllc = vpllc; Eterm tup, t, pid, id; @@ -411,6 +414,7 @@ static void make_one_lnk_element(ErtsLink *lnk, void * vpllc) pllc->hp += 5; pllc->res = CONS(pllc->hp, tup, pllc->res); pllc->hp += 2; + return 1; } static Eterm @@ -420,7 +424,7 @@ make_link_list(Process *p, int tree, ErtsLink *root, Eterm tail) Uint sz = 0; LnkListContext llc; void (*foreach)(ErtsLink *, - void (*)(ErtsLink *, void *), + ErtsLinkFunc, void *); foreach = tree ? erts_link_tree_foreach : erts_link_list_foreach; @@ -519,16 +523,17 @@ do { \ } \ } while (0) -static void collect_one_link(ErtsLink *lnk, void *vmicp) +static int collect_one_link(ErtsLink *lnk, void *vmicp, Sint reds) { MonitorInfoCollection *micp = vmicp; EXTEND_MONITOR_INFOS(micp); micp->mi[micp->mi_i].entity.term = lnk->other.item; micp->sz += 2 + NC_HEAP_SIZE(lnk->other.item); micp->mi_i++; + return 1; } -static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp) +static int collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp, Sint reds) { if (erts_monitor_is_origin(mon)) { MonitorInfoCollection *micp = vmicp; @@ -573,9 +578,10 @@ static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp) break; } } + return 1; } -static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp) +static int collect_one_target_monitor(ErtsMonitor *mon, void *vmicp, Sint reds) { MonitorInfoCollection *micp = vmicp; @@ -612,8 +618,8 @@ static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp) default: break; } - } + return 1; } typedef struct { @@ -653,8 +659,8 @@ do { \ } \ } while (0) -static void -collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp) +static int +collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp, Sint reds) { if (mon->type == ERTS_MON_TYPE_SUSPEND) { Sint count; @@ -678,6 +684,7 @@ collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp) smicp->smi_i++; } + return 1; } /* @@ -3144,14 +3151,16 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } -static void monitor_size(ErtsMonitor *mon, void *vsz) +static int monitor_size(ErtsMonitor *mon, void *vsz, Sint reds) { *((Uint *) vsz) = erts_monitor_size(mon); + return 1; } -static void link_size(ErtsMonitor *lnk, void *vsz) +static int link_size(ErtsMonitor *lnk, void *vsz, Sint reds) { *((Uint *) vsz) = erts_link_size(lnk); + return 1; } /**********************************************************************/ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index df6f42edd3..4132a54934 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -3701,7 +3701,7 @@ static SWord proc_cleanup_fixed_table(Process* p, DbFixation* fix) /* * erts_db_process_exiting() is called when a process terminates. * It returns 0 when completely done, and !0 when it wants to - * yield. c_p->u.terminate can hold a pointer to a state while + * yield. *yield_state can hold a pointer to a state while * yielding. */ #define ERTS_DB_INTERNAL_ERROR(LSTR) \ @@ -3709,7 +3709,7 @@ static SWord proc_cleanup_fixed_table(Process* p, DbFixation* fix) __FILE__, __LINE__) int -erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) +erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks, void **yield_state) { typedef struct { enum { @@ -3719,7 +3719,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) }op; DbTable *tb; } CleanupState; - CleanupState *state = (CleanupState *) c_p->u.terminate; + CleanupState *state = (CleanupState *) *yield_state; Eterm pid = c_p->common.id; CleanupState default_state; SWord initial_reds = ERTS_BIF_REDS_LEFT(c_p); @@ -3792,7 +3792,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) if (state != &default_state) erts_free(ERTS_ALC_T_DB_PROC_CLEANUP, state); - c_p->u.terminate = NULL; + *yield_state = NULL; BUMP_REDS(c_p, (initial_reds - reds)); return 0; @@ -3812,12 +3812,12 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) yield: if (state == &default_state) { - c_p->u.terminate = erts_alloc(ERTS_ALC_T_DB_PROC_CLEANUP, - sizeof(CleanupState)); - sys_memcpy(c_p->u.terminate, (void*) state, sizeof(CleanupState)); + *yield_state = erts_alloc(ERTS_ALC_T_DB_PROC_CLEANUP, + sizeof(CleanupState)); + sys_memcpy(*yield_state, (void*) state, sizeof(CleanupState)); } else - ASSERT(state == c_p->u.terminate); + ASSERT(state == *yield_state); return !0; } @@ -3912,7 +3912,7 @@ struct free_fixations_ctx SWord cnt; }; -static void free_fixations_op(DbFixation* fix, void* vctx) +static int free_fixations_op(DbFixation* fix, void* vctx, Sint reds) { struct free_fixations_ctx* ctx = (struct free_fixations_ctx*) vctx; erts_aint_t diff; @@ -3949,6 +3949,7 @@ static void free_fixations_op(DbFixation* fix, void* vctx) ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation)); } ctx->cnt++; + return 1; } int erts_db_execute_free_fixation(Process* p, DbFixation* fix) @@ -4093,7 +4094,7 @@ struct fixing_procs_info_ctx Eterm list; }; -static void fixing_procs_info_op(DbFixation* fix, void* vctx) +static int fixing_procs_info_op(DbFixation* fix, void* vctx, Sint reds) { struct fixing_procs_info_ctx* ctx = (struct fixing_procs_info_ctx*) vctx; Eterm* hp; @@ -4103,6 +4104,7 @@ static void fixing_procs_info_op(DbFixation* fix, void* vctx) tpl = TUPLE2(hp, fix->procs.p->common.id, make_small(fix->counter)); hp += 3; ctx->list = CONS(hp, tpl, ctx->list); + return 1; } static Eterm table_info(Process* p, DbTable* tb, Eterm What) diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index 5955d42aae..dc77fbb60c 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -111,7 +111,7 @@ typedef enum { } ErtsDbSpinCount; void init_db(ErtsDbSpinCount); -int erts_db_process_exiting(Process *, ErtsProcLocks); +int erts_db_process_exiting(Process *, ErtsProcLocks, void **); int erts_db_execute_free_fixation(Process*, DbFixation*); void db_info(fmtfn_t, void *, int); void erts_db_foreach_table(void (*)(DbTable *, void *), void *); diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index ec7442aeeb..1ea7074d21 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -3312,7 +3312,7 @@ void db_cleanup_offheap_comp(DbTerm* obj) default: ASSERT(is_external_header(u.hdr->thing_word)); ASSERT(u.pb != &tmp); - erts_deref_node_entry(u.ext->node); + erts_deref_node_entry(u.ext->node, make_boxed(u.ep)); break; } } diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 3a50b294d1..9317850d96 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1303,7 +1303,8 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, ExternalThing *etp; ASSERT(is_external_header(ptr->thing_word)); etp = (ExternalThing *) ptr; - erts_refc_inc(&etp->node->refc, 1); + erts_ref_node_entry(etp->node, 1, + make_boxed(&oh->thing_word)); break; } } @@ -2836,7 +2837,11 @@ sweep_off_heap(Process *p, int fullsweep) while (ptr) { if (IS_MOVED_BOXED(ptr->thing_word)) { ASSERT(!ErtsInArea(ptr, oheap, oheap_sz)); - *prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word); + if (is_external_header(((struct erl_off_heap_header*) boxed_val(ptr->thing_word))->thing_word)) + erts_node_bookkeep(((ExternalThing*)ptr)->node, + make_boxed(&ptr->thing_word), + ERL_NODE_DEC); + *prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word); ASSERT(!IS_MOVED_BOXED(ptr->thing_word)); switch (ptr->thing_word) { case HEADER_PROC_BIN: { @@ -2863,6 +2868,11 @@ sweep_off_heap(Process *p, int fullsweep) /* fall through... */ } default: + if (is_external_header(ptr->thing_word)) { + erts_node_bookkeep(((ExternalThing*)ptr)->node, + make_boxed(&ptr->thing_word), + ERL_NODE_INC); + } prev = &ptr->next; ptr = ptr->next; } @@ -2896,7 +2906,8 @@ sweep_off_heap(Process *p, int fullsweep) } default: ASSERT(is_external_header(ptr->thing_word)); - erts_deref_node_entry(((ExternalThing*)ptr)->node); + erts_deref_node_entry(((ExternalThing*)ptr)->node, + make_boxed(&ptr->thing_word)); } *prev = ptr = ptr->next; } @@ -3029,6 +3040,13 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) { struct erl_off_heap_header* oh = (struct erl_off_heap_header*) hp; + if (is_external_header(oh->thing_word)) { + erts_node_bookkeep(((ExternalThing*)oh)->node, + make_boxed(((Eterm*)oh)-offs), ERL_NODE_DEC); + erts_node_bookkeep(((ExternalThing*)oh)->node, + make_boxed((Eterm*)oh), ERL_NODE_INC); + } + if (ErtsInArea(oh->next, area, area_size)) { Eterm** uptr = (Eterm **) (void *) &oh->next; *uptr += offs; /* Patch the mso chain */ diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index 75ad6de2c9..b0eb0e85c0 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -2263,9 +2263,10 @@ parse_bif_timer_options(Eterm option_list, int *async, return 1; } -static void -exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp) +static int +exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp, Sint reds) { +#define ERTS_BTM_CANCEL_REDS 80 ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; Uint32 sid, roflgs; erts_aint_t state; @@ -2290,7 +2291,7 @@ exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp) if (sid != (Uint32) esdp->no) { queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr); - return; + return ERTS_BTM_CANCEL_REDS; } if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { @@ -2306,14 +2307,9 @@ exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp) hl_timer_dec_refc(&tmr->type.hlt, roflgs); else tw_timer_dec_refc(&tmr->type.twt); + return ERTS_BTM_CANCEL_REDS; } -#ifdef ERTS_HLT_DEBUG -# define ERTS_BTM_MAX_DESTROY_LIMIT 2 -#else -# define ERTS_BTM_MAX_DESTROY_LIMIT 50 -#endif - typedef struct { ErtsBifTimers *bif_timers; union { @@ -2321,10 +2317,9 @@ typedef struct { } u; } ErtsBifTimerYieldState; -int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp) +int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp, int reds) { ErtsSchedulerData *esdp = erts_proc_sched_data(p); - ErtsBifTimerYieldState ys = {*btm, {ERTS_RBT_YIELD_STAT_INITER}}; ErtsBifTimerYieldState *ysp; int res; @@ -2337,9 +2332,9 @@ int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp) exit_cancel_bif_timer, (void *) esdp, &ysp->u.proc_btm_yield_state, - ERTS_BTM_MAX_DESTROY_LIMIT); + reds); - if (res == 0) { + if (res > 0) { if (ysp != &ys) erts_free(ERTS_ALC_T_BTM_YIELD_STATE, ysp); *vyspp = NULL; @@ -2819,8 +2814,8 @@ btm_print(ErtsBifTimer *tmr, void *vbtmp, ErtsMonotonicTime tpos, int is_hlt) (Sint64) left); } -static void -btm_tree_print(ErtsBifTimer *tmr, void *vbtmp) +static int +btm_tree_print(ErtsBifTimer *tmr, void *vbtmp, Sint reds) { int is_hlt = !!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_HLT); ErtsMonotonicTime tpos; @@ -2829,6 +2824,7 @@ btm_tree_print(ErtsBifTimer *tmr, void *vbtmp) else tpos = erts_tweel_read_timeout(&tmr->type.twt.u.tw_tmr); btm_print(tmr, vbtmp, tpos, is_hlt); + return 1; } void @@ -2860,8 +2856,8 @@ typedef struct { void *arg; } ErtsBTMForeachDebug; -static void -debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd) +static int +debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd, Sint reds) { if (erts_atomic32_read_nob(&tmr->btm.state) == ERTS_TMR_STATE_ACTIVE) { ErtsBTMForeachDebug *btmfd = (ErtsBTMForeachDebug *) vbtmfd; @@ -2870,6 +2866,7 @@ debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd) : tmr->type.head.receiver.proc->common.id); (*btmfd->func)(id, tmr->btm.message, tmr->btm.bp, btmfd->arg); } + return 1; } void @@ -2918,8 +2915,8 @@ debug_callback_timer_foreach_list(ErtsHLTimer *tmr, void *vdfct) tmr->head.u.arg); } -static void -debug_callback_timer_foreach(ErtsHLTimer *tmr, void *vdfct) +static int +debug_callback_timer_foreach(ErtsHLTimer *tmr, void *vdfct, Sint reds) { ErtsDebugForeachCallbackTimer *dfct = (ErtsDebugForeachCallbackTimer *) vdfct; @@ -2934,6 +2931,7 @@ debug_callback_timer_foreach(ErtsHLTimer *tmr, void *vdfct) (*dfct->func)(dfct->arg, tmr->timeout, tmr->head.u.arg); + return 1; } static void @@ -2981,7 +2979,8 @@ erts_debug_callback_timer_foreach(void (*tclbk)(void *), if (srv->yield.root) debug_callback_timer_foreach(srv->yield.root, - (void *) &dfct); + (void *) &dfct, + -1); time_rbt_foreach(srv->time_tree, debug_callback_timer_foreach, diff --git a/erts/emulator/beam/erl_hl_timer.h b/erts/emulator/beam/erl_hl_timer.h index e6f5e8b67d..29c873868b 100644 --- a/erts/emulator/beam/erl_hl_timer.h +++ b/erts/emulator/beam/erl_hl_timer.h @@ -56,7 +56,7 @@ void erts_cancel_proc_timer(Process *); void erts_set_port_timer(Port *, Sint64); void erts_cancel_port_timer(Port *); Sint64 erts_read_port_timer(Port *); -int erts_cancel_bif_timers(Process *, ErtsBifTimers **, void **); +int erts_cancel_bif_timers(Process *, ErtsBifTimers **, void **, int); int erts_detach_accessor_bif_timers(Process *, ErtsBifTimers *, void **); ErtsHLTimerService *erts_create_timer_service(void); void erts_hl_timer_init(void); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 12750b9aa6..82d5140d1c 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -2417,12 +2417,17 @@ erts_exit_vv(int n, int flush_async, char *fmt, va_list args1, va_list args2) erts_exit_epilogue(); } +void check_obuf(void); __decl_noreturn void __noreturn erts_exit_epilogue(void) { int n = erts_exit_code; sys_tty_reset(n); +#ifdef DEBUG + check_obuf(); +#endif + if (n == ERTS_INTR_EXIT) exit(0); else if (n == ERTS_DUMP_EXIT) diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 3aab4828cc..39eabb6710 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -164,7 +164,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "os_monotonic_time", NULL }, { "erts_alloc_hard_debug", NULL }, { "hard_dbg_mseg", NULL }, - { "erts_mmap", NULL } + { "erts_mmap", NULL }, + { "sad", NULL} }; #define ERTS_LOCK_ORDER_SIZE \ diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 942bec84cf..9d40754d2d 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -181,7 +181,7 @@ erts_cleanup_offheap(ErlOffHeap *offheap) break; default: ASSERT(is_external_header(u.hdr->thing_word)); - erts_deref_node_entry(u.ext->node); + erts_deref_node_entry(u.ext->node, make_boxed(u.ep)); break; } } @@ -201,34 +201,44 @@ free_message_buffer(ErlHeapFragment* bp) }while (bp != NULL); } +static void +erts_cleanup_message(ErtsMessage *mp) +{ + ErlHeapFragment *bp; + if (ERTS_SIG_IS_EXTERNAL_MSG(mp) || ERTS_SIG_IS_NON_MSG(mp)) { + ErtsDistExternal *edep = erts_proc_sig_get_external(mp); + if (edep) { + erts_free_dist_ext_copy(edep); + if (mp->data.heap_frag == &mp->hfrag) { + ASSERT(ERTS_SIG_IS_EXTERNAL_MSG(mp)); + mp->data.heap_frag = ERTS_MSG_COMBINED_HFRAG; + } + } + } + + if (ERTS_SIG_IS_MSG(mp) && mp->data.attached != ERTS_MSG_COMBINED_HFRAG) { + bp = mp->data.heap_frag; + } else { + /* All non msg signals are combined HFRAG messages, + but we overwrite the mp->data field with the + nm_signal queue ptr so have to fix that here + before freeing it. */ + mp->data.attached = ERTS_MSG_COMBINED_HFRAG; + bp = mp->hfrag.next; + erts_cleanup_offheap(&mp->hfrag.off_heap); + } + + if (bp) + free_message_buffer(bp); +} + void erts_cleanup_messages(ErtsMessage *msgp) { ErtsMessage *mp = msgp; while (mp) { ErtsMessage *fmp; - ErlHeapFragment *bp; - if (ERTS_SIG_IS_EXTERNAL_MSG(mp)) { - if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) { - bp = (ErlHeapFragment *) mp->data.dist_ext->ext_endp; - erts_cleanup_offheap(&bp->off_heap); - } - if (mp->data.dist_ext) - erts_free_dist_ext_copy(mp->data.dist_ext); - } - else { - if (ERTS_SIG_IS_INTERNAL_MSG(mp) - && mp->data.attached != ERTS_MSG_COMBINED_HFRAG) { - bp = mp->data.heap_frag; - } - else { - mp->data.attached = ERTS_MSG_COMBINED_HFRAG; - bp = mp->hfrag.next; - erts_cleanup_offheap(&mp->hfrag.off_heap); - } - if (bp) - free_message_buffer(bp); - } + erts_cleanup_message(mp); fmp = mp; mp = mp->next; erts_free_message(fmp); @@ -260,6 +270,7 @@ void erts_queue_dist_message(Process *rcvr, ErtsProcLocks rcvr_locks, ErtsDistExternal *dist_ext, + ErlHeapFragment *hfrag, Eterm token, Eterm from) { @@ -268,8 +279,26 @@ erts_queue_dist_message(Process *rcvr, ERTS_LC_ASSERT(rcvr_locks == erts_proc_lc_my_proc_locks(rcvr)); - mp = erts_alloc_message(0, NULL); - mp->data.dist_ext = dist_ext; + if (hfrag) { + /* Fragmented message, allocate a message reference */ + mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = hfrag; + } else { + /* Un-fragmented message, allocate space for + token and dist_ext in message. */ + Uint dist_ext_sz = erts_dist_ext_size(dist_ext) / sizeof(Eterm); + Uint token_sz = size_object(token); + Uint sz = token_sz + dist_ext_sz; + Eterm *hp; + + mp = erts_alloc_message(sz, &hp); + mp->data.heap_frag = &mp->hfrag; + mp->hfrag.used_size = token_sz; + + erts_make_dist_ext_copy(dist_ext, erts_get_dist_ext(mp->data.heap_frag)); + + token = copy_struct(token, token_sz, &hp, &mp->data.heap_frag->off_heap); + } ERL_MESSAGE_FROM(mp) = dist_ext->dep->sysname; ERL_MESSAGE_TERM(mp) = THE_NON_VALUE; @@ -493,25 +522,27 @@ Uint erts_msg_attached_data_size_aux(ErtsMessage *msg) { Sint sz; - ASSERT(is_non_value(ERL_MESSAGE_TERM(msg))); - ASSERT(msg->data.dist_ext); - ASSERT(msg->data.dist_ext->heap_size < 0); - - sz = erts_decode_dist_ext_size(msg->data.dist_ext); - if (sz < 0) { - /* Bad external - * We leave the message intact in this case as it's not worth the trouble - * to make all callers remove it from queue. It will be detected again - * and removed from message queue later anyway. - */ - return 0; - } + ErtsDistExternal *edep = erts_get_dist_ext(msg->data.heap_frag); + ASSERT(ERTS_SIG_IS_EXTERNAL_MSG(msg)); - msg->data.dist_ext->heap_size = sz; - if (is_not_nil(msg->m[1])) { - ErlHeapFragment *heap_frag; - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); - sz += heap_frag->used_size; + if (edep->heap_size < 0) { + + sz = erts_decode_dist_ext_size(edep, 1); + if (sz < 0) { + /* Bad external + * We leave the message intact in this case as it's not worth the trouble + * to make all callers remove it from queue. It will be detected again + * and removed from message queue later anyway. + */ + return 0; + } + + edep->heap_size = sz; + } else { + sz = edep->heap_size; + } + if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) { + sz += msg->data.heap_frag->used_size; } return sz; } @@ -1099,80 +1130,6 @@ change_to_off_heap: return res; } -int -erts_decode_dist_message(Process *proc, ErtsProcLocks proc_locks, - ErtsMessage *msgp, int force_off_heap) -{ - ErtsHeapFactory factory; - Eterm msg; - ErlHeapFragment *bp; - Sint need; - int decode_in_heap_frag; - - decode_in_heap_frag = (force_off_heap - || !(proc_locks & ERTS_PROC_LOCK_MAIN) - || (proc->flags & F_OFF_HEAP_MSGQ)); - - if (msgp->data.dist_ext->heap_size >= 0) - need = msgp->data.dist_ext->heap_size; - else { - need = erts_decode_dist_ext_size(msgp->data.dist_ext); - if (need < 0) { - /* bad msg; remove it... */ - if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { - bp = erts_dist_ext_trailer(msgp->data.dist_ext); - erts_cleanup_offheap(&bp->off_heap); - } - erts_free_dist_ext_copy(msgp->data.dist_ext); - msgp->data.dist_ext = NULL; - return 0; - } - - msgp->data.dist_ext->heap_size = need; - } - - if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { - bp = erts_dist_ext_trailer(msgp->data.dist_ext); - need += bp->used_size; - } - - if (decode_in_heap_frag) - erts_factory_heap_frag_init(&factory, new_message_buffer(need)); - else - erts_factory_proc_prealloc_init(&factory, proc, need); - - ASSERT(msgp->data.dist_ext->heap_size >= 0); - if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { - ErlHeapFragment *heap_frag; - heap_frag = erts_dist_ext_trailer(msgp->data.dist_ext); - ERL_MESSAGE_TOKEN(msgp) = copy_struct(ERL_MESSAGE_TOKEN(msgp), - heap_frag->used_size, - &factory.hp, - factory.off_heap); - erts_cleanup_offheap(&heap_frag->off_heap); - } - - msg = erts_decode_dist_ext(&factory, msgp->data.dist_ext); - ERL_MESSAGE_TERM(msgp) = msg; - erts_free_dist_ext_copy(msgp->data.dist_ext); - msgp->data.attached = NULL; - - if (is_non_value(msg)) { - erts_factory_undo(&factory); - return 0; - } - - erts_factory_trim_and_close(&factory, msgp->m, - ERL_MESSAGE_REF_ARRAY_SZ); - - ASSERT(!msgp->data.heap_frag); - - if (decode_in_heap_frag) - msgp->data.heap_frag = factory.heap_frags; - - return 1; -} - void erts_factory_proc_init(ErtsHeapFactory* factory, Process* p) { @@ -1233,7 +1190,7 @@ erts_factory_message_create(ErtsHeapFactory* factory, int on_heap; erts_aint32_t state; - state = proc ? erts_atomic32_read_nob(&proc->state) : 0; + state = proc ? erts_atomic32_read_nob(&proc->state) : ERTS_PSFLG_OFF_HEAP_MSGQ; if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) { msgp = erts_alloc_message(sz, &hp); @@ -1466,8 +1423,8 @@ void erts_factory_close(ErtsHeapFactory* factory) else factory->message->data.heap_frag = factory->heap_frags; - /* Fall through */ - case FACTORY_HEAP_FRAGS: + /* Fall through */ + case FACTORY_HEAP_FRAGS: bp = factory->heap_frags; } diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index b2550814fd..4c2674394e 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -138,7 +138,7 @@ typedef struct erl_heap_fragment ErlHeapFragment; struct erl_heap_fragment { ErlHeapFragment* next; /* Next heap fragment */ ErlOffHeap off_heap; /* Offset heap data. */ - Uint alloc_size; /* Size in (half)words of mem */ + Uint alloc_size; /* Size in words of mem */ Uint used_size; /* With terms to be moved to heap by GC */ Eterm mem[1]; /* Data */ }; @@ -167,7 +167,6 @@ struct erl_heap_fragment { #define ERL_MESSAGE_REF_FIELDS__ \ ErtsMessage *next; /* Next message */ \ union { \ - ErtsDistExternal *dist_ext; \ ErlHeapFragment *heap_frag; \ void *attached; \ } data; \ @@ -438,7 +437,8 @@ ErlHeapFragment* new_message_buffer(Uint); ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint, Eterm *, Uint); void free_message_buffer(ErlHeapFragment *); -void erts_queue_dist_message(Process*, ErtsProcLocks, ErtsDistExternal *, Eterm, Eterm); +void erts_queue_dist_message(Process*, ErtsProcLocks, ErtsDistExternal *, + ErlHeapFragment *, Eterm, Eterm); void erts_queue_message(Process*, ErtsProcLocks,ErtsMessage*, Eterm, Eterm); void erts_queue_proc_message(Process* from,Process* to, ErtsProcLocks,ErtsMessage*, Eterm); void erts_queue_proc_messages(Process* from, Process* to, ErtsProcLocks, @@ -455,8 +455,6 @@ Sint erts_move_messages_off_heap(Process *c_p); Sint erts_complete_off_heap_message_queue_change(Process *c_p); Eterm erts_change_message_queue_management(Process *c_p, Eterm new_state); -int erts_decode_dist_message(Process *, ErtsProcLocks, ErtsMessage *, int); - void erts_cleanup_messages(ErtsMessage *mp); void *erts_alloc_message_ref(void); @@ -585,22 +583,11 @@ ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp) ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg) { ASSERT(msg->data.attached); - if (is_value(ERL_MESSAGE_TERM(msg))) { - ErlHeapFragment *bp; - bp = erts_message_to_heap_frag(msg); - return erts_used_frag_sz(bp); - } - else if (msg->data.dist_ext->heap_size < 0) - return erts_msg_attached_data_size_aux(msg); - else { - Uint sz = msg->data.dist_ext->heap_size; - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) { - ErlHeapFragment *heap_frag; - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); - sz += heap_frag->used_size; - } - return sz; - } + + if (ERTS_SIG_IS_INTERNAL_MSG(msg)) + return erts_used_frag_sz(erts_message_to_heap_frag(msg)); + + return erts_msg_attached_data_size_aux(msg); } #endif diff --git a/erts/emulator/beam/erl_monitor_link.c b/erts/emulator/beam/erl_monitor_link.c index 48d9bd4ca5..1c6b4afaa3 100644 --- a/erts/emulator/beam/erl_monitor_link.c +++ b/erts/emulator/beam/erl_monitor_link.c @@ -191,7 +191,8 @@ ml_cmp_keys(Eterm key1, Eterm key2) if (n1->sysname != n2->sysname) return n1->sysname < n2->sysname ? -1 : 1; ASSERT(n1->creation != n2->creation); - return n1->creation < n2->creation ? -1 : 1; + if (n1->creation != 0 && n2->creation != 0) + return n1->creation < n2->creation ? -1 : 1; } ndw1 = external_thing_data_words(et1); @@ -335,7 +336,7 @@ ml_rbt_delete(ErtsMonLnkNode **root, ErtsMonLnkNode *ml) static void ml_rbt_foreach(ErtsMonLnkNode *root, - void (*func)(ErtsMonLnkNode *, void *), + ErtsMonLnkNodeFunc func, void *arg) { mon_lnk_rbt_foreach(root, func, arg); @@ -348,7 +349,7 @@ typedef struct { static int ml_rbt_foreach_yielding(ErtsMonLnkNode *root, - void (*func)(ErtsMonLnkNode *, void *), + ErtsMonLnkNodeFunc func, void *arg, void **vyspp, Sint limit) @@ -362,7 +363,7 @@ ml_rbt_foreach_yielding(ErtsMonLnkNode *root, ysp = &ys; res = mon_lnk_rbt_foreach_yielding(ysp->root, func, arg, &ysp->rbt_ystate, limit); - if (res == 0) { + if (res > 0) { if (ysp != &ys) erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp); *vyspp = NULL; @@ -383,22 +384,22 @@ ml_rbt_foreach_yielding(ErtsMonLnkNode *root, } typedef struct { - void (*func)(ErtsMonLnkNode *, void *); + ErtsMonLnkNodeFunc func; void *arg; } ErtsMonLnkForeachDeleteContext; -static void -rbt_wrap_foreach_delete(ErtsMonLnkNode *ml, void *vctxt) +static int +rbt_wrap_foreach_delete(ErtsMonLnkNode *ml, void *vctxt, Sint reds) { ErtsMonLnkForeachDeleteContext *ctxt = vctxt; ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE); ml->flags &= ~ERTS_ML_FLG_IN_TABLE; - ctxt->func(ml, ctxt->arg); + return ctxt->func(ml, ctxt->arg, reds); } static void ml_rbt_foreach_delete(ErtsMonLnkNode **root, - void (*func)(ErtsMonLnkNode *, void *), + ErtsMonLnkNodeFunc func, void *arg) { ErtsMonLnkForeachDeleteContext ctxt; @@ -411,7 +412,7 @@ ml_rbt_foreach_delete(ErtsMonLnkNode **root, static int ml_rbt_foreach_delete_yielding(ErtsMonLnkNode **root, - void (*func)(ErtsMonLnkNode *, void *), + ErtsMonLnkNodeFunc func, void *arg, void **vyspp, Sint limit) @@ -433,7 +434,7 @@ ml_rbt_foreach_delete_yielding(ErtsMonLnkNode **root, (void *) &ctxt, &ysp->rbt_ystate, limit); - if (res == 0) { + if (res > 0) { if (ysp != &ys) erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp); *vyspp = NULL; @@ -459,12 +460,11 @@ ml_rbt_foreach_delete_yielding(ErtsMonLnkNode **root, static int ml_dl_list_foreach_yielding(ErtsMonLnkNode *list, - void (*func)(ErtsMonLnkNode *, void *), + ErtsMonLnkNodeFunc func, void *arg, void **vyspp, - Sint limit) + Sint reds) { - Sint cnt = 0; ErtsMonLnkNode *ml = (ErtsMonLnkNode *) *vyspp; ERTS_ML_ASSERT(!ml || list); @@ -475,28 +475,26 @@ ml_dl_list_foreach_yielding(ErtsMonLnkNode *list, if (ml) { do { ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE); - func(ml, arg); + reds -= func(ml, arg, reds); ml = ml->node.list.next; - cnt++; - } while (ml != list && cnt < limit); + } while (ml != list && reds > 0); if (ml != list) { *vyspp = (void *) ml; - return 1; /* yield */ + return 0; /* yield */ } } *vyspp = NULL; - return 0; /* done */ + return reds <= 0 ? 1 : reds; /* done */ } static int ml_dl_list_foreach_delete_yielding(ErtsMonLnkNode **list, - void (*func)(ErtsMonLnkNode *, void *), + ErtsMonLnkNodeFunc func, void *arg, void **vyspp, - Sint limit) + Sint reds) { - Sint cnt = 0; ErtsMonLnkNode *first = *list; ErtsMonLnkNode *ml = (ErtsMonLnkNode *) *vyspp; @@ -510,19 +508,18 @@ ml_dl_list_foreach_delete_yielding(ErtsMonLnkNode **list, ErtsMonLnkNode *next = ml->node.list.next; ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE); ml->flags &= ~ERTS_ML_FLG_IN_TABLE; - func(ml, arg); + reds -= func(ml, arg, reds); ml = next; - cnt++; - } while (ml != first && cnt < limit); + } while (ml != first && reds > 0); if (ml != first) { *vyspp = (void *) ml; - return 1; /* yield */ + return 0; /* yield */ } } *vyspp = NULL; *list = NULL; - return 0; /* done */ + return reds <= 0 ? 1 : reds; /* done */ } /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ @@ -666,91 +663,91 @@ erts_monitor_tree_delete(ErtsMonitor **root, ErtsMonitor *mon) void erts_monitor_tree_foreach(ErtsMonitor *root, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg) { ml_rbt_foreach((ErtsMonLnkNode *) root, - (void (*)(ErtsMonLnkNode*, void*)) func, + (ErtsMonLnkNodeFunc) func, arg); } int erts_monitor_tree_foreach_yielding(ErtsMonitor *root, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg, void **vyspp, Sint limit) { return ml_rbt_foreach_yielding((ErtsMonLnkNode *) root, - (void (*)(ErtsMonLnkNode*, void*)) func, + (int (*)(ErtsMonLnkNode*, void*, Sint)) func, arg, vyspp, limit); } void erts_monitor_tree_foreach_delete(ErtsMonitor **root, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg) { ml_rbt_foreach_delete((ErtsMonLnkNode **) root, - (void (*)(ErtsMonLnkNode*, void*)) func, + (int (*)(ErtsMonLnkNode*, void*, Sint)) func, arg); } int erts_monitor_tree_foreach_delete_yielding(ErtsMonitor **root, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg, void **vyspp, Sint limit) { return ml_rbt_foreach_delete_yielding((ErtsMonLnkNode **) root, - (void (*)(ErtsMonLnkNode*, void*)) func, + (int (*)(ErtsMonLnkNode*, void*, Sint)) func, arg, vyspp, limit); } void erts_monitor_list_foreach(ErtsMonitor *list, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg) { void *ystate = NULL; - while (ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list, - (void (*)(ErtsMonLnkNode *, void *)) func, - arg, &ystate, (Sint) INT_MAX)); + while (!ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list, + (int (*)(ErtsMonLnkNode *, void *, Sint)) func, + arg, &ystate, (Sint) INT_MAX)); } int erts_monitor_list_foreach_yielding(ErtsMonitor *list, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg, void **vyspp, Sint limit) { return ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list, - (void (*)(ErtsMonLnkNode *, void *)) func, + (int (*)(ErtsMonLnkNode *, void *, Sint)) func, arg, vyspp, limit); } void erts_monitor_list_foreach_delete(ErtsMonitor **list, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg) { void *ystate = NULL; - while (ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list, - (void (*)(ErtsMonLnkNode*, void*)) func, - arg, &ystate, (Sint) INT_MAX)); + while (!ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list, + (int (*)(ErtsMonLnkNode*, void*, Sint)) func, + arg, &ystate, (Sint) INT_MAX)); } int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg, void **vyspp, Sint limit) { return ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list, - (void (*)(ErtsMonLnkNode*, void*)) func, + (int (*)(ErtsMonLnkNode*, void*, Sint)) func, arg, vyspp, limit); } @@ -1074,92 +1071,92 @@ erts_link_tree_delete(ErtsLink **root, ErtsLink *lnk) void erts_link_tree_foreach(ErtsLink *root, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg) { ml_rbt_foreach((ErtsMonLnkNode *) root, - (void (*)(ErtsMonLnkNode*, void*)) func, + (ErtsMonLnkNodeFunc) func, arg); } int erts_link_tree_foreach_yielding(ErtsLink *root, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg, void **vyspp, Sint limit) { return ml_rbt_foreach_yielding((ErtsMonLnkNode *) root, - (void (*)(ErtsMonLnkNode*, void*)) func, + (ErtsMonLnkNodeFunc) func, arg, vyspp, limit); } void erts_link_tree_foreach_delete(ErtsLink **root, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg) { ml_rbt_foreach_delete((ErtsMonLnkNode **) root, - (void (*)(ErtsMonLnkNode*, void*)) func, + (ErtsMonLnkNodeFunc) func, arg); } int erts_link_tree_foreach_delete_yielding(ErtsLink **root, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg, void **vyspp, Sint limit) { return ml_rbt_foreach_delete_yielding((ErtsMonLnkNode **) root, - (void (*)(ErtsMonLnkNode*, void*)) func, + (ErtsMonLnkNodeFunc) func, arg, vyspp, limit); } void erts_link_list_foreach(ErtsLink *list, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg) { void *ystate = NULL; - while (ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list, - (void (*)(ErtsMonLnkNode *, void *)) func, - arg, &ystate, (Sint) INT_MAX)); + while (!ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list, + (ErtsMonLnkNodeFunc) func, + arg, &ystate, (Sint) INT_MAX)); } int erts_link_list_foreach_yielding(ErtsLink *list, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg, void **vyspp, Sint limit) { return ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list, - (void (*)(ErtsMonLnkNode *, void *)) func, + (ErtsMonLnkNodeFunc) func, arg, vyspp, limit); } void erts_link_list_foreach_delete(ErtsLink **list, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg) { void *ystate = NULL; - while (ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list, - (void (*)(ErtsMonLnkNode*, void*)) func, - arg, &ystate, (Sint) INT_MAX)); + while (!ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list, + (ErtsMonLnkNodeFunc) func, + arg, &ystate, (Sint) INT_MAX)); } int erts_link_list_foreach_delete_yielding(ErtsLink **list, - void (*func)(ErtsLink *, void *), + int (*func)(ErtsLink *, void *, Sint), void *arg, void **vyspp, Sint limit) { return ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list, - (void (*)(ErtsMonLnkNode*, void*)) func, + (ErtsMonLnkNodeFunc) func, arg, vyspp, limit); } diff --git a/erts/emulator/beam/erl_monitor_link.h b/erts/emulator/beam/erl_monitor_link.h index ed7bf7d54a..eff861fce8 100644 --- a/erts/emulator/beam/erl_monitor_link.h +++ b/erts/emulator/beam/erl_monitor_link.h @@ -439,6 +439,7 @@ (ERTS_ML_FLG_EXTENDED|ERTS_ML_FLG_NAME) typedef struct ErtsMonLnkNode__ ErtsMonLnkNode; +typedef int (*ErtsMonLnkNodeFunc)(ErtsMonLnkNode *, void *, Sint); typedef struct { UWord parent; /* Parent ptr and flags... */ @@ -622,6 +623,7 @@ erts_ml_dl_list_last__(ErtsMonLnkNode *list) typedef struct ErtsMonLnkNode__ ErtsMonitor; +typedef int (*ErtsMonitorFunc)(ErtsMonitor *, void *, Sint); typedef struct { ErtsMonitor origin; @@ -653,6 +655,7 @@ struct ErtsMonitorDataExtended__ { typedef struct ErtsMonitorSuspend__ ErtsMonitorSuspend; + struct ErtsMonitorSuspend__ { ErtsMonitorData md; /* origin = suspender; target = suspendee */ ErtsMonitorSuspend *next; @@ -685,7 +688,7 @@ ErtsMonitor *erts_monitor_tree_lookup(ErtsMonitor *root, Eterm key); * * @brief Lookup or insert a monitor in a monitor tree * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'mon' monitor is not part of any tree or list * If the above is not true, bad things will happen. * @@ -711,7 +714,7 @@ ErtsMonitor *erts_monotor_tree_lookup_insert(ErtsMonitor **root, * If it is not found, creates a monitor and returns a pointer to the * origin monitor. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - no target monitors with the key 'target' exists in the tree. * If the above is not true, bad things will happen. * @@ -738,7 +741,7 @@ ErtsMonitor *erts_monitor_tree_lookup_create(ErtsMonitor **root, int *created, * * @brief Insert a monitor in a monitor tree * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - no monitors with the same key that 'mon' exist in the tree * - 'mon' is not part of any list of tree * If the above are not true, bad things will happen. @@ -754,7 +757,7 @@ void erts_monitor_tree_insert(ErtsMonitor **root, ErtsMonitor *mon); * * @brief Replace a monitor in a monitor tree * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'old' monitor and 'new' monitor have exactly the same key * - 'old' monitor is part of the tree * - 'new' monitor is not part of any tree or list @@ -774,7 +777,7 @@ void erts_monitor_tree_replace(ErtsMonitor **root, ErtsMonitor *old, * * @brief Delete a monitor from a monitor tree * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'mon' monitor is part of the tree * If the above is not true, bad things will happen. * @@ -789,7 +792,7 @@ void erts_monitor_tree_delete(ErtsMonitor **root, ErtsMonitor *mon); * * @brief Call a function for each monitor in a monitor tree * - * The funcion 'func' will be called with a pointer to a monitor + * The function 'func' will be called with a pointer to a monitor * as first argument and 'arg' as second argument for each monitor * in the tree referred to by 'root'. * @@ -802,7 +805,7 @@ void erts_monitor_tree_delete(ErtsMonitor **root, ErtsMonitor *mon); * */ void erts_monitor_tree_foreach(ErtsMonitor *root, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg); /** @@ -810,9 +813,10 @@ void erts_monitor_tree_foreach(ErtsMonitor *root, * @brief Call a function for each monitor in a monitor tree. Yield * if lots of monitors exist. * - * The funcion 'func' will be called with a pointer to a monitor + * The function 'func' will be called with a pointer to a monitor * as first argument and 'arg' as second argument for each monitor - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * It is assumed that: * - *yspp equals NULL on first call @@ -835,27 +839,28 @@ void erts_monitor_tree_foreach(ErtsMonitor *root, * *yspp should be NULL. When done *yspp * will be NULL. * - * @param[in] limit Maximum amount of monitors to process - * before yielding. + * @param[in] reds Reductions available to execute before yielding. * - * @returns A non-zero value when all monitors has been - * processed, and zero when more work is needed. + * @returns The unconsumed reductions when all monitors + * have been processed, and zero when more work + * is needed. * */ int erts_monitor_tree_foreach_yielding(ErtsMonitor *root, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg, void **vyspp, - Sint limit); + Sint reds); /** * * @brief Delete all monitors from a monitor tree and call a function for * each monitor * - * The funcion 'func' will be called with a pointer to a monitor + * The function 'func' will be called with a pointer to a monitor * as first argument and 'arg' as second argument for each monitor - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * @param[in,out] root Pointer to pointer to root of monitor tree * @@ -866,7 +871,7 @@ int erts_monitor_tree_foreach_yielding(ErtsMonitor *root, * */ void erts_monitor_tree_foreach_delete(ErtsMonitor **root, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg); /** @@ -874,9 +879,10 @@ void erts_monitor_tree_foreach_delete(ErtsMonitor **root, * @brief Delete all monitors from a monitor tree and call a function for * each monitor * - * The funcion 'func' will be called with a pointer to a monitor + * The function 'func' will be called with a pointer to a monitor * as first argument and 'arg' as second argument for each monitor - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * It is assumed that: * - *yspp equals NULL on first call @@ -899,18 +905,18 @@ void erts_monitor_tree_foreach_delete(ErtsMonitor **root, * *yspp should be NULL. When done *yspp * will be NULL. * - * @param[in] limit Maximum amount of monitors to process - * before yielding. + * @param[in] reds Reductions available to execute before yielding. * - * @returns A non-zero value when all monitors has been - * processed, and zero when more work is needed. + * @returns The unconsumed reductions when all monitors + * have been processed, and zero when more work + * is needed. * */ int erts_monitor_tree_foreach_delete_yielding(ErtsMonitor **root, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg, void **vyspp, - Sint limit); + Sint reds); /* * --- Monitor list operations -- @@ -920,7 +926,7 @@ int erts_monitor_tree_foreach_delete_yielding(ErtsMonitor **root, * * @brief Insert a monitor in a monitor list * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'mon' monitor is not part of any list or tree * If the above is not true, bad things will happen. * @@ -935,7 +941,7 @@ ERTS_GLB_INLINE void erts_monitor_list_insert(ErtsMonitor **list, ErtsMonitor *m * * @brief Delete a monitor from a monitor list * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'mon' monitor is part of the list * If the above is not true, bad things will happen. * @@ -980,7 +986,7 @@ ERTS_GLB_INLINE ErtsMonitor *erts_monitor_list_last(ErtsMonitor *list); * * @brief Call a function for each monitor in a monitor list * - * The funcion 'func' will be called with a pointer to a monitor + * The function 'func' will be called with a pointer to a monitor * as first argument and 'arg' as second argument for each monitor * in the tree referred to by 'list'. * @@ -993,7 +999,7 @@ ERTS_GLB_INLINE ErtsMonitor *erts_monitor_list_last(ErtsMonitor *list); * */ void erts_monitor_list_foreach(ErtsMonitor *list, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg); /** @@ -1001,9 +1007,10 @@ void erts_monitor_list_foreach(ErtsMonitor *list, * @brief Call a function for each monitor in a monitor list. Yield * if lots of monitors exist. * - * The funcion 'func' will be called with a pointer to a monitor + * The function 'func' will be called with a pointer to a monitor * as first argument and 'arg' as second argument for each monitor - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * It is assumed that: * - *yspp equals NULL on first call @@ -1026,25 +1033,25 @@ void erts_monitor_list_foreach(ErtsMonitor *list, * *yspp should be NULL. When done *yspp * will be NULL. * - * @param[in] limit Maximum amount of monitors to process - * before yielding. + * @param[in] reds Reductions available to execute before yielding. * - * @returns A non-zero value when all monitors has been - * processed, and zero when more work is needed. + * @returns The unconsumed reductions when all monitors + * have been processed, and zero when more work + * is needed. * */ int erts_monitor_list_foreach_yielding(ErtsMonitor *list, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg, void **vyspp, - Sint limit); + Sint reds); /** * * @brief Delete all monitors from a monitor list and call a function for * each monitor * - * The funcion 'func' will be called with a pointer to a monitor + * The function 'func' will be called with a pointer to a monitor * as first argument and 'arg' as second argument for each monitor * in the tree referred to by 'root'. * @@ -1057,7 +1064,7 @@ int erts_monitor_list_foreach_yielding(ErtsMonitor *list, * */ void erts_monitor_list_foreach_delete(ErtsMonitor **list, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg); /** @@ -1065,9 +1072,10 @@ void erts_monitor_list_foreach_delete(ErtsMonitor **list, * @brief Delete all monitors from a monitor list and call a function for * each monitor * - * The funcion 'func' will be called with a pointer to a monitor + * The function 'func' will be called with a pointer to a monitor * as first argument and 'arg' as second argument for each monitor - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * It is assumed that: * - *yspp equals NULL on first call @@ -1090,18 +1098,18 @@ void erts_monitor_list_foreach_delete(ErtsMonitor **list, * *yspp should be NULL. When done *yspp * will be NULL. * - * @param[in] limit Maximum amount of monitors to process - * before yielding. + * @param[in] reds Reductions available to execute before yielding. * - * @returns A non-zero value when all monitors has been - * processed, and zero when more work is needed. + * @returns The unconsumed reductions when all monitors + * have been processed, and zero when more work + * is needed. * */ int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list, - void (*func)(ErtsMonitor *, void *), + ErtsMonitorFunc func, void *arg, void **vyspp, - Sint limit); + Sint reds); /* * --- Misc monitor operations --- @@ -1113,7 +1121,7 @@ int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list, * * Can create all types of monitors * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'ref' is an internal ordinary reference if type is ERTS_MON_TYPE_PROC, * ERTS_MON_TYPE_PORT, ERTS_MON_TYPE_TIME_OFFSET, or ERTS_MON_TYPE_RESOURCE * - 'ref' is NIL if type is ERTS_MON_TYPE_NODE, ERTS_MON_TYPE_NODES, or @@ -1199,7 +1207,7 @@ ERTS_GLB_INLINE int erts_monitor_is_in_table(ErtsMonitor *mon); * When both the origin and the target part of the monitor have * been released the monitor structure will be deallocated. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'mon' monitor is not part of any list or tree * - 'mon' is not referred to by any other structures * If the above are not true, bad things will happen. @@ -1216,7 +1224,7 @@ ERTS_GLB_INLINE void erts_monitor_release(ErtsMonitor *mon); * Release both the origin and target parts of the monitor * simultaneously and deallocate the structure. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - Neither the origin part nor the target part of the monitor * are not part of any list or tree * - Neither the origin part nor the target part of the monitor @@ -1232,7 +1240,7 @@ ERTS_GLB_INLINE void erts_monitor_release_both(ErtsMonitorData *mdp); * * @brief Insert monitor in dist monitor tree or list * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'mon' monitor is not part of any list or tree * If the above is not true, bad things will happen. * @@ -1253,7 +1261,7 @@ ERTS_GLB_INLINE int erts_monitor_dist_insert(ErtsMonitor *mon, ErtsMonLnkDist *d * * @brief Delete monitor from dist monitor tree or list * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'mon' monitor earler has been inserted into 'dist' * If the above is not true, bad things will happen. * @@ -1291,7 +1299,7 @@ erts_monitor_set_dead_dist(ErtsMonitor *mon, Eterm nodename); * whole size of the monitor data structure is returned; otherwise, * half of the size is returned. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'mon' has not been released * If the above is not true, bad things will happen. * @@ -1507,6 +1515,8 @@ ERTS_GLB_INLINE ErtsMonitorSuspend *erts_monitor_suspend(ErtsMonitor *mon) typedef struct ErtsMonLnkNode__ ErtsLink; +typedef int (*ErtsLinkFunc)(ErtsLink *, void *, Sint); + typedef struct { ErtsLink a; ErtsLink b; @@ -1544,7 +1554,7 @@ ErtsLink *erts_link_tree_lookup(ErtsLink *root, Eterm item); * * @brief Lookup or insert a link in a link tree * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' link is not part of any tree or list * If the above is not true, bad things will happen. * @@ -1590,7 +1600,7 @@ ErtsLink *erts_link_tree_lookup_create(ErtsLink **root, int *created, * * @brief Insert a link in a link tree * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - no links with the same key that 'lnk' exist in the tree * - 'lnk' is not part of any list of tree * If the above are not true, bad things will happen. @@ -1606,7 +1616,7 @@ void erts_link_tree_insert(ErtsLink **root, ErtsLink *lnk); * * @brief Replace a link in a link tree * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'old' link and 'new' link have exactly the same key * - 'old' link is part of the tree * - 'new' link is not part of any tree or list @@ -1630,7 +1640,7 @@ void erts_link_tree_replace(ErtsLink **root, ErtsLink *old, ErtsLink *new); * the tree and 'lnk' has a lower address than the link in the * tree, the existing link in the tree is replaced by 'lnk'. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' link is not part of any tree or list * If the above are not true, bad things will happen. * @@ -1649,7 +1659,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_tree_insert_addr_replace(ErtsLink **root, * * @brief Delete a link from a link tree * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' link is part of the tree * If the above is not true, bad things will happen. * @@ -1668,7 +1678,7 @@ void erts_link_tree_delete(ErtsLink **root, ErtsLink *lnk); * If link 'lnk' is not in the tree, another link with the same * key as 'lnk' is deleted from the tree if such a link exist. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - if 'lnk' link is part of a tree or list, it is part of this tree * If the above is not true, bad things will happen. * @@ -1687,7 +1697,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_tree_key_delete(ErtsLink **root, ErtsLink *l * * @brief Call a function for each link in a link tree * - * The funcion 'func' will be called with a pointer to a link + * The function 'func' will be called with a pointer to a link * as first argument and 'arg' as second argument for each link * in the tree referred to by 'root'. * @@ -1700,7 +1710,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_tree_key_delete(ErtsLink **root, ErtsLink *l * */ void erts_link_tree_foreach(ErtsLink *root, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc, void *arg); /** @@ -1708,9 +1718,10 @@ void erts_link_tree_foreach(ErtsLink *root, * @brief Call a function for each link in a link tree. Yield if lots * of links exist. * - * The funcion 'func' will be called with a pointer to a link + * The function 'func' will be called with a pointer to a link * as first argument and 'arg' as second argument for each link - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * It is assumed that: * - *yspp equals NULL on first call @@ -1733,25 +1744,25 @@ void erts_link_tree_foreach(ErtsLink *root, * *yspp should be NULL. When done *yspp * will be NULL. * - * @param[in] limit Maximum amount of links to process - * before yielding. + * @param[in] reds Reductions available to execute before yielding. * - * @returns A non-zero value when all links has been - * processed, and zero when more work is needed. + * @returns The unconsumed reductions when all links + * have been processed, and zero when more work + * is needed. * */ int erts_link_tree_foreach_yielding(ErtsLink *root, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg, void **vyspp, - Sint limit); + Sint reds); /** * * @brief Delete all links from a link tree and call a function for * each link * - * The funcion 'func' will be called with a pointer to a link + * The function 'func' will be called with a pointer to a link * as first argument and 'arg' as second argument for each link * in the tree referred to by 'root'. * @@ -1764,7 +1775,7 @@ int erts_link_tree_foreach_yielding(ErtsLink *root, * */ void erts_link_tree_foreach_delete(ErtsLink **root, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg); /** @@ -1772,9 +1783,10 @@ void erts_link_tree_foreach_delete(ErtsLink **root, * @brief Delete all links from a link tree and call a function for * each link * - * The funcion 'func' will be called with a pointer to a link + * The function 'func' will be called with a pointer to a link * as first argument and 'arg' as second argument for each link - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * It is assumed that: * - *yspp equals NULL on first call @@ -1797,18 +1809,18 @@ void erts_link_tree_foreach_delete(ErtsLink **root, * *yspp should be NULL. When done *yspp * will be NULL. * - * @param[in] limit Maximum amount of links to process - * before yielding. + * @param[in] reds Reductions available to execute before yielding. * - * @returns A non-zero value when all links has been - * processed, and zero when more work is needed. + * @returns The unconsumed reductions when all links + * have been processed, and zero when more work + * is needed. * */ int erts_link_tree_foreach_delete_yielding(ErtsLink **root, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg, void **vyspp, - Sint limit); + Sint reds); /* * --- Link list operations --- @@ -1818,7 +1830,7 @@ int erts_link_tree_foreach_delete_yielding(ErtsLink **root, * * @brief Insert a link in a link list * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' link is not part of any list or tree * If the above is not true, bad things will happen. * @@ -1833,7 +1845,7 @@ ERTS_GLB_INLINE void erts_link_list_insert(ErtsLink **list, ErtsLink *lnk); * * @brief Delete a link from a link list * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' link is part of the list * If the above is not true, bad things will happen. * @@ -1878,7 +1890,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_list_last(ErtsLink *list); * * @brief Call a function for each link in a link list * - * The funcion 'func' will be called with a pointer to a link + * The function 'func' will be called with a pointer to a link * as first argument and 'arg' as second argument for each link * in the tree referred to by 'list'. * @@ -1891,7 +1903,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_list_last(ErtsLink *list); * */ void erts_link_list_foreach(ErtsLink *list, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg); /** @@ -1899,9 +1911,10 @@ void erts_link_list_foreach(ErtsLink *list, * @brief Call a function for each link in a link list. Yield * if lots of links exist. * - * The funcion 'func' will be called with a pointer to a link + * The function 'func' will be called with a pointer to a link * as first argument and 'arg' as second argument for each link - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * It is assumed that: * - *yspp equals NULL on first call @@ -1924,25 +1937,25 @@ void erts_link_list_foreach(ErtsLink *list, * *yspp should be NULL. When done *yspp * will be NULL. * - * @param[in] limit Maximum amount of links to process - * before yielding. + * @param[in] reds Reductions available to execute before yielding. * - * @returns A non-zero value when all links has been - * processed, and zero when more work is needed. + * @returns The unconsumed reductions when all links + * have been processed, and zero when more work + * is needed. * */ int erts_link_list_foreach_yielding(ErtsLink *list, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg, void **vyspp, - Sint limit); + Sint reds); /** * * @brief Delete all links from a link list and call a function for * each link * - * The funcion 'func' will be called with a pointer to a link + * The function 'func' will be called with a pointer to a link * as first argument and 'arg' as second argument for each link * in the tree referred to by 'root'. * @@ -1955,7 +1968,7 @@ int erts_link_list_foreach_yielding(ErtsLink *list, * */ void erts_link_list_foreach_delete(ErtsLink **list, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg); /** @@ -1963,9 +1976,10 @@ void erts_link_list_foreach_delete(ErtsLink **list, * @brief Delete all links from a link list and call a function for * each link * - * The funcion 'func' will be called with a pointer to a link + * The function 'func' will be called with a pointer to a link * as first argument and 'arg' as second argument for each link - * in the tree referred to by 'root'. + * in the tree referred to by 'root'. It should return the number of + * reductions the operator took to perform. * * It is assumed that: * - *yspp equals NULL on first call @@ -1988,18 +2002,18 @@ void erts_link_list_foreach_delete(ErtsLink **list, * *yspp should be NULL. When done *yspp * will be NULL. * - * @param[in] limit Maximum amount of links to process - * before yielding. + * @param[in] reds Reductions available to execute before yielding. * - * @returns A non-zero value when all links has been - * processed, and zero when more work is needed. + * @returns The unconsumed reductions when all links + * have been processed, and zero when more work + * is needed. * */ int erts_link_list_foreach_delete_yielding(ErtsLink **list, - void (*func)(ErtsLink *, void *), + ErtsLinkFunc func, void *arg, void **vyspp, - Sint limit); + Sint reds); /* * --- Misc link operations --- @@ -2011,7 +2025,7 @@ int erts_link_list_foreach_delete_yielding(ErtsLink **list, * * Can create all types of links * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'ref' is an internal ordinary reference if type is ERTS_MON_TYPE_PROC, * ERTS_MON_TYPE_PORT, ERTS_MON_TYPE_TIME_OFFSET, or ERTS_MON_TYPE_RESOURCE * - 'ref' is NIL if type is ERTS_MON_TYPE_NODE or ERTS_MON_TYPE_NODES @@ -2081,7 +2095,7 @@ ERTS_GLB_INLINE int erts_link_is_in_table(ErtsLink *lnk); * When both link halves part of the link have been released the link * structure will be deallocated. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' link is not part of any list or tree * - 'lnk' is not referred to by any other structures * If the above are not true, bad things will happen. @@ -2098,7 +2112,7 @@ ERTS_GLB_INLINE void erts_link_release(ErtsLink *lnk); * Release both halves of a link simultaneously and deallocate * the structure. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - Neither of the parts of the link are part of any list or tree * - Neither of the parts of the link or the link data structure * are referred to by any other structures @@ -2113,7 +2127,7 @@ ERTS_GLB_INLINE void erts_link_release_both(ErtsLinkData *ldp); * * @brief Insert link in dist link list * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' link is not part of any list or tree * If the above is not true, bad things will happen. * @@ -2134,7 +2148,7 @@ ERTS_GLB_INLINE int erts_link_dist_insert(ErtsLink *lnk, ErtsMonLnkDist *dist); * * @brief Delete link from dist link list * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' link earler has been inserted into 'dist' * If the above is not true, bad things will happen. * @@ -2172,7 +2186,7 @@ erts_link_set_dead_dist(ErtsLink *lnk, Eterm nodename); * whole size of the link data structure is returned; otherwise, * half of the size is returned. * - * When the funcion is called it is assumed that: + * When the function is called it is assumed that: * - 'lnk' has not been released * If the above is not true, bad things will happen. * diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 0efef37802..349d9bf13a 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -2368,12 +2368,13 @@ rmon_refc_read(ErtsResourceMonitors *rms) return rms->refc & ERTS_RESOURCE_REFC_MASK; } -static void dtor_demonitor(ErtsMonitor* mon, void* context) +static int dtor_demonitor(ErtsMonitor* mon, void* context, Sint reds) { ASSERT(erts_monitor_is_origin(mon)); ASSERT(is_internal_pid(mon->other.item)); erts_proc_sig_send_demonitor(mon); + return 1; } #ifdef DEBUG @@ -2723,8 +2724,12 @@ int enif_consume_timeslice(ErlNifEnv* env, int percent) { Process *proc; Sint reds; + int sched; - execution_state(env, &proc, NULL); + execution_state(env, &proc, &sched); + + if (sched < 0) + return 0; /* no-op on dirty scheduler */ ASSERT(is_proc_bound(env) && percent >= 1 && percent <= 100); if (percent < 1) percent = 1; diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 18ed782ae3..afafaf48dc 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -201,6 +201,7 @@ dist_table_alloc(void *dep_tmpl) dep->send = NULL; dep->cache = NULL; dep->transcode_ctx = NULL; + dep->sequences = NULL; /* Link in */ @@ -801,8 +802,9 @@ node_table_hash(void *venp) static int node_table_cmp(void *venp1, void *venp2) { - return ((((ErlNode *) venp1)->sysname == ((ErlNode *) venp2)->sysname - && ((ErlNode *) venp1)->creation == ((ErlNode *) venp2)->creation) + return ((((ErlNode *) venp1)->sysname == ((ErlNode *) venp2)->sysname) && + ((((ErlNode *) venp1)->creation == ((ErlNode *) venp2)->creation) || + (((ErlNode *) venp1)->creation == 0 || ((ErlNode *) venp2)->creation == 0)) ? 0 : 1); } @@ -816,11 +818,16 @@ node_table_alloc(void *venp_tmpl) node_entries++; - erts_refc_init(&enp->refc, -1); + erts_init_node_entry(enp, -1); enp->creation = ((ErlNode *) venp_tmpl)->creation; enp->sysname = ((ErlNode *) venp_tmpl)->sysname; enp->dist_entry = erts_find_or_insert_dist_entry(((ErlNode *) venp_tmpl)->sysname); +#ifdef ERL_NODE_BOOKKEEP + erts_atomic_init_nob(&enp->slot, 0); + sys_memzero(enp->books, sizeof(struct erl_node_bookkeeping) * 1024); +#endif + return (void *) enp; } @@ -873,7 +880,7 @@ erts_node_table_info(fmtfn_t to, void *to_arg) } -ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation) +ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation, Eterm book) { ErlNode *res; ErlNode ne; @@ -883,9 +890,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation) erts_rwmtx_rlock(&erts_node_table_rwmtx); res = hash_get(&erts_node_table, (void *) &ne); if (res && res != erts_this_node) { - erts_aint_t refc = erts_refc_inctest(&res->refc, 0); + erts_aint_t refc = erts_ref_node_entry(res, 0, book); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + erts_ref_node_entry(res, 1, THE_NON_VALUE); } erts_rwmtx_runlock(&erts_node_table_rwmtx); if (res) @@ -895,9 +902,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation) res = hash_put(&erts_node_table, (void *) &ne); ASSERT(res); if (res != erts_this_node) { - erts_aint_t refc = erts_refc_inctest(&res->refc, 0); + erts_aint_t refc = erts_ref_node_entry(res, 0, book); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + erts_ref_node_entry(res, 1, THE_NON_VALUE); } erts_rwmtx_rwunlock(&erts_node_table_rwmtx); return res; @@ -924,6 +931,7 @@ static void try_delete_node(void *venp) * * If refc > 0, the entry is in use. Keep the entry. */ + erts_node_bookkeep(enp, THE_NON_VALUE, ERL_NODE_DEC); refc = erts_refc_dectest(&enp->refc, -1); if (refc == -1) (void) hash_erase(&erts_node_table, (void *) enp); @@ -1021,7 +1029,7 @@ erts_set_this_node(Eterm sysname, Uint creation) erts_deref_dist_entry(erts_this_dist_entry); erts_this_node = NULL; /* to make sure refc is bumped for this node */ - erts_this_node = erts_find_or_insert_node(sysname, creation); + erts_this_node = erts_find_or_insert_node(sysname, creation, THE_NON_VALUE); erts_this_dist_entry = erts_this_node->dist_entry; erts_ref_dist_entry(erts_this_dist_entry); @@ -1090,7 +1098,7 @@ void erts_init_node_tables(int dd_sec) node_tmpl.creation = 0; erts_this_node = hash_put(&erts_node_table, &node_tmpl); /* +1 for erts_this_node */ - erts_refc_init(&erts_this_node->refc, 1); + erts_init_node_entry(erts_this_node, 1); ASSERT(erts_this_node->dist_entry != NULL); erts_this_dist_entry = erts_this_node->dist_entry; @@ -1177,6 +1185,7 @@ static Eterm AM_system; static Eterm AM_timer; static Eterm AM_delayed_delete_timer; static Eterm AM_thread_progress_delete_timer; +static Eterm AM_sequence; static Eterm AM_signal; static void setup_reference_table(void); @@ -1218,6 +1227,7 @@ typedef struct dist_referrer_ { int ctrl_ref; int system_ref; int signal_ref; + int sequence_ref; Eterm id; Uint creation; Uint id_heap[ID_HEAP_SIZE]; @@ -1272,6 +1282,7 @@ erts_get_node_and_dist_references(struct process *proc) INIT_AM(delayed_delete_timer); INIT_AM(thread_progress_delete_timer); INIT_AM(signal); + INIT_AM(sequence); references_atoms_need_init = 0; } @@ -1309,8 +1320,9 @@ erts_get_node_and_dist_references(struct process *proc) #define TIMER_REF 8 #define SYSTEM_REF 9 #define SIGNAL_REF 10 +#define SEQUENCE_REF 11 -#define INC_TAB_SZ 10 +#define INC_TAB_SZ 11 static void insert_dist_referrer(ReferredDist *referred_dist, @@ -1344,6 +1356,7 @@ insert_dist_referrer(ReferredDist *referred_dist, drp->ctrl_ref = 0; drp->system_ref = 0; drp->signal_ref = 0; + drp->sequence_ref = 0; } switch (type) { @@ -1353,6 +1366,7 @@ insert_dist_referrer(ReferredDist *referred_dist, case ETS_REF: drp->ets_ref++; break; case SYSTEM_REF: drp->system_ref++; break; case SIGNAL_REF: drp->signal_ref++; break; + case SEQUENCE_REF: drp->sequence_ref++; break; default: ASSERT(0); } } @@ -1509,7 +1523,7 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) } } else if (IsSendCtxBinary(u.mref->mb)) { - ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(u.mref->mb); + ErtsDSigSendContext* ctx = ERTS_MAGIC_BIN_DATA(u.mref->mb); if (ctx->deref_dep) insert_dist_entry(ctx->dep, type, id, 0); } @@ -1544,16 +1558,18 @@ static void insert_monitor_data(ErtsMonitor *mon, int type, Eterm id) mdp->origin.flags |= ERTS_ML_FLG_DBG_VISITED; } -static void insert_monitor(ErtsMonitor *mon, void *idp) +static int insert_monitor(ErtsMonitor *mon, void *idp, Sint reds) { Eterm id = *((Eterm *) idp); insert_monitor_data(mon, MONITOR_REF, id); + return 1; } -static void clear_visited_monitor(ErtsMonitor *mon, void *p) +static int clear_visited_monitor(ErtsMonitor *mon, void *p, Sint reds) { ErtsMonitorData *mdp = erts_monitor_to_data(mon); mdp->origin.flags &= ~ERTS_ML_FLG_DBG_VISITED; + return 1; } static void @@ -1581,6 +1597,20 @@ insert_dist_monitors(DistEntry *dep) } } + +static int +insert_sequence(ErtsDistExternal *edep, void *arg, Sint reds) +{ + insert_dist_entry(edep->dep, SEQUENCE_REF, *(Eterm*)arg, 0); + return 1; +} + +static void +insert_dist_sequences(DistEntry *dep) +{ + erts_dist_seq_tree_foreach(dep, insert_sequence, (void *) &dep->sysname); +} + static void clear_visited_p_monitors(ErtsPTabElementCommon *p) { @@ -1621,16 +1651,18 @@ static void insert_link_data(ErtsLink *lnk, int type, Eterm id) ldp->a.flags |= ERTS_ML_FLG_DBG_VISITED; } -static void insert_link(ErtsLink *lnk, void *idp) +static int insert_link(ErtsLink *lnk, void *idp, Sint reds) { Eterm id = *((Eterm *) idp); insert_link_data(lnk, LINK_REF, id); + return 1; } -static void clear_visited_link(ErtsLink *lnk, void *p) +static int clear_visited_link(ErtsLink *lnk, void *p, Sint reds) { ErtsLinkData *ldp = erts_link_to_data(lnk); ldp->a.flags &= ~ERTS_ML_FLG_DBG_VISITED; + return 1; } static void @@ -1770,11 +1802,9 @@ insert_message(ErtsMessage *msg, int type, Process *proc) else if (ERTS_SIG_IS_INTERNAL_MSG(msg)) heap_frag = msg->data.heap_frag; else { - if (msg->data.dist_ext->dep) - insert_dist_entry(msg->data.dist_ext->dep, - type, proc->common.id, 0); - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + heap_frag = msg->data.heap_frag; + insert_dist_entry(erts_get_dist_ext(heap_frag)->dep, + type, proc->common.id, 0); } } while (heap_frag) { @@ -1798,24 +1828,115 @@ insert_sig_offheap(ErlOffHeap *ohp, void *arg) insert_offheap(ohp, SIGNAL_REF, proc->common.id); } -static void -insert_sig_monitor(ErtsMonitor *mon, void *arg) +static int +insert_sig_monitor(ErtsMonitor *mon, void *arg, Sint reds) { Process *proc = arg; insert_monitor_data(mon, SIGNAL_REF, proc->common.id); + return 1; } -static void -insert_sig_link(ErtsLink *lnk, void *arg) +static int +insert_sig_link(ErtsLink *lnk, void *arg, Sint reds) { Process *proc = arg; insert_link_data(lnk, SIGNAL_REF, proc->common.id); + return 1; } static void -setup_reference_table(void) +insert_sig_ext(ErtsDistExternal *edep, void *arg) { + Process *proc = arg; + insert_dist_entry(edep->dep, SIGNAL_REF, proc->common.id, 0); +} + +static void +insert_process(Process *proc) +{ + int mli; + ErtsMessage *msg_list[] = {proc->msg_frag}; ErlHeapFragment *hfp; + + /* Insert Heap */ + insert_offheap(&(proc->off_heap), + HEAP_REF, + proc->common.id); + /* Insert heap fragments buffers */ + for(hfp = proc->mbuf; hfp; hfp = hfp->next) + insert_offheap(&(hfp->off_heap), + HEAP_REF, + proc->common.id); + + /* Insert msg buffers */ + for (mli = 0; mli < sizeof(msg_list)/sizeof(msg_list[0]); mli++) { + ErtsMessage *msg; + for (msg = msg_list[mli]; msg; msg = msg->next) + insert_message(msg, HEAP_REF, proc); + } + + /* Insert signal queue */ + erts_proc_sig_debug_foreach_sig(proc, + insert_sig_msg, + insert_sig_offheap, + insert_sig_monitor, + insert_sig_link, + insert_sig_ext, + (void *) proc); + + /* If the process is FREE, the proc->common field has been + re-used by the ptab delete, so we cannot trust it. */ + if (!(erts_atomic32_read_nob(&proc->state) & ERTS_PSFLG_FREE)) { + /* Insert links */ + insert_p_links(&proc->common); + + /* Insert monitors */ + insert_p_monitors(&proc->common); + } + + { + DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(proc); + if (dep) + insert_dist_entry(dep, + CTRL_REF, + proc->common.id, + 0); + } +} + +static void +insert_dist_suspended_procs(DistEntry *dep) +{ + ErtsProcList *plist = erts_proclist_peek_first(dep->suspended); + while (plist) { + if (is_not_immed(plist->u.pid)) + insert_process(plist->u.p); + plist = erts_proclist_peek_next(dep->suspended, plist); + } +} + +#ifdef ERL_NODE_BOOKKEEP +void +erts_node_bookkeep(ErlNode *np, Eterm term, int what) +{ + erts_aint_t slot = (erts_atomic_inc_read_nob(&np->slot) - 1) % 1024; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + Eterm who = THE_NON_VALUE; + ASSERT(np); + np->books[slot].what = what; + np->books[slot].term = term; + if (esdp->current_process) { + who = esdp->current_process->common.id; + } else if (esdp->current_port) { + who = esdp->current_port->common.id; + } + np->books[slot].who = who; +} +#endif + +static void +setup_reference_table(void) +{ DistEntry *dep; HashInfo hi; int i, max; @@ -1865,52 +1986,10 @@ setup_reference_table(void) /* Insert all processes */ for (i = 0; i < max; i++) { Process *proc = erts_pix2proc(i); - if (proc) { - int mli; - ErtsMessage *msg_list[] = {proc->msg_frag}; - - /* Insert Heap */ - insert_offheap(&(proc->off_heap), - HEAP_REF, - proc->common.id); - /* Insert heap fragments buffers */ - for(hfp = proc->mbuf; hfp; hfp = hfp->next) - insert_offheap(&(hfp->off_heap), - HEAP_REF, - proc->common.id); - - /* Insert msg buffers */ - for (mli = 0; mli < sizeof(msg_list)/sizeof(msg_list[0]); mli++) { - ErtsMessage *msg; - for (msg = msg_list[mli]; msg; msg = msg->next) - insert_message(msg, HEAP_REF, proc); - } - - /* Insert signal queue */ - erts_proc_sig_debug_foreach_sig(proc, - insert_sig_msg, - insert_sig_offheap, - insert_sig_monitor, - insert_sig_link, - (void *) proc); - - /* Insert links */ - insert_p_links(&proc->common); - - /* Insert monitors */ - insert_p_monitors(&proc->common); - - { - DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(proc); - if (dep) - insert_dist_entry(dep, - CTRL_REF, - proc->common.id, - 0); - } - } + if (proc) + insert_process(proc); } - + erts_foreach_sys_msg_in_q(insert_sys_msg); /* Insert all ports */ @@ -1983,16 +2062,22 @@ setup_reference_table(void) for(dep = erts_visible_dist_entries; dep; dep = dep->next) { insert_dist_links(dep); insert_dist_monitors(dep); + insert_dist_sequences(dep); + insert_dist_suspended_procs(dep); } for(dep = erts_hidden_dist_entries; dep; dep = dep->next) { insert_dist_links(dep); insert_dist_monitors(dep); + insert_dist_sequences(dep); + insert_dist_suspended_procs(dep); } for(dep = erts_pending_dist_entries; dep; dep = dep->next) { insert_dist_links(dep); insert_dist_monitors(dep); + insert_dist_sequences(dep); + insert_dist_suspended_procs(dep); } /* Not connected dist entries should not have any links, @@ -2000,6 +2085,8 @@ setup_reference_table(void) for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) { insert_dist_links(dep); insert_dist_monitors(dep); + insert_dist_sequences(dep); + insert_dist_suspended_procs(dep); } /* Insert all ets tables */ @@ -2173,6 +2260,10 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp) tup = MK_2TUP(AM_system, MK_UINT(drp->system_ref)); drl = MK_CONS(tup, drl); } + if(drp->sequence_ref) { + tup = MK_2TUP(AM_sequence, MK_UINT(drp->sequence_ref)); + drl = MK_CONS(tup, drl); + } if(drp->signal_ref) { tup = MK_2TUP(AM_signal, MK_UINT(drp->signal_ref)); drl = MK_CONS(tup, drl); @@ -2247,6 +2338,12 @@ static void noop_sig_offheap(ErlOffHeap *oh, void *arg) } +static void noop_sig_ext(ErtsDistExternal *ext, void *arg) +{ + +} + + static void delete_reference_table(void) { @@ -2297,6 +2394,7 @@ delete_reference_table(void) noop_sig_offheap, clear_visited_monitor, clear_visited_link, + noop_sig_ext, (void *) proc); } } diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index c44f1f8991..d5daf0c2df 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -98,11 +98,22 @@ struct ErtsDistOutputBuf_ { byte *alloc_endp; #endif ErtsDistOutputBuf *next; - Uint hopefull_flags; + Binary *bin; + /* Pointers to the distribution header, + if NULL the distr header is in the extp */ + byte *hdrp; + byte *hdr_endp; + /* Pointers to the ctl + payload */ byte *extp; byte *ext_endp; + /* Start of payload and hopefull_flags, used by transcode */ + Uint hopefull_flags; byte *msg_start; - byte data[1]; + /* start of the ext buffer, this is not always the same as extp + as the atom cache handling can use less then the allotted buffer. + This value is needed to calculate the size of this output buffer.*/ + byte *ext_start; + }; typedef struct { @@ -161,7 +172,46 @@ struct dist_entry_ { ErtsThrPrgrLaterOp later_op; struct transcode_context* transcode_ctx; + + struct dist_sequences *sequences; /* Ongoing distribution sequences */ +}; + +/* +#define ERL_NODE_BOOKKEEP + * Bookkeeping of ErlNode inc and dec operations to help debug refc problems. + * This is best used together with cerl -rr. Type the below into gdb: + * gdb: +set pagination off +set $i = 0 +set $node = referred_nodes[$node_ix].node +while $i < $node->slot.counter + printf "%p: ", $node->books[$i].term + etp-1 $node->books[$i].who + printf " " + p $node->books[$i].what + set $i++ +end + + * Then save that into a file called test.txt and run the below in + * an erlang shell in order to get all inc/dec that do not have a + * match. + +f(), {ok, B} = file:read_file("test.txt"). +Vs = [begin [Val, _, _, _, What] = All = string:lexemes(Ln, " "),{Val,What,All} end || Ln <- string:lexemes(B,"\n")]. +Accs = lists:foldl(fun({V,<<"ERL_NODE_INC">>,_},M) -> Val = maps:get(V,M,0), M#{ V => Val + 1 }; ({V,<<"ERL_NODE_DEC">>,_},M) -> Val = maps:get(V,M,0), M#{ V => Val - 1 } end, #{}, Vs). +lists:usort(lists:filter(fun({V,N}) -> N /= 0 end, maps:to_list(Accs))). + + * There are bound to be bugs in the the instrumentation code, but + * atleast this is a place to start when hunting refc bugs. + * + */ +#ifdef ERL_NODE_BOOKKEEP +struct erl_node_bookkeeping { + Eterm who; + Eterm term; + enum { ERL_NODE_INC, ERL_NODE_DEC } what; }; +#endif typedef struct erl_node_ { HashBucket hash_bucket; /* Hash bucket */ @@ -169,6 +219,10 @@ typedef struct erl_node_ { Eterm sysname; /* name@host atom for efficiency */ Uint32 creation; /* Creation */ DistEntry *dist_entry; /* Corresponding dist entry */ +#ifdef ERL_NODE_BOOKKEEP + struct erl_node_bookkeeping books[1024]; + erts_atomic_t slot; +#endif } ErlNode; @@ -201,7 +255,7 @@ void erts_dist_table_info(fmtfn_t, void *); void erts_set_dist_entry_not_connected(DistEntry *); void erts_set_dist_entry_pending(DistEntry *); void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint); -ErlNode *erts_find_or_insert_node(Eterm, Uint32); +ErlNode *erts_find_or_insert_node(Eterm, Uint32, Eterm); void erts_schedule_delete_node(ErlNode *); void erts_set_this_node(Eterm, Uint); Uint erts_node_table_size(void); @@ -219,18 +273,38 @@ DistEntry *erts_dhandle_to_dist_entry(Eterm dhandle, Uint32* connection_id); Eterm erts_build_dhandle(Eterm **hpp, ErlOffHeap*, DistEntry*, Uint32 conn_id); Eterm erts_make_dhandle(Process *c_p, DistEntry*, Uint32 conn_id); -ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np); +ERTS_GLB_INLINE void erts_init_node_entry(ErlNode *np, erts_aint_t val); +ERTS_GLB_INLINE erts_aint_t erts_ref_node_entry(ErlNode *np, int min_val, Eterm term); +ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np, Eterm term); ERTS_GLB_INLINE void erts_de_rlock(DistEntry *dep); ERTS_GLB_INLINE void erts_de_runlock(DistEntry *dep); ERTS_GLB_INLINE void erts_de_rwlock(DistEntry *dep); ERTS_GLB_INLINE void erts_de_rwunlock(DistEntry *dep); +#ifdef ERL_NODE_BOOKKEEP +void erts_node_bookkeep(ErlNode *, Eterm , int); +#else +#define erts_node_bookkeep(...) +#endif #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void -erts_deref_node_entry(ErlNode *np) +erts_init_node_entry(ErlNode *np, erts_aint_t val) +{ + erts_refc_init(&np->refc, val); +} + +ERTS_GLB_INLINE erts_aint_t +erts_ref_node_entry(ErlNode *np, int min_val, Eterm term) +{ + erts_node_bookkeep(np, term, ERL_NODE_INC); + return erts_refc_inctest(&np->refc, min_val); +} + +ERTS_GLB_INLINE void +erts_deref_node_entry(ErlNode *np, Eterm term) { - ASSERT(np); + erts_node_bookkeep(np, term, ERL_NODE_DEC); if (erts_refc_dectest(&np->refc, 0) == 0) erts_schedule_delete_node(np); } diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index c8f2e88127..30a7875387 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -2094,7 +2094,7 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", pp->common.id); while (plp2 != NULL) { - erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->pid); + erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->u.pid); DTRACE2(process_port_unblocked, pid_str, port_str); } } diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 9cfb7fc681..2e33a8a782 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -487,6 +487,8 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet); ++bytep; --bytesize; + if ((*dcount)-- <= 0) + goto L_done; } if (bitsize) { Uint bits = bitoffs + bitsize; @@ -521,6 +523,8 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { PRINT_CHAR(res, fn, arg, octet); ++bytep; --bytesize; + if ((*dcount)-- <= 0) + goto L_done; } PRINT_STRING(res, fn, arg, "\">>"); } diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index 18418a76e1..9c74a2c355 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -36,6 +36,7 @@ #include "erl_port_task.h" #include "erl_trace.h" #include "beam_bp.h" +#include "erl_binary.h" #include "big.h" #include "erl_gc.h" #include "bif.h" @@ -80,6 +81,11 @@ #define ERTS_SIG_Q_TYPE_ADJUST_TRACE_INFO \ ERTS_SIG_Q_TYPE_MAX +#define ERTS_SIG_IS_GEN_EXIT(sig) \ + (ERTS_PROC_SIG_TYPE(((ErtsSignal *) sig)->common.tag) == ERTS_SIG_Q_TYPE_GEN_EXIT) +#define ERTS_SIG_IS_GEN_EXIT_EXTERNAL(sig) \ + (ASSERT(ERTS_SIG_IS_GEN_EXIT(sig)),is_non_value(get_exit_signal_data(sig)->reason)) + Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler); Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_high); Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_max); @@ -259,7 +265,7 @@ destroy_dist_proc_demonitor(ErtsSigDistProcDemonitor *dmon) Eterm ref = dmon->ref; if (is_external(ref)) { ExternalThing *etp = external_thing_ptr(ref); - erts_deref_node_entry(etp->node); + erts_deref_node_entry(etp->node, ref); } erts_free(ERTS_ALC_T_DIST_DEMONITOR, dmon); } @@ -294,7 +300,8 @@ destroy_sig_dist_link_op(ErtsSigDistLinkOp *sdlnk) { ASSERT(is_external_pid(sdlnk->remote)); ASSERT(boxed_val(sdlnk->remote) == &sdlnk->heap[0]); - erts_deref_node_entry(((ExternalThing *) &sdlnk->heap[0])->node); + erts_deref_node_entry(((ExternalThing *) &sdlnk->heap[0])->node, + make_boxed(&sdlnk->heap[0])); erts_free(ERTS_ALC_T_SIG_DATA, sdlnk); } @@ -936,29 +943,54 @@ erts_proc_sig_privqs_len(Process *c_p) return proc_sig_privqs_len(c_p, 0); } +ErtsDistExternal * +erts_proc_sig_get_external(ErtsMessage *msgp) +{ + if (ERTS_SIG_IS_EXTERNAL_MSG(msgp)) { + return erts_get_dist_ext(msgp->data.heap_frag); + } else if (ERTS_SIG_IS_NON_MSG(msgp) && + ERTS_SIG_IS_GEN_EXIT(msgp) && + ERTS_SIG_IS_GEN_EXIT_EXTERNAL(msgp)) { + ErtsDistExternal *edep; + ErtsExitSignalData *xsigd = get_exit_signal_data(msgp); + ASSERT(ERTS_PROC_SIG_TYPE(((ErtsSignal *) msgp)->common.tag) == ERTS_SIG_Q_TYPE_GEN_EXIT); + ASSERT(is_non_value(xsigd->reason)); + if (msgp->hfrag.next == NULL) + edep = (ErtsDistExternal*)(xsigd + 1); + else + edep = erts_get_dist_ext(msgp->hfrag.next); + return edep; + } + return NULL; +} + static void do_seq_trace_output(Eterm to, Eterm token, Eterm msg); static void send_gen_exit_signal(Process *c_p, Eterm from_tag, Eterm from, Eterm to, - Sint16 op, Eterm reason, Eterm ref, - Eterm token, int normal_kills) + Sint16 op, Eterm reason, ErtsDistExternal *dist_ext, + ErlHeapFragment *dist_ext_hfrag, + Eterm ref, Eterm token, int normal_kills) { ErtsExitSignalData *xsigd; Eterm *hp, *start_hp, s_reason, s_ref, s_message, s_token, s_from; ErtsMessage *mp; ErlHeapFragment *hfrag; ErlOffHeap *ohp; - Uint hsz, from_sz, reason_sz, ref_sz, token_sz; + Uint hsz, from_sz, reason_sz, ref_sz, token_sz, dist_ext_sz; int seq_trace; #ifdef USE_VM_PROBES Eterm s_utag, utag; Uint utag_sz; #endif + ASSERT((is_value(reason) && dist_ext == NULL) || + (is_non_value(reason) && dist_ext != NULL)); + ASSERT(is_immed(from_tag)); - hsz = sizeof(ErtsExitSignalData)/sizeof(Uint); + hsz = sizeof(ErtsExitSignalData)/sizeof(Eterm); seq_trace = c_p && have_seqtrace(token); if (seq_trace) @@ -977,33 +1009,42 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag, hsz += utag_sz; #endif - token_sz = is_immed(token) ? 0 : size_object(token); + token_sz = size_object(token); hsz += token_sz; - from_sz = is_immed(from) ? 0 : size_object(from); + from_sz = size_object(from); hsz += from_sz; - reason_sz = is_immed(reason) ? 0 : size_object(reason); - hsz += reason_sz; + ref_sz = size_object(ref); + hsz += ref_sz; - switch (op) { - case ERTS_SIG_Q_OP_EXIT: - case ERTS_SIG_Q_OP_EXIT_LINKED: { - /* {'EXIT', From, Reason} */ - hsz += 4; /* 3-tuple */ - ref_sz = 0; - break; - } - case ERTS_SIG_Q_OP_MONITOR_DOWN: { - /* {'DOWN', Ref, process, From, Reason} */ - hsz += 6; /* 5-tuple */ - ref_sz = NC_HEAP_SIZE(ref); - hsz += ref_sz; - break; - } - default: - ERTS_INTERNAL_ERROR("Invalid exit signal op"); - break; + /* The reason was part of the control message, + just use copy it into the xsigd */ + if (is_value(reason)) { + reason_sz = size_object(reason); + hsz += reason_sz; + + switch (op) { + case ERTS_SIG_Q_OP_EXIT: + case ERTS_SIG_Q_OP_EXIT_LINKED: { + /* {'EXIT', From, Reason} */ + hsz += 4; /* 3-tuple */ + break; + } + case ERTS_SIG_Q_OP_MONITOR_DOWN: { + /* {'DOWN', Ref, process, From, Reason} */ + hsz += 6; /* 5-tuple */ + break; + } + default: + ERTS_INTERNAL_ERROR("Invalid exit signal op"); + break; + } + } else if (dist_ext != NULL && dist_ext_hfrag == NULL) { + /* The message was not fragmented so we need to create space + for a single dist_ext element */ + dist_ext_sz = erts_dist_ext_size(dist_ext) / sizeof(Eterm); + hsz += dist_ext_sz; } /* @@ -1015,35 +1056,33 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag, ohp = &hfrag->off_heap; start_hp = hp; - s_token = (is_immed(token) - ? token - : copy_struct(token, token_sz, &hp, ohp)); - - s_reason = (is_immed(reason) - ? reason - : copy_struct(reason, reason_sz, &hp, ohp)); + s_token = copy_struct(token, token_sz, &hp, ohp); + s_from = copy_struct(from, from_sz, &hp, ohp); + s_ref = copy_struct(ref, ref_sz, &hp, ohp); - s_from = (is_immed(from) - ? from - : copy_struct(from, from_sz, &hp, ohp)); + if (is_value(reason)) { + s_reason = copy_struct(reason, reason_sz, &hp, ohp); - if (!ref_sz) - s_ref = NIL; - else - s_ref = STORE_NC(&hp, ohp, ref); - - switch (op) { - case ERTS_SIG_Q_OP_EXIT: - case ERTS_SIG_Q_OP_EXIT_LINKED: - /* {'EXIT', From, Reason} */ - s_message = TUPLE3(hp, am_EXIT, s_from, s_reason); - hp += 4; - break; - case ERTS_SIG_Q_OP_MONITOR_DOWN: - /* {'DOWN', Ref, process, From, Reason} */ - s_message = TUPLE5(hp, am_DOWN, s_ref, am_process, s_from, s_reason); - hp += 6; - break; + switch (op) { + case ERTS_SIG_Q_OP_EXIT: + case ERTS_SIG_Q_OP_EXIT_LINKED: + /* {'EXIT', From, Reason} */ + s_message = TUPLE3(hp, am_EXIT, s_from, s_reason); + hp += 4; + break; + case ERTS_SIG_Q_OP_MONITOR_DOWN: + /* {'DOWN', Ref, process, From, Reason} */ + s_message = TUPLE5(hp, am_DOWN, s_ref, am_process, s_from, s_reason); + hp += 6; + break; + default: + /* This cannot happen, used to silence gcc warning */ + s_message = THE_NON_VALUE; + break; + } + } else { + s_message = THE_NON_VALUE; + s_reason = THE_NON_VALUE; } #ifdef USE_VM_PROBES @@ -1061,11 +1100,13 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag, hfrag->used_size = hp - start_hp; - xsigd = (ErtsExitSignalData *) (char *) hp; + xsigd = (ErtsExitSignalData *) hp; xsigd->message = s_message; xsigd->from = s_from; xsigd->reason = s_reason; + hfrag->next = dist_ext_hfrag; + if (is_nil(s_ref)) xsigd->u.normal_kills = normal_kills; else { @@ -1073,6 +1114,15 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag, xsigd->u.ref = s_ref; } + hp += sizeof(ErtsExitSignalData)/sizeof(Eterm); + + if (dist_ext != NULL && dist_ext_hfrag == NULL && is_non_value(reason)) { + erts_make_dist_ext_copy(dist_ext, (ErtsDistExternal *) hp); + hp += dist_ext_sz; + } + + ASSERT(hp == mp->hfrag.mem + mp->hfrag.alloc_size); + if (seq_trace) do_seq_trace_output(to, s_token, s_message); @@ -1205,7 +1255,19 @@ erts_proc_sig_send_exit(Process *c_p, Eterm from, Eterm to, from_tag = dep->sysname; } send_gen_exit_signal(c_p, from_tag, from, to, ERTS_SIG_Q_OP_EXIT, - reason, NIL, token, normal_kills); + reason, NULL, NULL, NIL, token, normal_kills); +} + +void +erts_proc_sig_send_dist_exit(DistEntry *dep, + Eterm from, Eterm to, + ErtsDistExternal *dist_ext, + ErlHeapFragment *hfrag, + Eterm reason, Eterm token) +{ + send_gen_exit_signal(NULL, dep->sysname, from, to, ERTS_SIG_Q_OP_EXIT, + reason, dist_ext, hfrag, NIL, token, 0); + } void @@ -1219,7 +1281,7 @@ erts_proc_sig_send_link_exit(Process *c_p, Eterm from, ErtsLink *lnk, if (is_not_immed(reason) || is_not_nil(token)) { ASSERT(is_internal_pid(from) || is_internal_port(from)); send_gen_exit_signal(c_p, from, from, to, ERTS_SIG_Q_OP_EXIT_LINKED, - reason, NIL, token, 0); + reason, NULL, NULL, NIL, token, 0); } else { /* Pass signal using old link structure... */ @@ -1274,10 +1336,13 @@ erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk) void erts_proc_sig_send_dist_link_exit(DistEntry *dep, Eterm from, Eterm to, + ErtsDistExternal *dist_ext, + ErlHeapFragment *hfrag, Eterm reason, Eterm token) { send_gen_exit_signal(NULL, dep->sysname, from, to, ERTS_SIG_Q_OP_EXIT_LINKED, - reason, NIL, token, 0); + reason, dist_ext, hfrag, NIL, token, 0); + } void @@ -1299,16 +1364,18 @@ erts_proc_sig_send_dist_unlink(DistEntry *dep, Eterm from, Eterm to) void erts_proc_sig_send_dist_monitor_down(DistEntry *dep, Eterm ref, Eterm from, Eterm to, + ErtsDistExternal *dist_ext, + ErlHeapFragment *hfrag, Eterm reason) { Eterm monitored, heap[3]; - if (is_atom(from)) + if (is_atom(from)) monitored = TUPLE2(&heap[0], from, dep->sysname); else monitored = from; send_gen_exit_signal(NULL, dep->sysname, monitored, to, ERTS_SIG_Q_OP_MONITOR_DOWN, - reason, ref, NIL, 0); + reason, dist_ext, hfrag, ref, NIL, 0); } void @@ -1376,10 +1443,10 @@ erts_proc_sig_send_monitor_down(ErtsMonitor *mon, Eterm reason) || is_internal_pid(from_tag) || is_atom(from_tag)); monitored = TUPLE2(&heap[0], name, node); - } + } send_gen_exit_signal(NULL, from_tag, monitored, to, ERTS_SIG_Q_OP_MONITOR_DOWN, - reason, mdp->ref, NIL, 0); + reason, NULL, NULL, mdp->ref, NIL, 0); } erts_monitor_release(mon); } @@ -2037,7 +2104,6 @@ handle_exit_signal(Process *c_p, ErtsSigRecvTracing *tracing, if (type == ERTS_SIG_Q_TYPE_GEN_EXIT) { xsigd = get_exit_signal_data(sig); from = xsigd->from; - reason = xsigd->reason; if (op != ERTS_SIG_Q_OP_EXIT_LINKED) ignore = 0; else { @@ -2062,6 +2128,18 @@ handle_exit_signal(Process *c_p, ErtsSigRecvTracing *tracing, } } + /* This GEN_EXIT was received from another node, decode the exit reason */ + if (ERTS_SIG_IS_GEN_EXIT_EXTERNAL(sig)) + erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, sig, 1); + + reason = xsigd->reason; + + if (is_non_value(reason)) { + /* Bad distribution message; remove it from queue... */ + ignore = !0; + destroy = !0; + } + if (!ignore) { if ((op != ERTS_SIG_Q_OP_EXIT || reason != am_kill) @@ -2929,6 +3007,104 @@ handle_sync_suspend(Process *c_p, ErtsMessage *mp) } } +int +erts_proc_sig_decode_dist(Process *proc, ErtsProcLocks proc_locks, + ErtsMessage *msgp, int force_off_heap) +{ + ErtsHeapFactory factory; + ErlHeapFragment *hfrag; + Eterm msg; + Sint need; + ErtsDistExternal *edep; + ErtsExitSignalData *xsigd = NULL; + + edep = erts_proc_sig_get_external(msgp); + if (!ERTS_SIG_IS_EXTERNAL_MSG(msgp)) + xsigd = get_exit_signal_data(msgp); + + if (edep->heap_size >= 0) + need = edep->heap_size; + else { + need = erts_decode_dist_ext_size(edep, 1); + if (need < 0) { + /* bad signal; remove it... */ + return 0; + } + + edep->heap_size = need; + } + + if (ERTS_SIG_IS_NON_MSG(msgp)) { + switch (ERTS_PROC_SIG_OP(ERL_MESSAGE_TERM(msgp))) { + case ERTS_SIG_Q_OP_EXIT: + case ERTS_SIG_Q_OP_EXIT_LINKED: + /* {'EXIT', From, Reason} */ + need += 4; + break; + case ERTS_SIG_Q_OP_MONITOR_DOWN: + /* {'DOWN', Ref, process, From, Reason} */ + need += 6; /* 5-tuple */ + break; + default: + ERTS_INTERNAL_ERROR("Invalid exit signal op"); + break; + } + } + + hfrag = new_message_buffer(need); + erts_factory_heap_frag_init(&factory, hfrag); + + ASSERT(edep->heap_size >= 0); + + msg = erts_decode_dist_ext(&factory, edep, 1); + + if (is_non_value(msg)) { + erts_factory_undo(&factory); + return 0; + } + + if (ERTS_SIG_IS_MSG(msgp)) { + ERL_MESSAGE_TERM(msgp) = msg; + if (msgp->data.heap_frag == &msgp->hfrag) + msgp->data.heap_frag = ERTS_MSG_COMBINED_HFRAG; + } else { + switch (ERTS_PROC_SIG_OP(ERL_MESSAGE_TERM(msgp))) { + case ERTS_SIG_Q_OP_EXIT: + case ERTS_SIG_Q_OP_EXIT_LINKED: + /* {'EXIT', From, Reason} */ + erts_reserve_heap(&factory, 4); + xsigd->message = TUPLE3(factory.hp, am_EXIT, xsigd->from, msg); + factory.hp += 4; + break; + case ERTS_SIG_Q_OP_MONITOR_DOWN: + /* {'DOWN', Ref, process, From, Reason} */ + erts_reserve_heap(&factory, 6); + xsigd->message = TUPLE5(factory.hp, am_DOWN, xsigd->u.ref, am_process, xsigd->from, msg); + factory.hp += 6; + break; + } + xsigd->reason = msg; + } + + erts_free_dist_ext_copy(edep); + + erts_factory_close(&factory); + + hfrag = factory.heap_frags; + while (hfrag->next) + hfrag = hfrag->next; + + if (ERTS_SIG_IS_MSG(msgp) && msgp->data.heap_frag != ERTS_MSG_COMBINED_HFRAG) { + hfrag->next = msgp->data.heap_frag; + msgp->data.heap_frag = factory.heap_frags; + } else { + hfrag->next = msgp->hfrag.next; + msgp->hfrag.next = factory.heap_frags; + } + + return 1; +} + void erts_proc_sig_handle_pending_suspend(Process *c_p) { @@ -3045,7 +3221,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, ASSERT(ERTS_SIG_IS_NON_MSG(sig)); tag = ((ErtsSignal *) sig)->common.tag; - + switch (ERTS_PROC_SIG_OP(tag)) { case ERTS_SIG_Q_OP_EXIT: @@ -3091,6 +3267,12 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, break; case ERTS_SIG_Q_TYPE_GEN_EXIT: xsigd = get_exit_signal_data(sig); + + /* This GEN_EXIT was received from another node, decode the exit reason */ + if (ERTS_SIG_IS_GEN_EXIT_EXTERNAL(sig)) + if (!erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, sig, 1)) + break; /* Decode failed, just remove signal */ + omon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p), xsigd->u.ref); if (omon) { @@ -3590,9 +3772,10 @@ stretch_limit(Process *c_p, ErtsSigRecvTracing *tp, int -erts_proc_sig_handle_exit(Process *c_p, int *redsp) +erts_proc_sig_handle_exit(Process *c_p, Sint *redsp) { - int cnt, limit; + int cnt; + Sint limit; ErtsMessage *sig, ***next_nm_sig; ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0); @@ -3671,9 +3854,9 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp) break; case ERTS_SIG_Q_OP_MONITOR: { - ErtsProcExitContext pectxt = {c_p, am_noproc}; + ErtsProcExitContext pectxt = {c_p, am_noproc, NULL, NULL, NIL}; erts_proc_exit_handle_monitor((ErtsMonitor *) sig, - (void *) &pectxt); + (void *) &pectxt, -1); cnt += 4; break; } @@ -3687,7 +3870,7 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp) case ERTS_SIG_Q_OP_LINK: { ErtsProcExitContext pectxt = {c_p, am_noproc}; - erts_proc_exit_handle_link((ErtsLink *) sig, (void *) &pectxt); + erts_proc_exit_handle_link((ErtsLink *) sig, (void *) &pectxt, -1); break; } @@ -4188,11 +4371,13 @@ handle_msg_tracing(Process *c_p, ErtsSigRecvTracing *tracing, return -1; /* Yield... */ } if (ERTS_SIG_IS_EXTERNAL_MSG(sig)) { - cnt++; - if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, - sig, 0)) { + cnt += 50; /* Decode is expensive... */ + if (!erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, + sig, 0)) { /* Bad dist message; remove it... */ remove_mq_m_sig(c_p, sig, next_sig, next_nm_sig); + sig->next = NULL; + erts_cleanup_messages(sig); sig = *next_sig; continue; } @@ -4264,18 +4449,12 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p, if (ERTS_SIG_IS_EXTERNAL_MSG(mp)) { /* decode it... */ - if (mp->data.attached) - erts_decode_dist_message(rp, rp_locks, mp, !0); - - msg = ERL_MESSAGE_TERM(mp); - - if (is_non_value(msg)) { + if (!erts_proc_sig_decode_dist(rp, rp_locks, mp, !0)) { ErtsMessage *bad_mp = mp; /* * Bad distribution message; remove * it from the queue... */ - ASSERT(!mp->data.attached); ASSERT(*mpp == bad_mp); @@ -4287,6 +4466,8 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p, erts_cleanup_messages(bad_mp); continue; } + + msg = ERL_MESSAGE_TERM(mp); } ASSERT(is_value(msg)); @@ -4445,12 +4626,21 @@ debug_foreach_sig_fake_oh(Eterm term, } +static void +debug_foreach_sig_external(ErtsMessage *msgp, + void (*ext_func)(ErtsDistExternal *, void *), + void *arg) +{ + ext_func(erts_proc_sig_get_external(msgp), arg); +} + void erts_proc_sig_debug_foreach_sig(Process *c_p, void (*msg_func)(ErtsMessage *, void *), void (*oh_func)(ErlOffHeap *, void *), - void (*mon_func)(ErtsMonitor *, void *), - void (*lnk_func)(ErtsLink *, void *), + ErtsMonitorFunc mon_func, + ErtsLinkFunc lnk_func, + void (*ext_func)(ErtsDistExternal *, void *), void *arg) { ErtsMessage *queue[] = {c_p->sig_qs.first, c_p->sig_qs.cont, c_p->sig_inq.first}; @@ -4459,10 +4649,10 @@ erts_proc_sig_debug_foreach_sig(Process *c_p, for (qix = 0; qix < sizeof(queue)/sizeof(queue[0]); qix++) { ErtsMessage *sig; for (sig = queue[qix]; sig; sig = sig->next) { - - if (ERTS_SIG_IS_MSG(sig)) + + if (ERTS_SIG_IS_MSG(sig)) { msg_func(sig, arg); - else { + } else { Eterm tag; Uint16 type; int op; @@ -4481,18 +4671,21 @@ erts_proc_sig_debug_foreach_sig(Process *c_p, case ERTS_SIG_Q_OP_MONITOR_DOWN: switch (type) { case ERTS_SIG_Q_TYPE_GEN_EXIT: - debug_foreach_sig_heap_frags(&sig->hfrag, oh_func, arg); + if (ERTS_SIG_IS_GEN_EXIT_EXTERNAL(sig)) + debug_foreach_sig_external(sig, ext_func, arg); + else + debug_foreach_sig_heap_frags(&sig->hfrag, oh_func, arg); break; case ERTS_LNK_TYPE_PORT: case ERTS_LNK_TYPE_PROC: case ERTS_LNK_TYPE_DIST_PROC: - lnk_func((ErtsLink *) sig, arg); + lnk_func((ErtsLink *) sig, arg, -1); break; case ERTS_MON_TYPE_PORT: case ERTS_MON_TYPE_PROC: case ERTS_MON_TYPE_DIST_PROC: case ERTS_MON_TYPE_NODE: - mon_func((ErtsMonitor *) sig, arg); + mon_func((ErtsMonitor *) sig, arg, -1); break; default: ERTS_INTERNAL_ERROR("Unexpected sig type"); @@ -4513,7 +4706,7 @@ erts_proc_sig_debug_foreach_sig(Process *c_p, /* Fall through... */ case ERTS_SIG_Q_OP_MONITOR: - mon_func((ErtsMonitor *) sig, arg); + mon_func((ErtsMonitor *) sig, arg, -1); break; case ERTS_SIG_Q_OP_UNLINK: @@ -4525,7 +4718,7 @@ erts_proc_sig_debug_foreach_sig(Process *c_p, /* Fall through... */ case ERTS_SIG_Q_OP_LINK: - lnk_func((ErtsLink *) sig, arg); + lnk_func((ErtsLink *) sig, arg, -1); break; case ERTS_SIG_Q_OP_GROUP_LEADER: { diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h index 6b065a7add..2b055e73bc 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.h +++ b/erts/emulator/beam/erl_proc_sig_queue.h @@ -89,6 +89,7 @@ #endif struct erl_mesg; +struct erl_dist_external; typedef struct { struct erl_mesg *next; @@ -212,6 +213,38 @@ erts_proc_sig_send_exit(Process *c_p, Eterm from, Eterm to, /** * + * @brief Send an exit signal to a process. + * + * This function is used instead of erts_proc_sig_send_link_exit() + * when the signal arrives via the distribution and + * therefore no link structure is available. + * + * @param[in] dep Distribution entry of channel + * that the signal arrived on. + * + * @param[in] from Identifier of sender. + * + * @param[in] to Identifier of receiver. + * + * @param[in] dist_ext The exit reason in external term format + * + * @param[in] hfrag Heap frag with trace token and dist_ext + * iff available, otherwise NULL. + * + * @param[in] reason Exit reason. + * + * @param[in] token Seq trace token. + * + */ +void +erts_proc_sig_send_dist_exit(DistEntry *dep, + Eterm from, Eterm to, + ErtsDistExternal *dist_ext, + ErlHeapFragment *hfrag, + Eterm reason, Eterm token); + +/** + * * @brief Send an exit signal due to broken link to a process. * * @@ -282,7 +315,7 @@ erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk); * * This function is used instead of erts_proc_sig_send_link_exit() * when the signal arrives via the distribution and - * no link structure is available. + * therefore no link structure is available. * * @param[in] dep Distribution entry of channel * that the signal arrived on. @@ -291,6 +324,11 @@ erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk); * * @param[in] to Identifier of receiver. * + * @param[in] dist_ext The exit reason in external term format + * + * @param[in] hfrag Heap frag with trace token and dist_ext + * iff available, otherwise NULL. + * * @param[in] reason Exit reason. * * @param[in] token Seq trace token. @@ -299,6 +337,8 @@ erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk); void erts_proc_sig_send_dist_link_exit(struct dist_entry_ *dep, Eterm from, Eterm to, + ErtsDistExternal *dist_ext, + ErlHeapFragment *hfrag, Eterm reason, Eterm token); /** @@ -307,7 +347,7 @@ erts_proc_sig_send_dist_link_exit(struct dist_entry_ *dep, * * This function is used instead of erts_proc_sig_send_unlink() * when the signal arrives via the distribution and - * no link structure is available. + * therefore no link structure is available. * * @param[in] dep Distribution entry of channel * that the signal arrived on. @@ -380,7 +420,7 @@ erts_proc_sig_send_monitor(ErtsMonitor *mon, Eterm to); * * This function is used instead of erts_proc_sig_send_monitor_down() * when the signal arrives via the distribution and - * no link structure is available. + * therefore no monitor structure is available. * * @param[in] dep Pointer to distribution entry * of channel that the signal @@ -392,12 +432,19 @@ erts_proc_sig_send_monitor(ErtsMonitor *mon, Eterm to); * * @param[in] to Identifier of receiver. * + * @param[in] dist_ext The exit reason in external term format + * + * @param[in] hfrag Heap frag with trace token and dist_ext + * iff available, otherwise NULL. + * * @param[in] reason Exit reason. * */ void erts_proc_sig_send_dist_monitor_down(DistEntry *dep, Eterm ref, Eterm from, Eterm to, + ErtsDistExternal *dist_ext, + ErlHeapFragment *hfrag, Eterm reason); /** @@ -740,7 +787,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, * queue. */ int -erts_proc_sig_handle_exit(Process *c_p, int *redsp); +erts_proc_sig_handle_exit(Process *c_p, Sint *redsp); /** * @@ -962,6 +1009,34 @@ void erts_proc_sig_handle_pending_suspend(Process *c_p); /** + * + * @brief Decode the reason term in an external signal + * + * Any distributed signal with a payload only has the control + * message decoded by the dist entry. The final decode of the + * payload is done by the process when it inspects the signal + * by calling this function. + * + * This functions handles both messages and link/monitor exits. + * + * Return true if the decode was successful, false otherwise. + * + * @param[in] c_p Pointer to executing process + * + * @param[in] proc_lock Locks held by process. Should always be MAIN. + * + * @param[in] msgp The signal to decode + * + * @param[in] force_off_heap If the term should be forced to be off-heap + */ +int +erts_proc_sig_decode_dist(Process *proc, ErtsProcLocks proc_locks, + ErtsMessage *msgp, int force_off_heap); + +ErtsDistExternal * +erts_proc_sig_get_external(ErtsMessage *msgp); + +/** * @brief Initialize this functionality */ void erts_proc_sig_queue_init(void); @@ -970,8 +1045,9 @@ void erts_proc_sig_debug_foreach_sig(Process *c_p, void (*msg_func)(ErtsMessage *, void *), void (*oh_func)(ErlOffHeap *, void *), - void (*mon_func)(ErtsMonitor *, void *), - void (*lnk_func)(ErtsLink *, void *), + ErtsMonitorFunc mon_func, + ErtsLinkFunc lnk_func, + void (*ext_func)(ErtsDistExternal *, void *), void *arg); extern Process *erts_dirty_process_signal_handler; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 6419998702..0a099e69bb 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -735,12 +735,6 @@ erts_pre_init_process(void) #endif } -static void -release_process(void *vproc) -{ - erts_proc_dec_refc((Process *) vproc); -} - /* initialize the scheduler */ void erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) @@ -752,7 +746,7 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) erts_ptab_init_table(&erts_proc, ERTS_ALC_T_PROC_TABLE, - release_process, + NULL, (ErtsPTabElementCommon *) &erts_invalid_process.common, proc_tab_size, sizeof(Process), @@ -1476,7 +1470,10 @@ proclist_create(Process *p) { ErtsProcList *plp = proclist_alloc(); ensure_later_proc_interval(p->common.u.alive.started_interval); - plp->pid = p->common.id; + if (erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_FREE) + plp->u.p = p; + else + plp->u.pid = p->common.id; plp->started_interval = p->common.u.alive.started_interval; return plp; } @@ -1485,7 +1482,7 @@ static ERTS_INLINE ErtsProcList * proclist_copy(ErtsProcList *plp0) { ErtsProcList *plp1 = proclist_alloc(); - plp1->pid = plp0->pid; + plp1->u.pid = plp0->u.pid; plp1->started_interval = plp0->started_interval; return plp1; } @@ -1520,7 +1517,10 @@ erts_proclist_dump(fmtfn_t to, void *to_arg, ErtsProcList *plp) ErtsProcList *first = plp; while (plp) { - erts_print(to, to_arg, "%T", plp->pid); + if (is_pid(plp->u.pid)) + erts_print(to, to_arg, "%T", plp->u.pid); + else + erts_print(to, to_arg, "%T", plp->u.p->common.id); plp = plp->next; if (plp == first) break; @@ -6526,8 +6526,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, n &= ~running_flgs; if ((!!(a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS)) - | ((a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE)) - & !(a & ERTS_PSFLG_FREE)) { + | ((a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE))) { enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a); } a = erts_atomic32_cmpxchg_mb(&p->state, n, e); @@ -6562,7 +6561,6 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, else { Process* sched_p; - ASSERT(!(n & ERTS_PSFLG_FREE)); ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS))); @@ -6692,8 +6690,8 @@ change_proc_schedule_state(Process *p, enqueue = ERTS_ENQUEUE_NOT; - if (a & ERTS_PSFLG_FREE) - break; /* We don't want to schedule free processes... */ + if ((a & (ERTS_PSFLG_FREE|ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_FREE) + break; /* If free and not active, do not schedule */ if (clear_state_flags) n &= ~clear_state_flags; @@ -7219,8 +7217,7 @@ schdlr_sspnd_resume_procs(ErtsSchedType sched_type, while (resume->msb.chngrs) { ErtsProcList *plp = resume->msb.chngrs; resume->msb.chngrs = plp->next; - schdlr_sspnd_resume_proc(sched_type, - plp->pid); + schdlr_sspnd_resume_proc(sched_type, plp->u.pid); proclist_destroy(plp); } } @@ -7652,7 +7649,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) else { schdlr_sspnd.changer = am_true; /* change right in transit */ /* resume process that is queued for next change... */ - resume.onln.nxt = plp->pid; + resume.onln.nxt = plp->u.pid; ASSERT(is_internal_pid(resume.onln.nxt)); } } @@ -7872,7 +7869,7 @@ abort_sched_onln_chng_waitq(Process *p) proclist_destroy(plp); plp = erts_proclist_peek_first(schdlr_sspnd.chngq); if (plp) - resume = plp->pid; + resume = plp->u.pid; else schdlr_sspnd.changer = am_false; } @@ -8138,7 +8135,8 @@ done: ErtsSchedSuspendResult erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal, int all) { - int resume_proc, ix, res, have_unlocked_plocks = 0; + ErtsSchedSuspendResult res; + int resume_proc, ix, have_unlocked_plocks = 0; ErtsProcList *plp; ErtsMultiSchedulingBlock *msbp; erts_aint32_t chng_flg; @@ -8371,10 +8369,10 @@ erts_multi_scheduling_blockers(Process *p, int normal) plp1; plp1 = erts_proclist_peek_next(msbp->blckrs, plp1)) { for (plp2 = erts_proclist_peek_first(msbp->blckrs); - plp2->pid != plp1->pid; + plp2->u.pid != plp1->u.pid; plp2 = erts_proclist_peek_next(msbp->blckrs, plp2)); if (plp2 == plp1) { - res = CONS(hp, plp1->pid, res); + res = CONS(hp, plp1->u.pid, res); hp += 2; } /* else: already in result list */ @@ -9043,8 +9041,13 @@ erts_resume_processes(ErtsProcList *list) while (plp) { Process *proc; ErtsProcList *fplp; - ASSERT(is_internal_pid(plp->pid)); - proc = erts_pid2proc(NULL, 0, plp->pid, ERTS_PROC_LOCK_STATUS); + ASSERT(is_internal_pid(plp->u.pid) || is_CP((Eterm)plp->u.p)); + if (is_internal_pid(plp->u.pid)) + proc = erts_pid2proc(NULL, 0, plp->u.pid, ERTS_PROC_LOCK_STATUS); + else { + proc = plp->u.p; + erts_proc_lock(proc, ERTS_PROC_LOCK_STATUS); + } if (proc) { if (erts_proclist_same(plp, proc)) { resume_process(proc, ERTS_PROC_LOCK_STATUS); @@ -9636,7 +9639,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) while (1) { erts_aint32_t exp, new; - int run_process; + int run_process, not_running, exiting_on_normal_sched, + not_suspended, not_exiting_on_dirty_sched; new = exp = state; new &= psflg_band_mask; /* @@ -9645,29 +9649,33 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) * scheduler, and not suspended (and not in a * state where suspend should be ignored). */ - run_process = (((!(state & (ERTS_PSFLG_RUNNING - | ERTS_PSFLG_RUNNING_SYS - | ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS - | ERTS_PSFLG_FREE))) - | (((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)) - ) - & ((state & (ERTS_PSFLG_SUSPENDED - | ERTS_PSFLG_EXITING - | ERTS_PSFLG_FREE - | ERTS_PSFLG_ACTIVE_SYS - | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) - != ERTS_PSFLG_SUSPENDED) - & (!(state & ERTS_PSFLG_EXITING) - | (!!is_normal_sched)) - ); + not_running = !(state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS + | ERTS_PSFLG_FREE)); + exiting_on_normal_sched = + ((state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_ACTIVE + | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING_SYS + | ERTS_PSFLG_EXITING)) + == (ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE)) + & (!!is_normal_sched); + + + not_suspended = ((state & (ERTS_PSFLG_SUSPENDED + | ERTS_PSFLG_EXITING + | ERTS_PSFLG_FREE + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) + != ERTS_PSFLG_SUSPENDED); + + not_exiting_on_dirty_sched = !(state & ERTS_PSFLG_EXITING) | (!!is_normal_sched); + + run_process = (not_running | exiting_on_normal_sched) + & not_suspended + & not_exiting_on_dirty_sched; if (run_process) { if (state & (ERTS_PSFLG_ACTIVE_SYS @@ -9958,7 +9966,7 @@ trace_schedule_in(Process *p, erts_aint32_t state) /* Clear tracer if it has been removed */ if (erts_is_tracer_proc_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common)) { - if (state & ERTS_PSFLG_EXITING) { + if (state & ERTS_PSFLG_EXITING && p->u.terminate) { if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in_exiting); } @@ -9982,12 +9990,9 @@ trace_schedule_out(Process *p, erts_aint32_t state) if (IS_TRACED_FL(p, F_TRACE_CALLS) && !(state & ERTS_PSFLG_FREE)) erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_OUT); - if ((state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) { + if (state & ERTS_PSFLG_EXITING && p->u.terminate) { if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) - trace_sched(p, ERTS_PROC_LOCK_MAIN, - ((state & ERTS_PSFLG_FREE) - ? am_out_exited - : am_out_exiting)); + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out_exiting); } else { if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || @@ -12062,12 +12067,91 @@ erts_set_self_exiting(Process *c_p, Eterm reason) add2runq(enqueue, enq_prio, c_p, state, NULL); } -void -erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt) +static int +erts_proc_exit_handle_dist_monitor(ErtsMonitor *mon, void *vctxt, Sint reds) +{ + ErtsProcExitContext *ctxt = (ErtsProcExitContext *) vctxt; + Process *c_p = ctxt->c_p; + Eterm reason = ctxt->reason; + int code; + ErtsDSigSendContext ctx; + ErtsMonLnkDist *dist; + DistEntry *dep; + Eterm watcher; + ErtsMonitorData *mdp = NULL; + Eterm watched; + + ASSERT(erts_monitor_is_target(mon) && mon->type == ERTS_MON_TYPE_DIST_PROC); + + mdp = erts_monitor_to_data(mon); + + if (mon->flags & ERTS_ML_FLG_NAME) + watched = ((ErtsMonitorDataExtended *) mdp)->u.name; + else + watched = c_p->common.id; + ASSERT(is_internal_pid(watched) || is_atom(watched)); + + watcher = mon->other.item; + ASSERT(is_external_pid(watcher)); + dep = external_pid_dist_entry(watcher); + ASSERT(dep); + dist = ((ErtsMonitorDataExtended *) mdp)->dist; + ASSERT(dist); + + code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, 0, 0, 1); + + ctx.reds = (Sint) (reds * TERM_TO_BINARY_LOOP_FACTOR); + + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + case ERTS_DSIG_PREP_NOT_CONNECTED: + break; + case ERTS_DSIG_PREP_PENDING: + case ERTS_DSIG_PREP_CONNECTED: + if (dist->connection_id != ctx.connection_id) + break; + code = erts_dsig_send_m_exit(&ctx, + watcher, + watched, + mdp->ref, + reason); + switch (code) { + case ERTS_DSIG_SEND_CONTINUE: + erts_set_gc_state(c_p, 0); + ctxt->dist_state = erts_dsend_export_trap_context(c_p, &ctx); + /* fall-through */ + case ERTS_DSIG_SEND_YIELD: + break; + case ERTS_DSIG_SEND_OK: + break; + case ERTS_DSIG_SEND_TOO_LRG: + erts_set_gc_state(c_p, 1); + break; + default: + ASSERT(! "Invalid dsig send exit monitor result"); + break; + } + break; + default: + ASSERT(! "Invalid dsig prep exit monitor result"); + break; + } + if (!erts_monitor_dist_delete(&mdp->origin)) + erts_monitor_release(mon); + else + erts_monitor_release_both(mdp); + return reds - (ctx.reds / TERM_TO_BINARY_LOOP_FACTOR); +} + +int +erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt, Sint reds) { - Process *c_p = ((ErtsProcExitContext *) vctxt)->c_p; - Eterm reason = ((ErtsProcExitContext *) vctxt)->reason; + ErtsProcExitContext *ctxt = (ErtsProcExitContext *) vctxt; + Process *c_p = ctxt->c_p; + Eterm reason = ctxt->reason; ErtsMonitorData *mdp = NULL; + int res = 1; if (erts_monitor_is_target(mon)) { /* We are being watched... */ @@ -12097,43 +12181,48 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt) case ERTS_MON_TYPE_DIST_PROC: { ErtsMonLnkDist *dist; DistEntry *dep; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; int code; Eterm watcher; Eterm watched; - mdp = erts_monitor_to_data(mon); + if (is_immed(reason)) { + mdp = erts_monitor_to_data(mon); - if (mon->flags & ERTS_ML_FLG_NAME) - watched = ((ErtsMonitorDataExtended *) mdp)->u.name; - else - watched = c_p->common.id; - ASSERT(is_internal_pid(watched) || is_atom(watched)); - - watcher = mon->other.item; - ASSERT(is_external_pid(watcher)); - dep = external_pid_dist_entry(watcher); - ASSERT(dep); - dist = ((ErtsMonitorDataExtended *) mdp)->dist; - ASSERT(dist); - code = erts_dsig_prepare(&dsd, dep, NULL, 0, - ERTS_DSP_NO_LOCK, 0, 0); - switch (code) { - case ERTS_DSIG_PREP_CONNECTED: - case ERTS_DSIG_PREP_PENDING: - if (dist->connection_id == dsd.connection_id) { - code = erts_dsig_send_m_exit(&dsd, - watcher, - watched, - mdp->ref, - reason); - ASSERT(code == ERTS_DSIG_SEND_OK); + if (mon->flags & ERTS_ML_FLG_NAME) + watched = ((ErtsMonitorDataExtended *) mdp)->u.name; + else + watched = c_p->common.id; + ASSERT(is_internal_pid(watched) || is_atom(watched)); + + watcher = mon->other.item; + ASSERT(is_external_pid(watcher)); + dep = external_pid_dist_entry(watcher); + ASSERT(dep); + dist = ((ErtsMonitorDataExtended *) mdp)->dist; + ASSERT(dist); + code = erts_dsig_prepare(&ctx, dep, NULL, 0, + ERTS_DSP_NO_LOCK, 1, 1, 0); + switch (code) { + case ERTS_DSIG_PREP_CONNECTED: + case ERTS_DSIG_PREP_PENDING: + if (dist->connection_id == ctx.connection_id) { + code = erts_dsig_send_m_exit(&ctx, + watcher, + watched, + mdp->ref, + reason); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + default: + break; } - default: - break; + if (!erts_monitor_dist_delete(&mdp->origin)) + mdp = NULL; + } else { + erts_monitor_tree_insert(&ctxt->dist_monitors, mon); + return 1; } - if (!erts_monitor_dist_delete(&mdp->origin)) - mdp = NULL; break; } default: @@ -12175,7 +12264,7 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt) case ERTS_MON_TYPE_DIST_PROC: { ErtsMonLnkDist *dist; DistEntry *dep; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; int code; Eterm watched; @@ -12192,17 +12281,16 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt) ASSERT(is_external_pid(watched)); dep = external_pid_dist_entry(watched); } - code = erts_dsig_prepare(&dsd, dep, NULL, 0, - ERTS_DSP_NO_LOCK, 0, 0); + code = erts_dsig_prepare(&ctx, dep, NULL, 0, + ERTS_DSP_NO_LOCK, 1, 1, 0); switch (code) { case ERTS_DSIG_PREP_CONNECTED: case ERTS_DSIG_PREP_PENDING: - if (dist->connection_id == dsd.connection_id) { - code = erts_dsig_send_demonitor(&dsd, + if (dist->connection_id == ctx.connection_id) { + code = erts_dsig_send_demonitor(&ctx, c_p->common.id, watched, - mdp->ref, - 1); + mdp->ref); ASSERT(code == ERTS_DSIG_SEND_OK); } default: @@ -12210,6 +12298,7 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt) } if (!erts_monitor_dist_delete(&mdp->target)) mdp = NULL; + res = 100; break; } default: @@ -12222,11 +12311,84 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt) erts_monitor_release_both(mdp); else if (mon) erts_monitor_release(mon); + return res; } -void -erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt) +static int +erts_proc_exit_handle_dist_link(ErtsLink *lnk, void *vctxt, Sint reds) +{ + ErtsProcExitContext *ctxt = (ErtsProcExitContext *) vctxt; + Process *c_p = ctxt->c_p; + Eterm reason = ctxt->reason; + int code; + ErtsDSigSendContext ctx; + ErtsMonLnkDist *dist; + DistEntry *dep; + ErtsLink *dlnk; + ErtsLinkData *ldp = NULL; + + ASSERT(lnk->type == ERTS_LNK_TYPE_DIST_PROC); + dlnk = erts_link_to_other(lnk, &ldp); + dist = ((ErtsLinkDataExtended *) ldp)->dist; + + ASSERT(is_external_pid(lnk->other.item)); + dep = external_pid_dist_entry(lnk->other.item); + + ASSERT(dep != erts_this_dist_entry); + + if (!erts_link_dist_delete(dlnk)) + ldp = NULL; + + code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN, + ERTS_DSP_NO_LOCK, 0, 0, 0); + + ctx.reds = (Sint) (reds * TERM_TO_BINARY_LOOP_FACTOR); + + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + case ERTS_DSIG_PREP_NOT_CONNECTED: + break; + case ERTS_DSIG_PREP_PENDING: + case ERTS_DSIG_PREP_CONNECTED: + if (dist->connection_id != ctx.connection_id) + break; + code = erts_dsig_send_exit_tt(&ctx, + c_p->common.id, + lnk->other.item, + reason, + SEQ_TRACE_TOKEN(c_p)); + switch (code) { + case ERTS_DSIG_SEND_CONTINUE: + erts_set_gc_state(c_p, 0); + ctxt->dist_state = erts_dsend_export_trap_context(c_p, &ctx); + /* fall-through */ + case ERTS_DSIG_SEND_YIELD: + break; + case ERTS_DSIG_SEND_OK: + break; + case ERTS_DSIG_SEND_TOO_LRG: + erts_set_gc_state(c_p, 1); + break; + default: + ASSERT(! "Invalid dsig send exit monitor result"); + break; + } + break; + default: + ASSERT(! "Invalid dsig prep exit monitor result"); + break; + } + if (ldp) + erts_link_release_both(ldp); + else if (lnk) + erts_link_release(lnk); + return reds - (ctx.reds / TERM_TO_BINARY_LOOP_FACTOR); +} + +int +erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt, Sint reds) { + ErtsProcExitContext *ctxt = (ErtsProcExitContext *) vctxt; Process *c_p = ((ErtsProcExitContext *) vctxt)->c_p; Eterm reason = ((ErtsProcExitContext *) vctxt)->reason; ErtsLinkData *ldp = NULL; @@ -12257,32 +12419,40 @@ erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt) DistEntry *dep; ErtsMonLnkDist *dist; ErtsLink *dlnk; - ErtsDSigData dsd; + ErtsDSigSendContext ctx; int code; - dlnk = erts_link_to_other(lnk, &ldp); - dist = ((ErtsLinkDataExtended *) ldp)->dist; + if (is_immed(reason)) { + dlnk = erts_link_to_other(lnk, &ldp); + dist = ((ErtsLinkDataExtended *) ldp)->dist; - ASSERT(is_external_pid(lnk->other.item)); - dep = external_pid_dist_entry(lnk->other.item); + ASSERT(is_external_pid(lnk->other.item)); + dep = external_pid_dist_entry(lnk->other.item); - ASSERT(dep != erts_this_dist_entry); + ASSERT(dep != erts_this_dist_entry); - if (!erts_link_dist_delete(dlnk)) - ldp = NULL; + if (!erts_link_dist_delete(dlnk)) + ldp = NULL; - code = erts_dsig_prepare(&dsd, dep, c_p, 0, ERTS_DSP_NO_LOCK, 0, 0); - switch (code) { - case ERTS_DSIG_PREP_CONNECTED: - case ERTS_DSIG_PREP_PENDING: - if (dist->connection_id == dsd.connection_id) { - code = erts_dsig_send_exit_tt(&dsd, - c_p->common.id, - lnk->other.item, - reason, - SEQ_TRACE_TOKEN(c_p)); - ASSERT(code == ERTS_DSIG_SEND_OK); + code = erts_dsig_prepare(&ctx, dep, c_p, 0, ERTS_DSP_NO_LOCK, 1, 1, 0); + switch (code) { + case ERTS_DSIG_PREP_CONNECTED: + case ERTS_DSIG_PREP_PENDING: + if (dist->connection_id == ctx.connection_id) { + code = erts_dsig_send_exit_tt(&ctx, + c_p->common.id, + lnk->other.item, + reason, + SEQ_TRACE_TOKEN(c_p)); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + break; + default: + break; } + } else { + erts_link_tree_insert(&ctxt->dist_links, lnk); + return 1; } break; } @@ -12295,6 +12465,7 @@ erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt) erts_link_release_both(ldp); else if (lnk) erts_link_release(lnk); + return 1; } /* this function fishishes a process and propagates exit messages - called @@ -12328,11 +12499,8 @@ erts_do_exit_process(Process* p, Eterm reason) set_self_exiting(p, reason, NULL, NULL, NULL); - if (IS_TRACED(p)) { - if (IS_TRACED_FL(p, F_TRACE_CALLS)) - erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING); - - } + if (IS_TRACED_FL(p, F_TRACE_CALLS)) + erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING); erts_trace_check_exiting(p->common.id); @@ -12347,288 +12515,444 @@ erts_do_exit_process(Process* p, Eterm reason) erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); - if (IS_TRACED_FL(p,F_TRACE_PROCS)) + if (IS_TRACED_FL(p, F_TRACE_PROCS)) trace_proc(p, ERTS_PROC_LOCK_MAIN, p, am_exit, reason); - /* * p->u.initial of this process can *not* be used anymore; * will be overwritten by misc termination data. */ p->u.terminate = NULL; + BUMP_REDS(p, 100); + erts_continue_exit_process(p); } -void -erts_continue_exit_process(Process *p) -{ +enum continue_exit_phase { + ERTS_CONTINUE_EXIT_TIMERS, + ERTS_CONTINUE_EXIT_BLCKD_MSHED, + ERTS_CONTINUE_EXIT_BLCKD_NMSHED, + ERTS_CONTINUE_EXIT_USING_DB, + ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS, + ERTS_CONTINUE_EXIT_FREE, + ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS_AFTER, + ERTS_CONTINUE_EXIT_LINKS, + ERTS_CONTINUE_EXIT_MONITORS, + ERTS_CONTINUE_EXIT_LT_MONITORS, + ERTS_CONTINUE_EXIT_HANDLE_PROC_SIG, + ERTS_CONTINUE_EXIT_DIST_LINKS, + ERTS_CONTINUE_EXIT_DIST_MONITORS, + ERTS_CONTINUE_EXIT_DONE, +}; + +struct continue_exit_state { + enum continue_exit_phase phase; ErtsLink *links; ErtsMonitor *monitors; ErtsMonitor *lt_monitors; + Eterm reason; + ErtsProcExitContext pectxt; + DistEntry *dep; + void *yield_state; +}; + +void +erts_continue_exit_process(Process *p) +{ + struct continue_exit_state static_state, *trap_state = &static_state; ErtsProcLocks curr_locks = ERTS_PROC_LOCK_MAIN; - Eterm reason = p->fvalue; - DistEntry *dep = NULL; erts_aint32_t state; int delay_del_proc = 0; - ErtsProcExitContext pectxt; - + Sint reds = ERTS_BIF_REDS_LEFT(p); #ifdef DEBUG int yield_allowed = 1; #endif + if (p->u.terminate) { + trap_state = p->u.terminate; + } else { + trap_state->phase = ERTS_CONTINUE_EXIT_TIMERS; + trap_state->reason = p->fvalue; + trap_state->dep = NULL; + trap_state->yield_state = NULL; + } + ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p)); ASSERT(ERTS_PROC_IS_EXITING(p)); ASSERT(erts_proc_read_refc(p) > 0); - if (p->bif_timers) { - if (erts_cancel_bif_timers(p, &p->bif_timers, &p->u.terminate)) { - ASSERT(erts_proc_read_refc(p) > 0); - goto yield; - } - ASSERT(erts_proc_read_refc(p) > 0); - p->bif_timers = NULL; - } - - if (p->flags & F_SCHDLR_ONLN_WAITQ) - abort_sched_onln_chng_waitq(p); - - if (p->flags & F_HAVE_BLCKD_MSCHED) { - ErtsSchedSuspendResult ssr; - ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 0, 1); - switch (ssr) { - case ERTS_SCHDLR_SSPND_YIELD_RESTART: - goto yield; - case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED: - case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED: - case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED: - case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED: - case ERTS_SCHDLR_SSPND_DONE: - case ERTS_SCHDLR_SSPND_YIELD_DONE: - p->flags &= ~F_HAVE_BLCKD_MSCHED; - break; - case ERTS_SCHDLR_SSPND_EINVAL: - default: - erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n", - __FILE__, __LINE__, (int) ssr); - } - } - if (p->flags & F_HAVE_BLCKD_NMSCHED) { - ErtsSchedSuspendResult ssr; - ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1, 1); - switch (ssr) { - case ERTS_SCHDLR_SSPND_YIELD_RESTART: - goto yield; - case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED: - case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED: - case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED: - case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED: - case ERTS_SCHDLR_SSPND_DONE: - case ERTS_SCHDLR_SSPND_YIELD_DONE: - p->flags &= ~F_HAVE_BLCKD_MSCHED; - break; - case ERTS_SCHDLR_SSPND_EINVAL: - default: - erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n", - __FILE__, __LINE__, (int) ssr); - } - } +restart: + switch (trap_state->phase) { + case ERTS_CONTINUE_EXIT_TIMERS: + if (p->bif_timers) { + reds = erts_cancel_bif_timers(p, &p->bif_timers, &trap_state->yield_state, reds); + if (reds <= 0) goto yield; + p->bif_timers = NULL; + } - if (p->flags & F_USING_DB) { - if (erts_db_process_exiting(p, ERTS_PROC_LOCK_MAIN)) - goto yield; - p->flags &= ~F_USING_DB; - } + if (p->flags & F_SCHDLR_ONLN_WAITQ) { + abort_sched_onln_chng_waitq(p); + reds -= 100; + } - erts_set_gc_state(p, 1); - state = erts_atomic32_read_acqb(&p->state); - if ((state & ERTS_PSFLG_SYS_TASKS) || p->dirty_sys_tasks) { - if (cleanup_sys_tasks(p, state, CONTEXT_REDS) >= CONTEXT_REDS/2) - goto yield; - } + trap_state->phase = ERTS_CONTINUE_EXIT_BLCKD_MSHED; + if (reds <= 0) goto yield; + case ERTS_CONTINUE_EXIT_BLCKD_MSHED: + + if (p->flags & F_HAVE_BLCKD_MSCHED) { + ErtsSchedSuspendResult ssr; + ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 0, 1); + switch (ssr) { + case ERTS_SCHDLR_SSPND_DONE: + case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED: + case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED: + p->flags &= ~F_HAVE_BLCKD_MSCHED; + break; + default: + erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n", + __FILE__, __LINE__, (int) ssr); + } + reds -= 100; + } -#ifdef DEBUG - erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); - ASSERT(ERTS_PROC_GET_DELAYED_GC_TASK_QS(p) == NULL); - ASSERT(p->dirty_sys_tasks == NULL); - erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); -#endif + trap_state->phase = ERTS_CONTINUE_EXIT_BLCKD_NMSHED; + if (reds <= 0) goto yield; + case ERTS_CONTINUE_EXIT_BLCKD_NMSHED: + + if (p->flags & F_HAVE_BLCKD_NMSCHED) { + ErtsSchedSuspendResult ssr; + ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1, 1); + switch (ssr) { + case ERTS_SCHDLR_SSPND_DONE: + case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED: + case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED: + p->flags &= ~F_HAVE_BLCKD_MSCHED; + break; + default: + erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n", + __FILE__, __LINE__, (int) ssr); + } + reds -= 100; + } - if (p->flags & F_USING_DDLL) { - erts_ddll_proc_dead(p, ERTS_PROC_LOCK_MAIN); - p->flags &= ~F_USING_DDLL; - } + trap_state->yield_state = NULL; + trap_state->phase = ERTS_CONTINUE_EXIT_USING_DB; + if (reds <= 0) goto yield; + case ERTS_CONTINUE_EXIT_USING_DB: - /* - * The registered name *should* be the last "erlang resource" to - * cleanup. - */ - if (p->common.u.alive.reg) { - (void) erts_unregister_name(p, ERTS_PROC_LOCK_MAIN, NULL, THE_NON_VALUE); - ASSERT(!p->common.u.alive.reg); - } + if (p->flags & F_USING_DB) { + if (erts_db_process_exiting(p, ERTS_PROC_LOCK_MAIN, &trap_state->yield_state)) + goto yield; + p->flags &= ~F_USING_DB; + } - if (IS_TRACED_FL(p, F_TRACE_SCHED_EXIT)) - trace_sched(p, curr_locks, am_out_exited); + erts_set_gc_state(p, 1); - erts_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); - curr_locks = ERTS_PROC_LOCKS_ALL; + trap_state->phase = ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS; + case ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS: + + state = erts_atomic32_read_acqb(&p->state); + if ((state & ERTS_PSFLG_SYS_TASKS) || p->dirty_sys_tasks) { + reds -= cleanup_sys_tasks(p, state, reds); + if (reds <= 0) goto yield; + } + + trap_state->phase = ERTS_CONTINUE_EXIT_FREE; + case ERTS_CONTINUE_EXIT_FREE: - /* - * From this point on we are no longer allowed to yield - * this process. - */ #ifdef DEBUG - yield_allowed = 0; + erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); + ASSERT(ERTS_PROC_GET_DELAYED_GC_TASK_QS(p) == NULL); + ASSERT(p->dirty_sys_tasks == NULL); + erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); #endif - /* - * Note! The monitor and link fields will be overwritten - * by erts_ptab_delete_element() below. - */ - links = ERTS_P_LINKS(p); - monitors = ERTS_P_MONITORS(p); - lt_monitors = ERTS_P_LT_MONITORS(p); + if (p->flags & F_USING_DDLL) { + erts_ddll_proc_dead(p, ERTS_PROC_LOCK_MAIN); + p->flags &= ~F_USING_DDLL; + } - { - /* Do *not* use erts_get_runq_proc() */ - ErtsRunQueue *rq; - rq = erts_get_runq_current(erts_proc_sched_data(p)); + /* + * The registered name *should* be the last "erlang resource" to + * cleanup. + */ + if (p->common.u.alive.reg) { + (void) erts_unregister_name(p, ERTS_PROC_LOCK_MAIN, NULL, THE_NON_VALUE); + ASSERT(!p->common.u.alive.reg); + } - erts_runq_lock(rq); + erts_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); + curr_locks = ERTS_PROC_LOCKS_ALL; - ASSERT(p->scheduler_data); - ASSERT(p->scheduler_data->current_process == p); - ASSERT(p->scheduler_data->free_process == NULL); + /* + * Note! The monitor and link fields will be overwritten + * by erts_ptab_delete_element() below. + */ + trap_state->links = ERTS_P_LINKS(p); + trap_state->monitors = ERTS_P_MONITORS(p); + trap_state->lt_monitors = ERTS_P_LT_MONITORS(p); - p->scheduler_data->current_process = NULL; - p->scheduler_data->free_process = p; + { + /* Do *not* use erts_get_runq_proc() */ + ErtsRunQueue *rq; + rq = erts_get_runq_current(erts_proc_sched_data(p)); - /* Time of death! */ - erts_ptab_delete_element(&erts_proc, &p->common); + erts_runq_lock(rq); - erts_runq_unlock(rq); - } + ASSERT(p->scheduler_data); + ASSERT(p->scheduler_data->current_process == p); + ASSERT(p->scheduler_data->free_process == NULL); - /* - * All "erlang resources" have to be deallocated before this point, - * e.g. registered name, so monitoring and linked processes can - * be sure that all interesting resources have been deallocated - * when the monitors and/or links hit. - */ + /* Time of death! */ + erts_ptab_delete_element(&erts_proc, &p->common); - { - /* Inactivate and notify free */ - erts_aint32_t n, e, a = erts_atomic32_read_nob(&p->state); - int refc_inced = 0; - while (1) { - n = e = a; - ASSERT(a & ERTS_PSFLG_EXITING); - n |= ERTS_PSFLG_FREE; - n &= ~(ERTS_PSFLG_ACTIVE - | ERTS_PSFLG_ACTIVE_SYS - | ERTS_PSFLG_DIRTY_ACTIVE_SYS); - if ((n & ERTS_PSFLG_IN_RUNQ) && !refc_inced) { - erts_proc_inc_refc(p); - refc_inced = 1; - } - a = erts_atomic32_cmpxchg_mb(&p->state, n, e); - if (a == e) - break; - } + erts_runq_unlock(rq); + } - if (a & (ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { - p->flags |= F_DELAYED_DEL_PROC; - delay_del_proc = 1; - /* - * The dirty scheduler decrease refc - * when done with the process... - */ - } + /* + * All "erlang resources" have to be deallocated before this point, + * e.g. registered name, so monitoring and linked processes can + * be sure that all interesting resources have been deallocated + * when the monitors and/or links hit. + */ - if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ)) - erts_proc_dec_refc(p); - } + { + /* Inactivate and notify free */ + erts_aint32_t n, e, a = erts_atomic32_read_nob(&p->state); + int refc_inced = 0; + while (1) { + n = e = a; + ASSERT(a & ERTS_PSFLG_EXITING); + n |= ERTS_PSFLG_FREE; + if ((n & ERTS_PSFLG_IN_RUNQ) && !refc_inced) { + erts_proc_inc_refc(p); + refc_inced = 1; + } + a = erts_atomic32_cmpxchg_mb(&p->state, n, e); + if (a == e) + break; + } - dep = ((p->flags & F_DISTRIBUTION) - ? ERTS_PROC_SET_DIST_ENTRY(p, NULL) - : NULL); + if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ)) + erts_proc_dec_refc(p); + } + trap_state->dep = ((p->flags & F_DISTRIBUTION) + ? ERTS_PROC_SET_DIST_ENTRY(p, NULL) + : NULL); + + reds -= 50; - /* - * It might show up signal prio elevation tasks until we - * have entered free state. Cleanup such tasks now. - */ - state = erts_atomic32_read_acqb(&p->state); - if (!(state & ERTS_PSFLG_SYS_TASKS)) - erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL); - else { erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); + curr_locks = ERTS_PROC_LOCK_MAIN; + trap_state->phase = ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS_AFTER; + case ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS_AFTER: + /* + * It might show up signal prio elevation tasks until we + * have entered free state. Cleanup such tasks now. + */ - do { - (void) cleanup_sys_tasks(p, state, CONTEXT_REDS); - state = erts_atomic32_read_acqb(&p->state); - } while (state & ERTS_PSFLG_SYS_TASKS); - - erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN); - } + state = erts_atomic32_read_acqb(&p->state); + if ((state & ERTS_PSFLG_SYS_TASKS) || p->dirty_sys_tasks) { + reds -= cleanup_sys_tasks(p, state, reds); + if (reds <= 0) goto yield; + } + + /* Needs to be unlocked for erts_do_net_exits to work?!? */ + // erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN); #ifdef DEBUG - erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); - ASSERT(p->sys_task_qs == NULL); - erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); + ASSERT(p->sys_task_qs == NULL); + erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); #endif - if (dep) { - erts_do_net_exits(dep, (reason == am_kill) ? am_killed : reason); - erts_deref_dist_entry(dep); - } + if (trap_state->dep) { + erts_do_net_exits(trap_state->dep, + (trap_state->reason == am_kill) ? am_killed : trap_state->reason); + erts_deref_dist_entry(trap_state->dep); + } - pectxt.c_p = p; - pectxt.reason = reason; + trap_state->pectxt.c_p = p; + trap_state->pectxt.reason = trap_state->reason; + trap_state->pectxt.dist_links = NULL; + trap_state->pectxt.dist_monitors = NULL; + trap_state->pectxt.dist_state = NIL; + + erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ); + + erts_proc_sig_fetch(p); + + erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ); + + trap_state->yield_state = NULL; + trap_state->phase = ERTS_CONTINUE_EXIT_LINKS; + if (reds <= 0) goto yield; + case ERTS_CONTINUE_EXIT_LINKS: + + reds = erts_link_tree_foreach_delete_yielding( + &trap_state->links, + erts_proc_exit_handle_link, + (void *) &trap_state->pectxt, + &trap_state->yield_state, + reds); + if (reds <= 0) + goto yield; + + ASSERT(!trap_state->links); + trap_state->yield_state = NULL; + trap_state->phase = ERTS_CONTINUE_EXIT_MONITORS; + case ERTS_CONTINUE_EXIT_MONITORS: + + reds = erts_monitor_tree_foreach_delete_yielding( + &trap_state->monitors, + erts_proc_exit_handle_monitor, + (void *) &trap_state->pectxt, + &trap_state->yield_state, + reds); + if (reds <= 0) + goto yield; + + ASSERT(!trap_state->monitors); + trap_state->yield_state = NULL; + trap_state->phase = ERTS_CONTINUE_EXIT_LT_MONITORS; + case ERTS_CONTINUE_EXIT_LT_MONITORS: + + reds = erts_monitor_list_foreach_delete_yielding( + &trap_state->lt_monitors, + erts_proc_exit_handle_monitor, + (void *) &trap_state->pectxt, + &trap_state->yield_state, + reds); + if (reds <= 0) + goto yield; + + ASSERT(!trap_state->lt_monitors); + trap_state->phase = ERTS_CONTINUE_EXIT_HANDLE_PROC_SIG; + case ERTS_CONTINUE_EXIT_HANDLE_PROC_SIG: { + Sint r = reds; + + if (!erts_proc_sig_handle_exit(p, &r)) + goto yield; + + reds -= r; + + trap_state->phase = ERTS_CONTINUE_EXIT_DIST_LINKS; + } + case ERTS_CONTINUE_EXIT_DIST_LINKS: { + + continue_dist_send: + if (is_not_nil(trap_state->pectxt.dist_state)) { + Binary* bin = erts_magic_ref2bin(trap_state->pectxt.dist_state); + ErtsDSigSendContext* ctx = (ErtsDSigSendContext*) ERTS_MAGIC_BIN_DATA(bin); + Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); + int result; + + ctx->reds = initial_reds; + result = erts_dsig_send(ctx); + + /* erts_dsig_send bumps reductions on the process in the ctx */ + reds = ERTS_BIF_REDS_LEFT(p); + + switch (result) { + case ERTS_DSIG_SEND_OK: + case ERTS_DSIG_SEND_TOO_LRG: /*SEND_SYSTEM_LIMIT*/ + case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/ + break; + case ERTS_DSIG_SEND_CONTINUE: { /*SEND_YIELD_CONTINUE*/ + goto yield; + } + } + erts_set_gc_state(p, 1); + trap_state->pectxt.dist_state = NIL; + if (reds <= 0) + goto yield; + goto restart; + } - erts_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ); + reds = erts_link_tree_foreach_delete_yielding( + &trap_state->pectxt.dist_links, + erts_proc_exit_handle_dist_link, + (void *) &trap_state->pectxt, + &trap_state->yield_state, + reds); + if (reds <= 0 || is_not_nil(trap_state->pectxt.dist_state)) + goto yield; + trap_state->phase = ERTS_CONTINUE_EXIT_DIST_MONITORS; + } + case ERTS_CONTINUE_EXIT_DIST_MONITORS: { + + if (is_not_nil(trap_state->pectxt.dist_state)) + goto continue_dist_send; + + reds = erts_monitor_tree_foreach_delete_yielding( + &trap_state->pectxt.dist_monitors, + erts_proc_exit_handle_dist_monitor, + (void *) &trap_state->pectxt, + &trap_state->yield_state, + reds); + if (reds <= 0 || is_not_nil(trap_state->pectxt.dist_state)) + goto yield; + + trap_state->phase = ERTS_CONTINUE_EXIT_DONE; + } + case ERTS_CONTINUE_EXIT_DONE: { + erts_aint_t state; + /* + * From this point on we are no longer allowed to yield + * this process. + */ - erts_proc_sig_fetch(p); +#ifdef DEBUG + yield_allowed = 0; +#endif - erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ); + /* Set state to not active as we don't want this process + to be scheduled in again after this. */ + state = erts_atomic32_read_band_relb(&p->state, + ~(ERTS_PSFLG_ACTIVE + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)); - if (links) { - erts_link_tree_foreach_delete(&links, - erts_proc_exit_handle_link, - (void *) &pectxt); - ASSERT(!links); - } + ASSERT(p->scheduler_data); + ASSERT(p->scheduler_data->current_process == p); + ASSERT(p->scheduler_data->free_process == NULL); - if (monitors) { - erts_monitor_tree_foreach_delete(&monitors, - erts_proc_exit_handle_monitor, - (void *) &pectxt); - ASSERT(!monitors); - } + p->scheduler_data->current_process = NULL; + p->scheduler_data->free_process = p; - if (lt_monitors) { - erts_monitor_list_foreach_delete(<_monitors, - erts_proc_exit_handle_monitor, - (void *) &pectxt); - ASSERT(!lt_monitors); - } + if (state & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { + p->flags |= F_DELAYED_DEL_PROC; + delay_del_proc = 1; + /* + * The dirty scheduler decrease refc + * when done with the process... + */ + } - /* - * erts_proc_sig_handle_exit() implements yielding. - * However, this function cannot handle it yet... loop - * until done... - */ - while (!0) { - int reds = CONTEXT_REDS; - if (erts_proc_sig_handle_exit(p, &reds)) - break; + erts_schedule_thr_prgr_later_cleanup_op( + (void (*)(void*))erts_proc_dec_refc, + (void *) &p->common, + &p->common.u.release, + sizeof(Process)); + + break; + } } + if (trap_state != &static_state) { + erts_free(ERTS_ALC_T_CONT_EXIT_TRAP, trap_state); + p->u.terminate = NULL; + } + ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + if (IS_TRACED_FL(p, F_TRACE_SCHED_EXIT)) + trace_sched(p, curr_locks, am_out_exited); + erts_flush_trace_messages(p, ERTS_PROC_LOCK_MAIN); ERTS_TRACER_CLEAR(&ERTS_TRACER(p)); @@ -12644,9 +12968,26 @@ erts_continue_exit_process(Process *p) ERTS_LC_ASSERT(curr_locks == erts_proc_lc_my_proc_locks(p)); ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & curr_locks); + ASSERT(erts_proc_read_refc(p) > 0); + + if (trap_state == &static_state) { + trap_state = erts_alloc(ERTS_ALC_T_CONT_EXIT_TRAP, sizeof(*trap_state)); + sys_memcpy(trap_state, &static_state, sizeof(*trap_state)); + p->u.terminate = trap_state; + } + + ASSERT(p->scheduler_data); + ASSERT(p->scheduler_data->current_process == p); + ASSERT(p->scheduler_data->free_process == NULL); + + if (trap_state->phase >= ERTS_CONTINUE_EXIT_FREE) { + p->scheduler_data->current_process = NULL; + p->scheduler_data->free_process = p; + } p->i = (BeamInstr *) beam_continue_exit; + /* Why is this lock take??? */ if (!(curr_locks & ERTS_PROC_LOCK_STATUS)) { erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); curr_locks |= ERTS_PROC_LOCK_STATUS; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 43937f216c..3b593bce02 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -381,7 +381,10 @@ struct ErtsSchedulerSleepInfo_ { typedef struct ErtsProcList_ ErtsProcList; struct ErtsProcList_ { - Eterm pid; + union { + Eterm pid; + Process *p; + } u; Uint64 started_interval; ErtsProcList* next; ErtsProcList* prev; @@ -1580,7 +1583,7 @@ ERTS_GLB_INLINE int erts_proclist_is_last(ErtsProcList *, ErtsProcList *); ERTS_GLB_INLINE int erts_proclist_same(ErtsProcList *plp, Process *p) { - return (plp->pid == p->common.id + return ((plp->u.pid == p->common.id || plp->u.p == p) && (plp->started_interval == p->common.u.alive.started_interval)); } @@ -1819,9 +1822,12 @@ Eterm erts_process_info(Process *c_p, ErtsHeapFactory *hfact, typedef struct { Process *c_p; Eterm reason; + ErtsLink *dist_links; + ErtsMonitor *dist_monitors; + Eterm dist_state; } ErtsProcExitContext; -void erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt); -void erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt); +int erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt, Sint reds); +int erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt, Sint reds); Eterm erts_get_process_priority(erts_aint32_t state); Eterm erts_set_process_priority(Process *p, Eterm prio); diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 10ea401022..a164ed543e 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -100,16 +100,18 @@ erts_deep_process_dump(fmtfn_t to, void *to_arg) dump_binaries(to, to_arg, all_binaries); } -static void -monitor_size(ErtsMonitor *mon, void *vsize) +static int +monitor_size(ErtsMonitor *mon, void *vsize, Sint reds) { *((Uint *) vsize) += erts_monitor_size(mon); + return 1; } -static void -link_size(ErtsMonitor *lnk, void *vsize) +static int +link_size(ErtsMonitor *lnk, void *vsize, Sint reds) { *((Uint *) vsize) += erts_link_size(lnk); + return 1; } Uint erts_process_memory(Process *p, int include_sigs_in_transit) @@ -189,11 +191,11 @@ static ERTS_INLINE void dump_msg(fmtfn_t to, void *to_arg, ErtsMessage *mp) { if (ERTS_SIG_IS_MSG((ErtsSignal *) mp)) { - Eterm mesg = ERL_MESSAGE_TERM(mp); - if (is_value(mesg)) - dump_element(to, to_arg, mesg); + Eterm mesg; + if (ERTS_SIG_IS_INTERNAL_MSG(mp)) + dump_element(to, to_arg, ERL_MESSAGE_TERM(mp)); else - dump_dist_ext(to, to_arg, mp->data.dist_ext); + dump_dist_ext(to, to_arg, erts_get_dist_ext(mp->data.heap_frag)); mesg = ERL_MESSAGE_TOKEN(mp); erts_print(to, to_arg, ":"); dump_element(to, to_arg, mesg); @@ -265,6 +267,7 @@ dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep) else { byte *e; size_t sz; + int i; if (!(edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB)) erts_print(to, to_arg, "D0:"); @@ -274,8 +277,8 @@ dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep) for (i = 0; i < edep->attab.size; i++) dump_element(to, to_arg, edep->attab.atom[i]); } - sz = edep->ext_endp - edep->extp; - e = edep->extp; + sz = edep->data->ext_endp - edep->data->extp; + e = edep->data->extp; if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) { ASSERT(*e != VERSION_MAGIC); sz++; @@ -286,15 +289,19 @@ dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep) erts_print(to, to_arg, "E%X:", sz); if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) { byte sbuf[3]; - int i = 0; + + i = 0; sbuf[i++] = VERSION_MAGIC; - while (i < sizeof(sbuf) && e < edep->ext_endp) { + while (i < sizeof(sbuf) && e < edep->data->ext_endp) { sbuf[i++] = *e++; } erts_print_base64(to, to_arg, sbuf, i); } - erts_print_base64(to, to_arg, e, edep->ext_endp - e); + erts_print_base64(to, to_arg, e, edep->data->ext_endp - e); + for (i = 1; i < edep->data->frag_id; i++) + erts_print_base64(to, to_arg, edep->data[i].extp, + edep->data[i].ext_endp - edep->data[i].extp); } } diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h index 94f0247492..c30a684002 100644 --- a/erts/emulator/beam/erl_ptab.h +++ b/erts/emulator/beam/erl_ptab.h @@ -68,8 +68,11 @@ typedef struct { Uint64 started_interval; struct reg_proc *reg; ErtsLink *links; - ErtsMonitor *monitors; + /* Local target monitors, double linked list + contains the remote part of local monitors */ ErtsMonitor *lt_monitors; + /* other monitors, rb tree */ + ErtsMonitor *monitors; } alive; /* --- While being released --- */ diff --git a/erts/emulator/beam/erl_rbtree.h b/erts/emulator/beam/erl_rbtree.h index e50abf5cec..ce401fa7e7 100644 --- a/erts/emulator/beam/erl_rbtree.h +++ b/erts/emulator/beam/erl_rbtree.h @@ -161,7 +161,7 @@ * * - void <ERTS_RBT_PREFIX>_rbt_foreach( * ERTS_RBT_T *tree, - * void (*op)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), * void *arg); * Operate by calling the operator 'op' on each element. * Order is undefined. @@ -170,7 +170,7 @@ * * - void <ERTS_RBT_PREFIX>_rbt_foreach_destroy( * ERTS_RBT_T *tree, - * void (*op)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), * void *arg); * Operate by calling the operator 'op' on each element. * Order is undefined. Each element should be destroyed @@ -180,39 +180,46 @@ * * - int <ERTS_RBT_PREFIX>_rbt_foreach_yielding( * ERTS_RBT_T *tree, - * void (*op)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), * void *arg, * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, - * Sint ylimit); + * Sint reds); * Operate by calling the operator 'op' on each element. * Order is undefined. * - * Yield when 'ylimit' elements has been processed. True is - * returned when yielding, and false is returned when - * the whole tree has been processed. The tree should not be - * modified until all of it has been processed. + * Yield when 'reds' reductions has been processed. The 'op' + * function return the number of reductions that each element + * took to process. The number of reductions remaining is returned, + * meaning that if 0 is returned, there are more elements to be + * processed. If a value greater than 0 is returned the foreach has + * ended. The tree should not be modified until all of it has been + * processed. * * 'arg' is passed as argument to 'op'. * * - int <ERTS_RBT_PREFIX>_rbt_foreach_destroy_yielding( * ERTS_RBT_T *tree, - * void (*op)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), * void *arg, * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, - * Sint ylimit); + * Sint reds); * Operate by calling the operator 'op' on each element. * Order is undefined. Each element should be destroyed * by 'op'. * - * Yield when 'ylimit' elements has been processed. True is - * returned when yielding, and false is returned when - * the whole tree has been processed. + * Yield when 'reds' reductions has been processed. The 'op' + * function return the number of reductions that each element + * took to process. The number of reductions remaining is returned, + * meaning that if 0 is returned, there are more elements to be + * processed. If a value greater than 0 is returned the foreach has + * ended. The tree should not be modified until all of it has been + * processed. * * 'arg' is passed as argument to 'op'. * * - void <ERTS_RBT_PREFIX>_rbt_foreach_small( * ERTS_RBT_T *tree, - * void (*op)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), * void *arg); * Operate by calling the operator 'op' on each element from * smallest towards larger elements. @@ -221,7 +228,7 @@ * * - void <ERTS_RBT_PREFIX>_rbt_foreach_large( * ERTS_RBT_T *tree, - * void (*op)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), * void *arg); * Operate by calling the operator 'op' on each element from * largest towards smaller elements. @@ -230,40 +237,46 @@ * * - int <ERTS_RBT_PREFIX>_rbt_foreach_small_yielding( * ERTS_RBT_T *tree, - * void (*op)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), * void *arg, * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, - * Sint ylimit); + * Sint reds); * Operate by calling the operator 'op' on each element from * smallest towards larger elements. * - * Yield when 'ylimit' elements has been processed. True is - * returned when yielding, and false is returned when - * the whole tree has been processed. The tree should not be - * modified until all of it has been processed. + * Yield when 'reds' reductions has been processed. The 'op' + * function return the number of reductions that each element + * took to process. The number of reductions remaining is returned, + * meaning that if 0 is returned, there are more elements to be + * processed. If a value greater than 0 is returned the foreach has + * ended. The tree should not be modified until all of it has been + * processed. * * 'arg' is passed as argument to 'op'. * * - int <ERTS_RBT_PREFIX>_rbt_foreach_large_yielding( * ERTS_RBT_T *tree, - * void (*op)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), * void *arg, * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, - * Sint ylimit); + * Sint reds); * Operate by calling the operator 'op' on each element from * largest towards smaller elements. * - * Yield when 'ylimit' elements has been processed. True is - * returned when yielding, and false is returned when - * the whole tree has been processed. The tree should not be - * modified until all of it has been processed. + * Yield when 'reds' reductions has been processed. The 'op' + * function return the number of reductions that each element + * took to process. The number of reductions remaining is returned, + * meaning that if 0 is returned, there are more elements to be + * processed. If a value greater than 0 is returned the foreach has + * ended. The tree should not be modified until all of it has been + * processed. * * 'arg' is passed as argument to 'op'. * * - void <ERTS_RBT_PREFIX>_rbt_foreach_small_destroy( * ERTS_RBT_T **tree, - * void (*op)(ERTS_RBT_T *, void *), - * void (*destr)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), + * int (*destr)(ERTS_RBT_T *, void *), * void *arg); * Operate by calling the operator 'op' on each element from * smallest towards larger elements. @@ -277,8 +290,8 @@ * * - void <ERTS_RBT_PREFIX>_rbt_foreach_large_destroy( * ERTS_RBT_T **tree, - * void (*op)(ERTS_RBT_T *, void *), - * void (*destr)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), + * int (*destr)(ERTS_RBT_T *, void *), * void *arg); * Operate by calling the operator 'op' on each element from * largest towards smaller elements. @@ -292,11 +305,11 @@ * * - int <ERTS_RBT_PREFIX>_rbt_foreach_small_destroy_yielding( * ERTS_RBT_T **tree, - * void (*op)(ERTS_RBT_T *, void *), - * void (*destr)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), + * int (*destr)(ERTS_RBT_T *, void *), * void *arg, * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, - * Sint ylimit); + * Sint reds); * Operate by calling the operator 'op' on each element from * smallest towards larger elements. * @@ -305,20 +318,23 @@ * Note that elements are often destroyed in another order * than the order that the elements are operated on. * - * Yield when 'ylimit' elements has been processed. True is - * returned when yielding, and false is returned when - * the whole tree has been processed. The tree should not be - * modified until all of it has been processed. + * Yield when 'reds' reductions has been processed. The 'op' and + * 'destr' functions return the number of reductions that each element + * took to process. The number of reductions remaining is returned, + * meaning that if 0 is returned, there are more elements to be + * processed. If a value greater than 0 is returned the foreach has + * ended. The tree should not be modified until all of it has been + * processed. * * 'arg' is passed as argument to 'op' and 'destroy'. * * - int <ERTS_RBT_PREFIX>_rbt_foreach_large_destroy_yielding( * ERTS_RBT_T **tree, - * void (*op)(ERTS_RBT_T *, void *), - * void (*destr)(ERTS_RBT_T *, void *), + * int (*op)(ERTS_RBT_T *, void *), + * int (*destr)(ERTS_RBT_T *, void *), * void *arg, * <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate, - * Sint ylimit); + * Sint reds); * Operate by calling the operator 'op' on each element from * largest towards smaller elements. * @@ -327,10 +343,13 @@ * Note that elements are often destroyed in another order * than the order that the elements are operated on. * - * Yield when 'ylimit' elements has been processed. True is - * returned when yielding, and false is returned when - * the whole tree has been processed. The tree should not be - * modified until all of it has been processed. + * Yield when 'reds' reductions has been processed. The 'op' and + * 'destr' functions return the number of reductions that each element + * took to process. The number of reductions remaining is returned, + * meaning that if 0 is returned, there are more elements to be + * processed. If a value greater than 0 is returned the foreach has + * ended. The tree should not be modified until all of it has been + * processed. * * 'arg' is passed as argument to 'op' and 'destroy'. * @@ -447,17 +466,6 @@ # define ERTS_RBT_API_INLINE__ ERTS_INLINE #endif -#ifndef ERTS_RBT_YIELD_STAT_INITER -# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0} -#endif -#ifndef ERTS_RBT_YIELD_STAT_INIT -# define ERTS_RBT_YIELD_STAT_INIT(YS) \ - do { \ - (YS)->x = NULL; \ - (YS)->up = 0; \ - } while (0) -#endif - #define ERTS_RBT_CONCAT_MACRO_VALUES___(X, Y) \ X ## Y #define ERTS_RBT_CONCAT_MACRO_VALUES__(X, Y) \ @@ -470,8 +478,38 @@ typedef struct { ERTS_RBT_T *x; int up; +#ifdef DEBUG + int debug_red_adj; +#endif } ERTS_RBT_YIELD_STATE_T__; +#define ERTS_RBT_CALLBACK_FOREACH_FUNC(NAME) int (*NAME)(ERTS_RBT_T *, void *, Sint) + +#ifndef ERTS_RBT_YIELD_STAT_INITER +# ifdef DEBUG +# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0, CONTEXT_REDS} +# else +# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0} +# endif +#endif +#ifndef ERTS_RBT_YIELD_STAT_INIT +# define ERTS_RBT_YIELD_STAT_INIT__(YS) \ + do { \ + (YS)->x = NULL; \ + (YS)->up = 0; \ + } while (0) +# ifdef DEBUG +# define ERTS_RBT_YIELD_STAT_INIT(YS) \ + do { \ + ERTS_RBT_YIELD_STAT_INIT__(YS); \ + (YS)->debug_red_adj = CONTEXT_REDS; \ + } while(0) +# else +# define ERTS_RBT_YIELD_STAT_INIT(YS) ERTS_RBT_YIELD_STAT_INIT__(YS) +# endif +#endif + + #define ERTS_RBT_FUNC__(Name) \ ERTS_RBT_CONCAT_MACRO_VALUES__(ERTS_RBT_PREFIX, _rbt_ ## Name) @@ -1302,11 +1340,11 @@ ERTS_RBT_FUNC__(largest)(ERTS_RBT_T *root) static ERTS_INLINE int ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root, int destroying, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg, - int yielding, + int yielding, ERTS_RBT_YIELD_STATE_T__ *ystate, - Sint ylimit) + Sint reds) { ERTS_RBT_T *c, *p, *x; @@ -1314,13 +1352,17 @@ ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root, if (yielding && ystate->x) { x = ystate->x; +#ifdef DEBUG + if (ystate->debug_red_adj > 0) + ystate->debug_red_adj -= 100; +#endif ERTS_RBT_ASSERT(ystate->up); goto restart_up; } else { x = *root; if (!x) - return 0; + return reds; if (destroying) *root = NULL; } @@ -1346,10 +1388,10 @@ ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root, #ifdef ERTS_RBT_DEBUG int cdir; #endif - if (yielding && ylimit-- <= 0) { + if (yielding && reds <= 0) { ystate->x = x; ystate->up = 1; - return 1; + return 0; } restart_up: @@ -1375,14 +1417,20 @@ ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root, } #endif - (*op)(x, arg); + reds -= (*op)(x, arg, reds); +#ifdef DEBUG + if (yielding) + reds -= ystate->debug_red_adj; +#endif if (!p) { + /* Done */ if (yielding) { ystate->x = NULL; ystate->up = 0; + return reds <= 0 ? 1 : reds; } - return 0; /* Done */ + return 1; } c = ERTS_RBT_GET_RIGHT(p); @@ -1407,20 +1455,26 @@ static ERTS_INLINE int ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root, int from_small, int destroying, - void (*op)(ERTS_RBT_T *, void *), - void (*destroy)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), + ERTS_RBT_CALLBACK_FOREACH_FUNC(destroy), void *arg, - int yielding, + int yielding, ERTS_RBT_YIELD_STATE_T__ *ystate, - Sint ylimit) + Sint reds) { ERTS_RBT_T *c, *p, *x; ERTS_RBT_ASSERT(!yielding || ystate); ERTS_RBT_ASSERT(!destroying || destroy); + ERTS_RBT_ASSERT(!yielding || yop); + ERTS_RBT_ASSERT(yielding || op); if (yielding && ystate->x) { x = ystate->x; +#ifdef DEBUG + if (ystate->debug_red_adj > 0) + ystate->debug_red_adj -= 100; +#endif if (ystate->up) goto restart_up; else @@ -1429,7 +1483,7 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root, else { x = *root; if (!x) - return 0; + return reds; if (destroying) *root = NULL; } @@ -1445,12 +1499,16 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root, x = c; } - (*op)(x, arg); + reds -= (*op)(x, arg, reds); +#ifdef DEBUG + if (yielding) + reds -= ystate->debug_red_adj; +#endif - if (yielding && --ylimit <= 0) { + if (yielding && reds <= 0) { ystate->x = x; ystate->up = 0; - return 1; + return 0; } restart_down: @@ -1472,12 +1530,16 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root, ? ERTS_RBT_GET_LEFT(p) : ERTS_RBT_GET_RIGHT(p)) == x); - (*op)(p, arg); + reds -= (*op)(p, arg, reds); +#ifdef DEBUG + if (yielding) + reds -= ystate->debug_red_adj; +#endif - if (yielding && --ylimit <= 0) { + if (yielding && reds <= 0) { ystate->x = x; ystate->up = 1; - return 1; + return 0; restart_up: p = ERTS_RBT_GET_PARENT(x); } @@ -1510,15 +1572,20 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root, } #endif - (*destroy)(x, arg); + reds -= (*destroy)(x, arg, reds); +#ifdef DEBUG + if (yielding) + reds -= ystate->debug_red_adj; +#endif } if (!p) { if (yielding) { ystate->x = NULL; ystate->up = 0; + return reds <= 0 ? 1 : reds; } - return 0; /* Done */ + return 1; /* Done */ } x = p; } @@ -1531,7 +1598,7 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root, static ERTS_RBT_API_INLINE__ void ERTS_RBT_FUNC__(foreach)(ERTS_RBT_T *root, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg) { (void) ERTS_RBT_FUNC__(foreach_unordered__)(&root, 0, op, arg, @@ -1544,7 +1611,7 @@ ERTS_RBT_FUNC__(foreach)(ERTS_RBT_T *root, static ERTS_RBT_API_INLINE__ void ERTS_RBT_FUNC__(foreach_small)(ERTS_RBT_T *root, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg) { (void) ERTS_RBT_FUNC__(foreach_ordered__)(&root, 1, 0, @@ -1558,7 +1625,7 @@ ERTS_RBT_FUNC__(foreach_small)(ERTS_RBT_T *root, static ERTS_RBT_API_INLINE__ void ERTS_RBT_FUNC__(foreach_large)(ERTS_RBT_T *root, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg) { (void) ERTS_RBT_FUNC__(foreach_ordered__)(&root, 0, 0, @@ -1572,13 +1639,13 @@ ERTS_RBT_FUNC__(foreach_large)(ERTS_RBT_T *root, static ERTS_RBT_API_INLINE__ int ERTS_RBT_FUNC__(foreach_yielding)(ERTS_RBT_T *root, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg, ERTS_RBT_YIELD_STATE_T__ *ystate, - Sint ylimit) + Sint reds) { return ERTS_RBT_FUNC__(foreach_unordered__)(&root, 0, op, arg, - 1, ystate, ylimit); + 1, ystate, reds); } #endif /* ERTS_RBT_WANT_FOREACH_YIELDING */ @@ -1587,14 +1654,14 @@ ERTS_RBT_FUNC__(foreach_yielding)(ERTS_RBT_T *root, static ERTS_RBT_API_INLINE__ int ERTS_RBT_FUNC__(foreach_small_yielding)(ERTS_RBT_T *root, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg, ERTS_RBT_YIELD_STATE_T__ *ystate, - Sint ylimit) + Sint reds) { return ERTS_RBT_FUNC__(foreach_ordered__)(&root, 1, 0, op, NULL, arg, - 1, ystate, ylimit); + 1, ystate, reds); } #endif /* ERTS_RBT_WANT_FOREACH_SMALL_YIELDING */ @@ -1603,14 +1670,14 @@ ERTS_RBT_FUNC__(foreach_small_yielding)(ERTS_RBT_T *root, static ERTS_RBT_API_INLINE__ int ERTS_RBT_FUNC__(foreach_large_yielding)(ERTS_RBT_T *root, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg, ERTS_RBT_YIELD_STATE_T__ *ystate, - Sint ylimit) + Sint reds) { return ERTS_RBT_FUNC__(foreach_ordered__)(&root, 0, 0, op, NULL, arg, - 1, ystate, ylimit); + 1, ystate, reds); } #endif /* ERTS_RBT_WANT_FOREACH_LARGE_YIELDING */ @@ -1619,11 +1686,11 @@ ERTS_RBT_FUNC__(foreach_large_yielding)(ERTS_RBT_T *root, static ERTS_RBT_API_INLINE__ void ERTS_RBT_FUNC__(foreach_destroy)(ERTS_RBT_T **root, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg) { (void) ERTS_RBT_FUNC__(foreach_unordered__)(root, 1, op, arg, - 0, NULL, 0); + 0, NULL, 0); } #endif /* ERTS_RBT_WANT_FOREACH_DESTROY */ @@ -1632,8 +1699,8 @@ ERTS_RBT_FUNC__(foreach_destroy)(ERTS_RBT_T **root, static ERTS_RBT_API_INLINE__ void ERTS_RBT_FUNC__(foreach_small_destroy)(ERTS_RBT_T **root, - void (*op)(ERTS_RBT_T *, void *), - void (*destr)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), + ERTS_RBT_CALLBACK_FOREACH_FUNC(destr), void *arg) { (void) ERTS_RBT_FUNC__(foreach_ordered__)(root, 1, 1, @@ -1647,8 +1714,8 @@ ERTS_RBT_FUNC__(foreach_small_destroy)(ERTS_RBT_T **root, static ERTS_RBT_API_INLINE__ void ERTS_RBT_FUNC__(foreach_large_destroy)(ERTS_RBT_T **root, - void (*op)(ERTS_RBT_T *, void *), - void (*destr)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), + ERTS_RBT_CALLBACK_FOREACH_FUNC(destr), void *arg) { (void) ERTS_RBT_FUNC__(foreach_ordered__)(root, 0, 1, @@ -1662,13 +1729,13 @@ ERTS_RBT_FUNC__(foreach_large_destroy)(ERTS_RBT_T **root, static ERTS_RBT_API_INLINE__ int ERTS_RBT_FUNC__(foreach_destroy_yielding)(ERTS_RBT_T **root, - void (*op)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), void *arg, ERTS_RBT_YIELD_STATE_T__ *ystate, - Sint ylimit) + Sint reds) { return ERTS_RBT_FUNC__(foreach_unordered__)(root, 1, op, arg, - 1, ystate, ylimit); + 1, ystate, reds); } #endif /* ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING */ @@ -1677,15 +1744,15 @@ ERTS_RBT_FUNC__(foreach_destroy_yielding)(ERTS_RBT_T **root, static ERTS_RBT_API_INLINE__ int ERTS_RBT_FUNC__(foreach_small_destroy_yielding)(ERTS_RBT_T **root, - void (*op)(ERTS_RBT_T *, void *), - void (*destr)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), + ERTS_RBT_CALLBACK_FOREACH_FUNC(destr), void *arg, ERTS_RBT_YIELD_STATE_T__ *ystate, - Sint ylimit) + Sint reds) { return ERTS_RBT_FUNC__(foreach_ordered__)(root, 1, 1, op, destr, arg, - 1, ystate, ylimit); + 1, ystate, reds); } #endif /* ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING */ @@ -1694,15 +1761,15 @@ ERTS_RBT_FUNC__(foreach_small_destroy_yielding)(ERTS_RBT_T **root, static ERTS_RBT_API_INLINE__ int ERTS_RBT_FUNC__(foreach_large_destroy_yielding)(ERTS_RBT_T **root, - void (*op)(ERTS_RBT_T *, void *), - void (*destr)(ERTS_RBT_T *, void *), + ERTS_RBT_CALLBACK_FOREACH_FUNC(op), + ERTS_RBT_CALLBACK_FOREACH_FUNC(destr), void *arg, ERTS_RBT_YIELD_STATE_T__ *ystate, - Sint ylimit) + Sint reds) { return ERTS_RBT_FUNC__(foreach_ordered__)(root, 0, 1, op, destr, arg, - 1, ystate, ylimit); + 1, ystate, reds); } #endif /* ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING */ @@ -1855,6 +1922,7 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n) #ifdef ERTS_RBT_UNDEF # undef ERTS_RBT_PREFIX # undef ERTS_RBT_T +# undef ERTS_RBT_CALLBACK_FOREACH_FUNC # undef ERTS_RBT_KEY_T # undef ERTS_RBT_FLAGS_T # undef ERTS_RBT_INIT_EMPTY_TNODE diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 29c698e34f..d26ea19494 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -1911,8 +1911,8 @@ typedef struct { ErtsTimeOffsetMonitorInfo *to_mon_info; } ErtsTimeOffsetMonitorContext; -static void -save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt) +static int +save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt, Sint reds) { ErtsTimeOffsetMonitorContext *cntxt; ErtsMonitorData *mdp = erts_monitor_to_data(mon); @@ -1935,7 +1935,7 @@ save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt) cntxt->to_mon_info[mix].ref = make_internal_ref(&cntxt->to_mon_info[mix].heap[0]); - + return 1; } static void diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 9a66e491f3..73eae614fa 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -102,7 +102,7 @@ static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_h struct TTBEncodeContext_; static int enc_term_int(struct TTBEncodeContext_*,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, struct erl_off_heap_header** off_heap, Sint *reds, byte **res); -static Uint is_external_string(Eterm obj, int* p_is_string); +static int is_external_string(Eterm obj, Uint* lenp); static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32); static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32); struct B2TContext_t; @@ -262,19 +262,12 @@ erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags) if (acmp) { int long_atoms = 0; /* !0 if one or more atoms are longer than 255. */ int i; - int sz; - int fix_sz - = 1 /* VERSION_MAGIC */ - + 1 /* DIST_HEADER */ - + 1 /* dist header flags */ - + 1 /* number of internal cache entries */ - ; + int sz = 0; int min_sz; ASSERT(dflags & DFLAG_UTF8_ATOMS); ASSERT(acmp->hdr_sz < 0); /* Make sure cache update instructions fit */ - min_sz = fix_sz+(2+4)*acmp->sz; - sz = fix_sz; + min_sz = (2+4)*acmp->sz; for (i = 0; i < acmp->sz; i++) { Atom *a; Eterm atom; @@ -302,17 +295,28 @@ erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags) } Uint -erts_encode_ext_dist_header_size(ErtsAtomCacheMap *acmp) +erts_encode_ext_dist_header_size(ErtsAtomCacheMap *acmp, Uint fragments) { if (!acmp) return 0; else { + int fix_sz + = 1 /* VERSION_MAGIC */ + + 1 /* DIST_HEADER */ + + 1 /* dist header flags */ + + 1 /* number of internal cache entries */ + ; ASSERT(acmp->hdr_sz >= 0); - return acmp->hdr_sz; + if (fragments > 1) + fix_sz += 8 /* sequence id */ + + 8 /* number of fragments */ + ; + return fix_sz + acmp->hdr_sz; } } -byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp) +byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp, + Uint fragments, Eterm from) { /* Maximum number of atom must be less than the maximum of a 32 bits unsigned integer. Check is done in erl_init.c, erl_start function. */ @@ -346,12 +350,37 @@ byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp) put_int8(acmp->sz, ep); --ep; put_int8(dist_hdr_flags, ep); - *--ep = DIST_HEADER; - *--ep = VERSION_MAGIC; + if (fragments > 1) { + ASSERT(is_pid(from)); + ep -= 8; + put_int64(fragments, ep); + ep -= 8; + put_int64(from, ep); + *--ep = DIST_FRAG_HEADER; + } else { + *--ep = DIST_HEADER; + } + *--ep = VERSION_MAGIC; return ep; } } +byte *erts_encode_ext_dist_header_fragment(byte **hdrpp, + Uint fragment, + Eterm from) +{ + byte *ep = *hdrpp, *start = ep; + ASSERT(is_pid(from)); + *ep++ = VERSION_MAGIC; + *ep++ = DIST_FRAG_CONT; + put_int64(from, ep); + ep += 8; + put_int64(fragment, ep); + ep += 8; + *hdrpp = ep; + return start; +} + #define PASS_THROUGH 'p' @@ -365,7 +394,8 @@ Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob, int ci, sz; byte dist_hdr_flags; int long_atoms; - register byte *ep = ob->extp; + Uint64 seq_id = 0, frag_id = 0; + register byte *ep = ob->hdrp ? ob->hdrp : ob->extp; ASSERT(dflags & DFLAG_UTF8_ATOMS); /* @@ -416,7 +446,7 @@ Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob, } goto done; } - else if (ep[1] != DIST_HEADER) { + else if (ep[1] != DIST_HEADER && ep[1] != DIST_FRAG_HEADER && ep[1] != DIST_FRAG_CONT) { ASSERT(ep[1] == SMALL_TUPLE_EXT || ep[1] == LARGE_TUPLE_EXT); ASSERT(!(dflags & DFLAG_DIST_HDR_ATOM_CACHE)); /* Node without atom cache, 'pass through' needed */ @@ -424,6 +454,17 @@ Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob, goto done; } + if (ep[1] == DIST_FRAG_CONT) { + ep = ob->extp; + goto done; + } else if (ep[1] == DIST_FRAG_HEADER) { + /* skip the seq id and frag id */ + seq_id = get_int64(&ep[2]); + ep += 8; + frag_id = get_int64(&ep[2]); + ep += 8; + } + dist_hdr_flags = ep[2]; long_atoms = ERTS_DIST_HDR_LONG_ATOMS_FLG & ((int) dist_hdr_flags); @@ -546,11 +587,19 @@ Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob, } --ep; put_int8(ci, ep); - *--ep = DIST_HEADER; + if (seq_id) { + ep -= 8; + put_int64(frag_id, ep); + ep -= 8; + put_int64(seq_id, ep); + *--ep = DIST_FRAG_HEADER; + } else { + *--ep = DIST_HEADER; + } *--ep = VERSION_MAGIC; done: ob->extp = ep; - ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp); + ASSERT((byte*)ob->bin->orig_bytes <= ob->extp && ob->extp < ob->ext_endp); return reds < 0 ? 0 : reds; } @@ -571,7 +620,7 @@ int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp, } } -int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp) +int erts_encode_dist_ext_size_int(Eterm term, ErtsDSigSendContext *ctx, Uint* szp) { Uint sz; if (encode_size_struct_int(&ctx->u.sc, ctx->acmp, term, ctx->flags, &ctx->reds, &sz)) { @@ -635,56 +684,106 @@ byte* erts_encode_ext_ets(Eterm term, byte *ep, struct erl_off_heap_header** off off_heap); } -ErtsDistExternal * -erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize) + +static Uint +dist_ext_size(ErtsDistExternal *edep) { - size_t align_sz; - size_t dist_ext_sz; - size_t ext_sz; - byte *ep; - ErtsDistExternal *new_edep; + Uint sz = sizeof(ErtsDistExternal); + + ASSERT(edep->data->ext_endp && edep->data->extp); + ASSERT(edep->data->ext_endp >= edep->data->extp); + + if (edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) { + ASSERT(0 <= edep->attab.size \ + && edep->attab.size <= ERTS_ATOM_CACHE_SIZE); + sz -= sizeof(Eterm)*(ERTS_ATOM_CACHE_SIZE - edep->attab.size); + } else { + sz -= sizeof(ErtsAtomTranslationTable); + } + return sz; +} + +Uint +erts_dist_ext_size(ErtsDistExternal *edep) +{ + Uint sz = dist_ext_size(edep); + sz += edep->data[0].frag_id * sizeof(ErtsDistExternalData); + return sz + ERTS_EXTRA_DATA_ALIGN_SZ(sz); +} - dist_ext_sz = ERTS_DIST_EXT_SIZE(edep); - ASSERT(edep->ext_endp && edep->extp); - ASSERT(edep->ext_endp >= edep->extp); - ext_sz = edep->ext_endp - edep->extp; +Uint +erts_dist_ext_data_size(ErtsDistExternal *edep) +{ + Uint sz = 0, i; + for (i = 0; i < edep->data->frag_id; i++) + sz += edep->data[i].ext_endp - edep->data[i].extp; + return sz; +} - align_sz = ERTS_EXTRA_DATA_ALIGN_SZ(dist_ext_sz + ext_sz); +void +erts_dist_ext_frag(ErtsDistExternalData *ede_datap, ErtsDistExternal *edep) +{ + ErtsDistExternalData *new_ede_datap = &edep->data[edep->data->frag_id - ede_datap->frag_id]; + sys_memcpy(new_ede_datap, ede_datap, sizeof(ErtsDistExternalData)); + + /* If the data is not backed by a binary, we create one here to keep + things simple. Only custom distribution drivers should use lists. */ + if (new_ede_datap->binp == NULL) { + size_t ext_sz = ede_datap->ext_endp - ede_datap->extp; + new_ede_datap->binp = erts_bin_nrml_alloc(ext_sz); + sys_memcpy(new_ede_datap->binp->orig_bytes, (void *) ede_datap->extp, ext_sz); + new_ede_datap->extp = (byte*)new_ede_datap->binp->orig_bytes; + new_ede_datap->ext_endp = (byte*)new_ede_datap->binp->orig_bytes + ext_sz; + } else { + erts_refc_inc(&new_ede_datap->binp->intern.refc, 2); + } +} - new_edep = erts_alloc(ERTS_ALC_T_EXT_TERM_DATA, - dist_ext_sz + ext_sz + align_sz + xsize); +void +erts_make_dist_ext_copy(ErtsDistExternal *edep, ErtsDistExternal *new_edep) +{ + size_t dist_ext_sz = dist_ext_size(edep); + byte *ep; ep = (byte *) new_edep; sys_memcpy((void *) ep, (void *) edep, dist_ext_sz); + erts_ref_dist_entry(new_edep->dep); + ep += dist_ext_sz; - if (new_edep->dep) - erts_ref_dist_entry(new_edep->dep); - new_edep->extp = ep; - new_edep->ext_endp = ep + ext_sz; - new_edep->heap_size = -1; - sys_memcpy((void *) ep, (void *) edep->extp, ext_sz); - return new_edep; + + new_edep->data = (ErtsDistExternalData*)ep; + sys_memzero(new_edep->data, sizeof(ErtsDistExternalData) * edep->data->frag_id); + new_edep->data->frag_id = edep->data->frag_id; + erts_dist_ext_frag(edep->data, new_edep); } -int +void +erts_free_dist_ext_copy(ErtsDistExternal *edep) +{ + int i; + erts_deref_dist_entry(edep->dep); + for (i = 0; i < edep->data->frag_id; i++) + if (edep->data[i].binp) + erts_bin_release(edep->data[i].binp); +} + +ErtsPrepDistExtRes erts_prepare_dist_ext(ErtsDistExternal *edep, byte *ext, Uint size, + Binary *binp, DistEntry *dep, Uint32 conn_id, ErtsAtomCache *cache) { register byte *ep; - edep->heap_size = -1; - edep->flags = 0; - edep->dep = dep; - ASSERT(dep); erts_de_rlock(dep); ASSERT(dep->flags & DFLAG_UTF8_ATOMS); + if ((dep->state != ERTS_DE_STATE_CONNECTED && dep->state != ERTS_DE_STATE_PENDING) || dep->connection_id != conn_id) { @@ -697,7 +796,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, ext++; size--; } - edep->ext_endp = ext + size; + ep = ext; if (size < 2) @@ -713,16 +812,33 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, goto fail; } + edep->heap_size = -1; + edep->flags = 0; + edep->dep = dep; + edep->connection_id = conn_id; + edep->data->ext_endp = ext+size; + edep->data->binp = binp; + edep->data->seq_id = 0; + edep->data->frag_id = 1; + if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE) edep->flags |= ERTS_DIST_EXT_DFLAG_HDR; - edep->connection_id = dep->connection_id; - - if (ep[1] != DIST_HEADER) { + if (ep[1] != DIST_HEADER && ep[1] != DIST_FRAG_HEADER && ep[1] != DIST_FRAG_CONT) { if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) goto bad_hdr; edep->attab.size = 0; - edep->extp = ext; + edep->data->extp = ext; + } + else if (ep[1] == DIST_FRAG_CONT) { + if (!(dep->flags & DFLAG_FRAGMENTS)) + goto bad_hdr; + edep->attab.size = 0; + edep->data->extp = ext + 1 + 1 + 8 + 8; + edep->data->seq_id = get_int64(&ep[2]); + edep->data->frag_id = get_int64(&ep[2+8]); + erts_de_runlock(dep); + return ERTS_PREP_DIST_EXT_FRAG_CONT; } else { int tix; @@ -731,9 +847,17 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, if (!(edep->flags & ERTS_DIST_EXT_DFLAG_HDR)) goto bad_hdr; + if (ep[1] == DIST_FRAG_HEADER) { + if (!(dep->flags & DFLAG_FRAGMENTS)) + goto bad_hdr; + edep->data->seq_id = get_int64(&ep[2]); + edep->data->frag_id = get_int64(&ep[2+8]); + ep += 16; + } + #undef CHKSIZE #define CHKSIZE(SZ) \ - do { if ((SZ) > edep->ext_endp - ep) goto bad_hdr; } while(0) + do { if ((SZ) > edep->data->ext_endp - ep) goto bad_hdr; } while(0) CHKSIZE(1+1+1); ep += 2; @@ -863,7 +987,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, #endif } } - edep->extp = ep; + edep->data->extp = ep; #ifdef ERTS_DEBUG_USE_DIST_SEP if (*ep != VERSION_MAGIC) goto bad_hdr; @@ -888,7 +1012,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, erts_this_node->sysname, edep->dep->sysname, dist_entry_channel_no(edep->dep)); - for (ep = ext; ep < edep->ext_endp; ep++) + for (ep = ext; ep < edep->data->ext_endp; ep++) erts_dsprintf(dsbufp, ep != ext ? ",%b8u" : "<<%b8u", *ep); erts_dsprintf(dsbufp, ">>"); erts_send_warning_to_logger_nogl(dsbufp); @@ -913,9 +1037,9 @@ bad_dist_ext(ErtsDistExternal *edep) erts_this_node->sysname, dep->sysname, dist_entry_channel_no(dep)); - for (ep = edep->extp; ep < edep->ext_endp; ep++) + for (ep = edep->data->extp; ep < edep->data->ext_endp; ep++) erts_dsprintf(dsbufp, - ep != edep->extp ? ",%b8u" : "<<...,%b8u", + ep != edep->data->extp ? ",%b8u" : "<<...,%b8u", *ep); erts_dsprintf(dsbufp, ">>\n"); erts_dsprintf(dsbufp, "ATOM_CACHE_REF translations: "); @@ -933,30 +1057,32 @@ bad_dist_ext(ErtsDistExternal *edep) } Sint -erts_decode_dist_ext_size(ErtsDistExternal *edep) +erts_decode_dist_ext_size(ErtsDistExternal *edep, int kill_connection) { Sint res; byte *ep; - if (edep->extp >= edep->ext_endp) + + if (edep->data->extp >= edep->data->ext_endp) goto fail; #ifndef ERTS_DEBUG_USE_DIST_SEP if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) { - if (*edep->extp == VERSION_MAGIC) + if (*edep->data->extp == VERSION_MAGIC) goto fail; - ep = edep->extp; + ep = edep->data->extp; } else #endif { - if (*edep->extp != VERSION_MAGIC) + if (*edep->data->extp != VERSION_MAGIC) goto fail; - ep = edep->extp+1; + ep = edep->data->extp+1; } - res = decoded_size(ep, edep->ext_endp, 0, NULL); + res = decoded_size(ep, edep->data->ext_endp, 0, NULL); if (res >= 0) return res; fail: - bad_dist_ext(edep); + if (kill_connection) + bad_dist_ext(edep); return -1; } @@ -982,12 +1108,15 @@ Sint erts_decode_ext_size_ets(byte *ext, Uint size) */ Eterm erts_decode_dist_ext(ErtsHeapFactory* factory, - ErtsDistExternal *edep) + ErtsDistExternal *edep, + int kill_connection) { Eterm obj; - byte* ep = edep->extp; + byte* ep; - if (ep >= edep->ext_endp) + ep = edep->data->extp; + + if (ep >= edep->data->ext_endp) goto error; #ifndef ERTS_DEBUG_USE_DIST_SEP if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) { @@ -1005,14 +1134,15 @@ erts_decode_dist_ext(ErtsHeapFactory* factory, if (!ep) goto error; - edep->extp = ep; + edep->data->extp = ep; return obj; error: erts_factory_undo(factory); - bad_dist_ext(edep); + if (kill_connection) + bad_dist_ext(edep); return THE_NON_VALUE; } @@ -1057,6 +1187,7 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2) Eterm res; Sint hsz; ErtsDistExternal ede; + ErtsDistExternalData ede_data; Eterm *tp; Eterm real_bin; Uint offset; @@ -1069,7 +1200,8 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2) ede.flags = ERTS_DIST_EXT_ATOM_TRANS_TAB; ede.dep = NULL; ede.heap_size = -1; - + ede.data = &ede_data; + if (is_not_tuple(BIF_ARG_1)) goto badarg; tp = tuple_val(BIF_ARG_1); @@ -1094,15 +1226,15 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2) if (bitsize != 0) goto badarg; - ede.extp = binary_bytes(real_bin)+offset; - ede.ext_endp = ede.extp + size; + ede.data->extp = binary_bytes(real_bin)+offset; + ede.data->ext_endp = ede.data->extp + size; - hsz = erts_decode_dist_ext_size(&ede); + hsz = erts_decode_dist_ext_size(&ede, 1); if (hsz < 0) goto badarg; erts_factory_proc_prealloc_init(&factory, BIF_P, hsz); - res = erts_decode_dist_ext(&factory, &ede); + res = erts_decode_dist_ext(&factory, &ede, 1); erts_factory_close(&factory); if (is_value(res)) @@ -2348,7 +2480,7 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp) return ep; } -static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation) +static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation, Eterm book) { if (sysname == INTERNAL_LOCAL_SYSNAME) /* && DFLAG_INTERNAL_TAGS */ return erts_this_node; @@ -2357,7 +2489,7 @@ static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation) && (creation == erts_this_node->creation || creation == ORIG_CREATION)) return erts_this_node; - return erts_find_or_insert_node(sysname,creation); + return erts_find_or_insert_node(sysname,creation,book); } static byte* @@ -2403,7 +2535,7 @@ dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, * We are careful to create the node entry only after all * validity tests are done. */ - node = dec_get_node(sysname, cre); + node = dec_get_node(sysname, cre, make_boxed(factory->hp)); if(node == erts_this_node) { *objp = make_internal_pid(data); @@ -2481,11 +2613,21 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, { Eterm* cons = list_val(obj); Eterm tl; + Uint len_cnt = WSTACK_POP(s); obj = CAR(cons); tl = CDR(cons); - WSTACK_PUSH2(s, (is_list(tl) ? ENC_ONE_CONS : ENC_TERM), - tl); + if (is_list(tl)) { + len_cnt++; + WSTACK_PUSH3(s, len_cnt, ENC_ONE_CONS, tl); + } + else { + byte* list_lenp = (byte*) WSTACK_POP(s); + ASSERT(list_lenp[-1] == LIST_EXT); + put_int32(len_cnt, list_lenp); + + WSTACK_PUSH2(s, ENC_TERM, tl); + } } break; case ENC_PATCH_FUN_SIZE: @@ -2689,10 +2831,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, } case LIST_DEF: { - int is_str; - - i = is_external_string(obj, &is_str); - if (is_str) { + if (is_external_string(obj, &i)) { *ep++ = STRING_EXT; put_int16(i, ep); ep += 2; @@ -2701,9 +2840,12 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, *ep++ = unsigned_val(CAR(cons)); obj = CDR(cons); } + r -= i; } else { + r -= i/2; *ep++ = LIST_EXT; - put_int32(i, ep); + /* Patch list length when we find end of list */ + WSTACK_PUSH2(s, (UWord)ep, 1); ep += 4; goto encode_one_cons; } @@ -2961,9 +3103,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, return 0; } +/** @brief Is it a list of bytes not longer than MAX_STRING_LEN? + * @param lenp out: string length or number of list cells traversed + * @return true/false + */ static -Uint -is_external_string(Eterm list, int* p_is_string) +int +is_external_string(Eterm list, Uint* lenp) { Uint len = 0; @@ -2975,29 +3121,15 @@ is_external_string(Eterm list, int* p_is_string) Eterm* consp = list_val(list); Eterm hd = CAR(consp); - if (!is_byte(hd)) { - break; + if (!is_byte(hd) || ++len > MAX_STRING_LEN) { + *lenp = len; + return 0; } - len++; list = CDR(consp); } - /* - * If we have reached the end of the list, and we have - * not exceeded the maximum length of a string, this - * is a string. - */ - *p_is_string = is_nil(list) && len < MAX_STRING_LEN; - - /* - * Continue to calculate the length. - */ - while (is_list(list)) { - Eterm* consp = list_val(list); - len++; - list = CDR(consp); - } - return len; + *lenp = len; + return is_nil(list); } @@ -3397,7 +3529,7 @@ dec_term_atom_common: cre = get_int32(ep); ep += 4; } - node = dec_get_node(sysname, cre); + node = dec_get_node(sysname, cre, make_boxed(hp)); if(node == erts_this_node) { *objp = make_internal_port(num); } @@ -3477,7 +3609,7 @@ dec_term_atom_common: if (ref_words > ERTS_MAX_REF_NUMBERS) goto error; - node = dec_get_node(sysname, cre); + node = dec_get_node(sysname, cre, make_boxed(hp)); if(node == erts_this_node) { rtp = (ErtsORefThing *) hp; @@ -4075,8 +4207,8 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, for (;;) { ASSERT(!is_header(obj)); - if (ctx && --r == 0) { - *reds = r; + if (ctx && --r <= 0) { + *reds = 0; ctx->obj = obj; ctx->result = result; WSTACK_SAVE(s, &ctx->wstack); @@ -4166,8 +4298,10 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, result += (1 + encode_size_struct2(acmp, port_node_name(obj), dflags) + 4 + 1); break; - case LIST_DEF: - if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { + case LIST_DEF: { + int is_str = is_external_string(obj, &m); + r -= m/2; + if (is_str) { result += m + 2 + 1; } else { result += 5; @@ -4176,6 +4310,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, continue; /* big loop */ } break; + } case TUPLE_DEF: { Eterm* ptr = tuple_val(obj); @@ -4317,7 +4452,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, if (is_header(obj)) { switch (obj) { - case LIST_TAIL_OP: + case LIST_TAIL_OP: obj = (Eterm) WSTACK_POP(s); if (is_list(obj)) { Eterm* cons = list_val(obj); @@ -4343,7 +4478,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, WSTACK_DESTROY(s); if (ctx) { ASSERT(ctx->wstack.wstart == NULL); - *reds = r; + *reds = r < 0 ? 0 : r; } *res = result; return 0; diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index edac177cc6..396cd9f802 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -58,6 +58,8 @@ #define SMALL_ATOM_UTF8_EXT 'w' #define DIST_HEADER 'D' +#define DIST_FRAG_HEADER 'E' +#define DIST_FRAG_CONT 'F' #define ATOM_CACHE_REF 'R' #define ATOM_INTERNAL_REF2 'I' #define ATOM_INTERNAL_REF3 'K' @@ -122,13 +124,23 @@ typedef struct { #define ERTS_DIST_CON_ID_MASK ((Uint32) 0x00ffffff) /* also in net_kernel.erl */ -typedef struct { - DistEntry *dep; +struct binary; +typedef struct erl_dist_external_data ErtsDistExternalData; + +struct erl_dist_external_data { + Uint64 seq_id; + Uint64 frag_id; byte *extp; byte *ext_endp; + struct binary *binp; +}; + +typedef struct erl_dist_external { Sint heap_size; - Uint32 connection_id; + DistEntry *dep; Uint32 flags; + Uint32 connection_id; + ErtsDistExternalData *data; ErtsAtomTranslationTable attab; } ErtsDistExternal; @@ -155,8 +167,9 @@ void erts_reset_atom_cache_map(ErtsAtomCacheMap *); void erts_destroy_atom_cache_map(ErtsAtomCacheMap *); void erts_finalize_atom_cache_map(ErtsAtomCacheMap *, Uint32); -Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); -byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *); +Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *, Uint); +byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *, Uint, Eterm); +byte *erts_encode_ext_dist_header_fragment(byte **, Uint, Eterm); Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf*, DistEntry *, Uint32 dflags, Sint reds); struct erts_dsig_send_context; int erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp); @@ -171,20 +184,24 @@ Uint erts_encode_ext_size_ets(Eterm); void erts_encode_ext(Eterm, byte **); byte* erts_encode_ext_ets(Eterm, byte *, struct erl_off_heap_header** ext_off_heap); -ERTS_GLB_INLINE void erts_free_dist_ext_copy(ErtsDistExternal *); -ERTS_GLB_INLINE void *erts_dist_ext_trailer(ErtsDistExternal *); -ErtsDistExternal *erts_make_dist_ext_copy(ErtsDistExternal *, Uint); -void *erts_dist_ext_trailer(ErtsDistExternal *); -void erts_destroy_dist_ext_copy(ErtsDistExternal *); - -#define ERTS_PREP_DIST_EXT_FAILED (-1) -#define ERTS_PREP_DIST_EXT_SUCCESS (0) -#define ERTS_PREP_DIST_EXT_CLOSED (1) - -int erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint, - DistEntry *, Uint32 conn_id, ErtsAtomCache *); -Sint erts_decode_dist_ext_size(ErtsDistExternal *); -Eterm erts_decode_dist_ext(ErtsHeapFactory* factory, ErtsDistExternal *); +Uint erts_dist_ext_size(ErtsDistExternal *); +Uint erts_dist_ext_data_size(ErtsDistExternal *); +void erts_free_dist_ext_copy(ErtsDistExternal *); +void erts_make_dist_ext_copy(ErtsDistExternal *, ErtsDistExternal *); +void erts_dist_ext_frag(ErtsDistExternalData *, ErtsDistExternal *); +#define erts_get_dist_ext(HFRAG) ((ErtsDistExternal*)((HFRAG)->mem + (HFRAG)->used_size)) + +typedef enum { + ERTS_PREP_DIST_EXT_FAILED, + ERTS_PREP_DIST_EXT_SUCCESS, + ERTS_PREP_DIST_EXT_FRAG_CONT, + ERTS_PREP_DIST_EXT_CLOSED +} ErtsPrepDistExtRes; + +ErtsPrepDistExtRes erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint, struct binary *, + DistEntry *, Uint32, ErtsAtomCache *); +Sint erts_decode_dist_ext_size(ErtsDistExternal *, int); +Eterm erts_decode_dist_ext(ErtsHeapFactory*, ErtsDistExternal *, int); Sint erts_decode_ext_size(byte*, Uint); Sint erts_decode_ext_size_ets(byte*, Uint); @@ -200,25 +217,4 @@ int erts_debug_max_atom_out_cache_index(void); int erts_debug_atom_to_out_cache_index(Eterm); void transcode_free_ctx(DistEntry* dep); -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE void -erts_free_dist_ext_copy(ErtsDistExternal *edep) -{ - if (edep->dep) - erts_deref_dist_entry(edep->dep); - erts_free(ERTS_ALC_T_EXT_TERM_DATA, edep); -} - -ERTS_GLB_INLINE void * -erts_dist_ext_trailer(ErtsDistExternal *edep) -{ - void *res = (void *) (edep->ext_endp - + ERTS_EXTRA_DATA_ALIGN_SZ(edep->ext_endp)); - ASSERT((((UWord) res) % sizeof(Uint)) == 0); - return res; -} - -#endif - #endif /* ERL_EXTERNAL_H__ */ diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 5d0dec7f08..f9bbe4167f 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1096,7 +1096,7 @@ extern int distribution_info(fmtfn_t, void *); extern int is_node_name_atom(Eterm a); extern int erts_net_message(Port *, DistEntry *, Uint32 conn_id, - byte *, ErlDrvSizeT, byte *, ErlDrvSizeT); + byte *, ErlDrvSizeT, Binary *, byte *, ErlDrvSizeT); extern void init_dist(void); extern int stop_dist(void); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 7322239a73..b961c639f5 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -3644,20 +3644,22 @@ typedef struct { Eterm reason; } ErtsPortExitContext; -static void link_port_exit(ErtsLink *lnk, void *vpectxt) +static int link_port_exit(ErtsLink *lnk, void *vpectxt, Sint reds) { ErtsPortExitContext *pectxt = vpectxt; erts_proc_sig_send_link_exit(NULL, pectxt->port_id, lnk, pectxt->reason, NIL); + return 1; } -static void monitor_port_exit(ErtsMonitor *mon, void *vpectxt) +static int monitor_port_exit(ErtsMonitor *mon, void *vpectxt, Sint reds) { ErtsPortExitContext *pectxt = vpectxt; if (erts_monitor_is_target(mon)) erts_proc_sig_send_monitor_down(mon, pectxt->reason); else erts_proc_sig_send_demonitor(mon); + return 1; } /* 'from' is sending 'this_port' an exit signal, (this_port must be internal). @@ -4836,7 +4838,7 @@ typedef struct { void *arg; } prt_one_lnk_data; -static void prt_one_monitor(ErtsMonitor *mon, void *vprtd) +static int prt_one_monitor(ErtsMonitor *mon, void *vprtd, Sint reds) { ErtsMonitorData *mdp = erts_monitor_to_data(mon); prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd; @@ -4844,12 +4846,14 @@ static void prt_one_monitor(ErtsMonitor *mon, void *vprtd) erts_print(prtd->to, prtd->arg, "(%p,%T)", mon->other.ptr, mdp->ref); else erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->other.item, mdp->ref); + return 1; } -static void prt_one_lnk(ErtsLink *lnk, void *vprtd) +static int prt_one_lnk(ErtsLink *lnk, void *vprtd, Sint reds) { prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd; erts_print(prtd->to, prtd->arg, "%T", lnk->other.item); + return 1; } static void dump_port_state(fmtfn_t to, void *arg, erts_aint32_t state) @@ -5100,7 +5104,7 @@ erts_port_resume_procs(Port *prt) erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", prt->common.id); while (plp2 != NULL) { - erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->pid); + erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->u.pid); DTRACE2(process_port_unblocked, pid_str, port_str); } } @@ -6177,6 +6181,7 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, dep, conn_id, (byte*) hbuf, hlen, + ErlDrvBinary2Binary(bin), (byte*) (bin->orig_bytes+offs), len); } else @@ -6222,12 +6227,14 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, dep, conn_id, NULL, 0, + NULL, (byte*) hbuf, hlen); else return erts_net_message(prt, dep, conn_id, (byte*) hbuf, hlen, + NULL, (byte*) buf, len); } else if (state & ERTS_PORT_SFLG_LINEBUF_IO) diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab index 9bf3aefaca..6f8d1469ef 100644 --- a/erts/emulator/beam/msg_instrs.tab +++ b/erts/emulator/beam/msg_instrs.tab @@ -137,8 +137,8 @@ i_loop_rec(Dest) { if (ERTS_UNLIKELY(ERTS_SIG_IS_EXTERNAL_MSG(msgp))) { FCALLS -= 10; /* FIXME: bump appropriate amount... */ - SWAPOUT; /* erts_decode_dist_message() may write to heap... */ - if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { + SWAPOUT; /* erts_proc_sig_decode_dist() may write to heap... */ + if (!erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { /* * A corrupt distribution message that we weren't able to decode; * remove it... diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 1e7b494a91..36a492f00d 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2701,7 +2701,8 @@ Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) if((AN)->sysname != (BN)->sysname) \ RETURN_NEQ(erts_cmp_atoms((AN)->sysname, (BN)->sysname)); \ ASSERT((AN)->creation != (BN)->creation); \ - RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \ + if ((AN)->creation != 0 && (BN)->creation != 0) \ + RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \ } \ } while (0) @@ -3486,7 +3487,7 @@ store_external_or_ref_(Uint **hpp, ErlOffHeap* oh, Eterm ns) if (is_external_header(*from_hp)) { ExternalThing *etp = (ExternalThing *) from_hp; ASSERT(is_external(ns)); - erts_refc_inc(&etp->node->refc, 2); + erts_ref_node_entry(etp->node, 2, make_boxed(to_hp)); } else if (is_ordinary_ref_thing(from_hp)) return make_internal_ref(to_hp); diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 211ce0492a..80e5d81023 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -579,7 +579,7 @@ Eterm hipe_check_get_msg(Process *c_p) if (ERTS_SIG_IS_EXTERNAL_MSG(msgp)) { /* FIXME: bump appropriate amount... */ - if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { + if (!erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { /* * A corrupt distribution message that we weren't able to decode; * remove it... diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 68b780b6a0..80e8030d74 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -44,7 +44,7 @@ #include "erl_time.h" #if 0 -#define DEBUG_PRINT(FMT, ...) erts_printf(FMT "\r\n", ##__VA_ARGS__) +#define DEBUG_PRINT(FMT, ...) do { erts_printf(FMT "\r\n", ##__VA_ARGS__); fflush(stdout); } while(0) #define DEBUG_PRINT_FD(FMT, STATE, ...) \ DEBUG_PRINT("%d: " FMT " (ev=%s, ac=%s, flg=%s)", \ (STATE) ? (STATE)->fd : (ErtsSysFdType)-1, ##__VA_ARGS__, \ diff --git a/erts/emulator/sys/common/erl_osenv.c b/erts/emulator/sys/common/erl_osenv.c index 6a16377736..f055c5f854 100644 --- a/erts/emulator/sys/common/erl_osenv.c +++ b/erts/emulator/sys/common/erl_osenv.c @@ -167,9 +167,10 @@ void erts_osenv_init(erts_osenv_t *env) { env->tree = NULL; } -static void destroy_foreach(env_rbtnode_t *node, void *_state) { +static int destroy_foreach(env_rbtnode_t *node, void *_state, Sint reds) { erts_free(ERTS_ALC_T_ENVIRONMENT, node); (void)_state; + return 1; } void erts_osenv_clear(erts_osenv_t *env) { @@ -182,7 +183,7 @@ struct __env_merge { erts_osenv_t *env; }; -static void merge_foreach(env_rbtnode_t *node, void *_state) { +static int merge_foreach(env_rbtnode_t *node, void *_state, Sint reds) { struct __env_merge *state = (struct __env_merge*)(_state); env_rbtnode_t *existing_node; @@ -191,6 +192,7 @@ static void merge_foreach(env_rbtnode_t *node, void *_state) { if(existing_node == NULL || state->overwrite_existing) { erts_osenv_put_native(state->env, &node->key, &node->value); } + return 1; } void erts_osenv_merge(erts_osenv_t *env, const erts_osenv_t *with, int overwrite) { @@ -208,7 +210,7 @@ struct __env_foreach_term { void *user_state; }; -static void foreach_term_wrapper(env_rbtnode_t *node, void *_state) { +static int foreach_term_wrapper(env_rbtnode_t *node, void *_state, Sint reds) { struct __env_foreach_term *state = (struct __env_foreach_term*)_state; Eterm key, value; @@ -218,6 +220,7 @@ static void foreach_term_wrapper(env_rbtnode_t *node, void *_state) { node->value.length, (byte*)node->value.data); state->user_callback(state->process, state->user_state, key, value); + return 1; } void erts_osenv_foreach_term(const erts_osenv_t *env, struct process *process, @@ -314,10 +317,11 @@ struct __env_foreach_native { void *user_state; }; -static void foreach_native_wrapper(env_rbtnode_t *node, void *_state) { +static int foreach_native_wrapper(env_rbtnode_t *node, void *_state, Sint reds) { struct __env_foreach_native *state = (struct __env_foreach_native*)_state; state->user_callback(state->user_state, &node->key, &node->value); + return 1; } void erts_osenv_foreach_native(const erts_osenv_t *env, void *state, diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 885c66331c..4f70b51aa0 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -62,7 +62,12 @@ bad_dist_ext_control/1, bad_dist_ext_connection_id/1, bad_dist_ext_size/1, - start_epmd_false/1, epmd_module/1]). + start_epmd_false/1, epmd_module/1, + bad_dist_fragments/1, + message_latency_large_message/1, + message_latency_large_link_exit/1, + message_latency_large_monitor_exit/1, + message_latency_large_exit2/1]). %% Internal exports. -export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0, @@ -90,7 +95,8 @@ all() -> dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip, atom_roundtrip_r16b, contended_atom_cache_entry, contended_unicode_atom_cache_entry, - bad_dist_structure, {group, bad_dist_ext}, + {group, message_latency}, + {group, bad_dist}, {group, bad_dist_ext}, start_epmd_false, epmd_module]. groups() -> @@ -100,10 +106,18 @@ groups() -> {trap_bif, [], [trap_bif_1, trap_bif_2, trap_bif_3]}, {dist_auto_connect, [], [dist_auto_connect_never, dist_auto_connect_once]}, + {bad_dist, [], + [bad_dist_structure, bad_dist_fragments]}, {bad_dist_ext, [], [bad_dist_ext_receive, bad_dist_ext_process_info, bad_dist_ext_size, - bad_dist_ext_control, bad_dist_ext_connection_id]}]. + bad_dist_ext_control, bad_dist_ext_connection_id]}, + {message_latency, [], + [message_latency_large_message, + message_latency_large_link_exit, + message_latency_large_monitor_exit, + message_latency_large_exit2]} + ]. %% Tests pinging a node in different ways. ping(Config) when is_list(Config) -> @@ -568,10 +582,20 @@ do_busy_test(Node, Fun) -> %% Don't match arity; it is different in debug and %% optimized emulator [{status, suspended}, - {current_function, {erlang, bif_return_trap, _}}] = Pinfo, + {current_function, {Mod, Func, _}}] = Pinfo, + if + Mod =:= erlang andalso Func =:= bif_return_trap -> + true; + Mod =:= erts_internal andalso Func =:= dsend_continue_trap -> + true; + true -> + ct:fail({incorrect, pinfo, Pinfo}) + end, receive {'DOWN', M, process, P, Reason} -> io:format("~p died with exit reason ~p~n", [P, Reason]), + verify_nc(node()), + verify_nc(Node), normal = Reason end end. @@ -931,7 +955,9 @@ dist_auto_connect_never(Config) when is_list(Config) -> ok; {do_dist_auto_connect, Error} -> {error, Error}; - Other -> + %% The io:formats in dos_dist_auto_connect will + %% generate port output messages that are ok + Other when not is_port(element(1, Other))-> {error, Other} after 32000 -> timeout @@ -1364,6 +1390,131 @@ get_conflicting_unicode_atoms(CIX, N) -> get_conflicting_unicode_atoms(CIX, N) end. + +%% The message_latency_large tests that small distribution messages are +%% not blocked by other large distribution messages. Basically it tests +%% that fragmentation of distribution messages works. +message_latency_large_message(Config) when is_list(Config) -> + measure_latency_large_message(?FUNCTION_NAME, fun(Dropper, Payload) -> Dropper ! Payload end). + +message_latency_large_exit2(Config) when is_list(Config) -> + measure_latency_large_message(?FUNCTION_NAME, fun erlang:exit/2). + +message_latency_large_link_exit(Config) when is_list(Config) -> + message_latency_large_exit(?FUNCTION_NAME, fun erlang:link/1). + +message_latency_large_monitor_exit(Config) when is_list(Config) -> + message_latency_large_exit(?FUNCTION_NAME, fun(Dropper) -> + Dropper ! {monitor, self()}, + receive ok -> ok end + end). + +message_latency_large_exit(Nodename, ReasonFun) -> + measure_latency_large_message( + Nodename, + fun(Dropper, Payload) -> + Pid = spawn(fun() -> + receive go -> ok end, + ReasonFun(Dropper), + exit(Payload) + end), + + FlushTrace = fun F() -> + receive + {trace, Pid, _, _} = M -> + F() + after 0 -> + ok + end + end, + + erlang:trace(Pid, true, [exiting]), + Pid ! go, + receive + {trace, Pid, out_exited, 0} -> + FlushTrace() + end + end). + +measure_latency_large_message(Nodename, DataFun) -> + + erlang:system_monitor(self(), [busy_dist_port]), + + {ok, N} = start_node(Nodename), + + Dropper = spawn(N, fun F() -> + process_flag(trap_exit, true), + receive + {monitor,Pid} -> + erlang:monitor(process, Pid), + Pid ! ok; + _ -> ok + end, + F() + end), + + Echo = spawn(N, fun F() -> receive {From, Msg} -> From ! Msg, F() end end), + + %% Test 32 MB and 320 MB and test the latency difference of sent messages + Payloads = [{I, <<0:(I * 32 * 1024 * 1024 * 8)>>} || I <- [1,10]], + + IndexTimes = [{I, measure_latency(DataFun, Dropper, Echo, P)} + || {I, P} <- Payloads], + + Times = [ Time || {_I, Time} <- IndexTimes], + + ct:pal("~p",[IndexTimes]), + + case {lists:max(Times), lists:min(Times)} of + {Max, Min} when Max * 0.25 > Min -> + ct:fail({incorrect_latency, IndexTimes}); + _ -> + ok + end. + +measure_latency(DataFun, Dropper, Echo, Payload) -> + + flush(), + + Senders = [spawn_monitor( + fun F() -> + DataFun(Dropper, Payload), + receive + die -> ok + after 0 -> + F() + end + end) || _ <- lists:seq(1,2)], + + [receive + {monitor, _Sender, busy_dist_port, _Info} = M -> + ok + end || _ <- lists:seq(1,10)], + + {TS, _} = + timer:tc(fun() -> + [begin + Echo ! {self(), hello}, + receive hello -> ok end + end || _ <- lists:seq(1,100)] + end), + [begin + Sender ! die, + receive + {'DOWN', Ref, process, _, _} -> + ok + end + end || {Sender, Ref} <- Senders], + TS. + +flush() -> + receive + _ -> + flush() + after 0 -> + ok + end. + -define(COOKIE, ''). -define(DOP_LINK, 1). -define(DOP_SEND, 2). @@ -1382,6 +1533,15 @@ get_conflicting_unicode_atoms(CIX, N) -> -define(DOP_DEMONITOR_P, 20). -define(DOP_MONITOR_P_EXIT, 21). +-define(DOP_SEND_SENDER, 22). +-define(DOP_SEND_SENDER_TT, 23). + +-define(DOP_PAYLOAD_EXIT, 24). +-define(DOP_PAYLOAD_EXIT_TT, 25). +-define(DOP_PAYLOAD_EXIT2, 26). +-define(DOP_PAYLOAD_EXIT2_TT, 27). +-define(DOP_PAYLOAD_MONITOR_P_EXIT, 28). + start_monitor(Offender,P) -> Parent = self(), Q = spawn(Offender, @@ -1515,7 +1675,145 @@ bad_dist_structure(Config) when is_list(Config) -> stop_node(Victim), ok. +%% Test various dist fragmentation errors +bad_dist_fragments(Config) when is_list(Config) -> + ct:timetrap({seconds, 15}), + + {ok, Offender} = start_node(bad_dist_fragment_offender), + {ok, Victim} = start_node(bad_dist_fragment_victim), + + Msg = iolist_to_binary(dmsg_ext(lists:duplicate(255,255))), + + start_node_monitors([Offender,Victim]), + Parent = self(), + P = spawn(Victim, + fun () -> + process_flag(trap_exit,true), + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_struct_check_msgs([one, + two]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + receive {P, started} -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + start_monitor(Offender,P), + P ! one, + + start_monitor(Offender,P), + send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P},3, + [{frg, 1, binary:part(Msg, 10,byte_size(Msg)-10)}]), + start_monitor(Offender,P), + send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P},3, + [{hdr, 3, binary:part(Msg, 0,10)}, + {frg, 1, binary:part(Msg, 10,byte_size(Msg)-10)}]), + + start_monitor(Offender,P), + send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P},3, + [{hdr, 3, binary:part(Msg, 0,10)}, + {hdr, 3, binary:part(Msg, 0,10)}]), + + start_monitor(Offender,P), + send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P,broken},3, + [{hdr, 1, binary:part(Msg, 10,byte_size(Msg)-10)}]), + + start_monitor(Offender,P), + send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P},3, + [{hdr, 3, binary:part(Msg, 10,byte_size(Msg)-10)}, + close]), + + start_monitor(Offender,P), + ExitVictim = spawn(Victim, fun() -> receive ok -> ok end end), + send_bad_fragments(Offender, Victim, P,{?DOP_PAYLOAD_EXIT,P,ExitVictim},2, + [{hdr, 1, [131]}]), + + start_monitor(Offender,P), + Exit2Victim = spawn(Victim, fun() -> receive ok -> ok end end), + send_bad_fragments(Offender, Victim, P,{?DOP_PAYLOAD_EXIT2,P,ExitVictim},2, + [{hdr, 1, [132]}]), + + start_monitor(Offender,P), + DownVictim = spawn(Victim, fun() -> receive ok -> ok end end), + DownRef = erlang:monitor(process, DownVictim), + send_bad_fragments(Offender, Victim, P,{?DOP_PAYLOAD_MONITOR_P_EXIT,P,DownVictim,DownRef},2, + [{hdr, 1, [133]}]), + + P ! two, + P ! check_msgs, + receive + {P, messages_checked} -> ok + after 5000 -> + exit(victim_is_dead) + end, + + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + unlink(P), + P ! done, + stop_node(Offender), + stop_node(Victim), + ok. + +dmsg_frag_hdr(Frag) -> + dmsg_frag_hdr(erlang:phash2(self()), Frag). +dmsg_frag_hdr(Seq, Frag) -> + [131, $E, uint64_be(Seq), uint64_be(Frag), 0]. + +dmsg_frag(Frag) -> + dmsg_frag(erlang:phash2(self()), Frag). +dmsg_frag(Seq, Frag) -> + [131, $F, uint64_be(Seq), uint64_be(Frag)]. + +send_bad_fragments(Offender,VictimNode,Victim,Ctrl,WhereToPutSelf,Fragments) -> + Parent = self(), + Done = make_ref(), + ct:pal("Send: ~p",[Fragments]), + spawn_link(Offender, + fun () -> + Node = node(Victim), + pong = net_adm:ping(Node), + erlang:monitor_node(Node, true), + DCtrl = dctrl(Node), + Ctrl1 = case WhereToPutSelf of + 0 -> + Ctrl; + N when N > 0 -> + setelement(N,Ctrl,self()) + end, + + FragData = [case Type of + hdr -> + [dmsg_frag_hdr(FragId), + dmsg_ext(Ctrl1), FragPayload]; + frg -> + [dmsg_frag(FragId), FragPayload] + end || {Type, FragId, FragPayload} <- Fragments], + + receive {nodedown, Node} -> exit("premature nodedown") + after 10 -> ok + end, + + [ dctrl_send(DCtrl, D) || D <- FragData ], + [ erlang:port_close(DCtrl) || close <- Fragments], + + receive {nodedown, Node} -> ok + after 5000 -> exit("missing nodedown") + end, + Parent ! {FragData,Done} + end), + receive + {WhatSent,Done} -> + io:format("Offender sent ~p~n",[WhatSent]), + verify_nc(VictimNode), + ok + after 7000 -> + exit(unable_to_send) + end. bad_dist_ext_receive(Config) when is_list(Config) -> {ok, Offender} = start_node(bad_dist_ext_receive_offender), @@ -2124,8 +2422,25 @@ start_node(Config, Args, Rel) when is_list(Config), is_list(Rel) -> start_node(Name, Args, Rel). stop_node(Node) -> + verify_nc(Node), test_server:stop_node(Node). +verify_nc(Node) -> + P = self(), + Ref = make_ref(), + spawn(Node, + fun() -> + R = erts_test_utils:check_node_dist(fun(E) -> E end), + P ! {Ref, R} + end), + receive + {Ref, ok} -> + ok; + {Ref, Error} -> + ct:log("~s",[Error]), + ct:fail(failed_nc_refc_check) + end. + freeze_node(Node, MS) -> Own = 300, DoingIt = make_ref(), @@ -2485,6 +2800,17 @@ mk_ref({NodeNameExt, Creation}, Numbers) when is_integer(Creation), exit({unexpected_binary_to_term_result, Other}) end. +uint64_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 64 -> + [(Uint bsr 56) band 16#ff, + (Uint bsr 48) band 16#ff, + (Uint bsr 40) band 16#ff, + (Uint bsr 32) band 16#ff, + (Uint bsr 24) band 16#ff, + (Uint bsr 16) band 16#ff, + (Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint64_be(Uint) -> + exit({badarg, uint64_be, [Uint]}). uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> [(Uint bsr 24) band 16#ff, diff --git a/erts/emulator/test/erts_test_utils.erl b/erts/emulator/test/erts_test_utils.erl index ac2f2435be..0c3ef3e0fc 100644 --- a/erts/emulator/test/erts_test_utils.erl +++ b/erts/emulator/test/erts_test_utils.erl @@ -27,6 +27,7 @@ -export([mk_ext_pid/3, mk_ext_port/2, mk_ext_ref/2, + available_internal_state/1, check_node_dist/0, check_node_dist/1, check_node_dist/3]). @@ -157,6 +158,21 @@ mk_ext_ref({NodeName, Creation}, Numbers) when is_list(NodeName), end. +available_internal_state(Bool) when Bool == true; Bool == false -> + case {Bool, + (catch erts_debug:get_internal_state(available_internal_state))} of + {true, true} -> + true; + {false, true} -> + erts_debug:set_internal_state(available_internal_state, false), + true; + {true, _} -> + erts_debug:set_internal_state(available_internal_state, true), + false; + {false, _} -> + false + end. + %% %% Check reference counters for node- and dist entries. @@ -168,16 +184,21 @@ check_node_dist() -> end). check_node_dist(Fail) -> + AIS = available_internal_state(true), + [erlang:garbage_collect(P) || P <- erlang:processes()], {{node_references, NodeRefs}, {dist_references, DistRefs}} = erts_debug:get_internal_state(node_and_dist_references), - check_node_dist(Fail, NodeRefs, DistRefs). - - + R = check_node_dist(Fail, NodeRefs, DistRefs), + available_internal_state(AIS), + R. check_node_dist(Fail, NodeRefs, DistRefs) -> - check_nd_refc({node(),erlang:system_info(creation)}, - NodeRefs, DistRefs, Fail). + AIS = available_internal_state(true), + R = check_nd_refc({node(),erlang:system_info(creation)}, + NodeRefs, DistRefs, Fail), + available_internal_state(AIS), + R. check_nd_refc({ThisNodeName, ThisCreation}, NodeRefs, DistRefs, Fail) -> diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index b3d8f9584d..ef4635a6f5 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -71,25 +71,10 @@ init_per_suite(Config) -> end_per_suite(_Config) -> erts_debug:set_internal_state(available_internal_state, true), erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value - available_internal_state(false). - -available_internal_state(Bool) when Bool == true; Bool == false -> - case {Bool, - (catch erts_debug:get_internal_state(available_internal_state))} of - {true, true} -> - true; - {false, true} -> - erts_debug:set_internal_state(available_internal_state, false), - true; - {true, _} -> - erts_debug:set_internal_state(available_internal_state, true), - false; - {false, _} -> - false - end. + erts_test_utils:available_internal_state(false). init_per_testcase(_Case, Config) when is_list(Config) -> - available_internal_state(true), + erts_test_utils:available_internal_state(true), Config. end_per_testcase(_Case, Config) when is_list(Config) -> @@ -928,9 +913,9 @@ id(X) -> -define(ND_REFS, erts_debug:get_internal_state(node_and_dist_references)). node_container_refc_check(Node) when is_atom(Node) -> - AIS = available_internal_state(true), + AIS = erts_test_utils:available_internal_state(true), nc_refc_check(Node), - available_internal_state(AIS). + erts_test_utils:available_internal_state(AIS). nc_refc_check(Node) when is_atom(Node) -> Ref = make_ref(), diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index bb7b1a73f5..e8dc59156f 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1789,7 +1789,7 @@ define etp-pix2proc # Args: Eterm # set $proc = (Process *) *((UWord *) &erts_proc.r.o.tab[((int) $arg0)]) - printf "(Process *) %p\n", $proc + printf "(Process*)%p\n", $proc end define etp-pid2proc-1 @@ -1803,7 +1803,7 @@ define etp-pid2proc # Args: Eterm # etp-pid2proc-1 $arg0 - printf "(Process *) %p\n", $proc + printf "(Process*)%p\n", $proc end define etp-proc-state-int @@ -2083,7 +2083,7 @@ define etp-process-info-int printf "\n Flags: " etp-proc-flags $etp_proc if $proxy_process != 0 - printf " Pointer: (Process *) %p\n", $etp_proc + printf " Pointer: (Process*)%p\n", $etp_proc printf " *** PROXY process struct *** refer to: \n" etp-pid2proc-1 $etp_proc->common.id etp-process-info $proc @@ -2096,7 +2096,7 @@ define etp-process-info-int end end printf " Current function: " - if ($etp_proc->current) + if ($etp_proc->current && !($etp_proc->state.counter & 0x800)) etp-1 $etp_proc->current->module printf ":" etp-1 $etp_proc->current->function @@ -2133,7 +2133,7 @@ define etp-process-info-int end printf " Parent: " etp-1 ((Eterm)($etp_proc->parent)) - printf "\n Pointer: (Process *) %p\n", $etp_proc + printf "\n Pointer: (Process*)%p\n", $etp_proc end if ($arg1) etp-sigqs $etp_proc @@ -2156,6 +2156,43 @@ document etp-process-info %--------------------------------------------------------------------------- end +define etp-processes-free-runq-int + set $runq_prio = 0 + while $runq_prio < 3 + set $runq_proc = ($arg0)->procs.prio[$runq_prio].first + while $runq_proc != 0 + if $runq_proc->state.counter & 0x400 + printf "---\n" + printf " Pix: FREE -> run_queue %p\n", ($arg0) + etp-process-info-int $runq_proc ($arg1) + end + set $runq_proc = $runq_proc->next + end + set $runq_prio++ + end +end + +define etp-processes-free-de-int + set $de_ix = 0 + while $de_ix < ($arg1) + set $de = ($arg0)+$de_ix + set $susp = $de->suspended + set $susp_curr = $susp + set $first_loop = 1 + while $susp_curr != 0 && (($susp_curr != $susp) || $first_loop) + if ($susp_curr->u.pid & 0x3) == 0 + printf "---\n" + printf " Pix: FREE " + etp $de->sysname + etp-process-info-int $susp_curr->u.pid ($arg2) + end + set $first_loop = 0 + set $susp_curr = $susp_curr->next + end + set $de_ix++ + end +end + define etp-processes-int if (!erts_initialized) printf "No processes, since system isn't initialized!\n" @@ -2176,11 +2213,36 @@ define etp-processes-int set $proc_cnt-- end if $proc_ix == $proc_printile - printf "--- %d%% (%d / %d) searched\n", $proc_printile / $proc_decentile * 10, $proc_ix, $proc_max_ix + printf "--- %d%% (%d / %d) searched, looking for %d more\n", $proc_printile / $proc_decentile * 10, $proc_ix, $proc_max_ix, $proc_cnt set $proc_printile += $proc_decentile end set $proc_ix++ end + + ## We should also check for any FREE processes that are running + ## They can be found in esdp->current_process, dep->suspendees and + ## runq. Running FREE processes are processes that either are yielding + ## when exiting or running on a dirty scheduler while having exited. + set $sched_ix = 0 + while $sched_ix < erts_no_schedulers + set $sched_data = &erts_aligned_scheduler_data[$sched_ix].esd + if $sched_data->current_process != 0 + if $sched_data->current_process.state.counter & 0x400 + printf "---\n" + printf " Pix: FREE -> scheduler %d\n", $sched_ix+1 + etp-process-info-int $sched_data->current_process ($arg0) + end + end + etp-processes-free-runq-int $sched_data->run_queue ($arg0) + set $sched_ix++ + end + etp-processes-free-runq-int &erts_aligned_run_queues[erts_no_run_queues].runq ($arg0) + etp-processes-free-runq-int &erts_aligned_run_queues[erts_no_run_queues+1].runq ($arg0) + etp-processes-free-de-int erts_hidden_dist_entries erts_no_of_hidden_dist_entries ($arg0) + etp-processes-free-de-int erts_visible_dist_entries erts_no_of_visible_dist_entries ($arg0) + etp-processes-free-de-int erts_pending_dist_entries erts_no_of_pending_dist_entries ($arg0) + etp-processes-free-de-int erts_not_connected_dist_entries erts_no_of_not_connected_dist_entries ($arg0) + etp-processes-free-de-int erts_this_dist_entry 1 ($arg0) printf "---\n", end end @@ -2237,9 +2299,9 @@ define etp-process-memory-info end printf " " etp-1 $etp_pmem_proc->common.id - printf ": (Process *) %p ", $etp_pmem_proc + printf ": (Process*)%p ", $etp_pmem_proc if $proxy_process != 0 - printf "(Process *) %p ", $etp_pmem_proc + printf "(Process*)%p ", $etp_pmem_proc printf " *** PROXY process struct *** refer to next: \n" etp-pid2proc-1 $etp_pmem_proc->common.id printf " -" @@ -2313,7 +2375,7 @@ define etp-pix2port # Args: Eterm # set $port = (Port *) *((UWord *) &erts_port.r.o.tab[((int) $arg0)]) - printf "(Port *) %p\n", $port + printf "(Port*)%p\n", $port end define etp-id2port-1 @@ -2327,7 +2389,7 @@ define etp-id2port # Args: Eterm # etp-id2port-1 $arg0 - printf "(Port *) %p\n", $port + printf "(Port*)%p\n", $port end define etp-port-sched-flags-int @@ -2501,7 +2563,7 @@ define etp-port-info printf " Connected: " set $connected = *(((Eterm *) &(((Port *) $etp_pinfo_port)->connected))) etp-1 $connected - printf "\n Pointer: (Port *) %p\n", $etp_pinfo_port + printf "\n Pointer: (Port*)%p\n", $etp_pinfo_port end document etp-port-info @@ -2851,7 +2913,7 @@ define etp-scheduler-info-internal printf " Sleep Info Flags:" set $ssi_flags = *((Uint32 *) &$sched_data->ssi->flags) etp-ssi-flags $ssi_flags - printf " Pointer: (ErtsSchedulerData *) %p\n", $sched_data + printf " Pointer: (ErtsSchedulerData*)%p\n", $sched_data end define etp-run-queue-info-internal @@ -2884,7 +2946,7 @@ define etp-run-queue-info-internal end set $rq_flags = *((Uint32 *) &($runq->flags)) etp-rq-flags-int $rq_flags - printf " Pointer: (ErtsRunQueue *) %p\n", $runq + printf " Pointer: (ErtsRunQueue*)%p\n", $runq end define etp-fds @@ -2961,7 +3023,7 @@ define etp-timer-wheel printf "\n" while 1 printf "- Timeout pos: %ld\n", $tmr->timeout_pos - printf " Pointer: (ErtsTWheelTimer *) %p\n", $tmr + printf " Pointer: (ErtsTWheelTimer*)%p\n", $tmr set $tmr = $tmr->next if ($tmr == $tiw->w[$ix]) loop_break @@ -2991,7 +3053,7 @@ define etp-timer-wheel printf "\n" while 1 printf "- Timeout pos: %ld\n", $tmr->timeout_pos - printf " Pointer: (ErtsTWheelTimer *) %p\n", $tmr + printf " Pointer: (ErtsTWheelTimer*)%p\n", $tmr set $tmr = $tmr->next if ($tmr == $tiw->w[$ix]) loop_break diff --git a/erts/etc/win32/msys_tools/vc/ld.sh b/erts/etc/win32/msys_tools/vc/ld.sh index 8917251f51..22184faf76 100644 --- a/erts/etc/win32/msys_tools/vc/ld.sh +++ b/erts/etc/win32/msys_tools/vc/ld.sh @@ -178,7 +178,10 @@ if [ "$RES" = "0" -a -f "$CMANIFEST" ]; then RES=$? if [ "$RES" != "0" ]; then REMOVE=`echo "$OUTPUTRES" | sed 's,\\\;[12]$,,g'` - CREMOVE=`cygpath $REMOVE` + CREMOVE=`win2msys_path.sh $REMOVE` + ## If Defender or Search are enabled, they will lock just created files + ## and then mt will fail :/ + echo "If you get this error, make sure Windows Defender AND Windows Search is disabled">>/tmp/link.exe.${p}.1 rm -f "$CREMOVE" fi rm -f "$CMANIFEST" diff --git a/lib/common_test/test_server/configure.in b/lib/common_test/test_server/configure.in index 0511d126b4..e07bd4c2aa 100644 --- a/lib/common_test/test_server/configure.in +++ b/lib/common_test/test_server/configure.in @@ -459,11 +459,11 @@ dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a dnl AC_LANG_JAVA instead...) AC_DEFUN(ERL_TRY_LINK_JAVA, [java_link='$JAVAC conftest.java 1>&AC_FD_CC' -changequote(�, �)dnl +changequote(, )dnl cat > conftest.java <<EOF -�$1� +$1 class conftest { public static void main(String[] args) { - �$2� + $2 ; return; }} EOF changequote([, ])dnl diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 97c73d0e07..c971e8844d 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -90,7 +90,6 @@ MODULES = \ rec_env \ sys_core_alias \ sys_core_bsm \ - sys_core_dsetel \ sys_core_fold \ sys_core_fold_lists \ sys_core_inline \ @@ -209,7 +208,6 @@ $(EBIN)/core_lint.beam: core_parse.hrl $(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl $(EBIN)/core_pp.beam: core_parse.hrl $(EBIN)/sys_core_alias.beam: core_parse.hrl -$(EBIN)/sys_core_dsetel.beam: core_parse.hrl $(EBIN)/sys_core_fold.beam: core_parse.hrl $(EBIN)/sys_core_fold_lists.beam: core_parse.hrl $(EBIN)/sys_core_inline.beam: core_parse.hrl diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 09925b2872..28c89782c9 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -225,7 +225,11 @@ moves_from_stack(nil, I, Acc) -> {reverse(Acc),I}; moves_from_stack({literal,[H|T]}, I, Acc) -> Cons = {cons,tag_literal(H),tag_literal(T)}, - moves_from_stack(Cons, I, Acc). + moves_from_stack(Cons, I, Acc); +moves_from_stack(_, _, _) -> + %% Not understood. Give up. + {[],-1}. + get_reg(R, Regs) -> case Regs of diff --git a/lib/compiler/src/beam_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl index d6e675ae72..410bafe0bb 100644 --- a/lib/compiler/src/beam_kernel_to_ssa.erl +++ b/lib/compiler/src/beam_kernel_to_ssa.erl @@ -707,11 +707,6 @@ bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, %% internal_cg(Bif, [Arg], [Ret], Le, State) -> %% {[Ainstr],State}. -internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, _Le, St) -> - [New,Tuple,#b_literal{val=Index1}] = ssa_args([New0,Tuple0,Index0], St), - Index = #b_literal{val=Index1-1}, - Set = #b_set{op=set_tuple_element,args=[New,Tuple,Index]}, - {[Set],St}; internal_cg(make_fun, [Name0,Arity0|As], Rs, _Le, St0) -> #k_atom{val=Name} = Name0, #k_int{val=Arity} = Arity0, diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl index 0f662d851d..a9977b0b1d 100644 --- a/lib/compiler/src/beam_ssa.erl +++ b/lib/compiler/src/beam_ssa.erl @@ -109,7 +109,7 @@ 'make_fun' | 'new_try_tag' | 'peek_message' | 'phi' | 'put_list' | 'put_map' | 'put_tuple' | 'raw_raise' | 'recv_next' | 'remove_message' | 'resume' | - 'set_tuple_element' | 'succeeded' | + 'succeeded' | 'timeout' | 'wait' | 'wait_timeout'. @@ -118,7 +118,8 @@ %% Primops only used internally during code generation. -type cg_prim_op() :: 'bs_get' | 'bs_match_string' | 'bs_restore' | 'bs_skip' | - 'copy' | 'put_tuple_arity' | 'put_tuple_element'. + 'copy' | 'put_tuple_arity' | 'put_tuple_element' | + 'set_tuple_element'. -import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1]). diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index 355d2d060d..6e548dd529 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -164,12 +164,14 @@ repeated_passes(Opts) -> epilogue_passes(Opts) -> Ps = [?PASS(ssa_opt_type_finish), ?PASS(ssa_opt_float), - ?PASS(ssa_opt_live), %One last time to clean up the - %mess left by the float pass. + ?PASS(ssa_opt_sw), + + %% Run live one more time to clean up after the float and sw + %% passes. + ?PASS(ssa_opt_live), ?PASS(ssa_opt_bsm), ?PASS(ssa_opt_bsm_units), ?PASS(ssa_opt_bsm_shortcut), - ?PASS(ssa_opt_sw), ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_sink), ?PASS(ssa_opt_merge_blocks), @@ -847,6 +849,7 @@ cse_expr(#b_set{op=Op,args=Args}=I) -> cse_suitable(#b_set{op=get_hd}) -> true; cse_suitable(#b_set{op=get_tl}) -> true; cse_suitable(#b_set{op=put_list}) -> true; +cse_suitable(#b_set{op=get_tuple_element}) -> true; cse_suitable(#b_set{op=put_tuple}) -> true; cse_suitable(#b_set{op={bif,tuple_size}}) -> %% Doing CSE for tuple_size/1 can prevent the @@ -1830,12 +1833,16 @@ opt_tup_size_is([], _, _, _Acc) -> none. %%% ssa_opt_sw({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> - {Linear,Count} = opt_sw(Linear0, #{}, Count0, []), + {Linear,Count} = opt_sw(Linear0, Count0, []), {St#st{ssa=Linear,cnt=Count}, FuncDb}. -opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) -> - Phis = opt_sw_phis(Is, Phis0), - case opt_sw_last(Last0, Phis) of +opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Sw0}=Blk0}|Bs], Count0, Acc) -> + %% Ensure that no label in the switch list is the same + %% as the failure label. + #b_switch{fail=Fail,list=List0} = Sw0, + List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], + Sw1 = beam_ssa:normalize(Sw0#b_switch{list=List}), + case Sw1 of #b_switch{arg=Arg,fail=Fail,list=[{Lit,Lbl}]} -> %% Rewrite a single value switch to a br. Bool = #b_var{name={'@ssa_bool',Count0}}, @@ -1843,7 +1850,7 @@ opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) - IsEq = #b_set{op={bif,'=:='},dst=Bool,args=[Arg,Lit]}, Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, Blk = Blk0#b_blk{is=Is++[IsEq],last=Br}, - opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]); + opt_sw(Bs, Count, [{L,Blk}|Acc]); #b_switch{arg=Arg,fail=Fail, list=[{#b_literal{val=B1},Lbl},{#b_literal{val=B2},Lbl}]} when B1 =:= not B2 -> @@ -1853,71 +1860,18 @@ opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) - IsBool = #b_set{op={bif,is_boolean},dst=Bool,args=[Arg]}, Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, Blk = Blk0#b_blk{is=Is++[IsBool],last=Br}, - opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]); - Last0 -> - opt_sw(Bs, Phis, Count0, [{L,Blk0}|Acc]); - Last -> - Blk = Blk0#b_blk{last=Last}, - opt_sw(Bs, Phis, Count0, [{L,Blk}|Acc]) + opt_sw(Bs, Count, [{L,Blk}|Acc]); + Sw0 -> + opt_sw(Bs, Count0, [{L,Blk0}|Acc]); + Sw -> + Blk = Blk0#b_blk{last=Sw}, + opt_sw(Bs, Count0, [{L,Blk}|Acc]) end; -opt_sw([{L,#b_blk{is=Is}=Blk}|Bs], Phis0, Count, Acc) -> - Phis = opt_sw_phis(Is, Phis0), - opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]); -opt_sw([], _Phis, Count, Acc) -> +opt_sw([{L,#b_blk{}=Blk}|Bs], Count, Acc) -> + opt_sw(Bs, Count, [{L,Blk}|Acc]); +opt_sw([], Count, Acc) -> {reverse(Acc),Count}. -opt_sw_phis([#b_set{op=phi,dst=Dst,args=Args}|Is], Phis) -> - case opt_sw_literals(Args, []) of - error -> - opt_sw_phis(Is, Phis); - Literals -> - opt_sw_phis(Is, Phis#{Dst=>Literals}) - end; -opt_sw_phis(_, Phis) -> Phis. - -opt_sw_last(#b_switch{arg=Arg,fail=Fail,list=List0}=Sw0, Phis) -> - case Phis of - #{Arg:=Values0} -> - Values = gb_sets:from_list(Values0), - - %% Prune the switch list to only contain the possible values. - List1 = [P || {Lit,_}=P <- List0, gb_sets:is_member(Lit, Values)], - - %% Now test whether the failure label can ever be reached. - Sw = case gb_sets:size(Values) =:= length(List1) of - true -> - %% The switch list has the same number of values as the phi node. - %% The values must be the same, because the values that were not - %% possible were pruned from the switch list. Therefore, the - %% failure label can't possibly be reached, and we can choose a - %% a new failure label by picking a value from the list. - case List1 of - [{#b_literal{},Lbl}|List] -> - Sw0#b_switch{fail=Lbl,list=List}; - [] -> - Sw0#b_switch{list=List1} - end; - false -> - %% There are some values in the phi node that are not in the - %% switch list; thus, the failure label can still be reached. - Sw0 - end, - beam_ssa:normalize(Sw); - #{} -> - %% Ensure that no label in the switch list is the same - %% as the failure label. - List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], - Sw = Sw0#b_switch{list=List}, - beam_ssa:normalize(Sw) - end. - -opt_sw_literals([{#b_literal{}=Lit,_}|T], Acc) -> - opt_sw_literals(T, [Lit|Acc]); -opt_sw_literals([_|_], _Acc) -> - error; -opt_sw_literals([], Acc) -> Acc. - - %%% %%% Merge blocks. %%% @@ -2196,7 +2150,6 @@ insert_def_is([#b_set{op=Op}=I|Is]=Is0, V, Def) -> Action0 = case Op of call -> beyond; 'catch_end' -> beyond; - set_tuple_element -> beyond; timeout -> beyond; _ -> here end, diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index df4de8d7bd..bad43a9c4e 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -124,6 +124,7 @@ passes(Opts) -> false -> ignore; true -> ?PASS(fix_tuples) end, + ?PASS(use_set_tuple_element), ?PASS(place_frames), ?PASS(fix_receives), @@ -857,6 +858,202 @@ fix_tuples(#st{ssa=Blocks0,cnt=Count0}=St) -> St#st{ssa=Blocks,cnt=Count}. %%% +%%% Introduce the set_tuple_element instructions to make +%%% multiple-field record updates faster. +%%% +%%% The expansion of record field updates, when more than one field is +%%% updated, but not a majority of the fields, will create a sequence of +%%% calls to `erlang:setelement(Index, Value, Tuple)` where Tuple in the +%%% first call is the original record tuple, and in the subsequent calls +%%% Tuple is the result of the previous call. Furthermore, all Index +%%% values are constant positive integers, and the first call to +%%% `setelement` will have the greatest index. Thus all the following +%%% calls do not actually need to test at run-time whether Tuple has type +%%% tuple, nor that the index is within the tuple bounds. +%%% +%%% Since this optimization introduces destructive updates, it used to +%%% be done as the very last Core Erlang pass before going to +%%% lower-level code. However, it turns out that this kind of destructive +%%% updates are awkward also in SSA code and can prevent or complicate +%%% type analysis and aggressive optimizations. +%%% +%%% NOTE: Because there no write barriers in the system, this kind of +%%% optimization can only be done when we are sure that garbage +%%% collection will not be triggered between the creation of the tuple +%%% and the destructive updates - otherwise we might insert pointers +%%% from an older generation to a newer. +%%% + +use_set_tuple_element(#st{ssa=Blocks0}=St) -> + Uses = count_uses(Blocks0), + RPO = reverse(beam_ssa:rpo(Blocks0)), + Blocks = use_ste_1(RPO, Uses, Blocks0), + St#st{ssa=Blocks}. + +use_ste_1([L|Ls], Uses, Blocks0) -> + {Blk0,Blocks} = use_ste_across(L, Uses, Blocks0), + #b_blk{is=Is0} = Blk0, + case use_ste_is(Is0, Uses) of + Is0 -> + use_ste_1(Ls, Uses, Blocks); + Is -> + Blk = Blk0#b_blk{is=Is}, + use_ste_1(Ls, Uses, Blocks#{L:=Blk}) + end; +use_ste_1([], _, Blocks) -> Blocks. + +%%% Optimize within a single block. + +use_ste_is([#b_set{}=I|Is0], Uses) -> + Is = use_ste_is(Is0, Uses), + case extract_ste(I) of + none -> + [I|Is]; + Extracted -> + use_ste_call(Extracted, I, Is, Uses) + end; +use_ste_is([], _Uses) -> []. + +use_ste_call({Dst0,Pos0,_Var0,_Val0}, Call1, Is0, Uses) -> + case get_ste_call(Is0, []) of + {Prefix,{Dst1,Pos1,Dst0,Val1},Call2,Is} + when Pos1 > 0, Pos0 > Pos1 -> + case is_single_use(Dst0, Uses) of + true -> + Call = Call1#b_set{dst=Dst1}, + Args = [Val1,Dst1,#b_literal{val=Pos1-1}], + Dsetel = Call2#b_set{op=set_tuple_element, + dst=Dst0, + args=Args}, + [Call|Prefix] ++ [Dsetel|Is]; + false -> + [Call1|Is0] + end; + _ -> + [Call1|Is0] + end. + +get_ste_call([#b_set{op=get_tuple_element}=I|Is], Acc) -> + get_ste_call(Is, [I|Acc]); +get_ste_call([#b_set{op=call}=I|Is], Acc) -> + case extract_ste(I) of + none -> + none; + Extracted -> + {reverse(Acc),Extracted,I,Is} + end; +get_ste_call(_, _) -> none. + +extract_ste(#b_set{op=call,dst=Dst, + args=[#b_remote{mod=#b_literal{val=M}, + name=#b_literal{val=F}}|Args]}) -> + case {M,F,Args} of + {erlang,setelement,[#b_literal{val=Pos},Tuple,Val]} -> + {Dst,Pos,Tuple,Val}; + {_,_,_} -> + none + end; +extract_ste(#b_set{}) -> none. + +%%% Optimize accross blocks within a try/catch block. + +use_ste_across(L, Uses, Blocks) -> + case map_get(L, Blocks) of + #b_blk{last=#b_br{bool=#b_var{}}}=Blk -> + try + use_ste_across_1(L, Blk, Uses, Blocks) + catch + throw:not_possible -> + {Blk,Blocks} + end; + #b_blk{}=Blk -> + {Blk,Blocks} + end. + +use_ste_across_1(L, Blk0, Uses, Blocks0) -> + #b_blk{is=IsThis,last=#b_br{bool=Bool,succ=Next}} = Blk0, + case reverse(IsThis) of + [#b_set{op=succeeded,dst=Bool,args=[Result]}=Succ0, + #b_set{op=call,args=[#b_remote{}|_],dst=Result}=Call1|Prefix] -> + case is_single_use(Bool, Uses) andalso + is_n_uses(2, Result, Uses) of + true -> ok; + false -> throw(not_possible) + end, + Call2 = use_ste_across_next(Next, Uses, Blocks0), + Is = [Call1,Call2], + case use_ste_is(Is, decrement_uses(Result, Uses)) of + [#b_set{}=Call,#b_set{op=set_tuple_element}=Ste] -> + Blocks1 = use_ste_fix_next(Ste, Next, Blocks0), + Succ = Succ0#b_set{args=[Call#b_set.dst]}, + Blk = Blk0#b_blk{is=reverse(Prefix, [Call,Succ])}, + Blocks = Blocks1#{L:=Blk}, + {Blk,Blocks}; + _ -> + throw(not_possible) + end; + _ -> + throw(not_possible) + end. + +use_ste_across_next(Next, Uses, Blocks) -> + case map_get(Next, Blocks) of + #b_blk{is=[#b_set{op=call,dst=Result,args=[#b_remote{}|_]}=Call, + #b_set{op=succeeded,dst=Bool,args=[Result]}], + last=#b_br{bool=Bool}} -> + case is_single_use(Bool, Uses) andalso + is_n_uses(2, Result, Uses) of + true -> ok; + false -> throw(not_possible) + end, + Call; + #b_blk{} -> + throw(not_possible) + end. + +use_ste_fix_next(Ste, Next, Blocks) -> + Blk0 = map_get(Next, Blocks), + #b_blk{is=[#b_set{op=call},#b_set{op=succeeded}],last=Br0} = Blk0, + Br = beam_ssa:normalize(Br0#b_br{bool=#b_literal{val=true}}), + Blk = Blk0#b_blk{is=[Ste],last=Br}, + Blocks#{Next:=Blk}. + +%% Count how many times each variable is used. + +count_uses(Blocks) -> + count_uses_blk(maps:values(Blocks), #{}). + +count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> + F = fun(I, CountMap) -> + foldl(fun(Var, Acc) -> + case Acc of + #{Var:=3} -> Acc; + #{Var:=C} -> Acc#{Var:=C+1}; + #{} -> Acc#{Var=>1} + end + end, CountMap, beam_ssa:used(I)) + end, + CountMap = F(Last, foldl(F, CountMap0, Is)), + count_uses_blk(Bs, CountMap); +count_uses_blk([], CountMap) -> CountMap. + +decrement_uses(V, Uses) -> + #{V:=C} = Uses, + Uses#{V:=C-1}. + +is_n_uses(N, V, Uses) -> + case Uses of + #{V:=N} -> true; + #{} -> false + end. + +is_single_use(V, Uses) -> + case Uses of + #{V:=1} -> true; + #{} -> false + end. + +%%% %%% Find out where frames should be placed. %%% diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 6fa02da89d..aa4720d222 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -23,7 +23,8 @@ -include("beam_ssa_opt.hrl"). -import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - partition/2,reverse/1,reverse/2,seq/2,sort/1]). + keyfind/3,partition/2,reverse/1,reverse/2, + seq/2,sort/1,split/2]). -define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). @@ -260,29 +261,34 @@ opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]) end; opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Fdb0, D, Sub, Acc) -> - Args = simplify_args(Args0, Sub, Ts0), + Ts0, Ds0, Fdb0, D, Sub0, Acc) -> + Args = simplify_args(Args0, Sub0, Ts0), I1 = beam_ssa:normalize(I0#b_set{args=Args}), - {Ts,Ds,Fdb,I} = opt_call(I1, D, Ts0, Ds0, Fdb0), - case {map_get(Dst, Ts),Is} of - {none,[#b_set{op=succeeded}]} -> + {Ts1,Ds,Fdb,I2} = opt_call(I1, D, Ts0, Ds0, Fdb0), + case {map_get(Dst, Ts1),Is} of + {_,[#b_set{op=succeeded}]} -> %% This call instruction is inside a try/catch %% block. Don't attempt to optimize it. - opt_is(Is, Ts, Ds, Fdb, D, Sub, [I|Acc]); + opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I2|Acc]); {none,_} -> %% This call never returns. The rest of the %% instructions will not be executed. Ret = #b_ret{arg=Dst}, - {no_return,Ret,reverse(Acc, [I]),Ds,Fdb,Sub}; - _ -> - opt_is(Is, Ts, Ds, Fdb, D, Sub, [I|Acc]) + {no_return,Ret,reverse(Acc, [I2]),Ds,Fdb,Sub0}; + {_,_} -> + case simplify_call(I2) of + #b_set{}=I -> + opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I|Acc]); + #b_literal{}=Lit -> + Sub = Sub0#{Dst=>Lit}, + Ts = maps:remove(Dst, Ts1), + opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc); + #b_var{}=Var -> + Ts = maps:remove(Dst, Ts1), + Sub = Sub0#{Dst=>Var}, + opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc) + end end; -opt_is([#b_set{op=set_tuple_element}=I0|Is], - Ts0, Ds0, Fdb, D, Sub, Acc) -> - %% This instruction lacks a return value and destructively updates its - %% source, so it needs special handling to update the source type. - {Ts, Ds, I} = opt_set_tuple_element(I0, Ts0, Ds0, Sub), - opt_is(Is, Ts, Ds, Fdb, D, Sub, [I|Acc]); opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], Ts0, Ds0, Fdb, D, Sub0, Acc) -> case Ds0 of @@ -334,6 +340,59 @@ opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) -> {reverse(Acc), Ts, Ds, Fdb, Sub}. +simplify_call(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I) -> + case Rem of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}} -> + case erl_bifs:is_pure(Mod, Name, length(Args)) of + true -> + simplify_remote_call(Mod, Name, Args, I); + false -> + I + end; + #b_remote{} -> + I + end; +simplify_call(I) -> I. + +%% Simplify a remote call to a pure BIF. +simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> + Tl; +simplify_remote_call(erlang, setelement, + [#b_literal{val=Pos}, + #b_literal{val=Tuple}, + #b_var{}=Value], I) + when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> + %% Position is a literal integer and the shape of the + %% tuple is known. + Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], + {Bef,[_|Aft]} = split(Pos - 1, Els0), + Els = Bef ++ [Value|Aft], + I#b_set{op=put_tuple,args=Els}; +simplify_remote_call(Mod, Name, Args0, I) -> + case make_literal_list(Args0) of + none -> + I; + Args -> + %% The arguments are literals. Try to evaluate the BIF. + try apply(Mod, Name, Args) of + Val -> + case cerl:is_literal_term(Val) of + true -> + #b_literal{val=Val}; + false -> + %% The value can't be expressed as a literal + %% (e.g. a pid). + I + end + catch + _:_ -> + %% Failed. Don't bother trying to optimize + %% the call. + I + end + end. + opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), case Fdb0 of @@ -381,28 +440,6 @@ update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> update_arg_types([], [], _CallId, _Ts) -> []. -opt_set_tuple_element(#b_set{op=set_tuple_element,args=Args0,dst=Dst}=I0, - Ts0, Ds0, Sub) -> - Args = simplify_args(Args0, Sub, Ts0), - [Val,#b_var{}=Src,#b_literal{val=N}] = Args, - - SrcType0 = get_type(Src, Ts0), - ValType = get_type(Val, Ts0), - Index = N + 1, - - #t_tuple{size=Size,elements=Es0} = SrcType0, - true = Index =< Size, %Assertion. - - Es = set_element_type(Index, ValType, Es0), - SrcType = SrcType0#t_tuple{elements=Es}, - - I = beam_ssa:normalize(I0#b_set{args=Args}), - - Ts = Ts0#{ Dst => any, Src => SrcType }, - Ds = Ds0#{ Dst => I }, - - {Ts, Ds, I}. - simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> case is_safe_bool_op(Args, Ts) of true -> @@ -480,10 +517,19 @@ simplify(#b_set{op={bif,'=='},args=Args}=I, Ts) -> end; simplify(#b_set{op={bif,'=:='},args=[Same,Same]}, _Ts) -> #b_literal{val=true}; -simplify(#b_set{op={bif,'=:='},args=Args}=I, Ts) -> - case meet(get_types(Args, Ts)) of - none -> #b_literal{val=false}; - _ -> eval_bif(I, Ts) +simplify(#b_set{op={bif,'=:='},args=[A1,_A2]=Args}=I, Ts) -> + [T1,T2] = get_types(Args, Ts), + case meet(T1, T2) of + none -> + #b_literal{val=false}; + _ -> + case {t_is_boolean(T1),T2} of + {true,#t_atom{elements=[true]}} -> + %% Bool =:= true ==> Bool + A1; + {_,_} -> + eval_bif(I, Ts) + end end; simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> Types = get_types(Args, Ts), @@ -626,41 +672,49 @@ anno_float_arg(_) -> convert. opt_terminator(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> beam_ssa:normalize(Br); -opt_terminator(#b_br{bool=#b_var{}=V}=Br, Ts, Ds) -> - #{V:=Set} = Ds, - case Set of - #b_set{op={bif,'=:='},args=[Bool,#b_literal{val=true}]} -> - case t_is_boolean(get_type(Bool, Ts)) of - true -> - %% Bool =:= true ==> Bool - simplify_not(Br#b_br{bool=Bool}, Ts, Ds); - false -> - Br - end; - #b_set{} -> - simplify_not(Br, Ts, Ds) - end; +opt_terminator(#b_br{bool=#b_var{}}=Br, Ts, Ds) -> + simplify_not(Br, Ts, Ds); opt_terminator(#b_switch{arg=#b_literal{}}=Sw, _Ts, _Ds) -> beam_ssa:normalize(Sw); -opt_terminator(#b_switch{arg=#b_var{}=V}=Sw0, Ts, Ds) -> - Type = get_type(V, Ts), +opt_terminator(#b_switch{arg=#b_var{}=V}=Sw, Ts, Ds) -> + case get_type(V, Ts) of + any -> + beam_ssa:normalize(Sw); + Type -> + beam_ssa:normalize(opt_switch(Sw, Type, Ts, Ds)) + end; +opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret. + + +opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) -> + List = prune_switch_list(List0, Fail, Type, Ts), + Sw1 = Sw0#b_switch{list=List}, case Type of #t_integer{elements={_,_}=Range} -> - simplify_switch_int(Sw0, Range); - _ -> + simplify_switch_int(Sw1, Range); + #t_atom{elements=[_|_]} -> case t_is_boolean(Type) of true -> - case simplify_switch_bool(Sw0, Ts, Ds) of - #b_br{}=Br -> - opt_terminator(Br, Ts, Ds); - Sw -> - beam_ssa:normalize(Sw) - end; + #b_br{} = Br = simplify_switch_bool(Sw1, Ts, Ds), + opt_terminator(Br, Ts, Ds); false -> - beam_ssa:normalize(Sw0) - end + simplify_switch_atom(Type, Sw1) + end; + _ -> + Sw1 + end. + +prune_switch_list([{_,Fail}|T], Fail, Type, Ts) -> + prune_switch_list(T, Fail, Type, Ts); +prune_switch_list([{Arg,_}=Pair|T], Fail, Type, Ts) -> + case meet(get_type(Arg, Ts), Type) of + none -> + %% Different types. This value can never match. + prune_switch_list(T, Fail, Type, Ts); + _ -> + [Pair|prune_switch_list(T, Fail, Type, Ts)] end; -opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret. +prune_switch_list([], _, _, _) -> []. update_successors(#b_br{bool=#b_literal{val=true},succ=S}, Ts, D) -> update_successor(S, Ts, D); @@ -669,8 +723,8 @@ update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> true -> %% This variable is defined in this block and is only %% referenced by this br terminator. Therefore, there is - %% no need to include the type database passed on to the - %% successors of this block. + %% no need to include it in the type database passed on to + %% the successors of this block. Ts = maps:remove(Bool, Ts0), {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0), D = update_successor(Fail, FailTs, D0), @@ -830,6 +884,9 @@ type(call, [#b_remote{mod=#b_literal{val=Mod}, end; {erlang,'--',[_,_]} -> list; + {lists,F,Args} -> + Types = get_types(Args, Ts), + lists_function_type(F, Types); {math,_,_} -> case is_math_bif(Name, length(Args)) of false -> any; @@ -921,6 +978,70 @@ arith_op_type(Args, Ts) -> (_, _) -> none end, unknown, Types). +lists_function_type(F, Types) -> + case {F,Types} of + %% Functions that return booleans. + {all,[_,_]} -> + t_boolean(); + {any,[_,_]} -> + t_boolean(); + {keymember,[_,_,_]} -> + t_boolean(); + {member,[_,_]} -> + t_boolean(); + {prefix,[_,_]} -> + t_boolean(); + {suffix,[_,_]} -> + t_boolean(); + + %% Functions that return lists. + {dropwhile,[_,_]} -> + list; + {duplicate,[_,_]} -> + list; + {filter,[_,_]} -> + list; + {flatten,[_]} -> + list; + {map,[_Fun,List]} -> + same_length_type(List); + {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl; + MapFold =:= mapfoldr -> + #t_tuple{size=2,exact=true, + elements=#{1=>same_length_type(List)}}; + {partition,[_,_]} -> + t_two_tuple(list, list); + {reverse,[List]} -> + same_length_type(List); + {sort,[List]} -> + same_length_type(List); + {splitwith,[_,_]} -> + t_two_tuple(list, list); + {takewhile,[_,_]} -> + list; + {unzip,[List]} -> + ListType = same_length_type(List), + t_two_tuple(ListType, ListType); + {usort,[List]} -> + same_length_type(List); + {zip,[_,_]} -> + list; + {zipwith,[_,_,_]} -> + list; + {_,_} -> + any + end. + +%% For a lists function that return a list of the same +%% length as the input list, return the type of the list. +same_length_type(cons) -> cons; +same_length_type(nil) -> nil; +same_length_type(_) -> list. + +t_two_tuple(Type1, Type2) -> + #t_tuple{size=2,exact=true, + elements=#{1=>Type1,2=>Type2}}. + %% will_succeed(TestOperation, Type) -> yes|no|maybe. %% Test whether TestOperation applied to an argument of type Type %% will succeed. Return yes, no, or maybe. @@ -1057,6 +1178,17 @@ bs_match_type(utf16, _) -> bs_match_type(utf32, _) -> ?UNICODE_INT. +simplify_switch_atom(#t_atom{elements=Atoms}, #b_switch{list=List0}=Sw) -> + case sort([A || {#b_literal{val=A},_} <- List0]) of + Atoms -> + %% All possible atoms are included in the list. The + %% failure label will never be used. + [{_,Fail}|List] = List0, + Sw#b_switch{fail=Fail,list=List}; + _ -> + Sw + end. + simplify_switch_int(#b_switch{list=List0}=Sw, {Min,Max}) -> List1 = sort(List0), Vs = [V || {#b_literal{val=V},_} <- List1], @@ -1101,14 +1233,14 @@ simplify_is_record(I, any, _Size, _Tag, _Ts) -> simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> #b_literal{val=false}. -simplify_switch_bool(#b_switch{arg=B,list=List0}=Sw, Ts, Ds) -> - List = sort(List0), - case List of - [{#b_literal{val=false},Fail},{#b_literal{val=true},Succ}] -> - simplify_not(#b_br{bool=B,succ=Succ,fail=Fail}, Ts, Ds); - [_|_] -> - Sw - end. +simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds) -> + FalseVal = #b_literal{val=false}, + TrueVal = #b_literal{val=true}, + List1 = List0 ++ [{FalseVal,Fail},{TrueVal,Fail}], + {_,FalseLbl} = keyfind(FalseVal, 1, List1), + {_,TrueLbl} = keyfind(TrueVal, 1, List1), + Br = beam_ssa:normalize(#b_br{bool=B,succ=TrueLbl,fail=FalseLbl}), + simplify_not(Br, Ts, Ds). simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> case Ds of @@ -1122,7 +1254,8 @@ simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> end; #{} -> Br0 - end. + end; +simplify_not(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> Br. %%% %%% Calculate the set of variables that are only used once in the diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index aa7b190670..5175be3ad5 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -28,7 +28,8 @@ -export([module/2, format_error/1]). -export([type_anno/1, type_anno/2, type_anno/4]). --import(lists, [any/2,dropwhile/2,foldl/3,map/2,reverse/1,zip/2]). +-import(lists, [any/2,dropwhile/2,foldl/3,map/2,member/2,reverse/1, + seq/2,sort/1,zip/2]). %% To be called by the compiler. @@ -140,8 +141,8 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> -type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}). -record(st, %Emulation state - {x=init_regs(0, term) :: reg_tab(),%x register info. - y=init_regs(0, initialized) :: reg_tab(),%y register info. + {x :: reg_tab(), %x register info. + y :: reg_tab(), %y register info. f=init_fregs(), % numy=none, %Number of y registers. h=0, %Available heap size. @@ -188,7 +189,7 @@ index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> index_parameter_types(Fs, Acc0) end; index_parameter_types([], Acc) -> - gb_trees:from_orddict(lists:sort(Acc)). + gb_trees:from_orddict(sort(Acc)). index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) -> Type = case Type0 of @@ -211,14 +212,10 @@ validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) -> validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> Offset = 1 + length(Ls1) + 1 + length(Ls2), - EntryOK = lists:member(Entry, Ls2), + EntryOK = member(Entry, Ls2), if EntryOK -> - St = init_state(Arity), - Vst0 = #vst{current=St, - branched=gb_trees_from_list([{L,St} || L <- Ls1]), - labels=gb_sets:from_list(Ls1++Ls2), - ft=Ft}, + Vst0 = init_vst(Arity, Ls1, Ls2, Ft), MFA = {Mod,Name,Arity}, Vst = valfun(Is, MFA, Offset, Vst0), validate_fun_info_branches(Ls1, MFA, Vst); @@ -262,10 +259,16 @@ labels_1([{line,_}|Is], R) -> labels_1(Is, R) -> {reverse(R),Is}. -init_state(Arity) -> +init_vst(Arity, Ls1, Ls2, Ft) -> Xs = init_regs(Arity, term), Ys = init_regs(0, initialized), - kill_heap_allocation(#st{x=Xs,y=Ys,numy=none,ct=[]}). + St = #st{x=Xs,y=Ys}, + Branches = gb_trees_from_list([{L,St} || L <- Ls1]), + Labels = gb_sets:from_list(Ls1++Ls2), + #vst{branched=Branches, + current=St, + labels=Labels, + ft=Ft}. kill_heap_allocation(St) -> St#st{h=0,hf=0}. @@ -273,7 +276,7 @@ kill_heap_allocation(St) -> init_regs(0, _) -> gb_trees:empty(); init_regs(N, Type) -> - gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]). + gb_trees_from_list([{R,Type} || R <- seq(0, N-1)]). valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Targets = gb_trees:keys(Targets0), @@ -324,7 +327,7 @@ valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - extract_term(binary, [Ctx], Dst, Vst, Vst0); + extract_term(binary, bs_get_tail, [Ctx], Dst, Vst, Vst0); valfun_1(bs_init_writable=I, Vst) -> call(I, 1, Vst); valfun_1(build_stacktrace=I, Vst) -> @@ -338,15 +341,15 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - create_term({float,[]}, Dst, Vst); -valfun_1({kill,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); -valfun_1({init,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); + create_term({float,[]}, fmove, [], Dst, Vst); +valfun_1({kill,Reg}, Vst) -> + create_tag(initialized, kill, [], Reg, Vst); +valfun_1({init,Reg}, Vst) -> + create_tag(initialized, init, [], Reg, Vst); valfun_1({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> - case is_bif_safe(Op, length(Src)) of +valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) -> + case is_bif_safe(Op, length(Ss)) of false -> %% Since the BIF can fail, make sure that any catch state %% is updated. @@ -354,16 +357,16 @@ valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> true -> %% It can't fail, so we finish handling it here (not updating %% catch state). - validate_src(Src, Vst), - Type = bif_type(Op, Src, Vst), - set_type_reg_expr(Type, I, Dst, Vst) + validate_src(Ss, Vst), + Type = bif_return_type(Op, Ss, Vst), + extract_term(Type, {bif,Op}, Ss, Dst, Vst) end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> assert_not_fragile(A, Vst0), assert_not_fragile(B, Vst0), Vst = eat_heap(2, Vst0), - create_term(cons, Dst, Vst); + create_term(cons, put_list, [A, B], Dst, Vst); valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> _ = [assert_not_fragile(El, Vst0) || El <- Elements], Size = length(Elements), @@ -374,10 +377,10 @@ valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> {Es, Index + 1} end, {#{}, 1}, Elements), Type = {tuple,Size,Es}, - create_term(Type, Dst, Vst); + create_term(Type, put_tuple2, [], Dst, Vst); valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), - Vst = create_term(tuple_in_progress, Dst, Vst1), + Vst = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1), #vst{current=St0} = Vst, St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; @@ -390,7 +393,7 @@ valfun_1({put,Src}, Vst0) -> error(not_building_a_tuple); #st{puts_left={1,{Dst,Sz,Es}}} -> St = St0#st{puts_left=none}, - create_term({tuple,Sz,Es}, Dst, Vst#vst{current=St}); + create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St}); #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) -> Index = Sz - PutsLeft + 1, Es = Es0#{ Index => get_term_type(Src, Vst0) }, @@ -420,7 +423,7 @@ valfun_1({line,_}, Vst) -> Vst; %% Exception generating calls valfun_1({call_ext,Live,Func}=I, Vst) -> - case return_type(Func, Vst) of + case call_return_type(Func, Vst) of exception -> verify_live(Live, Vst), %% The stack will be scanned, so Y registers @@ -447,71 +450,73 @@ valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> deallocate(Vst); valfun_1({deallocate,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_1({trim,N,Remaining}, #vst{current=#st{y=Yregs0,numy=NumY}=St}=Vst) -> +valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) -> + #st{numy=NumY} = St0, if - N =< NumY, N+Remaining =:= NumY -> - Yregs1 = [{Y-N,Type} || {Y,Type} <- gb_trees:to_list(Yregs0), Y >= N], - Yregs = gb_trees_from_list(Yregs1), - Vst#vst{current=St#st{y=Yregs,numy=NumY-N,aliases=#{}}}; - true -> - error({trim,N,Remaining,allocated,NumY}) + N =< NumY, N+Remaining =:= NumY -> + Vst#vst{current=trim_stack(N, 0, NumY, St0)}; + N > NumY; N+Remaining =/= NumY -> + error({trim,N,Remaining,allocated,NumY}) end; %% Catch & try. valfun_1({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(catchtag, Dst, Fail, Vst); valfun_1({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(trytag, Dst, Fail, Vst); -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {catchtag,Fail} -> - Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xregs = gb_trees:enter(0, term, St#st.x), - Vst#vst{current=St#st{x=Xregs,ct=Fails,fls=undefined,aliases=#{}}}; - Type -> - error({bad_type,Type}) +valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> + case get_tag_type(Reg, Vst0) of + {catchtag,Fail} -> + %% {x,0} contains the caught term, if any. + create_term(term, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0)); + Type -> + error({wrong_tag_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst) -> - case get_special_y_type(Reg, Vst) of - {trytag,Fail} -> - St = St0#st{ct=Fails,fls=undefined}, - set_catch_end(Reg, Vst#vst{current=St}); - Type -> - error({bad_type,Type}) +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst) -> + case get_tag_type(Reg, Vst) of + {trytag,Fail} -> + %% Kill the catch tag, note that x registers are unaffected. + kill_catch_tag(Reg, Vst); + Type -> + error({wrong_tag_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {trytag,Fail} -> - Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), - Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined,aliases=#{}}}; - Type -> - error({bad_type,Type}) +valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> + case get_tag_type(Reg, Vst0) of + {trytag,Fail} -> + %% Kill the catch tag and all x registers. + Vst1 = prune_x_regs(0, kill_catch_tag(Reg, Vst0)), + + %% Class:Error:Stacktrace + Vst2 = create_term({atom,[]}, try_case, [], {x,0}, Vst1), + Vst = create_term(term, try_case, [], {x,1}, Vst2), + create_term(term, try_case, [], {x,2}, Vst); + Type -> + error({wrong_tag_type,Type}) end; valfun_1({get_list,Src,D1,D2}, Vst0) -> assert_not_literal(Src), assert_type(cons, Src, Vst0), - Vst = extract_term(term, [Src], D1, Vst0), - extract_term(term, [Src], D2, Vst); + Vst = extract_term(term, get_hd, [Src], D1, Vst0), + extract_term(term, get_tl, [Src], D2, Vst); valfun_1({get_hd,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - extract_term(term, [Src], Dst, Vst); + extract_term(term, get_hd, [Src], Dst, Vst); valfun_1({get_tl,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - extract_term(term, [Src], Dst, Vst); + extract_term(term, get_tl, [Src], Dst, Vst); valfun_1({get_tuple_element,Src,N,Dst}, Vst) -> assert_not_literal(Src), assert_type({tuple_element,N+1}, Src, Vst), Type = get_element_type(N+1, Src, Vst), - extract_term(Type, [Src], Dst, Vst); + extract_term(Type, get_tuple_element, [Src], Dst, Vst); valfun_1({jump,{f,Lbl}}, Vst) -> kill_state(branch_state(Lbl, Vst)); valfun_1(I, Vst) -> valfun_2(I, Vst). init_try_catch_branch(Tag, Dst, Fail, Vst0) -> - Vst1 = set_type_y({Tag,[Fail]}, Dst, Vst0), + Vst1 = create_tag({Tag,[Fail]}, 'try_catch', [], Dst, Vst0), #vst{current=#st{ct=Fails}=St0} = Vst1, CurrentSt = St0#st{ct=[[Fail]|Fails]}, @@ -603,9 +608,6 @@ valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs -valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}=I, Vst0) -> - Vst = type_test(Fail, {tuple,[0],#{}}, Tuple, Vst0), - set_type_reg_expr({integer,[]}, I, Dst, Vst); valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> PosType = get_durable_term_type(Pos, Vst0), ElementType = case PosType of @@ -615,28 +617,18 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> InferredType = {tuple,[get_tuple_size(PosType)],#{}}, Vst1 = branch_state(Fail, Vst0), Vst = update_type(fun meet/2, InferredType, Tuple, Vst1), - extract_term(ElementType, [Tuple], Dst, Vst); + extract_term(ElementType, {bif,element}, [Tuple], Dst, Vst); valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); valfun_4(raw_raise=I, Vst) -> call(I, 3, Vst); -valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> - validate_src(Ss, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = update_type(fun meet/2, map, Map, Vst1), - extract_term(term, Ss, Dst, Vst); -valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> - validate_src(Ss, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = update_type(fun meet/2, map, Map, Vst1), - extract_term(bool, Ss, Dst, Vst); valfun_4({bif,Op,{f,Fail},[Cons]=Ss,Dst}, Vst0) when Op =:= hd; Op =:= tl -> validate_src(Ss, Vst0), Vst = type_test(Fail, cons, Cons, Vst0), - Type = bif_type(Op, Ss, Vst), - extract_term(Type, Ss, Dst, Vst); + Type = bif_return_type(Op, Ss, Vst), + extract_term(Type, {bif,Op}, Ss, Dst, Vst); valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst0) -> validate_src(Ss, Vst0), Vst1 = branch_state(Fail, Vst0), @@ -648,8 +640,8 @@ valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst0) -> update_type(fun meet/2, T, Arg, Vsti) end, Vst1, zip(Ss, ArgTypes)), - Type = bif_type(Op, Ss, Vst), - extract_term(Type, Ss, Dst, Vst); + Type = bif_return_type(Op, Ss, Vst), + extract_term(Type, {bif,Op}, Ss, Dst, Vst); valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> validate_src(Ss, Vst0), verify_live(Live, Vst0), @@ -663,9 +655,9 @@ valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> update_type(fun meet/2, T, Arg, Vsti) end, Vst2, zip(Ss, ArgTypes)), - Type = bif_type(Op, Ss, Vst3), + Type = bif_return_type(Op, Ss, Vst3), Vst = prune_x_regs(Live, Vst3), - extract_term(Type, Ss, Dst, Vst, Vst0); + extract_term(Type, {gc_bif,Op}, Ss, Dst, Vst, Vst0); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> assert_not_fragile({x,0}, Vst), kill_state(Vst); @@ -677,7 +669,7 @@ valfun_4({loop_rec,{f,Fail},Dst}, Vst0) -> %% remove_message/0 is executed. If control transfers %% to the loop_rec_end/1 instruction, no part of %% this term must be stored in a Y register. - create_term({fragile,term}, Dst, Vst); + create_term({fragile,term}, loop_rec, [], Dst, Vst); valfun_4({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); @@ -696,20 +688,22 @@ valfun_4({set_tuple_element,Src,Tuple,N}, Vst) -> I = N + 1, assert_not_fragile(Src, Vst), assert_type({tuple_element,I}, Tuple, Vst), + %% Manually update the tuple type; we can't rely on the ordinary update + %% helpers as we must support overwriting (rather than just widening or + %% narrowing) known elements, and we can't use extract_term either since + %% the source tuple may be aliased. {tuple, Sz, Es0} = get_term_type(Tuple, Vst), Es = set_element_type(I, get_term_type(Src, Vst), Es0), - set_aliased_type({tuple, Sz, Es}, Tuple, Vst); + override_type({tuple, Sz, Es}, Tuple, Vst); %% Match instructions. valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst0) -> assert_term(Src, Vst0), assert_choices(Choices), - Vst = branch_state(Fail, Vst0), - kill_state(select_val_branches(Src, Choices, Vst)); -valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst0) -> - assert_type(tuple, Tuple, Vst0), + select_val_branches(Fail, Src, Choices, Vst0); +valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> + assert_type(tuple, Tuple, Vst), assert_arities(Choices), - Vst = branch_state(Fail, Vst0), - kill_state(branch_arities(Choices, Tuple, Vst)); + select_arity_branches(Fail, Choices, Tuple, Vst); %% New bit syntax matching instructions. valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> @@ -735,19 +729,18 @@ valfun_4({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); valfun_4({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_4({test,bs_get_integer2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_float2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {float, []}, Dst, Vst); -valfun_4({test,bs_get_binary2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - Type = propagate_fragility(term, [Ctx], Vst), - validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst); -valfun_4({test,bs_get_utf8,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_utf16,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_utf32,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_integer2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {float, []}, Dst, Vst); +valfun_4({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, binary, Dst, Vst); +valfun_4({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); valfun_4({bs_save2,Ctx,SavePoint}, Vst) -> bsm_save(Ctx, SavePoint, Vst); valfun_4({bs_restore2,Ctx,SavePoint}, Vst) -> @@ -757,7 +750,7 @@ valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - create_term(bs_position, Dst, Vst); + create_term(bs_position, bs_get_position, [Ctx], Dst, Vst); valfun_4({bs_set_position, Ctx, Pos}, Vst) -> bsm_validate_context(Ctx, Vst), assert_type(bs_position, Pos, Vst), @@ -826,13 +819,13 @@ valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> assert_not_fragile(A, Vst), assert_not_fragile(B, Vst), - create_term({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, bs_add, [A, B], Dst, branch_state(Fail, Vst)); valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - create_term({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, bs_utf8_size, [A], Dst, branch_state(Fail, Vst)); valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - create_term({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, bs_utf16_size, [A], Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -845,7 +838,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - create_term(binary, Dst, Vst); + create_term(binary, bs_init2, [], Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -858,7 +851,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - create_term(binary, Dst, Vst); + create_term(binary, bs_init_bits, [], Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -867,12 +860,12 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - create_term(binary, Dst, Vst); + create_term(binary, bs_append, [Bin], Dst, Vst); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_not_fragile(Bits, Vst0), assert_not_fragile(Bin, Vst0), Vst = branch_state(Fail, Vst0), - create_term(binary, Dst, Vst); + create_term(binary, bs_private_append, [Bin], Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> @@ -897,10 +890,10 @@ valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> assert_not_fragile(Src, Vst), branch_state(Fail, Vst); %% Map instructions. -valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Fail, Src, Dst, Live, List, Vst); -valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> verify_get_map(Fail, Src, List, Vst); valfun_4(_, _) -> @@ -926,10 +919,10 @@ verify_get_map(Fail, Src, List, Vst0) -> %% {get_map_elements,{f,7},{x,1},{list,[{atom,a},{x,1},{atom,b},{x,2}]}}. %% %% If 'a' exists but not 'b', {x,1} is overwritten when we jump to {f,7}. -clobber_map_vals([_Key,Dst|T], Map, Vst0) -> +clobber_map_vals([Key,Dst|T], Map, Vst0) -> case is_reg_defined(Dst, Vst0) of true -> - Vst = extract_term(term, [Map], Dst, Vst0), + Vst = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vst0), clobber_map_vals(T, Map, Vst); false -> clobber_map_vals(T, Map, Vst0) @@ -941,14 +934,14 @@ extract_map_keys([Key,_Val|T]) -> [Key|extract_map_keys(T)]; extract_map_keys([]) -> []. -extract_map_vals([Src,Dst|Vs], Map, Vst0, Vsti0) -> - assert_term(Src, Vst0), - Vsti = extract_term(term, [Map], Dst, Vsti0), +extract_map_vals([Key,Dst|Vs], Map, Vst0, Vsti0) -> + assert_term(Key, Vst0), + Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0), extract_map_vals(Vs, Map, Vst0, Vsti); extract_map_vals([], _Map, _Vst0, Vst) -> Vst. -verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> +verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> assert_type(map, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), @@ -958,7 +951,7 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> Vst = prune_x_regs(Live, Vst2), Keys = extract_map_keys(List), assert_unique_map_keys(Keys), - create_term(map, Dst, Vst). + create_term(map, Op, [Src], Dst, Vst). %% %% Common code for validating bs_start_match* instructions. @@ -971,25 +964,28 @@ validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) -> %% #ms{} can represent either a match context or a term, so we have to mark %% the source as a term if it fails, and retain the incoming type if it %% succeeds (match context or not). + %% + %% The override_type hack is only needed until we get proper union types. complex_test(Fail, fun(FailVst) -> - set_aliased_type(term, Src, FailVst) + override_type(term, Src, FailVst) end, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - extract_term(Type, [Src], Dst, SuccVst, Vst) + extract_term(Type, bs_start_match, [Src], Dst, + SuccVst, Vst) end, Vst). %% %% Common code for validating bs_get* instructions. %% -validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) -> +validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst0) -> bsm_validate_context(Ctx, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), Vst1 = prune_x_regs(Live, Vst0), Vst = branch_state(Fail, Vst1), - create_term(Type, Dst, Vst). + extract_term(Type, Op, [Ctx], Dst, Vst). %% %% Common code for validating bs_skip_utf* instructions. @@ -1030,14 +1026,15 @@ kill_state(Vst) -> %% A "plain" call. %% The stackframe must be initialized. %% The instruction will return to the instruction following the call. -call(Name, Live, #vst{current=St}=Vst) -> - verify_call_args(Name, Live, Vst), - verify_y_init(Vst), - case return_type(Name, Vst) of - Type when Type =/= exception -> - %% Type is never 'exception' because it has been handled earlier. - Xs = gb_trees_from_list([{0,Type}]), - Vst#vst{current=St#st{x=Xs,f=init_fregs(),aliases=#{}}} +call(Name, Live, #vst{current=St0}=Vst0) -> + verify_call_args(Name, Live, Vst0), + verify_y_init(Vst0), + case call_return_type(Name, Vst0) of + Type when Type =/= exception -> + %% Type is never 'exception' because it has been handled earlier. + St = St0#st{f=init_fregs(),aliases=#{}}, + Vst = prune_x_regs(0, Vst0#vst{current=St}), + create_term(Type, call, [], {x,0}, Vst) end. %% Tail call. @@ -1053,40 +1050,36 @@ tail_call(Name, Live, Vst0) -> verify_call_args(_, 0, #vst{}) -> ok; verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - verify_local_call(Lbl, Live, Vst); + verify_local_args(Live - 1, Lbl, #{}, Vst); verify_call_args(_, Live, Vst) when is_integer(Live)-> - verify_call_args_1(Live, Vst); + verify_remote_args_1(Live - 1, Vst); verify_call_args(_, Live, _) -> error({bad_number_of_live_regs,Live}). -verify_call_args_1(0, _) -> ok; -verify_call_args_1(N, Vst) -> - X = N - 1, - assert_not_fragile({x,X}, Vst), - verify_call_args_1(X, Vst). - -verify_local_call(Lbl, Live, Vst) -> - TRegs = typed_call_regs(Live, Vst), - [verify_arg_type(Lbl, R, Type, Vst) || {R, Type} <- TRegs], - verify_no_ms_aliases(TRegs), - ok. +verify_remote_args_1(-1, _) -> + ok; +verify_remote_args_1(X, Vst) -> + assert_not_fragile({x, X}, Vst), + verify_remote_args_1(X - 1, Vst). -typed_call_regs(0, _Vst) -> - []; -typed_call_regs(Live0, Vst) -> - Live = Live0 - 1, - R = {x,Live}, - [{R, get_move_term_type(R, Vst)} | typed_call_regs(Live, Vst)]. - -%% Verifies that the same match context isn't present twice. -verify_no_ms_aliases(Regs) -> - CtxIds = [Id || {_, #ms{id=Id}} <- Regs], - UniqueCtxIds = ordsets:from_list(CtxIds), - if - length(UniqueCtxIds) < length(CtxIds) -> - error({multiple_match_contexts, Regs}); - length(UniqueCtxIds) =:= length(CtxIds) -> - ok +verify_local_args(-1, _Lbl, _CtxIds, _Vst) -> + ok; +verify_local_args(X, Lbl, CtxIds, Vst) -> + Reg = {x, X}, + case get_raw_type(Reg, Vst) of + #ms{id=Id}=Type -> + case CtxIds of + #{ Id := Other } -> + error({multiple_match_contexts, [Reg, Other]}); + #{} -> + verify_arg_type(Lbl, Reg, Type, Vst), + verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst) + end; + {fragile,_} -> + error({fragile_message_reference, Reg}); + Type -> + verify_arg_type(Lbl, Reg, Type, Vst), + verify_local_args(X - 1, Lbl, CtxIds, Vst) end. %% Verifies that the given argument narrows to what the function expects. @@ -1132,6 +1125,25 @@ allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) -> deallocate(#vst{current=St}=Vst) -> Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}. +trim_stack(From, To, Top, #st{y=Ys0}=St) when From =:= Top -> + Ys = foldl(fun(Y, Acc) -> + gb_trees:delete(Y, Acc) + end, Ys0, seq(To, From - 1)), + %% Note that all aliases and defs are wiped. This is perhaps a bit too + %% conservative, but preserving them won't be easy until type management + %% is refactored. + St#st{aliases=#{},defs=#{},numy=To,y=Ys}; +trim_stack(From, To, Top, St0) -> + #st{y=Ys0} = St0, + + Ys = case gb_trees:lookup(From, Ys0) of + none -> error({invalid_shift,{y,From},{y,To}}); + {value,Type} -> gb_trees:enter(To, Type, Ys0) + end, + + St = St0#st{y=Ys}, + trim_stack(From + 1, To + 1, Top, St). + test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -1319,7 +1331,7 @@ bsm_save(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots}, - set_type_reg(Ctx, Reg, Vst); + override_type(Ctx, Reg, Vst); _ -> error({illegal_save,SavePoint}) end. @@ -1338,49 +1350,78 @@ bsm_restore(Reg, SavePoint, Vst) -> _ -> error({illegal_restore,SavePoint,range}) end. -select_val_branches(Src, Choices, Vst) -> - Infer = infer_types(Src, Vst), - select_val_branches_1(Choices, Src, Infer, Vst). +select_val_branches(Fail, Src, Choices, Vst0) -> + Vst = svb_1(Choices, Src, Vst0), + kill_state(branch_state(Fail, Vst)). + +svb_1([Val,{f,L}|T], Src, Vst0) -> + Vst = complex_test(L, + fun(BranchVst) -> + update_eq_types(Val, Src, BranchVst) + end, + fun(FailVst) -> + update_ne_types(Val, Src, FailVst) + end, Vst0), + svb_1(T, Src, Vst); +svb_1([], _, Vst) -> + Vst. + +select_arity_branches(Fail, List, Tuple, Vst0) -> + Type = get_durable_term_type(Tuple, Vst0), + Vst = sab_1(List, Tuple, Type, Vst0), + kill_state(branch_state(Fail, Vst)). -select_val_branches_1([Val,{f,L}|T], Src, Infer, Vst0) -> - Vst1 = set_aliased_type(Val, Src, Infer(Val, Vst0)), - Vst = branch_state(L, Vst1), - select_val_branches_1(T, Src, Infer, Vst); -select_val_branches_1([], _, _, Vst) -> Vst. +sab_1([Sz,{f,L}|T], Tuple, {tuple,[_],Es}=Type0, Vst0) -> + #vst{current=St0} = Vst0, + Vst1 = update_type(fun meet/2, {tuple,Sz,Es}, Tuple, Vst0), + Vst2 = branch_state(L, Vst1), + Vst = Vst2#vst{current=St0}, + + sab_1(T, Tuple, Type0, Vst); +sab_1([Sz,{f,L}|T], Tuple, {tuple,Sz,_Es}=Type, Vst0) -> + %% The type is already correct. (This test is redundant.) + Vst = branch_state(L, Vst0), + sab_1(T, Tuple, Type, Vst); +sab_1([_,{f,_}|T], Tuple, Type, Vst) -> + %% We already have an established different exact size for the tuple. + %% This label can't possibly be reached. + sab_1(T, Tuple, Type, Vst); +sab_1([], _, _, #vst{}=Vst) -> + Vst. infer_types(Src, Vst) -> case get_def(Src, Vst) of - {bif,tuple_size,{f,_},[Tuple],_} -> + {{bif,tuple_size}, [Tuple]} -> fun({integer,Arity}, S) -> update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); (_, S) -> S end; - {bif,'=:=',{f,_},[ArityReg,{integer,_}=Val],_} when ArityReg =/= Src -> + {{bif,'=:='},[ArityReg,{integer,_}=Val]} when ArityReg =/= Src -> fun({atom,true}, S) -> Infer = infer_types(ArityReg, S), Infer(Val, S); (_, S) -> S end; - {bif,is_atom,{f,_},[Src],_} -> - infer_type_test_bif({atom,[]}, Src); - {bif,is_boolean,{f,_},[Src],_} -> - infer_type_test_bif(bool, Src); - {bif,is_binary,{f,_},[Src],_} -> - infer_type_test_bif(binary, Src); - {bif,is_bitstring,{f,_},[Src],_} -> - infer_type_test_bif(binary, Src); - {bif,is_float,{f,_},[Src],_} -> - infer_type_test_bif(float, Src); - {bif,is_integer,{f,_},[Src],_} -> - infer_type_test_bif({integer,{}}, Src); - {bif,is_list,{f,_},[Src],_} -> - infer_type_test_bif(list, Src); - {bif,is_map,{f,_},[Src],_} -> - infer_type_test_bif(map, Src); - {bif,is_number,{f,_},[Src],_} -> - infer_type_test_bif(number, Src); - {bif,is_tuple,{f,_},[Src],_} -> - infer_type_test_bif({tuple,[],#{}}, Src); + {{bif,is_atom},[Src]} -> + infer_type_test_bif({atom,[]}, Src); + {{bif,is_boolean},[Src]} -> + infer_type_test_bif(bool, Src); + {{bif,is_binary},[Src]} -> + infer_type_test_bif(binary, Src); + {{bif,is_bitstring},[Src]} -> + infer_type_test_bif(binary, Src); + {{bif,is_float},[Src]} -> + infer_type_test_bif(float, Src); + {{bif,is_integer},[Src]} -> + infer_type_test_bif({integer,{}}, Src); + {{bif,is_list},[Src]} -> + infer_type_test_bif(list, Src); + {{bif,is_map},[Src]} -> + infer_type_test_bif(map, Src); + {{bif,is_number},[Src]} -> + infer_type_test_bif(number, Src); + {{bif,is_tuple},[Src]} -> + infer_type_test_bif({tuple,[0],#{}}, Src); _ -> fun(_, S) -> S end end. @@ -1400,28 +1441,42 @@ infer_type_test_bif(Type, Src) -> assign({y,_}=Src, {y,_}=Dst, Vst) -> %% The stack trimming optimization may generate a move from an initialized %% but unassigned Y register to another Y register. - case get_term_type_1(Src, Vst) of - initialized -> set_type_reg(initialized, Dst, Vst); + case get_raw_type(Src, Vst) of + initialized -> create_tag(initialized, init, [], Dst, Vst); _ -> assign_1(Src, Dst, Vst) end; assign({Kind,_}=Reg, Dst, Vst) when Kind =:= x; Kind =:= y -> assign_1(Reg, Dst, Vst); assign(Literal, Dst, Vst) -> - create_term(get_term_type(Literal, Vst), Dst, Vst). + Type = get_term_type(Literal, Vst), + create_term(Type, move, [Literal], Dst, Vst). + +%% Creates a special tag value that isn't a regular term, such as +%% 'initialized' or 'catchtag' +create_tag(Type, Op, Ss, {y,_}=Dst, Vst) -> + set_type_reg_expr(Type, {Op, Ss}, Dst, Vst); +create_tag(_Type, _Op, _Ss, Dst, _Vst) -> + error({invalid_tag_register, Dst}). + +%% Wipes a special tag, leaving the register initialized but empty. +kill_tag({y,Y}=Reg, #vst{current=#st{y=Ys0}=St0}=Vst) -> + _ = get_tag_type(Reg, Vst), %Assertion. + Ys = gb_trees:update(Y, initialized, Ys0), + Vst#vst{current=St0#st{y=Ys}}. %% Creates a completely new term with the given type. -create_term(Type, Dst, Vst) -> - set_type_reg(Type, Dst, Vst). +create_term(Type, Op, Ss, Dst, Vst) -> + set_type_reg_expr(Type, {Op, Ss}, Dst, Vst). %% Extracts a term from Ss, propagating fragility. -extract_term(Type, Ss, Dst, Vst) -> - extract_term(Type, Ss, Dst, Vst, Vst). +extract_term(Type, Op, Ss, Dst, Vst) -> + extract_term(Type, Op, Ss, Dst, Vst, Vst). %% As extract_term/4, but uses the incoming Vst for fragility in case x-regs %% have been pruned and the sources can no longer be found. -extract_term(Type0, Ss, Dst, Vst, OrigVst) -> +extract_term(Type0, Op, Ss, Dst, Vst, OrigVst) -> Type = propagate_fragility(Type0, Ss, OrigVst), - set_type_reg(Type, Dst, Vst). + set_type_reg_expr(Type, {Op, Ss}, Dst, Vst). %% Helper functions for tests that alter state on both the success and fail %% branches, keeping the states from tainting each other. @@ -1443,6 +1498,13 @@ type_test(Fail, Type, Reg, Vst) -> update_type(fun meet/2, Type, Reg, SuccVst) end, Vst). +%% Overrides the type of Reg. This is ugly but a necessity for certain +%% destructive operations. +override_type(Type, Reg, Vst) -> + %% Once the new type format is in, this should be expressed as: + %% update_type(fun(_, T) -> T end, Type, Reg, Vst). + set_aliased_type(Type, Reg, Vst). + %% This is used when linear code finds out more and more information about a %% type, so that the type gets more specialized. update_type(Merge, Type0, Reg, Vst) -> @@ -1479,13 +1541,16 @@ update_eq_types(LHS, RHS, Vst0) -> assign_1(Src, Dst, Vst0) -> Type = get_move_term_type(Src, Vst0), - Vst = set_type_reg(Type, Dst, Vst0), + Def = get_def(Src, Vst0), + + Vst = set_type_reg_expr(Type, Def, Dst, Vst0), #vst{current=St0} = Vst, #st{aliases=Aliases0} = St0, + Aliases = Aliases0#{Src=>Dst,Dst=>Src}, - St = St0#st{aliases=Aliases}, + St = St0#st{aliases=Aliases}, Vst#vst{current=St}. set_aliased_type(Type, Reg, #vst{current=#st{aliases=Aliases}}=Vst0) -> @@ -1515,12 +1580,15 @@ set_type(Type, {y,_}=Reg, Vst) -> set_type(_, _, #vst{}=Vst) -> Vst. set_type_reg(Type, Src, Dst, Vst) -> - case get_term_type_1(Src, Vst) of + case get_raw_type(Src, Vst) of + uninitialized -> + error({uninitialized_reg, Src}); {fragile,_} -> set_type_reg(make_fragile(Type), Dst, Vst); _ -> set_type_reg(Type, Dst, Vst) end. + set_type_reg(Type, Reg, Vst) -> set_type_reg_expr(Type, none, Reg, Vst). @@ -1529,9 +1597,6 @@ set_type_reg_expr(Type, Expr, {x,_}=Reg, Vst) -> set_type_reg_expr(Type, Expr, Reg, Vst) -> set_type_y(Type, Expr, Reg, Vst). -set_type_y(Type, Reg, Vst) -> - set_type_y(Type, none, Reg, Vst). - set_type_x(Type, Expr, {x,X}=Reg, #vst{current=#st{x=Xs0,defs=Defs0}=St0}=Vst) when is_integer(X), 0 =< X -> check_limit(Reg), @@ -1562,7 +1627,7 @@ set_type_y(Type, Expr, {y,Y}=Reg, #vst{current=#st{y=Ys0,defs=Defs0}=St0}=Vst) {value,_} -> gb_trees:update(Y, Type, Ys0) end, - check_try_catch_tags(Type, Y, Ys0), + check_try_catch_tags(Type, Reg, Vst), Defs = Defs0#{Reg=>Expr}, St = kill_aliases(Reg, St0), Vst#vst{current=St#st{y=Ys,defs=Defs}}; @@ -1572,34 +1637,26 @@ set_type_y(Type, _Expr, Reg, #vst{}) -> make_fragile({fragile,_}=Type) -> Type; make_fragile(Type) -> {fragile,Type}. -set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) -> - Ys = gb_trees:update(Y, initialized, Ys0), - Vst#vst{current=St#st{y=Ys}}. +kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> + Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}}, + {_, Fail} = get_tag_type(Reg, Vst), %Assertion. + kill_tag(Reg, Vst). -check_try_catch_tags(Type, LastY, Ys) -> +check_try_catch_tags(Type, {y,N}=Reg, Vst) -> + %% Every catch or try/catch must use a lower Y register number than any + %% enclosing catch or try/catch. That will ensure that when the stack is + %% scanned when an exception occurs, the innermost try/catch tag is found + %% first. case is_try_catch_tag(Type) of - false -> - ok; true -> - %% Every catch or try/catch must use a lower Y register - %% number than any enclosing catch or try/catch. That will - %% ensure that when the stack is scanned when an - %% exception occurs, the innermost try/catch tag is found - %% first. - Bad = [{{y,Y},Tag} || {Y,Tag} <- gb_trees:to_list(Ys), - Y < LastY, is_try_catch_tag(Tag)], - case Bad of - [] -> - ok; - [_|_] -> - error({bad_try_catch_nesting,{y,LastY},Bad}) - end + case collect_try_catch_tags(N - 1, Vst, []) of + [_|_]=Bad -> error({bad_try_catch_nesting, Reg, Bad}); + [] -> ok + end; + false -> + ok end. -is_try_catch_tag({catchtag,_}) -> true; -is_try_catch_tag({trytag,_}) -> true; -is_try_catch_tag(_) -> false. - is_reg_defined({x,_}=Reg, Vst) -> is_type_defined_x(Reg, Vst); is_reg_defined({y,_}=Reg, Vst) -> is_type_defined_y(Reg, Vst); is_reg_defined(V, #vst{}) -> error({not_a_register, V}). @@ -1649,10 +1706,10 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% used by the catch instructions; NOT safe to use in other %% instructions. %% -%% exception Can only be used as a type returned by return_type/2 -%% (which gives the type of the value returned by a BIF). -%% Thus 'exception' is never stored as type descriptor -%% for a register. +%% exception Can only be used as a type returned by +%% call_return_type/2 (which gives the type of the value +%% returned by a call). Thus 'exception' is never stored +%% as type descriptor for a register. %% %% #ms{} A match context for bit syntax matching. We do allow %% it to moved/to from stack, but otherwise it must only @@ -1738,10 +1795,14 @@ meet(T1, T2) -> {_, _, none} -> none; {[Sz1],[Sz2],_} -> - {tuple,[erlang:max(Sz1, Sz2)],Es}; + Sz = erlang:max(Sz1, Sz2), + assert_tuple_elements(Sz, Es), + {tuple,[Sz],Es}; {Sz1,[Sz2],_} when Sz2 =< Sz1 -> + assert_tuple_elements(Sz1, Es), {tuple,Sz1,Es}; {Sz,Sz,_} -> + assert_tuple_elements(Sz, Es), {tuple,Sz,Es}; {_,_,_} -> none @@ -1775,6 +1836,12 @@ meet_elements_1([Key | Keys], Es1, Es2, Acc) -> meet_elements_1([], _Es1, _Es2, Acc) -> Acc. +%% No tuple elements may have an index above the known size. +assert_tuple_elements(Limit, Es) -> + true = maps:fold(fun(Index, _T, true) -> + Index =< Limit + end, true, Es). %Assertion. + %% subtract(Type1, Type2) -> Type %% Subtract Type2 from Type2. Example: %% subtract(list, nil) -> cons @@ -1835,6 +1902,16 @@ validate_src(Ss, Vst) when is_list(Ss) -> [assert_term(S, Vst) || S <- Ss], ok. +%% get_term_type(Src, ValidatorState) -> Type +%% Get the type of the source Src. The returned type Type will be +%% a standard Erlang type (no catch/try tags or match contexts). + +get_term_type(Src, Vst) -> + case get_move_term_type(Src, Vst) of + #ms{} -> error({match_context,Src}); + Type -> Type + end. + %% get_durable_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be %% a standard Erlang type (no catch/try tags or match contexts). @@ -1851,42 +1928,42 @@ get_durable_term_type(Src, Vst) -> %% a standard Erlang type (no catch/try tags). Match contexts are OK. get_move_term_type(Src, Vst) -> - case get_term_type_1(Src, Vst) of - initialized -> error({unassigned,Src}); - {catchtag,_} -> error({catchtag,Src}); - {trytag,_} -> error({trytag,Src}); + case get_raw_type(Src, Vst) of + initialized -> error({unassigned,Src}); + uninitialized -> error({uninitialized_reg,Src}); + {catchtag,_} -> error({catchtag,Src}); + {trytag,_} -> error({trytag,Src}); tuple_in_progress -> error({tuple_in_progress,Src}); - Type -> Type - end. - -%% get_term_type(Src, ValidatorState) -> Type -%% Get the type of the source Src. The returned type Type will be -%% a standard Erlang type (no catch/try tags or match contexts). - -get_term_type(Src, Vst) -> - case get_move_term_type(Src, Vst) of - #ms{} -> error({match_context,Src}); - Type -> Type + Type -> Type end. -%% get_special_y_type(Src, ValidatorState) -> Type -%% Return the type for the Y register without doing any validity checks. +%% get_tag_type(Src, ValidatorState) -> Type +%% Return the tag type of a Y register, erroring out if it contains a term. -get_special_y_type({y,_}=Reg, Vst) -> get_term_type_1(Reg, Vst); -get_special_y_type(Src, _) -> error({source_not_y_reg,Src}). +get_tag_type({y,_}=Src, Vst) -> + case get_raw_type(Src, Vst) of + {catchtag, _}=Tag -> Tag; + {trytag, _}=Tag -> Tag; + uninitialized=Tag -> Tag; + initialized=Tag -> Tag; + Other -> error({invalid_tag,Src,Other}) + end; +get_tag_type(Src, _) -> + error({invalid_tag_register,Src}). -get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) -> +%% get_raw_type(Src, ValidatorState) -> Type +%% Return the type of a register without doing any validity checks. +get_raw_type({x,X}, #vst{current=#st{x=Xs}}) when is_integer(X) -> case gb_trees:lookup(X, Xs) of - {value,Type} -> Type; - none -> error({uninitialized_reg,Reg}) + {value,Type} -> Type; + none -> uninitialized end; -get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> +get_raw_type({y,Y}, #vst{current=#st{y=Ys}}) when is_integer(Y) -> case gb_trees:lookup(Y, Ys) of - none -> error({uninitialized_reg,Reg}); - {value,uninitialized} -> error({uninitialized_reg,Reg}); - {value,Type} -> Type + {value,Type} -> Type; + none -> uninitialized end; -get_term_type_1(Src, _) -> +get_raw_type(Src, #vst{}) -> get_literal_type(Src). get_def(Src, #vst{current=#st{defs=Defs}}) -> @@ -1919,27 +1996,6 @@ value_to_type(T) when is_tuple(T) -> {tuple, tuple_size(T), Es}; value_to_type(L) -> {literal, L}. -branch_arities(List, Tuple, Vst) -> - Type = get_durable_term_type(Tuple, Vst), - branch_arities(List, Tuple, Type, Vst). - -branch_arities([Sz,{f,L}|T], Tuple, {tuple,[_],Es0}=Type0, Vst0) when is_integer(Sz) -> - %% Filter out element types that are no longer valid. - Es = maps:filter(fun(Index, _Type) -> Index =< Sz end, Es0), - Vst1 = set_aliased_type({tuple,Sz,Es}, Tuple, Vst0), - Vst = branch_state(L, Vst1), - branch_arities(T, Tuple, Type0, Vst); -branch_arities([Sz,{f,L}|T], Tuple, {tuple,Sz,_Es}=Type, Vst0) when is_integer(Sz) -> - %% The type is already correct. (This test is redundant.) - Vst = branch_state(L, Vst0), - branch_arities(T, Tuple, Type, Vst); -branch_arities([Sz0,{f,_}|T], Tuple, {tuple,Sz,_Es}=Type, Vst) - when is_integer(Sz), Sz0 =/= Sz -> - %% We already have an established different exact size for the tuple. - %% This label can't possibly be reached. - branch_arities(T, Tuple, Type, Vst); -branch_arities([], _, _, #vst{}=Vst) -> Vst. - branch_state(0, #vst{}=Vst) -> %% If the instruction fails, the stack may be scanned %% looking for a catch tag. Therefore the Y registers @@ -2051,9 +2107,9 @@ join({tuple,Size,EsA}, {tuple,Size,EsB}) -> Es = join_tuple_elements(tuple_sz(Size), EsA, EsB), {tuple, Size, Es}; join({tuple,A,EsA}, {tuple,B,EsB}) -> - Size = [min(tuple_sz(A), tuple_sz(B))], + Size = min(tuple_sz(A), tuple_sz(B)), Es = join_tuple_elements(Size, EsA, EsB), - {tuple, Size, Es}; + {tuple, [Size], Es}; join({Type,A}, {Type,B}) when Type =:= atom; Type =:= integer; Type =:= float -> if A =:= B -> {Type,A}; @@ -2083,10 +2139,9 @@ join(T1, T2) when T1 =/= T2 -> %% a 'term'. join_list(T1, T2). -join_tuple_elements(Size, EsA, EsB) -> +join_tuple_elements(Limit, EsA, EsB) -> Es0 = join_elements(EsA, EsB), - MinSize = tuple_sz(Size), - maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). + maps:filter(fun(Index, _Type) -> Index =< Limit end, Es0). join_elements(Es1, Es2) -> Keys = if @@ -2143,44 +2198,78 @@ merge_aliases(Al0, Al1) when map_size(Al0) =< map_size(Al1) -> merge_aliases(Al0, Al1) -> merge_aliases(Al1, Al0). -verify_y_init(#vst{current=#st{y=Ys}}) -> - verify_y_init_1(gb_trees:to_list(Ys)). - -verify_y_init_1([]) -> ok; -verify_y_init_1([{Y,uninitialized}|_]) -> - error({uninitialized_reg,{y,Y}}); -verify_y_init_1([{Y,{fragile,_}}|_]) -> - %% Unsafe. This term may be outside any heap belonging - %% to the process and would be corrupted by a GC. - error({fragile_message_reference,{y,Y}}); -verify_y_init_1([{_,_}|Ys]) -> - verify_y_init_1(Ys). - -verify_live(0, #vst{}) -> ok; -verify_live(N, #vst{current=#st{x=Xs}}) -> - verify_live_1(N, Xs). - -verify_live_1(0, _) -> ok; -verify_live_1(N, Xs) when is_integer(N) -> - X = N-1, - case gb_trees:is_defined(X, Xs) of - false -> error({{x,X},not_live}); - true -> verify_live_1(X, Xs) +verify_y_init(#vst{current=#st{numy=NumY,y=Ys}}=Vst) + when is_integer(NumY), NumY > 0 -> + {HighestY, _} = gb_trees:largest(Ys), + true = NumY > HighestY, %Assertion. + verify_y_init_1(NumY - 1, Vst), + ok; +verify_y_init(#vst{current=#st{numy=undecided,y=Ys}}=Vst) -> + case gb_trees:is_empty(Ys) of + true -> + ok; + false -> + {HighestY, _} = gb_trees:largest(Ys), + verify_y_init_1(HighestY, Vst) end; -verify_live_1(N, _) -> error({bad_number_of_live_regs,N}). +verify_y_init(#vst{}) -> + ok. + +verify_y_init_1(-1, _Vst) -> + ok; +verify_y_init_1(Y, Vst) -> + Reg = {y, Y}, + case get_raw_type(Reg, Vst) of + uninitialized -> + error({uninitialized_reg,Reg}); + {fragile, _} -> + %% Unsafe. This term may be outside any heap belonging to the + %% process and would be corrupted by a GC. + error({fragile_message_reference,Reg}); + _ -> + verify_y_init_1(Y - 1, Vst) + end. + +verify_live(0, _Vst) -> + ok; +verify_live(Live, Vst) when is_integer(Live), 0 < Live, Live =< 1023 -> + verify_live_1(Live - 1, Vst); +verify_live(Live, _Vst) -> + error({bad_number_of_live_regs,Live}). + +verify_live_1(-1, _) -> + ok; +verify_live_1(X, Vst) when is_integer(X) -> + Reg = {x, X}, + case get_raw_type(Reg, Vst) of + uninitialized -> error({Reg, not_live}); + _ -> verify_live_1(X - 1, Vst) + end. -verify_no_ct(#vst{current=#st{numy=none}}) -> ok; +verify_no_ct(#vst{current=#st{numy=none}}) -> + ok; verify_no_ct(#vst{current=#st{numy=undecided}}) -> error(unknown_size_of_stackframe); -verify_no_ct(#vst{current=#st{y=Ys}}) -> - case [Y || Y <- gb_trees:to_list(Ys), verify_no_ct_1(Y)] of - [] -> ok; - CT -> error({unfinished_catch_try,CT}) +verify_no_ct(#vst{current=St}=Vst) -> + case collect_try_catch_tags(St#st.numy - 1, Vst, []) of + [_|_]=Bad -> error({unfinished_catch_try,Bad}); + [] -> ok end. -verify_no_ct_1({_, {catchtag, _}}) -> true; -verify_no_ct_1({_, {trytag, _}}) -> true; -verify_no_ct_1({_, _}) -> false. +%% Collects all try/catch tags, walking down from the Nth stack position. +collect_try_catch_tags(-1, _Vst, Acc) -> + Acc; +collect_try_catch_tags(Y, Vst, Acc0) -> + Tag = get_raw_type({y, Y}, Vst), + Acc = case is_try_catch_tag(Tag) of + true -> [{{y, Y}, Tag} | Acc0]; + false -> Acc0 + end, + collect_try_catch_tags(Y - 1, Vst, Acc). + +is_try_catch_tag({catchtag,_}) -> true; +is_try_catch_tag({trytag,_}) -> true; +is_try_catch_tag(_) -> false. eat_heap(N, #vst{current=#st{h=Heap0}=St}=Vst) -> case Heap0-N of @@ -2209,7 +2298,7 @@ remove_fragility(#vst{current=#st{x=Xs0,y=Ys0}=St0}=Vst) -> propagate_fragility(Type, Ss, Vst) -> F = fun(S) -> - case get_term_type_1(S, Vst) of + case get_raw_type(S, Vst) of {fragile,_} -> true; _ -> false end @@ -2219,9 +2308,82 @@ propagate_fragility(Type, Ss, Vst) -> false -> Type end. +%%% +%%% Return/argument types of BIFs +%%% + +bif_return_type('-', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type('+', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type('*', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type(abs, [Num], Vst) -> + case get_durable_term_type(Num, Vst) of + {float,_}=T -> T; + {integer,_}=T -> T; + _ -> number + end; +bif_return_type(float, _, _) -> {float,[]}; +bif_return_type('/', _, _) -> {float,[]}; +%% Binary operations +bif_return_type('byte_size', _, _) -> {integer,[]}; +bif_return_type('bit_size', _, _) -> {integer,[]}; +%% Integer operations. +bif_return_type(ceil, [_], _) -> {integer,[]}; +bif_return_type('div', [_,_], _) -> {integer,[]}; +bif_return_type(floor, [_], _) -> {integer,[]}; +bif_return_type('rem', [_,_], _) -> {integer,[]}; +bif_return_type(length, [_], _) -> {integer,[]}; +bif_return_type(size, [_], _) -> {integer,[]}; +bif_return_type(trunc, [_], _) -> {integer,[]}; +bif_return_type(round, [_], _) -> {integer,[]}; +bif_return_type('band', [_,_], _) -> {integer,[]}; +bif_return_type('bor', [_,_], _) -> {integer,[]}; +bif_return_type('bxor', [_,_], _) -> {integer,[]}; +bif_return_type('bnot', [_], _) -> {integer,[]}; +bif_return_type('bsl', [_,_], _) -> {integer,[]}; +bif_return_type('bsr', [_,_], _) -> {integer,[]}; +%% Booleans. +bif_return_type('==', [_,_], _) -> bool; +bif_return_type('/=', [_,_], _) -> bool; +bif_return_type('=<', [_,_], _) -> bool; +bif_return_type('<', [_,_], _) -> bool; +bif_return_type('>=', [_,_], _) -> bool; +bif_return_type('>', [_,_], _) -> bool; +bif_return_type('=:=', [_,_], _) -> bool; +bif_return_type('=/=', [_,_], _) -> bool; +bif_return_type('not', [_], _) -> bool; +bif_return_type('and', [_,_], _) -> bool; +bif_return_type('or', [_,_], _) -> bool; +bif_return_type('xor', [_,_], _) -> bool; +bif_return_type(is_atom, [_], _) -> bool; +bif_return_type(is_boolean, [_], _) -> bool; +bif_return_type(is_binary, [_], _) -> bool; +bif_return_type(is_float, [_], _) -> bool; +bif_return_type(is_function, [_], _) -> bool; +bif_return_type(is_integer, [_], _) -> bool; +bif_return_type(is_list, [_], _) -> bool; +bif_return_type(is_map, [_], _) -> bool; +bif_return_type(is_number, [_], _) -> bool; +bif_return_type(is_pid, [_], _) -> bool; +bif_return_type(is_port, [_], _) -> bool; +bif_return_type(is_reference, [_], _) -> bool; +bif_return_type(is_tuple, [_], _) -> bool; +%% Misc. +bif_return_type(tuple_size, [_], _) -> {integer,[]}; +bif_return_type(node, [], _) -> {atom,[]}; +bif_return_type(node, [_], _) -> {atom,[]}; +bif_return_type(hd, [_], _) -> term; +bif_return_type(tl, [_], _) -> term; +bif_return_type(get, [_], _) -> term; +bif_return_type(Bif, _, _) when is_atom(Bif) -> term. + %% Generic bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}]; bif_arg_types(map_size, [_]) -> [map]; +bif_arg_types(is_map_key, [_,_]) -> [term, map]; +bif_arg_types(map_get, [_,_]) -> [term, map]; bif_arg_types(length, [_]) -> [list]; bif_arg_types(hd, [_]) -> [cons]; bif_arg_types(tl, [_]) -> [cons]; @@ -2255,73 +2417,6 @@ bif_arg_types('bsr', [_,_]) -> [{integer,[]}, {integer,[]}]; bif_arg_types(is_function, [_,_]) -> [term, {integer,[]}]; bif_arg_types(_, Args) -> [term || _Arg <- Args]. -bif_type('-', Src, Vst) -> - arith_type(Src, Vst); -bif_type('+', Src, Vst) -> - arith_type(Src, Vst); -bif_type('*', Src, Vst) -> - arith_type(Src, Vst); -bif_type(abs, [Num], Vst) -> - case get_durable_term_type(Num, Vst) of - {float,_}=T -> T; - {integer,_}=T -> T; - _ -> number - end; -bif_type(float, _, _) -> {float,[]}; -bif_type('/', _, _) -> {float,[]}; -%% Binary operations -bif_type('byte_size', _, _) -> {integer,[]}; -bif_type('bit_size', _, _) -> {integer,[]}; -%% Integer operations. -bif_type(ceil, [_], _) -> {integer,[]}; -bif_type('div', [_,_], _) -> {integer,[]}; -bif_type(floor, [_], _) -> {integer,[]}; -bif_type('rem', [_,_], _) -> {integer,[]}; -bif_type(length, [_], _) -> {integer,[]}; -bif_type(size, [_], _) -> {integer,[]}; -bif_type(trunc, [_], _) -> {integer,[]}; -bif_type(round, [_], _) -> {integer,[]}; -bif_type('band', [_,_], _) -> {integer,[]}; -bif_type('bor', [_,_], _) -> {integer,[]}; -bif_type('bxor', [_,_], _) -> {integer,[]}; -bif_type('bnot', [_], _) -> {integer,[]}; -bif_type('bsl', [_,_], _) -> {integer,[]}; -bif_type('bsr', [_,_], _) -> {integer,[]}; -%% Booleans. -bif_type('==', [_,_], _) -> bool; -bif_type('/=', [_,_], _) -> bool; -bif_type('=<', [_,_], _) -> bool; -bif_type('<', [_,_], _) -> bool; -bif_type('>=', [_,_], _) -> bool; -bif_type('>', [_,_], _) -> bool; -bif_type('=:=', [_,_], _) -> bool; -bif_type('=/=', [_,_], _) -> bool; -bif_type('not', [_], _) -> bool; -bif_type('and', [_,_], _) -> bool; -bif_type('or', [_,_], _) -> bool; -bif_type('xor', [_,_], _) -> bool; -bif_type(is_atom, [_], _) -> bool; -bif_type(is_boolean, [_], _) -> bool; -bif_type(is_binary, [_], _) -> bool; -bif_type(is_float, [_], _) -> bool; -bif_type(is_function, [_], _) -> bool; -bif_type(is_integer, [_], _) -> bool; -bif_type(is_list, [_], _) -> bool; -bif_type(is_map, [_], _) -> bool; -bif_type(is_number, [_], _) -> bool; -bif_type(is_pid, [_], _) -> bool; -bif_type(is_port, [_], _) -> bool; -bif_type(is_reference, [_], _) -> bool; -bif_type(is_tuple, [_], _) -> bool; -%% Misc. -bif_type(tuple_size, [_], _) -> {integer,[]}; -bif_type(node, [], _) -> {atom,[]}; -bif_type(node, [_], _) -> {atom,[]}; -bif_type(hd, [_], _) -> term; -bif_type(tl, [_], _) -> term; -bif_type(get, [_], _) -> term; -bif_type(Bif, _, _) when is_atom(Bif) -> term. - is_bif_safe('/=', 2) -> true; is_bif_safe('<', 2) -> true; is_bif_safe('=/=', 2) -> true; @@ -2349,14 +2444,14 @@ is_bif_safe(self, 0) -> true; is_bif_safe(node, 0) -> true; is_bif_safe(_, _) -> false. -arith_type([A], Vst) -> +arith_return_type([A], Vst) -> %% Unary '+' or '-'. case get_durable_term_type(A, Vst) of {integer,_} -> {integer,[]}; {float,_} -> {float,[]}; _ -> number end; -arith_type([A,B], Vst) -> +arith_return_type([A,B], Vst) -> TypeA = get_durable_term_type(A, Vst), TypeB = get_durable_term_type(B, Vst), case {TypeA, TypeB} of @@ -2365,12 +2460,16 @@ arith_type([A,B], Vst) -> {_,{float,_}} -> {float,[]}; {_,_} -> number end; -arith_type(_, _) -> number. +arith_return_type(_, _) -> number. -return_type({extfunc,M,F,A}, Vst) -> return_type_1(M, F, A, Vst); -return_type(_, _) -> term. +%%% +%%% Return/argument types of calls +%%% -return_type_1(erlang, setelement, 3, Vst) -> +call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst); +call_return_type(_, _) -> term. + +call_return_type_1(erlang, setelement, 3, Vst) -> IndexType = get_term_type({x,0}, Vst), TupleType = case get_term_type({x,1}, Vst) of @@ -2393,53 +2492,113 @@ return_type_1(erlang, setelement, 3, Vst) -> %% information. setelement(3, TupleType, #{}) end; -return_type_1(erlang, '++', 2, Vst) -> +call_return_type_1(erlang, '++', 2, Vst) -> case get_term_type({x,0}, Vst) =:= cons orelse get_term_type({x,1}, Vst) =:= cons of true -> cons; false -> list end; -return_type_1(erlang, '--', 2, _Vst) -> +call_return_type_1(erlang, '--', 2, _Vst) -> + list; +call_return_type_1(erlang, F, A, _) -> + erlang_mod_return_type(F, A); +call_return_type_1(lists, F, A, Vst) -> + lists_mod_return_type(F, A, Vst); +call_return_type_1(math, F, A, _) -> + math_mod_return_type(F, A); +call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> + term. + +erlang_mod_return_type(exit, 1) -> exception; +erlang_mod_return_type(throw, 1) -> exception; +erlang_mod_return_type(error, 1) -> exception; +erlang_mod_return_type(error, 2) -> exception; +erlang_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. + +math_mod_return_type(cos, 1) -> {float,[]}; +math_mod_return_type(cosh, 1) -> {float,[]}; +math_mod_return_type(sin, 1) -> {float,[]}; +math_mod_return_type(sinh, 1) -> {float,[]}; +math_mod_return_type(tan, 1) -> {float,[]}; +math_mod_return_type(tanh, 1) -> {float,[]}; +math_mod_return_type(acos, 1) -> {float,[]}; +math_mod_return_type(acosh, 1) -> {float,[]}; +math_mod_return_type(asin, 1) -> {float,[]}; +math_mod_return_type(asinh, 1) -> {float,[]}; +math_mod_return_type(atan, 1) -> {float,[]}; +math_mod_return_type(atanh, 1) -> {float,[]}; +math_mod_return_type(erf, 1) -> {float,[]}; +math_mod_return_type(erfc, 1) -> {float,[]}; +math_mod_return_type(exp, 1) -> {float,[]}; +math_mod_return_type(log, 1) -> {float,[]}; +math_mod_return_type(log2, 1) -> {float,[]}; +math_mod_return_type(log10, 1) -> {float,[]}; +math_mod_return_type(sqrt, 1) -> {float,[]}; +math_mod_return_type(atan2, 2) -> {float,[]}; +math_mod_return_type(pow, 2) -> {float,[]}; +math_mod_return_type(ceil, 1) -> {float,[]}; +math_mod_return_type(floor, 1) -> {float,[]}; +math_mod_return_type(fmod, 2) -> {float,[]}; +math_mod_return_type(pi, 0) -> {float,[]}; +math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. + +lists_mod_return_type(dropwhile, 2, _Vst) -> + list; +lists_mod_return_type(duplicate, 2, _Vst) -> + list; +lists_mod_return_type(filter, 2, _Vst) -> + list; +lists_mod_return_type(flatten, 2, _Vst) -> + list; +lists_mod_return_type(map, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr -> + ListType = same_length_type({x,2}, Vst), + {tuple,2,#{1=>ListType}}; +lists_mod_return_type(partition, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(reverse, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(seq, 2, _Vst) -> list; -return_type_1(erlang, F, A, _) -> - return_type_erl(F, A); -return_type_1(math, F, A, _) -> - return_type_math(F, A); -return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> +lists_mod_return_type(seq, 3, _Vst) -> + list; +lists_mod_return_type(sort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(sort, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(splitwith, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(takewhile, 2, _Vst) -> + list; +lists_mod_return_type(unzip, 1, Vst) -> + ListType = same_length_type({x,0}, Vst), + two_tuple(ListType, ListType); +lists_mod_return_type(usort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(usort, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(zip, 2, _Vst) -> + list; +lists_mod_return_type(zip3, 3, _Vst) -> + list; +lists_mod_return_type(zipwith, 3, _Vst) -> + list; +lists_mod_return_type(zipwith3, 4, _Vst) -> + list; +lists_mod_return_type(_, _, _) -> term. -return_type_erl(exit, 1) -> exception; -return_type_erl(throw, 1) -> exception; -return_type_erl(error, 1) -> exception; -return_type_erl(error, 2) -> exception; -return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -return_type_math(cos, 1) -> {float,[]}; -return_type_math(cosh, 1) -> {float,[]}; -return_type_math(sin, 1) -> {float,[]}; -return_type_math(sinh, 1) -> {float,[]}; -return_type_math(tan, 1) -> {float,[]}; -return_type_math(tanh, 1) -> {float,[]}; -return_type_math(acos, 1) -> {float,[]}; -return_type_math(acosh, 1) -> {float,[]}; -return_type_math(asin, 1) -> {float,[]}; -return_type_math(asinh, 1) -> {float,[]}; -return_type_math(atan, 1) -> {float,[]}; -return_type_math(atanh, 1) -> {float,[]}; -return_type_math(erf, 1) -> {float,[]}; -return_type_math(erfc, 1) -> {float,[]}; -return_type_math(exp, 1) -> {float,[]}; -return_type_math(log, 1) -> {float,[]}; -return_type_math(log2, 1) -> {float,[]}; -return_type_math(log10, 1) -> {float,[]}; -return_type_math(sqrt, 1) -> {float,[]}; -return_type_math(atan2, 2) -> {float,[]}; -return_type_math(pow, 2) -> {float,[]}; -return_type_math(ceil, 1) -> {float,[]}; -return_type_math(floor, 1) -> {float,[]}; -return_type_math(fmod, 2) -> {float,[]}; -return_type_math(pi, 0) -> {float,[]}; -return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. +two_tuple(Type1, Type2) -> + {tuple,2,#{1=>Type1,2=>Type2}}. + +same_length_type(Reg, Vst) -> + case get_term_type(Reg, Vst) of + {literal,[_|_]} -> cons; + cons -> cons; + nil -> nil; + _ -> list + end. check_limit({x,X}) when is_integer(X), X < 1023 -> %% Note: x(1023) is reserved for use by the BEAM loader. @@ -2454,6 +2613,6 @@ check_limit(_) -> min(A, B) when is_integer(A), is_integer(B), A < B -> A; min(A, B) when is_integer(A), is_integer(B) -> B. -gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)). +gb_trees_from_list(L) -> gb_trees:from_orddict(sort(L)). error(Error) -> throw(Error). diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index c281af57a1..11dea9524b 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -814,8 +814,6 @@ kernel_passes() -> %% Optimizations that must be done after all other optimizations. [{pass,sys_core_bsm}, {iff,dcbsm,{listing,"core_bsm"}}, - {pass,sys_core_dsetel}, - {iff,dsetel,{listing,"dsetel"}}, {iff,clint,?pass(core_lint_module)}, {iff,core,?pass(save_core_code)}, @@ -2122,7 +2120,6 @@ pre_load() -> erl_scan, sys_core_alias, sys_core_bsm, - sys_core_dsetel, sys_core_fold, v3_core, v3_kernel], diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 108a0ca100..a086a3a8d3 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -65,7 +65,6 @@ rec_env, sys_core_alias, sys_core_bsm, - sys_core_dsetel, sys_core_fold, sys_core_fold_lists, sys_core_inline, diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index d925decce6..94a5dfe012 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -32,6 +32,22 @@ %% Returns `true' if the function `Module:Name/Arity' does not %% affect the state, nor depend on the state, although its %% evaluation is not guaranteed to complete normally for all input. +%% +%% NOTE: There is no need to include every new pure BIF +%% here. Including it here means that the value of the function +%% will be evaluated at compile-time if the arguments are +%% constant. If that optimization is not useful/desired, there is +%% no need to include the new BIF here. +%% +%% Functions whose return value could conceivably change in a +%% future version of the runtime system must NOT be included here. +%% +%% Here are some example of functions that should not be +%% included: `term_to_binary/1', hashing functions, non-trivial +%% encode/decode functions. +%% +%% When unsure whether a new BIF should be included here, the +%% conservative safe choice is NOT to include it. -spec is_pure(atom(), atom(), arity()) -> boolean(). diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl deleted file mode 100644 index 9ab83c210f..0000000000 --- a/lib/compiler/src/sys_core_dsetel.erl +++ /dev/null @@ -1,360 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% 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 : Using dsetelement to make multiple-field record updates -%% faster. - -%% The expansion of record field updates, when more than one field is -%% updated, but not a majority of the fields, will create a sequence of -%% calls to 'erlang:setelement(Index, Value, Tuple)' where Tuple in the -%% first call is the original record tuple, and in the subsequent calls -%% Tuple is the result of the previous call. Furthermore, all Index -%% values are constant positive integers, and the first call to -%% 'setelement' will have the greatest index. Thus all the following -%% calls do not actually need to test at run-time whether Tuple has type -%% tuple, nor that the index is within the tuple bounds. -%% -%% Since this introduces destructive updates in the Core Erlang code, it -%% must be done as a last stage before going to lower-level code. -%% -%% NOTE: Because there are currently no write barriers in the system, -%% this kind of optimization can only be done when we are sure that -%% garbage collection will not be triggered between the creation of the -%% tuple and the destructive updates - otherwise we might insert -%% pointers from an older generation to a newer. -%% -%% The rewriting is done as follows: -%% -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in call 'erlang':'setelement(3, X1, Value2) -%% => -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X1, Value2) -%% X1 -%% and -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in let X2 = call 'erlang':'setelement(3, X1, Value2) -%% in ... -%% => -%% let X2 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop 'dsetelement(3, X2, Value2) -%% ... -%% if X1 is used exactly once. -%% Thus, we need to track variable usage. -%% - --module(sys_core_dsetel). - --export([module/2]). - --include("core_parse.hrl"). - --spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}. - -module(M0, _Options) -> - M = visit_module(M0), - {ok,M}. - -visit_module(#c_module{defs=Ds0}=R) -> - Env = #{}, - Ds = visit_module_1(Ds0, Env, []), - R#c_module{defs=Ds}. - -visit_module_1([{Name,F0}|Fs], Env, Acc) -> - try visit(Env, F0) of - {F,_} -> - visit_module_1(Fs, Env, [{Name,F}|Acc]) - catch - Class:Error:Stack -> - #c_var{name={Func,Arity}} = Name, - io:fwrite("Function: ~w/~w\n", [Func,Arity]), - erlang:raise(Class, Error, Stack) - end; -visit_module_1([], _, Acc) -> - lists:reverse(Acc). - -visit(Env, #c_var{name={_,_}}=R) -> - %% Ignore local function name. - {R, Env}; -visit(Env0, #c_var{name=X}=R) -> - %% There should not be any free variables. If there are, - %% the case will fail with an exception. - case Env0 of - #{X:=N} -> - {R, Env0#{X:=N+1}} - end; -visit(Env, #c_literal{}=R) -> - {R, Env}; -visit(Env0, #c_tuple{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_tuple{es=Es1}, Env1}; -visit(Env0, #c_map{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_map{es=Es1}, Env1}; -visit(Env0, #c_map_pair{key=K0,val=V0}=R) -> - {K,Env1} = visit(Env0, K0), - {V,Env2} = visit(Env1, V0), - {R#c_map_pair{key=K,val=V}, Env2}; -visit(Env0, #c_cons{hd=H0,tl=T0}=R) -> - {H1,Env1} = visit(Env0, H0), - {T1,Env2} = visit(Env1, T0), - {R#c_cons{hd=H1,tl=T1}, Env2}; -visit(Env0, #c_binary{segments=Segs}=R) -> - Env = visit_bin_segs(Env0, Segs), - {R, Env}; -visit(Env0, #c_values{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_values{es=Es1}, Env1}; -visit(Env0, #c_fun{vars=Vs, body=B0}=R) -> - {Xs, Env1} = bind_vars(Vs, Env0), - {B1,Env2} = visit(Env1, B0), - {R#c_fun{body=B1}, restore_vars(Xs, Env0, Env2)}; -visit(Env0, #c_let{vars=Vs, arg=A0, body=B0}=R) -> - {A1,Env1} = visit(Env0, A0), - {Xs,Env2} = bind_vars(Vs, Env1), - {B1,Env3} = visit(Env2, B0), - rewrite(R#c_let{arg=A1,body=B1}, Env3, restore_vars(Xs, Env1, Env3)); -visit(Env0, #c_seq{arg=A0, body=B0}=R) -> - {A1,Env1} = visit(Env0, A0), - {B1,Env2} = visit(Env1, B0), - {R#c_seq{arg=A1,body=B1}, Env2}; -visit(Env0, #c_case{arg=A0,clauses=Cs0}=R) -> - {A1,Env1} = visit(Env0, A0), - {Cs1,Env2} = visit_list(Env1, Cs0), - {R#c_case{arg=A1,clauses=Cs1}, Env2}; -visit(Env0, #c_clause{pats=Ps,guard=G0,body=B0}=R) -> - {Vs, Env1} = visit_pats(Ps, Env0), - {G1,Env2} = visit(Env1, G0), - {B1,Env3} = visit(Env2, B0), - {R#c_clause{guard=G1,body=B1}, restore_vars(Vs, Env0, Env3)}; -visit(Env0, #c_receive{clauses=Cs0,timeout=T0,action=A0}=R) -> - {T1,Env1} = visit(Env0, T0), - {Cs1,Env2} = visit_list(Env1, Cs0), - {A1,Env3} = visit(Env2, A0), - {R#c_receive{clauses=Cs1,timeout=T1,action=A1}, Env3}; -visit(Env0, #c_apply{op=Op0, args=As0}=R) -> - {Op1,Env1} = visit(Env0, Op0), - {As1,Env2} = visit_list(Env1, As0), - {R#c_apply{op=Op1,args=As1}, Env2}; -visit(Env0, #c_call{module=M0,name=N0,args=As0}=R) -> - {M1,Env1} = visit(Env0, M0), - {N1,Env2} = visit(Env1, N0), - {As1,Env3} = visit_list(Env2, As0), - {R#c_call{module=M1,name=N1,args=As1}, Env3}; -visit(Env0, #c_primop{name=N0, args=As0}=R) -> - {N1,Env1} = visit(Env0, N0), - {As1,Env2} = visit_list(Env1, As0), - {R#c_primop{name=N1,args=As1}, Env2}; -visit(Env0, #c_try{arg=E0, vars=Vs, body=B0, evars=Evs, handler=H0}=R) -> - {E1,Env1} = visit(Env0, E0), - {Xs, Env2} = bind_vars(Vs, Env1), - {B1,Env3} = visit(Env2, B0), - Env4 = restore_vars(Xs, Env1, Env3), - {Ys, Env5} = bind_vars(Evs, Env4), - {H1,Env6} = visit(Env5, H0), - {R#c_try{arg=E1,body=B1,handler=H1}, restore_vars(Ys, Env4, Env6)}; -visit(Env0, #c_catch{body=B0}=R) -> - {B1,Env1} = visit(Env0, B0), - {R#c_catch{body=B1}, Env1}; -visit(Env0, #c_letrec{defs=Ds0,body=B0}=R) -> - {Xs, Env1} = bind_vars([V || {V,_} <- Ds0], Env0), - {Ds1,Env2} = visit_def_list(Env1, Ds0), - {B1,Env3} = visit(Env2, B0), - {R#c_letrec{defs=Ds1,body=B1}, restore_vars(Xs, Env0, Env3)}. -%% The following general code for handling modules is slow if a module -%% contains very many functions. There is special code in visit_module/1 -%% which is much faster. -%% visit(Env0, #c_module{defs=D0}=R) -> -%% {R1,Env1} = visit(Env0, #c_letrec{defs=D0,body=#c_nil{}}), -%% {R#c_module{defs=R1#c_letrec.defs}, Env1}; - -visit_list(Env, L) -> - lists:mapfoldl(fun (E, A) -> visit(A, E) end, Env, L). - -visit_def_list(Env, L) -> - lists:mapfoldl(fun ({Name,V0}, E0) -> - {V1,E1} = visit(E0, V0), - {{Name,V1}, E1} - end, Env, L). - -visit_bin_segs(Env, Segs) -> - lists:foldl(fun (#c_bitstr{val=Val,size=Sz}, E0) -> - {_, E1} = visit(E0, Val), - {_, E2} = visit(E1, Sz), - E2 - end, Env, Segs). - -bind_vars(Vs, Env) -> - bind_vars(Vs, Env, []). - -bind_vars([#c_var{name=X}|Vs], Env0, Xs)-> - bind_vars(Vs, Env0#{X=>0}, [X|Xs]); -bind_vars([], Env,Xs) -> - {Xs, Env}. - -visit_pats(Ps, Env) -> - visit_pats(Ps, Env, []). - -visit_pats([P|Ps], Env0, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, P, Vs0), - visit_pats(Ps, Env1, Vs1); -visit_pats([], Env, Vs) -> - {Vs, Env}. - -visit_pat(Env0, #c_var{name=V}, Vs) -> - {[V|Vs], Env0#{V=>0}}; -visit_pat(Env0, #c_tuple{es=Es}, Vs) -> - visit_pats(Es, Env0, Vs); -visit_pat(Env0, #c_map{es=Es}, Vs) -> - visit_pats(Es, Env0, Vs); -visit_pat(Env0, #c_map_pair{op=#c_literal{val=exact},key=V,val=K}, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, V, Vs0), - visit_pat(Env1, K, Vs1); -visit_pat(Env0, #c_cons{hd=H,tl=T}, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, H, Vs0), - visit_pat(Env1, T, Vs1); -visit_pat(Env0, #c_binary{segments=Segs}, Vs) -> - visit_pats(Segs, Env0, Vs); -visit_pat(Env0, #c_bitstr{val=Val,size=Sz}, Vs0) -> - {Vs1, Env1} = - case Sz of - #c_var{name=V} -> - %% We don't tolerate free variables. - case Env0 of - #{V:=N} -> - {Vs0, Env0#{V:=N+1}} - end; - _ -> - visit_pat(Env0, Sz, Vs0) - end, - visit_pat(Env1, Val, Vs1); -visit_pat(Env0, #c_alias{pat=P,var=#c_var{name=V}}, Vs) -> - visit_pat(Env0#{V=>0}, P, [V|Vs]); -visit_pat(Env, #c_literal{}, Vs) -> - {Vs, Env}. - -restore_vars([V|Vs], Env0, Env1) -> - case Env0 of - #{V:=N} -> - restore_vars(Vs, Env0, Env1#{V=>N}); - _ -> - restore_vars(Vs, Env0, maps:remove(V, Env1)) - end; -restore_vars([], _, Env1) -> - Env1. - - -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in call 'erlang':'setelement(3, X1, Value2) -%% => -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X1, Value2) -%% X1 - -rewrite(#c_let{vars=[#c_var{name=X}=V]=Vs, - arg=#c_call{module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index1}, _Tuple, _Val1] - }=A, - body=#c_call{anno=Banno,module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index2}, - #c_var{name=X}, - Val2] - } - }=R, - _BodyEnv, FinalEnv) - when is_integer(Index1), is_integer(Index2), Index2 > 0, Index1 > Index2 -> - case is_safe(Val2) of - true -> - {R#c_let{vars=Vs, - arg=A, - body=#c_seq{arg=#c_primop{ - anno=Banno, - name=#c_literal{val='dsetelement'}, - args=[#c_literal{val=Index2}, - V, - Val2]}, - body=V} - }, - FinalEnv}; - false -> - {R, FinalEnv} - end; - -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in let X2 = 'erlang':'setelement(3, X1, Value2) -%% in ... -%% => -%% let X2 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X2, Value2) -%% ... -%% if X1 is used exactly once. - -rewrite(#c_let{vars=[#c_var{name=X1}], - arg=#c_call{module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index1}, _Tuple, _Val1] - }=A, - body=#c_let{vars=[#c_var{}=V]=Vs, - arg=#c_call{anno=Banno, - module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index2}, - #c_var{name=X1}, - Val2]}, - body=B} - }=R, - BodyEnv, FinalEnv) - when is_integer(Index1), is_integer(Index2), Index2 > 0, Index1 > Index2 -> - case is_single_use(X1, BodyEnv) andalso is_safe(Val2) of - true -> - {R#c_let{vars=Vs, - arg=A, - body=#c_seq{arg=#c_primop{ - anno=Banno, - name=#c_literal{val='dsetelement'}, - args=[#c_literal{val=Index2}, - V, - Val2]}, - body=B} - }, - FinalEnv}; - false -> - {R, FinalEnv} - end; - -rewrite(R, _, FinalEnv) -> - {R, FinalEnv}. - -%% is_safe(CoreExpr) -> true|false -%% Determines whether the Core expression can cause a GC collection at run-time. -%% Note: Assumes that the constant pool is turned on. - -is_safe(#c_var{}) -> true; -is_safe(#c_literal{}) -> true; -is_safe(_) -> false. - -is_single_use(V, Env) -> - case Env of - #{V:=1} -> - true; - _ -> - false - end. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 43c99be982..7e219da0af 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -961,18 +961,12 @@ fold_lit_args(Call, Module, Name, Args0) -> %% fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) -> eval_is_boolean(Call, Arg, Sub); -fold_non_lit_args(Call, erlang, element, [Arg1,Arg2], Sub) -> - eval_element(Call, Arg1, Arg2, Sub); fold_non_lit_args(Call, erlang, length, [Arg], _) -> eval_length(Call, Arg); fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); -fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) -> - eval_setelement(Call, Arg1, Arg2, Arg3); -fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) -> - eval_is_record(Call, Arg1, Arg2, Arg3, Sub); fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) -> eval_is_function_1(Call, Arg1, Sub); fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) -> @@ -1141,96 +1135,6 @@ eval_append(Call, #c_cons{anno=Anno,hd=H,tl=T}, List) -> eval_append(Call, X, Y) -> Call#c_call{args=[X,Y]}. %Rebuild call arguments. -%% eval_element(Call, Pos, Tuple, Types) -> Val. -%% Evaluates element/2 if the position Pos is a literal and -%% the shape of the tuple Tuple is known. -%% -eval_element(Call, #c_literal{val=Pos}, Tuple, Types) - when is_integer(Pos) -> - case get_type(Tuple, Types) of - none -> - Call; - Type -> - Es = case cerl:is_c_tuple(Type) of - false -> []; - true -> cerl:tuple_es(Type) - end, - if - 1 =< Pos, Pos =< length(Es) -> - El = lists:nth(Pos, Es), - try - cerl:set_ann(pat_to_expr(El), [compiler_generated]) - catch - throw:impossible -> - Call - end; - true -> - %% Index outside tuple or not a tuple. - eval_failure(Call, badarg) - end - end; -eval_element(Call, Pos, Tuple, Sub) -> - case is_int_type(Pos, Sub) =:= no orelse - is_tuple_type(Tuple, Sub) =:= no of - true -> - eval_failure(Call, badarg); - false -> - Call - end. - -%% eval_is_record(Call, Var, Tag, Size, Types) -> Val. -%% Evaluates is_record/3 using type information. -%% -eval_is_record(Call, Term, #c_literal{val=NeededTag}, - #c_literal{val=Size}, Types) -> - case get_type(Term, Types) of - none -> - Call; - Type -> - Es = case cerl:is_c_tuple(Type) of - false -> []; - true -> cerl:tuple_es(Type) - end, - case Es of - [#c_literal{val=Tag}|_] -> - Bool = Tag =:= NeededTag andalso - length(Es) =:= Size, - #c_literal{val=Bool}; - _ -> - #c_literal{val=false} - end - end; -eval_is_record(Call, _, _, _, _) -> Call. - -%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. -%% Evaluates setelement/3 if position Pos is an integer -%% and the shape of the tuple Tuple is known. -%% -eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal) - when is_integer(Pos) -> - case cerl:is_data(Tuple) of - false -> - Call; - true -> - Es0 = case cerl:is_c_tuple(Tuple) of - false -> []; - true -> cerl:tuple_es(Tuple) - end, - if - 1 =< Pos, Pos =< length(Es0) -> - Es = eval_setelement_1(Pos, Es0, NewVal), - cerl:update_c_tuple(Tuple, Es); - true -> - eval_failure(Call, badarg) - end - end; -eval_setelement(Call, _, _, _) -> Call. - -eval_setelement_1(1, [_|T], NewVal) -> - [NewVal|T]; -eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 -> - [H|eval_setelement_1(Pos-1, T, NewVal)]. - %% eval_failure(Call, Reason) -> Core. %% Warn for a call that will fail and replace the call with %% a call to erlang:error(Reason). @@ -1290,16 +1194,15 @@ clause(#c_clause{pats=Ps0}=Cl, Cexpr, Ctxt, Sub0) -> end. clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> - Sub2 = update_types(Cexpr, Ps1, Sub1), GSub = case {Cexpr,Ps1,G0} of {_,_,#c_literal{}} -> %% No need for substitution tricks when the guard %% does not contain any variables. - Sub2; + Sub1; {#c_var{name='_'},_,_} -> %% In a 'receive', Cexpr is the variable '_', which represents the %% message being matched. We must NOT do any extra substiutions. - Sub2; + Sub1; {#c_var{},[#c_var{}=Var],_} -> %% The idea here is to optimize expressions such as %% @@ -1321,16 +1224,16 @@ clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> %% case cerl:is_c_fname(Cexpr) of false -> - sub_set_var(Var, Cexpr, Sub2); + sub_set_var(Var, Cexpr, Sub1); true -> %% We must not copy funs, and especially not into guards. - Sub2 + Sub1 end; _ -> - Sub2 + Sub1 end, G1 = guard(G0, GSub), - B1 = body(B0, Ctxt, Sub2), + B1 = body(B0, Ctxt, Sub1), Cl#c_clause{pats=Ps1,guard=G1,body=B1}. %% let_substs(LetVars, LetArg, Sub) -> {[Var],[Val],Sub}. @@ -1414,8 +1317,7 @@ pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) -> {Pat#c_binary{segments=V1},Osub1}; pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) -> {V1,Osub1} = pattern(V0, Isub, Osub0), - {P1,Osub2} = pattern(P0, Isub, Osub1), - Osub = update_types(V1, [P1], Osub2), + {P1,Osub} = pattern(P0, Isub, Osub1), {Pat#c_alias{var=V1,pat=P1},Osub}. map_pair_pattern_list(Ps0, Isub, Osub0) -> @@ -2137,14 +2039,9 @@ case_expand_var(E, #sub{t=Tdb}) -> %% encountered. coerce_to_data(C) -> - case cerl:is_c_alias(C) of - false -> - case cerl:is_data(C) orelse cerl:is_c_var(C) of - true -> C; - false -> throw(impossible) - end; - true -> - coerce_to_data(cerl:alias_pat(C)) + case cerl:is_data(C) orelse cerl:is_c_var(C) of + true -> C; + false -> throw(impossible) end. %% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' @@ -3140,14 +3037,6 @@ is_int_type(Var, Sub) -> C -> yes_no(cerl:is_c_int(C)) end. --spec is_tuple_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_tuple_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> maybe; - C -> yes_no(cerl:is_c_tuple(C)) - end. - yes_no(true) -> yes; yes_no(false) -> no. @@ -3209,27 +3098,23 @@ returns_integer(_, _) -> false. %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. --spec update_types(cerl:cerl(), [type_info()], sub()) -> sub(). +-spec update_types(cerl:c_var(), [type_info()], sub()) -> sub(). -update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> - Tdb = update_types_1(Expr, Pat, Tdb0), +update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) -> + Tdb = update_types_1(V, Pat, Tdb0), Sub#sub{t=Tdb}. -update_types_1(#c_var{name=V}, Pat, Types) -> - update_types_2(V, Pat, Types); -update_types_1(_, _, Types) -> Types. - -update_types_2(V, [#c_tuple{}=P], Types) -> +update_types_1(V, [#c_tuple{}=P], Types) -> Types#{V=>P}; -update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> +update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> Types#{V=>bool}; -update_types_2(V, [#c_fun{vars=Vars}], Types) -> +update_types_1(V, [#c_fun{vars=Vars}], Types) -> Types#{V=>{'fun',length(Vars)}}; -update_types_2(V, [#c_var{name={_,Arity}}], Types) -> +update_types_1(V, [#c_var{name={_,Arity}}], Types) -> Types#{V=>{'fun',Arity}}; -update_types_2(V, [Type], Types) when is_atom(Type) -> +update_types_1(V, [Type], Types) when is_atom(Type) -> Types#{V=>Type}; -update_types_2(_, _, Types) -> Types. +update_types_1(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' %% Kill any entries that references the variable, diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index e2bcd25801..3699c9d22e 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -330,7 +330,7 @@ gexpr({protect,Line,Arg}, Bools0, St0) -> {#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St} end; gexpr({op,_,'andalso',_,_}=E0, Bools, St0) -> - {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso', St0), + {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -338,7 +338,7 @@ gexpr({op,_,'andalso',_,_}=E0, Bools, St0) -> E = make_bool_switch_guard(L, E1, V, E2, False), gexpr(E, Bools, St); gexpr({op,_,'orelse',_,_}=E0, Bools, St0) -> - {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse', St0), + {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -768,7 +768,7 @@ expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2), {Y,Mps++Yps,St}; expr({op,_,'andalso',_,_}=E0, St0) -> - {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso', St0), + {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -776,7 +776,7 @@ expr({op,_,'andalso',_,_}=E0, St0) -> E = make_bool_switch(L, E1, V, E2, False, St0), expr(E, St); expr({op,_,'orelse',_,_}=E0, St0) -> - {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse', St0), + {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -2060,17 +2060,9 @@ fail_clause(Pats, Anno, Arg) -> args=[Arg]}]}. %% Optimization for Dialyzer. -right_assoc(E, Op, St) -> - case member(dialyzer, St#core.opts) of - true -> - right_assoc2(E, Op); - false -> - E - end. - -right_assoc2({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) -> - right_assoc2({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op); -right_assoc2(E, _Op) -> E. +right_assoc({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) -> + right_assoc({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op); +right_assoc(E, _Op) -> E. annotate_tuple(A, Es, St) -> case member(dialyzer, St#core.opts) of diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index f7ca66b1da..86351bc0c5 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1414,7 +1414,6 @@ is_remote_bif(_, _, _) -> false. %% return multiple values. Only used in bodies where a BIF may be %% called for effect only. -bif_vals(dsetelement, 3) -> 0; bif_vals(_, _) -> 1. bif_vals(_, _, _) -> 1. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 585d0e7191..2660bf222c 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -159,7 +159,7 @@ merge_undefined(Config) when is_list(Config) -> [{{t,handle_call,2}, {{call_ext,1,{extfunc,erlang,exit,1}}, 10, - {uninitialized_reg,{y,0}}}}] = Errors, + {uninitialized_reg,{y,_}}}}] = Errors, ok. uninit(Config) when is_list(Config) -> @@ -211,16 +211,16 @@ bad_catch_try(Config) when is_list(Config) -> Errors = do_val(bad_catch_try, Config), [{{bad_catch_try,bad_1,1}, {{'catch',{x,0},{f,3}}, - 5,{invalid_store,{x,0},{catchtag,[3]}}}}, + 5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_2,1}, {{catch_end,{x,9}}, - 8,{source_not_y_reg,{x,9}}}}, + 8,{invalid_tag_register,{x,9}}}}, {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, + {{catch_end,{y,1}},9,{invalid_tag,{y,1},{atom,kalle}}}}, {{bad_catch_try,bad_4,1}, - {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, + {{'try',{x,0},{f,15}},5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{bad_type,term}}}, + {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}}, {{bad_catch_try,bad_6,1}, {{move,{integer,1},{y,1}},7, {invalid_store,{y,1},{integer,1}}}}] = Errors, @@ -539,37 +539,37 @@ receive_stacked(Config) -> [{{receive_stacked,f1,0}, {{loop_rec_end,{f,3}}, 17, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f2,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f3,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f4,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f5,0}, {{loop_rec_end,{f,23}}, 23, - {fragile_message_reference,{y,1}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f6,0}, - {{gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}}, + {{gc_bif,byte_size,{f,29},0,[{y,_}],{x,0}}, 12, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f7,0}, {{loop_rec_end,{f,33}}, 20, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f8,0}, {{loop_rec_end,{f,38}}, 20, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,m1,0}, {{loop_rec_end,{f,43}}, 19, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,m2,0}, {{loop_rec_end,{f,48}}, 33, - {fragile_message_reference,{y,0}}}}] = Errors, + {fragile_message_reference,{y,_}}}}] = Errors, %% Compile the original source code as a smoke test. Data = proplists:get_value(data_dir, Config), diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 78c4bbe9c0..408af80dd9 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -372,7 +372,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> {dcore, ".core"}, {dcopt, ".copt"}, {dcbsm, ".core_bsm"}, - {dsetel, ".dsetel"}, {dkern, ".kernel"}, {dssa, ".ssa"}, {dssaopt, ".ssaopt"}, diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 0f9b2dd21f..a0b415ceaa 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -161,14 +161,13 @@ md5_1(Beam) -> %% Cover some code that handles internal errors. silly_coverage(Config) when is_list(Config) -> - %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel + %% sys_core_fold, sys_core_alias, sys_core_bsm, v3_kernel BadCoreErlang = {c_module,[], name,[],[], [{{c_var,[],{foo,2}},seriously_bad_body}]}, expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end), expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end), expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end), - expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end), expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), %% beam_kernel_to_ssa diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index c5d0bf8420..70b7100451 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -240,19 +240,7 @@ guard(Config) when is_list(Config) -> {4,sys_core_fold,nomatch_guard}, {6,sys_core_fold,no_clause_match}, {6,sys_core_fold,nomatch_guard}, - {6,sys_core_fold,{eval_failure,badarg}}, - {8,sys_core_fold,no_clause_match}, - {8,sys_core_fold,nomatch_guard}, - {8,sys_core_fold,{eval_failure,badarg}}, - {9,sys_core_fold,no_clause_match}, - {9,sys_core_fold,nomatch_guard}, - {9,sys_core_fold,{eval_failure,badarg}}, - {10,sys_core_fold,no_clause_match}, - {10,sys_core_fold,nomatch_guard}, - {10,sys_core_fold,{eval_failure,badarg}}, - {11,sys_core_fold,no_clause_match}, - {11,sys_core_fold,nomatch_guard}, - {11,sys_core_fold,{eval_failure,badarg}} + {6,sys_core_fold,{eval_failure,badarg}} ]}}], [] = run(Config, Ts), diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index da059fa7d6..e5e766d2a0 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -92,9 +92,9 @@ -type connect_option() :: {raddr, inet:ip_address()} | {rport, pos_integer()} - | {ssl_options, true | [ssl:connect_option()]} + | {ssl_options, true | [ssl:tls_client_option()]} | option() - | ssl:connect_option() + | ssl:tls_client_option() | gen_tcp:connect_option(). -type match() :: inet:ip_address() @@ -102,9 +102,9 @@ | [match()]. -type listen_option() :: {accept, match()} - | {ssl_options, true | [ssl:listen_option()]} + | {ssl_options, true | [ssl:tls_server_option()]} | option() - | ssl:listen_option() + | ssl:tls_server_option() | gen_tcp:listen_option(). -type option() :: {port, non_neg_integer()} diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml index 0668676096..df2d081d76 100644 --- a/lib/kernel/doc/src/logger.xml +++ b/lib/kernel/doc/src/logger.xml @@ -689,6 +689,15 @@ start(_, []) -> </func> <func> + <name name="i" arity="0" since="OTP 21.3"/> + <name name="i" arity="1" since="OTP 21.3"/> + <fsummary>Pretty print the Logger configuration.</fsummary> + <desc> + <p>Pretty print the Logger configuration.</p> + </desc> + </func> + + <func> <name name="remove_handler" arity="1" since="OTP 21.0"/> <fsummary>Remove the handler with the specified identity.</fsummary> <desc> diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl index 003852f1b0..f06fc328d7 100644 --- a/lib/kernel/include/dist.hrl +++ b/lib/kernel/include/dist.hrl @@ -42,6 +42,9 @@ -define(DFLAG_BIG_CREATION, 16#40000). -define(DFLAG_SEND_SENDER, 16#80000). -define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000). +%% -define(DFLAG_NO_MAGIC, 16#200000). %% Used internally only +-define(DFLAG_EXIT_PAYLOAD, 16#400000). +-define(DFLAG_FRAGMENTS, 16#800000). %% Also update dflag2str() in ../src/dist_util.erl %% when adding flags... diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index ecc022b28d..09ed31f10c 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -116,6 +116,10 @@ dflag2str(?DFLAG_SEND_SENDER) -> "SEND_SENDER"; dflag2str(?DFLAG_BIG_SEQTRACE_LABELS) -> "BIG_SEQTRACE_LABELS"; +dflag2str(?DFLAG_EXIT_PAYLOAD) -> + "EXIT_PAYLOAD"; +dflag2str(?DFLAG_FRAGMENTS) -> + "FRAGMENTS"; dflag2str(_) -> "UNKNOWN". diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl index c37212b0f9..c5a114a9ef 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -212,6 +212,7 @@ do_accept(Driver, Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> [{active, true}, {deliver, port}, {packet, 4}, + binary, nodelay()]) end, f_getll = fun(S) -> diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl index abdd9a9ceb..7d36640f52 100644 --- a/lib/kernel/src/logger.erl +++ b/lib/kernel/src/logger.erl @@ -60,6 +60,7 @@ -export([compare_levels/2]). -export([set_process_metadata/1, update_process_metadata/1, unset_process_metadata/0, get_process_metadata/0]). +-export([i/0, i/1]). %% Basic report formatting -export([format_report/1, format_otp_report/1]). @@ -647,6 +648,142 @@ get_config() -> proxy=>get_proxy_config(), module_levels=>lists:keysort(1,get_module_level())}. +-spec i() -> ok. +i() -> + #{primary := Primary, + handlers := HandlerConfigs, + proxy := Proxy, + module_levels := Modules} = get_config(), + M = modifier(), + i_primary(Primary,M), + i_handlers(HandlerConfigs,M), + i_proxy(Proxy,M), + i_modules(Modules,M). + +-spec i(What) -> ok when + What :: primary | handlers | proxy | modules | handler_id(). +i(primary) -> + i_primary(get_primary_config(),modifier()); +i(handlers) -> + i_handlers(get_handler_config(),modifier()); +i(proxy) -> + i_proxy(get_proxy_config(),modifier()); +i(modules) -> + i_modules(get_module_level(),modifier()); +i(HandlerId) when is_atom(HandlerId) -> + case get_handler_config(HandlerId) of + {ok,HandlerConfig} -> + i_handlers([HandlerConfig],modifier()); + Error -> + Error + end; +i(What) -> + erlang:error(badarg,[What]). + + +i_primary(#{level := Level, + filters := Filters, + filter_default := FilterDefault}, + M) -> + io:format("Primary configuration: ~n",[]), + io:format(" Level: ~p~n",[Level]), + io:format(" Filter Default: ~p~n", [FilterDefault]), + io:format(" Filters: ~n", []), + print_filters(" ",Filters,M). + +i_handlers(HandlerConfigs,M) -> + io:format("Handler configuration: ~n", []), + print_handlers(HandlerConfigs,M). + +i_proxy(Proxy,M) -> + io:format("Proxy configuration: ~n", []), + print_custom(" ",Proxy,M). + +i_modules(Modules,M) -> + io:format("Level set per module: ~n", []), + print_module_levels(Modules,M). + +encoding() -> + case lists:keyfind(encoding, 1, io:getopts()) of + false -> latin1; + {encoding, Enc} -> Enc + end. + +modifier() -> + modifier(encoding()). + +modifier(latin1) -> ""; +modifier(_) -> "t". + +print_filters(Indent, {Id, {Fun, Arg}}, M) -> + io:format("~sId: ~"++M++"p~n" + "~s Fun: ~"++M++"p~n" + "~s Arg: ~"++M++"p~n", + [Indent, Id, Indent, Fun, Indent, Arg]); +print_filters(Indent,[],_M) -> + io:format("~s(none)~n",[Indent]); +print_filters(Indent,Filters,M) -> + [print_filters(Indent,Filter,M) || Filter <- Filters], + ok. + +print_handlers(#{id := Id, + module := Module, + level := Level, + filters := Filters, filter_default := FilterDefault, + formatter := {FormatterModule,FormatterConfig}} = Config, M) -> + io:format(" Id: ~"++M++"p~n" + " Module: ~p~n" + " Level: ~p~n" + " Formatter:~n" + " Module: ~p~n" + " Config:~n", + [Id, Module, Level, FormatterModule]), + print_custom(" ",FormatterConfig,M), + io:format(" Filter Default: ~p~n" + " Filters:~n", + [FilterDefault]), + print_filters(" ",Filters,M), + case maps:find(config,Config) of + {ok,HandlerConfig} -> + io:format(" Handler Config:~n"), + print_custom(" ",HandlerConfig,M); + error -> + ok + end, + MyKeys = [filter_default, filters, formatter, level, module, id, config], + case maps:without(MyKeys,Config) of + Empty when Empty==#{} -> + ok; + Unhandled -> + io:format(" Custom Config:~n"), + print_custom(" ",Unhandled,M) + end; +print_handlers([], _M) -> + io:format(" (none)~n"); +print_handlers(HandlerConfigs, M) -> + [print_handlers(HandlerConfig, M) || HandlerConfig <- HandlerConfigs], + ok. + +print_custom(Indent, {Key, Value}, M) -> + io:format("~s~"++M++"p: ~"++M++"p~n",[Indent,Key,Value]); +print_custom(Indent, Map, M) when is_map(Map) -> + print_custom(Indent,lists:keysort(1,maps:to_list(Map)), M); +print_custom(Indent, List, M) when is_list(List), is_tuple(hd(List)) -> + [print_custom(Indent, X, M) || X <- List], + ok; +print_custom(Indent, Value, M) -> + io:format("~s~"++M++"p~n",[Indent,Value]). + +print_module_levels({Module,Level},M) -> + io:format(" Module: ~"++M++"p~n" + " Level: ~p~n", + [Module,Level]); +print_module_levels([],_M) -> + io:format(" (none)~n"); +print_module_levels(Modules,M) -> + [print_module_levels(Module,M) || Module <- Modules], + ok. + -spec internal_init_logger() -> ok | {error,term()}. %% This function is responsible for config of the logger %% This is done before add_handlers because we want the diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl index 0669164bb6..65f5b3876e 100644 --- a/lib/kernel/src/logger_std_h.erl +++ b/lib/kernel/src/logger_std_h.erl @@ -217,17 +217,24 @@ open_log_file(HandlerName, FileInfo) -> Error -> Error end. -do_open_log_file({file,File}) -> - do_open_log_file({file,File,[raw,append,delayed_write]}); +do_open_log_file({file,FileName}) -> + do_open_log_file({file,FileName,[raw,append,delayed_write]}); -do_open_log_file({file,File,[]}) -> - do_open_log_file({file,File,[raw,append,delayed_write]}); +do_open_log_file({file,FileName,[]}) -> + do_open_log_file({file,FileName,[raw,append,delayed_write]}); -do_open_log_file({file,File,Modes}) -> +do_open_log_file({file,FileName,Modes}) -> try - case filelib:ensure_dir(File) of + case filelib:ensure_dir(FileName) of ok -> - file:open(File, Modes); + case file:open(FileName, Modes) of + {ok, Fd} -> + {ok,#file_info{inode=INode}} = + file:read_file_info(FileName), + {ok, {Fd, INode}}; + Error -> + Error + end; Error -> Error end @@ -237,7 +244,7 @@ do_open_log_file({file,File,Modes}) -> close_log_file(Std) when Std == standard_io; Std == standard_error -> ok; -close_log_file(Fd) -> +close_log_file({Fd,_}) -> _ = file:datasync(Fd), _ = file:close(Fd). @@ -296,9 +303,9 @@ file_ctrl_init(HandlerName, FileInfo, Starter) when is_tuple(FileInfo) -> process_flag(message_queue_data, off_heap), FileName = element(2, FileInfo), case do_open_log_file(FileInfo) of - {ok,Fd} -> + {ok,File} -> Starter ! {self(),ok}, - file_ctrl_loop(Fd, FileName, false, ok, ok, HandlerName); + file_ctrl_loop(File, FileName, false, ok, ok, HandlerName); {error,Reason} -> Starter ! {self(),{error,{open_failed,FileName,Reason}}} end; @@ -306,39 +313,43 @@ file_ctrl_init(HandlerName, StdDev, Starter) -> Starter ! {self(),ok}, file_ctrl_loop(StdDev, StdDev, false, ok, ok, HandlerName). -file_ctrl_loop(Fd, DevName, Synced, +file_ctrl_loop(File, DevName, Synced, PrevWriteResult, PrevSyncResult, HandlerName) -> receive %% asynchronous event {log,Bin} -> - Fd1 = ensure(Fd, DevName), - Result = write_to_dev(Fd1, Bin, DevName, PrevWriteResult, HandlerName), - file_ctrl_loop(Fd1, DevName, false, + File1 = ensure(File, DevName), + Result = write_to_dev(File1, Bin, DevName, + PrevWriteResult, HandlerName), + file_ctrl_loop(File1, DevName, false, Result, PrevSyncResult, HandlerName); %% synchronous event {{log,Bin},{From,MRef}} -> - Fd1 = ensure(Fd, DevName), - Result = write_to_dev(Fd1, Bin, DevName, PrevWriteResult, HandlerName), + File1 = ensure(File, DevName), + Result = write_to_dev(File1, Bin, DevName, + PrevWriteResult, HandlerName), From ! {MRef,ok}, - file_ctrl_loop(Fd1, DevName, false, + file_ctrl_loop(File1, DevName, false, Result, PrevSyncResult, HandlerName); filesync -> - Fd1 = ensure(Fd, DevName), - Result = sync_dev(Fd1, DevName, Synced, PrevSyncResult, HandlerName), - file_ctrl_loop(Fd1, DevName, true, + File1 = ensure(File, DevName), + Result = sync_dev(File1, DevName, Synced, + PrevSyncResult, HandlerName), + file_ctrl_loop(File1, DevName, true, PrevWriteResult, Result, HandlerName); {filesync,{From,MRef}} -> - Fd1 = ensure(Fd, DevName), - Result = sync_dev(Fd1, DevName, Synced, PrevSyncResult, HandlerName), + File1 = ensure(File, DevName), + Result = sync_dev(File1, DevName, Synced, + PrevSyncResult, HandlerName), From ! {MRef,ok}, - file_ctrl_loop(Fd1, DevName, true, + file_ctrl_loop(File1, DevName, true, PrevWriteResult, Result, HandlerName); stop -> - _ = close_log_file(Fd), + _ = close_log_file(File), stopped end. @@ -347,16 +358,16 @@ file_ctrl_loop(Fd, DevName, Synced, %% logrotate) ensure(Fd,DevName) when is_atom(DevName) -> Fd; -ensure(Fd,FileName) -> +ensure({Fd,INode},FileName) -> case file:read_file_info(FileName) of - {ok,_} -> - Fd; + {ok,#file_info{inode=INode}} -> + {Fd,INode}; _ -> _ = file:close(Fd), _ = file:close(Fd), % delayed_write cause close not to close case do_open_log_file({file,FileName}) of - {ok,Fd1} -> - Fd1; + {ok,File} -> + File; Error -> exit({could_not_reopen_file,Error}) end @@ -365,13 +376,13 @@ ensure(Fd,FileName) -> write_to_dev(DevName, Bin, _DevName, _PrevWriteResult, _HandlerName) when is_atom(DevName) -> io:put_chars(DevName, Bin); -write_to_dev(Fd, Bin, FileName, PrevWriteResult, HandlerName) -> +write_to_dev({Fd,_}, Bin, FileName, PrevWriteResult, HandlerName) -> Result = ?file_write(Fd, Bin), maybe_notify_error(write,Result,PrevWriteResult,FileName,HandlerName). -sync_dev(_Fd, _FileName, true, PrevSyncResult, _HandlerName) -> +sync_dev(_, _FileName, true, PrevSyncResult, _HandlerName) -> PrevSyncResult; -sync_dev(Fd, FileName, false, PrevSyncResult, HandlerName) -> +sync_dev({Fd,_}, FileName, false, PrevSyncResult, HandlerName) -> Result = ?file_datasync(Fd), maybe_notify_error(filesync,Result,PrevSyncResult,FileName,HandlerName). diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 4915193196..83d3b4b5e1 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -1126,14 +1126,22 @@ do_disconnect(Node, State) -> {false, State} end. - disconnect_pid(Pid, State) -> exit(Pid, disconnect), + + %% This code used to only use exit + recv 'EXIT' to sync, + %% but since OTP-22 links are no longer broken atomically + %% so the exit message below can arrive before any remaining + %% exit messages have killed the distribution port + Ref = erlang:monitor(process, Pid), %% Sync wait for connection to die!!! receive - {'EXIT',Pid,Reason} -> - {_,State1} = handle_exit(Pid, Reason, State), - {true, State1} + {'DOWN',Ref,_,_,_} -> + receive + {'EXIT',Pid,Reason} -> + {_,State1} = handle_exit(Pid, Reason, State), + {true, State1} + end end. %% diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl index d831d0d108..2dad651f9c 100644 --- a/lib/kernel/test/logger_SUITE.erl +++ b/lib/kernel/test/logger_SUITE.erl @@ -101,7 +101,8 @@ all() -> compare_levels, process_metadata, app_config, - kernel_config]. + kernel_config, + pretty_print]. start_stop(_Config) -> S = whereis(logger), @@ -1141,6 +1142,61 @@ kernel_config(Config) -> ok. +pretty_print(Config) -> + ok = logger:add_handler(?FUNCTION_NAME,logger_std_h,#{}), + ok = logger:set_module_level([module1,module2],debug), + + ct:capture_start(), + logger:i(), + ct:capture_stop(), + I0 = ct:capture_get(), + + ct:capture_start(), + logger:i(primary), + ct:capture_stop(), + IPrim = ct:capture_get(), + + ct:capture_start(), + logger:i(handlers), + ct:capture_stop(), + IHs = ct:capture_get(), + + ct:capture_start(), + logger:i(proxy), + ct:capture_stop(), + IProxy = ct:capture_get(), + + ct:capture_start(), + logger:i(modules), + ct:capture_stop(), + IMs = ct:capture_get(), + + I02 = lists:append([IPrim,IHs,IProxy,IMs]), + %% ct:log("~p~n",[I0]), + %% ct:log("~p~n",[I02]), + I0 = I02, + + ct:capture_start(), + logger:i(handlers), + ct:capture_stop(), + IHs = ct:capture_get(), + + Ids = logger:get_handler_ids(), + IHs2 = + lists:append( + [begin + ct:capture_start(), + logger:i(Id), + ct:capture_stop(), + [_|IH] = ct:capture_get(), + IH + end || Id <- Ids]), + + %% ct:log("~p~n",[IHs]), + %% ct:log("~p~n",[["Handler configuration: \n"|IHs2]]), + IHs = ["Handler configuration: \n"|IHs2], + ok. + %%%----------------------------------------------------------------- %%% Internal check_logged(Level,Format,Args,Meta) -> diff --git a/lib/kernel/test/logger_disk_log_h_SUITE.erl b/lib/kernel/test/logger_disk_log_h_SUITE.erl index 9bbec42de8..13b30835a1 100644 --- a/lib/kernel/test/logger_disk_log_h_SUITE.erl +++ b/lib/kernel/test/logger_disk_log_h_SUITE.erl @@ -293,7 +293,7 @@ logging(Config) -> ok = start_and_add(Name, #{filter_default=>log, formatter=>{?MODULE,self()}}, #{file => LogFile}), - MsgFormatter = fun(Term) -> {io_lib:format("Term:~p",[Term]),[]} end, + MsgFormatter = fun(Term) -> {"Term:~p",[Term]} end, logger:notice([{x,y}], #{report_cb => MsgFormatter}), logger:notice([{x,y}], #{}), ct:pal("Checking contents of ~p", [?log_no(LogFile,1)]), diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl index 484d914ec3..b2c2c8ba67 100644 --- a/lib/kernel/test/logger_std_h_SUITE.erl +++ b/lib/kernel/test/logger_std_h_SUITE.erl @@ -141,7 +141,8 @@ all() -> mem_kill_std, restart_after, handler_requests_under_load, - recreate_deleted_log + recreate_deleted_log, + reopen_changed_log ]. add_remove_instance_tty(_Config) -> @@ -1269,6 +1270,21 @@ recreate_deleted_log(Config) -> recreate_deleted_log(cleanup, _Config) -> ok = stop_handler(?MODULE). +reopen_changed_log(Config) -> + {Log,_HConfig,_StdHConfig} = + start_handler(?MODULE, ?FUNCTION_NAME, Config), + logger:notice("first",?domain), + logger_std_h:filesync(?MODULE), + ok = file:rename(Log,Log++".old"), + ok = file:write_file(Log,""), + logger:notice("second",?domain), + logger_std_h:filesync(?MODULE), + {ok,<<"first\n">>} = file:read_file(Log++".old"), + {ok,<<"second\n">>} = file:read_file(Log), + ok. +reopen_changed_log(cleanup, _Config) -> + ok = stop_handler(?MODULE). + %%%----------------------------------------------------------------- %%% send_requests(TO, Reqs = [{Mod,Func,Args,Res}|Rs]) -> diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index d6b5eff9b5..84ed99afa5 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -24,7 +24,7 @@ create_binaries/0,create_sub_binaries/1, dump_persistent_terms/0, create_persistent_terms/0]). --compile(r18). +-compile(r20). -include_lib("common_test/include/ct.hrl"). n1_proc(N2,Creator) -> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index fd85d3722d..47c5dbb95a 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -66,7 +66,7 @@ -export_type([public_key/0, private_key/0, pem_entry/0, pki_asn1_type/0, asn1_type/0, ssh_file/0, der_encoded/0, - key_params/0, digest_type/0, issuer_name/0]). + key_params/0, digest_type/0, issuer_name/0, oid/0]). -type public_key() :: rsa_public_key() | dsa_public_key() | ec_public_key() | ed_public_key() . -type private_key() :: rsa_private_key() | dsa_private_key() | ec_private_key() | ed_private_key() . diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index f11aae61c6..bb092e8bbf 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -172,7 +172,7 @@ break(_Config) -> start_server(_Config) -> {ok, Pid} = ?msym({ok, _}, reltool:start_server([])), - Libs = lists:sort(erl_libs()), + Libs = reltool_test_lib:erl_libs(), StrippedDefault = case Libs of [] -> {sys, []}; @@ -186,7 +186,7 @@ start_server(_Config) -> %% Start a server process and check that it does not crash set_config(_Config) -> - Libs = lists:sort(erl_libs()), + Libs = reltool_test_lib:erl_libs(), Default = {sys, [ @@ -220,7 +220,15 @@ get_config(_Config) -> StdLibDir = filename:join(LibDir,"stdlib-"++StdVsn), SaslLibDir = filename:join(LibDir,"sasl-"++SaslVsn), - Sys = {sys,[{incl_cond, exclude}, + Libs = reltool_test_lib:erl_libs(), + LibDirs = + case Libs of + [] -> []; + _ -> [{lib_dirs,Libs}] + end, + + Sys = {sys,LibDirs ++ + [{incl_cond, exclude}, {app,kernel,[{incl_cond,include}]}, {app,sasl,[{incl_cond,include},{vsn,SaslVsn}]}, {app,stdlib,[{incl_cond,include},{lib_dir,StdLibDir}]}]}, @@ -229,13 +237,27 @@ get_config(_Config) -> ?m({ok, Sys}, reltool:get_config(Pid,false,false)), %% Include derived info - ?msym({ok,{sys,[{incl_cond, exclude}, - {erts,[]}, - {app,kernel,[{incl_cond,include},{mod,_,[]}|_]}, - {app,sasl,[{incl_cond,include},{vsn,SaslVsn},{mod,_,[]}|_]}, - {app,stdlib,[{incl_cond,include},{lib_dir,StdLibDir}, - {mod,_,[]}|_]}]}}, - reltool:get_config(Pid,false,true)), + case Libs of + [] -> + ?msym({ok,{sys,[{incl_cond, exclude}, + {erts,[]}, + {app,kernel,[{incl_cond,include},{mod,_,[]}|_]}, + {app,sasl,[{incl_cond,include},{vsn,SaslVsn}, + {mod,_,[]}|_]}, + {app,stdlib,[{incl_cond,include},{lib_dir,StdLibDir}, + {mod,_,[]}|_]}]}}, + reltool:get_config(Pid,false,true)); + _ -> + ?msym({ok,{sys,[{lib_dirs,Libs}, + {incl_cond, exclude}, + {erts,[]}, + {app,kernel,[{incl_cond,include},{mod,_,[]}|_]}, + {app,sasl,[{incl_cond,include},{vsn,SaslVsn}, + {mod,_,[]}|_]}, + {app,stdlib,[{incl_cond,include},{lib_dir,StdLibDir}, + {mod,_,[]}|_]}]}}, + reltool:get_config(Pid,false,true)) + end, %% Include defaults ?msym({ok,{sys,[{root_dir,_}, @@ -306,11 +328,11 @@ get_config(_Config) -> %% OTP-9135, test that app_file option can be set to all | keep | strip otp_9135(_Config) -> - Libs = lists:sort(erl_libs()), + Libs = reltool_test_lib:erl_libs(), StrippedDefaultSys = case Libs of [] -> []; - _ -> {lib_dirs, Libs} + _ -> [{lib_dirs, Libs}] end, Config1 = {sys,[{app_file, keep}]}, % this is the default @@ -1746,13 +1768,19 @@ set_sys_and_undo(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% load_config_and_undo(Config) -> - Sys1 = {sys,[{incl_cond, exclude}, - {app,kernel,[{incl_cond,include}]}, - {app,sasl,[{incl_cond,include}]}, - {app,stdlib,[{incl_cond,include}]}, - {app,tools,[{incl_cond,include}]}]}, + Sys1 = {sys,Cfg1=[{incl_cond, exclude}, + {app,kernel,[{incl_cond,include}]}, + {app,sasl,[{incl_cond,include}]}, + {app,stdlib,[{incl_cond,include}]}, + {app,tools,[{incl_cond,include}]}]}, {ok, Pid} = ?msym({ok, _}, reltool:start_server([{config, Sys1}])), - ?m({ok, Sys1}, reltool:get_config(Pid)), + Libs = reltool_test_lib:erl_libs(), + Sys11 = + case Libs of + [] -> Sys1; + _ -> {sys, [{lib_dirs, Libs}|Cfg1]} + end, + ?m({ok, Sys11}, reltool:get_config(Pid)), ?m({ok,[]}, reltool_server:get_status(Pid)), %% Get app and mod @@ -1807,13 +1835,19 @@ load_config_and_undo(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test that load_config is properly rolled back if it fails load_config_fail(_Config) -> - Sys1 = {sys,[{incl_cond, exclude}, - {app,kernel,[{incl_cond,include}]}, - {app,sasl,[{incl_cond,include}]}, - {app,stdlib,[{incl_cond,include}]}, - {app,tools,[{incl_cond,include}]}]}, + Sys1 = {sys,Cfg1=[{incl_cond, exclude}, + {app,kernel,[{incl_cond,include}]}, + {app,sasl,[{incl_cond,include}]}, + {app,stdlib,[{incl_cond,include}]}, + {app,tools,[{incl_cond,include}]}]}, {ok, Pid} = ?msym({ok, _}, reltool:start_server([{config, Sys1}])), - ?m({ok, Sys1}, reltool:get_config(Pid)), + Libs = reltool_test_lib:erl_libs(), + Sys11 = + case Libs of + [] -> Sys1; + _ -> {sys, [{lib_dirs, Libs}|Cfg1]} + end, + ?m({ok, Sys11}, reltool:get_config(Pid)), ?m({ok,[]}, reltool_server:get_status(Pid)), %% Get app and mod @@ -1831,7 +1865,7 @@ load_config_fail(_Config) -> reltool_server:load_config(Pid,Sys2)), %% Check that a rollback is done to the old configuration - ?m({ok, Sys1}, reltool:get_config(Pid,false,false)), + ?m({ok, Sys11}, reltool:get_config(Pid,false,false)), %% and that tools is not changed (i.e. that the new configuration %% is not applied) @@ -2101,25 +2135,42 @@ gen_rel_files(_Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% save_config(Config) -> PrivDir = ?config(priv_dir,Config), - Sys = {sys,[{incl_cond, exclude}, - {app,kernel,[{incl_cond,include}]}, - {app,sasl,[{incl_cond,include}]}, - {app,stdlib,[{incl_cond,include}]}]}, + Sys = {sys,Cfg=[{incl_cond, exclude}, + {app,kernel,[{incl_cond,include}]}, + {app,sasl,[{incl_cond,include}]}, + {app,stdlib,[{incl_cond,include}]}]}, {ok, Pid} = ?msym({ok, _}, reltool:start_server([{config, Sys}])), - ?m({ok, Sys}, reltool:get_config(Pid)), + Libs = reltool_test_lib:erl_libs(), + Sys1 = + case Libs of + [] -> Sys; + _ -> {sys, [{lib_dirs, Libs}|Cfg]} + end, + ?m({ok, Sys1}, reltool:get_config(Pid)), Simple = filename:join(PrivDir,"save_simple.reltool"), ?m(ok, reltool_server:save_config(Pid,Simple,false,false)), - ?m({ok,[Sys]}, file:consult(Simple)), + ?m({ok,[Sys1]}, file:consult(Simple)), Derivates = filename:join(PrivDir,"save_derivates.reltool"), ?m(ok, reltool_server:save_config(Pid,Derivates,false,true)), - ?msym({ok,[{sys,[{incl_cond, exclude}, - {erts,[]}, - {app,kernel,[{incl_cond,include},{mod,_,[]}|_]}, - {app,sasl,[{incl_cond,include},{mod,_,[]}|_]}, - {app,stdlib,[{incl_cond,include},{mod,_,[]}|_]}]}]}, - file:consult(Derivates)), + case Libs of + [] -> + ?msym({ok,[{sys,[{incl_cond, exclude}, + {erts,[]}, + {app,kernel,[{incl_cond,include},{mod,_,[]}|_]}, + {app,sasl,[{incl_cond,include},{mod,_,[]}|_]}, + {app,stdlib,[{incl_cond,include},{mod,_,[]}|_]}]}]}, + file:consult(Derivates)); + _ -> + ?msym({ok,[{sys,[{lib_dirs,Libs}, + {incl_cond, exclude}, + {erts,[]}, + {app,kernel,[{incl_cond,include},{mod,_,[]}|_]}, + {app,sasl,[{incl_cond,include},{mod,_,[]}|_]}, + {app,stdlib,[{incl_cond,include},{mod,_,[]}|_]}]}]}, + file:consult(Derivates)) + end, Defaults = filename:join(PrivDir,"save_defaults.reltool"), ?m(ok, reltool_server:save_config(Pid,Defaults,true,false)), @@ -2587,9 +2638,6 @@ windows_erl_libs(_Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Library functions -erl_libs() -> - reltool_utils:erl_libs(). - datadir(Config) -> %% Removes the trailing slash... filename:nativename(?config(data_dir,Config)). diff --git a/lib/reltool/test/reltool_test_lib.erl b/lib/reltool/test/reltool_test_lib.erl index be48ea4726..033d952d0a 100644 --- a/lib/reltool/test/reltool_test_lib.erl +++ b/lib/reltool/test/reltool_test_lib.erl @@ -237,7 +237,8 @@ wait_for_close() -> wait_for_close() end. - +erl_libs() -> + lists:sort([filename:absname(P) || P<-reltool_utils:erl_libs()]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% A small test server, which can be run standalone in a shell diff --git a/lib/reltool/test/reltool_wx_SUITE.erl b/lib/reltool/test/reltool_wx_SUITE.erl index f6f7721762..983c8f6c52 100644 --- a/lib/reltool/test/reltool_wx_SUITE.erl +++ b/lib/reltool/test/reltool_wx_SUITE.erl @@ -74,7 +74,12 @@ start_all_windows(_Config) -> %% Test that server pid can be fetched, and that server is alive {ok, Server} = ?msym({ok,_}, reltool:get_server(SysPid)), ?m(true, erlang:is_process_alive(Server)), - ?m({ok,{sys,[]}}, reltool:get_config(Server)), + Sys = + case reltool_test_lib:erl_libs() of + [] -> []; + Libs -> [{lib_dirs,Libs}] + end, + ?m({ok,{sys,Sys}}, reltool:get_config(Server)), %% Terminate check_no_win_crash(), diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl index f5210d4f27..7867d3da39 100644 --- a/lib/sasl/test/test_lib.hrl +++ b/lib/sasl/test/test_lib.hrl @@ -1,3 +1,3 @@ -define(ertsvsn,"4.4"). --define(kernelvsn,"5.3"). --define(stdlibvsn,"3.4"). +-define(kernelvsn,"6.0"). +-define(stdlibvsn,"3.5"). diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index be5abac7bc..bd963e8148 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -55,7 +55,7 @@ <datatype> <name name="sslsocket"/> <desc> - <p>An opaque reference to the TLS/DTLS connection.</p> + <p>An opaque reference to the TLS/DTLS connection, may be used for equality matching.</p> </desc> </datatype> @@ -87,14 +87,6 @@ </datatype> <datatype> - <name name="socket_connect_option"/> - </datatype> - - <datatype> - <name name="socket_listen_option"/> - </datatype> - - <datatype> <name name="active_msgs"/> <desc> <p>When an TLS/DTLS socket is in active mode (the default), data from the @@ -119,11 +111,7 @@ </p> </desc> </datatype> - - <datatype> - <name name="path"/> - </datatype> - + <datatype> <name name="host"/> </datatype> @@ -147,12 +135,14 @@ <datatype> <name name="dtls_version"/> </datatype> - - - <datatype> + + <datatype> <name name="legacy_version"/> </datatype> + <datatype> + <name name="prf_random"/> + </datatype> <datatype> <name name="verify_type"/> @@ -190,17 +180,24 @@ <name name="legacy_hash"/> </datatype> - + <datatype> + <name name="old_cipher_suite"/> + </datatype> + <datatype> <name name="signature_algs"/> </datatype> - + <datatype> <name name="sign_algo"/> </datatype> - + <datatype> - <name name="key_algo"/> + <name name="sign_scheme"/> + </datatype> + + <datatype> + <name name="kex_algo"/> </datatype> <datatype> @@ -232,6 +229,10 @@ </datatype> <datatype> + <name name="protocol_extensions"/> + </datatype> + + <datatype> <name name="error_alert"/> </datatype> @@ -334,7 +335,30 @@ and to restrict their usage when using a cipher suite supporting them.</p> </desc> </datatype> - + + <datatype> + <name name="signature_schemes"/> + <desc> + <p> + In addition to the signature_algorithms extension from TLS 1.2, + <url href="http://www.ietf.org/rfc/rfc8446.txt#section-4.2.3">TLS 1.3 + (RFC 5246 Section 4.2.3)</url>adds the signature_algorithms_cert extension + which enables having special requirements on the signatures used in the + certificates that differs from the requirements on digital signatures as a whole. + If this is not required this extension is not needed. + </p> + <p> + The client will send a signature_algorithms_cert extension (ClientHello), + if TLS version 1.3 or later is used, and the signature_algs_cert option is + explicitly specified. By default, only the signature_algs extension is sent. + </p> + <p> + The signature schemes shall be ordered according to the client's preference + (favorite choice first). + </p> + </desc> + </datatype> + <datatype> <name name="secure_renegotiation"/> <desc><p>Specifies if to reject renegotiation attempt that does @@ -366,8 +390,8 @@ <p>The verification fun is to be defined as follows:</p> <code> -fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revoked, -atom()}} | +fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | + {revoked, atom()}} | {extension, #'Extension'{}}, InitialUserState :: term()) -> {valid, UserState :: term()} | {valid_peer, UserState :: term()} | {fail, Reason :: term()} | {unknown, UserState :: term()}. @@ -580,7 +604,8 @@ fun(Chain::[public_key:der_encoded()]) -> fun(psk, PSKIdentity ::string(), UserState :: term()) -> {ok, SharedSecret :: binary()} | error; fun(srp, Username :: string(), UserState :: term()) -> - {ok, {SRPParams :: srp_param_type(), Salt :: binary(), DerivedKey :: binary()}} | error. + {ok, {SRPParams :: srp_param_type(), Salt :: binary(), + DerivedKey :: binary()}} | error. </code> <p>For Pre-Shared Key (PSK) cipher suites, the lookup fun is @@ -606,10 +631,19 @@ fun(srp, Username :: string(), UserState :: term()) -> </desc> </datatype> - <datatype> - <name name="log_alert"/> - <desc><p>If set to <c>false</c>, error reports are not displayed.</p> - </desc> + <datatype> + <name name="log_alert"/> + <desc><p>If set to <c>false</c>, error reports are not displayed. + Deprecated in OTP 22, use {log_level, <seealso marker="#type-logging_level">logging_level()</seealso>} instead.</p> + </desc> + </datatype> + + <datatype> + <name name="logging_level"/> + <desc><p>Specifies the log level for TLS/DTLS. At verbosity level <c>notice</c> and above error reports are + displayed in TLS. The level <c>debug</c> triggers verbose logging of TLS protocol + messages and logging of ignored alerts in DTLS.</p> + </desc> </datatype> <datatype> @@ -658,7 +692,11 @@ fun(srp, Username :: string(), UserState :: term()) -> </desc> </datatype> - + <datatype> + <name name="ssl_imp"/> + <desc><p>Deprecated since OTP-17, has no affect.</p></desc> + </datatype> + <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - CLIENT</datatype_title> <datatype> @@ -1076,7 +1114,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name since="OTP R14B">cipher_suites() -></name> - <name since="OTP R14B">cipher_suites(Type) -> old_ciphers()</name> + <name since="OTP R14B">cipher_suites(Type) -> [old_cipher_suite()]</name> <fsummary>Returns a list of supported cipher suites.</fsummary> <type> <v>Type = erlang | openssl | all</v> @@ -1137,10 +1175,10 @@ fun(srp, Username :: string(), UserState :: term()) -> equivalent, connected socket to an TLS socket.</fsummary> <type> <v>Socket = <seealso marker="#type-socket"> socket() </seealso></v> - <v>Options = <seealso marker="#type-client_option"> [client_option()] </seealso></v> + <v>Options = <seealso marker="#type-tls_client_option"> [tls_client_option()] </seealso></v> <v>Timeout = timeout()</v> <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Ext = hello_extensions()</v> + <v>Ext = <seealso marker="#type-protocol_extensions">protocol_extensions()</seealso></v> <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> <desc><p>Upgrades a <c>gen_tcp</c>, or equivalent, @@ -1181,7 +1219,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <type> <v>Host =<seealso marker="#type-host"> host() </seealso> </v> <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - <v>Options = <seealso marker="#type-client_option"> [client_option()]</seealso></v> + <v>Options = <seealso marker="#type-tls_client_option"> [tls_client_option()]</seealso></v> <v>Timeout = timeout()</v> <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> @@ -1390,8 +1428,8 @@ fun(srp, Username :: string(), UserState :: term()) -> <type> <v>Socket = socket() | <seealso marker="#type-sslsocket"> socket() </seealso> </v> <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v> - <v>Ext = hello_extensions()</v> - <v>Options = <seealso marker="#type-server_option"> [server_option()] </seealso> </v> + <v>Ext = <seealso marker="#type-protocol_extensions">protocol_extensions()</seealso></v> + <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso> </v> <v>Timeout = timeout()</v> <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> @@ -1461,7 +1499,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Creates an SSL listen socket.</fsummary> <type> <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - <v>Options = <seealso marker="#type-server_option"> [server_option()] </seealso></v> + <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso></v> <v>ListenSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> </type> <desc> @@ -1536,7 +1574,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Secret = binary() | master_secret</v> <v>Label = binary()</v> - <v>Seed = [binary() | prf_random()]</v> + <v>Seed = [binary() | <seealso marker="#type-prf_random"> prf_random()</seealso>]</v> <v>WantedLength = non_neg_integer()</v> </type> <desc> @@ -1666,7 +1704,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> <type> <v>Socket = socket() | <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v> - <v>Options = <seealso marker="#type-server_option"> [server_option()] </seealso> </v> + <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso> </v> <v>Timeout = timeout()</v> <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 5b264e2748..8dc76f2638 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -138,7 +138,7 @@ $(shell mkdir -p $(dir $(DEP_FILE)) >/dev/null) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -EXTRA_ERLC_FLAGS = +warn_unused_vars +no_bsm_opt +EXTRA_ERLC_FLAGS = +warn_unused_vars ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/src \ -pz $(EBIN) \ -pz $(ERL_TOP)/lib/public_key/ebin \ diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index d5460bae34..6b5a311efc 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2018. All Rights Reserved. +%% Copyright Ericsson AB 2013-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,8 +51,7 @@ -export([encode_alert/3, send_alert/2, send_alert_in_connection/2, close/5, protocol_name/0]). %% Data handling --export([encode_data/3, next_record/1, - send/3, socket/5, setopts/3, getopts/3]). +-export([next_record/1, socket/4, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -393,16 +392,13 @@ protocol_name() -> %% Data handling %%==================================================================== -encode_data(Data, Version, ConnectionStates0)-> - dtls_record:encode_data(Data, Version, ConnectionStates0). +send(Transport, {Listener, Socket}, Data) when is_pid(Listener) -> % Server socket + dtls_socket:send(Transport, Socket, Data); +send(Transport, Socket, Data) -> % Client socket + dtls_socket:send(Transport, Socket, Data). -send(Transport, {_, {{_,_}, _} = Socket}, Data) -> - send(Transport, Socket, Data); -send(Transport, Socket, Data) -> - dtls_socket:send(Transport, Socket, Data). - -socket(Pid, Transport, Socket, Connection, _) -> - dtls_socket:socket(Pid, Transport, Socket, Connection). +socket(Pid, Transport, Socket, _Tracker) -> + dtls_socket:socket(Pid, Transport, Socket, ?MODULE). setopts(Transport, Socket, Other) -> dtls_socket:setopts(Transport, Socket, Other). @@ -806,7 +802,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, session = #session{is_resumable = new}, connection_states = ConnectionStates, protocol_buffers = #protocol_buffers{}, - user_data_buffer = <<>>, + user_data_buffer = {[],0,[]}, start_or_recv_from = undefined, flight_buffer = new_flight(), protocol_specific = #{flight_state => initial_flight_state(DataTag)} @@ -1174,7 +1170,6 @@ log_ignore_alert(_, _, _, _) -> send_application_data(Data, From, _StateName, #state{static_env = #static_env{socket = Socket, - protocol_cb = Connection, transport_cb = Transport}, connection_env = #connection_env{negotiated_version = Version}, handshake_env = HsEnv, @@ -1187,9 +1182,9 @@ send_application_data(Data, From, _StateName, [{next_event, {call, From}, {application_data, Data}}]); false -> {Msgs, ConnectionStates} = - Connection:encode_data(Data, Version, ConnectionStates0), + dtls_record:encode_data(Data, Version, ConnectionStates0), State = State0#state{connection_states = ConnectionStates}, - case Connection:send(Transport, Socket, Msgs) of + case send(Transport, Socket, Msgs) of ok -> ssl_connection:hibernate_after(connection, State, [{reply, From, ok}]); Result -> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index dd33edfd77..2fe875da31 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2018. All Rights Reserved. +%% Copyright Ericsson AB 2013-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -546,15 +546,15 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, compression_algorithm = CompAlg}} = ReadState0, ConnnectionStates0) -> AAD = start_additional_data(Type, Version, Epoch, Seq), - CipherS1 = ssl_record:nonce_seed(BulkCipherAlgo, <<?UINT16(Epoch), ?UINT48(Seq)>>, CipherS0), + CipherS = ssl_record:nonce_seed(BulkCipherAlgo, <<?UINT16(Epoch), ?UINT48(Seq)>>, CipherS0), TLSVersion = dtls_v1:corresponding_tls_version(Version), - case ssl_record:decipher_aead(BulkCipherAlgo, CipherS1, AAD, CipherFragment, TLSVersion) of - {PlainFragment, CipherState} -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + case ssl_record:decipher_aead(BulkCipherAlgo, CipherS, AAD, CipherFragment, TLSVersion) of + PlainFragment when is_binary(PlainFragment) -> + {Plain, CompressionS} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), - ReadState0 = ReadState0#{compression_state => CompressionS1, - cipher_state => CipherState}, - ReadState = update_replay_window(Seq, ReadState0), + ReadState1 = ReadState0#{compression_state := CompressionS, + cipher_state := CipherS}, + ReadState = update_replay_window(Seq, ReadState1), ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; #alert{} = Alert -> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index d06f61f17d..3516bd6d49 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2018. All Rights Reserved. +%% Copyright Ericsson AB 1999-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -65,160 +65,169 @@ -export_type([socket/0, sslsocket/0, socket_option/0, - tls_client_option/0, - tls_option/0, - tls_server_option/0, active_msgs/0, - erl_cipher_suite/0, - protocol_version/0, - dtls_version/0, - tls_version/0, - prf_random/0, - hello_extensions/0, - error_alert/0, - session_id/0, - path/0, - hostname/0, host/0, - prf/0, - srp_param_type/0, - cipher_filters/0, - ssl_imp/0, - private_key_type/0, + tls_option/0, + tls_client_option/0, + tls_server_option/0, + erl_cipher_suite/0, + old_cipher_suite/0, + ciphers/0, cipher/0, hash/0, key/0, - key_algo/0, - sign_algo/0 - ]). + kex_algo/0, + prf_random/0, + cipher_filters/0, + sign_algo/0, + protocol_version/0, + protocol_extensions/0, + session_id/0, + error_alert/0, + srp_param_type/0]). + %% ------------------------------------------------------------------------------------------------------- -type socket() :: gen_tcp:socket(). --type socket_option() :: socket_connect_option() | socket_listen_option(). --type socket_connect_option() :: gen_tcp:connect_option() | gen_udp:option(). --type socket_listen_option() :: gen_tcp:listen_option() | gen_udp:option(). --opaque sslsocket() :: #sslsocket{}. --type tls_option() :: tls_client_option() | tls_server_option(). --type tls_client_option() :: client_option() | socket_connect_option() | transport_option(). --type tls_server_option() :: server_option() | socket_listen_option() | transport_option(). --type active_msgs() :: {ssl, sslsocket(), Data::binary() | list()} | {ssl_closed, sslsocket()} | - {ssl_error, sslsocket(), Reason::term()}. --type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), +-type socket_option() :: gen_tcp:connect_option() | gen_tcp:listen_option() | gen_udp:option(). +-type sslsocket() :: any(). +-type tls_option() :: tls_client_option() | tls_server_option(). +-type tls_client_option() :: client_option() | common_option() | socket_option() | transport_option(). +-type tls_server_option() :: server_option() | common_option() | socket_option() | transport_option(). +-type active_msgs() :: {ssl, sslsocket(), Data::binary() | list()} | {ssl_closed, sslsocket()} | + {ssl_error, sslsocket(), Reason::term()}. +-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag::atom()}}. --type path() :: file:filename(). --type host() :: hostname() | ip_address(). --type hostname() :: string(). --type ip_address() :: inet:ip_address(). --type session_id() :: binary(). --type protocol_version() :: tls_version() | dtls_version(). --type tls_version() :: tlsv1 | 'tlsv1.1' | 'tlsv1.2' | 'tlsv1.3' | legacy_version(). --type dtls_version() :: 'dtlsv1' | 'dtlsv1.2'. --type legacy_version() :: sslv3. --type verify_type() :: verify_none | verify_peer. --type cipher() :: aes_128_cbc | - aes_256_cbc | - aes_128_gcm | - aes_256_gcm | - chacha20_poly1305 | - legacy_cipher(). --type legacy_cipher() :: rc4_128 | - des_cbc | - '3des_ede_cbc'. - --type hash() :: sha | - sha2() | - legacy_hash(). - --type sha2() :: sha224 | - sha256 | - sha384 | - sha512. - --type legacy_hash() :: md5. - --type sign_algo() :: rsa | dsa | ecdsa. --type key_algo() :: rsa | - dhe_rsa | dhe_dss | - ecdhe_ecdsa | ecdh_ecdsa | ecdh_rsa | - srp_rsa| srp_dss | - psk | dhe_psk | rsa_psk | - dh_anon | ecdh_anon | srp_anon | - any. %% TLS 1.3 --type prf() :: hash() | default_prf. --type erl_cipher_suite() :: #{key_exchange := key_algo(), - cipher := cipher(), - mac := hash() | aead, - prf := hash() | default_prf %% Old cipher suites, version dependent - }. - --type named_curve() :: sect571r1 | - sect571k1 | - secp521r1 | - brainpoolP512r1 | - sect409k1 | - sect409r1 | - brainpoolP384r1 | - secp384r1 | - sect283k1 | - sect283r1 | - brainpoolP256r1 | - secp256k1 | - secp256r1 | - sect239k1 | - sect233k1 | - sect233r1 | - secp224k1 | - secp224r1 | - sect193r1 | - sect193r2 | - secp192k1 | - secp192r1 | - sect163k1 | - sect163r1 | - sect163r2 | - secp160k1 | - secp160r1 | - secp160r2. - --type srp_param_type() :: srp_1024 | - srp_1536 | - srp_2048 | - srp_3072 | - srp_4096 | - srp_6144 | - srp_8192. - --type error_alert() :: {tls_alert, {tls_alert(), Description::string()}}. - --type tls_alert() :: - close_notify | - unexpected_message | - bad_record_mac | - record_overflow | - handshake_failure | - bad_certificate | - unsupported_certificate | - certificate_revoked | - certificate_expired | - certificate_unknown | - illegal_parameter | - unknown_ca | - access_denied | - decode_error | - decrypt_error | - export_restriction| - protocol_version | - insufficient_security | - internal_error | - inappropriate_fallback | - user_canceled | - no_renegotiation | - unsupported_extension | - certificate_unobtainable | - unrecognized_name | - bad_certificate_status_response | - bad_certificate_hash_value | - unknown_psk_identity | - no_application_protocol. +-type host() :: hostname() | ip_address(). +-type hostname() :: string(). +-type ip_address() :: inet:ip_address(). +-type session_id() :: binary(). +-type protocol_version() :: tls_version() | dtls_version(). +-type tls_version() :: tlsv1 | 'tlsv1.1' | 'tlsv1.2' | 'tlsv1.3' | legacy_version(). +-type dtls_version() :: 'dtlsv1' | 'dtlsv1.2'. +-type legacy_version() :: sslv3. +-type verify_type() :: verify_none | verify_peer. +-type cipher() :: aes_128_cbc | + aes_256_cbc | + aes_128_gcm | + aes_256_gcm | + chacha20_poly1305 | + legacy_cipher(). +-type legacy_cipher() :: rc4_128 | + des_cbc | + '3des_ede_cbc'. + +-type hash() :: sha | + sha2() | + legacy_hash(). + +-type sha2() :: sha224 | + sha256 | + sha384 | + sha512. + +-type legacy_hash() :: md5. + +-type sign_algo() :: rsa | dsa | ecdsa. + +-type sign_scheme() :: rsa_pkcs1_sha256 + | rsa_pkcs1_sha384 + | rsa_pkcs1_sha512 + | ecdsa_secp256r1_sha256 + | ecdsa_secp384r1_sha384 + | ecdsa_secp521r1_sha512 + | rsa_pss_rsae_sha256 + | rsa_pss_rsae_sha384 + | rsa_pss_rsae_sha512 + | rsa_pss_pss_sha256 + | rsa_pss_pss_sha384 + | rsa_pss_pss_sha512 + | rsa_pkcs1_sha1 + | ecdsa_sha1. +-type kex_algo() :: rsa | + dhe_rsa | dhe_dss | + ecdhe_ecdsa | ecdh_ecdsa | ecdh_rsa | + srp_rsa| srp_dss | + psk | dhe_psk | rsa_psk | + dh_anon | ecdh_anon | srp_anon | + any. %% TLS 1.3 +-type erl_cipher_suite() :: #{key_exchange := kex_algo(), + cipher := cipher(), + mac := hash() | aead, + prf := hash() | default_prf %% Old cipher suites, version dependent + }. + +-type old_cipher_suite() :: {kex_algo(), cipher(), hash()} % Pre TLS 1.2 + %% TLS 1.2, internally PRE TLS 1.2 will use default_prf + | {kex_algo(), cipher(), hash() | aead, hash()}. + +-type named_curve() :: sect571r1 | + sect571k1 | + secp521r1 | + brainpoolP512r1 | + sect409k1 | + sect409r1 | + brainpoolP384r1 | + secp384r1 | + sect283k1 | + sect283r1 | + brainpoolP256r1 | + secp256k1 | + secp256r1 | + sect239k1 | + sect233k1 | + sect233r1 | + secp224k1 | + secp224r1 | + sect193r1 | + sect193r2 | + secp192k1 | + secp192r1 | + sect163k1 | + sect163r1 | + sect163r2 | + secp160k1 | + secp160r1 | + secp160r2. + +-type srp_param_type() :: srp_1024 | + srp_1536 | + srp_2048 | + srp_3072 | + srp_4096 | + srp_6144 | + srp_8192. + +-type error_alert() :: {tls_alert, {tls_alert(), Description::string()}}. + +-type tls_alert() :: close_notify | + unexpected_message | + bad_record_mac | + record_overflow | + handshake_failure | + bad_certificate | + unsupported_certificate | + certificate_revoked | + certificate_expired | + certificate_unknown | + illegal_parameter | + unknown_ca | + access_denied | + decode_error | + decrypt_error | + export_restriction| + protocol_version | + insufficient_security | + internal_error | + inappropriate_fallback | + user_canceled | + no_renegotiation | + unsupported_extension | + certificate_unobtainable | + unrecognized_name | + bad_certificate_status_response | + bad_certificate_hash_value | + unknown_psk_identity | + no_application_protocol. %% ------------------------------------------------------------------------------------------------------- -type common_option() :: {protocol, protocol()} | {handshake, handshake_completion()} | @@ -229,6 +238,7 @@ {password, key_password()} | {ciphers, cipher_suites()} | {eccs, eccs()} | + {signature_algs_cert, signature_schemes()} | {secure_renegotiate, secure_renegotiation()} | {depth, allowed_cert_chain_length()} | {verify_fun, custom_verify()} | @@ -238,32 +248,35 @@ {partial_chain, root_fun()} | {versions, protocol_versions()} | {user_lookup_fun, custom_user_lookup()} | + {log_level, logging_level()} | {log_alert, log_alert()} | {hibernate_after, hibernate_after()} | {padding_check, padding_check()} | - {beast_mitigation, beast_mitigation()}. - --type protocol() :: tls | dtls. --type handshake_completion() :: hello | full. --type cert() :: public_key:der_encoded(). --type cert_pem() :: ssl:path(). --type key() :: {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', + {beast_mitigation, beast_mitigation()} | + {ssl_imp, ssl_imp()}. + +-type protocol() :: tls | dtls. +-type handshake_completion() :: hello | full. +-type cert() :: public_key:der_encoded(). +-type cert_pem() :: file:filename(). +-type key() :: {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', public_key:der_encoded()} | #{algorithm := rsa | dss | ecdsa, engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}. --type key_pem() :: ssl:path(). --type key_password() :: string(). --type cipher_suites() :: ciphers(). --type ciphers() :: [erl_cipher_suite()] | - string(). % (according to old API) --type cipher_filters() :: list({key_exchange | cipher | mac | prf, - algo_filter()}). --type algo_filter() :: fun((key_algo()|cipher()|hash()|aead|default_prf) -> true | false). --type eccs() :: [named_curve()]. --type secure_renegotiation() :: boolean(). +-type key_pem() :: file:filename(). +-type key_password() :: string(). +-type cipher_suites() :: ciphers(). +-type ciphers() :: [erl_cipher_suite()] | + string(). % (according to old API) +-type cipher_filters() :: list({key_exchange | cipher | mac | prf, + algo_filter()}). +-type algo_filter() :: fun((kex_algo()|cipher()|hash()|aead|default_prf) -> true | false). +-type eccs() :: [named_curve()]. +-type secure_renegotiation() :: boolean(). -type allowed_cert_chain_length() :: integer(). + -type custom_verify() :: {Verifyfun :: fun(), InitialUserState :: term()}. -type crl_check() :: boolean() | peer | best_effort. -type crl_cache_opts() :: [term()]. @@ -272,12 +285,14 @@ -type root_fun() :: fun(). -type protocol_versions() :: [protocol_version()]. -type signature_algs() :: [{hash(), sign_algo()}]. +-type signature_schemes() :: [sign_scheme()]. -type custom_user_lookup() :: {Lookupfun :: fun(), UserState :: term()}. -type padding_check() :: boolean(). -type beast_mitigation() :: one_n_minus_one | zero_n | disabled. -type srp_identity() :: {Username :: string(), Password :: string()}. -type psk_identity() :: string(). -type log_alert() :: boolean(). +-type logging_level() :: logger:level(). %% ------------------------------------------------------------------------------------------------------- @@ -296,10 +311,10 @@ {fallback, fallback()}. -type client_verify_type() :: verify_type(). --type client_reuse_session() :: ssl:session_id(). +-type client_reuse_session() :: session_id(). -type client_reuse_sessions() :: boolean() | save. -type client_cacerts() :: [public_key:der_encoded()]. --type client_cafile() :: ssl:path(). +-type client_cafile() :: file:filename(). -type app_level_protocol() :: binary(). -type client_alpn() :: [app_level_protocol()]. -type client_preferred_next_protocols() :: {Precedence :: server | client, @@ -310,9 +325,10 @@ -type client_psk_identity() :: psk_identity(). -type client_srp_identity() :: srp_identity(). -type customize_hostname_check() :: list(). --type sni() :: HostName :: ssl:hostname() | disable. +-type sni() :: HostName :: hostname() | disable. -type client_signature_algs() :: signature_algs(). -type fallback() :: boolean(). +-type ssl_imp() :: new | old. %% ------------------------------------------------------------------------------------------------------- @@ -336,38 +352,38 @@ {signature_algs, server_signature_algs()}. -type server_cacerts() :: [public_key:der_encoded()]. --type server_cafile() :: ssl:path(). +-type server_cafile() :: file:filename(). -type server_alpn() :: [app_level_protocol()]. -type server_next_protocol() :: [app_level_protocol()]. -type server_psk_identity() :: psk_identity(). -type dh_der() :: binary(). --type dh_file() :: ssl:path(). +-type dh_file() :: file:filename(). -type server_verify_type() :: verify_type(). -type fail_if_no_peer_cert() :: boolean(). -type server_signature_algs() :: signature_algs(). -type server_reuse_session() :: fun(). -type server_reuse_sessions() :: boolean(). --type sni_hosts() :: [{ssl:hostname(), [server_option() | common_option()]}]. +-type sni_hosts() :: [{hostname(), [server_option() | common_option()]}]. -type sni_fun() :: fun(). -type honor_cipher_order() :: boolean(). -type honor_ecc_order() :: boolean(). -type client_renegotiation() :: boolean(). %% ------------------------------------------------------------------------------------------------------- - --type ssl_imp() :: new | old. - - -type prf_random() :: client_random | server_random. +-type protocol_extensions() :: #{renegotiation_info => binary(), + signature_algs => signature_algs(), + alpn => app_level_protocol(), + srp => binary(), + next_protocol => app_level_protocol(), + ec_point_formats => [0..2], + elliptic_curves => [public_key:oid()], + sni => hostname()}. +%% ------------------------------------------------------------------------------------------------------- --type private_key_type() :: rsa | %% Backwards compatibility - dsa | %% Backwards compatibility - 'RSAPrivateKey' | - 'DSAPrivateKey' | - 'ECPrivateKey' | - 'PrivateKeyInfo'. +%%%-------------------------------------------------------------------- +%%% API +%%%-------------------------------------------------------------------- --type hello_extensions() :: #{signature_algs => sign_algo()}. %% TODO -%% ------------------------------------------------------------------------------------------------------- %%-------------------------------------------------------------------- %% %% Description: Utility function that starts the ssl and applications @@ -636,7 +652,7 @@ 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 = [_, Pid]}, Data) when is_pid(Pid) -> - tls_sender:send_data(Pid, erlang:iolist_to_binary(Data)); + tls_sender:send_data(Pid, erlang:iolist_to_iovec(Data)); send(#sslsocket{pid = {_, #config{transport_info={_, udp, _, _}}}}, _) -> {error,enotconn}; %% Emulate connection behaviour send(#sslsocket{pid = {dtls,_}}, _) -> @@ -755,13 +771,13 @@ negotiated_protocol(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> ssl_connection:negotiated_protocol(Pid). %%-------------------------------------------------------------------- --spec cipher_suites() -> [ssl_cipher_format:old_erl_cipher_suite()] | [string()]. +-spec cipher_suites() -> [old_cipher_suite()] | [string()]. %%-------------------------------------------------------------------- cipher_suites() -> cipher_suites(erlang). %%-------------------------------------------------------------------- -spec cipher_suites(erlang | openssl | all) -> - [ssl_cipher_format:old_erl_cipher_suite() | string()]. + [old_cipher_suite() | string()]. %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- cipher_suites(erlang) -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 873572e231..6e751f9ceb 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,7 +1,7 @@ % %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2018. All Rights Reserved. +%% Copyright Ericsson AB 2007-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -42,7 +42,7 @@ rc4_suites/1, des_suites/1, rsa_suites/1, filter/3, filter_suites/1, filter_suites/2, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, - random_bytes/1, calc_mac_hash/4, + random_bytes/1, calc_mac_hash/4, calc_mac_hash/6, is_stream_ciphersuite/1, signature_scheme/1, scheme_to_components/1, hash_size/1, effective_key_bits/1, key_material/1]). @@ -112,7 +112,8 @@ cipher_init(?AES_GCM, IV, Key) -> cipher_init(?CHACHA20_POLY1305, IV, Key) -> #cipher_state{iv = IV, key = Key, tag_len = 16}; cipher_init(_BCA, IV, Key) -> - #cipher_state{iv = IV, key = Key}. + %% Initialize random IV cache, not used for aead ciphers + #cipher_state{iv = IV, key = Key, state = <<>>}. nonce_seed(Seed, CipherState) -> CipherState#cipher_state{nonce = Seed}. @@ -127,12 +128,11 @@ nonce_seed(Seed, CipherState) -> %% data is calculated and the data plus the HMAC is ecncrypted. %%------------------------------------------------------------------- cipher(?NULL, CipherState, <<>>, Fragment, _Version) -> - GenStreamCipherList = [Fragment, <<>>], - {GenStreamCipherList, CipherState}; + {iolist_to_binary(Fragment), CipherState}; cipher(?RC4, CipherState = #cipher_state{state = State0}, Mac, Fragment, _Version) -> GenStreamCipherList = [Fragment, Mac], {State1, T} = crypto:stream_encrypt(State0, GenStreamCipherList), - {T, CipherState#cipher_state{state = State1}}; + {iolist_to_binary(T), CipherState#cipher_state{state = State1}}; cipher(?DES, CipherState, Mac, Fragment, Version) -> block_cipher(fun(Key, IV, T) -> crypto:block_encrypt(des_cbc, Key, IV, T) @@ -161,8 +161,7 @@ aead_type(?CHACHA20_POLY1305) -> build_cipher_block(BlockSz, Mac, Fragment) -> TotSz = byte_size(Mac) + erlang:iolist_size(Fragment) + 1, - {PaddingLength, Padding} = get_padding(TotSz, BlockSz), - [Fragment, Mac, PaddingLength, Padding]. + [Fragment, Mac, padding_with_len(TotSz, BlockSz)]. block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, Mac, Fragment, {3, N}) @@ -172,14 +171,21 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, NextIV = next_iv(T, IV), {T, CS0#cipher_state{iv=NextIV}}; -block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, +block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV, state = IV_Cache0} = CS0, Mac, Fragment, {3, N}) when N == 2; N == 3; N == 4 -> - NextIV = random_iv(IV), + IV_Size = byte_size(IV), + <<NextIV:IV_Size/binary, IV_Cache/binary>> = + case IV_Cache0 of + <<>> -> + random_bytes(IV_Size bsl 5); % 32 IVs + _ -> + IV_Cache0 + end, L0 = build_cipher_block(BlockSz, Mac, Fragment), L = [NextIV|L0], T = Fun(Key, IV, L), - {T, CS0#cipher_state{iv=NextIV}}. + {T, CS0#cipher_state{iv=NextIV, state = IV_Cache}}. %%-------------------------------------------------------------------- -spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), @@ -654,12 +660,13 @@ random_bytes(N) -> calc_mac_hash(Type, Version, PlainFragment, #{sequence_number := SeqNo, mac_secret := MacSecret, - security_parameters:= - SecPars}) -> + security_parameters := + #security_parameters{mac_algorithm = MacAlgorithm}}) -> + calc_mac_hash(Type, Version, PlainFragment, MacAlgorithm, MacSecret, SeqNo). +%% +calc_mac_hash(Type, Version, PlainFragment, MacAlgorithm, MacSecret, SeqNo) -> Length = erlang:iolist_size(PlainFragment), - mac_hash(Version, SecPars#security_parameters.mac_algorithm, - MacSecret, SeqNo, Type, - Length, PlainFragment). + mac_hash(Version, MacAlgorithm, MacSecret, SeqNo, Type, Length, PlainFragment). is_stream_ciphersuite(#{cipher := rc4_128}) -> true; @@ -765,7 +772,6 @@ expanded_key_material(Cipher) when Cipher == aes_128_cbc; Cipher == chacha20_poly1305 -> unknown. - effective_key_bits(null) -> 0; effective_key_bits(des_cbc) -> @@ -785,18 +791,15 @@ iv_size(Cipher) when Cipher == null; Cipher == rc4_128; Cipher == chacha20_poly1305-> 0; - iv_size(Cipher) when Cipher == aes_128_gcm; Cipher == aes_256_gcm -> 4; - iv_size(Cipher) -> block_size(Cipher). block_size(Cipher) when Cipher == des_cbc; Cipher == '3des_ede_cbc' -> 8; - block_size(Cipher) when Cipher == aes_128_cbc; Cipher == aes_256_cbc; Cipher == aes_128_gcm; @@ -963,21 +966,51 @@ is_correct_padding(GenBlockCipher, {3, 1}, false) -> %% Padding must be checked in TLS 1.1 and after is_correct_padding(#generic_block_cipher{padding_length = Len, padding = Padding}, _, _) -> - Len == byte_size(Padding) andalso - binary:copy(?byte(Len), Len) == Padding. - -get_padding(Length, BlockSize) -> - get_padding_aux(BlockSize, Length rem BlockSize). - -get_padding_aux(_, 0) -> - {0, <<>>}; -get_padding_aux(BlockSize, PadLength) -> - N = BlockSize - PadLength, - {N, binary:copy(?byte(N), N)}. + (Len == byte_size(Padding)) andalso (padding(Len) == Padding). + +padding(PadLen) -> + case PadLen of + 0 -> <<>>; + 1 -> <<1>>; + 2 -> <<2,2>>; + 3 -> <<3,3,3>>; + 4 -> <<4,4,4,4>>; + 5 -> <<5,5,5,5,5>>; + 6 -> <<6,6,6,6,6,6>>; + 7 -> <<7,7,7,7,7,7,7>>; + 8 -> <<8,8,8,8,8,8,8,8>>; + 9 -> <<9,9,9,9,9,9,9,9,9>>; + 10 -> <<10,10,10,10,10,10,10,10,10,10>>; + 11 -> <<11,11,11,11,11,11,11,11,11,11,11>>; + 12 -> <<12,12,12,12,12,12,12,12,12,12,12,12>>; + 13 -> <<13,13,13,13,13,13,13,13,13,13,13,13,13>>; + 14 -> <<14,14,14,14,14,14,14,14,14,14,14,14,14,14>>; + 15 -> <<15,15,15,15,15,15,15,15,15,15,15,15,15,15,15>>; + _ -> + binary:copy(<<PadLen>>, PadLen) + end. -random_iv(IV) -> - IVSz = byte_size(IV), - random_bytes(IVSz). +padding_with_len(TextLen, BlockSize) -> + case BlockSize - (TextLen rem BlockSize) of + 0 -> <<0>>; + 1 -> <<1,1>>; + 2 -> <<2,2,2>>; + 3 -> <<3,3,3,3>>; + 4 -> <<4,4,4,4,4>>; + 5 -> <<5,5,5,5,5,5>>; + 6 -> <<6,6,6,6,6,6,6>>; + 7 -> <<7,7,7,7,7,7,7,7>>; + 8 -> <<8,8,8,8,8,8,8,8,8>>; + 9 -> <<9,9,9,9,9,9,9,9,9,9>>; + 10 -> <<10,10,10,10,10,10,10,10,10,10,10>>; + 11 -> <<11,11,11,11,11,11,11,11,11,11,11,11>>; + 12 -> <<12,12,12,12,12,12,12,12,12,12,12,12,12>>; + 13 -> <<13,13,13,13,13,13,13,13,13,13,13,13,13,13>>; + 14 -> <<14,14,14,14,14,14,14,14,14,14,14,14,14,14,14>>; + 15 -> <<15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15>>; + PadLen -> + binary:copy(<<PadLen>>, PadLen + 1) + end. next_iv(Bin, IV) -> BinSz = byte_size(Bin), diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl index f75daaad22..b592295d56 100644 --- a/lib/ssl/src/ssl_cipher_format.erl +++ b/lib/ssl/src/ssl_cipher_format.erl @@ -34,15 +34,15 @@ -type internal_cipher() :: null | ssl:cipher(). -type internal_hash() :: null | ssl:hash(). --type internal_key_algo() :: null | ssl:key_algo(). --type internal_erl_cipher_suite() :: #{key_exchange := internal_key_algo(), +-type internal_kex_algo() :: null | ssl:kex_algo(). +-type internal_erl_cipher_suite() :: #{key_exchange := internal_kex_algo(), cipher := internal_cipher(), mac := internal_hash() | aead, prf := internal_hash() | default_prf %% Old cipher suites, version dependent }. --type old_erl_cipher_suite() :: {ssl:key_algo(), internal_cipher(), internal_hash()} % Pre TLS 1.2 +-type old_erl_cipher_suite() :: {ssl:kex_algo(), internal_cipher(), internal_hash()} % Pre TLS 1.2 %% TLS 1.2, internally PRE TLS 1.2 will use default_prf - | {ssl:key_algo(), internal_cipher(), internal_hash(), + | {ssl:kex_algo(), internal_cipher(), internal_hash(), internal_hash() | default_prf}. -type cipher_suite() :: binary(). -type openssl_cipher_suite() :: string(). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 08d2fae925..f194610d72 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2018. All Rights Reserved. +%% Copyright Ericsson AB 2013-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -71,7 +71,7 @@ -export([terminate/3, format_status/2]). %% Erlang Distribution export --export([get_sslsocket/1, dist_handshake_complete/2]). +-export([dist_handshake_complete/2]). %%==================================================================== %% Setup @@ -183,19 +183,19 @@ socket_control(Connection, Socket, Pid, Transport) -> %%-------------------------------------------------------------------- socket_control(Connection, Socket, Pids, Transport, udp_listener) -> %% dtls listener process must have the socket control - {ok, Connection:socket(Pids, Transport, Socket, Connection, undefined)}; + {ok, Connection:socket(Pids, Transport, Socket, undefined)}; socket_control(tls_connection = Connection, Socket, [Pid|_] = Pids, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, Connection:socket(Pids, Transport, Socket, Connection, ListenTracker)}; + {ok, Connection:socket(Pids, Transport, Socket, ListenTracker)}; {error, Reason} -> {error, Reason} end; socket_control(dtls_connection = Connection, {_, Socket}, [Pid|_] = Pids, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, Connection:socket(Pids, Transport, Socket, Connection, ListenTracker)}; + {ok, Connection:socket(Pids, Transport, Socket, ListenTracker)}; {error, Reason} -> {error, Reason} end. @@ -212,9 +212,9 @@ socket_control(dtls_connection = Connection, {_, Socket}, [Pid|_] = Pids, Transp %%-------------------------------------------------------------------- send(Pid, Data) -> call(Pid, {application_data, - %% iolist_to_binary should really - %% be called iodata_to_binary() - erlang:iolist_to_binary(Data)}). + %% iolist_to_iovec should really + %% be called iodata_to_iovec() + erlang:iolist_to_iovec(Data)}). %%-------------------------------------------------------------------- -spec recv(pid(), integer(), timeout()) -> @@ -312,9 +312,6 @@ renegotiation(ConnectionPid) -> internal_renegotiation(ConnectionPid, #{current_write := WriteState}) -> gen_statem:cast(ConnectionPid, {internal_renegotiate, WriteState}). -get_sslsocket(ConnectionPid) -> - call(ConnectionPid, get_sslsocket). - dist_handshake_complete(ConnectionPid, DHandle) -> gen_statem:cast(ConnectionPid, {dist_handshake_complete, DHandle}). @@ -446,11 +443,10 @@ handle_alert(#alert{level = ?WARNING} = Alert, StateName, %%==================================================================== %% Data handling %%==================================================================== -passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName, Connection, StartTimerAction) -> - case Buffer of - <<>> -> - {Record, State} = Connection:next_record(State0), - Connection:next_event(StateName, Record, State, StartTimerAction); +passive_receive(State0 = #state{user_data_buffer = {_,BufferSize,_}}, StateName, Connection, StartTimerAction) -> + case BufferSize of + 0 -> + Connection:next_event(StateName, no_record, State0, StartTimerAction); _ -> case read_application_data(<<>>, State0) of {stop, _, _} = ShutdownError -> @@ -470,101 +466,227 @@ passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName, Connectio read_application_data( Data, #state{ - user_data_buffer = Buffer0, + user_data_buffer = {Front0,BufferSize0,Rear0}, connection_env = #connection_env{erl_dist_handle = DHandle}} = State) -> %% - Buffer = bincat(Buffer0, Data), + Front = Front0, + BufferSize = BufferSize0 + byte_size(Data), + Rear = [Data|Rear0], case DHandle of undefined -> - #state{ - socket_options = SocketOpts, - bytes_to_read = BytesToRead, - start_or_recv_from = RecvFrom} = State, - read_application_data( - Buffer, State, SocketOpts, RecvFrom, BytesToRead); + read_application_data(State, Front, BufferSize, Rear); _ -> - try read_application_dist_data(Buffer, State, DHandle) + try read_application_dist_data(DHandle, Front, BufferSize, Rear) of + Buffer -> + {no_record, State#state{user_data_buffer = Buffer}} catch error:_ -> {stop,disconnect, - State#state{ - user_data_buffer = Buffer, - bytes_to_read = undefined}} + State#state{user_data_buffer = {Front,BufferSize,Rear}}} end end. -read_application_dist_data(Buffer, State, DHandle) -> - case Buffer of - <<Size:32,Data:Size/binary>> -> - erlang:dist_ctrl_put_data(DHandle, Data), + +read_application_data(#state{ + socket_options = SocketOpts, + bytes_to_read = BytesToRead, + start_or_recv_from = RecvFrom} = State, Front, BufferSize, Rear) -> + read_application_data(State, Front, BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead). + +%% Pick binary from queue front, if empty wait for more data +read_application_data(State, [Bin|Front], BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead) -> + read_application_data_bin(State, Front, BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead, Bin); +read_application_data(State, [] = Front, BufferSize, [] = Rear, SocketOpts, RecvFrom, BytesToRead) -> + 0 = BufferSize, % Assert + {no_record, State#state{socket_options = SocketOpts, + bytes_to_read = BytesToRead, + start_or_recv_from = RecvFrom, + user_data_buffer = {Front,BufferSize,Rear}}}; +read_application_data(State, [], BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead) -> + [Bin|Front] = lists:reverse(Rear), + read_application_data_bin(State, Front, BufferSize, [], SocketOpts, RecvFrom, BytesToRead, Bin). + +read_application_data_bin(State, Front, BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead, <<>>) -> + %% Done with this binary - get next + read_application_data(State, Front, BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead); +read_application_data_bin(State, Front0, BufferSize0, Rear0, SocketOpts0, RecvFrom, BytesToRead, Bin0) -> + %% Decode one packet from a binary + case get_data(SocketOpts0, BytesToRead, Bin0) of + {ok, Data, Bin} -> % Send data + BufferSize = BufferSize0 - (byte_size(Bin0) - byte_size(Bin)), + read_application_data_deliver( + State, [Bin|Front0], BufferSize, Rear0, SocketOpts0, RecvFrom, Data); + {more, undefined} -> + %% We need more data, do not know how much + if + byte_size(Bin0) < BufferSize0 -> + %% We have more data in the buffer besides the first binary - concatenate all and retry + Bin = iolist_to_binary([Bin0,Front0|lists:reverse(Rear0)]), + read_application_data_bin( + State, [], BufferSize0, [], SocketOpts0, RecvFrom, BytesToRead, Bin); + true -> + %% All data is in the first binary, no use to retry - wait for more + {no_record, State#state{socket_options = SocketOpts0, + bytes_to_read = BytesToRead, + start_or_recv_from = RecvFrom, + user_data_buffer = {[Bin0|Front0],BufferSize0,Rear0}}} + end; + {more, Size} when Size =< BufferSize0 -> + %% We have a packet in the buffer - collect it in a binary and decode + {Data,Front,Rear} = iovec_from_front(Size - byte_size(Bin0), Front0, Rear0, [Bin0]), + Bin = iolist_to_binary(Data), + read_application_data_bin( + State, Front, BufferSize0, Rear, SocketOpts0, RecvFrom, BytesToRead, Bin); + {more, _Size} -> + %% We do not have a packet in the buffer - wait for more + {no_record, State#state{socket_options = SocketOpts0, + bytes_to_read = BytesToRead, + start_or_recv_from = RecvFrom, + user_data_buffer = {[Bin0|Front0],BufferSize0,Rear0}}}; + passive -> + {no_record, State#state{socket_options = SocketOpts0, + bytes_to_read = BytesToRead, + start_or_recv_from = RecvFrom, + user_data_buffer = {[Bin0|Front0],BufferSize0,Rear0}}}; + {error,_Reason} -> + %% Invalid packet in packet mode + #state{ + static_env = + #static_env{ + socket = Socket, + protocol_cb = Connection, + transport_cb = Transport, + tracker = Tracker}, + connection_env = + #connection_env{user_application = {_Mon, Pid}}} = State, + Buffer = iolist_to_binary([Bin0,Front0|lists:reverse(Rear0)]), + deliver_packet_error( + Connection:pids(State), Transport, Socket, SocketOpts0, + Buffer, Pid, RecvFrom, Tracker, Connection), + {stop, {shutdown, normal}, State#state{socket_options = SocketOpts0, + bytes_to_read = BytesToRead, + start_or_recv_from = RecvFrom, + user_data_buffer = {[Buffer],BufferSize0,[]}}} + end. + +read_application_data_deliver(State, Front, BufferSize, Rear, SocketOpts0, RecvFrom, Data) -> + #state{ + static_env = + #static_env{ + socket = Socket, + protocol_cb = Connection, + transport_cb = Transport, + tracker = Tracker}, + connection_env = + #connection_env{user_application = {_Mon, Pid}}} = State, + SocketOpts = + deliver_app_data( + Connection:pids(State), Transport, Socket, SocketOpts0, Data, Pid, RecvFrom, Tracker, Connection), + if + SocketOpts#socket_options.active =:= false -> + %% Passive mode, wait for active once or recv {no_record, State#state{ - user_data_buffer = <<>>, - bytes_to_read = undefined}}; - <<Size:32,Data:Size/binary,Rest/binary>> -> + user_data_buffer = {Front,BufferSize,Rear}, + start_or_recv_from = undefined, + bytes_to_read = undefined, + socket_options = SocketOpts + }}; + true -> %% Try to deliver more data + read_application_data(State, Front, BufferSize, Rear, SocketOpts, undefined, undefined) + end. + + +read_application_dist_data(DHandle, [Bin|Front], BufferSize, Rear) -> + read_application_dist_data(DHandle, Front, BufferSize, Rear, Bin); +read_application_dist_data(_DHandle, [] = Front, BufferSize, [] = Rear) -> + BufferSize = 0, + {Front,BufferSize,Rear}; +read_application_dist_data(DHandle, [], BufferSize, Rear) -> + [Bin|Front] = lists:reverse(Rear), + read_application_dist_data(DHandle, Front, BufferSize, [], Bin). +%% +read_application_dist_data(DHandle, Front0, BufferSize, Rear0, Bin0) -> + case Bin0 of + %% + %% START Optimization + %% It is cheaper to match out several packets in one match operation than to loop for each + <<SizeA:32, DataA:SizeA/binary, + SizeB:32, DataB:SizeB/binary, + SizeC:32, DataC:SizeC/binary, + SizeD:32, DataD:SizeD/binary, Rest/binary>> -> + %% We have 4 complete packets in the first binary + erlang:dist_ctrl_put_data(DHandle, DataA), + erlang:dist_ctrl_put_data(DHandle, DataB), + erlang:dist_ctrl_put_data(DHandle, DataC), + erlang:dist_ctrl_put_data(DHandle, DataD), + read_application_dist_data( + DHandle, Front0, BufferSize - (4*4+SizeA+SizeB+SizeC+SizeD), Rear0, Rest); + <<SizeA:32, DataA:SizeA/binary, + SizeB:32, DataB:SizeB/binary, + SizeC:32, DataC:SizeC/binary, Rest/binary>> -> + %% We have 3 complete packets in the first binary + erlang:dist_ctrl_put_data(DHandle, DataA), + erlang:dist_ctrl_put_data(DHandle, DataB), + erlang:dist_ctrl_put_data(DHandle, DataC), + read_application_dist_data( + DHandle, Front0, BufferSize - (3*4+SizeA+SizeB+SizeC), Rear0, Rest); + <<SizeA:32, DataA:SizeA/binary, + SizeB:32, DataB:SizeB/binary, Rest/binary>> -> + %% We have 2 complete packets in the first binary + erlang:dist_ctrl_put_data(DHandle, DataA), + erlang:dist_ctrl_put_data(DHandle, DataB), + read_application_dist_data( + DHandle, Front0, BufferSize - (2*4+SizeA+SizeB), Rear0, Rest); + %% END Optimization + %% + %% Basic one packet code path + <<Size:32, Data:Size/binary, Rest/binary>> -> + %% We have a complete packet in the first binary erlang:dist_ctrl_put_data(DHandle, Data), - read_application_dist_data(Rest, State, DHandle); - _ -> - {no_record, - State#state{ - user_data_buffer = Buffer, - bytes_to_read = undefined}} + read_application_dist_data(DHandle, Front0, BufferSize - (4+Size), Rear0, Rest); + <<Size:32, FirstData/binary>> when 4+Size =< BufferSize -> + %% We have a complete packet in the buffer + %% - fetch the missing content from the buffer front + {Data,Front,Rear} = iovec_from_front(Size - byte_size(FirstData), Front0, Rear0, [FirstData]), + erlang:dist_ctrl_put_data(DHandle, Data), + read_application_dist_data(DHandle, Front, BufferSize - (4+Size), Rear); + <<Bin/binary>> -> + %% In OTP-21 the match context reuse optimization fails if we use Bin0 in recursion, so here we + %% match out the whole binary which will trick the optimization into keeping the match context + %% for the first binary contains complete packet code above + case Bin of + <<_Size:32, _InsufficientData/binary>> -> + %% We have a length field in the first binary but there is not enough data + %% in the buffer to form a complete packet - await more data + {[Bin|Front0],BufferSize,Rear0}; + <<IncompleteLengthField/binary>> when 4 < BufferSize -> + %% We do not have a length field in the first binary but the buffer + %% contains enough data to maybe form a packet + %% - fetch a tiny binary from the buffer front to complete the length field + {LengthField,Front,Rear} = + iovec_from_front(4 - byte_size(IncompleteLengthField), Front0, Rear0, [IncompleteLengthField]), + LengthBin = iolist_to_binary(LengthField), + read_application_dist_data(DHandle, Front, BufferSize, Rear, LengthBin); + <<IncompleteLengthField/binary>> -> + %% We do not have enough data in the buffer to even form a length field - await more data + {[IncompleteLengthField|Front0],BufferSize,Rear0} + end end. -read_application_data( - Buffer0, State, SocketOpts0, RecvFrom, BytesToRead) -> - %% - case get_data(SocketOpts0, BytesToRead, Buffer0) of - {ok, ClientData, Buffer} -> % Send data - #state{static_env = - #static_env{ - socket = Socket, - protocol_cb = Connection, - transport_cb = Transport, - tracker = Tracker}, - connection_env = - #connection_env{user_application = {_Mon, Pid}}} - = State, - SocketOpts = - deliver_app_data( - Connection:pids(State), - Transport, Socket, SocketOpts0, - ClientData, Pid, RecvFrom, Tracker, Connection), - if - SocketOpts#socket_options.active =:= false -> - %% Passive mode, wait for active once or recv - %% Active and empty, get more data - {no_record, - State#state{ - user_data_buffer = Buffer, - start_or_recv_from = undefined, - bytes_to_read = undefined, - socket_options = SocketOpts - }}; - true -> %% We have more data - read_application_data( - Buffer, State, SocketOpts, - undefined, undefined) - end; - {more, Buffer} -> % no reply, we need more data - {no_record, State#state{user_data_buffer = Buffer}}; - {passive, Buffer} -> - {no_record, State#state{user_data_buffer = Buffer}}; - {error,_Reason} -> %% Invalid packet in packet mode - #state{static_env = - #static_env{ - socket = Socket, - protocol_cb = Connection, - transport_cb = Transport, - tracker = Tracker}, - connection_env = - #connection_env{user_application = {_Mon, Pid}}} - = State, - deliver_packet_error( - Connection:pids(State), Transport, Socket, SocketOpts0, - Buffer0, Pid, RecvFrom, Tracker, Connection), - {stop, {shutdown, normal}, State} +iovec_from_front(Size, [], Rear, Acc) -> + iovec_from_front(Size, lists:reverse(Rear), [], Acc); +iovec_from_front(Size, [Bin|Front], Rear, Acc) -> + case Bin of + <<Last:Size/binary>> -> % Just enough + {lists:reverse(Acc, [Last]),Front,Rear}; + <<Last:Size/binary, Rest/binary>> -> % More than enough, split here + {lists:reverse(Acc, [Last]),[Rest|Front],Rear}; + <<_/binary>> -> % Not enough + BinSize = byte_size(Bin), + iovec_from_front(Size - BinSize, Front, Rear, [Bin|Acc]) end. + %%==================================================================== %% Help functions for tls|dtls_connection.erl %%==================================================================== @@ -1070,10 +1192,8 @@ cipher(internal, #finished{verify_data = Data} = Finished, cipher(internal, #next_protocol{selected_protocol = SelectedProtocol}, #state{static_env = #static_env{role = server}, handshake_env = #handshake_env{expecting_finished = true, - expecting_next_protocol_negotiation = true} = HsEnv} = State0, Connection) -> - {Record, State} = - Connection:next_record(State0), - Connection:next_event(?FUNCTION_NAME, Record, + expecting_next_protocol_negotiation = true} = HsEnv} = State, Connection) -> + Connection:next_event(?FUNCTION_NAME, no_record, State#state{handshake_env = HsEnv#handshake_env{negotiated_protocol = SelectedProtocol, expecting_next_protocol_negotiation = false}}); cipher(internal, #change_cipher_spec{type = <<1>>}, #state{handshake_env = HsEnv, connection_states = ConnectionStates0} = @@ -1195,10 +1315,10 @@ handle_common_event({timeout, handshake}, close, _StateName, #state{start_or_rec handle_common_event({timeout, recv}, timeout, StateName, #state{start_or_recv_from = RecvFrom} = State, _) -> {next_state, StateName, State#state{start_or_recv_from = undefined, bytes_to_read = undefined}, [{reply, RecvFrom, {error, timeout}}]}; -handle_common_event(_Type, Msg, StateName, #state{connection_env = +handle_common_event(Type, Msg, StateName, #state{connection_env = #connection_env{negotiated_version = Version}} = State, _) -> - Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, {unexpected_msg, Msg}), + Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, {unexpected_msg, {Type,Msg}}), handle_own_alert(Alert, Version, StateName, State). handle_call({application_data, _Data}, _, _, _, _) -> @@ -1273,10 +1393,6 @@ handle_call({set_opts, Opts0}, From, StateName, handle_call(renegotiate, From, StateName, _, _) when StateName =/= connection -> {keep_state_and_data, [{reply, From, {error, already_renegotiating}}]}; -handle_call(get_sslsocket, From, _StateName, State, Connection) -> - SslSocket = Connection:socket(State), - {keep_state_and_data, [{reply, From, SslSocket}]}; - handle_call({prf, Secret, Label, Seed, WantedLength}, From, _, #state{connection_states = ConnectionStates, connection_env = #connection_env{negotiated_version = Version}}, _) -> @@ -2585,7 +2701,7 @@ handle_active_option(false, connection = StateName, To, Reply, State) -> hibernate_after(StateName, State, [{reply, To, Reply}]); handle_active_option(_, connection = StateName0, To, Reply, #state{static_env = #static_env{protocol_cb = Connection}, - user_data_buffer = <<>>} = State0) -> + user_data_buffer = {_,0,_}} = State0) -> case Connection:next_event(StateName0, no_record, State0) of {next_state, StateName, State} -> hibernate_after(StateName, State, [{reply, To, Reply}]); @@ -2594,11 +2710,11 @@ handle_active_option(_, connection = StateName0, To, Reply, #state{static_env = {stop, _, _} = Stop -> Stop end; -handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = <<>>} = State) -> +handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = {_,0,_}} = State) -> %% Active once already set {next_state, StateName, State, [{reply, To, Reply}]}; -%% user_data_buffer =/= <<>> +%% user_data_buffer nonempty handle_active_option(_, StateName0, To, Reply, #state{static_env = #static_env{protocol_cb = Connection}} = State0) -> case read_application_data(<<>>, State0) of @@ -2618,33 +2734,25 @@ handle_active_option(_, StateName0, To, Reply, %% Picks ClientData -get_data(_, _, <<>>) -> - {more, <<>>}; -%% Recv timed out save buffer data until next recv -get_data(#socket_options{active=false}, undefined, Buffer) -> - {passive, Buffer}; -get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Buffer) +get_data(#socket_options{active=false}, undefined, _Bin) -> + %% Recv timed out save buffer data until next recv + passive; +get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Bin) when Raw =:= raw; Raw =:= 0 -> %% Raw Mode - if - Active =/= false orelse BytesToRead =:= 0 -> + case Bin of + <<_/binary>> when Active =/= false orelse BytesToRead =:= 0 -> %% Active true or once, or passive mode recv(0) - {ok, Buffer, <<>>}; - byte_size(Buffer) >= BytesToRead -> + {ok, Bin, <<>>}; + <<Data:BytesToRead/binary, Rest/binary>> -> %% Passive Mode, recv(Bytes) - <<Data:BytesToRead/binary, Rest/binary>> = Buffer, - {ok, Data, Rest}; - true -> + {ok, Data, Rest}; + <<_/binary>> -> %% Passive Mode not enough data - {more, Buffer} + {more, BytesToRead} end; -get_data(#socket_options{packet=Type, packet_size=Size}, _, Buffer) -> +get_data(#socket_options{packet=Type, packet_size=Size}, _, Bin) -> PacketOpts = [{packet_size, Size}], - case decode_packet(Type, Buffer, PacketOpts) of - {more, _} -> - {more, Buffer}; - Decoded -> - Decoded - end. + decode_packet(Type, Bin, PacketOpts). decode_packet({http, headers}, Buffer, PacketOpts) -> decode_packet(httph, Buffer, PacketOpts); @@ -2696,7 +2804,7 @@ format_reply(_, _, _,#socket_options{active = false, mode = Mode, packet = Packe {ok, do_format_reply(Mode, Packet, Header, Data)}; format_reply(CPids, Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, header = Header}, Data, Tracker, Connection) -> - {ssl, Connection:socket(CPids, Transport, Socket, Connection, Tracker), + {ssl, Connection:socket(CPids, Transport, Socket, Tracker), do_format_reply(Mode, Packet, Header, Data)}. deliver_packet_error(CPids, Transport, Socket, @@ -2708,7 +2816,7 @@ format_packet_error(_, _, _,#socket_options{active = false, mode = Mode}, Data, {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; format_packet_error(CPids, Transport, Socket, #socket_options{active = _, mode = Mode}, Data, Tracker, Connection) -> - {ssl_error, Connection:socket(CPids, Transport, Socket, Connection, Tracker), + {ssl_error, Connection:socket(CPids, Transport, Socket, Tracker), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode @@ -2764,12 +2872,10 @@ alert_user(Pids, Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Con case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, - {ssl_closed, Connection:socket(Pids, - Transport, Socket, Connection, Tracker)}); + {ssl_closed, Connection:socket(Pids, Transport, Socket, Tracker)}); ReasonCode -> send_or_reply(Active, Pid, From, - {ssl_error, Connection:socket(Pids, - Transport, Socket, Connection, Tracker), ReasonCode}) + {ssl_error, Connection:socket(Pids, Transport, Socket, Tracker), ReasonCode}) end. log_alert(Level, Role, ProtocolName, StateName, #alert{role = Role} = Alert) -> @@ -2841,11 +2947,3 @@ new_emulated([], EmOpts) -> EmOpts; new_emulated(NewEmOpts, _) -> NewEmOpts. - --compile({inline, [bincat/2]}). -bincat(<<>>, B) -> - B; -bincat(A, <<>>) -> - A; -bincat(A, B) -> - <<A/binary, B/binary>>. diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index f2864e5f33..201164949a 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2018. All Rights Reserved. +%% Copyright Ericsson AB 2013-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -69,7 +69,7 @@ hashsign_algorithm = {undefined, undefined}, cert_hashsign_algorithm = {undefined, undefined}, %% key exchange - kex_algorithm :: ssl:key_algo(), + kex_algorithm :: ssl:kex_algo(), kex_keys :: {PublicKey :: binary(), PrivateKey :: binary()} | #'ECPrivateKey'{} | undefined | secret_printout(), diffie_hellman_params:: #'DHParameter'{} | undefined | secret_printout(), srp_params :: #srp_user{} | secret_printout() | 'undefined', @@ -83,7 +83,7 @@ downgrade, terminated = false ::boolean() | closed, negotiated_version :: ssl_record:ssl_version() | 'undefined', - erl_dist_handle = undefined :: erlang:dist_handle() | undefined, + erl_dist_handle = undefined :: erlang:dist_handle() | 'undefined', private_key :: public_key:private_key() | secret_printout() | 'undefined' }). @@ -110,7 +110,7 @@ %% Data shuffling %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% connection_states :: ssl_record:connection_states() | secret_printout(), protocol_buffers :: term() | secret_printout() , %% #protocol_buffers{} from tls_record.hrl or dtls_recor.hr - user_data_buffer :: undefined | binary() | secret_printout(), + user_data_buffer :: undefined | {[binary()],non_neg_integer(),[binary()]} | secret_printout(), bytes_to_read :: undefined | integer(), %% bytes to read in passive mode %% recv and start handling start_or_recv_from :: term(), diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 16b5b34a3e..6b1e3b6e07 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -833,7 +833,7 @@ decode_extensions(Extensions, Version, MessageType) -> decode_extensions(Extensions, Version, MessageType, empty_extensions()). %%-------------------------------------------------------------------- --spec decode_server_key(binary(), ssl:key_algo(), ssl_record:ssl_version()) -> +-spec decode_server_key(binary(), ssl:kex_algo(), ssl_record:ssl_version()) -> #server_key_params{}. %% %% Description: Decode server_key data and return appropriate type @@ -842,7 +842,7 @@ decode_server_key(ServerKey, Type, Version) -> dec_server_key(ServerKey, key_exchange_alg(Type), Version). %%-------------------------------------------------------------------- --spec decode_client_key(binary(), ssl:key_algo(), ssl_record:ssl_version()) -> +-spec decode_client_key(binary(), ssl:kex_algo(), ssl_record:ssl_version()) -> #encrypted_premaster_secret{} | #client_diffie_hellman_public{} | #client_ec_diffie_hellman_public{} diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index c4dd2dad60..d59a0dfda2 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2018. All Rights Reserved. +%% Copyright Ericsson AB 1999-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -46,13 +46,19 @@ format(#{level:= _Level, msg:= {report, Msg}, meta:= _Meta}, _Config0) -> #{direction := Direction, protocol := Protocol, - message := BinMsg0} = Msg, + message := Content} = Msg, case Protocol of 'tls_record' -> - BinMsg = lists:flatten(BinMsg0), + BinMsg = + case Content of + #ssl_tls{} -> + [tls_record:build_tls_record(Content)]; + _ when is_list(Content) -> + lists:flatten(Content) + end, format_tls_record(Direction, BinMsg); 'handshake' -> - format_handshake(Direction, BinMsg0); + format_handshake(Direction, Content); _Other -> [] end. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index d0a72ce51f..91f1876980 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2018. All Rights Reserved. +%% Copyright Ericsson AB 2013-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -47,14 +47,16 @@ -export([compress/3, uncompress/3, compressions/0]). %% Payload encryption/decryption --export([cipher/4, decipher/4, cipher_aead/4, decipher_aead/5, is_correct_mac/2, nonce_seed/3]). +-export([cipher/4, cipher/5, decipher/4, + cipher_aead/4, cipher_aead/5, decipher_aead/5, + is_correct_mac/2, nonce_seed/3]). -export_type([ssl_version/0, ssl_atom_version/0, connection_states/0, connection_state/0]). -type ssl_version() :: {integer(), integer()}. -type ssl_atom_version() :: tls_record:tls_atom_version(). --type connection_states() :: term(). %% Map --type connection_state() :: term(). %% Map +-type connection_states() :: map(). %% Map +-type connection_state() :: map(). %% Map %%==================================================================== %% Connection state handling @@ -120,7 +122,7 @@ activate_pending_connection_state(#{current_write := Current, }. %%-------------------------------------------------------------------- --spec step_encryption_state(connection_states()) -> connection_states(). +-spec step_encryption_state(#state{}) -> #state{}. %% %% Description: Activates the next encyrption state (e.g. handshake %% encryption). @@ -319,27 +321,49 @@ cipher(Version, Fragment, #security_parameters{bulk_cipher_algorithm = BulkCipherAlgo} } = WriteState0, MacHash) -> - + %% {CipherFragment, CipherS1} = ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version), {CipherFragment, WriteState0#{cipher_state => CipherS1}}. + +%%-------------------------------------------------------------------- +-spec cipher(ssl_version(), iodata(), #cipher_state{}, MacHash::binary(), #security_parameters{}) -> + {CipherFragment::binary(), #cipher_state{}}. +%% +%% Description: Payload encryption +%%-------------------------------------------------------------------- +cipher(Version, Fragment, CipherS0, MacHash, + #security_parameters{bulk_cipher_algorithm = BulkCipherAlgo}) -> + %% + ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version). + %%-------------------------------------------------------------------- -spec cipher_aead(ssl_version(), iodata(), connection_state(), AAD::binary()) -> {CipherFragment::binary(), connection_state()}. %% Description: Payload encryption %% %%-------------------------------------------------------------------- -cipher_aead(Version, Fragment, +cipher_aead(_Version, Fragment, #{cipher_state := CipherS0, security_parameters := #security_parameters{bulk_cipher_algorithm = BulkCipherAlgo} } = WriteState0, AAD) -> {CipherFragment, CipherS1} = - cipher_aead(BulkCipherAlgo, CipherS0, AAD, Fragment, Version), + do_cipher_aead(BulkCipherAlgo, Fragment, CipherS0, AAD), {CipherFragment, WriteState0#{cipher_state => CipherS1}}. %%-------------------------------------------------------------------- +-spec cipher_aead(ssl_version(), iodata(), #cipher_state{}, AAD::binary(), #security_parameters{}) -> + {CipherFragment::binary(), #cipher_state{}}. + +%% Description: Payload encryption +%% %%-------------------------------------------------------------------- +cipher_aead(_Version, Fragment, CipherS, AAD, + #security_parameters{bulk_cipher_algorithm = BulkCipherAlgo}) -> + do_cipher_aead(BulkCipherAlgo, Fragment, CipherS, AAD). + +%%-------------------------------------------------------------------- -spec decipher(ssl_version(), binary(), connection_state(), boolean()) -> {binary(), binary(), connection_state()} | #alert{}. %% @@ -360,9 +384,8 @@ decipher(Version, CipherFragment, Alert end. %%-------------------------------------------------------------------- --spec decipher_aead(ssl_cipher:cipher_enum(), #cipher_state{}, - binary(), binary(), ssl_record:ssl_version()) -> - {binary(), #cipher_state{}} | #alert{}. +-spec decipher_aead(ssl_cipher:cipher_enum(), #cipher_state{}, binary(), binary(), ssl_record:ssl_version()) -> + binary() | #alert{}. %% %% Description: Decrypts the data and checks the associated data (AAD) MAC using %% cipher described by cipher_enum() and updating the cipher state. @@ -374,7 +397,7 @@ decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment {AAD, CipherText, CipherTag} = aead_ciphertext_split(Type, CipherState, CipherFragment, AAD0), case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of Content when is_binary(Content) -> - {Content, CipherState}; + Content; _ -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end @@ -416,11 +439,13 @@ random() -> Random_28_bytes = ssl_cipher:random_bytes(28), <<?UINT32(Secs_since_1970), Random_28_bytes/binary>>. +-compile({inline, [is_correct_mac/2]}). is_correct_mac(Mac, Mac) -> true; is_correct_mac(_M,_H) -> false. +-compile({inline, [record_protocol_role/1]}). record_protocol_role(client) -> ?CLIENT; record_protocol_role(server) -> @@ -444,13 +469,15 @@ initial_security_params(ConnectionEnd) -> compression_algorithm = ?NULL}, ssl_cipher:security_parameters(?TLS_NULL_WITH_NULL_NULL, SecParams). -cipher_aead(?CHACHA20_POLY1305 = Type, #cipher_state{key=Key} = CipherState, AAD0, Fragment, _Version) -> - AAD = end_additional_data(AAD0, erlang:iolist_size(Fragment)), +-define(end_additional_data(AAD, Len), << (begin(AAD)end)/binary, ?UINT16(begin(Len)end) >>). + +do_cipher_aead(?CHACHA20_POLY1305 = Type, Fragment, #cipher_state{key=Key} = CipherState, AAD0) -> + AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)), Nonce = encrypt_nonce(Type, CipherState), {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD), {<<Content/binary, CipherTag/binary>>, CipherState}; -cipher_aead(Type, #cipher_state{key=Key, nonce = ExplicitNonce} = CipherState, AAD0, Fragment, _Version) -> - AAD = end_additional_data(AAD0, erlang:iolist_size(Fragment)), +do_cipher_aead(Type, Fragment, #cipher_state{key=Key, nonce = ExplicitNonce} = CipherState, AAD0) -> + AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)), Nonce = encrypt_nonce(Type, CipherState), {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD), {<<ExplicitNonce:64/integer, Content/binary, CipherTag/binary>>, CipherState#cipher_state{nonce = ExplicitNonce + 1}}. @@ -466,15 +493,12 @@ decrypt_nonce(?CHACHA20_POLY1305, #cipher_state{nonce = Nonce, iv = IV}, _) -> decrypt_nonce(?AES_GCM, #cipher_state{iv = <<Salt:4/bytes, _/binary>>}, <<ExplicitNonce:8/bytes, _/binary>>) -> <<Salt/binary, ExplicitNonce/binary>>. +-compile({inline, [aead_ciphertext_split/4]}). aead_ciphertext_split(?CHACHA20_POLY1305, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> - CipherLen = size(CipherTextFragment) - Len, + CipherLen = byte_size(CipherTextFragment) - Len, <<CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, - {end_additional_data(AAD, CipherLen), CipherText, CipherTag}; + {?end_additional_data(AAD, CipherLen), CipherText, CipherTag}; aead_ciphertext_split(?AES_GCM, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> - CipherLen = size(CipherTextFragment) - (Len + 8), %% 8 is length of explicit Nonce + CipherLen = byte_size(CipherTextFragment) - (Len + 8), %% 8 is length of explicit Nonce << _:8/bytes, CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, - {end_additional_data(AAD, CipherLen), CipherText, CipherTag}. - -end_additional_data(AAD, Len) -> - <<AAD/binary, ?UINT16(Len)>>. - + {?end_additional_data(AAD, CipherLen), CipherText, CipherTag}. diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index 4cb19d9d0d..eb718fd20c 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2016. All Rights Reserved. +%% Copyright Ericsson AB 2007-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -141,6 +141,8 @@ -define(HANDSHAKE, 22). -define(APPLICATION_DATA, 23). -define(HEARTBEAT, 24). +-define(KNOWN_RECORD_TYPE(Type), + (is_integer(Type) andalso (20 =< (Type)) andalso ((Type) =< 23))). -define(MAX_PLAIN_TEXT_LENGTH, 16384). -define(MAX_COMPRESSED_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+1024)). -define(MAX_CIPHER_TEXT_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+2048)). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index ebb723673e..9a896971ef 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2018. All Rights Reserved. +%% Copyright Ericsson AB 2007-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -59,11 +59,10 @@ %% Alert and close handling -export([send_alert/2, send_alert_in_connection/2, send_sync_alert/2, - encode_alert/3, close/5, protocol_name/0]). + close/5, protocol_name/0]). %% Data handling --export([encode_data/3, next_record/1, - send/3, socket/5, setopts/3, getopts/3]). +-export([next_record/1, socket/4, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -168,19 +167,10 @@ next_record(#state{handshake_env = {no_record, State#state{handshake_env = HsEnv#handshake_env{unprocessed_handshake_events = N-1}}}; next_record(#state{protocol_buffers = - #protocol_buffers{tls_cipher_texts = [#ssl_tls{type = Type}| _] = CipherTexts0} - = Buffers, - connection_states = ConnectionStates0, - connection_env = #connection_env{negotiated_version = Version}, + #protocol_buffers{tls_cipher_texts = [_|_] = CipherTexts}, + connection_states = ConnectionStates, ssl_options = #ssl_options{padding_check = Check}} = State) -> - case decode_cipher_texts(Version, Type, CipherTexts0, ConnectionStates0, Check, <<>>) of - {#ssl_tls{} = Record, ConnectionStates, CipherTexts} -> - {Record, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts}, - connection_states = ConnectionStates}}; - {#alert{} = Alert, ConnectionStates, CipherTexts} -> - {Alert, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts}, - connection_states = ConnectionStates}} - end; + next_record(State, CipherTexts, ConnectionStates, Check); next_record(#state{protocol_buffers = #protocol_buffers{tls_cipher_texts = []}, protocol_specific = #{active_n_toggle := true, active_n := N} = ProtocolSpec, static_env = #static_env{socket = Socket, @@ -197,16 +187,56 @@ next_record(#state{protocol_buffers = #protocol_buffers{tls_cipher_texts = []}, next_record(State) -> {no_record, State}. +%% Decipher next record and concatenate consecutive ?APPLICATION_DATA records into one +%% +next_record(State, CipherTexts, ConnectionStates, Check) -> + next_record(State, CipherTexts, ConnectionStates, Check, []). +%% +next_record(#state{connection_env = #connection_env{negotiated_version = Version}} = State, + [CT|CipherTexts], ConnectionStates0, Check, Acc) -> + case tls_record:decode_cipher_text(Version, CT, ConnectionStates0, Check) of + {#ssl_tls{type = ?APPLICATION_DATA, fragment = Fragment}, ConnectionStates} -> + case CipherTexts of + [] -> + %% End of cipher texts - build and deliver an ?APPLICATION_DATA record + %% from the accumulated fragments + next_record_done(State, [], ConnectionStates, + #ssl_tls{type = ?APPLICATION_DATA, + fragment = iolist_to_binary(lists:reverse(Acc, [Fragment]))}); + [_|_] -> + next_record(State, CipherTexts, ConnectionStates, Check, [Fragment|Acc]) + end; + {Record, ConnectionStates} when Acc =:= [] -> + %% Singelton non-?APPLICATION_DATA record - deliver + next_record_done(State, CipherTexts, ConnectionStates, Record); + {_Record, _ConnectionStates_to_forget} -> + %% Not ?APPLICATION_DATA but we have accumulated fragments + %% -> build an ?APPLICATION_DATA record with concatenated fragments + %% and forget about decrypting this record - we'll decrypt it again next time + next_record_done(State, [CT|CipherTexts], ConnectionStates0, + #ssl_tls{type = ?APPLICATION_DATA, fragment = iolist_to_binary(lists:reverse(Acc))}); + #alert{} = Alert -> + Alert + end. + +next_record_done(#state{protocol_buffers = Buffers} = State, CipherTexts, ConnectionStates, Record) -> + {Record, + State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts}, + connection_states = ConnectionStates}}. + + next_event(StateName, Record, State) -> next_event(StateName, Record, State, []). +%% next_event(StateName, no_record, State0, Actions) -> case next_record(State0) of {no_record, State} -> {next_state, StateName, State, Actions}; {#ssl_tls{} = Record, State} -> {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; - {#alert{} = Alert, State} -> - {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + #alert{} = Alert -> + Version = State0#state.connection_env#connection_env.negotiated_version, + ssl_connection:handle_own_alert(Alert, Version, StateName, State0) end; next_event(StateName, Record, State, Actions) -> case Record of @@ -215,34 +245,24 @@ next_event(StateName, Record, State, Actions) -> #ssl_tls{} = Record -> {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; #alert{} = Alert -> - {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + Version = State#state.connection_env#connection_env.negotiated_version, + ssl_connection:handle_own_alert(Alert, Version, StateName, State) end. -decode_cipher_texts(_, Type, [] = CipherTexts, ConnectionStates, _, Acc) -> - {#ssl_tls{type = Type, fragment = Acc}, ConnectionStates, CipherTexts}; -decode_cipher_texts(Version, Type, - [#ssl_tls{type = Type} = CT | CipherTexts], ConnectionStates0, Check, Acc) -> - case tls_record:decode_cipher_text(Version, CT, ConnectionStates0, Check) of - {#ssl_tls{type = ?APPLICATION_DATA, fragment = Plain}, ConnectionStates} -> - decode_cipher_texts(Version, Type, CipherTexts, - ConnectionStates, Check, <<Acc/binary, Plain/binary>>); - {#ssl_tls{type = Type0, fragment = Plain}, ConnectionStates} -> - {#ssl_tls{type = Type0, fragment = Plain}, ConnectionStates, CipherTexts}; - #alert{} = Alert -> - {Alert, ConnectionStates0, CipherTexts} - end; -decode_cipher_texts(_, Type, CipherTexts, ConnectionStates, _, Acc) -> - {#ssl_tls{type = Type, fragment = Acc}, ConnectionStates, CipherTexts}. %%% TLS record protocol level application data messages -handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State0) -> +handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName0, State0) -> case ssl_connection:read_application_data(Data, State0) of {stop, _, _} = Stop-> Stop; {Record, State1} -> - {next_state, StateName, State, Actions} = next_event(StateName, Record, State1), - ssl_connection:hibernate_after(StateName, State, Actions) + case next_event(StateName0, Record, State1) of + {next_state, StateName, State, Actions} -> + ssl_connection:hibernate_after(StateName, State, Actions); + {stop, _, _} = Stop -> + Stop + end end; %%% TLS record protocol level handshake messages handle_protocol_record(#ssl_tls{type = ?HANDSHAKE, fragment = Data}, @@ -324,7 +344,7 @@ renegotiate(#state{static_env = #static_env{role = server, Hs0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates} = tls_record:encode_handshake(Frag, Version, ConnectionStates0), - send(Transport, Socket, BinMsg), + tls_socket:send(Transport, Socket, BinMsg), State = State0#state{connection_states = ConnectionStates, handshake_env = HsEnv#handshake_env{tls_handshake_history = Hs0}}, @@ -351,7 +371,7 @@ queue_handshake(Handshake, #state{handshake_env = #handshake_env{tls_handshake_h send_handshake_flight(#state{static_env = #static_env{socket = Socket, transport_cb = Transport}, flight_buffer = Flight} = State0) -> - send(Transport, Socket, Flight), + tls_socket:send(Transport, Socket, Flight), {State0#state{flight_buffer = []}, []}. @@ -409,7 +429,7 @@ send_alert(Alert, #state{static_env = #static_env{socket = Socket, connection_states = ConnectionStates0} = StateData0) -> {BinMsg, ConnectionStates} = encode_alert(Alert, Version, ConnectionStates0), - send(Transport, Socket, BinMsg), + tls_socket:send(Transport, Socket, BinMsg), ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinMsg), StateData0#state{connection_states = ConnectionStates}. @@ -464,14 +484,9 @@ protocol_name() -> %%==================================================================== %% Data handling %%==================================================================== -encode_data(Data, Version, ConnectionStates0)-> - tls_record:encode_data(Data, Version, ConnectionStates0). - -send(Transport, Socket, Data) -> - tls_socket:send(Transport, Socket, Data). -socket(Pids, Transport, Socket, Connection, Tracker) -> - tls_socket:socket(Pids, Transport, Socket, Connection, Tracker). +socket(Pids, Transport, Socket, Tracker) -> + tls_socket:socket(Pids, Transport, Socket, ?MODULE, Tracker). setopts(Transport, Socket, Other) -> tls_socket:setopts(Transport, Socket, Other). @@ -510,7 +525,7 @@ init({call, From}, {start, Timeout}, Handshake0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0), - send(Transport, Socket, BinMsg), + tls_socket:send(Transport, Socket, BinMsg), ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Hello), ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinMsg), @@ -755,12 +770,11 @@ connection(internal, #client_hello{} = Hello, }, [{next_event, internal, Hello}]); connection(internal, #client_hello{}, - #state{static_env = #static_env{role = server, - protocol_cb = Connection}, + #state{static_env = #static_env{role = server}, handshake_env = #handshake_env{allow_renegotiate = false}} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), send_alert_in_connection(Alert, State0), - State = Connection:reinit_handshake_data(State0), + State = reinit_handshake_data(State0), next_event(?FUNCTION_NAME, no_record, State); connection(Type, Event, State) -> @@ -970,7 +984,7 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac session = #session{is_resumable = new}, connection_states = ConnectionStates, protocol_buffers = #protocol_buffers{}, - user_data_buffer = <<>>, + user_data_buffer = {[],0,[]}, start_or_recv_from = undefined, flight_buffer = [], protocol_specific = #{sender => Sender, @@ -982,7 +996,6 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac initialize_tls_sender(#state{static_env = #static_env{ role = Role, transport_cb = Transport, - protocol_cb = Connection, socket = Socket, tracker = Tracker }, @@ -997,20 +1010,29 @@ initialize_tls_sender(#state{static_env = #static_env{ socket => Socket, socket_options => SockOpts, tracker => Tracker, - protocol_cb => Connection, transport_cb => Transport, negotiated_version => Version, renegotiate_at => RenegotiateAt, log_level => LogLevel}, tls_sender:initialize(Sender, Init). - -next_tls_record(Data, StateName, #state{protocol_buffers = - #protocol_buffers{tls_record_buffer = Buf0, - tls_cipher_texts = CT0} = Buffers, - ssl_options = SslOpts} = State0) -> - case tls_record:get_tls_records(Data, - acceptable_record_versions(StateName, State0), - Buf0, SslOpts) of + +next_tls_record(Data, StateName, + #state{protocol_buffers = + #protocol_buffers{tls_record_buffer = Buf0, + tls_cipher_texts = CT0} = Buffers, + ssl_options = SslOpts} = State0) -> + Versions = + %% TLS 1.3 Client/Server + %% - Ignore TLSPlaintext.legacy_record_version + %% - Verify that TLSCiphertext.legacy_record_version is set to 0x0303 for all records + %% other than an initial ClientHello, where it MAY also be 0x0301. + case StateName of + hello -> + [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS]; + _ -> + State0#state.connection_env#connection_env.negotiated_version + end, + case tls_record:get_tls_records(Data, Versions, Buf0, SslOpts) of {Records, Buf1} -> CT1 = CT0 ++ Records, next_record(State0#state{protocol_buffers = @@ -1020,14 +1042,6 @@ next_tls_record(Data, StateName, #state{protocol_buffers = handle_record_alert(Alert, State0) end. -%% TLS 1.3 Client/Server -%% - Ignore TLSPlaintext.legacy_record_version -%% - Verify that TLSCiphertext.legacy_record_version is set to 0x0303 for all records -%% other than an initial ClientHello, where it MAY also be 0x0301. -acceptable_record_versions(StateName, #state{connection_env = #connection_env{negotiated_version = Version}}) when StateName =/= hello-> - Version; -acceptable_record_versions(hello, _) -> - [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS]. handle_record_alert(Alert, _) -> Alert. @@ -1058,7 +1072,7 @@ handle_info({CloseTag, Socket}, StateName, connection_env = #connection_env{negotiated_version = Version}, socket_options = #socket_options{active = Active}, protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}, - user_data_buffer = Buffer, + user_data_buffer = {_,BufferSize,_}, protocol_specific = PS} = State) -> %% Note that as of TLS 1.1, @@ -1066,7 +1080,7 @@ handle_info({CloseTag, Socket}, StateName, %% session not be resumed. This is a change from TLS 1.0 to conform %% with widespread implementation practice. - case (Active == false) andalso ((CTs =/= []) or (Buffer =/= <<>>)) of + case (Active == false) andalso ((CTs =/= []) or (BufferSize =/= 0)) of false -> case Version of {1, N} when N >= 1 -> @@ -1101,9 +1115,9 @@ handle_alerts(_, {stop, _, _} = Stop) -> handle_alerts([#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} | _Alerts], {next_state, connection = StateName, #state{connection_env = CEnv, socket_options = #socket_options{active = false}, - user_data_buffer = Buffer, + user_data_buffer = {_,BufferSize,_}, protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}} = - State}) when (Buffer =/= <<>>) orelse + State}) when (BufferSize =/= 0) orelse (CTs =/= []) -> {next_state, StateName, State#state{connection_env = CEnv#connection_env{terminated = true}}}; handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> @@ -1155,7 +1169,7 @@ gen_info(Event, connection = StateName, #state{connection_env = #connection_env Result -> Result catch - _:_ -> + _:_ -> ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR, malformed_data), Version, StateName, State) @@ -1177,7 +1191,7 @@ gen_info_1_3(Event, connected = StateName, #state{connection_env = #connection_ Result -> Result catch - _:_ -> + _:_ -> ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR, malformed_data), Version, StateName, State) diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index a1397047f2..e7cee1956b 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -98,7 +98,7 @@ client_hello(Host, Port, ConnectionStates, -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, ssl_record:connection_states() | {inet:port_number(), #session{}, db_handle(), atom(), ssl_record:connection_states(), - binary() | undefined, ssl:key_algo()}, + binary() | undefined, ssl:kex_algo()}, boolean()) -> {tls_record:tls_version(), ssl:session_id(), ssl_record:connection_states(), alpn | npn, binary() | undefined}| diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index c099e3f276..6a6de4b988 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -532,7 +532,7 @@ do_wait_finished(#change_cipher_spec{}, {_Ref, {state_not_implemented, State}} -> ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) end; -do_wait_finished(#finished{}, +do_wait_finished(#finished{verify_data = VerifyData}, #state{connection_states = _ConnectionStates0, session = #session{session_id = _SessionId, own_certificate = _OwnCert}, @@ -546,10 +546,10 @@ do_wait_finished(#finished{}, transport_cb = _Transport} } = State0) -> - %% {Ref,Maybe} = maybe(), + {Ref,Maybe} = maybe(), try - %% TODO: validate client Finished + Maybe(validate_client_finished(State0, VerifyData)), State1 = calculate_traffic_secrets(State0), @@ -558,7 +558,9 @@ do_wait_finished(#finished{}, catch - {_Ref, {state_not_implemented, State}} -> + {Ref, decrypt_error} -> + ?ALERT_REC(?FATAL, ?DECRYPT_ERROR, decrypt_error); + {_, {state_not_implemented, State}} -> %% TODO ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) end. @@ -569,6 +571,32 @@ do_wait_finished(#finished{}, %% {error, {state_not_implemented, State}}. +%% Recipients of Finished messages MUST verify that the contents are +%% correct and if incorrect MUST terminate the connection with a +%% "decrypt_error" alert. +validate_client_finished(#state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + tls_handshake_history = {Messages0, _}}}, VerifyData) -> + #{security_parameters := SecParamsR, + cipher_state := #cipher_state{finished_key = FinishedKey}} = + ssl_record:current_connection_state(ConnectionStates, read), + #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR, + + %% Drop the client's finished message, it is not part of the handshake context + %% when the client calculates its finished message. + [_|Messages] = Messages0, + + ControlData = tls_v1:finished_verify_data(FinishedKey, HKDFAlgo, Messages), + compare_verify_data(ControlData, VerifyData). + + +compare_verify_data(Data, Data) -> + ok; +compare_verify_data(_, _) -> + {error, decrypt_error}. + + calculate_handshake_secrets(ClientKey, SelectedGroup, KeyShare, #state{connection_states = ConnectionStates, handshake_env = diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 96e851de41..94506b8edc 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2018. All Rights Reserved. +%% Copyright Ericsson AB 2007-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,6 +43,9 @@ %% Decoding -export([decode_cipher_text/4]). +%% Logging helper +-export([build_tls_record/1]). + %% Protocol version handling -export([protocol_version/1, lowest_protocol_version/1, lowest_protocol_version/2, highest_protocol_version/1, highest_protocol_version/2, @@ -76,15 +79,23 @@ init_connection_states(Role, BeastMitigation) -> pending_write => Pending}. %%-------------------------------------------------------------------- --spec get_tls_records(binary(), [tls_version()] | tls_version(), binary(), - #ssl_options{}) -> {[binary()], binary()} | #alert{}. +-spec get_tls_records( + binary(), + [tls_version()] | tls_version(), + Buffer0 :: binary() | {'undefined' | #ssl_tls{}, {[binary()],non_neg_integer(),[binary()]}}, + #ssl_options{}) -> + {Records :: [#ssl_tls{}], + Buffer :: {'undefined' | #ssl_tls{}, {[binary()],non_neg_integer(),[binary()]}}} | + #alert{}. %% %% and returns it as a list of tls_compressed binaries also returns leftover %% Description: Given old buffer and new data from TCP, packs up a records %% data %%-------------------------------------------------------------------- -get_tls_records(Data, Version, Buffer, SslOpts) -> - get_tls_records_aux(Version, <<Buffer/binary, Data/binary>>, [], SslOpts). +get_tls_records(Data, Versions, Buffer, SslOpts) when is_binary(Buffer) -> + parse_tls_records(Versions, {[Data],byte_size(Data),[]}, SslOpts, undefined); +get_tls_records(Data, Versions, {Hdr, {Front,Size,Rear}}, SslOpts) -> + parse_tls_records(Versions, {Front,Size + byte_size(Data),[Data|Rear]}, SslOpts, Hdr). %%==================================================================== %% Encoding @@ -106,8 +117,8 @@ encode_handshake(Frag, Version, ConnectionStates) -> case iolist_size(Frag) of N when N > ?MAX_PLAIN_TEXT_LENGTH -> - Data = split_bin(iolist_to_binary(Frag), Version, BCA, BeastMitigation), - encode_iolist(?HANDSHAKE, Data, Version, ConnectionStates); + Data = split_iovec(erlang:iolist_to_iovec(Frag), Version, BCA, BeastMitigation), + encode_fragments(?HANDSHAKE, Version, Data, ConnectionStates); _ -> encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates) end. @@ -135,20 +146,20 @@ encode_change_cipher_spec(Version, ConnectionStates) -> encode_plain_text(?CHANGE_CIPHER_SPEC, Version, ?byte(?CHANGE_CIPHER_SPEC_PROTO), ConnectionStates). %%-------------------------------------------------------------------- --spec encode_data(binary(), tls_version(), ssl_record:connection_states()) -> - {iolist(), ssl_record:connection_states()}. +-spec encode_data([binary()], tls_version(), ssl_record:connection_states()) -> + {[[binary()]], ssl_record:connection_states()}. %% %% Description: Encodes data to send on the ssl-socket. %%-------------------------------------------------------------------- encode_data(Data, {3, 4}, ConnectionStates) -> tls_record_1_3:encode_data(Data, ConnectionStates); -encode_data(Frag, Version, +encode_data(Data, Version, #{current_write := #{beast_mitigation := BeastMitigation, security_parameters := #security_parameters{bulk_cipher_algorithm = BCA}}} = ConnectionStates) -> - Data = split_bin(Frag, Version, BCA, BeastMitigation), - encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates). + Fragments = split_iovec(Data, Version, BCA, BeastMitigation), + encode_fragments(?APPLICATION_DATA, Version, Fragments, ConnectionStates). %%==================================================================== %% Decoding @@ -162,57 +173,59 @@ encode_data(Frag, Version, %%-------------------------------------------------------------------- decode_cipher_text({3,4}, CipherTextRecord, ConnectionStates, _) -> tls_record_1_3:decode_cipher_text(CipherTextRecord, ConnectionStates); -decode_cipher_text(_, #ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, +decode_cipher_text(_, CipherTextRecord, #{current_read := - #{compression_state := CompressionS0, - sequence_number := Seq, - cipher_state := CipherS0, + #{sequence_number := Seq, security_parameters := - #security_parameters{ - cipher_type = ?AEAD, - bulk_cipher_algorithm = - BulkCipherAlgo, - compression_algorithm = CompAlg} - } = ReadState0} = ConnnectionStates0, _) -> - AAD = start_additional_data(Type, Version, ReadState0), - CipherS1 = ssl_record:nonce_seed(BulkCipherAlgo, <<?UINT64(Seq)>>, CipherS0), - case ssl_record:decipher_aead(BulkCipherAlgo, CipherS1, AAD, CipherFragment, Version) of - {PlainFragment, CipherState} -> - {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, - PlainFragment, CompressionS0), - ConnnectionStates = ConnnectionStates0#{ + #security_parameters{cipher_type = ?AEAD, + bulk_cipher_algorithm = BulkCipherAlgo}, + cipher_state := CipherS0 + } + } = ConnectionStates0, _) -> + SeqBin = <<?UINT64(Seq)>>, + #ssl_tls{type = Type, version = {MajVer,MinVer} = Version, fragment = Fragment} = CipherTextRecord, + StartAdditionalData = <<SeqBin/binary, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>, + CipherS = ssl_record:nonce_seed(BulkCipherAlgo, SeqBin, CipherS0), + case ssl_record:decipher_aead( + BulkCipherAlgo, CipherS, StartAdditionalData, Fragment, Version) + of + PlainFragment when is_binary(PlainFragment) -> + #{current_read := + #{security_parameters := SecParams, + compression_state := CompressionS0} = ReadState0} = ConnectionStates0, + {Plain, CompressionS} = ssl_record:uncompress(SecParams#security_parameters.compression_algorithm, + PlainFragment, CompressionS0), + ConnectionStates = ConnectionStates0#{ current_read => ReadState0#{ - cipher_state => CipherState, + cipher_state => CipherS, sequence_number => Seq + 1, - compression_state => CompressionS1}}, - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + compression_state => CompressionS}}, + {CipherTextRecord#ssl_tls{fragment = Plain}, ConnectionStates}; #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) -> +decode_cipher_text(_, #ssl_tls{version = Version, + fragment = CipherFragment} = CipherTextRecord, + #{current_read := 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), + MacHash = ssl_cipher:calc_mac_hash(CipherTextRecord#ssl_tls.type, Version, PlainFragment, ReadState1), case ssl_record:is_correct_mac(Mac, MacHash) of true -> + #{sequence_number := Seq, + compression_state := CompressionS0, + security_parameters := + #security_parameters{compression_algorithm = CompAlg}} = ReadState0, {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}; + ConnnectionStates = + ConnnectionStates0#{current_read => + ReadState1#{sequence_number => Seq + 1, + compression_state => CompressionS1}}, + {CipherTextRecord#ssl_tls{fragment = Plain}, ConnnectionStates}; false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end; #alert{} = Alert -> Alert @@ -398,138 +411,230 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> server_verify_data => undefined }. -%% TLS 1.3 -get_tls_records_aux({3,4} = Version, <<?BYTE(Type),?BYTE(3),?BYTE(3), - ?UINT16(Length), Data:Length/binary, - Rest/binary>> = RawTLSRecord, - Acc, SslOpts) when Type == ?APPLICATION_DATA; - Type == ?HANDSHAKE; - Type == ?ALERT; - Type == ?CHANGE_CIPHER_SPEC -> - ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'tls_record', [RawTLSRecord]), - get_tls_records_aux(Version, Rest, [#ssl_tls{type = Type, - version = {3,3}, %% Use legacy version - fragment = Data} | Acc], SslOpts); -get_tls_records_aux({MajVer, MinVer} = Version, <<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Length), Data:Length/binary, Rest/binary>> = RawTLSRecord, - Acc, SslOpts) when Type == ?APPLICATION_DATA; - Type == ?HANDSHAKE; - Type == ?ALERT; - Type == ?CHANGE_CIPHER_SPEC -> - ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'tls_record', [RawTLSRecord]), - get_tls_records_aux(Version, Rest, [#ssl_tls{type = Type, - version = Version, - fragment = Data} | Acc], SslOpts); -get_tls_records_aux(Versions, <<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer), - ?UINT16(Length), Data:Length/binary, Rest/binary>> = RawTLSRecord, - Acc, SslOpts) when is_list(Versions) andalso - ((Type == ?APPLICATION_DATA) - orelse - (Type == ?HANDSHAKE) - orelse - (Type == ?ALERT) - orelse - (Type == ?CHANGE_CIPHER_SPEC)) -> - case is_acceptable_version({MajVer, MinVer}, Versions) of +%% Used by logging to recreate the received bytes +build_tls_record(#ssl_tls{type = Type, version = {MajVer, MinVer}, fragment = Fragment}) -> + Length = byte_size(Fragment), + <<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer),?UINT16(Length), Fragment/binary>>. + + +parse_tls_records(Versions, Q, SslOpts, undefined) -> + decode_tls_records(Versions, Q, SslOpts, [], undefined, undefined, undefined); +parse_tls_records(Versions, Q, SslOpts, #ssl_tls{type = Type, version = Version, fragment = Length}) -> + decode_tls_records(Versions, Q, SslOpts, [], Type, Version, Length). + +%% Generic code path +decode_tls_records(Versions, {_,Size,_} = Q0, SslOpts, Acc, undefined, _Version, _Length) -> + if + 5 =< Size -> + {<<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Length)>>, Q} = binary_from_front(5, Q0), + validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, {MajVer,MinVer}, Length); + 3 =< Size -> + {<<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer)>>, Q} = binary_from_front(3, Q0), + validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, {MajVer,MinVer}, undefined); + 1 =< Size -> + {<<?BYTE(Type)>>, Q} = binary_from_front(1, Q0), + validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, undefined, undefined); + true -> + validate_tls_records_type(Versions, Q0, SslOpts, Acc, undefined, undefined, undefined) + end; +decode_tls_records(Versions, {_,Size,_} = Q0, SslOpts, Acc, Type, undefined, _Length) -> + if + 4 =< Size -> + {<<?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Length)>>, Q} = binary_from_front(4, Q0), + validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, {MajVer,MinVer}, Length); + 2 =< Size -> + {<<?BYTE(MajVer),?BYTE(MinVer)>>, Q} = binary_from_front(2, Q0), + validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, {MajVer,MinVer}, undefined); + true -> + validate_tls_record_version(Versions, Q0, SslOpts, Acc, Type, undefined, undefined) + end; +decode_tls_records(Versions, {_,Size,_} = Q0, SslOpts, Acc, Type, Version, undefined) -> + if + 2 =< Size -> + {<<?UINT16(Length)>>, Q} = binary_from_front(2, Q0), + validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length); true -> - ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'tls_record', [RawTLSRecord]), - get_tls_records_aux(Versions, Rest, [#ssl_tls{type = Type, - version = {MajVer, MinVer}, - fragment = Data} | Acc], SslOpts); - false -> + validate_tls_record_length(Versions, Q0, SslOpts, Acc, Type, Version, undefined) + end; +decode_tls_records(Versions, Q, SslOpts, Acc, Type, Version, Length) -> + validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length). + +validate_tls_records_type(_Versions, Q, _SslOpts, Acc, undefined, _Version, _Length) -> + {lists:reverse(Acc), + {undefined, Q}}; +validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, Version, Length) -> + if + ?KNOWN_RECORD_TYPE(Type) -> + validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, Version, Length); + true -> + %% Not ?KNOWN_RECORD_TYPE(Type) + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) + end. + +validate_tls_record_version(_Versions, Q, _SslOpts, Acc, Type, undefined, _Length) -> + {lists:reverse(Acc), + {#ssl_tls{type = Type, version = undefined, fragment = undefined}, Q}}; +validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, Version, Length) -> + case Versions of + _ when is_list(Versions) -> + case is_acceptable_version(Version, Versions) of + true -> + validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length); + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + {3, 4} when Version =:= {3, 3} -> + validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length); + Version -> + %% Exact version match + validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length); + _ -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end. + +validate_tls_record_length(_Versions, Q, _SslOpts, Acc, Type, Version, undefined) -> + {lists:reverse(Acc), + {#ssl_tls{type = Type, version = Version, fragment = undefined}, Q}}; +validate_tls_record_length(Versions, {_,Size0,_} = Q0, SslOpts, Acc, Type, Version, Length) -> + if + Length =< ?MAX_CIPHER_TEXT_LENGTH -> + if + Length =< Size0 -> + %% Complete record + {Fragment, Q} = binary_from_front(Length, Q0), + Record = #ssl_tls{type = Type, version = Version, fragment = Fragment}, + ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'tls_record', Record), + decode_tls_records(Versions, Q, SslOpts, [Record|Acc], undefined, undefined, undefined); + true -> + {lists:reverse(Acc), + {#ssl_tls{type = Type, version = Version, fragment = Length}, Q0}} + end; + true -> + ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW) + end. + + +binary_from_front(SplitSize, {Front,Size,Rear}) -> + binary_from_front(SplitSize, Front, Size, Rear, []). +%% +binary_from_front(SplitSize, [], Size, [_] = Rear, Acc) -> + %% Optimize a simple case + binary_from_front(SplitSize, Rear, Size, [], Acc); +binary_from_front(SplitSize, [], Size, Rear, Acc) -> + binary_from_front(SplitSize, lists:reverse(Rear), Size, [], Acc); +binary_from_front(SplitSize, [Bin|Front], Size, Rear, []) -> + %% Optimize a frequent case + BinSize = byte_size(Bin), + if + SplitSize < BinSize -> + {RetBin, Rest} = erlang:split_binary(Bin, SplitSize), + {RetBin, {[Rest|Front],Size - SplitSize,Rear}}; + BinSize < SplitSize -> + binary_from_front(SplitSize - BinSize, Front, Size, Rear, [Bin]); + true -> % Perfect fit + {Bin, {Front,Size - SplitSize,Rear}} end; -get_tls_records_aux(_, <<?BYTE(Type),?BYTE(_MajVer),?BYTE(_MinVer), - ?UINT16(Length), _:Length/binary, _Rest/binary>>, - _, _) when Type == ?APPLICATION_DATA; - Type == ?HANDSHAKE; - Type == ?ALERT; - Type == ?CHANGE_CIPHER_SPEC -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC); -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(_, Data, Acc, _) -> - case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of - true -> - {lists:reverse(Acc), Data}; - false -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) +binary_from_front(SplitSize, [Bin|Front], Size, Rear, Acc) -> + BinSize = byte_size(Bin), + if + SplitSize < BinSize -> + {Last, Rest} = erlang:split_binary(Bin, SplitSize), + RetBin = iolist_to_binary(lists:reverse(Acc, [Last])), + {RetBin, {[Rest|Front],Size - byte_size(RetBin),Rear}}; + BinSize < SplitSize -> + binary_from_front(SplitSize - BinSize, Front, Size, Rear, [Bin|Acc]); + true -> % Perfect fit + RetBin = iolist_to_binary(lists:reverse(Acc, [Bin])), + {RetBin, {Front,Size - byte_size(RetBin),Rear}} end. + %%-------------------------------------------------------------------- -encode_plain_text(Type, Version, Data, #{current_write := Write0} = ConnectionStates) -> - {CipherFragment, Write1} = do_encode_plain_text(Type, Version, Data, Write0), - {CipherText, Write} = encode_tls_cipher_text(Type, Version, CipherFragment, Write1), - {CipherText, ConnectionStates#{current_write => Write}}. - -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], - Write#{sequence_number => Seq +1}}. - -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}. -%%-------------------------------------------------------------------- -do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0, - cipher_state := CipherS0, - sequence_number := Seq, - security_parameters := - #security_parameters{ - cipher_type = ?AEAD, - bulk_cipher_algorithm = BCAlg, - compression_algorithm = CompAlg} - } = WriteState0) -> - {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), - CipherS = ssl_record:nonce_seed(BCAlg, <<?UINT64(Seq)>>, CipherS0), - WriteState = WriteState0#{compression_state => CompS1, - cipher_state => CipherS}, - AAD = start_additional_data(Type, Version, WriteState), - ssl_record:cipher_aead(Version, Comp, WriteState, AAD); -do_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); -do_encode_plain_text(_,_,_,CS) -> +encode_plain_text(Type, Version, Data, ConnectionStates0) -> + {[CipherText],ConnectionStates} = encode_fragments(Type, Version, [Data], ConnectionStates0), + {CipherText,ConnectionStates}. +%%-------------------------------------------------------------------- +encode_fragments(Type, Version, Data, + #{current_write := #{compression_state := CompS, + cipher_state := CipherS, + sequence_number := Seq}} = ConnectionStates) -> + encode_fragments(Type, Version, Data, ConnectionStates, CompS, CipherS, Seq, []). +%% +encode_fragments(_Type, _Version, [], #{current_write := WriteS} = CS, + CompS, CipherS, Seq, CipherFragments) -> + {lists:reverse(CipherFragments), + CS#{current_write := WriteS#{compression_state := CompS, + cipher_state := CipherS, + sequence_number := Seq}}}; +encode_fragments(Type, Version, [Text|Data], + #{current_write := #{security_parameters := + #security_parameters{cipher_type = ?AEAD, + bulk_cipher_algorithm = BCAlg, + compression_algorithm = CompAlg} = SecPars}} = CS, + CompS0, CipherS0, Seq, CipherFragments) -> + {CompText, CompS} = ssl_record:compress(CompAlg, Text, CompS0), + SeqBin = <<?UINT64(Seq)>>, + CipherS1 = ssl_record:nonce_seed(BCAlg, SeqBin, CipherS0), + {MajVer, MinVer} = Version, + VersionBin = <<?BYTE(MajVer), ?BYTE(MinVer)>>, + StartAdditionalData = <<SeqBin/binary, ?BYTE(Type), VersionBin/binary>>, + {CipherFragment,CipherS} = ssl_record:cipher_aead(Version, CompText, CipherS1, StartAdditionalData, SecPars), + Length = byte_size(CipherFragment), + CipherHeader = <<?BYTE(Type), VersionBin/binary, ?UINT16(Length)>>, + encode_fragments(Type, Version, Data, CS, CompS, CipherS, Seq + 1, + [[CipherHeader, CipherFragment] | CipherFragments]); +encode_fragments(Type, Version, [Text|Data], + #{current_write := #{security_parameters := + #security_parameters{compression_algorithm = CompAlg, + mac_algorithm = MacAlgorithm} = SecPars, + mac_secret := MacSecret}} = CS, + CompS0, CipherS0, Seq, CipherFragments) -> + {CompText, CompS} = ssl_record:compress(CompAlg, Text, CompS0), + MacHash = ssl_cipher:calc_mac_hash(Type, Version, CompText, MacAlgorithm, MacSecret, Seq), + {CipherFragment,CipherS} = ssl_record:cipher(Version, CompText, CipherS0, MacHash, SecPars), + Length = byte_size(CipherFragment), + {MajVer, MinVer} = Version, + CipherHeader = <<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, + encode_fragments(Type, Version, Data, CS, CompS, CipherS, Seq + 1, + [[CipherHeader, CipherFragment] | CipherFragments]); +encode_fragments(_Type, _Version, _Data, CS, _CompS, _CipherS, _Seq, _CipherFragments) -> exit({cs, CS}). %%-------------------------------------------------------------------- -start_additional_data(Type, {MajVer, MinVer}, - #{sequence_number := SeqNo}) -> - <<?UINT64(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. %% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are %% not vulnerable to this attack. -split_bin(<<FirstByte:8, Rest/binary>>, Version, BCA, one_n_minus_one) when - BCA =/= ?RC4 andalso ({3, 1} == Version orelse - {3, 0} == Version) -> - [[FirstByte]|do_split_bin(Rest)]; +split_iovec([<<FirstByte:8, Rest/binary>>|Data], Version, BCA, one_n_minus_one) + when (BCA =/= ?RC4) andalso ({3, 1} == Version orelse + {3, 0} == Version) -> + [[FirstByte]|split_iovec([Rest|Data])]; %% 0/n splitting countermeasure for clients that are incompatible with 1/n-1 %% splitting. -split_bin(Bin, Version, BCA, zero_n) when - BCA =/= ?RC4 andalso ({3, 1} == Version orelse - {3, 0} == Version) -> - [<<>>|do_split_bin(Bin)]; -split_bin(Bin, _, _, _) -> - do_split_bin(Bin). - -do_split_bin(<<>>) -> []; -do_split_bin(Bin) -> - case Bin of - <<Chunk:?MAX_PLAIN_TEXT_LENGTH/binary, Rest/binary>> -> - [Chunk|do_split_bin(Rest)]; - _ -> - [Bin] - end. +split_iovec(Data, Version, BCA, zero_n) + when (BCA =/= ?RC4) andalso ({3, 1} == Version orelse + {3, 0} == Version) -> + [<<>>|split_iovec(Data)]; +split_iovec(Data, _Version, _BCA, _BeatMitigation) -> + split_iovec(Data). + +split_iovec([]) -> + []; +split_iovec(Data) -> + {Part,Rest} = split_iovec(Data, ?MAX_PLAIN_TEXT_LENGTH, []), + [Part|split_iovec(Rest)]. +%% +split_iovec([Bin|Data], SplitSize, Acc) -> + BinSize = byte_size(Bin), + if + SplitSize < BinSize -> + {Last, Rest} = erlang:split_binary(Bin, SplitSize), + {lists:reverse(Acc, [Last]), [Rest|Data]}; + BinSize < SplitSize -> + split_iovec(Data, SplitSize - BinSize, [Bin|Acc]); + true -> % Perfect match + {lists:reverse(Acc, [Bin]), Data} + end; +split_iovec([], _SplitSize, Acc) -> + {lists:reverse(Acc),[]}. + %%-------------------------------------------------------------------- lowest_list_protocol_version(Ver, []) -> Ver; diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl index 1f34f9a420..ba73eddf0b 100644 --- a/lib/ssl/src/tls_sender.erl +++ b/lib/ssl/src/tls_sender.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2018. All Rights Reserved. +%% Copyright Ericsson AB 2018-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -38,20 +38,24 @@ -define(SERVER, ?MODULE). --record(data, {connection_pid, - connection_states = #{}, - role, - socket, - socket_options, - tracker, - protocol_cb, - transport_cb, - negotiated_version, - renegotiate_at, - connection_monitor, - dist_handle, - log_level - }). +-record(static, + {connection_pid, + role, + socket, + socket_options, + tracker, + transport_cb, + negotiated_version, + renegotiate_at, + connection_monitor, + dist_handle, + log_level + }). + +-record(data, + {static = #static{}, + connection_states = #{} + }). %%%=================================================================== %%% API @@ -172,6 +176,10 @@ dist_tls_socket(Pid) -> callback_mode() -> state_functions. + +-define(HANDLE_COMMON, + ?FUNCTION_NAME(Type, Msg, StateData) -> + handle_common(Type, Msg, StateData)). %%-------------------------------------------------------------------- -spec init(Args :: term()) -> gen_statem:init_result(atom()). @@ -193,41 +201,37 @@ init({call, From}, {Pid, #{current_write := WriteState, socket := Socket, socket_options := SockOpts, tracker := Tracker, - protocol_cb := Connection, transport_cb := Transport, negotiated_version := Version, renegotiate_at := RenegotiateAt, log_level := LogLevel}}, - #data{connection_states = ConnectionStates} = StateData0) -> + #data{connection_states = ConnectionStates, static = Static0} = StateData0) -> Monitor = erlang:monitor(process, Pid), StateData = - StateData0#data{connection_pid = Pid, - connection_monitor = Monitor, - connection_states = - ConnectionStates#{current_write => WriteState}, - role = Role, - socket = Socket, - socket_options = SockOpts, - tracker = Tracker, - protocol_cb = Connection, - transport_cb = Transport, - negotiated_version = Version, - renegotiate_at = RenegotiateAt, - log_level = LogLevel}, + StateData0#data{connection_states = ConnectionStates#{current_write => WriteState}, + static = Static0#static{connection_pid = Pid, + connection_monitor = Monitor, + role = Role, + socket = Socket, + socket_options = SockOpts, + tracker = Tracker, + transport_cb = Transport, + negotiated_version = Version, + renegotiate_at = RenegotiateAt, + log_level = LogLevel}}, {next_state, handshake, StateData, [{reply, From, ok}]}; -init(info, Msg, StateData) -> - handle_info(Msg, ?FUNCTION_NAME, StateData). +init(_, _, _) -> + %% Just in case anything else sneeks through + {keep_state_and_data, [postpone]}. + %%-------------------------------------------------------------------- -spec connection(gen_statem:event_type(), Msg :: term(), StateData :: term()) -> gen_statem:event_handler_result(atom()). %%-------------------------------------------------------------------- -connection({call, From}, renegotiate, - #data{connection_states = #{current_write := Write}} = StateData) -> - {next_state, handshake, StateData, [{reply, From, {ok, Write}}]}; connection({call, From}, {application_data, AppData}, - #data{socket_options = #socket_options{packet = Packet}} = + #data{static = #static{socket_options = #socket_options{packet = Packet}}} = StateData) -> case encode_packet(Packet, AppData) of {error, _} = Error -> @@ -235,40 +239,40 @@ connection({call, From}, {application_data, AppData}, Data -> send_application_data(Data, From, ?FUNCTION_NAME, StateData) end; -connection({call, From}, {set_opts, _} = Call, StateData) -> - handle_call(From, Call, ?FUNCTION_NAME, StateData); +connection({call, From}, {ack_alert, #alert{} = Alert}, StateData0) -> + StateData = send_tls_alert(Alert, StateData0), + {next_state, ?FUNCTION_NAME, StateData, + [{reply,From,ok}]}; +connection({call, From}, renegotiate, + #data{connection_states = #{current_write := Write}} = StateData) -> + {next_state, handshake, StateData, [{reply, From, {ok, Write}}]}; +connection({call, From}, downgrade, #data{connection_states = + #{current_write := Write}} = StateData) -> + {next_state, death_row, StateData, [{reply,From, {ok, Write}}]}; +connection({call, From}, {set_opts, Opts}, StateData) -> + handle_set_opts(From, Opts, StateData); connection({call, From}, dist_get_tls_socket, - #data{protocol_cb = Connection, - transport_cb = Transport, - socket = Socket, - connection_pid = Pid, - tracker = Tracker} = StateData) -> - TLSSocket = Connection:socket([Pid, self()], Transport, Socket, Connection, Tracker), + #data{static = #static{transport_cb = Transport, + socket = Socket, + connection_pid = Pid, + tracker = Tracker}} = StateData) -> + TLSSocket = tls_connection:socket([Pid, self()], Transport, Socket, Tracker), {next_state, ?FUNCTION_NAME, StateData, [{reply, From, {ok, TLSSocket}}]}; connection({call, From}, {dist_handshake_complete, _Node, DHandle}, - #data{connection_pid = Pid, - socket_options = #socket_options{packet = Packet}} = - StateData) -> + #data{static = #static{connection_pid = Pid} = Static} = StateData) -> ok = erlang:dist_ctrl_input_handler(DHandle, Pid), ok = ssl_connection:dist_handshake_complete(Pid, DHandle), %% From now on we execute on normal priority process_flag(priority, normal), - {next_state, ?FUNCTION_NAME, StateData#data{dist_handle = DHandle}, - [{reply, From, ok} - | case dist_data(DHandle, Packet) of - [] -> - []; - Data -> - [{next_event, internal, - {application_packets,{self(),undefined},Data}}] - end]}; -connection({call, From}, {ack_alert, #alert{} = Alert}, StateData0) -> - StateData = send_tls_alert(Alert, StateData0), - {next_state, ?FUNCTION_NAME, StateData, - [{reply,From,ok}]}; -connection({call, From}, downgrade, #data{connection_states = - #{current_write := Write}} = StateData) -> - {next_state, death_row, StateData, [{reply,From, {ok, Write}}]}; + {keep_state, StateData#data{static = Static#static{dist_handle = DHandle}}, + [{reply,From,ok}| + case dist_data(DHandle) of + [] -> + []; + Data -> + [{next_event, internal, + {application_packets,{self(),undefined},erlang:iolist_to_iovec(Data)}}] + end]}; connection(internal, {application_packets, From, Data}, StateData) -> send_application_data(Data, From, ?FUNCTION_NAME, StateData); %% @@ -276,29 +280,26 @@ connection(cast, #alert{} = Alert, StateData0) -> StateData = send_tls_alert(Alert, StateData0), {next_state, ?FUNCTION_NAME, StateData}; connection(cast, {new_write, WritesState, Version}, - #data{connection_states = ConnectionStates0} = StateData) -> + #data{connection_states = ConnectionStates, static = Static} = StateData) -> {next_state, connection, StateData#data{connection_states = - ConnectionStates0#{current_write => WritesState}, - negotiated_version = Version}}; + ConnectionStates#{current_write => WritesState}, + static = Static#static{negotiated_version = Version}}}; %% -connection(info, dist_data, - #data{dist_handle = DHandle, - socket_options = #socket_options{packet = Packet}} = - StateData) -> - {next_state, ?FUNCTION_NAME, StateData, - case dist_data(DHandle, Packet) of +connection(info, dist_data, #data{static = #static{dist_handle = DHandle}}) -> + {keep_state_and_data, + case dist_data(DHandle) of [] -> []; Data -> [{next_event, internal, - {application_packets,{self(),undefined},Data}}] + {application_packets,{self(),undefined},erlang:iolist_to_iovec(Data)}}] end}; connection(info, tick, StateData) -> consume_ticks(), - {next_state, ?FUNCTION_NAME, StateData, - [{next_event, {call, {self(), undefined}}, - {application_data, <<>>}}]}; + Data = [<<0:32>>], % encode_packet(4, <<>>) + From = {self(), undefined}, + send_application_data(Data, From, ?FUNCTION_NAME, StateData); connection(info, {send, From, Ref, Data}, _StateData) -> %% This is for testing only! %% @@ -307,29 +308,37 @@ connection(info, {send, From, Ref, Data}, _StateData) -> From ! {Ref, ok}, {keep_state_and_data, [{next_event, {call, {self(), undefined}}, - {application_data, iolist_to_binary(Data)}}]}; -connection(info, Msg, StateData) -> - handle_info(Msg, ?FUNCTION_NAME, StateData). + {application_data, erlang:iolist_to_iovec(Data)}}]}; +?HANDLE_COMMON. + %%-------------------------------------------------------------------- -spec handshake(gen_statem:event_type(), Msg :: term(), StateData :: term()) -> gen_statem:event_handler_result(atom()). %%-------------------------------------------------------------------- -handshake({call, From}, {set_opts, _} = Call, StateData) -> - handle_call(From, Call, ?FUNCTION_NAME, StateData); +handshake({call, From}, {set_opts, Opts}, StateData) -> + handle_set_opts(From, Opts, StateData); handshake({call, _}, _, _) -> + %% Postpone all calls to the connection state + {keep_state_and_data, [postpone]}; +handshake(internal, {application_packets,_,_}, _) -> {keep_state_and_data, [postpone]}; handshake(cast, {new_write, WritesState, Version}, - #data{connection_states = ConnectionStates0} = StateData) -> + #data{connection_states = ConnectionStates, static = Static} = StateData) -> {next_state, connection, - StateData#data{connection_states = - ConnectionStates0#{current_write => WritesState}, - negotiated_version = Version}}; -handshake(internal, {application_packets,_,_}, _) -> + StateData#data{connection_states = ConnectionStates#{current_write => WritesState}, + static = Static#static{negotiated_version = Version}}}; +handshake(info, dist_data, _) -> {keep_state_and_data, [postpone]}; -handshake(info, Msg, StateData) -> - handle_info(Msg, ?FUNCTION_NAME, StateData). +handshake(info, tick, _) -> + %% Ignore - data is sent anyway during handshake + consume_ticks(), + keep_state_and_data; +handshake(info, {send, _, _, _}, _) -> + %% Testing only, OTP distribution test suites... + {keep_state_and_data, [postpone]}; +?HANDLE_COMMON. %%-------------------------------------------------------------------- -spec death_row(gen_statem:event_type(), @@ -364,52 +373,69 @@ code_change(_OldVsn, State, Data, _Extra) -> %%%=================================================================== %%% Internal functions %%%=================================================================== -handle_call(From, {set_opts, Opts}, StateName, #data{socket_options = SockOpts} = StateData) -> - {next_state, StateName, StateData#data{socket_options = set_opts(SockOpts, Opts)}, [{reply, From, ok}]}. - -handle_info({'DOWN', Monitor, _, _, Reason}, _, - #data{connection_monitor = Monitor, - dist_handle = Handle} = StateData) when Handle =/= undefined-> - {next_state, death_row, StateData, [{state_timeout, 5000, Reason}]}; -handle_info({'DOWN', Monitor, _, _, _}, _, - #data{connection_monitor = Monitor} = StateData) -> + +handle_set_opts( + From, Opts, #data{static = #static{socket_options = SockOpts} = Static} = StateData) -> + {keep_state, StateData#data{static = Static#static{socket_options = set_opts(SockOpts, Opts)}}, + [{reply, From, ok}]}. + +handle_common( + {call, From}, {set_opts, Opts}, + #data{static = #static{socket_options = SockOpts} = Static} = StateData) -> + {keep_state, StateData#data{static = Static#static{socket_options = set_opts(SockOpts, Opts)}}, + [{reply, From, ok}]}; +handle_common( + info, {'DOWN', Monitor, _, _, Reason}, + #data{static = #static{connection_monitor = Monitor, + dist_handle = Handle}} = StateData) when Handle =/= undefined -> + {next_state, death_row, StateData, + [{state_timeout, 5000, Reason}]}; +handle_common( + info, {'DOWN', Monitor, _, _, _}, + #data{static = #static{connection_monitor = Monitor}} = StateData) -> {stop, normal, StateData}; -handle_info(_,_,_) -> +handle_common(info, Msg, _) -> + Report = + io_lib:format("TLS sender: Got unexpected info: ~p ~n", [Msg]), + error_logger:info_report(Report), + keep_state_and_data; +handle_common(Type, Msg, _) -> + Report = + io_lib:format( + "TLS sender: Got unexpected event: ~p ~n", [{Type,Msg}]), + error_logger:error_report(Report), keep_state_and_data. -send_tls_alert(Alert, #data{negotiated_version = Version, - socket = Socket, - protocol_cb = Connection, - transport_cb = Transport, - connection_states = ConnectionStates0, - log_level = LogLevel} = StateData0) -> +send_tls_alert(#alert{} = Alert, + #data{static = #static{negotiated_version = Version, + socket = Socket, + transport_cb = Transport, + log_level = LogLevel}, + connection_states = ConnectionStates0} = StateData0) -> {BinMsg, ConnectionStates} = - Connection:encode_alert(Alert, Version, ConnectionStates0), - Connection:send(Transport, Socket, BinMsg), + tls_record:encode_alert_record(Alert, Version, ConnectionStates0), + tls_socket:send(Transport, Socket, BinMsg), ssl_logger:debug(LogLevel, outbound, 'tls_record', BinMsg), StateData0#data{connection_states = ConnectionStates}. send_application_data(Data, From, StateName, - #data{connection_pid = Pid, - socket = Socket, - dist_handle = DistHandle, - negotiated_version = Version, - protocol_cb = Connection, - transport_cb = Transport, - connection_states = ConnectionStates0, - renegotiate_at = RenegotiateAt, - log_level = LogLevel} = StateData0) -> + #data{static = #static{connection_pid = Pid, + socket = Socket, + dist_handle = DistHandle, + negotiated_version = Version, + transport_cb = Transport, + renegotiate_at = RenegotiateAt, + log_level = LogLevel}, + connection_states = ConnectionStates0} = StateData0) -> case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of true -> ssl_connection:internal_renegotiation(Pid, ConnectionStates0), {next_state, handshake, StateData0, [{next_event, internal, {application_packets, From, Data}}]}; false -> - {Msgs, ConnectionStates} = - Connection:encode_data( - iolist_to_binary(Data), Version, ConnectionStates0), + {Msgs, ConnectionStates} = tls_record:encode_data(Data, Version, ConnectionStates0), StateData = StateData0#data{connection_states = ConnectionStates}, - case Connection:send(Transport, Socket, Msgs) of + case tls_socket:send(Transport, Socket, Msgs) of ok when DistHandle =/= undefined -> ssl_logger:debug(LogLevel, outbound, 'tls_record', Msgs), {next_state, StateName, StateData, []}; @@ -427,9 +453,9 @@ send_application_data(Data, From, StateName, encode_packet(Packet, Data) -> Len = iolist_size(Data), case Packet of - 1 when Len < (1 bsl 8) -> [<<Len:8>>,Data]; - 2 when Len < (1 bsl 16) -> [<<Len:16>>,Data]; - 4 when Len < (1 bsl 32) -> [<<Len:32>>,Data]; + 1 when Len < (1 bsl 8) -> [<<Len:8>>|Data]; + 2 when Len < (1 bsl 16) -> [<<Len:16>>|Data]; + 4 when Len < (1 bsl 32) -> [<<Len:32>>|Data]; N when N =:= 1; N =:= 2; N =:= 4 -> {error, {badarg, {packet_to_large, Len, (1 bsl (Packet bsl 3)) - 1}}}; @@ -466,22 +492,30 @@ call(FsmPid, Event) -> {error, closed} end. -%%---------------Erlang distribution -------------------------------------- +%%-------------- Erlang distribution helpers ------------------------------ -dist_data(DHandle, Packet) -> +dist_data(DHandle) -> case erlang:dist_ctrl_get_data(DHandle) of none -> erlang:dist_ctrl_get_data_notification(DHandle), []; - Data -> - %% This is encode_packet(4, Data) without Len check - %% since the emulator will always deliver a Data - %% smaller than 4 GB, and the distribution will - %% therefore always have to use {packet,4} + %% This is encode_packet(4, Data) without Len check + %% since the emulator will always deliver a Data + %% smaller than 4 GB, and the distribution will + %% therefore always have to use {packet,4} + Data when is_binary(Data) -> + Len = byte_size(Data), + [[<<Len:32>>,Data]|dist_data(DHandle)]; + [BA,BB] = Data -> + Len = byte_size(BA) + byte_size(BB), + [[<<Len:32>>|Data]|dist_data(DHandle)]; + Data when is_list(Data) -> Len = iolist_size(Data), - [<<Len:32>>,Data|dist_data(DHandle, Packet)] + [[<<Len:32>>|Data]|dist_data(DHandle)] end. + +%% Empty the inbox from distribution ticks - do not let them accumulate consume_ticks() -> receive tick -> consume_ticks() diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 1ed1fdef4a..f109d85e49 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2018. All Rights Reserved. +%% Copyright Ericsson AB 2007-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -3568,7 +3568,7 @@ tls_dont_crash_on_handshake_garbage(Config) -> <<22, 3,3, 5:16, 92,64,37,228,209>> % garbage ]), % Send unexpected change_cipher_spec - ok = gen_tcp:send(Socket, <<20, 0,0,12, 111,40,244,7,137,224,16,109,197,110,249,152>>), + ok = gen_tcp:send(Socket, <<20, 3,3, 12:16, 111,40,244,7,137,224,16,109,197,110,249,152>>), % Ensure we receive an alert, not sudden disconnect {ok, <<21, _/binary>>} = drop_handshakes(Socket, 1000). diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl index 0b2011a627..35efa2b8a3 100644 --- a/lib/ssl/test/ssl_bench_SUITE.erl +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -41,6 +41,7 @@ end_per_group(_GroupName, _Config) -> ok. init_per_suite(Config) -> + ct:timetrap({minutes, 1}), case node() of nonode@nohost -> {skipped, "Node not distributed"}; @@ -163,7 +164,7 @@ do_test(Type, TC, Loop, ParallellConnections, Server) -> end end, Spawn = fun(Id) -> - Pid = spawn(fun() -> Test(Id) end), + Pid = spawn_link(fun() -> Test(Id) end), receive {Pid, init} -> Pid end end, Pids = [Spawn(Id) || Id <- lists:seq(ParallellConnections, 1, -1)], @@ -180,42 +181,42 @@ do_test(Type, TC, Loop, ParallellConnections, Server) -> {ok, TestPerSecond}. server_init(ssl, setup_connection, _, _, Server) -> - {ok, Socket} = ssl:listen(0, ssl_opts(listen)), - {ok, {_Host, Port}} = ssl:sockname(Socket), + {ok, LSocket} = ssl:listen(0, ssl_opts(listen)), + {ok, {_Host, Port}} = ssl:sockname(LSocket), {ok, Host} = inet:gethostname(), ?FPROF_SERVER andalso start_profile(fprof, [whereis(ssl_manager), new]), %%?EPROF_SERVER andalso start_profile(eprof, [ssl_connection_sup, ssl_manager]), ?EPROF_SERVER andalso start_profile(eprof, [ssl_manager]), Server ! {self(), {init, Host, Port}}, Test = fun(TSocket) -> - ok = ssl:ssl_accept(TSocket), - ssl:close(TSocket) + {ok, Socket} = ssl:handshake(TSocket), + ssl:close(Socket) end, - setup_server_connection(Socket, Test); + setup_server_connection(LSocket, Test); server_init(ssl, payload, Loop, _, Server) -> - {ok, Socket} = ssl:listen(0, ssl_opts(listen)), - {ok, {_Host, Port}} = ssl:sockname(Socket), + {ok, LSocket} = ssl:listen(0, ssl_opts(listen)), + {ok, {_Host, Port}} = ssl:sockname(LSocket), {ok, Host} = inet:gethostname(), Server ! {self(), {init, Host, Port}}, Test = fun(TSocket) -> - ok = ssl:ssl_accept(TSocket), + {ok, Socket} = ssl:handshake(TSocket), Size = byte_size(msg()), - server_echo(TSocket, Size, Loop), - ssl:close(TSocket) + server_echo(Socket, Size, Loop), + ssl:close(Socket) end, - setup_server_connection(Socket, Test); + setup_server_connection(LSocket, Test); server_init(ssl, pem_cache, Loop, _, Server) -> - {ok, Socket} = ssl:listen(0, ssl_opts(listen_der)), - {ok, {_Host, Port}} = ssl:sockname(Socket), + {ok, LSocket} = ssl:listen(0, ssl_opts(listen_der)), + {ok, {_Host, Port}} = ssl:sockname(LSocket), {ok, Host} = inet:gethostname(), Server ! {self(), {init, Host, Port}}, Test = fun(TSocket) -> - ok = ssl:ssl_accept(TSocket), + {ok, Socket} = ssl:handshake(TSocket), Size = byte_size(msg()), - server_echo(TSocket, Size, Loop), - ssl:close(TSocket) + server_echo(Socket, Size, Loop), + ssl:close(Socket) end, - setup_server_connection(Socket, Test); + setup_server_connection(LSocket, Test); server_init(Type, Tc, _, _, Server) -> io:format("No server init code for ~p ~p~n",[Type, Tc]), diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl index d9d9c4e473..7e7de5c9bf 100644 --- a/lib/ssl/test/ssl_dist_bench_SUITE.erl +++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl @@ -1,7 +1,7 @@ %%%------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017-2018. All Rights Reserved. +%% Copyright Ericsson AB 2017-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,7 +43,7 @@ throughput_1048576/1]). %% Debug --export([payload/1]). +-export([payload/1, roundtrip_runner/3, setup_runner/3, throughput_runner/4]). %%%------------------------------------------------------------------- @@ -504,17 +504,19 @@ throughput(A, B, Prefix, HA, HB, Packets, Size) -> [] = ssl_apply(HA, erlang, nodes, []), [] = ssl_apply(HB, erlang, nodes, []), #{time := Time, - dist_stats := DistStats, + client_dist_stats := ClientDistStats, client_msacc_stats := ClientMsaccStats, client_prof := ClientProf, server_msacc_stats := ServerMsaccStats, - server_prof := ServerProf} = + server_prof := ServerProf, + server_gc_before := Server_GC_Before, + server_gc_after := Server_GC_After} = ssl_apply(HA, fun () -> throughput_runner(A, B, Packets, Size) end), [B] = ssl_apply(HA, erlang, nodes, []), [A] = ssl_apply(HB, erlang, nodes, []), ClientMsaccStats =:= undefined orelse msacc:print(ClientMsaccStats), - io:format("DistStats: ~p~n", [DistStats]), + io:format("ClientDistStats: ~p~n", [ClientDistStats]), Overhead = 50 % Distribution protocol headers (empirical) (TLS+=54) + byte_size(erlang:term_to_binary([0|<<>>])), % Benchmark overhead @@ -533,6 +535,8 @@ throughput(A, B, Prefix, HA, HB, Packets, Size) -> end, io:format("******* ClientProf:~n", []), prof_print(ClientProf), io:format("******* ServerProf:~n", []), prof_print(ServerProf), + io:format("******* Server GC Before:~n~p~n", [Server_GC_Before]), + io:format("******* Server GC After:~n~p~n", [Server_GC_After]), Speed = round((Bytes * 1000000) / (1024 * Time)), report(Prefix++" Throughput_"++integer_to_list(Size), Speed, "kB/s"). @@ -554,10 +558,10 @@ throughput_runner(A, B, Rounds, Size) -> ok end, prof_start(), - {Time,ServerMsaccStats,ServerProf} = + #{time := Time} = Result = throughput_client(ServerPid, ServerMon, Payload, Rounds), prof_stop(), - ClientMsaccStats = + MsaccStats = case msacc:available() of true -> MStats = msacc:stats(), @@ -566,15 +570,13 @@ throughput_runner(A, B, Rounds, Size) -> false -> undefined end, - ClientProf = prof_end(), + Prof = prof_end(), [{_Node,Socket}] = dig_dist_node_sockets(), DistStats = inet:getstat(Socket), - #{time => microseconds(Time), - dist_stats => DistStats, - client_msacc_stats => ClientMsaccStats, - client_prof => ClientProf, - server_msacc_stats => ServerMsaccStats, - server_prof => ServerProf}. + Result#{time := microseconds(Time), + client_dist_stats => DistStats, + client_msacc_stats => MsaccStats, + client_prof => Prof}. dig_dist_node_sockets() -> [case DistCtrl of @@ -597,6 +599,9 @@ dig_dist_node_sockets() -> throughput_server(Pid, N) -> + GC_Before = get_server_gc_info(), + %% dbg:tracer(port, dbg:trace_port(file, "throughput_server_gc.log")), + %% dbg:p(TLSDistReceiver, garbage_collection), msacc:available() andalso begin msacc:stop(), @@ -605,9 +610,9 @@ throughput_server(Pid, N) -> ok end, prof_start(), - throughput_server_loop(Pid, N). + throughput_server_loop(Pid, GC_Before, N). -throughput_server_loop(_Pid, 0) -> +throughput_server_loop(_Pid, GC_Before, 0) -> prof_stop(), MsaccStats = case msacc:available() of @@ -620,11 +625,26 @@ throughput_server_loop(_Pid, 0) -> undefined end, Prof = prof_end(), - exit({ok,MsaccStats,Prof}); -throughput_server_loop(Pid, N) -> + %% dbg:flush_trace_port(), + exit(#{server_msacc_stats => MsaccStats, + server_prof => Prof, + server_gc_before => GC_Before, + server_gc_after => get_server_gc_info()}); +throughput_server_loop(Pid, GC_Before, N) -> receive {Pid, N, _} -> - throughput_server_loop(Pid, N-1) + throughput_server_loop(Pid, GC_Before, N-1) + end. + +get_server_gc_info() -> + case whereis(ssl_connection_sup_dist) of + undefined -> + undefined; + SupPid -> + [{_Id,TLSDistReceiver,_Type,_Modules}|_] = + supervisor:which_children(SupPid), + erlang:process_info( + TLSDistReceiver, [garbage_collection,garbage_collection_info]) end. throughput_client(Pid, Mon, Payload, N) -> @@ -632,8 +652,8 @@ throughput_client(Pid, Mon, Payload, N) -> throughput_client_loop(_Pid, Mon, _Payload, 0, StartTime) -> receive - {'DOWN', Mon, _, _, {ok,MsaccStats,Prof}} -> - {elapsed_time(StartTime),MsaccStats,Prof}; + {'DOWN', Mon, _, _, #{} = Result} -> + Result#{time => elapsed_time(StartTime)}; {'DOWN', Mon, _, _, Other} -> exit(Other) end; @@ -651,6 +671,7 @@ prof_start() -> ok. -elif(?prof =:= eprof). prof_start() -> + catch eprof:stop(), {ok,_} = eprof:start(), profiling = eprof:start_profiling(processes()), ok. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index dd302a2880..ada3ff5de3 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -697,6 +697,8 @@ fun_info(Extra) -> %% BITS: +bit_grp([], _Opts) -> + leaf("<<>>"); bit_grp(Fs, Opts) -> append([['<<'], [bit_elems(Fs, Opts)], ['>>']]). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index dda8d0a12e..f5d80e7e68 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2018. All Rights Reserved. +%% Copyright Ericsson AB 2006-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,7 +51,7 @@ otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1, pr_1014/1, - otp_13662/1, otp_14285/1]). + otp_13662/1, otp_14285/1, otp_15592/1]). %% Internal export. -export([ehook/6]). @@ -81,7 +81,7 @@ groups() -> [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, otp_10302, otp_10820, otp_11100, otp_11861, pr_1014, otp_13662, - otp_14285]}]. + otp_14285, otp_15592]}]. init_per_suite(Config) -> Config. @@ -1167,6 +1167,11 @@ otp_14285(_Config) -> [{encoding,latin1}])), ok. +otp_15592(_Config) -> + ok = pp_expr(<<"long12345678901234567890123456789012345678901234" + "56789012345678901234:f(<<>>)">>), + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> @@ -1018,7 +1018,7 @@ do_debuginfo_win32 () fi BINDIR="$ERL_TOP/bin/$TARGET" EVSN=`grep '^VSN' erts/vsn.mk | sed 's,^VSN.*=[^0-9]*\([0-9].*\)$,@\1,g;s,^[^@].*,,g;s,^@,,g'` - for f in beam.debug.dll beam.debug.smp.dll beam.pdb beam.smp.pdb erl.pdb werl.pdb erlexec.pdb; do + for f in beam.debug.smp.dll beam.smp.pdb erl.pdb werl.pdb erlexec.pdb; do if [ -f $BINDIR/$f ]; then rm -f $RELDIR/erts-$EVSN/bin/$f cp $BINDIR/$f $RELDIR/erts-$EVSN/bin/$f |