diff options
379 files changed, 5438 insertions, 2563 deletions
diff --git a/.travis.yml b/.travis.yml index 42151a16d2..baa55b383d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -29,7 +29,7 @@ before_script: - kerl_deactivate script: - - ./otp_build all -a + - ./scripts/build-otp after_success: - $ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools wx xmerl --statistics diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differindex 2388ccad80..8028b5995c 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 8169505d78..453a05f1e7 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 f7dfd8d707..4411551695 100644 --- a/bootstrap/lib/compiler/ebin/beam_block.beam +++ b/bootstrap/lib/compiler/ebin/beam_block.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam Binary files differindex 6105ef85ca..097bf79ce2 100644 --- a/bootstrap/lib/compiler/ebin/beam_bs.beam +++ b/bootstrap/lib/compiler/ebin/beam_bs.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex acba331476..c015d425d7 100644 --- a/bootstrap/lib/compiler/ebin/beam_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex 3d0d5112f8..1ea7be1a2b 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam Binary files differindex febe5c1e5f..70dec1ccd6 100644 --- a/bootstrap/lib/compiler/ebin/beam_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam Binary files differindex 3428b2872e..1235ff6a13 100644 --- a/bootstrap/lib/compiler/ebin/beam_dict.beam +++ b/bootstrap/lib/compiler/ebin/beam_dict.beam diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex 56c0a7c05f..3c587d6c7e 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 361d41017c..56cb83b3cb 100644 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ b/bootstrap/lib/compiler/ebin/beam_except.beam diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex f6fc8dfc50..0ab7f55bdd 100644 --- a/bootstrap/lib/compiler/ebin/beam_flatten.beam +++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex fa1d85ad04..67c82ddc76 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_listing.beam b/bootstrap/lib/compiler/ebin/beam_listing.beam Binary files differindex b80561b4dd..9512391666 100644 --- a/bootstrap/lib/compiler/ebin/beam_listing.beam +++ b/bootstrap/lib/compiler/ebin/beam_listing.beam diff --git a/bootstrap/lib/compiler/ebin/beam_opcodes.beam b/bootstrap/lib/compiler/ebin/beam_opcodes.beam Binary files differindex eaf39a378e..4f20b1eac5 100644 --- a/bootstrap/lib/compiler/ebin/beam_opcodes.beam +++ b/bootstrap/lib/compiler/ebin/beam_opcodes.beam diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam Binary files differindex 2a2b8d38f5..36c20ba82b 100644 --- a/bootstrap/lib/compiler/ebin/beam_peep.beam +++ b/bootstrap/lib/compiler/ebin/beam_peep.beam diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam Binary files differindex bf80745ffe..aba03a9f9c 100644 --- a/bootstrap/lib/compiler/ebin/beam_receive.beam +++ b/bootstrap/lib/compiler/ebin/beam_receive.beam diff --git a/bootstrap/lib/compiler/ebin/beam_reorder.beam b/bootstrap/lib/compiler/ebin/beam_reorder.beam Binary files differindex 45d1dcfa2f..71e1b5f041 100644 --- a/bootstrap/lib/compiler/ebin/beam_reorder.beam +++ b/bootstrap/lib/compiler/ebin/beam_reorder.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex 524e9a3078..d9fcdb32bc 100644 --- a/bootstrap/lib/compiler/ebin/beam_split.beam +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex 4d3b79a148..42b7c88aab 100644 --- a/bootstrap/lib/compiler/ebin/beam_trim.beam +++ b/bootstrap/lib/compiler/ebin/beam_trim.beam diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam Binary files differindex b4066184e3..4699f7ec05 100644 --- a/bootstrap/lib/compiler/ebin/beam_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex faa140278b..70ad9110ac 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 04ecddd284..533815dc45 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam Binary files differindex 11ddf0e062..1bc8b9f61d 100644 --- a/bootstrap/lib/compiler/ebin/beam_z.beam +++ b/bootstrap/lib/compiler/ebin/beam_z.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 24c039780a..d303959897 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_clauses.beam b/bootstrap/lib/compiler/ebin/cerl_clauses.beam Binary files differindex cc4e3a92a3..883a3620e6 100644 --- a/bootstrap/lib/compiler/ebin/cerl_clauses.beam +++ b/bootstrap/lib/compiler/ebin/cerl_clauses.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex 038dd583dc..f517ec59e9 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_sets.beam b/bootstrap/lib/compiler/ebin/cerl_sets.beam Binary files differindex 20cf324b41..c527517045 100644 --- a/bootstrap/lib/compiler/ebin/cerl_sets.beam +++ b/bootstrap/lib/compiler/ebin/cerl_sets.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex 49fe0727a8..478cf25063 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 9837ed458b..da7cddd86d 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam Binary files differindex 32b770c186..3453dd5963 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 4c037ee7b0..77d8a225ed 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex c85f2ec140..c1cd8f361b 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex 64efd99314..3ee1ae2bd0 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/core_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam Binary files differindex e0837207b9..e6669d61d7 100644 --- a/bootstrap/lib/compiler/ebin/core_scan.beam +++ b/bootstrap/lib/compiler/ebin/core_scan.beam diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex f96a9698c4..4cf2c89551 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam Binary files differindex 33b0722b1f..c3dfe82f1d 100644 --- a/bootstrap/lib/compiler/ebin/rec_env.beam +++ b/bootstrap/lib/compiler/ebin/rec_env.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam Binary files differindex 3d800738c9..8e25d50dd5 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex cd8fd5ac05..14084876a9 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam Binary files differindex 20cd2af6bc..8478b64381 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam Binary files differindex 821eb13469..d048275a0c 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 eed59b6cfa..04846fc120 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 1db120e00e..7c21ab7bc0 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 1cc1a7e5dc..c43c3a50b6 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 e8c0466ddc..5e7afacf83 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 7995c58cac..3ee6e0139c 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam diff --git a/bootstrap/lib/compiler/ebin/v3_life.beam b/bootstrap/lib/compiler/ebin/v3_life.beam Binary files differindex fb35981da8..1ed5e170f9 100644 --- a/bootstrap/lib/compiler/ebin/v3_life.beam +++ b/bootstrap/lib/compiler/ebin/v3_life.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex ac01acad27..64c46b9c2f 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex ebe2044b6f..efabd7f5f3 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 a9bc35fb04..c8578b5014 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/application_starter.beam b/bootstrap/lib/kernel/ebin/application_starter.beam Binary files differindex 043e15fb2a..0594611321 100644 --- a/bootstrap/lib/kernel/ebin/application_starter.beam +++ b/bootstrap/lib/kernel/ebin/application_starter.beam diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam Binary files differindex 1ccad1a5a3..4d5c2339d6 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 bb9ca635c4..0ebd85824c 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 c697a6574e..1689c53eb5 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 12953c28d1..e2b2711767 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 f36399a927..a9f6d9b33a 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 70cb4e7eaa..5a49a580e4 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_server.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_sup.beam b/bootstrap/lib/kernel/ebin/disk_log_sup.beam Binary files differindex 4e68c9af84..d76d4753d8 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_sup.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_sup.beam diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam Binary files differindex fed7ee342f..e6b445845a 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 37c844ec9b..6a9ca84c03 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 20c41fd06e..7a9a98a4b1 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 0a644d2e38..4530aa1d80 100644 --- a/bootstrap/lib/kernel/ebin/erl_ddll.beam +++ b/bootstrap/lib/kernel/ebin/erl_ddll.beam diff --git a/bootstrap/lib/kernel/ebin/erl_distribution.beam b/bootstrap/lib/kernel/ebin/erl_distribution.beam Binary files differindex 223cda0e59..f345e4ac50 100644 --- a/bootstrap/lib/kernel/ebin/erl_distribution.beam +++ b/bootstrap/lib/kernel/ebin/erl_distribution.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex 6da0de6b17..51e9cc54b2 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/erl_reply.beam b/bootstrap/lib/kernel/ebin/erl_reply.beam Binary files differindex 6cf7d9e196..604f9d836e 100644 --- a/bootstrap/lib/kernel/ebin/erl_reply.beam +++ b/bootstrap/lib/kernel/ebin/erl_reply.beam diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam Binary files differindex c485b61a87..1c29d27c28 100644 --- a/bootstrap/lib/kernel/ebin/error_handler.beam +++ b/bootstrap/lib/kernel/ebin/error_handler.beam diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam Binary files differindex 73ab813430..01152d695f 100644 --- a/bootstrap/lib/kernel/ebin/error_logger.beam +++ b/bootstrap/lib/kernel/ebin/error_logger.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex 8a4241c25f..ce9e73e77a 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex 75c94f8a9f..f0d1068661 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 23da3a7982..d66f0902df 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 5512a8c307..789bfefab4 100644 --- a/bootstrap/lib/kernel/ebin/file_server.beam +++ b/bootstrap/lib/kernel/ebin/file_server.beam diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam Binary files differindex c98d25a3d0..a0e0abec20 100644 --- a/bootstrap/lib/kernel/ebin/gen_sctp.beam +++ b/bootstrap/lib/kernel/ebin/gen_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/gen_tcp.beam b/bootstrap/lib/kernel/ebin/gen_tcp.beam Binary files differindex cf4757a568..edcc1caaa4 100644 --- a/bootstrap/lib/kernel/ebin/gen_tcp.beam +++ b/bootstrap/lib/kernel/ebin/gen_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/gen_udp.beam b/bootstrap/lib/kernel/ebin/gen_udp.beam Binary files differindex fec430304e..9683584619 100644 --- a/bootstrap/lib/kernel/ebin/gen_udp.beam +++ b/bootstrap/lib/kernel/ebin/gen_udp.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex 09ac326ecb..e072de72d0 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 778972ea34..5b658e8551 100644 --- a/bootstrap/lib/kernel/ebin/global_group.beam +++ b/bootstrap/lib/kernel/ebin/global_group.beam diff --git a/bootstrap/lib/kernel/ebin/global_search.beam b/bootstrap/lib/kernel/ebin/global_search.beam Binary files differindex 0d6f105e5f..100e6f26bb 100644 --- a/bootstrap/lib/kernel/ebin/global_search.beam +++ b/bootstrap/lib/kernel/ebin/global_search.beam diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam Binary files differindex b424be4aa2..acf83775d6 100644 --- a/bootstrap/lib/kernel/ebin/group.beam +++ b/bootstrap/lib/kernel/ebin/group.beam diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam Binary files differindex b5bb0806c8..a1e87ddb2f 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 078a0ffc9e..28e12a6e55 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 c4554c1f35..ab71326102 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_sctp.beam b/bootstrap/lib/kernel/ebin/inet6_sctp.beam Binary files differindex c3aac09fbe..dedea4a2ea 100644 --- a/bootstrap/lib/kernel/ebin/inet6_sctp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam Binary files differindex a2ee6cd916..be31bc3a90 100644 --- a/bootstrap/lib/kernel/ebin/inet6_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam Binary files differindex 98f70db13c..1202b4ee82 100644 --- a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam +++ b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_udp.beam b/bootstrap/lib/kernel/ebin/inet6_udp.beam Binary files differindex c15d0da74a..7298aab9fe 100644 --- a/bootstrap/lib/kernel/ebin/inet6_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_udp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam Binary files differindex 32fb3b0092..b66b7920c7 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 1ffa8865ab..7a2f273605 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 d301809146..aeff67c5b0 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 71f42e52c5..07717206ba 100644 --- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam +++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam diff --git a/bootstrap/lib/kernel/ebin/inet_hosts.beam b/bootstrap/lib/kernel/ebin/inet_hosts.beam Binary files differindex 958588c385..e4281b00f9 100644 --- a/bootstrap/lib/kernel/ebin/inet_hosts.beam +++ b/bootstrap/lib/kernel/ebin/inet_hosts.beam diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam Binary files differindex 2f941fff9e..bca8d67c09 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 58c73842db..d6f6e87d9f 100644 --- a/bootstrap/lib/kernel/ebin/inet_res.beam +++ b/bootstrap/lib/kernel/ebin/inet_res.beam diff --git a/bootstrap/lib/kernel/ebin/inet_sctp.beam b/bootstrap/lib/kernel/ebin/inet_sctp.beam Binary files differindex 153f7b389e..167e3ea052 100644 --- a/bootstrap/lib/kernel/ebin/inet_sctp.beam +++ b/bootstrap/lib/kernel/ebin/inet_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam Binary files differindex 4d23e1e876..57c3da4507 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 41dd317f5d..ad648eb252 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 aa2e0d4326..30db8238b9 100644 --- a/bootstrap/lib/kernel/ebin/inet_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet_udp.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex 9fd407c287..b673862981 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 5e59fc2f82..bb2372d5c0 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 3c1de4fab9..32e87edb26 100644 --- a/bootstrap/lib/kernel/ebin/local_tcp.beam +++ b/bootstrap/lib/kernel/ebin/local_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/local_udp.beam b/bootstrap/lib/kernel/ebin/local_udp.beam Binary files differindex 44a4bee902..219d020299 100644 --- a/bootstrap/lib/kernel/ebin/local_udp.beam +++ b/bootstrap/lib/kernel/ebin/local_udp.beam diff --git a/bootstrap/lib/kernel/ebin/net.beam b/bootstrap/lib/kernel/ebin/net.beam Binary files differindex ae7db397e1..606efbc494 100644 --- a/bootstrap/lib/kernel/ebin/net.beam +++ b/bootstrap/lib/kernel/ebin/net.beam diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam Binary files differindex 60f51602b3..36210655fd 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 981eb737db..db32c6c2d7 100644 --- a/bootstrap/lib/kernel/ebin/net_kernel.beam +++ b/bootstrap/lib/kernel/ebin/net_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam Binary files differindex f5f81c5838..d2d140c67f 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex d1fd670bb2..4c37653685 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam Binary files differindex 92ad2aecca..46f84b9af2 100644 --- a/bootstrap/lib/kernel/ebin/ram_file.beam +++ b/bootstrap/lib/kernel/ebin/ram_file.beam diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam Binary files differindex 313d83ecaa..9c14d8e02f 100644 --- a/bootstrap/lib/kernel/ebin/rpc.beam +++ b/bootstrap/lib/kernel/ebin/rpc.beam diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam Binary files differindex 0155810ca7..c6520409cb 100644 --- a/bootstrap/lib/kernel/ebin/seq_trace.beam +++ b/bootstrap/lib/kernel/ebin/seq_trace.beam diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam Binary files differindex c6392c17ad..b62a55b274 100644 --- a/bootstrap/lib/kernel/ebin/standard_error.beam +++ b/bootstrap/lib/kernel/ebin/standard_error.beam diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam Binary files differindex a78e0e9c6e..8e37d1131b 100644 --- a/bootstrap/lib/kernel/ebin/user.beam +++ b/bootstrap/lib/kernel/ebin/user.beam diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam Binary files differindex aeb69e8fa3..91f4313fac 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/kernel/ebin/user_sup.beam b/bootstrap/lib/kernel/ebin/user_sup.beam Binary files differindex 9e7b95544d..09f05a98ac 100644 --- a/bootstrap/lib/kernel/ebin/user_sup.beam +++ b/bootstrap/lib/kernel/ebin/user_sup.beam diff --git a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam Binary files differindex 93f1f1ba72..29694c2437 100644 --- a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam +++ b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex d3fa6db97b..570f1fb7f6 100644 --- a/bootstrap/lib/stdlib/ebin/array.beam +++ b/bootstrap/lib/stdlib/ebin/array.beam diff --git a/bootstrap/lib/stdlib/ebin/base64.beam b/bootstrap/lib/stdlib/ebin/base64.beam Binary files differindex ad725f61b9..38d738fb4a 100644 --- a/bootstrap/lib/stdlib/ebin/base64.beam +++ b/bootstrap/lib/stdlib/ebin/base64.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex a33e062d47..1dada1d9b6 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/binary.beam b/bootstrap/lib/stdlib/ebin/binary.beam Binary files differindex ff9022388e..909cadf9ea 100644 --- a/bootstrap/lib/stdlib/ebin/binary.beam +++ b/bootstrap/lib/stdlib/ebin/binary.beam diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex 481783bcd7..85faf980ed 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 9bb16e070f..dbd5ec957d 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 bda7aba167..75baaa543d 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 195c2bcc2f..0fa002bd15 100644 --- a/bootstrap/lib/stdlib/ebin/dets_server.beam +++ b/bootstrap/lib/stdlib/ebin/dets_server.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_sup.beam b/bootstrap/lib/stdlib/ebin/dets_sup.beam Binary files differindex 35b8c8a799..9b75387892 100644 --- a/bootstrap/lib/stdlib/ebin/dets_sup.beam +++ b/bootstrap/lib/stdlib/ebin/dets_sup.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex 81158b25b2..e58fa432de 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 28997da899..23b5b5d321 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 a4e8f674f0..2394a5dad2 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 0bb6b7590a..6cba675635 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 0b60dd595b..1a7151beb9 100644 --- a/bootstrap/lib/stdlib/ebin/digraph_utils.beam +++ b/bootstrap/lib/stdlib/ebin/digraph_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam Binary files differindex 459a98c959..dd6ee8ccc2 100644 --- a/bootstrap/lib/stdlib/ebin/edlin.beam +++ b/bootstrap/lib/stdlib/ebin/edlin.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam Binary files differindex b709f7db82..747403ff8a 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 ae569ce9f8..d4eed5218b 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 bb1bdeaf94..baef5c0c95 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 a5aec9de8b..f95fadc7fb 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 b2fd9572ef..9466739f29 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 eff463adc0..b15305abf3 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 5e5bff219c..515e529a6b 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex dc52205d63..b35ddeeb25 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 4959f0d040..38f0d5da7a 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 9f241899e0..cb1e3fad72 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam b/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam Binary files differindex 48f3d58dbb..bfe55b571f 100644 --- a/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam +++ b/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 9ebc1505f4..d6314819ca 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 0e32572156..29f14b5686 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 6dcc4fd3b2..7c6c6dbd84 100644 --- a/bootstrap/lib/stdlib/ebin/erl_tar.beam +++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam Binary files differindex 181e44b3be..25a7810e08 100644 --- a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam +++ b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam Binary files differindex a2a92d2960..d5b73fbdb4 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 2d04bab10c..01db5e3161 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 291b988002..e66749048d 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam Binary files differindex f7db5adc3e..db56adf05a 100644 --- a/bootstrap/lib/stdlib/ebin/eval_bits.beam +++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex 5e6d9fd2ac..f63f3a2dab 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 996df071cf..031f5945ce 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 ea960fa1ab..e3b570b42e 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_sets.beam b/bootstrap/lib/stdlib/ebin/gb_sets.beam Binary files differindex 0c9c70a4d5..fa333fb0e7 100644 --- a/bootstrap/lib/stdlib/ebin/gb_sets.beam +++ b/bootstrap/lib/stdlib/ebin/gb_sets.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_trees.beam b/bootstrap/lib/stdlib/ebin/gb_trees.beam Binary files differindex a2627402ae..b9cb66e3ef 100644 --- a/bootstrap/lib/stdlib/ebin/gb_trees.beam +++ b/bootstrap/lib/stdlib/ebin/gb_trees.beam diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam Binary files differindex 82b820af23..2f7b6afd36 100644 --- a/bootstrap/lib/stdlib/ebin/gen.beam +++ b/bootstrap/lib/stdlib/ebin/gen.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 80db66b438..6446caa3b6 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex 1b8d1a9bdc..6caed29dd8 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex 665810bd7a..015a708bf6 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam Binary files differindex b2aed7e7ac..9bbb4bfa7f 100644 --- a/bootstrap/lib/stdlib/ebin/gen_statem.beam +++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam Binary files differindex 283c912800..15f6160cd4 100644 --- a/bootstrap/lib/stdlib/ebin/io.beam +++ b/bootstrap/lib/stdlib/ebin/io.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam Binary files differindex 9378972324..73936df34f 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex 7877d2c73a..ead12e3e14 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam Binary files differindex d0e9f703a5..3d1a6ad10c 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex 04f0b9aa78..2fe9240a97 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/lib.beam b/bootstrap/lib/stdlib/ebin/lib.beam Binary files differindex 3ceba627be..c84b4cc4ae 100644 --- a/bootstrap/lib/stdlib/ebin/lib.beam +++ b/bootstrap/lib/stdlib/ebin/lib.beam diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam Binary files differindex 22705c8a9a..c6f67c47f6 100644 --- a/bootstrap/lib/stdlib/ebin/lists.beam +++ b/bootstrap/lib/stdlib/ebin/lists.beam diff --git a/bootstrap/lib/stdlib/ebin/log_mf_h.beam b/bootstrap/lib/stdlib/ebin/log_mf_h.beam Binary files differindex 6de9494e84..a33703469d 100644 --- a/bootstrap/lib/stdlib/ebin/log_mf_h.beam +++ b/bootstrap/lib/stdlib/ebin/log_mf_h.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differindex 5f041ab10f..868bdb1367 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/math.beam b/bootstrap/lib/stdlib/ebin/math.beam Binary files differindex a155482a64..07ecabcca2 100644 --- a/bootstrap/lib/stdlib/ebin/math.beam +++ b/bootstrap/lib/stdlib/ebin/math.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex 203ef5ba23..c67e80772c 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/orddict.beam b/bootstrap/lib/stdlib/ebin/orddict.beam Binary files differindex 4624d2139a..1f2013a4e3 100644 --- a/bootstrap/lib/stdlib/ebin/orddict.beam +++ b/bootstrap/lib/stdlib/ebin/orddict.beam diff --git a/bootstrap/lib/stdlib/ebin/ordsets.beam b/bootstrap/lib/stdlib/ebin/ordsets.beam Binary files differindex 6228f1b5d6..7d3067de0b 100644 --- a/bootstrap/lib/stdlib/ebin/ordsets.beam +++ b/bootstrap/lib/stdlib/ebin/ordsets.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 9e9a25c5bb..2efeea996a 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam Binary files differindex cc6e536ccd..da60598778 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 dc2ccd4937..7b2bcf3f61 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/proplists.beam b/bootstrap/lib/stdlib/ebin/proplists.beam Binary files differindex b54b757d39..3e543e9b23 100644 --- a/bootstrap/lib/stdlib/ebin/proplists.beam +++ b/bootstrap/lib/stdlib/ebin/proplists.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 27284851d1..2269812b08 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 865f549ac9..2ef0e276e3 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 830a9ebb53..0e4101ceb4 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 c99b8d7bc1..b12ae5be99 100644 --- a/bootstrap/lib/stdlib/ebin/rand.beam +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam Binary files differindex fc351a800a..2371a8be4b 100644 --- a/bootstrap/lib/stdlib/ebin/random.beam +++ b/bootstrap/lib/stdlib/ebin/random.beam diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam Binary files differindex 23c6a70894..307f025736 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 ef6e70298d..2681abe656 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 00164c704e..4b924e45e4 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/shell_default.beam b/bootstrap/lib/stdlib/ebin/shell_default.beam Binary files differindex a53a8fa5d2..9620769917 100644 --- a/bootstrap/lib/stdlib/ebin/shell_default.beam +++ b/bootstrap/lib/stdlib/ebin/shell_default.beam diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam Binary files differindex ae3d2d2f1f..e2534ef90b 100644 --- a/bootstrap/lib/stdlib/ebin/slave.beam +++ b/bootstrap/lib/stdlib/ebin/slave.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex 2122a5cd3b..4f39b6e415 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam Binary files differindex 940462e918..bd34b03dc1 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 24495b464e..97f56d5dfc 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 f52d5c407b..9b0affac34 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex 2d044f637c..026ec29608 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/bootstrap/lib/stdlib/ebin/timer.beam b/bootstrap/lib/stdlib/ebin/timer.beam Binary files differindex b5d68fd677..c3fd17d26c 100644 --- a/bootstrap/lib/stdlib/ebin/timer.beam +++ b/bootstrap/lib/stdlib/ebin/timer.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam Binary files differindex d0b805202e..92f9227ee1 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/bootstrap/lib/stdlib/ebin/win32reg.beam b/bootstrap/lib/stdlib/ebin/win32reg.beam Binary files differindex 2b4f9229ea..ef7ce01733 100644 --- a/bootstrap/lib/stdlib/ebin/win32reg.beam +++ b/bootstrap/lib/stdlib/ebin/win32reg.beam diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam Binary files differindex 7d7ad5e3b3..792eebcbd2 100644 --- a/bootstrap/lib/stdlib/ebin/zip.beam +++ b/bootstrap/lib/stdlib/ebin/zip.beam diff --git a/erts/configure.in b/erts/configure.in index e1233cee59..1c4a3e90ef 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1911,7 +1911,25 @@ case X$erl_xcomp_bigendian in *) AC_MSG_ERROR([Bad erl_xcomp_bigendian value: $erl_xcomp_bigendian]);; esac -AC_C_BIGENDIAN +AC_C_BIGENDIAN( + [ + AC_DEFINE([WORDS_BIGENDIAN], [1], [Define if big-endian]) + AC_DEFINE([ERTS_ENDIANNESS], [1], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]) + ], + [ + AC_DEFINE([ERTS_ENDIANNESS], [-1], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]) + ], + [ + case "$erl_xcomp_bigendian" in + yes) + AC_DEFINE([ERTS_ENDIANNESS], [1], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]);; + no) + AC_DEFINE([ERTS_ENDIANNESS], [-1], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]);; + *) + AC_DEFINE([ERTS_ENDIANNESS], [0], [Define > 0 if big-endian < 0 if little-endian, or 0 if unknown]);; + esac + ]) + AC_C_DOUBLE_MIDDLE_ENDIAN dnl fdatasync syscall (Unix only) diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index d8bf45c523..7fbe97bc0b 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -1103,8 +1103,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <marker id="driver_binary_dec_refc"></marker> <p>Decrements the reference count on <c>bin</c> and returns the reference count reached after the decrement.</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> <note> <p>The reference count of driver binary is normally to be decremented by calling <seealso marker="#driver_free_binary"> @@ -1124,8 +1123,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <desc> <marker id="driver_binary_get_refc"></marker> <p>Returns the current reference count on <c>bin</c>.</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> </desc> </func> @@ -1137,8 +1135,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <marker id="driver_binary_inc_refc"></marker> <p>Increments the reference count on <c>bin</c> and returns the reference count reached after the increment.</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> </desc> </func> @@ -1434,8 +1431,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <seealso marker="#driver_alloc_binary"> <c>driver_alloc_binary</c></seealso>. As binaries in Erlang are reference counted, the binary can still be around.</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> </desc> </func> @@ -1872,8 +1868,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <p>Resizes a driver binary, while keeping the data.</p> <p>Returns the resized driver binary on success. Returns <c>NULL</c> on failure (out of memory).</p> - <p>This function is only thread-safe when the emulator with SMP - support is used.</p> + <p>This function is thread-safe.</p> </desc> </func> diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml index 4f799f8f34..a436a9ca74 100644 --- a/erts/doc/src/erl_ext_dist.xml +++ b/erts/doc/src/erl_ext_dist.xml @@ -119,16 +119,11 @@ <tcaption>Compressed Data Format when Expanded</tcaption></table> <marker id="utf8_atoms"/> <note> - <p>As from ERTS 5.10 (OTP R16) support - for UTF-8 encoded atoms has been introduced in the external format. - However, only characters that can be encoded using Latin-1 (ISO-8859-1) - are currently supported in atoms. The support for UTF-8 encoded atoms - in the external format has been implemented to be able to support - all Unicode characters in atoms in <em>some future release</em>. - Until full Unicode support for atoms has been introduced, - it is an <em>error</em> to pass atoms containing - characters that cannot be encoded in Latin-1, and <em>the behavior is - undefined</em>.</p> + <p>As from ERTS 9.0 (OTP 20), UTF-8 encoded atoms may contain any Unicode + character. Although the support for UTF-8 encoded atoms in the external + format is available since ERTS 5.10 (OTP R16), passing atoms that cannot + be encoded in Latin-1 is an <em>error</em> in versions earlier than + Erlang/OTP 20, and <em>the behavior is undefined</em>.</p> <p>When distribution flag <seealso marker="erl_dist_protocol#dflags"> <c>DFLAG_UTF8_ATOMS</c></seealso> has been exchanged between both nodes in the <seealso marker="erl_dist_protocol#distribution_handshake"> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 2859f22bf4..8d340a15f5 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -325,16 +325,11 @@ Z = erlang:adler32_combine(X,Y,iolist_size(Data2)).</code> is <c>latin1</c>, one byte exists for each character in the text representation. If <c><anno>Encoding</anno></c> is <c>utf8</c> or - <c>unicode</c>, the characters are encoded using UTF-8 - (that is, characters from 128 through 255 are - encoded in two bytes).</p> + <c>unicode</c>, the characters are encoded using UTF-8 where + characters may require multiple bytes.</p> <note> - <p><c>atom_to_binary(<anno>Atom</anno>, latin1)</c> never - fails, as the text representation of an atom can only - contain characters from 0 through 255. In a future release, - the text representation - of atoms can be allowed to contain any Unicode character and - <c>atom_to_binary(<anno>Atom</anno>, latin1)</c> then fails if the + <p>As from Erlang/OTP 20, atoms can contain any Unicode character + and <c>atom_to_binary(<anno>Atom</anno>, latin1)</c> may fail if the text representation for <c><anno>Atom</anno></c> contains a Unicode character > 255.</p> </note> @@ -402,13 +397,11 @@ Z = erlang:adler32_combine(X,Y,iolist_size(Data2)).</code> translation of bytes in the binary is done. If <c><anno>Encoding</anno></c> is <c>utf8</c> or <c>unicode</c>, the binary must contain - valid UTF-8 sequences. Only Unicode characters up - to 255 are allowed.</p> + valid UTF-8 sequences.</p> <note> - <p><c>binary_to_atom(<anno>Binary</anno>, utf8)</c> fails if - the binary contains Unicode characters > 255. - In a future release, such Unicode characters can be allowed and - <c>binary_to_atom(<anno>Binary</anno>, utf8)</c> does then not fail. + <p>As from Erlang/OTP 20, <c>binary_to_atom(<anno>Binary</anno>, utf8)</c> + is capable of encoding any Unicode character. Earlier versions would + fail if the binary contained Unicode characters > 255. For more information about Unicode support in atoms, see the <seealso marker="erl_ext_dist#utf8_atoms">note on UTF-8 encoded atoms</seealso> @@ -419,9 +412,7 @@ Z = erlang:adler32_combine(X,Y,iolist_size(Data2)).</code> > <input>binary_to_atom(<<"Erlang">>, latin1).</input> 'Erlang' > <input>binary_to_atom(<<1024/utf8>>, utf8).</input> -** exception error: bad argument - in function binary_to_atom/2 - called as binary_to_atom(<<208,128>>,utf8)</pre> +'Ѐ'</pre> </desc> </func> @@ -2381,10 +2372,10 @@ os_prompt%</pre> <desc> <p>Returns the atom whose text representation is <c><anno>String</anno></c>.</p> - <p><c><anno>String</anno></c> can only contain ISO-latin-1 - characters (that is, numbers < 256) as the implementation does not - allow Unicode characters equal to or above 256 in atoms. - For more information on Unicode support in atoms, see + <p>As from Erlang/OTP 20, <c><anno>String</anno></c> may contain + any Unicode character. Earlier versions allowed only ISO-latin-1 + characters as the implementation did not allow Unicode characters + above 255. For more information on Unicode support in atoms, see <seealso marker="erl_ext_dist#utf8_atoms">note on UTF-8 encoded atoms</seealso> in section "External Term Format" in the User's Guide.</p> @@ -3832,10 +3823,6 @@ RealSystem = system + MissedSystem</code> <desc> <p>Returns a string corresponding to the text representation of <c><anno>Pid</anno></c>.</p> - <warning> - <p>This BIF is intended for debugging and is not to be used - in application programs.</p> - </warning> </desc> </func> @@ -4408,10 +4395,6 @@ RealSystem = system + MissedSystem</code> <desc> <p>Returns a string corresponding to the text representation of the port identifier <c><anno>Port</anno></c>.</p> - <warning> - <p>This BIF is intended for debugging. It is not to be used - in application programs.</p> - </warning> </desc> </func> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 812538729d..ae1d2b1d93 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -32,12 +32,39 @@ <p>This document describes the changes made to the ERTS application.</p> -<section><title>Erts 8.2.1</title> +<section><title>Erts 8.2.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> <item> <p> + Fix bug in <c>binary_to_term</c> for binaries created by + <c>term_to_binary </c> with option <c>compressed</c>. The + bug can cause <c>badarg</c> exception for a valid binary + when Erlang VM is linked against a <c>zlib</c> library of + version 1.2.9 or newer. Bug exists since OTP 17.0.</p> + <p> + Own Id: OTP-14159 Aux Id: ERL-340 </p> + </item> + <item> + <p> + The driver efile_drv when opening a file now use fstat() + on the open file instead of stat() before opening, if + fstat() exists. This avoids a race when the file happens + to change between stat() and open().</p> + <p> + Own Id: OTP-14184 Aux Id: seq-13266 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 8.2.1</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix a quite rare bug causing VM crash during code loading and the use of export funs (fun M:F/A) of not yet loaded modules. Requires a very specfic timing of concurrent diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index 2b5ad097a0..2055c29190 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -233,10 +233,10 @@ need_convertion: } /* - * erts_atom_put() may fail. If it fails THE_NON_VALUE is returned! + * erts_atom_put_index() may fail. Returns negative indexes for errors. */ -Eterm -erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) +int +erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc) { byte utf8_copy[MAX_ATOM_SZ_FROM_LATIN1]; const byte *text = name; @@ -253,7 +253,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) if (trunc) tlen = 0; else - return THE_NON_VALUE; + return ATOM_MAX_CHARS_ERROR; } switch (enc) { @@ -262,7 +262,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) if (trunc) tlen = MAX_ATOM_CHARACTERS; else - return THE_NON_VALUE; + return ATOM_MAX_CHARS_ERROR; } #ifdef DEBUG for (aix = 0; aix < len; aix++) { @@ -276,7 +276,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) if (trunc) tlen = MAX_ATOM_CHARACTERS; else - return THE_NON_VALUE; + return ATOM_MAX_CHARS_ERROR; } no_latin1_chars = tlen; latin1_to_utf8(utf8_copy, &text, &tlen); @@ -284,7 +284,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) case ERTS_ATOM_ENC_UTF8: /* First sanity check; need to verify later */ if (tlen > MAX_ATOM_SZ_LIMIT && !trunc) - return THE_NON_VALUE; + return ATOM_MAX_CHARS_ERROR; break; } @@ -295,7 +295,7 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) atom_read_unlock(); if (aix >= 0) { /* Already in table no need to verify it */ - return make_atom(aix); + return aix; } if (enc == ERTS_ATOM_ENC_UTF8) { @@ -314,13 +314,13 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) case ERTS_UTF8_OK_MAX_CHARS: /* Truncated... */ if (!trunc) - return THE_NON_VALUE; + return ATOM_MAX_CHARS_ERROR; ASSERT(no_chars == MAX_ATOM_CHARACTERS); tlen = err_pos - text; break; default: /* Bad utf8... */ - return THE_NON_VALUE; + return ATOM_BAD_ENCODING_ERROR; } } @@ -333,7 +333,20 @@ erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) atom_write_lock(); aix = index_put(&erts_atom_table, (void*) &a); atom_write_unlock(); - return make_atom(aix); + return aix; +} + +/* + * erts_atom_put() may fail. If it fails THE_NON_VALUE is returned! + */ +Eterm +erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc) +{ + int aix = erts_atom_put_index(name, len, enc, trunc); + if (aix >= 0) + return make_atom(aix); + else + return THE_NON_VALUE; } Eterm diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h index abd3b44993..be998a46bd 100644 --- a/erts/emulator/beam/atom.h +++ b/erts/emulator/beam/atom.h @@ -29,6 +29,8 @@ #define MAX_ATOM_SZ_LIMIT (4*MAX_ATOM_CHARACTERS) /* theoretical byte limit */ #define ATOM_LIMIT (1024*1024) #define MIN_ATOM_TABLE_SIZE 8192 +#define ATOM_BAD_ENCODING_ERROR -1 +#define ATOM_MAX_CHARS_ERROR -2 #ifndef ARCH_32 /* Internal atom cache needs MAX_ATOM_TABLE_SIZE to be less than an @@ -133,6 +135,7 @@ int atom_table_sz(void); /* table size in bytes, excluding stored objects */ Eterm am_atom_put(const char*, int); /* ONLY 7-bit ascii! */ Eterm erts_atom_put(const byte *name, int len, ErtsAtomEncoding enc, int trunc); +int erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc); void init_atom_table(void); void atom_info(fmtfn_t, void *); void dump_atoms(fmtfn_t, void *); diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index dd0a42b5ba..df2866b40e 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -195,6 +195,7 @@ atom current_stacktrace atom data atom debug_flags atom decimals +atom default atom delay_trap atom dexit atom depth @@ -245,6 +246,7 @@ atom Eq='=:=' atom Eqeq='==' atom erl_tracer atom erlang +atom erl_signal_server atom ERROR='ERROR' atom error_handler atom error_logger @@ -312,6 +314,7 @@ atom global atom Gt='>' atom grun atom group_leader +atom handle atom have_dt_utag atom heap_block_size atom heap_size @@ -376,6 +379,7 @@ atom long_schedule atom low atom Lt='<' atom machine +atom magic_ref atom major atom match atom match_limit @@ -572,7 +576,7 @@ atom running_procs atom runtime atom safe atom save_calls -atom scheduler +atom scheduler atom scheduler_id atom scheduler_wall_time atom scheduler_wall_time_all @@ -600,6 +604,19 @@ atom set_tcw atom set_tcw_fake atom separate atom shared +atom sighup +atom sigterm +atom sigusr1 +atom sigusr2 +atom sigill +atom sigchld +atom sigabrt +atom sigalrm +atom sigstop +atom sigint +atom sigsegv +atom sigtstp +atom sigquit atom silent atom size atom sl_alloc diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index a5891a0ec2..4ba8c2a669 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -156,11 +156,13 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3) Module* modp; Eterm res, mod; - if (!ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_1) || - is_not_atom(mod = erts_module_for_prepared_code - (((ProcBin*)binary_val(BIF_ARG_1))->val))) { + if (!is_internal_magic_ref(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + + mod = erts_module_for_prepared_code(erts_magic_ref2bin(BIF_ARG_1)); + + if (is_not_atom(mod)) BIF_ERROR(BIF_P, BADARG); - } if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD3(bif_export[BIF_code_make_stub_module_3], @@ -229,8 +231,8 @@ prepare_loading_2(BIF_ALIST_2) res = TUPLE2(hp, am_error, reason); BIF_RET(res); } - hp = HAlloc(BIF_P, PROC_BIN_SIZE); - res = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), magic); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); + res = erts_mk_magic_ref(&hp, &MSO(BIF_P), magic); erts_refc_dec(&magic->refc, 1); BIF_RET(res); } @@ -239,15 +241,13 @@ BIF_RETTYPE has_prepared_code_on_load_1(BIF_ALIST_1) { Eterm res; - ProcBin* pb; - if (!ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_1)) { + if (!is_internal_magic_ref(BIF_ARG_1)) { error: BIF_ERROR(BIF_P, BADARG); } - pb = (ProcBin*) binary_val(BIF_ARG_1); - res = erts_has_code_on_load(pb->val); + res = erts_has_code_on_load(erts_magic_ref2bin(BIF_ARG_1)); if (res == NIL) { goto error; } @@ -333,13 +333,11 @@ finish_loading_1(BIF_ALIST_1) for (i = 0; i < n; i++) { Eterm* cons = list_val(BIF_ARG_1); Eterm term = CAR(cons); - ProcBin* pb; - if (!ERTS_TERM_IS_MAGIC_BINARY(term)) { + if (!is_internal_magic_ref(term)) { goto badarg; } - pb = (ProcBin*) binary_val(term); - p[i].code = pb->val; + p[i].code = erts_magic_ref2bin(term); p[i].module = erts_module_for_prepared_code(p[i].code); if (p[i].module == NIL) { goto badarg; diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 27329a339e..b32c74ce7a 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -392,17 +392,17 @@ consolidate_bp_data(Module* modp, ErtsCodeInfo *ci, int local) } if (flags & ERTS_BPF_META_TRACE) { dst->meta_tracer = src->meta_tracer; - erts_refc_inc(&dst->meta_tracer->refc, 1); + erts_smp_refc_inc(&dst->meta_tracer->refc, 1); dst->meta_ms = src->meta_ms; MatchSetRef(dst->meta_ms); } if (flags & ERTS_BPF_COUNT) { dst->count = src->count; - erts_refc_inc(&dst->count->refc, 1); + erts_smp_refc_inc(&dst->count->refc, 1); } if (flags & ERTS_BPF_TIME_TRACE) { dst->time = src->time; - erts_refc_inc(&dst->time->refc, 1); + erts_smp_refc_inc(&dst->time->refc, 1); ASSERT(dst->time->hash); } } @@ -1576,7 +1576,7 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, MatchSetRef(match_spec); bp->meta_ms = match_spec; bmt = Alloc(sizeof(BpMetaTracer)); - erts_refc_init(&bmt->refc, 1); + erts_smp_refc_init(&bmt->refc, 1); erts_tracer_update(&meta_tracer, tracer); /* copy tracer */ erts_smp_atomic_init_nob(&bmt->tracer, (erts_aint_t)meta_tracer); bp->meta_tracer = bmt; @@ -1585,7 +1585,7 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, ASSERT((bp->flags & ERTS_BPF_COUNT) == 0); bcp = Alloc(sizeof(BpCount)); - erts_refc_init(&bcp->refc, 1); + erts_smp_refc_init(&bcp->refc, 1); erts_smp_atomic_init_nob(&bcp->acount, 0); bp->count = bcp; } else if (break_flags & ERTS_BPF_TIME_TRACE) { @@ -1594,7 +1594,7 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags, ASSERT((bp->flags & ERTS_BPF_TIME_TRACE) == 0); bdt = Alloc(sizeof(BpDataTime)); - erts_refc_init(&bdt->refc, 1); + erts_smp_refc_init(&bdt->refc, 1); #ifdef ERTS_DIRTY_SCHEDULERS bdt->n = erts_no_schedulers + 1; #else @@ -1664,7 +1664,7 @@ clear_function_break(ErtsCodeInfo *ci, Uint break_flags) static void bp_meta_unref(BpMetaTracer* bmt) { - if (erts_refc_dectest(&bmt->refc, 0) <= 0) { + if (erts_smp_refc_dectest(&bmt->refc, 0) <= 0) { ErtsTracer trc = erts_smp_atomic_read_nob(&bmt->tracer); ERTS_TRACER_CLEAR(&trc); Free(bmt); @@ -1674,7 +1674,7 @@ bp_meta_unref(BpMetaTracer* bmt) static void bp_count_unref(BpCount* bcp) { - if (erts_refc_dectest(&bcp->refc, 0) <= 0) { + if (erts_smp_refc_dectest(&bcp->refc, 0) <= 0) { Free(bcp); } } @@ -1682,7 +1682,7 @@ bp_count_unref(BpCount* bcp) static void bp_time_unref(BpDataTime* bdt) { - if (erts_refc_dectest(&bdt->refc, 0) <= 0) { + if (erts_smp_refc_dectest(&bdt->refc, 0) <= 0) { Uint i = 0; Uint j = 0; Process *h_p = NULL; diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index cccd395e0a..3dba3cc1b5 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -41,7 +41,7 @@ typedef struct { typedef struct bp_data_time { /* Call time */ Uint n; bp_time_hash_t *hash; - erts_refc_t refc; + erts_smp_refc_t refc; } BpDataTime; typedef struct { @@ -51,12 +51,12 @@ typedef struct { typedef struct { erts_smp_atomic_t acount; - erts_refc_t refc; + erts_smp_refc_t refc; } BpCount; typedef struct { erts_smp_atomic_t tracer; - erts_refc_t refc; + erts_smp_refc_t refc; } BpMetaTracer; typedef struct generic_bp_data { diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 85d92321b8..5e275c8fc5 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -6846,7 +6846,7 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) p->htop = hp + needed; funp = (ErlFunThing *) hp; hp = funp->env; - erts_refc_inc(&fe->refc, 2); + erts_smp_refc_inc(&fe->refc, 2); funp->thing_word = HEADER_FUN; funp->next = MSO(p).first; MSO(p).first = (struct erl_off_heap_header*) funp; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 309465bcd3..e75e7afd54 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -157,13 +157,15 @@ typedef struct { #define STR_CHUNK 2 #define IMP_CHUNK 3 #define EXP_CHUNK 4 -#define NUM_MANDATORY 5 +#define MIN_MANDATORY 1 +#define MAX_MANDATORY 5 #define LAMBDA_CHUNK 5 #define LITERAL_CHUNK 6 #define ATTR_CHUNK 7 #define COMPILE_CHUNK 8 #define LINE_CHUNK 9 +#define UTF8_ATOM_CHUNK 10 #define NUM_CHUNK_TYPES (sizeof(chunk_types)/sizeof(chunk_types[0])) @@ -173,9 +175,13 @@ typedef struct { static Uint chunk_types[] = { /* - * Mandatory chunk types -- these MUST be present. + * Atom chunk types -- Atom or AtU8 MUST be present. */ MakeIffId('A', 't', 'o', 'm'), /* 0 */ + + /* + * Mandatory chunk types -- these MUST be present. + */ MakeIffId('C', 'o', 'd', 'e'), /* 1 */ MakeIffId('S', 't', 'r', 'T'), /* 2 */ MakeIffId('I', 'm', 'p', 'T'), /* 3 */ @@ -189,6 +195,7 @@ static Uint chunk_types[] = { MakeIffId('A', 't', 't', 'r'), /* 7 */ MakeIffId('C', 'I', 'n', 'f'), /* 8 */ MakeIffId('L', 'i', 'n', 'e'), /* 9 */ + MakeIffId('A', 't', 'U', '8'), /* 10 */ }; /* @@ -490,9 +497,9 @@ static Eterm stub_insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, #endif static int init_iff_file(LoaderState* stp, byte* code, Uint size); static int scan_iff_file(LoaderState* stp, Uint* chunk_types, - Uint num_types, Uint num_mandatory); + Uint num_types); static int verify_chunks(LoaderState* stp); -static int load_atom_table(LoaderState* stp); +static int load_atom_table(LoaderState* stp, ErtsAtomEncoding enc); static int load_import_table(LoaderState* stp); static int read_export_table(LoaderState* stp); static int is_bif(Eterm mod, Eterm func, unsigned arity); @@ -629,7 +636,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, CHKALLOC(); CHKBLK(ERTS_ALC_T_CODE,stp->code); if (!init_iff_file(stp, code, unloaded_size) || - !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) || + !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) || !verify_chunks(stp)) { goto load_error; } @@ -674,9 +681,16 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, */ CHKBLK(ERTS_ALC_T_CODE,stp->code); - define_file(stp, "atom table", ATOM_CHUNK); - if (!load_atom_table(stp)) { - goto load_error; + if (stp->chunks[UTF8_ATOM_CHUNK].size > 0) { + define_file(stp, "utf8 atom table", UTF8_ATOM_CHUNK); + if (!load_atom_table(stp, ERTS_ATOM_ENC_UTF8)) { + goto load_error; + } + } else { + define_file(stp, "atom table", ATOM_CHUNK); + if (!load_atom_table(stp, ERTS_ATOM_ENC_LATIN1)) { + goto load_error; + } } /* @@ -1212,7 +1226,7 @@ init_iff_file(LoaderState* stp, byte* code, Uint size) * Scan the IFF file. The header should have been verified by init_iff_file(). */ static int -scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory) +scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types) { Uint count; Uint id; @@ -1291,7 +1305,16 @@ verify_chunks(LoaderState* stp) MD5_CTX context; MD5Init(&context); - for (i = 0; i < NUM_MANDATORY; i++) { + + if (stp->chunks[UTF8_ATOM_CHUNK].start != NULL) { + MD5Update(&context, stp->chunks[UTF8_ATOM_CHUNK].start, stp->chunks[UTF8_ATOM_CHUNK].size); + } else if (stp->chunks[ATOM_CHUNK].start != NULL) { + MD5Update(&context, stp->chunks[ATOM_CHUNK].start, stp->chunks[ATOM_CHUNK].size); + } else { + LoadError0(stp, "mandatory chunk of type 'Atom' or 'AtU8' not found\n"); + } + + for (i = MIN_MANDATORY; i < MAX_MANDATORY; i++) { if (stp->chunks[i].start != NULL) { MD5Update(&context, stp->chunks[i].start, stp->chunks[i].size); } else { @@ -1352,7 +1375,7 @@ verify_chunks(LoaderState* stp) } static int -load_atom_table(LoaderState* stp) +load_atom_table(LoaderState* stp, ErtsAtomEncoding enc) { unsigned int i; @@ -1371,7 +1394,7 @@ load_atom_table(LoaderState* stp) GetByte(stp, n); GetString(stp, atom, n); - stp->atom[i] = erts_atom_put(atom, n, ERTS_ATOM_ENC_LATIN1, 1); + stp->atom[i] = erts_atom_put(atom, n, enc, 1); } /* @@ -4839,7 +4862,7 @@ final_touch(LoaderState* stp, struct erl_module_instance* inst_p) /* * We are hiding a pointer into older code. */ - erts_refc_dec(&fe->refc, 1); + erts_smp_refc_dec(&fe->refc, 1); } fe->address = code_ptr; #ifdef HIPE @@ -5938,7 +5961,7 @@ code_get_chunk_2(BIF_ALIST_2) goto error; } if (!init_iff_file(stp, start, binary_size(Bin)) || - !scan_iff_file(stp, &chunk, 1, 1) || + !scan_iff_file(stp, &chunk, 1) || stp->chunks[0].start == NULL) { res = am_undefined; goto done; @@ -5987,7 +6010,7 @@ code_module_md5_1(BIF_ALIST_1) } stp->module = THE_NON_VALUE; /* Suppress diagnostiscs */ if (!init_iff_file(stp, bytes, binary_size(Bin)) || - !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) || + !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) || !verify_chunks(stp)) { res = am_undefined; goto done; @@ -6251,7 +6274,7 @@ patch_funentries(Eterm Patchlist) * * Reproduced on a debug emulator with stdlib_test/qlc_SUITE:join_merge * - * erts_refc_dec(&fe->refc, 1); + * erts_smp_refc_dec(&fe->refc, 1); */ if (!patch(Addresses, (Uint) fe)) @@ -6299,8 +6322,8 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info) stp = ERTS_MAGIC_BIN_DATA(magic); hipe_code = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*hipe_code)); - if (!ERTS_TERM_IS_MAGIC_BINARY(hipe_magic_bin) || - !(hipe_magic = ((ProcBin*)binary_val(hipe_magic_bin))->val, + if (!is_internal_magic_ref(hipe_magic_bin) || + !(hipe_magic = erts_magic_ref2bin(hipe_magic_bin), hipe_stp = hipe_get_loader_state(hipe_magic)) || hipe_stp->module == NIL || hipe_stp->text_segment == 0) { goto error; @@ -6336,7 +6359,7 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info) if (!init_iff_file(stp, bytes, size)) { goto error; } - if (!scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) || + if (!scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) || !verify_chunks(stp)) { goto error; } @@ -6344,9 +6367,16 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info) if (!read_code_header(stp)) { goto error; } - define_file(stp, "atom table", ATOM_CHUNK); - if (!load_atom_table(stp)) { - goto error; + if (stp->chunks[UTF8_ATOM_CHUNK].size > 0) { + define_file(stp, "utf8 atom table", UTF8_ATOM_CHUNK); + if (!load_atom_table(stp, ERTS_ATOM_ENC_UTF8)) { + goto error; + } + } else { + define_file(stp, "atom table", ATOM_CHUNK); + if (!load_atom_table(stp, ERTS_ATOM_ENC_LATIN1)) { + goto error; + } } define_file(stp, "export table", EXP_CHUNK); if (!stub_read_export_table(stp)) { @@ -6538,8 +6568,8 @@ int erts_commit_hipe_patch_load(Eterm hipe_magic_bin) HipeModule *hipe_code; Module* modp; - if (!ERTS_TERM_IS_MAGIC_BINARY(hipe_magic_bin) || - !(hipe_magic = ((ProcBin*)binary_val(hipe_magic_bin))->val, + if (!is_internal_magic_ref(hipe_magic_bin) || + !(hipe_magic = erts_magic_ref2bin(hipe_magic_bin), hipe_stp = hipe_get_loader_state(hipe_magic)) || hipe_stp->module == NIL || hipe_stp->text_segment == 0) { return 0; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index a3acf87000..2190c47262 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -199,7 +199,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1) goto res_no_proc; case ERTS_PORT_OP_SCHEDULED: if (refp) { - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true); } default: @@ -782,7 +782,7 @@ local_name_monitor(Process *self, Eterm type, Eterm target_name) case ERTS_PORT_OP_DONE: return ret; case ERTS_PORT_OP_SCHEDULED: { /* Scheduled a signal */ - ASSERT(is_internal_ref(ret)); + ASSERT(is_internal_ordinary_ref(ret)); BIF_TRAP3(await_port_send_result_trap, self, ret, am_true, ret); /* bif_trap returns */ @@ -1180,7 +1180,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) res = erts_port_unlink(BIF_P, prt, BIF_P->common.id, refp); if (refp && res == ERTS_PORT_OP_SCHEDULED) { - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true); } } @@ -1586,7 +1586,7 @@ BIF_RETTYPE exit_2(BIF_ALIST_2) ERTS_BIF_CHK_EXITED(BIF_P); if (refp && res == ERTS_PORT_OP_SCHEDULED) { - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true); } @@ -2221,7 +2221,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) /* Fall through */ case ERTS_PORT_OP_SCHEDULED: if (is_not_nil(*refp)) { - ASSERT(is_internal_ref(*refp)); + ASSERT(is_internal_ordinary_ref(*refp)); ret_val = SEND_AWAIT_RESULT; } break; @@ -2409,7 +2409,7 @@ BIF_RETTYPE send_3(BIF_ALIST_3) ERTS_BIF_PREP_YIELD_RETURN(retval, p, am_ok); break; case SEND_AWAIT_RESULT: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); ERTS_BIF_PREP_TRAP3(retval, await_port_send_result_trap, p, ref, am_nosuspend, am_ok); break; case SEND_BADARG: @@ -2446,7 +2446,7 @@ BIF_RETTYPE send_2(BIF_ALIST_2) static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1) { - Binary* bin = ((ProcBin*) binary_val(BIF_ARG_1))->val; + Binary* bin = erts_magic_ref2bin(BIF_ARG_1); ErtsSendContext* ctx = (ErtsSendContext*) ERTS_MAGIC_BIN_DATA(bin); Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(BIF_P) * TERM_TO_BINARY_LOOP_FACTOR); int result; @@ -2526,7 +2526,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ERTS_BIF_PREP_YIELD_RETURN(retval, p, msg); break; case SEND_AWAIT_RESULT: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); ERTS_BIF_PREP_TRAP3(retval, await_port_send_result_trap, p, ref, msg, msg); break; @@ -3022,8 +3022,8 @@ BIF_RETTYPE atom_to_list_1(BIF_ALIST_1) BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) { Eterm res; - char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS); - Sint i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); + byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT); + Sint i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); if (i < 0) { erts_free(ERTS_ALC_T_TMP, (void *) buf); @@ -3033,7 +3033,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) } BIF_ERROR(BIF_P, BADARG); } - res = erts_atom_put((byte *) buf, i, ERTS_ATOM_ENC_LATIN1, 1); + res = erts_atom_put(buf, i, ERTS_ATOM_ENC_UTF8, 1); ASSERT(is_atom(res)); erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(res); @@ -3043,17 +3043,17 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1) { - Sint i; - char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS); + byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT); + Sint i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); - if ((i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS)) < 0) { + if (i < 0) { error: erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_ERROR(BIF_P, BADARG); } else { Eterm a; - if (erts_atom_get(buf, i, &a, ERTS_ATOM_ENC_LATIN1)) { + if (erts_atom_get((char *) buf, i, &a, ERTS_ATOM_ENC_UTF8)) { erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(a); } else { @@ -4109,6 +4109,7 @@ BIF_RETTYPE ref_to_list_1(BIF_ALIST_1) { if (is_not_ref(BIF_ARG_1)) BIF_ERROR(BIF_P, BADARG); + erts_magic_ref_save_bin(BIF_ARG_1); BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1)); } @@ -5555,12 +5556,10 @@ BIF_RETTYPE dt_restore_tag_1(BIF_ALIST_1) SEQ_TRACE_TOKEN(BIF_P) = am_have_dt_utag; } } -#else +#else if (BIF_ARG_1 != am_true) { BIF_ERROR(BIF_P,BADARG); } #endif BIF_RET(am_true); } - - diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 476c4b9632..a6510ace81 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -670,3 +670,4 @@ gcbif erlang:ceil/1 bif math:floor/1 bif math:ceil/1 bif math:fmod/2 +bif os:set_signal/2 diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 071a356260..d38097fb12 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -47,13 +47,8 @@ void erts_init_binary(void) { /* Verify Binary alignment... */ - if ((((UWord) &((Binary *) 0)->orig_bytes[0]) % ((UWord) 8)) != 0) { - /* I assume that any compiler should be able to optimize this - away. If not, this test is not very expensive... */ - erts_exit(ERTS_ABORT_EXIT, - "Internal error: Address of orig_bytes[0] of a Binary" - " is *not* 8-byte aligned\n"); - } + ERTS_CT_ASSERT((offsetof(Binary,orig_bytes) % 8) == 0); + ERTS_CT_ASSERT((offsetof(ErtsMagicBinary,u.aligned.data) % 8) == 0); erts_init_trap_export(&binary_to_list_continue_export, am_erts_internal, am_binary_to_list_continue, 1, @@ -445,18 +440,17 @@ binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, sp->size = size; sp->bitoffs = bitoffs; - hp = HAlloc(c_p, PROC_BIN_SIZE); - mb = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp); + hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + mb = erts_mk_magic_ref(&hp, &MSO(c_p), mbp); return binary_to_list_chunk(c_p, mb, sp, reds_left, 0); } } static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1) { - Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val; + Binary *mbp = erts_magic_ref2bin(BIF_ARG_1); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == b2l_state_destructor); - ASSERT(BIF_P->flags & F_DISABLE_GC); return binary_to_list_chunk(BIF_P, @@ -792,8 +786,8 @@ list_to_binary_chunk(Eterm mb_eterm, ERTS_L2B_STATE_MOVE(new_sp, sp); sp = new_sp; - hp = HAlloc(c_p, PROC_BIN_SIZE); - mb_eterm = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp); + hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + mb_eterm = erts_mk_magic_ref(&hp, &MSO(c_p), mbp); ASSERT(is_value(mb_eterm)); @@ -839,9 +833,9 @@ list_to_binary_chunk(Eterm mb_eterm, static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1) { - Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val; - ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor); + Binary *mbp = erts_magic_ref2bin(BIF_ARG_1); + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor); ASSERT(BIF_P->flags & F_DISABLE_GC); return list_to_binary_chunk(BIF_ARG_1, diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 2fc61ab436..e57c2f5f6b 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -647,7 +647,7 @@ bin_check(void) erts_printf("%p orig_size: %bpd, norefs = %bpd\n", bp->val, bp->val->orig_size, - erts_smp_atomic_read_nob(&bp->val->refc)); + erts_refc_read(&bp->val->refc, 1)); } } if (printed) { diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index c4dcd6a3cc..85db23393c 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -850,7 +850,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint funp = (ErlFunThing *) tp; funp->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*) funp; - erts_refc_inc(&funp->fe->refc, 2); + erts_smp_refc_inc(&funp->fe->refc, 2); *argp = make_fun(tp); } break; @@ -858,20 +858,24 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: { - ExternalThing *etp = (ExternalThing *) htop; - + ExternalThing *etp = (ExternalThing *) objp; + erts_smp_refc_inc(&etp->node->refc, 2); + } + L_off_heap_node_container_common: + { + struct erl_off_heap_header *ohhp; + ohhp = (struct erl_off_heap_header *) htop; i = thing_arityval(hdr) + 1; + *argp = make_boxed(htop); tp = htop; while (i--) { *htop++ = *objp++; } - etp->next = off_heap->first; - off_heap->first = (struct erl_off_heap_header*)etp; - erts_refc_inc(&etp->node->refc, 2); + ohhp->next = off_heap->first; + off_heap->first = ohhp; - *argp = make_external(tp); } break; case MAP_SUBTAG: @@ -899,6 +903,13 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint case BIN_MATCHSTATE_SUBTAG: erts_exit(ERTS_ABORT_EXIT, "copy_struct: matchstate term not allowed"); + case REF_SUBTAG: + if (is_magic_ref_thing(objp)) { + ErtsMRefThing *mreft = (ErtsMRefThing *) objp; + erts_refc_inc(&mreft->mb->refc, 2); + goto L_off_heap_node_container_common; + } + /* Fall through... */ default: i = thing_arityval(hdr)+1; hbot -= i; @@ -1525,7 +1536,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, } funp->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*) funp; - erts_refc_inc(&funp->fe->refc, 2); + erts_smp_refc_inc(&funp->fe->refc, 2); goto cleanup_next; } case MAP_SUBTAG: @@ -1649,20 +1660,33 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, } case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: - case EXTERNAL_REF_SUBTAG: { - ExternalThing *etp = (ExternalThing *) hp; + case EXTERNAL_REF_SUBTAG: + { + ExternalThing *etp = (ExternalThing *) ptr; + erts_smp_refc_inc(&etp->node->refc, 2); + } + off_heap_node_container_common: + { + struct erl_off_heap_header *ohhp; + ohhp = (struct erl_off_heap_header *) hp; sz = thing_arityval(hdr); - *resp = make_external(hp); + *resp = make_boxed(hp); *hp++ = hdr; ptr++; while (sz-- > 0) { *hp++ = *ptr++; } - etp->next = off_heap->first; - off_heap->first = (struct erl_off_heap_header*) etp; - erts_refc_inc(&etp->node->refc, 2); + ohhp->next = off_heap->first; + off_heap->first = ohhp; goto cleanup_next; } + case REF_SUBTAG: + if (is_magic_ref_thing(ptr)) { + ErtsMRefThing *mreft = (ErtsMRefThing *) ptr; + erts_refc_inc(&mreft->mb->refc, 2); + goto off_heap_node_container_common; + } + /* Fall through... */ default: sz = thing_arityval(hdr); *resp = make_boxed(hp); @@ -1836,7 +1860,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) case FUN_SUBTAG: { ErlFunThing* funp = (ErlFunThing *) (tp-1); - erts_refc_inc(&funp->fe->refc, 2); + erts_smp_refc_inc(&funp->fe->refc, 2); } goto off_heap_common; case EXTERNAL_PID_SUBTAG: @@ -1844,7 +1868,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) case EXTERNAL_REF_SUBTAG: { ExternalThing* etp = (ExternalThing *) (tp-1); - erts_refc_inc(&etp->node->refc, 2); + erts_smp_refc_inc(&etp->node->refc, 2); } off_heap_common: { @@ -1859,6 +1883,15 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = ohh; } break; + case REF_SUBTAG: { + ErtsRefThing *rtp = (ErtsRefThing *) (tp - 1); + if (is_magic_ref_thing(rtp)) { + ErtsMRefThing *mreft = (ErtsMRefThing *) rtp; + erts_refc_inc(&mreft->mb->refc, 2); + goto off_heap_common; + } + /* Fall through... */ + } default: { int tari = header_arity(val); @@ -1959,6 +1992,9 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int lite ASSERT(ptr + header_arity(val) < end); MOVE_BOXED(ptr, val, hp, &dummy_ref); switch (val & _HEADER_SUBTAG_MASK) { + case REF_SUBTAG: + if (is_ordinary_ref_thing(hdr)) + break; case REFC_BINARY_SUBTAG: case FUN_SUBTAG: case EXTERNAL_PID_SUBTAG: diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 990edb274e..390f2a0db3 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -741,7 +741,7 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx), erts_dsend_context_dtor); struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin); - Eterm* hp = HAlloc(p, PROC_BIN_SIZE); + 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)); @@ -750,7 +750,7 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap)); dst->ctx.dss.acmp = &dst->acm; } - return erts_mk_magic_binary_term(&hp, &MSO(p), ctx_bin); + return erts_mk_magic_ref(&hp, &MSO(p), ctx_bin); } @@ -2082,7 +2082,7 @@ erts_dist_command(Port *prt, int reds_limit) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - erts_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be + erts_smp_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be removed if port command fails */ erts_smp_atomic_set_mb(&dep->dist_cmd_scheduled, 0); @@ -2515,7 +2515,7 @@ info_dist_entry(fmtfn_t to, void *arg, DistEntry *dep, int visible, int connecte erts_print(to, arg, "Name: %T", dep->sysname); #ifdef DEBUG - erts_print(to, arg, " (refc=%d)", erts_refc_read(&dep->refc, 0)); + erts_print(to, arg, " (refc=%d)", erts_smp_refc_read(&dep->refc, 0)); #endif erts_print(to, arg, "\n"); if (!connected && is_nil(dep->cid)) { diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 4d990a9c56..e433de0f35 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -48,6 +48,7 @@ #if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE) #include "erl_check_io.h" #endif +#include "erl_bif_unique.h" #define GET_ERL_GF_ALLOC_IMPL #include "erl_goodfit_alloc.h" @@ -152,8 +153,7 @@ typedef struct { int internal; Uint req_sched; Process *proc; - Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + ErtsIRefStorage iref; int allocs[ERTS_ALC_INFO_A_END - ERTS_ALC_A_MIN + 1]; } ErtsAllocInfoReq; @@ -682,6 +682,8 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) #endif fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NIF_EXP_TRACE)] = sizeof(NifExportTrace); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MREF_NSCHED_ENT)] + = sizeof(ErtsNSchedMagicRefTableEntry); #ifdef HARD_DEBUG hdbg_init(); @@ -3139,9 +3141,10 @@ reply_alloc_info(void *vair) while (1) { if (hpp) - ref_copy = STORE_NC(hpp, ohp, air->ref); + ref_copy = erts_iref_storage_make_ref(&air->iref, + hpp, ohp, 0); else - *szp += REF_THING_SIZE; + *szp += erts_iref_storage_heap_size(&air->iref); ai_list = NIL; for (i = 0; air->allocs[i] != ERTS_ALC_A_INVALID; i++); @@ -3370,8 +3373,10 @@ reply_alloc_info(void *vair) erts_smp_proc_unlock(rp, rp_locks); erts_proc_dec_refc(rp); - if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0) + if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0) { + erts_iref_storage_clean(&air->iref); aireq_free(air); + } } int @@ -3384,7 +3389,6 @@ erts_request_alloc_info(struct process *c_p, ErtsAllocInfoReq *air = aireq_alloc(); Eterm req_ai[ERTS_ALC_INFO_A_END] = {0}; Eterm alist; - Eterm *hp; int airix = 0, ai; air->req_sched = erts_get_scheduler_id(); @@ -3398,8 +3402,7 @@ erts_request_alloc_info(struct process *c_p, if (is_not_internal_ref(ref)) return 0; - hp = &air->ref_heap[0]; - air->ref = STORE_NC(&hp, NULL, ref); + erts_iref_storage_save(&air->iref, ref); if (is_not_list(allocs)) return 0; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 70eca5b49c..c253ea82c8 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -280,6 +280,10 @@ type TRACE_MSG_QUEUE SHORT_LIVED SYSTEM trace_message_queue type SCHED_ASYNC_JOB SHORT_LIVED SYSTEM async_calls type DIRTY_START STANDARD PROCESSES dirty_start type DIRTY_SL SHORT_LIVED SYSTEM dirty_short_lived +type MREF_NSCHED_ENT FIXED_SIZE SYSTEM nsched_magic_ref_entry +type MREF_ENT STANDARD SYSTEM magic_ref_entry +type MREF_TAB_BKTS STANDARD SYSTEM magic_ref_table_buckets +type MREF_TAB LONG_LIVED SYSTEM magic_ref_table +if threads_no_smp # Need thread safe allocs, but std_alloc and fix_alloc are not; diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 6e10980b6b..e57cd06cec 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -1010,8 +1010,8 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1) if (do_binary_match_compile(BIF_ARG_1,&tag,&bin)) { BIF_ERROR(BIF_P,BADARG); } - hp = HAlloc(BIF_P, PROC_BIN_SIZE+3); - ret = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE+3); + ret = erts_mk_magic_ref(&hp, &MSO(BIF_P), bin); ret = TUPLE2(hp, tag, ret); BIF_RET(ret); } @@ -1426,11 +1426,11 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags) goto badarg; } if (((tp[1] != am_bm) && (tp[1] != am_ac)) || - !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) { + !is_internal_magic_ref(tp[2])) { goto badarg; } bfs.type = tp[1]; - bin = ((ProcBin *) binary_val(tp[2]))->val; + bin = erts_magic_ref2bin(tp[2]); if (bfs.type == am_bm && ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { goto badarg; @@ -1448,8 +1448,8 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags) bfs.global_result = &do_match_global_result; runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(p, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); + Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } @@ -1512,11 +1512,11 @@ binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) goto badarg; } if (((tp[1] != am_bm) && (tp[1] != am_ac)) || - !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) { + !is_internal_magic_ref(tp[2])) { goto badarg; } bfs.type = tp[1]; - bin = ((ProcBin *) binary_val(tp[2]))->val; + bin = erts_magic_ref2bin(tp[2]); if (bfs.type == am_bm && ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { goto badarg; @@ -1534,8 +1534,8 @@ binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) bfs.global_result = &do_split_global_result; runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(p, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); + Eterm *hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } @@ -1767,7 +1767,8 @@ static BIF_RETTYPE binary_find_trap(BIF_ALIST_3) { int runres; Eterm result; - Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val; + Binary *bin = erts_magic_ref2bin(BIF_ARG_3); + runres = do_binary_find(BIF_P, BIF_ARG_1, NULL, bin, BIF_ARG_2, &result); if (runres == DO_BIN_MATCH_OK) { BIF_RET(result); @@ -2186,8 +2187,8 @@ static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction) cd[i].type = CL_TYPE_HEAP; } } - hp = HAlloc(p, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + bin_term = erts_mk_magic_ref(&hp, &MSO(p), mb); BUMP_ALL_REDS(p); BIF_TRAP3(trapper, p, bin_term, epos,list); } @@ -2214,8 +2215,7 @@ static BIF_RETTYPE do_longest_common_trap(Process *p, Eterm bin_term, Eterm curr #else term_to_Uint(current_pos, &pos); #endif - ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin_term)); - bin = ((ProcBin *) binary_val(bin_term))->val; + bin = erts_magic_ref2bin(bin_term); cd = (CommonData *) ERTS_MAGIC_BIN_DATA(bin); if (direction == DIRECTION_PREFIX) { trapper = &binary_longest_prefix_trap_export; @@ -2680,8 +2680,8 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en) cbs->source_size = size; cbs->result_pos = pos; cbs->times_left = n-i; - hp = HAlloc(p,PROC_BIN_SIZE); - trap_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + trap_term = erts_mk_magic_ref(&hp, &MSO(p), mb); BUMP_ALL_REDS(p); BIF_TRAP2(&binary_copy_trap_export, p, bin, trap_term); } else { @@ -2716,7 +2716,7 @@ BIF_RETTYPE binary_copy_trap(BIF_ALIST_2) Uint reds = get_reds(BIF_P, BINARY_COPY_LOOP_FACTOR); byte *t; Uint pos; - Binary *mb = ((ProcBin *) binary_val(BIF_ARG_2))->val; + Binary *mb = erts_magic_ref2bin(BIF_ARG_2); CopyBinState *cbs = (CopyBinState *) ERTS_MAGIC_BIN_DATA(mb); Uint opos; diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 587859e413..2ce872d2bc 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -1109,25 +1109,25 @@ void erts_ddll_decrement_port_count(DE_Handle *dh) static void first_ddll_reference(DE_Handle *dh) { assert_drv_list_rwlocked(); - erts_refc_init(&(dh->refc),1); + erts_smp_refc_init(&(dh->refc),1); } void erts_ddll_reference_driver(DE_Handle *dh) { assert_drv_list_locked(); - if (erts_refc_inctest(&(dh->refc),1) == 1) { - erts_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */ + if (erts_smp_refc_inctest(&(dh->refc),1) == 1) { + erts_smp_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */ } } void erts_ddll_reference_referenced_driver(DE_Handle *dh) { - erts_refc_inc(&(dh->refc),2); + erts_smp_refc_inc(&(dh->refc),2); } void erts_ddll_dereference_driver(DE_Handle *dh) { - if (erts_refc_dectest(&(dh->refc),0) == 0) { + if (erts_smp_refc_dectest(&(dh->refc),0) == 0) { /* No lock here, but if the driver is referenced again, the scheduled deletion is added as a reference too, see above */ erts_schedule_misc_op(ddll_no_more_references, (void *) dh); @@ -1150,11 +1150,11 @@ static void restore_process_references(DE_Handle *dh) { DE_ProcEntry *p; assert_drv_list_rwlocked(); - ASSERT(erts_refc_read(&(dh->refc),0) == 0); + ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0); for(p = dh->procs;p != NULL; p = p->next) { if (p->awaiting_status == ERL_DE_PROC_LOADED) { ASSERT(p->flags & ERL_DE_FL_DEREFERENCED); - erts_refc_inc(&(dh->refc),1); + erts_smp_refc_inc(&(dh->refc),1); p->flags &= ~ERL_DE_FL_DEREFERENCED; } } @@ -1176,9 +1176,9 @@ static void ddll_no_more_references(void *vdh) lock_drv_list(); - x = erts_refc_read(&(dh->refc),0); + x = erts_smp_refc_read(&(dh->refc),0); if (x > 0) { - x = erts_refc_dectest(&(dh->refc),0); /* delete the reference added for me */ + x = erts_smp_refc_dectest(&(dh->refc),0); /* delete the reference added for me */ } @@ -1476,8 +1476,10 @@ static void add_proc_loaded_deref(DE_Handle *dh, Process *proc) static Eterm copy_ref(Eterm ref, Eterm *hp) { - RefThing *ptr = ref_thing_ptr(ref); - memcpy(hp, ptr, sizeof(RefThing)); + ErtsORefThing *ptr; + ASSERT(is_internal_ordinary_ref(ref)); + ptr = ordinary_ref_thing_ptr(ref); + memcpy(hp, ptr, sizeof(ErtsORefThing)); return (make_internal_ref(hp)); } @@ -1643,7 +1645,7 @@ static int load_driver_entry(DE_Handle **dhp, char *path, char *name) dh->handle = NULL; dh->procs = NULL; erts_smp_atomic32_init_nob(&dh->port_count, 0); - erts_refc_init(&(dh->refc), (erts_aint_t) 0); + erts_smp_refc_init(&(dh->refc), (erts_aint_t) 0); dh->status = -1; dh->reload_full_path = NULL; dh->reload_driver_name = NULL; @@ -1681,7 +1683,7 @@ static int reload_driver_entry(DE_Handle *dh) dh->reload_full_path = NULL; dh->reload_driver_name = NULL; - ASSERT(erts_refc_read(&(dh->refc),0) == 0); + ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0); ASSERT(dh->full_path != NULL); erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path); dh->full_path = NULL; @@ -1720,10 +1722,10 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, Eterm e; mp = erts_alloc_message_heap(proc, &rp_locks, (6 /* tuple */ + 3 /* Error tuple */ + - REF_THING_SIZE + need), + ERTS_REF_THING_SIZE + need), &hp, &ohp); r = copy_ref(ref,hp); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; e = build_load_error_hp(hp, errcode); hp += need; mess = TUPLE2(hp,tag,e); @@ -1731,10 +1733,10 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, mess = TUPLE5(hp,type,r,am_driver,driver_name,mess); } else { mp = erts_alloc_message_heap(proc, &rp_locks, - 6 /* tuple */ + REF_THING_SIZE, + 6 /* tuple */ + ERTS_REF_THING_SIZE, &hp, &ohp); r = copy_ref(ref,hp); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; mess = TUPLE5(hp,type,r,am_driver,driver_name,tag); } erts_queue_message(proc, rp_locks, mp, mess, am_system); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 5ee19aead8..be113b7c88 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -177,7 +177,33 @@ bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) if (szp) *szp += 4+2; if (hpp) { - Uint refc = (Uint) erts_smp_atomic_read_nob(&pb->val->refc); + Uint refc = (Uint) erts_refc_read(&pb->val->refc, 1); + tuple = TUPLE3(*hpp, val, orig_size, make_small(refc)); + res = CONS(*hpp + 4, tuple, res); + *hpp += 4+2; + } + } + } + return res; +} + +static Eterm +bld_magic_ref_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) +{ + struct erl_off_heap_header* ohh; + Eterm res = NIL; + Eterm tuple; + + for (ohh = oh->first; ohh; ohh = ohh->next) { + if (is_ref_thing_header((*((Eterm *) ohh)))) { + ErtsMRefThing *mrtp = (ErtsMRefThing *) ohh; + Eterm val = erts_bld_uword(hpp, szp, (UWord) mrtp->mb); + Eterm orig_size = erts_bld_uint(hpp, szp, mrtp->mb->orig_size); + + if (szp) + *szp += 4+2; + if (hpp) { + Uint refc = (Uint) erts_refc_read(&mrtp->mb->refc, 1); tuple = TUPLE3(*hpp, val, orig_size, make_small(refc)); res = CONS(*hpp + 4, tuple, res); *hpp += 4+2; @@ -613,7 +639,8 @@ static Eterm pi_args[] = { am_current_location, am_current_stacktrace, am_message_queue_data, - am_garbage_collection_info + am_garbage_collection_info, + am_magic_ref }; #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm))) @@ -664,6 +691,7 @@ pi_arg2ix(Eterm arg) case am_current_stacktrace: return 31; case am_message_queue_data: return 32; case am_garbage_collection_info: return 33; + case am_magic_ref: return 34; default: return -1; } } @@ -1599,6 +1627,14 @@ process_info_aux(Process *BIF_P, hp = HAlloc(BIF_P, 3); break; + case am_magic_ref: { + Uint sz = 3; + (void) bld_magic_ref_bin_list(NULL, &sz, &MSO(rp)); + hp = HAlloc(BIF_P, sz); + res = bld_magic_ref_bin_list(&hp, NULL, &MSO(rp)); + break; + } + default: return THE_NON_VALUE; /* will produce badarg */ @@ -3531,6 +3567,11 @@ BIF_RETTYPE error_logger_warning_map_0(BIF_ALIST_0) static erts_smp_atomic_t available_internal_state; +static void empty_magic_ref_destructor(Binary *bin) +{ + +} + BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) { /* @@ -3896,6 +3937,34 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) } return make_atom(ix); } + else if (ERTS_IS_ATOM_STR("magic_ref", tp[1])) { + Binary *bin; + UWord bin_addr, refc; + Eterm bin_addr_term, refc_term, test_type; + Uint sz; + Eterm *hp; + if (!is_internal_magic_ref(tp[2])) { + if (is_internal_ordinary_ref(tp[2])) { + ErtsORefThing *rtp; + rtp = (ErtsORefThing *) internal_ref_val(tp[2]); + if (erts_is_ref_numbers_magic(rtp->num)) + BIF_RET(am_true); + } + BIF_RET(am_false); + } + bin = erts_magic_ref2bin(tp[2]); + refc = erts_refc_read(&bin->refc, 1); + bin_addr = (UWord) bin; + sz = 4; + erts_bld_uword(NULL, &sz, bin_addr); + erts_bld_uword(NULL, &sz, refc); + hp = HAlloc(BIF_P, sz); + bin_addr_term = erts_bld_uword(&hp, NULL, bin_addr); + refc_term = erts_bld_uword(&hp, NULL, refc); + test_type = (ERTS_MAGIC_BIN_DESTRUCTOR(bin) == empty_magic_ref_destructor + ? am_true : am_false); + BIF_RET(TUPLE3(hp, bin_addr_term, refc_term, test_type)); + } break; } @@ -3984,7 +4053,6 @@ static void broken_halt_test(Eterm bif_arg_2) erts_exit(ERTS_DUMP_EXIT, "%T", bif_arg_2); } - BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) { /* @@ -4314,6 +4382,21 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) /* Used by ets_SUITE (stdlib) */ BIF_RET(erts_ets_restore_meta_state(BIF_P, BIF_ARG_2)); } + else if (ERTS_IS_ATOM_STR("make", BIF_ARG_1)) { + if (ERTS_IS_ATOM_STR("magic_ref", BIF_ARG_2)) { + Binary *bin = erts_create_magic_binary(0, empty_magic_ref_destructor); + UWord bin_addr = (UWord) bin; + Eterm bin_addr_term, magic_ref, res; + Eterm *hp; + Uint sz = ERTS_MAGIC_REF_THING_SIZE + 3; + erts_bld_uword(NULL, &sz, bin_addr); + hp = HAlloc(BIF_P, sz); + bin_addr_term = erts_bld_uword(&hp, NULL, bin_addr); + magic_ref = erts_mk_magic_ref(&hp, &BIF_P->off_heap, bin); + res = TUPLE2(hp, magic_ref, bin_addr_term); + BIF_RET(res); + } + } } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c index 46777d3aa5..edc3c82b23 100644 --- a/erts/emulator/beam/erl_bif_os.c +++ b/erts/emulator/beam/erl_bif_os.c @@ -203,3 +203,17 @@ BIF_RETTYPE os_unsetenv_1(BIF_ALIST_1) } BIF_RET(am_true); } + +BIF_RETTYPE os_set_signal_2(BIF_ALIST_2) { + if (is_atom(BIF_ARG_1) && ((BIF_ARG_2 == am_ignore) || + (BIF_ARG_2 == am_default) || + (BIF_ARG_2 == am_handle))) { + if (!erts_set_signal(BIF_ARG_1, BIF_ARG_2)) + goto error; + + BIF_RET(am_ok); + } + +error: + BIF_ERROR(BIF_P, BADARG); +} diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 90e78a9b0b..09d2c5376b 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -214,7 +214,7 @@ BIF_RETTYPE erts_internal_port_command_3(BIF_ALIST_3) ASSERT(!(flags & ERTS_PORT_SIG_FLG_FORCE)); /* Fall through... */ case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); ERTS_BIF_PREP_RET(res, ref); break; case ERTS_PORT_OP_DONE: @@ -260,7 +260,7 @@ BIF_RETTYPE erts_internal_port_call_3(BIF_ALIST_3) retval = am_badarg; break; case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); + ASSERT(is_internal_ordinary_ref(retval)); break; case ERTS_PORT_OP_DONE: ASSERT(is_not_internal_ref(retval)); @@ -310,7 +310,7 @@ BIF_RETTYPE erts_internal_port_control_3(BIF_ALIST_3) retval = am_badarg; break; case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); + ASSERT(is_internal_ordinary_ref(retval)); break; case ERTS_PORT_OP_DONE: ASSERT(is_not_internal_ref(retval)); @@ -356,7 +356,7 @@ BIF_RETTYPE erts_internal_port_close_1(BIF_ALIST_1) case ERTS_PORT_OP_DROPPED: BIF_RET(am_badarg); case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_RET(ref); case ERTS_PORT_OP_DONE: BIF_RET(am_true); @@ -389,7 +389,7 @@ BIF_RETTYPE erts_internal_port_connect_2(BIF_ALIST_2) case ERTS_PORT_OP_DROPPED: BIF_RET(am_badarg); case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); BIF_RET(ref); break; case ERTS_PORT_OP_DONE: @@ -428,7 +428,7 @@ BIF_RETTYPE erts_internal_port_info_1(BIF_ALIST_1) case ERTS_PORT_OP_DROPPED: BIF_RET(am_undefined); case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); + ASSERT(is_internal_ordinary_ref(retval)); BIF_RET(retval); case ERTS_PORT_OP_DONE: ASSERT(is_not_internal_ref(retval)); @@ -467,7 +467,7 @@ BIF_RETTYPE erts_internal_port_info_2(BIF_ALIST_2) case ERTS_PORT_OP_DROPPED: BIF_RET(am_undefined); case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); + ASSERT(is_internal_ordinary_ref(retval)); BIF_RET(retval); case ERTS_PORT_OP_DONE: ASSERT(is_not_internal_ref(retval)); diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c index ff7746ce1d..ba183f24e8 100644 --- a/erts/emulator/beam/erl_bif_re.c +++ b/erts/emulator/beam/erl_bif_re.c @@ -1319,17 +1319,17 @@ handle_iolist: Binary *mbp = erts_create_magic_binary(sizeof(RestartContext), cleanup_restart_context_bin); RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp); - Eterm magic_bin; + Eterm magic_ref; Eterm *hp; memcpy(restartp,&restart,sizeof(RestartContext)); BUMP_ALL_REDS(p); - hp = HAlloc(p, PROC_BIN_SIZE); - magic_bin = erts_mk_magic_binary_term(&hp, &MSO(p), mbp); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + magic_ref = erts_mk_magic_ref(&hp, &MSO(p), mbp); BIF_TRAP3(&re_exec_trap_export, p, arg1, arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */, - magic_bin); + magic_ref); } res = build_exec_return(p, rc, &restart, arg1); @@ -1366,9 +1366,7 @@ static BIF_RETTYPE re_exec_trap(BIF_ALIST_3) Uint loop_limit_tmp; Eterm res; - ASSERT(ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_3)); - - mbp = ((ProcBin *) binary_val(BIF_ARG_3))->val; + mbp = erts_magic_ref2bin(BIF_ARG_3); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == cleanup_restart_context_bin); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index a480754bdb..f471390501 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -2363,7 +2363,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2) typedef struct { Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Eterm target; erts_smp_atomic32_t refc; } ErtsTraceDeliveredAll; diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c index 7c70217d8d..3fd4c87094 100644 --- a/erts/emulator/beam/erl_bif_unique.c +++ b/erts/emulator/beam/erl_bif_unique.c @@ -22,12 +22,15 @@ # include "config.h" #endif +#define ERL_BIF_UNIQUE_C__ #include "sys.h" #include "erl_vm.h" #include "erl_alloc.h" #include "export.h" #include "bif.h" #include "erl_bif_unique.h" +#include "hash.h" +#include "erl_binary.h" /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Reference * @@ -58,9 +61,20 @@ static union { static Uint32 max_thr_id; #endif +static void init_magic_ref_tables(void); + +static Uint64 ref_init_value; + static void init_reference(void) { + SysTimeval tv; + sys_gettimeofday(&tv); + ref_init_value = 0; + ref_init_value |= (Uint64) tv.tv_sec; + ref_init_value |= ((Uint64) tv.tv_usec) << 32; + ref_init_value *= (Uint64) 268438039; + ref_init_value += (Uint64) tv.tv_usec; #ifdef DEBUG max_thr_id = (Uint32) erts_no_schedulers; #ifdef ERTS_DIRTY_SCHEDULERS @@ -68,11 +82,13 @@ init_reference(void) max_thr_id += (Uint32) erts_no_dirty_io_schedulers; #endif #endif - erts_atomic64_init_nob(&global_reference.count, 0); + erts_atomic64_init_nob(&global_reference.count, + (erts_aint64_t) ref_init_value); + init_magic_ref_tables(); } static ERTS_INLINE void -global_make_ref_in_array(Uint32 thr_id, Uint32 ref[ERTS_MAX_REF_NUMBERS]) +global_make_ref_in_array(Uint32 thr_id, Uint32 ref[ERTS_REF_NUMBERS]) { Uint64 value; @@ -82,7 +98,7 @@ global_make_ref_in_array(Uint32 thr_id, Uint32 ref[ERTS_MAX_REF_NUMBERS]) } static ERTS_INLINE void -make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]) { ErtsSchedulerData *esdp = erts_get_scheduler_data(); if (esdp) @@ -92,15 +108,23 @@ make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) } void -erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +erts_make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]) +{ + make_ref_in_array(ref); +} + +void +erts_make_magic_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]) { make_ref_in_array(ref); + ASSERT(!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__)); + ref[1] |= ERTS_REF1_MAGIC_MARKER_BIT__; } -Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]) +Eterm erts_make_ref_in_buffer(Eterm buffer[ERTS_REF_THING_SIZE]) { Eterm* hp = buffer; - Uint32 ref[ERTS_MAX_REF_NUMBERS]; + Uint32 ref[ERTS_REF_NUMBERS]; make_ref_in_array(ref); write_ref_thing(hp, ref[0], ref[1], ref[2]); @@ -110,11 +134,11 @@ Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]) Eterm erts_make_ref(Process *c_p) { Eterm* hp; - Uint32 ref[ERTS_MAX_REF_NUMBERS]; + Uint32 ref[ERTS_REF_NUMBERS]; ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p)); - hp = HAlloc(c_p, REF_THING_SIZE); + hp = HAlloc(c_p, ERTS_REF_THING_SIZE); make_ref_in_array(ref); write_ref_thing(hp, ref[0], ref[1], ref[2]); @@ -122,6 +146,272 @@ Eterm erts_make_ref(Process *c_p) return make_internal_ref(hp); } +/* + * Magic reference tables + */ + +typedef struct { + HashBucket hash; + ErtsMagicBinary *mb; + Uint64 value; + Uint32 thr_id; +} ErtsMagicRefTableEntry; + +typedef struct { + erts_rwmtx_t rwmtx; + Hash hash; + char name[32]; +} ErtsMagicRefTable; + +typedef struct { + union { + ErtsMagicRefTable table; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsMagicRefTable))]; + } u; +} ErtsAlignedMagicRefTable; + +ErtsAlignedMagicRefTable *magic_ref_table; + +ErtsMagicBinary * +erts_magic_ref_lookup_bin__(Uint32 refn[ERTS_REF_NUMBERS]) +{ + ErtsMagicRefTableEntry tmpl; + ErtsMagicRefTableEntry *tep; + ErtsMagicBinary *mb; + ErtsMagicRefTable *tblp; + + ASSERT(erts_is_ref_numbers_magic(refn)); + + tmpl.value = erts_get_ref_numbers_value(refn); + tmpl.thr_id = erts_get_ref_numbers_thr_id(refn); + if (tmpl.thr_id > erts_no_schedulers) + tblp = &magic_ref_table[0].u.table; + else + tblp = &magic_ref_table[tmpl.thr_id].u.table; + + erts_rwmtx_rlock(&tblp->rwmtx); + + tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl); + if (!tep) + mb = NULL; + else { + erts_aint_t refc; + mb = tep->mb; + refc = erts_refc_inc_unless(&mb->refc, 0, 0); + if (refc == 0) + mb = NULL; + } + + erts_rwmtx_runlock(&tblp->rwmtx); + + return mb; +} + +void +erts_magic_ref_save_bin__(Eterm ref) +{ + ErtsMagicRefTableEntry tmpl; + ErtsMagicRefTableEntry *tep; + ErtsMRefThing *mrtp; + ErtsMagicRefTable *tblp; + Uint32 *refn; + + ASSERT(is_internal_magic_ref(ref)); + + mrtp = (ErtsMRefThing *) internal_ref_val(ref); + refn = mrtp->mb->refn; + + tmpl.value = erts_get_ref_numbers_value(refn); + tmpl.thr_id = erts_get_ref_numbers_thr_id(refn); + + if (tmpl.thr_id > erts_no_schedulers) + tblp = &magic_ref_table[0].u.table; + else + tblp = &magic_ref_table[tmpl.thr_id].u.table; + + erts_rwmtx_rlock(&tblp->rwmtx); + + tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl); + + erts_rwmtx_runlock(&tblp->rwmtx); + + if (!tep) { + ErtsMagicRefTableEntry *used_tep; + + ASSERT(tmpl.value == erts_get_ref_numbers_value(refn)); + ASSERT(tmpl.thr_id == erts_get_ref_numbers_thr_id(refn)); + + if (tblp != &magic_ref_table[0].u.table) { + tep = erts_alloc(ERTS_ALC_T_MREF_NSCHED_ENT, + sizeof(ErtsNSchedMagicRefTableEntry)); + } + else { + tep = erts_alloc(ERTS_ALC_T_MREF_ENT, + sizeof(ErtsMagicRefTableEntry)); + tep->thr_id = tmpl.thr_id; + } + + tep->value = tmpl.value; + tep->mb = mrtp->mb; + + erts_rwmtx_rwlock(&tblp->rwmtx); + + used_tep = hash_put(&tblp->hash, tep); + + erts_rwmtx_rwunlock(&tblp->rwmtx); + + if (used_tep != tep) { + if (tblp != &magic_ref_table[0].u.table) + erts_free(ERTS_ALC_T_MREF_NSCHED_ENT, (void *) tep); + else + erts_free(ERTS_ALC_T_MREF_ENT, (void *) tep); + } + } +} + +void +erts_magic_ref_remove_bin(Uint32 refn[ERTS_REF_NUMBERS]) +{ + ErtsMagicRefTableEntry tmpl; + ErtsMagicRefTableEntry *tep; + ErtsMagicRefTable *tblp; + + tmpl.value = erts_get_ref_numbers_value(refn); + tmpl.thr_id = erts_get_ref_numbers_thr_id(refn); + + if (tmpl.thr_id > erts_no_schedulers) + tblp = &magic_ref_table[0].u.table; + else + tblp = &magic_ref_table[tmpl.thr_id].u.table; + + erts_rwmtx_rlock(&tblp->rwmtx); + + tep = (ErtsMagicRefTableEntry *) hash_get(&tblp->hash, &tmpl); + + erts_rwmtx_runlock(&tblp->rwmtx); + + if (tep) { + + ASSERT(tmpl.value == erts_get_ref_numbers_value(refn)); + ASSERT(tmpl.thr_id == erts_get_ref_numbers_thr_id(refn)); + + erts_rwmtx_rwlock(&tblp->rwmtx); + + tep = hash_remove(&tblp->hash, &tmpl); + ASSERT(tep); + + erts_rwmtx_rwunlock(&tblp->rwmtx); + + if (tblp != &magic_ref_table[0].u.table) + erts_free(ERTS_ALC_T_MREF_NSCHED_ENT, (void *) tep); + else + erts_free(ERTS_ALC_T_MREF_ENT, (void *) tep); + } +} + +static int nsched_mreft_cmp(void *ve1, void *ve2) +{ + ErtsNSchedMagicRefTableEntry *e1 = ve1; + ErtsNSchedMagicRefTableEntry *e2 = ve2; + return e1->value != e2->value; +} + +static int non_nsched_mreft_cmp(void *ve1, void *ve2) +{ + ErtsMagicRefTableEntry *e1 = ve1; + ErtsMagicRefTableEntry *e2 = ve2; + return e1->value != e2->value || e1->thr_id != e2->thr_id; +} + +static HashValue nsched_mreft_hash(void *ve) +{ + ErtsNSchedMagicRefTableEntry *e = ve; + return (HashValue) e->value; +} + +static HashValue non_nsched_mreft_hash(void *ve) +{ + ErtsMagicRefTableEntry *e = ve; + HashValue h; + h = (HashValue) e->thr_id; + h *= 268440163; + h += (HashValue) e->value; + return h; +} + +static void *mreft_alloc(void *ve) +{ + /* + * We allocate the element before + * hash_put() and pass it as + * template which we get as + * input... + */ + return ve; +} + +static void mreft_free(void *ve) +{ + /* + * We free the element ourselves + * after hash_remove()... + */ +} + +static void *mreft_meta_alloc(int i, size_t size) +{ + return erts_alloc(ERTS_ALC_T_MREF_TAB_BKTS, size); +} + +static void mreft_meta_free(int i, void *ptr) +{ + erts_free(ERTS_ALC_T_MREF_TAB_BKTS, ptr); +} + +static void +init_magic_ref_tables(void) +{ + HashFunctions hash_funcs; + int i; + ErtsMagicRefTable *tblp; + + magic_ref_table = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_MREF_TAB, + (sizeof(ErtsAlignedMagicRefTable) + * (erts_no_schedulers + 1))); + + hash_funcs.hash = non_nsched_mreft_hash; + hash_funcs.cmp = non_nsched_mreft_cmp; + + hash_funcs.alloc = mreft_alloc; + hash_funcs.free = mreft_free; + hash_funcs.meta_alloc = mreft_meta_alloc; + hash_funcs.meta_free = mreft_meta_free; + hash_funcs.meta_print = erts_print; + + tblp = &magic_ref_table[0].u.table; + erts_snprintf(&tblp->name[0], sizeof(tblp->name), + "magic_ref_table_0"); + hash_init(0, &tblp->hash, &tblp->name[0], 1, hash_funcs); + erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table"); + + hash_funcs.hash = nsched_mreft_hash; + hash_funcs.cmp = nsched_mreft_cmp; + + for (i = 1; i <= erts_no_schedulers; i++) { + ErtsMagicRefTable *tblp = &magic_ref_table[i].u.table; + erts_snprintf(&tblp->name[0], sizeof(tblp->name), + "magic_ref_table_%d", i); + hash_init(0, &tblp->hash, &tblp->name[0], 1, hash_funcs); + erts_rwmtx_init(&tblp->rwmtx, "magic_ref_table"); + } +} + +void erts_ref_bin_free(ErtsMagicBinary *mb) +{ + erts_bin_free((Binary *) mb); +} + + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Unique Integer * \* */ @@ -498,7 +788,7 @@ void erts_sched_bif_unique_init(ErtsSchedulerData *esdp) { esdp->unique = (Uint64) 0; - esdp->ref = (Uint64) 0; + esdp->ref = (Uint64) ref_init_value; } /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ @@ -513,7 +803,7 @@ BIF_RETTYPE make_ref_0(BIF_ALIST_0) ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); - hp = HAlloc(BIF_P, REF_THING_SIZE); + hp = HAlloc(BIF_P, ERTS_REF_THING_SIZE); res = erts_sched_make_ref_in_buffer(erts_proc_sched_data(BIF_P), hp); diff --git a/erts/emulator/beam/erl_bif_unique.h b/erts/emulator/beam/erl_bif_unique.h index c6481864d0..27c2a15a5e 100644 --- a/erts/emulator/beam/erl_bif_unique.h +++ b/erts/emulator/beam/erl_bif_unique.h @@ -21,16 +21,25 @@ #ifndef ERTS_BIF_UNIQUE_H__ #define ERTS_BIF_UNIQUE_H__ +#include "erl_term.h" #include "erl_process.h" #include "big.h" +#define ERTS_BINARY_TYPES_ONLY__ +#include "erl_binary.h" +#undef ERTS_BINARY_TYPES_ONLY__ void erts_bif_unique_init(void); void erts_sched_bif_unique_init(ErtsSchedulerData *esdp); /* reference */ Eterm erts_make_ref(Process *); -Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]); -void erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]); +Eterm erts_make_ref_in_buffer(Eterm buffer[ERTS_REF_THING_SIZE]); +void erts_make_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]); +void erts_make_magic_ref_in_array(Uint32 ref[ERTS_REF_NUMBERS]); +void erts_magic_ref_remove_bin(Uint32 refn[ERTS_REF_NUMBERS]); +void erts_magic_ref_save_bin__(Eterm ref); +ErtsMagicBinary *erts_magic_ref_lookup_bin__(Uint32 refn[ERTS_REF_NUMBERS]); + /* strict monotonic counter */ @@ -67,19 +76,35 @@ Eterm erts_debug_make_unique_integer(Process *c_p, Eterm etval1); -ERTS_GLB_INLINE void erts_set_ref_numbers(Uint32 ref[ERTS_MAX_REF_NUMBERS], +ERTS_GLB_INLINE void erts_set_ref_numbers(Uint32 ref[ERTS_REF_NUMBERS], Uint32 thr_id, Uint64 value); -ERTS_GLB_INLINE Uint32 erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_MAX_REF_NUMBERS]); -ERTS_GLB_INLINE Uint64 erts_get_ref_numbers_value(Uint32 ref[ERTS_MAX_REF_NUMBERS]); +ERTS_GLB_INLINE Uint32 erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_REF_NUMBERS]); +ERTS_GLB_INLINE int erts_is_ref_numbers_magic(Uint32 ref[ERTS_REF_NUMBERS]); +ERTS_GLB_INLINE Uint64 erts_get_ref_numbers_value(Uint32 ref[ERTS_REF_NUMBERS]); ERTS_GLB_INLINE void erts_sched_make_ref_in_array(ErtsSchedulerData *esdp, - Uint32 ref[ERTS_MAX_REF_NUMBERS]); + Uint32 ref[ERTS_REF_NUMBERS]); +ERTS_GLB_INLINE void erts_sched_make_magic_ref_in_array(ErtsSchedulerData *esdp, + Uint32 ref[ERTS_REF_NUMBERS]); ERTS_GLB_INLINE Eterm erts_sched_make_ref_in_buffer(ErtsSchedulerData *esdp, - Eterm buffer[REF_THING_SIZE]); + Eterm buffer[ERTS_REF_THING_SIZE]); +ERTS_GLB_INLINE Eterm erts_mk_magic_ref(Eterm **hpp, ErlOffHeap *ohp, Binary *mbp); +ERTS_GLB_INLINE Binary *erts_magic_ref2bin(Eterm mref); +ERTS_GLB_INLINE void erts_magic_ref_save_bin(Eterm ref); +ERTS_GLB_INLINE ErtsMagicBinary *erts_magic_ref_lookup_bin(Uint32 ref[ERTS_REF_NUMBERS]); + +#define ERTS_REF1_MAGIC_MARKER_BIT_NO__ \ + (_REF_NUM_SIZE-1) +#define ERTS_REF1_MAGIC_MARKER_BIT__ \ + (((Uint32) 1) << ERTS_REF1_MAGIC_MARKER_BIT_NO__) +#define ERTS_REF1_THR_ID_MASK__ \ + (ERTS_REF1_MAGIC_MARKER_BIT__-1) +#define ERTS_REF1_NUM_MASK__ \ + (~(ERTS_REF1_THR_ID_MASK__|ERTS_REF1_MAGIC_MARKER_BIT__)) #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void -erts_set_ref_numbers(Uint32 ref[ERTS_MAX_REF_NUMBERS], Uint32 thr_id, Uint64 value) +erts_set_ref_numbers(Uint32 ref[ERTS_REF_NUMBERS], Uint32 thr_id, Uint64 value) { /* * We cannot use thread id in the first 18-bit word since @@ -87,30 +112,39 @@ erts_set_ref_numbers(Uint32 ref[ERTS_MAX_REF_NUMBERS], Uint32 thr_id, Uint64 val * we did, we would get really poor hash values. Instead * we have to shuffle the bits a bit. */ - ASSERT(thr_id == (thr_id & ((Uint32) 0x3ffff))); - ref[0] = (Uint32) (value & ((Uint64) 0x3ffff)); - ref[1] = (((Uint32) (value & ((Uint64) 0xfffc0000))) - | (thr_id & ((Uint32) 0x3ffff))); + ASSERT(thr_id == (thr_id & ((Uint32) ERTS_REF1_THR_ID_MASK__))); + ref[0] = (Uint32) (value & ((Uint64) REF_MASK)); + ref[1] = (((Uint32) (value & ((Uint64) ERTS_REF1_NUM_MASK__))) + | (thr_id & ((Uint32) ERTS_REF1_THR_ID_MASK__))); ref[2] = (Uint32) ((value >> 32) & ((Uint64) 0xffffffff)); } ERTS_GLB_INLINE Uint32 -erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +erts_get_ref_numbers_thr_id(Uint32 ref[ERTS_REF_NUMBERS]) { - return ref[1] & ((Uint32) 0x3ffff); + return ref[1] & ((Uint32) ERTS_REF1_THR_ID_MASK__); +} + +ERTS_GLB_INLINE int +erts_is_ref_numbers_magic(Uint32 ref[ERTS_REF_NUMBERS]) +{ + return !!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__); } ERTS_GLB_INLINE Uint64 -erts_get_ref_numbers_value(Uint32 ref[ERTS_MAX_REF_NUMBERS]) +erts_get_ref_numbers_value(Uint32 ref[ERTS_REF_NUMBERS]) { + ERTS_CT_ASSERT((ERTS_REF1_NUM_MASK__ | REF_MASK) == 0xffffffff); + ERTS_CT_ASSERT((ERTS_REF1_NUM_MASK__ & REF_MASK) == 0); + return (((((Uint64) ref[2]) & ((Uint64) 0xffffffff)) << 32) - | (((Uint64) ref[1]) & ((Uint64) 0xfffc0000)) - | (((Uint64) ref[0]) & ((Uint64) 0x3ffff))); + | (((Uint64) ref[1]) & ((Uint64) ERTS_REF1_NUM_MASK__)) + | (((Uint64) ref[0]) & ((Uint64) REF_MASK))); } ERTS_GLB_INLINE void erts_sched_make_ref_in_array(ErtsSchedulerData *esdp, - Uint32 ref[ERTS_MAX_REF_NUMBERS]) + Uint32 ref[ERTS_REF_NUMBERS]) { Uint64 value; @@ -119,18 +153,288 @@ erts_sched_make_ref_in_array(ErtsSchedulerData *esdp, erts_set_ref_numbers(ref, (Uint32) esdp->thr_id, value); } +ERTS_GLB_INLINE void +erts_sched_make_magic_ref_in_array(ErtsSchedulerData *esdp, + Uint32 ref[ERTS_REF_NUMBERS]) +{ + erts_sched_make_ref_in_array(esdp, ref); + ASSERT(!(ref[1] & ERTS_REF1_MAGIC_MARKER_BIT__)); + ref[1] |= ERTS_REF1_MAGIC_MARKER_BIT__; +} + ERTS_GLB_INLINE Eterm erts_sched_make_ref_in_buffer(ErtsSchedulerData *esdp, - Eterm buffer[REF_THING_SIZE]) + Eterm buffer[ERTS_REF_THING_SIZE]) { Eterm* hp = buffer; - Uint32 ref[ERTS_MAX_REF_NUMBERS]; + Uint32 ref[ERTS_REF_NUMBERS]; erts_sched_make_ref_in_array(esdp, ref); write_ref_thing(hp, ref[0], ref[1], ref[2]); return make_internal_ref(hp); } +ERTS_GLB_INLINE Eterm +erts_mk_magic_ref(Eterm **hpp, ErlOffHeap *ohp, Binary *bp) +{ + Eterm *hp = *hpp; + ASSERT(bp->flags & BIN_FLAG_MAGIC); + write_magic_ref_thing(hp, ohp, (ErtsMagicBinary *) bp); + *hpp += ERTS_MAGIC_REF_THING_SIZE; + erts_refc_inc(&bp->refc, 1); + OH_OVERHEAD(ohp, bp->orig_size / sizeof(Eterm)); + return make_internal_ref(hp); +} + +ERTS_GLB_INLINE Binary * +erts_magic_ref2bin(Eterm mref) +{ + ErtsMRefThing *mrtp; + ASSERT(is_internal_magic_ref(mref)); + mrtp = (ErtsMRefThing *) internal_ref_val(mref); + return (Binary *) mrtp->mb; +} + +/* + * Save the magic binary of a ref when the + * ref is exposed to the outside world... + */ +ERTS_GLB_INLINE void +erts_magic_ref_save_bin(Eterm ref) +{ + if (is_internal_magic_ref(ref)) + erts_magic_ref_save_bin__(ref); +} + +/* + * Look up the magic binary of a magic ref + * when the ref comes from the outside world... + */ +ERTS_GLB_INLINE ErtsMagicBinary * +erts_magic_ref_lookup_bin(Uint32 ref[ERTS_REF_NUMBERS]) +{ + if (!erts_is_ref_numbers_magic(ref)) + return NULL; + return erts_magic_ref_lookup_bin__(ref); +} + + #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +/* + * Storage of internal refs in misc structures... + */ + +#include "erl_message.h" + +#if ERTS_REF_NUMBERS != 3 +# error fix this... +#endif + +ERTS_GLB_INLINE int erts_internal_ref_number_cmp(Uint32 num1[ERTS_REF_NUMBERS], + Uint32 num2[ERTS_REF_NUMBERS]); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE int +erts_internal_ref_number_cmp(Uint32 num1[ERTS_REF_NUMBERS], + Uint32 num2[ERTS_REF_NUMBERS]) +{ + if (num1[2] != num2[2]) + return (int) ((Sint64) num1[2] - (Sint64) num2[2]); + if (num1[1] != num2[1]) + return (int) ((Sint64) num1[1] - (Sint64) num2[1]); + if (num1[0] != num2[0]) + return (int) ((Sint64) num1[0] - (Sint64) num2[0]); + return 0; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +/* Iref storage for all internal references... */ +typedef struct { + Uint32 is_magic; + union { + ErtsMagicBinary *mb; + Uint32 num[ERTS_REF_NUMBERS]; + } u; +} ErtsIRefStorage; + +void erts_ref_bin_free(ErtsMagicBinary *mb); + +ERTS_GLB_INLINE void erts_iref_storage_save(ErtsIRefStorage *iref, Eterm ref); +ERTS_GLB_INLINE void erts_iref_storage_clean(ErtsIRefStorage *iref); +ERTS_GLB_INLINE Uint erts_iref_storage_heap_size(ErtsIRefStorage *iref); +ERTS_GLB_INLINE Eterm erts_iref_storage_make_ref(ErtsIRefStorage *iref, + Eterm **hpp, ErlOffHeap *ohp, + int clean_storage); +ERTS_GLB_INLINE int erts_iref_storage_cmp(ErtsIRefStorage *iref1, + ErtsIRefStorage *iref2); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_iref_storage_save(ErtsIRefStorage *iref, Eterm ref) +{ + Eterm *hp; + + ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3); + ASSERT(is_internal_ref(ref)); + + hp = boxed_val(ref); + + if (is_ordinary_ref_thing(hp)) { + ErtsORefThing *rtp = (ErtsORefThing *) hp; + iref->is_magic = 0; + iref->u.num[0] = rtp->num[0]; + iref->u.num[1] = rtp->num[1]; + iref->u.num[2] = rtp->num[2]; + } + else { + ErtsMRefThing *mrtp = (ErtsMRefThing *) hp; + ASSERT(is_magic_ref_thing(hp)); + iref->is_magic = 1; + iref->u.mb = mrtp->mb; + erts_refc_inc(&mrtp->mb->refc, 1); + } +} + +ERTS_GLB_INLINE void +erts_iref_storage_clean(ErtsIRefStorage *iref) +{ + if (iref->is_magic && erts_refc_dectest(&iref->u.mb->refc, 0) == 0) + erts_ref_bin_free(iref->u.mb); +#ifdef DEBUG + memset((void *) iref, 0xf, sizeof(ErtsIRefStorage)); +#endif +} + +ERTS_GLB_INLINE Uint +erts_iref_storage_heap_size(ErtsIRefStorage *iref) +{ + return iref->is_magic ? ERTS_MAGIC_REF_THING_SIZE : ERTS_REF_THING_SIZE; +} + +ERTS_GLB_INLINE Eterm +erts_iref_storage_make_ref(ErtsIRefStorage *iref, + Eterm **hpp, ErlOffHeap *ohp, + int clean_storage) +{ + Eterm *hp = *hpp; + if (!iref->is_magic) { + write_ref_thing(hp, iref->u.num[0], iref->u.num[1], + iref->u.num[2]); + *hpp += ERTS_REF_THING_SIZE; + } + else { + write_magic_ref_thing(hp, ohp, iref->u.mb); + OH_OVERHEAD(ohp, iref->u.mb->orig_size / sizeof(Eterm)); + *hpp += ERTS_MAGIC_REF_THING_SIZE; + /* + * If we clean storage, the term inherits the + * refc increment of the cleaned storage... + */ + if (!clean_storage) + erts_refc_inc(&iref->u.mb->refc, 1); + } + +#ifdef DEBUG + if (clean_storage) + memset((void *) iref, 0xf, sizeof(ErtsIRefStorage)); +#endif + + return make_internal_ref(hp); +} + +ERTS_GLB_INLINE int +erts_iref_storage_cmp(ErtsIRefStorage *iref1, + ErtsIRefStorage *iref2) +{ + Uint32 *num1 = iref1->is_magic ? iref1->u.mb->refn : iref1->u.num; + Uint32 *num2 = iref2->is_magic ? iref2->u.mb->refn : iref2->u.num; + return erts_internal_ref_number_cmp(num1, num2); +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + +/* OIref storage for ordinary internal references only... */ +typedef struct { + Uint32 num[ERTS_REF_NUMBERS]; +} ErtsOIRefStorage; + +ERTS_GLB_INLINE void erts_oiref_storage_save(ErtsOIRefStorage *oiref, + Eterm ref); +ERTS_GLB_INLINE Eterm erts_oiref_storage_make_ref(ErtsOIRefStorage *oiref, + Eterm **hpp); +ERTS_GLB_INLINE int erts_oiref_storage_cmp(ErtsOIRefStorage *oiref1, + ErtsOIRefStorage *oiref2); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_oiref_storage_save(ErtsOIRefStorage *oiref, Eterm ref) +{ + ErtsORefThing *rtp; + ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3); + ASSERT(is_internal_ordinary_ref(ref)); + + rtp = (ErtsORefThing *) internal_ref_val(ref); + + oiref->num[0] = rtp->num[0]; + oiref->num[1] = rtp->num[1]; + oiref->num[2] = rtp->num[2]; +} + +ERTS_GLB_INLINE Eterm +erts_oiref_storage_make_ref(ErtsOIRefStorage *oiref, Eterm **hpp) +{ + Eterm *hp = *hpp; + ERTS_CT_ASSERT(ERTS_REF_NUMBERS == 3); + write_ref_thing(hp, oiref->num[0], oiref->num[1], oiref->num[2]); + *hpp += ERTS_REF_THING_SIZE; + return make_internal_ref(hp); +} + +ERTS_GLB_INLINE int +erts_oiref_storage_cmp(ErtsOIRefStorage *oiref1, + ErtsOIRefStorage *oiref2) +{ + return erts_internal_ref_number_cmp(oiref1->num, oiref2->num); +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + +ERTS_GLB_INLINE Eterm +erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE Eterm +erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]) +{ + Eterm *hp = HAlloc(c_p, ERTS_REF_THING_SIZE); + write_ref_thing(hp, ref[0], ref[1], ref[2]); + return make_internal_ref(hp); +} + +#endif + #endif /* ERTS_BIF_UNIQUE_H__ */ + +#if (defined(ERTS_ALLOC_C__) || defined(ERL_BIF_UNIQUE_C__)) \ + && !defined(ERTS_BIF_UNIQUE_H__FIX_ALLOC_TYPES__) +#define ERTS_BIF_UNIQUE_H__FIX_ALLOC_TYPES__ + +#include "hash.h" + +typedef struct { + HashBucket hash; + ErtsMagicBinary *mb; + Uint64 value; +} ErtsNSchedMagicRefTableEntry; + +#endif diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index fdc5efea98..c811a002ce 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -18,11 +18,146 @@ * %CopyrightEnd% */ -#ifndef __ERL_BINARY_H -#define __ERL_BINARY_H +#ifndef ERL_BINARY_H__TYPES__ +#define ERL_BINARY_H__TYPES__ + +/* +** Just like the driver binary but with initial flags +** Note that the two structures Binary and ErlDrvBinary HAVE to +** be equal except for extra fields in the beginning of the struct. +** ErlDrvBinary is defined in erl_driver.h. +** When driver_alloc_binary is called, a Binary is allocated, but +** the pointer returned is to the address of the first element that +** also occurs in the ErlDrvBinary struct (driver.*binary takes care if this). +** The driver need never know about additions to the internal Binary of the +** emulator. One should however NEVER be sloppy when mixing ErlDrvBinary +** and Binary, the macros below can convert one type to the other, as they both +** in reality are equal. +*/ + +#ifdef ARCH_32 + /* *DO NOT USE* only for alignment. */ +#define ERTS_BINARY_STRUCT_ALIGNMENT Uint32 align__; +#else +#define ERTS_BINARY_STRUCT_ALIGNMENT +#endif + +/* Add fields in ERTS_INTERNAL_BINARY_FIELDS, otherwise the drivers crash */ +#define ERTS_INTERNAL_BINARY_FIELDS \ + UWord flags; \ + erts_refc_t refc; \ + ERTS_BINARY_STRUCT_ALIGNMENT + +typedef struct binary { + ERTS_INTERNAL_BINARY_FIELDS + SWord orig_size; + char orig_bytes[1]; /* to be continued */ +} Binary; + +#define ERTS_SIZEOF_Binary(Sz) \ + (offsetof(Binary,orig_bytes) + (Sz)) + +#if ERTS_REF_NUMBERS != 3 +#error "Update ErtsMagicBinary" +#endif + +typedef struct magic_binary ErtsMagicBinary; +struct magic_binary { + ERTS_INTERNAL_BINARY_FIELDS + SWord orig_size; + void (*destructor)(Binary *); + Uint32 refn[ERTS_REF_NUMBERS]; + ErtsAlcType_t alloc_type; + union { + struct { + ERTS_BINARY_STRUCT_ALIGNMENT + char data[1]; + } aligned; + struct { + char data[1]; + } unaligned; + } u; +}; + +#ifdef ARCH_32 +#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 4 +#else +#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 0 +#endif + +typedef union { + Binary binary; + ErtsMagicBinary magic_binary; + struct { + ERTS_INTERNAL_BINARY_FIELDS + ErlDrvBinary binary; + } driver; +} ErtsBinary; + +/* + * 'Binary' alignment: + * Address of orig_bytes[0] of a Binary should always be 8-byte aligned. + * It is assumed that the flags, refc, and orig_size fields are 4 bytes on + * 32-bits architectures and 8 bytes on 64-bits architectures. + */ + +#define ERTS_MAGIC_BIN_REFN(BP) \ + ((ErtsBinary *) (BP))->magic_binary.refn +#define ERTS_MAGIC_BIN_ATYPE(BP) \ + ((ErtsBinary *) (BP))->magic_binary.alloc_type +#define ERTS_MAGIC_DATA_OFFSET \ + (offsetof(ErtsMagicBinary,u.aligned.data) - offsetof(Binary,orig_bytes)) +#define ERTS_MAGIC_BIN_DESTRUCTOR(BP) \ + ((ErtsBinary *) (BP))->magic_binary.destructor +#define ERTS_MAGIC_BIN_DATA(BP) \ + ((void *) ((ErtsBinary *) (BP))->magic_binary.u.aligned.data) +#define ERTS_MAGIC_BIN_DATA_SIZE(BP) \ + ((BP)->orig_size - ERTS_MAGIC_DATA_OFFSET) +#define ERTS_MAGIC_DATA_OFFSET \ + (offsetof(ErtsMagicBinary,u.aligned.data) - offsetof(Binary,orig_bytes)) +#define ERTS_MAGIC_BIN_ORIG_SIZE(Sz) \ + (ERTS_MAGIC_DATA_OFFSET + (Sz)) +#define ERTS_MAGIC_BIN_SIZE(Sz) \ + (offsetof(ErtsMagicBinary,u.aligned.data) + (Sz)) +#define ERTS_MAGIC_BIN_FROM_DATA(DATA) \ + ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,u.aligned.data))) + +/* On 32-bit arch these macro variants will save memory + by not forcing 8-byte alignment for the magic payload. +*/ +#define ERTS_MAGIC_BIN_UNALIGNED_DATA(BP) \ + ((void *) ((ErtsBinary *) (BP))->magic_binary.u.unaligned.data) +#define ERTS_MAGIC_UNALIGNED_DATA_OFFSET \ + (offsetof(ErtsMagicBinary,u.unaligned.data) - offsetof(Binary,orig_bytes)) +#define ERTS_MAGIC_BIN_UNALIGNED_DATA_SIZE(BP) \ + ((BP)->orig_size - ERTS_MAGIC_UNALIGNED_DATA_OFFSET) +#define ERTS_MAGIC_BIN_UNALIGNED_ORIG_SIZE(Sz) \ + (ERTS_MAGIC_UNALIGNED_DATA_OFFSET + (Sz)) +#define ERTS_MAGIC_BIN_UNALIGNED_SIZE(Sz) \ + (offsetof(ErtsMagicBinary,u.unaligned.data) + (Sz)) +#define ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(DATA) \ + ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,u.unaligned.data))) + + +#define Binary2ErlDrvBinary(B) (&((ErtsBinary *) (B))->driver.binary) +#define ErlDrvBinary2Binary(D) ((Binary *) \ + (((char *) (D)) \ + - offsetof(ErtsBinary, driver.binary))) + +/* A "magic" binary flag */ +#define BIN_FLAG_MAGIC 1 +#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */ +#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */ +#define BIN_FLAG_DRV 8 + +#endif /* ERL_BINARY_H__TYPES__ */ + +#if !defined(ERL_BINARY_H__) && !defined(ERTS_BINARY_TYPES_ONLY__) +#define ERL_BINARY_H__ #include "erl_threads.h" #include "bif.h" +#include "erl_bif_unique.h" /* * Maximum number of bytes to place in a heap binary. @@ -190,6 +325,7 @@ ERTS_GLB_INLINE Binary *erts_bin_realloc(Binary *bp, Uint size); ERTS_GLB_INLINE void erts_bin_free(Binary *bp); ERTS_GLB_INLINE Binary *erts_create_magic_binary_x(Uint size, void (*destructor)(Binary *), + ErtsAlcType_t alloc_type, int unaligned); ERTS_GLB_INLINE Binary *erts_create_magic_binary(Uint size, void (*destructor)(Binary *)); @@ -320,9 +456,12 @@ erts_bin_realloc(Binary *bp, Uint size) ERTS_GLB_INLINE void erts_bin_free(Binary *bp) { - if (bp->flags & BIN_FLAG_MAGIC) + if (bp->flags & BIN_FLAG_MAGIC) { ERTS_MAGIC_BIN_DESTRUCTOR(bp)(bp); - if (bp->flags & BIN_FLAG_DRV) + erts_magic_ref_remove_bin(ERTS_MAGIC_BIN_REFN(bp)); + erts_free(ERTS_MAGIC_BIN_ATYPE(bp), (void *) bp); + } + else if (bp->flags & BIN_FLAG_DRV) erts_free(ERTS_ALC_T_DRV_BINARY, (void *) bp); else erts_free(ERTS_ALC_T_BINARY, (void *) bp); @@ -330,29 +469,33 @@ erts_bin_free(Binary *bp) ERTS_GLB_INLINE Binary * erts_create_magic_binary_x(Uint size, void (*destructor)(Binary *), + ErtsAlcType_t alloc_type, int unaligned) { Uint bsize = unaligned ? ERTS_MAGIC_BIN_UNALIGNED_SIZE(size) : ERTS_MAGIC_BIN_SIZE(size); - Binary* bptr = erts_alloc_fnf(ERTS_ALC_T_BINARY, bsize); + Binary* bptr = erts_alloc_fnf(alloc_type, bsize); ASSERT(bsize > size); if (!bptr) - erts_alloc_n_enomem(ERTS_ALC_T2N(ERTS_ALC_T_BINARY), bsize); + erts_alloc_n_enomem(ERTS_ALC_T2N(alloc_type), bsize); ERTS_CHK_BIN_ALIGNMENT(bptr); bptr->flags = BIN_FLAG_MAGIC; bptr->orig_size = unaligned ? ERTS_MAGIC_BIN_UNALIGNED_ORIG_SIZE(size) : ERTS_MAGIC_BIN_ORIG_SIZE(size); erts_refc_init(&bptr->refc, 0); ERTS_MAGIC_BIN_DESTRUCTOR(bptr) = destructor; + ERTS_MAGIC_BIN_ATYPE(bptr) = alloc_type; + erts_make_magic_ref_in_array(ERTS_MAGIC_BIN_REFN(bptr)); return bptr; } ERTS_GLB_INLINE Binary * erts_create_magic_binary(Uint size, void (*destructor)(Binary *)) { - return erts_create_magic_binary_x(size, destructor, 0); + return erts_create_magic_binary_x(size, destructor, + ERTS_ALC_T_BINARY, 0); } #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ -#endif /* !__ERL_BINARY_H */ +#endif /* !ERL_BINARY_H__ */ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index fd092015bd..9f077dd407 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -266,7 +266,7 @@ static void schedule_free_dbtable(DbTable* tb) * Caller is *not* allowed to access the specialized part * (hash or tree) of *tb after this function has returned. */ - ASSERT(erts_refc_read(&tb->common.ref, 0) == 0); + ASSERT(erts_smp_refc_read(&tb->common.ref, 0) == 0); erts_schedule_thr_prgr_later_cleanup_op(free_dbtable, (void *) tb, &tb->release.data, @@ -600,11 +600,11 @@ done: */ static ERTS_INLINE void local_fix_table(DbTable* tb) { - erts_refc_inc(&tb->common.ref, 1); + erts_smp_refc_inc(&tb->common.ref, 1); } static ERTS_INLINE void local_unfix_table(DbTable* tb) { - if (erts_refc_dectest(&tb->common.ref, 0) == 0) { + if (erts_smp_refc_dectest(&tb->common.ref, 0) == 0) { ASSERT(IS_HASH_TABLE(tb->common.status)); db_unfix_table_hash(&(tb->hash)); } @@ -1487,7 +1487,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.type = status & ERTS_ETS_TABLE_TYPES; /* Note, 'type' is *read only* from now on... */ #endif - erts_refc_init(&tb->common.ref, 0); + erts_smp_refc_init(&tb->common.ref, 0); db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ), "db_tab", "db_tab_fix"); tb->common.keypos = keypos; @@ -2779,7 +2779,7 @@ BIF_RETTYPE ets_info_2(BIF_ALIST_2) BIF_RETTYPE ets_is_compiled_ms_1(BIF_ALIST_1) { - if (erts_db_is_compiled_ms(BIF_ARG_1)) { + if (erts_db_get_match_prog_binary(BIF_ARG_1)) { BIF_RET(am_true); } else { BIF_RET(am_false); @@ -2794,9 +2794,9 @@ BIF_RETTYPE ets_match_spec_compile_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } - hp = HAlloc(BIF_P, PROC_BIN_SIZE); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); - BIF_RET(erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mp)); + BIF_RET(erts_db_make_match_prog_ref(BIF_P, mp, &hp)); } BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) @@ -2805,24 +2805,18 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) int i = 0; Eterm *hp; Eterm lst; - ProcBin *bp; Binary *mp; Eterm res; Uint32 dummy; - if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) || !is_binary(BIF_ARG_2)) { + if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL)) { error: BIF_ERROR(BIF_P, BADARG); } - bp = (ProcBin*) binary_val(BIF_ARG_2); - if (thing_subtag(bp->thing_word) != REFC_BINARY_SUBTAG) { + mp = erts_db_get_match_prog_binary(BIF_ARG_2); + if (!mp) goto error; - } - mp = bp->val; - if (!IsMatchProgBinary(mp)) { - goto error; - } if (BIF_ARG_1 == NIL) { BIF_RET(BIF_ARG_3); @@ -2990,7 +2984,7 @@ void init_db(ErtsDbSpinCount db_spin_count) meta_pid_to_tab->common.meth = &db_hash; meta_pid_to_tab->common.compress = 0; - erts_refc_init(&meta_pid_to_tab->common.ref, 0); + erts_smp_refc_init(&meta_pid_to_tab->common.ref, 0); /* Neither rwlock or fixlock used db_init_lock(meta_pid_to_tab, "meta_pid_to_tab", "meta_pid_to_tab_FIX");*/ @@ -3021,7 +3015,7 @@ void init_db(ErtsDbSpinCount db_spin_count) meta_pid_to_fixed_tab->common.meth = &db_hash; meta_pid_to_fixed_tab->common.compress = 0; - erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 0); + erts_smp_refc_init(&meta_pid_to_fixed_tab->common.ref, 0); /* Neither rwlock or fixlock used db_init_lock(meta_pid_to_fixed_tab, "meta_pid_to_fixed_tab", "meta_pid_to_fixed_tab_FIX");*/ @@ -3382,7 +3376,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) if ((*pp)->pid == pid) { DbFixation* fix = *pp; erts_aint_t diff = -((erts_aint_t) fix->counter); - erts_refc_add(&tb->common.ref,diff,0); + erts_smp_refc_add(&tb->common.ref,diff,0); *pp = fix->next; erts_db_free(ERTS_ALC_T_DB_FIXATION, tb, fix, sizeof(DbFixation)); @@ -3458,7 +3452,7 @@ static void fix_table_locked(Process* p, DbTable* tb) #ifdef ERTS_SMP erts_smp_mtx_lock(&tb->common.fixlock); #endif - erts_refc_inc(&tb->common.ref,1); + erts_smp_refc_inc(&tb->common.ref,1); fix = tb->common.fixations; if (fix == NULL) { tb->common.time.monotonic @@ -3514,7 +3508,7 @@ static void unfix_table_locked(Process* p, DbTable* tb, for (pp = &tb->common.fixations; *pp != NULL; pp = &(*pp)->next) { if ((*pp)->pid == p->common.id) { DbFixation* fix = *pp; - erts_refc_dec(&tb->common.ref,0); + erts_smp_refc_dec(&tb->common.ref,0); --(fix->counter); ASSERT(fix->counter >= 0); if (fix->counter > 0) { @@ -3563,7 +3557,7 @@ static void free_fixations_locked(DbTable *tb) fix = tb->common.fixations; while (fix != NULL) { erts_aint_t diff = -((erts_aint_t) fix->counter); - erts_refc_add(&tb->common.ref,diff,0); + erts_smp_refc_add(&tb->common.ref,diff,0); next_fix = fix->next; db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC); db_erase_bag_exact2(meta_pid_to_fixed_tab, diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index b2a231467b..bb29d56aa7 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -1287,15 +1287,13 @@ static int db_select_continue_hash(Process *p, if (arityval(*tptr) != 6) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - if (!is_small(tptr[2]) || !is_small(tptr[3]) || !is_binary(tptr[4]) || + if (!is_small(tptr[2]) || !is_small(tptr[3]) || !(is_list(tptr[5]) || tptr[5] == NIL) || !is_small(tptr[6])) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); if ((chunk_size = signed_val(tptr[3])) < 0) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - if (!(thing_subtag(*binary_val(tptr[4])) == REFC_BINARY_SUBTAG)) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - mp = ((ProcBin *) binary_val(tptr[4]))->val; - if (!IsMatchProgBinary(mp)) + mp = erts_db_get_match_prog_binary(tptr[4]); + if (!mp) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); all_objects = mp->flags & BIN_FLAG_ALL_OBJECTS; match_list = tptr[5]; @@ -1554,8 +1552,8 @@ done: been in 'user space' */ } if (rest != NIL || slot_ix >= 0) { /* Need more calls */ - hp = HAlloc(p,3+7+PROC_BIN_SIZE); - mpb =db_make_mp_binary(p,(mpi.mp),&hp); + hp = HAlloc(p,3+7+ERTS_MAGIC_REF_THING_SIZE); + mpb = erts_db_make_match_prog_ref(p,(mpi.mp),&hp); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; continuation = TUPLE6(hp, tb->common.id,make_small(slot_ix), @@ -1580,8 +1578,8 @@ trap: BUMP_ALL_REDS(p); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - hp = HAlloc(p,7+PROC_BIN_SIZE); - mpb =db_make_mp_binary(p,(mpi.mp),&hp); + hp = HAlloc(p,7+ERTS_MAGIC_REF_THING_SIZE); + mpb = erts_db_make_match_prog_ref(p,(mpi.mp),&hp); continuation = TUPLE6(hp, tb->common.id, make_small(slot_ix), make_small(chunk_size), mpb, match_list, @@ -1693,15 +1691,15 @@ done: trap: BUMP_ALL_REDS(p); if (IS_USMALL(0, got)) { - hp = HAlloc(p, PROC_BIN_SIZE + 5); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE + 5); egot = make_small(got); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + PROC_BIN_SIZE + 5); + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + ERTS_MAGIC_REF_THING_SIZE + 5); egot = uint_to_big(got, hp); hp += BIG_UINT_HEAP_SIZE; } - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix), mpb, egot); @@ -1838,15 +1836,15 @@ done: trap: BUMP_ALL_REDS(p); if (IS_USMALL(0, got)) { - hp = HAlloc(p, PROC_BIN_SIZE + 5); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE + 5); egot = make_small(got); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + PROC_BIN_SIZE + 5); + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + ERTS_MAGIC_REF_THING_SIZE + 5); egot = uint_to_big(got, hp); hp += BIG_UINT_HEAP_SIZE; } - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix), mpb, egot); @@ -1887,7 +1885,7 @@ static int db_select_delete_continue_hash(Process *p, tptr = tuple_val(continuation); slot_ix = unsigned_val(tptr[2]); - mp = ((ProcBin *) binary_val(tptr[3]))->val; + mp = erts_db_get_match_prog_binary_unchecked(tptr[3]); if (is_big(tptr[4])) { got = big_to_uint32(tptr[4]); } else { @@ -1999,7 +1997,7 @@ static int db_select_count_continue_hash(Process *p, tptr = tuple_val(continuation); slot_ix = unsigned_val(tptr[2]); - mp = ((ProcBin *) binary_val(tptr[3]))->val; + mp = erts_db_get_match_prog_binary_unchecked(tptr[3]); if (is_big(tptr[4])) { got = big_to_uint32(tptr[4]); } else { diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index dd9403e132..c4ecd2ba37 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -935,17 +935,15 @@ static int db_select_continue_tree(Process *p, if (arityval(*tptr) != 8) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - if (!is_small(tptr[4]) || !is_binary(tptr[5]) || + if (!is_small(tptr[4]) || !(is_list(tptr[6]) || tptr[6] == NIL) || !is_small(tptr[7]) || !is_small(tptr[8])) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); lastkey = tptr[2]; end_condition = tptr[3]; - if (!(thing_subtag(*binary_val(tptr[5])) == REFC_BINARY_SUBTAG)) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - mp = ((ProcBin *) binary_val(tptr[5]))->val; - if (!IsMatchProgBinary(mp)) + mp = erts_db_get_match_prog_binary(tptr[5]); + if (!mp) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); chunk_size = signed_val(tptr[4]); @@ -1145,11 +1143,11 @@ static int db_select_tree(Process *p, DbTable *tbl, key = GETKEY(tb, sc.lastobj); sz = size_object(key); - hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - mpb=db_make_mp_binary(p,mpi.mp,&hp); + mpb= erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 (hp, @@ -1208,10 +1206,8 @@ static int db_select_count_continue_tree(Process *p, lastkey = tptr[2]; end_condition = tptr[3]; - if (!(thing_subtag(*binary_val(tptr[4])) == REFC_BINARY_SUBTAG)) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - mp = ((ProcBin *) binary_val(tptr[4]))->val; - if (!IsMatchProgBinary(mp)) + mp = erts_db_get_match_prog_binary(tptr[4]); + if (!mp) RET_TO_BIF(NIL,DB_ERROR_BADPARAM); sc.p = p; @@ -1338,18 +1334,18 @@ static int db_select_count_tree(Process *p, DbTable *tbl, key = GETKEY(tb, sc.lastobj); sz = size_object(key); if (IS_USMALL(0, sc.got)) { - hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); + hp = HAlloc(p, sz + ERTS_MAGIC_REF_THING_SIZE + 6); egot = make_small(sc.got); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + PROC_BIN_SIZE + 6); + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + ERTS_MAGIC_REF_THING_SIZE + 6); egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE5 (hp, @@ -1470,11 +1466,11 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, key = GETKEY(tb, sc.lastobj); sz = size_object(key); - hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 (hp, @@ -1495,12 +1491,12 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, key = GETKEY(tb, sc.lastobj); sz = size_object(key); - hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 (hp, tb->common.id, @@ -1558,7 +1554,7 @@ static int db_select_delete_continue_tree(Process *p, sc.erase_lastterm = 0; /* Before first RET_TO_BIF */ sc.lastterm = NULL; - mp = ((ProcBin *) binary_val(tptr[4]))->val; + mp = erts_db_get_match_prog_binary_unchecked(tptr[4]); sc.p = p; sc.tb = tb; if (is_big(tptr[5])) { @@ -1682,16 +1678,16 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); sz = size_object(key); if (IS_USMALL(0, sc.accum)) { - hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); + hp = HAlloc(p, sz + ERTS_MAGIC_REF_THING_SIZE + 6); eaccsum = make_small(sc.accum); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + PROC_BIN_SIZE + 6); + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + ERTS_MAGIC_REF_THING_SIZE + 6); eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } key = copy_struct(key, sz, &hp, &MSO(p)); - mpb = db_make_mp_binary(p,mpi.mp,&hp); + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE5 (hp, diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 4e987d5bee..070e29578f 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2545,14 +2545,6 @@ success: } -/* - * Convert a match program to a "magic" binary to return up to erlang - */ -Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) -{ - return erts_mk_magic_binary_term(hpp, &MSO(p), mp); -} - DMCErrInfo *db_new_dmc_err_info(void) { DMCErrInfo *ret = erts_alloc(ERTS_ALC_T_DB_DMC_ERR_INFO, @@ -3107,7 +3099,7 @@ void db_cleanup_offheap_comp(DbTerm* obj) break; case FUN_SUBTAG: ASSERT(u.pb != &tmp); - if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) { + if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) { erts_erase_fun_entry(u.fun->fe); } break; @@ -3266,13 +3258,6 @@ int db_has_variable(Eterm node) { return 0; } -int erts_db_is_compiled_ms(Eterm term) -{ - return (is_binary(term) - && (thing_subtag(*binary_val(term)) == REFC_BINARY_SUBTAG) - && IsMatchProgBinary((((ProcBin *) binary_val(term))->val))); -} - /* ** Local (static) utilities. */ @@ -5289,24 +5274,35 @@ void db_match_dis(Binary *bp) case matchEqRef: ++t; { - RefThing *rt = (RefThing *) t; + Uint32 *num; int ri; - n = thing_arityval(rt->header); - erts_printf("EqRef\t(%d) {", (int) n); + + if (is_ordinary_ref_thing(t)) { + ErtsORefThing *rt = (ErtsORefThing *) t; + num = rt->num; + t += TermWords(ERTS_REF_THING_SIZE); + } + else { + ErtsMRefThing *mrt = (ErtsMRefThing *) t; + ASSERT(is_magic_ref_thing(t)); + num = mrt->mb->refn; + t += TermWords(ERTS_MAGIC_REF_THING_SIZE); + } + + erts_printf("EqRef\t(%d) {", (int) ERTS_REF_NUMBERS); first = 1; - for (ri = 0; ri < n; ++ri) { + for (ri = 0; ri < ERTS_REF_NUMBERS; ++ri) { if (first) first = 0; else erts_printf(", "); #if defined(ARCH_64) - erts_printf("0x%016bex", rt->data.ui[ri]); + erts_printf("0x%016bex", num[ri]); #else - erts_printf("0x%08bex", rt->data.ui[ri]); + erts_printf("0x%08bex", num[ri]); #endif } } - t += TermWords(REF_THING_SIZE); erts_printf("}\n"); break; case matchEqBig: diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 49e5f6b4cf..b2a3bb6c20 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -23,6 +23,7 @@ #include "global.h" #include "erl_message.h" +#include "erl_bif_unique.h" /*#define HARDDEBUG 1*/ @@ -211,7 +212,7 @@ typedef struct db_fixation { */ typedef struct db_table_common { - erts_refc_t ref; /* fixation counter */ + erts_smp_refc_t ref; /* fixation counter */ #ifdef ERTS_SMP erts_smp_rwmtx_t rwlock; /* rw lock on table */ erts_smp_mtx_t fixlock; /* Protects fixations,megasec,sec,microsec */ @@ -260,7 +261,7 @@ typedef struct db_table_common { (DB_BAG | DB_SET | DB_DUPLICATE_BAG))) #define IS_TREE_TABLE(Status) (!!((Status) & \ DB_ORDERED_SET)) -#define NFIXED(T) (erts_refc_read(&(T)->common.ref,0)) +#define NFIXED(T) (erts_smp_refc_read(&(T)->common.ref,0)) #define IS_FIXED(T) (NFIXED(T) != 0) /* @@ -456,10 +457,44 @@ Eterm db_format_dmc_err_info(Process *p, DMCErrInfo *ei); void db_free_dmc_err_info(DMCErrInfo *ei); /* Completely free's an error info structure, including all recorded errors */ -Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp); -/* Convert a match program to a erlang "magic" binary to be returned to userspace, - increments the reference counter. */ -int erts_db_is_compiled_ms(Eterm term); + +ERTS_GLB_INLINE Eterm erts_db_make_match_prog_ref(Process *p, Binary *mp, Eterm **hpp); +ERTS_GLB_INLINE Binary *erts_db_get_match_prog_binary(Eterm term); +ERTS_GLB_INLINE Binary *erts_db_get_match_prog_binary_unchecked(Eterm term); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +/* + * Convert a match program to a "magic" ref to return up to erlang + */ +ERTS_GLB_INLINE Eterm erts_db_make_match_prog_ref(Process *p, Binary *mp, Eterm **hpp) +{ + return erts_mk_magic_ref(hpp, &MSO(p), mp); +} + +ERTS_GLB_INLINE Binary * +erts_db_get_match_prog_binary_unchecked(Eterm term) +{ + Binary *bp = erts_magic_ref2bin(term); + ASSERT(bp->flags & BIN_FLAG_MAGIC); + ASSERT((ERTS_MAGIC_BIN_DESTRUCTOR(bp) == erts_db_match_prog_destructor)); + return bp; +} + +ERTS_GLB_INLINE Binary * +erts_db_get_match_prog_binary(Eterm term) +{ + Binary *bp; + if (!is_internal_magic_ref(term)) + return NULL; + bp = erts_magic_ref2bin(term); + ASSERT(bp->flags & BIN_FLAG_MAGIC); + if (ERTS_MAGIC_BIN_DESTRUCTOR(bp) != erts_db_match_prog_destructor) + return NULL; + return bp; +} + +#endif /* ** Convenience when compiling into Binary structures diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c index 3526bb684d..517dad9cbb 100644 --- a/erts/emulator/beam/erl_debug.c +++ b/erts/emulator/beam/erl_debug.c @@ -130,7 +130,7 @@ pdisplay1(fmtfn_t to, void *to_arg, Process* p, Eterm obj) Uint32 *ref_num; erts_print(to, to_arg, "#Ref<%lu", ref_channel_no(obj)); ref_num = ref_numbers(obj); - for (i = ref_no_of_numbers(obj)-1; i >= 0; i--) + for (i = ref_no_numbers(obj)-1; i >= 0; i--) erts_print(to, to_arg, ",%lu", ref_num[i]); erts_print(to, to_arg, ">"); break; diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c index 41097203d4..cedc0517e1 100644 --- a/erts/emulator/beam/erl_fun.c +++ b/erts/emulator/beam/erl_fun.c @@ -113,9 +113,9 @@ erts_put_fun_entry(Eterm mod, int uniq, int index) fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template); sys_memset(fe->uniq, 0, sizeof(fe->uniq)); fe->index = 0; - refc = erts_refc_inctest(&fe->refc, 0); + refc = erts_smp_refc_inctest(&fe->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&fe->refc, 1); + erts_smp_refc_inc(&fe->refc, 1); erts_fun_write_unlock(); return fe; } @@ -137,9 +137,9 @@ erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index, sys_memcpy(fe->uniq, uniq, sizeof(fe->uniq)); fe->index = index; fe->arity = arity; - refc = erts_refc_inctest(&fe->refc, 0); + refc = erts_smp_refc_inctest(&fe->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&fe->refc, 1); + erts_smp_refc_inc(&fe->refc, 1); erts_fun_write_unlock(); return fe; } @@ -164,9 +164,9 @@ erts_get_fun_entry(Eterm mod, int uniq, int index) erts_fun_read_lock(); ret = (ErlFunEntry *) hash_get(&erts_fun_table, (void*) &template); if (ret) { - erts_aint_t refc = erts_refc_inctest(&ret->refc, 1); + erts_aint_t refc = erts_smp_refc_inctest(&ret->refc, 1); if (refc < 2) /* Pending delete */ - erts_refc_inc(&ret->refc, 1); + erts_smp_refc_inc(&ret->refc, 1); } erts_fun_read_unlock(); return ret; @@ -187,7 +187,7 @@ erts_erase_fun_entry(ErlFunEntry* fe) * We have to check refc again since someone might have looked up * the fun entry and incremented refc after last check. */ - if (erts_refc_dectest(&fe->refc, -1) <= 0) + if (erts_smp_refc_dectest(&fe->refc, -1) <= 0) #endif { if (fe->address != unloaded_fun) @@ -274,7 +274,7 @@ erts_fun_purge_complete(ErlFunEntry **funs, Uint no) #ifdef HIPE fe->pend_purge_native_address = NULL; #endif - if (erts_refc_dectest(&fe->refc, 0) == 0) + if (erts_smp_refc_dectest(&fe->refc, 0) == 0) erts_erase_fun_entry(fe); } ERTS_SMP_WRITE_MEMORY_BARRIER; @@ -306,7 +306,7 @@ erts_dump_fun_entries(fmtfn_t to, void *to_arg) #ifdef HIPE erts_print(to, to_arg, "Native_address: %p\n", fe->native_address); #endif - erts_print(to, to_arg, "Refc: %ld\n", erts_refc_read(&fe->refc, 1)); + erts_print(to, to_arg, "Refc: %ld\n", erts_smp_refc_read(&fe->refc, 1)); b = b->next; } } @@ -337,7 +337,7 @@ fun_alloc(ErlFunEntry* template) obj->old_uniq = template->old_uniq; obj->old_index = template->old_index; obj->module = template->module; - erts_refc_init(&obj->refc, -1); + erts_smp_refc_init(&obj->refc, -1); obj->address = unloaded_fun; obj->pend_purge_address = NULL; #ifdef HIPE diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h index 83899f24a6..e3073eb874 100644 --- a/erts/emulator/beam/erl_fun.h +++ b/erts/emulator/beam/erl_fun.h @@ -42,7 +42,7 @@ typedef struct erl_fun_entry { Uint arity; /* The arity of the fun. */ Eterm module; /* Tagged atom for module. */ - erts_refc_t refc; /* Reference count: One for code + one for each + erts_smp_refc_t refc; /* Reference count: One for code + one for each fun object in each process. */ BeamInstr *pend_purge_address; /* address stored during a pending purge */ #ifdef HIPE diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 3a3ad820b5..cb3a189e8f 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -178,7 +178,7 @@ Uint erts_test_long_gc_sleep; /* Only used for testing... */ typedef struct { Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; } ErtsGCInfoReq; @@ -2354,6 +2354,9 @@ copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap, switch (val & _HEADER_SUBTAG_MASK) { case ARITYVAL_SUBTAG: break; + case REF_SUBTAG: + if (is_ordinary_ref_thing(fhp - 1)) + goto the_default; case REFC_BINARY_SUBTAG: case FUN_SUBTAG: case EXTERNAL_PID_SUBTAG: @@ -2363,6 +2366,7 @@ copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap, cpy_sz = thing_arityval(val); goto cpy_words; default: + the_default: cpy_sz = header_arity(val); cpy_words: @@ -2796,6 +2800,16 @@ link_live_proc_bin(struct shrink_cand_data *shrink, *prevppp = &pbp->next; } +#ifdef ERTS_MAGIC_REF_THING_HEADER +/* + * ERTS_MAGIC_REF_THING_HEADER only defined when there + * is a size difference between magic and ordinary references... + */ +# define ERTS_USED_MAGIC_REF_THING_HEADER__ ERTS_MAGIC_REF_THING_HEADER +#else +# define ERTS_USED_MAGIC_REF_THING_HEADER__ ERTS_REF_THING_HEADER +#endif + static void sweep_off_heap(Process *p, int fullsweep) @@ -2828,7 +2842,8 @@ sweep_off_heap(Process *p, int fullsweep) ASSERT(!ErtsInArea(ptr, oheap, oheap_sz)); *prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word); ASSERT(!IS_MOVED_BOXED(ptr->thing_word)); - if (ptr->thing_word == HEADER_PROC_BIN) { + switch (ptr->thing_word) { + case HEADER_PROC_BIN: { int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz); ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1))); if (to_new_heap) { @@ -2837,13 +2852,28 @@ sweep_off_heap(Process *p, int fullsweep) BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/ } link_live_proc_bin(&shrink, &prev, &ptr, to_new_heap); - } - else { + break; + } + case ERTS_USED_MAGIC_REF_THING_HEADER__: { + Uint size; + int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz); + ASSERT(is_magic_ref_thing(ptr)); + ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1))); + size = (Uint) ((ErtsMRefThing *) ptr)->mb->orig_size; + if (to_new_heap) + bin_vheap += size / sizeof(Eterm); + else + BIN_OLD_VHEAP(p) += size / sizeof(Eterm); /* for binary gc (words)*/ + /* fall through... */ + } + default: prev = &ptr->next; ptr = ptr->next; } } - else if (!ErtsInArea(ptr, oheap, oheap_sz)) { + else if (ErtsInArea(ptr, oheap, oheap_sz)) + break; /* and let old-heap loop continue */ + else { /* garbage */ switch (thing_subtag(ptr->thing_word)) { case REFC_BINARY_SUBTAG: @@ -2857,18 +2887,26 @@ sweep_off_heap(Process *p, int fullsweep) case FUN_SUBTAG: { ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe; - if (erts_refc_dectest(&fe->refc, 0) == 0) { + if (erts_smp_refc_dectest(&fe->refc, 0) == 0) { erts_erase_fun_entry(fe); } break; } + case REF_SUBTAG: + { + ErtsMagicBinary *bptr; + ASSERT(is_magic_ref_thing(ptr)); + bptr = ((ErtsMRefThing *) ptr)->mb; + if (erts_refc_dectest(&bptr->refc, 0) == 0) + erts_bin_free((Binary *) bptr); + break; + } default: ASSERT(is_external_header(ptr->thing_word)); erts_deref_node_entry(((ExternalThing*)ptr)->node); } *prev = ptr = ptr->next; } - else break; /* and let old-heap loop continue */ } /* The rest of the list resides on old-heap, and we just did a @@ -2877,15 +2915,24 @@ sweep_off_heap(Process *p, int fullsweep) while (ptr) { ASSERT(ErtsInArea(ptr, oheap, oheap_sz)); ASSERT(!IS_MOVED_BOXED(ptr->thing_word)); - if (ptr->thing_word == HEADER_PROC_BIN) { + switch (ptr->thing_word) { + case HEADER_PROC_BIN: BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/ link_live_proc_bin(&shrink, &prev, &ptr, 0); - } - else { - ASSERT(is_fun_header(ptr->thing_word) || - is_external_header(ptr->thing_word)); - prev = &ptr->next; - ptr = ptr->next; + break; + case ERTS_USED_MAGIC_REF_THING_HEADER__: + ASSERT(is_magic_ref_thing(ptr)); + BIN_OLD_VHEAP(p) += + (((Uint) ((ErtsMRefThing *) ptr)->mb->orig_size) + / sizeof(Eterm)); /* for binary gc (words)*/ + /* fall through... */ + default: + ASSERT(is_fun_header(ptr->thing_word) || + is_external_header(ptr->thing_word) + || is_magic_ref_thing(ptr)); + prev = &ptr->next; + ptr = ptr->next; + break; } } @@ -2978,6 +3025,9 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) } tari = thing_arityval(val); switch (thing_subtag(val)) { + case REF_SUBTAG: + if (is_ordinary_ref_thing(hp)) + break; case REFC_BINARY_SUBTAG: case FUN_SUBTAG: case EXTERNAL_PID_SUBTAG: @@ -3175,7 +3225,7 @@ reply_gc_info(void *vgcirp) if (hpp) ref_copy = STORE_NC(hpp, ohp, gcirp->ref); else - *szp += REF_THING_SIZE; + *szp += ERTS_REF_THING_SIZE; msg = erts_bld_tuple(hpp, szp, 3, make_small(esdp->no), @@ -3519,12 +3569,16 @@ erts_check_off_heap2(Process *p, Eterm *htop) refc = erts_refc_read(&u.pb->val->refc, 1); break; case FUN_SUBTAG: - refc = erts_refc_read(&u.fun->fe->refc, 1); + refc = erts_smp_refc_read(&u.fun->fe->refc, 1); break; case EXTERNAL_PID_SUBTAG: case EXTERNAL_PORT_SUBTAG: case EXTERNAL_REF_SUBTAG: - refc = erts_refc_read(&u.ext->node->refc, 1); + refc = erts_smp_refc_read(&u.ext->node->refc, 1); + break; + case REF_SUBTAG: + ASSERT(is_magic_ref_thing(u.hdr)); + refc = erts_refc_read(&u.mref->mb->refc, 1); break; default: ASSERT(!"erts_check_off_heap2: Invalid thing_word"); diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index 647fa26811..26be8c7edf 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -1771,7 +1771,7 @@ setup_bif_timer(Process *c_p, ErtsMonotonicTime timeout_pos, esdp = erts_proc_sched_data(c_p); - hp = HAlloc(c_p, REF_THING_SIZE); + hp = HAlloc(c_p, ERTS_REF_THING_SIZE); ref = erts_sched_make_ref_in_buffer(esdp, hp); ASSERT(erts_get_ref_numbers_thr_id( @@ -1939,7 +1939,7 @@ access_sched_local_btm(Process *c_p, Eterm pid, Eterm *hp_end; #endif - hsz = REF_THING_SIZE; + hsz = ERTS_REF_THING_SIZE; if (async) { refn = trefn; /* timer ref */ hsz += 4; /* 3-tuple */ @@ -1973,7 +1973,7 @@ access_sched_local_btm(Process *c_p, Eterm pid, refn[1], refn[2]); ref = make_internal_ref(hp); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; msg = (async ? TUPLE3(hp, (cancel @@ -2087,7 +2087,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN; ErlOffHeap *ohp; - hsz = 4 + REF_THING_SIZE; + hsz = 4 + ERTS_REF_THING_SIZE; if (time_left > (Sint64) MAX_SMALL) hsz += ERTS_SINT64_HEAP_SIZE(time_left); @@ -2103,7 +2103,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, trefn[1], trefn[2]); tref = make_internal_ref(hp); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; if (time_left < 0) res = am_false; @@ -2189,7 +2189,7 @@ access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info) Eterm *hp, rref; Uint32 *rrefn; - hp = HAlloc(c_p, REF_THING_SIZE); + hp = HAlloc(c_p, ERTS_REF_THING_SIZE); rref = erts_sched_make_ref_in_buffer(esdp, hp); rrefn = internal_ref_numbers(rref); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 88bd002a8c..b2c307e826 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -111,12 +111,19 @@ const int etp_lock_check = 1; #else const int etp_lock_check = 0; #endif -#ifdef WORDS_BIGENDIAN -const int etp_big_endian = 1; +const int etp_endianness = ERTS_ENDIANNESS; +const Eterm etp_ref_header = ERTS_REF_THING_HEADER; +#ifdef ERTS_MAGIC_REF_THING_HEADER +const Eterm etp_magic_ref_header = ERTS_MAGIC_REF_THING_HEADER; #else -const int etp_big_endian = 0; +const Eterm etp_magic_ref_header = ERTS_REF_THING_HEADER; #endif const Eterm etp_the_non_value = THE_NON_VALUE; +#ifdef ERTS_HOLE_MARKER +const Eterm etp_hole_marker = ERTS_HOLE_MARKER; +#else +const Eterm etp_hole_marker = 0; +#endif /* * Note about VxWorks: All variables must be initialized by executable code, @@ -767,6 +774,8 @@ early_init(int *argc, char **argv) /* H_MAX_SIZE = H_DEFAULT_MAX_SIZE; H_MAX_FLAGS = MAX_HEAP_SIZE_KILL|MAX_HEAP_SIZE_LOG; + erts_term_init(); + erts_initialized = 0; erts_use_sender_punish = 1; @@ -1138,6 +1147,8 @@ early_init(int *argc, char **argv) /* no_schedulers_online = schdlrs_onln; erts_no_schedulers = (Uint) no_schedulers; +#else + erts_no_schedulers = 1; #endif #ifdef ERTS_DIRTY_SCHEDULERS erts_no_dirty_cpu_schedulers = no_dirty_cpu_schedulers = dirty_cpu_scheds; diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 08dcbed91c..c98581a45e 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -156,6 +156,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "tracer_mtx", NULL }, { "port_table", NULL }, #endif + { "magic_ref_table", "address" }, { "mtrace_op", NULL }, { "instr_x", NULL }, { "instr", NULL }, diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 979a0040b0..990be8efb2 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -1197,7 +1197,7 @@ static void hashmap_merge_ctx_destructor(Binary* ctx_bin) } BIF_RETTYPE maps_merge_trap_1(BIF_ALIST_1) { - Binary* ctx_bin = ((ProcBin *) binary_val(BIF_ARG_1))->val; + Binary* ctx_bin = erts_magic_ref2bin(BIF_ARG_1); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(ctx_bin) == hashmap_merge_ctx_destructor); @@ -1453,9 +1453,9 @@ trap: /* Yield */ hashmap_merge_ctx_destructor); ctx = ERTS_MAGIC_BIN_DATA(ctx_b); sys_memcpy(ctx, &local_ctx, sizeof(HashmapMergeContext)); - hp = HAlloc(p, PROC_BIN_SIZE); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); ASSERT(ctx->trap_bin == THE_NON_VALUE); - ctx->trap_bin = erts_mk_magic_binary_term(&hp, &MSO(p), ctx_b); + ctx->trap_bin = erts_mk_magic_ref(&hp, &MSO(p), ctx_b); erts_set_gc_state(p, 0); } diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 547e9cac64..f181c1e3cb 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -172,10 +172,15 @@ erts_cleanup_offheap(ErlOffHeap *offheap) } break; case FUN_SUBTAG: - if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) { + if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) { erts_erase_fun_entry(u.fun->fe); } break; + case REF_SUBTAG: + ASSERT(is_magic_ref_thing(u.hdr)); + if (erts_refc_dectest(&u.mref->mb->refc, 0) == 0) + erts_bin_free((Binary *)u.mref->mb); + break; default: ASSERT(is_external_header(u.hdr->thing_word)); erts_deref_node_entry(u.ext->node); diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index 910598690d..bdfc7f30d9 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -45,6 +45,7 @@ #include "bif.h" #include "big.h" #include "erl_monitors.h" +#include "erl_bif_unique.h" #define STACK_NEED 50 #define MAX_MONITORS 0xFFFFFFFFUL @@ -79,7 +80,24 @@ static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2) b2 = boxed_val(ref2); if (is_ref_thing_header(*b1)) { if (is_ref_thing_header(*b2)) { - return memcmp(b1+1,b2+1,ERTS_REF_WORDS*sizeof(Uint)); + Uint32 *num1, *num2; + if (is_ordinary_ref_thing(b1)) { + ErtsORefThing *rtp = (ErtsORefThing *) b1; + num1 = rtp->num; + } + else { + ErtsMRefThing *mrtp = (ErtsMRefThing *) b1; + num1 = mrtp->mb->refn; + } + if (is_ordinary_ref_thing(b2)) { + ErtsORefThing *rtp = (ErtsORefThing *) b2; + num2 = rtp->num; + } + else { + ErtsMRefThing *mrtp = (ErtsMRefThing *) b2; + num2 = mrtp->mb->refn; + } + return erts_internal_ref_number_cmp(num1, num2); } return -1; } @@ -97,14 +115,15 @@ do { \ Uint i__; \ Uint len__; \ ASSERT((Hp)); \ - ASSERT(is_internal_ref((From)) || is_external((From))); \ + ASSERT(is_internal_ordinary_ref((From)) \ + || is_external((From))); \ (To) = make_boxed((Hp)); \ len__ = thing_arityval(*boxed_val((From))) + 1; \ for(i__ = 0; i__ < len__; i__++) \ (*((Hp)++)) = boxed_val((From))[i__]; \ if (is_external((To))) { \ external_thing_ptr((To))->next = NULL; \ - erts_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\ + erts_smp_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\ } \ } \ } while (0) @@ -339,6 +358,8 @@ void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid, int state = 0; ErtsMonitor **this = root; Sint c; + + ASSERT(is_internal_ordinary_ref(ref) || is_external_ref(ref)); dstack[0] = DIR_END; for (;;) { diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h index 9e2beedea3..bb493bf336 100644 --- a/erts/emulator/beam/erl_monitors.h +++ b/erts/emulator/beam/erl_monitors.h @@ -91,7 +91,7 @@ /* Size of a monitor without heap, in words (fixalloc) */ #define ERTS_MONITOR_SIZE ((sizeof(ErtsMonitor) - sizeof(Uint))/sizeof(Uint)) -#define ERTS_MONITOR_SH_SIZE (ERTS_MONITOR_SIZE + REF_THING_SIZE) +#define ERTS_MONITOR_SH_SIZE (ERTS_MONITOR_SIZE + ERTS_REF_THING_SIZE) #define ERTS_LINK_SIZE ((sizeof(ErtsLink) - sizeof(Uint))/sizeof(Uint)) #define ERTS_LINK_SH_SIZE ERTS_LINK_SIZE /* Size of fix-alloced links */ diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c index 66bb55e6c8..1c3160efaf 100644 --- a/erts/emulator/beam/erl_msacc.c +++ b/erts/emulator/beam/erl_msacc.c @@ -66,9 +66,9 @@ static Uint msacc_unmanaged_count = 0; #endif #if ERTS_MSACC_STATE_COUNT < MAP_SMALL_MAP_LIMIT -#define DEFAULT_MSACC_MSG_SIZE (3 + 1 + ERTS_MSACC_STATE_COUNT * 2 + 3 + REF_THING_SIZE) +#define DEFAULT_MSACC_MSG_SIZE (3 + 1 + ERTS_MSACC_STATE_COUNT * 2 + 3 + ERTS_REF_THING_SIZE) #else -#define DEFAULT_MSACC_MSG_SIZE (3 + ERTS_MSACC_STATE_COUNT * 3 + 3 + REF_THING_SIZE) +#define DEFAULT_MSACC_MSG_SIZE (3 + ERTS_MSACC_STATE_COUNT * 3 + 3 + ERTS_REF_THING_SIZE) #endif /* we have to split initiation as atoms are not inited in early init */ @@ -212,7 +212,7 @@ typedef struct { int action; Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; } ErtsMSAccReq; @@ -245,7 +245,7 @@ static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) { if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx); - hp = erts_produce_heap(&factory, REF_THING_SIZE + 3 /* tuple */, 0); + hp = erts_produce_heap(&factory, ERTS_REF_THING_SIZE + 3 /* tuple */, 0); ref_copy = STORE_NC(&hp, &msgp->hfrag.off_heap, msaccrp->ref); msg = erts_msacc_gather_stats(msacc, &factory); msg = TUPLE2(hp, ref_copy, msg); @@ -255,7 +255,7 @@ static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) { erts_factory_close(&factory); } else { ErlOffHeap *ohp = NULL; - msgp = erts_alloc_message_heap(rp, &rp_locks, REF_THING_SIZE, &hp, &ohp); + msgp = erts_alloc_message_heap(rp, &rp_locks, ERTS_REF_THING_SIZE, &hp, &ohp); msg = STORE_NC(&hp, &msgp->hfrag.off_heap, msaccrp->ref); } diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 7c7a32f234..3674a29bf8 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1721,7 +1721,7 @@ ERL_NIF_TERM enif_make_string_len(ErlNifEnv* env, const char* string, ERL_NIF_TERM enif_make_ref(ErlNifEnv* env) { - Eterm* hp = alloc_heap(env, REF_THING_SIZE); + Eterm* hp = alloc_heap(env, ERTS_REF_THING_SIZE); return erts_make_ref_in_buffer(hp); } @@ -1967,7 +1967,6 @@ typedef struct enif_resource_t byte align__[4]; # endif #endif - char data[1]; }ErlNifResource; @@ -2166,6 +2165,7 @@ void* enif_alloc_resource(ErlNifResourceType* type, size_t size) { Binary* bin = erts_create_magic_binary_x(SIZEOF_ErlNifResource(size), &nif_resource_dtor, + ERTS_ALC_T_BINARY, 1); /* unaligned */ ErlNifResource* resource = ERTS_MAGIC_BIN_UNALIGNED_DATA(bin); @@ -2209,34 +2209,56 @@ ERL_NIF_TERM enif_make_resource(ErlNifEnv* env, void* obj) { ErlNifResource* resource = DATA_TO_RESOURCE(obj); ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource); - Eterm* hp = alloc_heap(env,PROC_BIN_SIZE); - return erts_mk_magic_binary_term(&hp, &MSO(env->proc), &bin->binary); + Eterm* hp = alloc_heap(env, ERTS_MAGIC_REF_THING_SIZE); + return erts_mk_magic_ref(&hp, &MSO(env->proc), &bin->binary); } ERL_NIF_TERM enif_make_resource_binary(ErlNifEnv* env, void* obj, const void* data, size_t size) { - Eterm bin = enif_make_resource(env, obj); - ProcBin* pb = (ProcBin*) binary_val(bin); - pb->bytes = (byte*) data; + ErlNifResource* resource = DATA_TO_RESOURCE(obj); + ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource); + ErlOffHeap *ohp = &MSO(env->proc); + Eterm* hp = alloc_heap(env,PROC_BIN_SIZE); + ProcBin* pb = (ProcBin *) hp; + + pb->thing_word = HEADER_PROC_BIN; pb->size = size; - return bin; + pb->next = ohp->first; + ohp->first = (struct erl_off_heap_header*) pb; + pb->val = &bin->binary; + pb->bytes = (byte*) data; + pb->flags = 0; + + OH_OVERHEAD(ohp, size / sizeof(Eterm)); + erts_refc_inc(&bin->binary.refc, 1); + + return make_binary(hp); } int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp) { - ProcBin* pb; Binary* mbin; ErlNifResource* resource; - if (!ERTS_TERM_IS_MAGIC_BINARY(term)) { - return 0; + if (is_internal_magic_ref(term)) + mbin = erts_magic_ref2bin(term); + else { + Eterm *hp; + if (!is_binary(term)) + return 0; + hp = binary_val(term); + if (thing_subtag(*hp) != REFC_BINARY_SUBTAG) + return 0; + /* + if (((ProcBin *) hp)->size != 0) { + return 0; / * Or should we allow "resource binaries" as handles? * / + } + */ + mbin = ((ProcBin *) hp)->val; + if (!(mbin->flags & BIN_FLAG_MAGIC)) + return 0; } - pb = (ProcBin*) binary_val(term); - /*if (pb->size != 0) { - return 0; / * Or should we allow "resource binaries" as handles? * / - }*/ - mbin = pb->val; resource = (ErlNifResource*) ERTS_MAGIC_BIN_UNALIGNED_DATA(mbin); if (ERTS_MAGIC_BIN_DESTRUCTOR(mbin) != &nif_resource_dtor || resource->type != type) { diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h index 0c76c6fe7d..e27f1d121a 100644 --- a/erts/emulator/beam/erl_node_container_utils.h +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -255,19 +255,16 @@ extern ErtsPTab erts_port; * Refs * \* */ +#define internal_ref_no_numbers(x) ERTS_REF_NUMBERS +#define internal_ref_numbers(x) (is_internal_ordinary_ref((x)) \ + ? internal_ordinary_ref_numbers((x)) \ + : (ASSERT(is_internal_magic_ref((x))), \ + internal_magic_ref_numbers((x)))) #if defined(ARCH_64) -#define internal_ref_no_of_numbers(x) \ - (internal_ref_data((x))[0]) -#define internal_thing_ref_no_of_numbers(thing) \ - (internal_thing_ref_data(thing)[0]) -#define internal_ref_numbers(x) \ - (&internal_ref_data((x))[1]) -#define internal_thing_ref_numbers(thing) \ - (&internal_thing_ref_data(thing)[1]) -#define external_ref_no_of_numbers(x) \ +#define external_ref_no_numbers(x) \ (external_ref_data((x))[0]) -#define external_thing_ref_no_of_numbers(thing) \ +#define external_thing_ref_no_numbers(thing) \ (external_thing_ref_data(thing)[0]) #define external_ref_numbers(x) \ (&external_ref_data((x))[1]) @@ -277,12 +274,8 @@ extern ErtsPTab erts_port; #else -#define internal_ref_no_of_numbers(x) (internal_ref_data_words((x))) -#define internal_thing_ref_no_of_numbers(t) (internal_thing_ref_data_words(t)) -#define internal_ref_numbers(x) (internal_ref_data((x))) -#define internal_thing_ref_numbers(t) (internal_thing_ref_data(t)) -#define external_ref_no_of_numbers(x) (external_ref_data_words((x))) -#define external_thing_ref_no_of_numbers(t) (external_thing_ref_data_words((t))) +#define external_ref_no_numbers(x) (external_ref_data_words((x))) +#define external_thing_ref_no_numbers(t) (external_thing_ref_data_words((t))) #define external_ref_numbers(x) (external_ref_data((x))) #define external_thing_ref_numbers(t) (external_thing_ref_data((t))) @@ -299,15 +292,9 @@ extern ErtsPTab erts_port; #define internal_ref_channel_no(x) (internal_channel_no((x))) #define external_ref_channel_no(x) (external_channel_no((x))) -#define ref_data_words(x) (is_internal_ref((x)) \ - ? internal_ref_data_words((x)) \ - : external_ref_data_words((x))) -#define ref_data(x) (is_internal_ref((x)) \ - ? internal_ref_data((x)) \ - : external_ref_data((x))) -#define ref_no_of_numbers(x) (is_internal_ref((x)) \ - ? internal_ref_no_of_numbers((x))\ - : external_ref_no_of_numbers((x))) +#define ref_no_numbers(x) (is_internal_ref((x)) \ + ? internal_ref_no_numbers((x))\ + : external_ref_no_numbers((x))) #define ref_numbers(x) (is_internal_ref((x)) \ ? internal_ref_numbers((x)) \ : external_ref_numbers((x))) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 70500ed6e1..5e54e5aef2 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -98,7 +98,7 @@ dist_table_alloc(void *dep_tmpl) dist_entries++; dep->prev = NULL; - erts_refc_init(&dep->refc, -1); + erts_smp_refc_init(&dep->refc, -1); erts_smp_rwmtx_init_opt_x(&dep->rwmtx, &rwmtx_opt, "dist_entry", chnl_nr); dep->sysname = sysname; dep->cid = NIL; @@ -208,7 +208,7 @@ erts_channel_no_to_dist_entry(Uint cno) * to the node name is used as channel no. */ if(cno == ERST_INTERNAL_CHANNEL_NO) { - erts_refc_inc(&erts_this_dist_entry->refc, 2); + erts_smp_refc_inc(&erts_this_dist_entry->refc, 2); return erts_this_dist_entry; } @@ -231,16 +231,16 @@ erts_sysname_to_connected_dist_entry(Eterm sysname) de.sysname = sysname; if(erts_this_dist_entry->sysname == sysname) { - erts_refc_inc(&erts_this_dist_entry->refc, 2); + erts_smp_refc_inc(&erts_this_dist_entry->refc, 2); return erts_this_dist_entry; } erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); res_dep = (DistEntry *) hash_get(&erts_dist_table, (void *) &de); if (res_dep) { - erts_aint_t refc = erts_refc_inctest(&res_dep->refc, 1); + erts_aint_t refc = erts_smp_refc_inctest(&res_dep->refc, 1); if (refc < 2) /* Pending delete */ - erts_refc_inc(&res_dep->refc, 1); + erts_smp_refc_inc(&res_dep->refc, 1); } erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); if (res_dep) { @@ -267,9 +267,9 @@ DistEntry *erts_find_or_insert_dist_entry(Eterm sysname) de.sysname = sysname; erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); res = hash_put(&erts_dist_table, (void *) &de); - refc = erts_refc_inctest(&res->refc, 0); + refc = erts_smp_refc_inctest(&res->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + erts_smp_refc_inc(&res->refc, 1); erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); return res; } @@ -282,9 +282,9 @@ DistEntry *erts_find_dist_entry(Eterm sysname) erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); res = hash_get(&erts_dist_table, (void *) &de); if (res) { - erts_aint_t refc = erts_refc_inctest(&res->refc, 1); + erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 1); if (refc < 2) /* Pending delete */ - erts_refc_inc(&res->refc, 1); + erts_smp_refc_inc(&res->refc, 1); } erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); return res; @@ -311,7 +311,7 @@ static void try_delete_dist_entry(void *vdep) * * If refc > 0, the entry is in use. Keep the entry. */ - refc = erts_refc_dectest(&dep->refc, -1); + refc = erts_smp_refc_dectest(&dep->refc, -1); if (refc == -1) (void) hash_erase(&erts_dist_table, (void *) dep); erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); @@ -518,7 +518,7 @@ node_table_alloc(void *venp_tmpl) node_entries++; - erts_refc_init(&enp->refc, -1); + erts_smp_refc_init(&enp->refc, -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); @@ -585,9 +585,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation) erts_smp_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_smp_refc_inctest(&res->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + erts_smp_refc_inc(&res->refc, 1); } erts_smp_rwmtx_runlock(&erts_node_table_rwmtx); if (res) @@ -597,9 +597,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_smp_refc_inctest(&res->refc, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + erts_smp_refc_inc(&res->refc, 1); } erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); return res; @@ -626,7 +626,7 @@ static void try_delete_node(void *venp) * * If refc > 0, the entry is in use. Keep the entry. */ - refc = erts_refc_dectest(&enp->refc, -1); + refc = erts_smp_refc_dectest(&enp->refc, -1); if (refc == -1) (void) hash_erase(&erts_node_table, (void *) enp); erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); @@ -672,7 +672,7 @@ static void print_node(void *venp, void *vpndp) erts_print(pndp->to, pndp->to_arg, " %d", enp->creation); #ifdef DEBUG erts_print(pndp->to, pndp->to_arg, " (refc=%ld)", - erts_refc_read(&enp->refc, 0)); + erts_smp_refc_read(&enp->refc, 0)); #endif pndp->no_sysname++; } @@ -715,19 +715,19 @@ void erts_set_this_node(Eterm sysname, Uint creation) { ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking()); - ASSERT(erts_refc_read(&erts_this_dist_entry->refc, 2)); + ASSERT(erts_smp_refc_read(&erts_this_dist_entry->refc, 2)); - if (erts_refc_dectest(&erts_this_node->refc, 0) == 0) + if (erts_smp_refc_dectest(&erts_this_node->refc, 0) == 0) try_delete_node(erts_this_node); - if (erts_refc_dectest(&erts_this_dist_entry->refc, 0) == 0) + if (erts_smp_refc_dectest(&erts_this_dist_entry->refc, 0) == 0) try_delete_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_dist_entry = erts_this_node->dist_entry; - erts_refc_inc(&erts_this_dist_entry->refc, 2); + erts_smp_refc_inc(&erts_this_dist_entry->refc, 2); erts_this_node_sysname = erts_this_node_sysname_BUFFER; erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER), @@ -789,13 +789,13 @@ 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_smp_refc_init(&erts_this_node->refc, 1); ASSERT(erts_this_node->dist_entry != NULL); erts_this_dist_entry = erts_this_node->dist_entry; /* +1 for erts_this_dist_entry */ /* +1 for erts_this_node->dist_entry */ - erts_refc_init(&erts_this_dist_entry->refc, 2); + erts_smp_refc_init(&erts_this_dist_entry->refc, 2); erts_this_node_sysname = erts_this_node_sysname_BUFFER; @@ -1126,12 +1126,12 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) for (u.hdr = oh->first; u.hdr; u.hdr = u.hdr->next) { switch (thing_subtag(u.hdr->thing_word)) { - case REFC_BINARY_SUBTAG: - if(IsMatchProgBinary(u.pb->val)) { + case REF_SUBTAG: + if(IsMatchProgBinary(u.mref->mb)) { InsertedBin *ib; int insert_bin = 1; for (ib = inserted_bins; ib; ib = ib->next) - if(ib->bin_val == u.pb->val) { + if(ib->bin_val == (Binary *) u.mref->mb) { insert_bin = 0; break; } @@ -1140,18 +1140,19 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) Uint *hp = &id_heap[0]; InsertedBin *nib; UseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); - a.id = erts_bld_uint(&hp, NULL, (Uint) u.pb->val); - erts_match_prog_foreach_offheap(u.pb->val, + a.id = erts_bld_uint(&hp, NULL, (Uint) u.mref->mb); + erts_match_prog_foreach_offheap((Binary *) u.mref->mb, insert_offheap2, (void *) &a); nib = erts_alloc(ERTS_ALC_T_NC_TMP, sizeof(InsertedBin)); - nib->bin_val = u.pb->val; + nib->bin_val = (Binary *) u.mref->mb; nib->next = inserted_bins; inserted_bins = nib; UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); } } break; + case REFC_BINARY_SUBTAG: case FUN_SUBTAG: break; /* No need to */ default: @@ -1623,7 +1624,7 @@ reference_table_term(Uint **hpp, Uint *szp) tup = MK_2TUP(referred_nodes[i].node->sysname, MK_UINT(referred_nodes[i].node->creation)); - tup = MK_3TUP(tup, MK_UINT(erts_refc_read(&referred_nodes[i].node->refc, 0)), nril); + tup = MK_3TUP(tup, MK_UINT(erts_smp_refc_read(&referred_nodes[i].node->refc, 0)), nril); nl = MK_CONS(tup, nl); } @@ -1684,7 +1685,7 @@ reference_table_term(Uint **hpp, Uint *szp) /* DistList = [{Dist, Refc, ReferenceIdList}] */ tup = MK_3TUP(referred_dists[i].dist->sysname, - MK_UINT(erts_refc_read(&referred_dists[i].dist->refc, 0)), + MK_UINT(erts_smp_refc_read(&referred_dists[i].dist->refc, 0)), dril); dl = MK_CONS(tup, dl); } diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index 47a6724c21..35051173d0 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -107,7 +107,7 @@ typedef struct dist_entry_ { HashBucket hash_bucket; /* Hash bucket */ struct dist_entry_ *next; /* Next entry in dist_table (not sorted) */ struct dist_entry_ *prev; /* Previous entry in dist_table (not sorted) */ - erts_refc_t refc; /* Reference count */ + erts_smp_refc_t refc; /* Reference count */ erts_smp_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */ Eterm sysname; /* name@host atom for efficiency */ @@ -149,7 +149,7 @@ typedef struct dist_entry_ { typedef struct erl_node_ { HashBucket hash_bucket; /* Hash bucket */ - erts_refc_t refc; /* Reference count */ + erts_smp_refc_t refc; /* Reference count */ Eterm sysname; /* name@host atom for efficiency */ Uint32 creation; /* Creation */ DistEntry *dist_entry; /* Corresponding dist entry */ @@ -210,7 +210,7 @@ ERTS_GLB_INLINE void erts_deref_dist_entry(DistEntry *dep) { ASSERT(dep); - if (erts_refc_dectest(&dep->refc, 0) == 0) + if (erts_smp_refc_dectest(&dep->refc, 0) == 0) erts_schedule_delete_dist_entry(dep); } @@ -218,7 +218,7 @@ ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np) { ASSERT(np); - if (erts_refc_dectest(&np->refc, 0) == 0) + if (erts_smp_refc_dectest(&np->refc, 0) == 0) erts_schedule_delete_node(np); } diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index b43a1b0190..6b64bbd2f1 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -382,12 +382,15 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { break; } case REF_DEF: + if (!ERTS_IS_CRASH_DUMPING) + erts_magic_ref_save_bin(obj); + /* fall through... */ case EXTERNAL_REF_DEF: PRINT_STRING(res, fn, arg, "#Ref<"); PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) ref_channel_no(wobj)); ref_num = ref_numbers(wobj); - for (i = ref_no_of_numbers(wobj)-1; i >= 0; i--) { + for (i = ref_no_numbers(wobj)-1; i >= 0; i--) { PRINT_CHAR(res, fn, arg, '.'); PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) ref_num[i]); } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 641a8fb3e8..87d71fdd22 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1173,7 +1173,7 @@ typedef struct { int enable; Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; #ifdef ERTS_DIRTY_SCHEDULERS @@ -1185,7 +1185,7 @@ typedef struct { typedef struct { Process *proc; Eterm ref; - Eterm ref_heap[REF_THING_SIZE]; + Eterm ref_heap[ERTS_REF_THING_SIZE]; Uint req_sched; erts_smp_atomic32_t refc; } ErtsSystemCheckReq; @@ -1297,7 +1297,7 @@ reply_sched_wall_time(void *vswtrp) if (hpp) ref_copy = STORE_NC(hpp, ohp, swtrp->ref); else - *szp += REF_THING_SIZE; + *szp += ERTS_REF_THING_SIZE; ASSERT(!swtrp->set); @@ -1342,7 +1342,7 @@ reply_sched_wall_time(void *vswtrp) if (hpp) ref_copy = STORE_NC(hpp, ohp, swtrp->ref); else - *szp += REF_THING_SIZE; + *szp += ERTS_REF_THING_SIZE; if (swtrp->set) msg = ref_copy; @@ -1444,7 +1444,7 @@ reply_system_check(void *vscrp) ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp)); #endif - sz = REF_THING_SIZE; + sz = ERTS_REF_THING_SIZE; mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); hpp = &hp; msg = STORE_NC(hpp, ohp, scrp->ref); @@ -6381,7 +6381,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online erts_tsd_set(sched_data_key, (void *) esdp); #endif } - erts_no_schedulers = 1; erts_no_dirty_cpu_schedulers = 0; erts_no_dirty_io_schedulers = 0; #endif @@ -10176,7 +10175,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) esdp->current_process = NULL; #ifdef ERTS_SMP - p->scheduler_data = NULL; + if (is_normal_sched) + p->scheduler_data = NULL; #endif erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN @@ -10633,8 +10633,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) state = erts_smp_atomic32_read_nob(&p->state); - ASSERT(!p->scheduler_data); #ifndef ERTS_DIRTY_SCHEDULERS + ASSERT(!p->scheduler_data); p->scheduler_data = esdp; #else /* ERTS_DIRTY_SCHEDULERS */ if (is_normal_sched) { @@ -10645,6 +10645,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); goto sched_out_proc; } + ASSERT(!p->scheduler_data); p->scheduler_data = esdp; } else { diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 7c23b5c76a..77c7c5e73c 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -447,7 +447,7 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x) ProcBin* pb = (ProcBin *) binary_val(x); Binary* val = pb->val; - if (erts_smp_atomic_xchg_nob(&val->refc, 0) != 0) { + if (erts_atomic_xchg_nob(&val->refc, 0) != 0) { val->flags = (UWord) all_binaries; all_binaries = val; } diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c index 22830a19c4..a132b1d334 100644 --- a/erts/emulator/beam/erl_ptab.c +++ b/erts/emulator/beam/erl_ptab.c @@ -771,18 +771,18 @@ erts_ptab_list(Process *c_p, ErtsPTab *ptab) } else { Eterm *hp; - Eterm magic_bin; + Eterm magic_ref; ERTS_PTAB_LIST_DBG_CHK_RESLIST(res_acc); - hp = HAlloc(c_p, PROC_BIN_SIZE); - ERTS_PTAB_LIST_DBG_SAVE_HEAP_ALLOC(ptlbdp, hp, PROC_BIN_SIZE); - magic_bin = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp); + hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + ERTS_PTAB_LIST_DBG_SAVE_HEAP_ALLOC(ptlbdp, hp, ERTS_MAGIC_REF_THING_SIZE); + magic_ref = erts_mk_magic_ref(&hp, &MSO(c_p), mbp); ERTS_PTAB_LIST_DBG_VERIFY_HEAP_ALLOC_USED(ptlbdp, hp); ERTS_PTAB_LIST_DBG_TRACE(c_p->common.id, trap); ERTS_BIF_PREP_YIELD2(ret_val, &ptab_list_continue_export, c_p, res_acc, - magic_bin); + magic_ref); } return ret_val; } @@ -1287,9 +1287,7 @@ static BIF_RETTYPE ptab_list_continue(BIF_ALIST_2) res_acc = BIF_ARG_1; - ERTS_PTAB_LIST_ASSERT(ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_2)); - - mbp = ((ProcBin *) binary_val(BIF_ARG_2))->val; + mbp = erts_magic_ref2bin(BIF_ARG_2); ERTS_PTAB_LIST_ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == cleanup_ptab_list_bif_data); diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index 7d857ad326..6b25728af7 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -59,6 +59,42 @@ erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz) #endif } +void +erts_term_init(void) +{ +#ifdef ERTS_ORDINARY_REF_MARKER + /* Ordinary and magic references of same size... */ + + ErtsRefThing ref_thing; + + ERTS_CT_ASSERT(ERTS_ORDINARY_REF_MARKER == ~((Uint32)0)); + ref_thing.m.header = ERTS_REF_THING_HEADER; + ref_thing.m.mb = (ErtsMagicBinary *) ~((UWord) 3); + ref_thing.m.next = (struct erl_off_heap_header *) ~((UWord) 3); + if (ref_thing.o.marker == ERTS_ORDINARY_REF_MARKER) + ERTS_INTERNAL_ERROR("Cannot differentiate between magic and ordinary references"); + + ERTS_CT_ASSERT(offsetof(ErtsORefThing,marker) != 0); + ERTS_CT_ASSERT(sizeof(ErtsORefThing) == sizeof(ErtsMRefThing)); +# ifdef ERTS_MAGIC_REF_THING_HEADER +# error Magic ref thing header should not have been defined... +# endif + +#else + /* Ordinary and magic references of different sizes... */ + +# ifndef ERTS_MAGIC_REF_THING_HEADER +# error Magic ref thing header should have been defined... +# endif + ERTS_CT_ASSERT(sizeof(ErtsORefThing) != sizeof(ErtsMRefThing)); + +#endif + + ERTS_CT_ASSERT(ERTS_REF_THING_SIZE*sizeof(Eterm) == sizeof(ErtsORefThing)); + ERTS_CT_ASSERT(ERTS_MAGIC_REF_THING_SIZE*sizeof(Eterm) == sizeof(ErtsMRefThing)); + +} + /* * XXX: define NUMBER_CODE() here when new representation is used */ @@ -95,8 +131,8 @@ ET_DEFINE_CHECKED(Eterm*,tuple_val,Wterm,is_tuple); ET_DEFINE_CHECKED(struct erl_node_*,internal_pid_node,Eterm,is_internal_pid); ET_DEFINE_CHECKED(struct erl_node_*,internal_port_node,Eterm,is_internal_port); ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Wterm,is_internal_ref); -ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Wterm,is_internal_ref); -ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Wterm,is_internal_ref); +ET_DEFINE_CHECKED(Uint32*,internal_magic_ref_numbers,Wterm,is_internal_magic_ref); +ET_DEFINE_CHECKED(Uint32*,internal_ordinary_ref_numbers,Wterm,is_internal_ordinary_ref); ET_DEFINE_CHECKED(struct erl_node_*,internal_ref_node,Eterm,is_internal_ref); ET_DEFINE_CHECKED(Eterm*,external_val,Wterm,is_external); ET_DEFINE_CHECKED(Uint,external_data_words,Wterm,is_external); diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index c3234ee349..a602a8f7c6 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -23,6 +23,8 @@ #include "erl_mmap.h" +void erts_term_init(void); + typedef UWord Wterm; /* Full word terms */ struct erl_node_; /* Declared in erl_node_tables.h */ @@ -718,73 +720,224 @@ _ET_DECLARE_CHECKED(struct erl_node_*,internal_port_node,Eterm) #define ERTS_MAX_REF_NUMBERS 3 #define ERTS_REF_NUMBERS ERTS_MAX_REF_NUMBERS -#if defined(ARCH_64) -# define ERTS_REF_WORDS (ERTS_REF_NUMBERS/2 + 1) -# define ERTS_REF_32BIT_WORDS (ERTS_REF_NUMBERS+1) -#else -# define ERTS_REF_WORDS ERTS_REF_NUMBERS -# define ERTS_REF_32BIT_WORDS ERTS_REF_NUMBERS +#ifndef ERTS_ENDIANNESS +# error ERTS_ENDIANNESS not defined... #endif -typedef struct { - Eterm header; - union { - Uint32 ui32[ERTS_REF_32BIT_WORDS]; - Uint ui[ERTS_REF_WORDS]; - } data; -} RefThing; - -#define REF_THING_SIZE (sizeof(RefThing)/sizeof(Uint)) -#define REF_THING_HEAD_SIZE (sizeof(Eterm)/sizeof(Uint)) +#if ERTS_REF_NUMBERS != 3 +# error "A new reference layout for 64-bit needs to be implemented..." +#endif -#define make_ref_thing_header(DW) \ - _make_header((DW)+REF_THING_HEAD_SIZE-1,_TAG_HEADER_REF) +struct magic_binary; #if defined(ARCH_64) +# define ERTS_ORDINARY_REF_MARKER (~((Uint32) 0)) + +typedef struct { + Eterm header; +#if ERTS_ENDIANNESS <= 0 + Uint32 marker; +#endif + Uint32 num[ERTS_REF_NUMBERS]; +#if ERTS_ENDIANNESS > 0 + Uint32 marker; +#endif +} ErtsORefThing; + +typedef struct { + Eterm header; + struct magic_binary *mb; + struct erl_off_heap_header* next; +#if !ERTS_ENDIANNESS + Uint32 num[ERTS_REF_NUMBERS]; + Uint32 marker; +#endif +} ErtsMRefThing; + /* - * Ref layout on a 64-bit little endian machine: + * Ordinary ref layout on a 64-bit little endian machine: * * 63 31 0 * +--------------+--------------+ * | Thing word | * +--------------+--------------+ - * | Data 0 | 32-bit arity | + * | Data 0 | 0xffffffff | * +--------------+--------------+ * | Data 2 | Data 1 | * +--------------+--------------+ * - * Data is stored as an Uint32 array with 32-bit arity as first number. + * Ordinary ref layout on a 64-bit big endian machine: + * + * 63 31 0 + * +--------------+--------------+ + * | Thing word | + * +--------------+--------------+ + * | Data 0 | Data 1 | + * +--------------+--------------+ + * | Data 2 | 0xffffffff | + * +--------------+--------------+ + * + * Magic Ref layout on a 64-bit machine: + * + * 63 31 0 + * +--------------+--------------+ + * | Thing word | + * +--------------+--------------+ + * | Magic Binary Pointer | + * +--------------+--------------+ + * | Next Off Heap Pointer | + * +--------------+--------------+ + * + * Both pointers in the magic ref are 64-bit aligned. That is, + * least significant bits are zero. The marker 32-bit word is + * placed over the least significant bits of one of the pointers. + * That is, we can distinguish between magic and ordinary ref + * by looking at the marker field. + * */ #define write_ref_thing(Hp, R0, R1, R2) \ do { \ - ((RefThing *) (Hp))->header = make_ref_thing_header(ERTS_REF_WORDS); \ - ((RefThing *) (Hp))->data.ui32[0] = ERTS_REF_NUMBERS; \ - ((RefThing *) (Hp))->data.ui32[1] = (R0); \ - ((RefThing *) (Hp))->data.ui32[2] = (R1); \ - ((RefThing *) (Hp))->data.ui32[3] = (R2); \ + ((ErtsORefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \ + ((ErtsORefThing *) (Hp))->marker = ERTS_ORDINARY_REF_MARKER; \ + ((ErtsORefThing *) (Hp))->num[0] = (R0); \ + ((ErtsORefThing *) (Hp))->num[1] = (R1); \ + ((ErtsORefThing *) (Hp))->num[2] = (R2); \ } while (0) -#else +#if ERTS_ENDIANNESS +/* Known big or little endian */ + +#define write_magic_ref_thing(Hp, Ohp, Binp) \ +do { \ + ((ErtsMRefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \ + ((ErtsMRefThing *) (Hp))->mb = (Binp); \ + ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \ + (Ohp)->first = (struct erl_off_heap_header*) (Hp); \ + ASSERT(erts_is_ref_numbers_magic((Binp)->refn)); \ +} while (0) + +#else /* !ERTS_ENDIANNESS */ + +#define write_magic_ref_thing(Hp, Ohp, Binp) \ +do { \ + ((ErtsMRefThing *) (Hp))->header = ERTS_MAGIC_REF_THING_HEADER; \ + ((ErtsMRefThing *) (Hp))->mb = (Binp); \ + ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \ + (Ohp)->first = (struct erl_off_heap_header*) (Hp); \ + ((ErtsMRefThing *) (Hp))->marker = 0; \ + ((ErtsMRefThing *) (Hp))->num[0] = (Binp)->refn[0]; \ + ((ErtsMRefThing *) (Hp))->num[1] = (Binp)->refn[1]; \ + ((ErtsMRefThing *) (Hp))->num[2] = (Binp)->refn[2]; \ + ASSERT(erts_is_ref_numbers_magic((Binp)->refn)); \ +} while (0) + +#endif /* !ERTS_ENDIANNESS */ + +#else /* ARCH_32 */ + +typedef struct { + Eterm header; + Uint32 num[ERTS_REF_NUMBERS]; +} ErtsORefThing; + +typedef struct { + Eterm header; + struct magic_binary *mb; + struct erl_off_heap_header* next; +} ErtsMRefThing; + #define write_ref_thing(Hp, R0, R1, R2) \ do { \ - ((RefThing *) (Hp))->header = make_ref_thing_header(ERTS_REF_WORDS); \ - ((RefThing *) (Hp))->data.ui32[0] = (R0); \ - ((RefThing *) (Hp))->data.ui32[1] = (R1); \ - ((RefThing *) (Hp))->data.ui32[2] = (R2); \ + ((ErtsORefThing *) (Hp))->header = ERTS_REF_THING_HEADER; \ + ((ErtsORefThing *) (Hp))->num[0] = (R0); \ + ((ErtsORefThing *) (Hp))->num[1] = (R1); \ + ((ErtsORefThing *) (Hp))->num[2] = (R2); \ } while (0) +#define write_magic_ref_thing(Hp, Ohp, Binp) \ +do { \ + ((ErtsMRefThing *) (Hp))->header = ERTS_MAGIC_REF_THING_HEADER; \ + ((ErtsMRefThing *) (Hp))->mb = (Binp); \ + ((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \ + (Ohp)->first = (struct erl_off_heap_header*) (Hp); \ + ASSERT(erts_is_ref_numbers_magic(&(Binp)->refn)); \ +} while (0) + +#endif /* ARCH_32 */ + +typedef union { + ErtsMRefThing m; + ErtsORefThing o; +} ErtsRefThing; + +#define ERTS_REF_THING_SIZE (sizeof(ErtsORefThing)/sizeof(Uint)) +#define ERTS_MAGIC_REF_THING_SIZE (sizeof(ErtsMRefThing)/sizeof(Uint)) +#define ERTS_MAX_INTERNAL_REF_SIZE (sizeof(ErtsRefThing)/sizeof(Uint)) + +#define make_ref_thing_header(Words) \ + _make_header((Words)-1,_TAG_HEADER_REF) + +#define ERTS_REF_THING_HEADER _make_header(ERTS_REF_THING_SIZE-1,_TAG_HEADER_REF) + +#if defined(ARCH_64) && ERTS_ENDIANNESS /* All internal refs of same size... */ + +# undef ERTS_MAGIC_REF_THING_HEADER + +# define is_ref_thing_header(x) ((x) == ERTS_REF_THING_HEADER) + +#define is_ordinary_ref_thing(x) \ + (ASSERT(is_ref_thing_header(*((Eterm *)(x)))), \ + ((ErtsRefThing *) (x))->o.marker == ERTS_ORDINARY_REF_MARKER) + +#define is_magic_ref_thing(x) \ + (!is_ordinary_ref_thing((x))) + +#define is_internal_magic_ref(x) \ + ((_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER) \ + && is_magic_ref_thing(boxed_val((x)))) + +#define is_internal_ordinary_ref(x) \ + ((_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER) \ + && is_ordinary_ref_thing(boxed_val((x)))) + +#else /* Ordinary and magic references of different sizes... */ + +# define ERTS_MAGIC_REF_THING_HEADER \ + _make_header(ERTS_MAGIC_REF_THING_SIZE-1,_TAG_HEADER_REF) + +# define is_ref_thing_header(x) \ + (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_REF) + +#define is_ordinary_ref_thing(x) \ + (ASSERT(is_ref_thing_header(*((Eterm *)(x)))), \ + *((Eterm *)(x)) == ERTS_REF_THING_HEADER) + +#define is_magic_ref_thing(x) \ + (ASSERT(is_ref_thing_header(*((Eterm *)(x)))), \ + *((Eterm *)(x)) == ERTS_MAGIC_REF_THING_HEADER) + +#define is_internal_magic_ref(x) \ + (_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_MAGIC_REF_THING_HEADER) + +#define is_internal_ordinary_ref(x) \ + (_unchecked_is_boxed((x)) && *boxed_val((x)) == ERTS_REF_THING_HEADER) + #endif -#define is_ref_thing_header(x) (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_REF) #define make_internal_ref(x) make_boxed((Eterm*)(x)) -#define _unchecked_ref_thing_ptr(x) \ - ((RefThing*) _unchecked_internal_ref_val(x)) -#define ref_thing_ptr(x) \ - ((RefThing*) internal_ref_val(x)) +#define _unchecked_ordinary_ref_thing_ptr(x) \ + ((ErtsORefThing*) _unchecked_internal_ref_val(x)) +#define ordinary_ref_thing_ptr(x) \ + ((ErtsORefThing*) internal_ref_val(x)) + +#define _unchecked_magic_ref_thing_ptr(x) \ + ((ErtsMRefThing*) _unchecked_internal_ref_val(x)) +#define magic_ref_thing_ptr(x) \ + ((ErtsMRefThing*) internal_ref_val(x)) #define is_internal_ref(x) \ (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x)))) @@ -796,16 +949,21 @@ do { \ _ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Wterm) #define internal_ref_val(x) _ET_APPLY(internal_ref_val,(x)) -#define internal_thing_ref_data_words(t) (thing_arityval(*(Eterm*)(t))) -#define _unchecked_internal_ref_data_words(x) \ - (_unchecked_thing_arityval(*_unchecked_internal_ref_val(x))) -_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Wterm) -#define internal_ref_data_words(x) _ET_APPLY(internal_ref_data_words,(x)) +#define internal_ordinary_thing_ref_numbers(ort) (((ErtsORefThing *)(ort))->num) +#define _unchecked_internal_ordinary_ref_numbers(x) (internal_ordinary_thing_ref_numbers(_unchecked_ordinary_ref_thing_ptr(x))) +_ET_DECLARE_CHECKED(Uint32*,internal_ordinary_ref_numbers,Wterm) +#define internal_ordinary_ref_numbers(x) _ET_APPLY(internal_ordinary_ref_numbers,(x)) + +#if defined(ARCH_64) && !ERTS_ENDIANNESS +#define internal_magic_thing_ref_numbers(mrt) (((ErtsMRefThing *)(mrt))->num) +#else +#define internal_magic_thing_ref_numbers(mrt) (((ErtsMRefThing *)(mrt))->mb->refn) +#endif + +#define _unchecked_internal_magic_ref_numbers(x) (internal_magic_thing_ref_numbers(_unchecked_magic_ref_thing_ptr(x))) +_ET_DECLARE_CHECKED(Uint32*,internal_magic_ref_numbers,Wterm) +#define internal_magic_ref_numbers(x) _ET_APPLY(internal_magic_ref_numbers,(x)) -#define internal_thing_ref_data(thing) ((thing)->data.ui32) -#define _unchecked_internal_ref_data(x) (internal_thing_ref_data(_unchecked_ref_thing_ptr(x))) -_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Wterm) -#define internal_ref_data(x) _ET_APPLY(internal_ref_data,(x)) #define _unchecked_internal_ref_node(x) erts_this_node _ET_DECLARE_CHECKED(struct erl_node_*,internal_ref_node,Eterm) diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 6aa2a7500f..1d747e5fab 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -1831,7 +1831,10 @@ erts_demonitor_time_offset(Eterm ref) ErtsMonitor *mon; ASSERT(is_internal_ref(ref)); erts_smp_mtx_lock(&erts_get_time_mtx); - mon = erts_remove_monitor(&time_offset_monitors, ref); + if (is_internal_ordinary_ref(ref)) + mon = erts_remove_monitor(&time_offset_monitors, ref); + else + mon = NULL; if (!mon) res = 0; else { @@ -1848,7 +1851,7 @@ erts_demonitor_time_offset(Eterm ref) typedef struct { Eterm pid; Eterm ref; - Eterm heap[REF_THING_SIZE]; + Eterm heap[ERTS_REF_THING_SIZE]; } ErtsTimeOffsetMonitorInfo; typedef struct { @@ -1869,11 +1872,11 @@ save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt) cntxt->to_mon_info[mix].pid = mon->pid; to_hp = &cntxt->to_mon_info[mix].heap[0]; - ASSERT(is_internal_ref(mon->ref)); + ASSERT(is_internal_ordinary_ref(mon->ref)); from_hp = internal_ref_val(mon->ref); - ASSERT(thing_arityval(*from_hp) + 1 == REF_THING_SIZE); + ASSERT(thing_arityval(*from_hp) + 1 == ERTS_REF_THING_SIZE); - for (hix = 0; hix < REF_THING_SIZE; hix++) + for (hix = 0; hix < ERTS_REF_THING_SIZE; hix++) to_hp[hix] = from_hp[hix]; cntxt->to_mon_info[mix].ref @@ -1933,7 +1936,7 @@ send_time_offset_changed_notifications(void *new_offsetp) hp = (Eterm *) (tmp + no_monitors*sizeof(ErtsTimeOffsetMonitorInfo)); hsz = 6; /* 5-tuple */ - hsz += REF_THING_SIZE; + hsz += ERTS_REF_THING_SIZE; hsz += ERTS_SINT64_HEAP_SIZE(new_offset); if (IS_SSMALL(new_offset)) diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index bd5e1482fb..dd7c589c3d 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -129,13 +129,9 @@ static void cleanup_restart_context_bin(Binary *bp) cleanup_restart_context(rc); } -static RestartContext *get_rc_from_bin(Eterm bin) +static RestartContext *get_rc_from_bin(Eterm mref) { - Binary *mbp; - ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin)); - - mbp = ((ProcBin *) binary_val(bin))->val; - + Binary *mbp = erts_magic_ref2bin(mref); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == cleanup_restart_context_bin); return (RestartContext *) ERTS_MAGIC_BIN_DATA(mbp); @@ -148,8 +144,8 @@ static Eterm make_magic_bin_for_restart(Process *p, RestartContext *rc) RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp); Eterm *hp; memcpy(restartp,rc,sizeof(RestartContext)); - hp = HAlloc(p, PROC_BIN_SIZE); - return erts_mk_magic_binary_term(&hp, &MSO(p), mbp); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + return erts_mk_magic_ref(&hp, &MSO(p), mbp); } @@ -1890,74 +1886,57 @@ binary_to_atom(Process* proc, Eterm bin, Eterm enc, int must_exist) byte* bytes; byte *temp_alloc = NULL; Uint bin_size; + Eterm a; if ((bytes = erts_get_aligned_binary_bytes(bin, &temp_alloc)) == 0) { BIF_ERROR(proc, BADARG); } bin_size = binary_size(bin); + if (enc == am_latin1) { - Eterm a; - if (bin_size > MAX_ATOM_CHARACTERS) { - system_limit: - erts_free_aligned_binary_bytes(temp_alloc); - BIF_ERROR(proc, SYSTEM_LIMIT); - } if (!must_exist) { - a = erts_atom_put((byte *) bytes, - bin_size, - ERTS_ATOM_ENC_LATIN1, - 0); - erts_free_aligned_binary_bytes(temp_alloc); - if (is_non_value(a)) - goto badarg; - BIF_RET(a); - } else if (erts_atom_get((char *)bytes, bin_size, &a, ERTS_ATOM_ENC_LATIN1)) { - erts_free_aligned_binary_bytes(temp_alloc); - BIF_RET(a); - } else { + int lix = erts_atom_put_index((byte *) bytes, + bin_size, + ERTS_ATOM_ENC_LATIN1, + 0); + if (lix == ATOM_BAD_ENCODING_ERROR) { + badarg: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(proc, BADARG); + } else if (lix == ATOM_MAX_CHARS_ERROR) { + system_limit: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(proc, SYSTEM_LIMIT); + } + + a = make_atom(lix); + } else if (!erts_atom_get((char *)bytes, bin_size, &a, ERTS_ATOM_ENC_LATIN1)) { goto badarg; } - } else if (enc == am_utf8 || enc == am_unicode) { - Eterm res; - Uint num_chars = 0; - const byte* p = bytes; - Uint left = bin_size; - while (left) { - if (++num_chars > MAX_ATOM_CHARACTERS) { + } else if (enc == am_utf8 || enc == am_unicode) { + if (!must_exist) { + int uix = erts_atom_put_index((byte *) bytes, + bin_size, + ERTS_ATOM_ENC_UTF8, + 0); + if (uix == ATOM_BAD_ENCODING_ERROR) { + goto badarg; + } else if (uix == ATOM_MAX_CHARS_ERROR) { goto system_limit; } - if ((p[0] & 0x80) == 0) { - ++p; - --left; - } - else if (left >= 2 - && (p[0] & 0xFE) == 0xC2 /* only allow latin1 subset */ - && (p[1] & 0xC0) == 0x80) { - p += 2; - left -= 2; - } - else goto badarg; - } - if (!must_exist) { - res = erts_atom_put((byte *) bytes, - bin_size, - ERTS_ATOM_ENC_UTF8, - 0); + a = make_atom(uix); } - else if (!erts_atom_get((char*)bytes, bin_size, &res, ERTS_ATOM_ENC_UTF8)) { + else if (!erts_atom_get((char*)bytes, bin_size, &a, ERTS_ATOM_ENC_UTF8)) { goto badarg; } - erts_free_aligned_binary_bytes(temp_alloc); - if (is_non_value(res)) - goto badarg; - BIF_RET(res); } else { - badarg: - erts_free_aligned_binary_bytes(temp_alloc); - BIF_ERROR(proc, BADARG); + goto badarg; } + + erts_free_aligned_binary_bytes(temp_alloc); + BIF_RET(a); } BIF_RETTYPE binary_to_atom_2(BIF_ALIST_2) diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index d88cafc5bf..5366ee3644 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -110,8 +110,21 @@ #define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p)) #if defined(DEBUG) || defined(CHECK_FOR_HOLES) -# define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef) -#endif /* egil: 32-bit ? */ + +/* + * ERTS_HOLE_MARKER must *not* be mistaken for a valid term + * on the heap... + */ +# ifdef ARCH_64 +# define ERTS_HOLE_MARKER \ + make_catch(UWORD_CONSTANT(0xdeadbeaf00000000) >> _TAG_IMMED2_SIZE) +/* Will (at the time of writing) appear as 0xdeadbeaf0000001b */ +# else +# define ERTS_HOLE_MARKER \ + make_catch(UWORD_CONSTANT(0xdead0000) >> _TAG_IMMED2_SIZE) +/* Will (at the time of writing) appear as 0xdead001b */ +# endif +#endif /* * Allocate heap memory on the ordinary heap, NEVER in a heap diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 10e452fa25..f9cba0aec0 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -616,7 +616,7 @@ erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize) sys_memcpy((void *) ep, (void *) edep, dist_ext_sz); ep += dist_ext_sz; if (new_edep->dep) - erts_refc_inc(&new_edep->dep->refc, 1); + erts_smp_refc_inc(&new_edep->dep->refc, 1); new_edep->extp = ep; new_edep->ext_endp = ep + ext_sz; new_edep->heap_size = -1; @@ -1079,7 +1079,7 @@ static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1) Eterm *tp = tuple_val(BIF_ARG_1); Eterm Term = tp[1]; Eterm bt = tp[2]; - Binary *bin = ((ProcBin *) binary_val(bt))->val; + Binary *bin = erts_magic_ref2bin(bt); Eterm res = erts_term_to_binary_int(BIF_P, Term, 0, 0,bin); if (is_tuple(res)) { ASSERT(BIF_P->flags & F_DISABLE_GC); @@ -1222,6 +1222,7 @@ typedef struct B2TContext_t { } u; } B2TContext; +static B2TContext* b2t_export_context(Process*, B2TContext* src); static uLongf binary2term_uncomp_size(byte* data, Sint size) { @@ -1254,7 +1255,7 @@ static uLongf binary2term_uncomp_size(byte* data, Sint size) static ERTS_INLINE int binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size, - B2TContext* ctx) + B2TContext** ctxp, Process* p) { byte *bytes = data; Sint size = data_size; @@ -1268,8 +1269,8 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size, size--; if (size < 5 || *bytes != COMPRESSED) { state->extp = bytes; - if (ctx) - ctx->state = B2TSizeInit; + if (ctxp) + (*ctxp)->state = B2TSizeInit; } else { uLongf dest_len = (Uint32) get_int32(bytes+1); @@ -1286,16 +1287,26 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size, return -1; } state->extp = erts_alloc(ERTS_ALC_T_EXT_TERM_DATA, dest_len); - ctx->reds -= dest_len; + if (ctxp) + (*ctxp)->reds -= dest_len; } state->exttmp = 1; - if (ctx) { + if (ctxp) { + /* + * Start decompression by exporting trap context + * so we don't have to deal with deep-copying z_stream. + */ + B2TContext* ctx = b2t_export_context(p, *ctxp); + ASSERT(state = &(*ctxp)->b2ts); + state = &ctx->b2ts; + if (erl_zlib_inflate_start(&ctx->u.uc.stream, bytes, size) != Z_OK) return -1; ctx->u.uc.dbytes = state->extp; ctx->u.uc.dleft = dest_len; ctx->state = B2TUncompressChunk; + *ctxp = ctx; } else { uLongf dlen = dest_len; @@ -1339,7 +1350,7 @@ erts_binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size { Sint res; - if (binary2term_prepare(state, data, data_size, NULL) < 0 || + if (binary2term_prepare(state, data, data_size, NULL, NULL) < 0 || (res=decoded_size(state->extp, state->extp + state->extsize, 0, NULL)) < 0) { if (state->exttmp) @@ -1397,7 +1408,7 @@ static void b2t_context_destructor(Binary *context_bin) static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1) { - Binary *context_bin = ((ProcBin *) binary_val(BIF_ARG_1))->val; + Binary *context_bin = erts_magic_ref2bin(BIF_ARG_1); ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor); return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin, NULL, @@ -1431,8 +1442,8 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src) if (ctx->state >= B2TDecode && ctx->u.dc.next == &src->u.dc.res) { ctx->u.dc.next = &ctx->u.dc.res; } - hp = HAlloc(p, PROC_BIN_SIZE); - ctx->trap_bin = erts_mk_magic_binary_term(&hp, &MSO(p), context_b); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + ctx->trap_bin = erts_mk_magic_ref(&hp, &MSO(p), context_b); return ctx; } @@ -1485,7 +1496,7 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar if (ctx->aligned_alloc) { ctx->reds -= bin_size / 8; } - if (binary2term_prepare(&ctx->b2ts, bytes, bin_size, ctx) < 0) { + if (binary2term_prepare(&ctx->b2ts, bytes, bin_size, &ctx, p) < 0) { ctx->state = B2TBadArg; } break; @@ -1860,8 +1871,8 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla #define RETURN_STATE() \ do { \ - hp = HAlloc(p, PROC_BIN_SIZE+3); \ - c_term = erts_mk_magic_binary_term(&hp, &MSO(p), context_b); \ + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE+3); \ + c_term = erts_mk_magic_ref(&hp, &MSO(p), context_b); \ res = TUPLE2(hp, Term, c_term); \ BUMP_ALL_REDS(p); \ return res; \ @@ -2568,7 +2579,9 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); - i = ref_no_of_numbers(obj); + erts_magic_ref_save_bin(obj); + + i = ref_no_numbers(obj); put_int16(i, ep); ep += 2; ep = enc_atom(acmp, sysname, ep, dflags); @@ -3424,26 +3437,35 @@ dec_term_atom_common: r0 = get_int32(ep); /* allow full word */ ep += 4; - ref_ext_common: + ref_ext_common: { + ErtsORefThing *rtp; + if (ref_words > ERTS_MAX_REF_NUMBERS) goto error; node = dec_get_node(sysname, cre); if(node == erts_this_node) { - RefThing *rtp = (RefThing *) hp; - ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE); + + rtp = (ErtsORefThing *) hp; + ref_num = &rtp->num[0]; + if (ref_words != ERTS_REF_NUMBERS) { + int i; + if (ref_words > ERTS_REF_NUMBERS) + goto error; /* Not a ref that we created... */ + for (i = ref_words; i < ERTS_REF_NUMBERS; i++) + ref_num[i] = 0; + } -#if defined(ARCH_64) - hp += REF_THING_HEAD_SIZE + ref_words/2 + 1; - rtp->header = make_ref_thing_header(ref_words/2 + 1); -#else - hp += REF_THING_HEAD_SIZE + ref_words; - rtp->header = make_ref_thing_header(ref_words); +#ifdef ERTS_ORDINARY_REF_MARKER + rtp->marker = ERTS_ORDINARY_REF_MARKER; #endif + hp += ERTS_REF_THING_SIZE; + rtp->header = ERTS_REF_THING_HEADER; *objp = make_internal_ref(rtp); } else { ExternalThing *etp = (ExternalThing *) hp; + rtp = NULL; #if defined(ARCH_64) hp += EXTERNAL_THING_HEAD_SIZE + ref_words/2 + 1; #else @@ -3461,12 +3483,13 @@ dec_term_atom_common: factory->off_heap->first = (struct erl_off_heap_header*)etp; *objp = make_external_ref(etp); ref_num = &(etp->data.ui32[0]); - } - #if defined(ARCH_64) - *(ref_num++) = ref_words /* 32-bit arity */; + *(ref_num++) = ref_words /* 32-bit arity */; #endif + } + ref_num[0] = r0; + for(i = 1; i < ref_words; i++) { ref_num[i] = get_int32(ep); ep += 4; @@ -3475,8 +3498,26 @@ dec_term_atom_common: if ((1 + ref_words) % 2) ref_num[ref_words] = 0; #endif + if (node == erts_this_node) { + /* Check if it was a magic reference... */ + ErtsMagicBinary *mb = erts_magic_ref_lookup_bin(ref_num); + if (mb) { + /* + * Was a magic ref; adjust it... + * + * Refc on binary was increased by lookup above... + */ + ASSERT(rtp); + hp = (Eterm *) rtp; + write_magic_ref_thing(hp, factory->off_heap, mb); + OH_OVERHEAD(factory->off_heap, + mb->orig_size / sizeof(Eterm)); + hp += ERTS_MAGIC_REF_THING_SIZE; + } + } break; } + } case BINARY_EXT: { n = get_int32(ep); @@ -4098,7 +4139,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, /*fall through*/ case REF_DEF: ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); - i = ref_no_of_numbers(obj); + i = ref_no_numbers(obj); result += (1 + 2 + encode_size_struct2(acmp, ref_node_name(obj), dflags) + 1 + 4*i); break; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index c39ac2f7ec..fff22fe9c1 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -42,6 +42,9 @@ #include "erl_utils.h" #include "erl_port.h" #include "erl_gc.h" +#define ERTS_BINARY_TYPES_ONLY__ +#include "erl_binary.h" +#undef ERTS_BINARY_TYPES_ONLY__ struct enif_func_t; @@ -126,7 +129,7 @@ typedef struct de_proc_entry { PROC_AWAIT_LOAD == Wants to be notified when we reloaded the driver (old was locked) */ Uint flags; /* ERL_FL_DE_DEREFERENCED when reload in progress */ - Eterm heap[REF_THING_SIZE]; /* "ref heap" */ + Eterm heap[ERTS_REF_THING_SIZE]; /* "ref heap" */ struct de_proc_entry *next; } DE_ProcEntry; @@ -134,7 +137,7 @@ typedef struct { void *handle; /* Handle for DLL or SO (for dyn. drivers). */ DE_ProcEntry *procs; /* List of pids that have loaded this driver, or that wait for it to change state */ - erts_refc_t refc; /* Number of ports/processes having + erts_smp_refc_t refc; /* Number of ports/processes having references to the driver */ erts_smp_atomic32_t port_count; /* Number of ports using the driver */ Uint flags; /* ERL_DE_FL_KILL_PORTS */ @@ -214,118 +217,6 @@ extern Eterm erts_ddll_monitor_driver(Process *p, ErtsProcLocks plocks); /* -** Just like the driver binary but with initial flags -** Note that the two structures Binary and ErlDrvBinary HAVE to -** be equal except for extra fields in the beginning of the struct. -** ErlDrvBinary is defined in erl_driver.h. -** When driver_alloc_binary is called, a Binary is allocated, but -** the pointer returned is to the address of the first element that -** also occurs in the ErlDrvBinary struct (driver.*binary takes care if this). -** The driver need never know about additions to the internal Binary of the -** emulator. One should however NEVER be sloppy when mixing ErlDrvBinary -** and Binary, the macros below can convert one type to the other, as they both -** in reality are equal. -*/ - -#ifdef ARCH_32 - /* *DO NOT USE* only for alignment. */ -#define ERTS_BINARY_STRUCT_ALIGNMENT Uint32 align__; -#else -#define ERTS_BINARY_STRUCT_ALIGNMENT -#endif - -/* Add fields in ERTS_INTERNAL_BINARY_FIELDS, otherwise the drivers crash */ -#define ERTS_INTERNAL_BINARY_FIELDS \ - UWord flags; \ - erts_refc_t refc; \ - ERTS_BINARY_STRUCT_ALIGNMENT - -typedef struct binary { - ERTS_INTERNAL_BINARY_FIELDS - SWord orig_size; - char orig_bytes[1]; /* to be continued */ -} Binary; - -#define ERTS_SIZEOF_Binary(Sz) \ - (offsetof(Binary,orig_bytes) + (Sz)) - -typedef struct { - ERTS_INTERNAL_BINARY_FIELDS - SWord orig_size; - void (*destructor)(Binary *); - union { - struct { - ERTS_BINARY_STRUCT_ALIGNMENT - char data[1]; - } aligned; - struct { - char data[1]; - } unaligned; - } u; -} ErtsMagicBinary; - -#ifdef ARCH_32 -#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 4 -#else -#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 0 -#endif - -typedef union { - Binary binary; - ErtsMagicBinary magic_binary; - struct { - ERTS_INTERNAL_BINARY_FIELDS - ErlDrvBinary binary; - } driver; -} ErtsBinary; - -/* - * 'Binary' alignment: - * Address of orig_bytes[0] of a Binary should always be 8-byte aligned. - * It is assumed that the flags, refc, and orig_size fields are 4 bytes on - * 32-bits architectures and 8 bytes on 64-bits architectures. - */ - -#define ERTS_MAGIC_BIN_DESTRUCTOR(BP) \ - ((ErtsBinary *) (BP))->magic_binary.destructor -#define ERTS_MAGIC_BIN_DATA(BP) \ - ((void *) ((ErtsBinary *) (BP))->magic_binary.u.aligned.data) -#define ERTS_MAGIC_DATA_OFFSET \ - (offsetof(ErtsMagicBinary,u.aligned.data) - offsetof(Binary,orig_bytes)) -#define ERTS_MAGIC_BIN_ORIG_SIZE(Sz) \ - (ERTS_MAGIC_DATA_OFFSET + (Sz)) -#define ERTS_MAGIC_BIN_SIZE(Sz) \ - (offsetof(ErtsMagicBinary,u.aligned.data) + (Sz)) - -/* On 32-bit arch these macro variants will save memory - by not forcing 8-byte alignment for the magic payload. -*/ -#define ERTS_MAGIC_BIN_UNALIGNED_DATA(BP) \ - ((void *) ((ErtsBinary *) (BP))->magic_binary.u.unaligned.data) -#define ERTS_MAGIC_UNALIGNED_DATA_OFFSET \ - (offsetof(ErtsMagicBinary,u.unaligned.data) - offsetof(Binary,orig_bytes)) -#define ERTS_MAGIC_BIN_UNALIGNED_DATA_SIZE(BP) \ - ((BP)->orig_size - ERTS_MAGIC_UNALIGNED_DATA_OFFSET) -#define ERTS_MAGIC_BIN_UNALIGNED_ORIG_SIZE(Sz) \ - (ERTS_MAGIC_UNALIGNED_DATA_OFFSET + (Sz)) -#define ERTS_MAGIC_BIN_UNALIGNED_SIZE(Sz) \ - (offsetof(ErtsMagicBinary,u.unaligned.data) + (Sz)) -#define ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(DATA) \ - ((ErtsBinary*)((char*)(DATA) - offsetof(ErtsMagicBinary,u.unaligned.data))) - - -#define Binary2ErlDrvBinary(B) (&((ErtsBinary *) (B))->driver.binary) -#define ErlDrvBinary2Binary(D) ((Binary *) \ - (((char *) (D)) \ - - offsetof(ErtsBinary, driver.binary))) - -/* A "magic" binary flag */ -#define BIN_FLAG_MAGIC 1 -#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */ -#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */ -#define BIN_FLAG_DRV 8 - -/* * This structure represents one type of a binary in a process. */ @@ -346,46 +237,12 @@ typedef struct proc_bin { */ #define PROC_BIN_SIZE (sizeof(ProcBin)/sizeof(Eterm)) -ERTS_GLB_INLINE Eterm erts_mk_magic_binary_term(Eterm **hpp, - ErlOffHeap *ohp, - Binary *mbp); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE Eterm -erts_mk_magic_binary_term(Eterm **hpp, ErlOffHeap *ohp, Binary *mbp) -{ - ProcBin *pb = (ProcBin *) *hpp; - *hpp += PROC_BIN_SIZE; - - ASSERT(mbp->flags & BIN_FLAG_MAGIC); - - pb->thing_word = HEADER_PROC_BIN; - pb->size = 0; - pb->next = ohp->first; - ohp->first = (struct erl_off_heap_header*) pb; - pb->val = mbp; - pb->bytes = (byte *) mbp->orig_bytes; - pb->flags = 0; - - erts_refc_inc(&mbp->refc, 1); - - return make_binary(pb); -} - -#endif - -#define ERTS_TERM_IS_MAGIC_BINARY(T) \ - (is_binary((T)) \ - && (thing_subtag(*binary_val((T))) == REFC_BINARY_SUBTAG) \ - && (((ProcBin *) binary_val((T)))->val->flags & BIN_FLAG_MAGIC)) - - union erl_off_heap_ptr { struct erl_off_heap_header* hdr; ProcBin *pb; struct erl_fun_thing* fun; struct external_thing_* ext; + ErtsMRefThing *mref; Eterm* ep; void* voidp; }; @@ -978,21 +835,6 @@ void erts_bif_info_init(void); /* bif.c */ -ERTS_GLB_INLINE Eterm -erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE Eterm -erts_proc_store_ref(Process *c_p, Uint32 ref[ERTS_MAX_REF_NUMBERS]) -{ - Eterm *hp = HAlloc(c_p, REF_THING_SIZE); - write_ref_thing(hp, ref[0], ref[1], ref[2]); - return make_internal_ref(hp); -} - -#endif - void erts_queue_monitor_message(Process *, ErtsProcLocks*, Eterm, @@ -1077,6 +919,9 @@ void print_process_info(fmtfn_t, void *, Process*); void info(fmtfn_t, void *); void loaded(fmtfn_t, void *); +/* sighandler sys.c */ +int erts_set_signal(Eterm signal, Eterm type); + /* erl_arith.c */ double erts_get_positive_zero_float(void); @@ -1380,6 +1225,7 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen); void bin_write(fmtfn_t, void*, byte*, size_t); Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */ +Sint erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len); struct Sint_buf { #if defined(ARCH_64) diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 33b74f30b7..dad24d7ef6 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1445,7 +1445,7 @@ finalize_force_imm_drv_call(ErtsTryImmDrvCallState *sp) erts_unblock_fpe(sp->fpe_was_unmasked); } -#define ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE (REF_THING_SIZE + 3) +#define ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE (ERTS_REF_THING_SIZE + 3) static ERTS_INLINE void queue_port_sched_op_reply(Process *rp, @@ -1460,7 +1460,7 @@ queue_port_sched_op_reply(Process *rp, ref= make_internal_ref(hp); write_ref_thing(hp, ref_num[0], ref_num[1], ref_num[2]); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; msg = TUPLE2(hp, ref, msg); @@ -3099,7 +3099,7 @@ port_monitor(Port *prt, erts_aint32_t state, Eterm origin, ASSERT(is_pid(origin)); ASSERT(is_atom(name) || is_port(name) || name == NIL); - ASSERT(is_internal_ref(ref)); + ASSERT(is_internal_ordinary_ref(ref)); if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) { ErtsProcLocks p_locks = ERTS_PROC_LOCK_LINK; @@ -3124,7 +3124,7 @@ static int port_sig_monitor(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigdp) { - Eterm hp[REF_THING_SIZE]; + Eterm hp[ERTS_REF_THING_SIZE]; Eterm ref = make_internal_ref(&hp); write_ref_thing(hp, sigdp->ref[0], sigdp->ref[1], sigdp->ref[2]); @@ -3245,7 +3245,7 @@ static int port_sig_demonitor(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigdp) { - Eterm hp[REF_THING_SIZE]; + Eterm hp[ERTS_REF_THING_SIZE]; Eterm ref = make_internal_ref(&hp); write_ref_thing(hp, sigdp->u.demonitor.ref[0], sigdp->u.demonitor.ref[1], @@ -3302,10 +3302,10 @@ ErtsPortOpResult erts_port_demonitor(Process *origin, ErtsDemonitorMode mode, sigdp->u.demonitor.origin = origin->common.id; sigdp->u.demonitor.name = target->common.id; { - RefThing *reft = ref_thing_ptr(ref); + Uint32 *nums = internal_ref_numbers(ref); /* Start from 1 skip ref arity */ sys_memcpy(sigdp->u.demonitor.ref, - internal_thing_ref_numbers(reft), + nums, sizeof(sigdp->u.demonitor.ref)); } @@ -5413,7 +5413,7 @@ reply_io_bytes(void *vreq) rp_locks = ERTS_PROC_LOCK_MAIN; } - hsz = 5 /* 4-tuple */ + REF_THING_SIZE; + hsz = 5 /* 4-tuple */ + ERTS_REF_THING_SIZE; erts_bld_uint64(NULL, &hsz, in); erts_bld_uint64(NULL, &hsz, out); @@ -5422,7 +5422,7 @@ reply_io_bytes(void *vreq) ref = make_internal_ref(hp); write_ref_thing(hp, req->refn[0], req->refn[1], req->refn[2]); - hp += REF_THING_SIZE; + hp += ERTS_REF_THING_SIZE; ein = erts_bld_uint64(&hp, NULL, in); eout = erts_bld_uint64(&hp, NULL, out); @@ -5451,7 +5451,7 @@ erts_request_io_bytes(Process *c_p) ErtsIOBytesReq *req = erts_alloc(ERTS_ALC_T_IOB_REQ, sizeof(ErtsIOBytesReq)); - hp = HAlloc(c_p, REF_THING_SIZE); + hp = HAlloc(c_p, ERTS_REF_THING_SIZE); ref = erts_sched_make_ref_in_buffer(esdp, hp); refn = internal_ref_numbers(ref); @@ -6888,12 +6888,6 @@ ErlDrvSizeT driver_vec_to_buf(ErlIOVec *vec, char *buf, ErlDrvSizeT len) return (orig_len - len); } - -/* - * - driver_alloc_binary() is thread safe (efile driver depend on it). - * - driver_realloc_binary(), and driver_free_binary() are *not* thread safe. - */ - /* * reference count on driver binaries... */ @@ -6936,26 +6930,15 @@ driver_alloc_binary(ErlDrvSizeT size) return Binary2ErlDrvBinary(bin); } -/* Reallocate space hold by binary */ +/* Reallocate space held by binary */ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size) { Binary* oldbin; Binary* newbin; - if (!bin) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, - "Bad use of driver_realloc_binary(%p, %lu): " - "called with ", - bin, (unsigned long)size); - if (!bin) { - erts_dsprintf(dsbufp, "NULL pointer as first argument"); - } - erts_send_warning_to_logger_nogl(dsbufp); - if (!bin) - return driver_alloc_binary(size); - } + if (!bin) + return driver_alloc_binary(size); oldbin = ErlDrvBinary2Binary(bin); newbin = (Binary *) erts_bin_realloc_fnf(oldbin, size); @@ -6969,14 +6952,8 @@ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size) void driver_free_binary(ErlDrvBinary* dbin) { Binary *bin; - if (!dbin) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, - "Bad use of driver_free_binary(%p): called with " - "NULL pointer as argument", dbin); - erts_send_warning_to_logger_nogl(dsbufp); + if (!dbin) return; - } bin = ErlDrvBinary2Binary(dbin); if (erts_refc_dectest(&bin->refc, 0) == 0) @@ -7632,20 +7609,16 @@ erl_drv_convert_time_unit(ErlDrvTime val, static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon) { - RefThing *refp; - ASSERT(is_internal_ref(ref)); - ERTS_CT_ASSERT(sizeof(RefThing) <= sizeof(ErlDrvMonitor)); - refp = ref_thing_ptr(ref); - memset(mon,0,sizeof(ErlDrvMonitor)); - memcpy(mon,refp,sizeof(RefThing)); + ERTS_CT_ASSERT(sizeof(ErtsOIRefStorage) <= sizeof(ErlDrvMonitor)); + erts_oiref_storage_save((ErtsOIRefStorage *) mon, ref); } static int do_driver_monitor_process(Port *prt, - Eterm *buf, ErlDrvTermData process, ErlDrvMonitor *monitor) { + Eterm buf[ERTS_REF_THING_SIZE]; Process *rp; Eterm ref; @@ -7688,26 +7661,22 @@ int driver_monitor_process(ErlDrvPort drvport, /* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - { - DeclareTmpHeapNoproc(buf,REF_THING_SIZE); - UseTmpHeapNoproc(REF_THING_SIZE); - ret = do_driver_monitor_process(prt,buf,process,monitor); - UnUseTmpHeapNoproc(REF_THING_SIZE); - } + ret = do_driver_monitor_process(prt,process,monitor); DRV_MONITOR_UNLOCK_PDL(prt); return ret; } -static int do_driver_demonitor_process(Port *prt, Eterm *buf, - const ErlDrvMonitor *monitor) +static int do_driver_demonitor_process(Port *prt, const ErlDrvMonitor *monitor) { + Eterm heap[ERTS_REF_THING_SIZE]; + Eterm *hp = &heap[0]; Process *rp; Eterm ref; ErtsMonitor *mon; Eterm to; - memcpy(buf,monitor,sizeof(Eterm)*REF_THING_SIZE); - ref = make_internal_ref(buf); + ref = erts_oiref_storage_make_ref((ErtsOIRefStorage *) monitor, &hp), + mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref); if (mon == NULL) { return 1; @@ -7751,25 +7720,21 @@ int driver_demonitor_process(ErlDrvPort drvport, /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - { - DeclareTmpHeapNoproc(buf,REF_THING_SIZE); - UseTmpHeapNoproc(REF_THING_SIZE); - ret = do_driver_demonitor_process(prt,buf,monitor); - UnUseTmpHeapNoproc(REF_THING_SIZE); - } + ret = do_driver_demonitor_process(prt,monitor); DRV_MONITOR_UNLOCK_PDL(prt); return ret; } -static ErlDrvTermData do_driver_get_monitored_process(Port *prt, Eterm *buf, - const ErlDrvMonitor *monitor) +static ErlDrvTermData do_driver_get_monitored_process(Port *prt,const ErlDrvMonitor *monitor) { Eterm ref; ErtsMonitor *mon; Eterm to; + Eterm heap[ERTS_REF_THING_SIZE]; + Eterm *hp = &heap[0]; + + ref = erts_oiref_storage_make_ref((ErtsOIRefStorage *) monitor, &hp), - memcpy(buf,monitor,sizeof(Eterm)*REF_THING_SIZE); - ref = make_internal_ref(buf); mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref); if (mon == NULL) { return driver_term_nil; @@ -7797,12 +7762,7 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - { - DeclareTmpHeapNoproc(buf,REF_THING_SIZE); - UseTmpHeapNoproc(REF_THING_SIZE); - ret = do_driver_get_monitored_process(prt,buf,monitor); - UnUseTmpHeapNoproc(REF_THING_SIZE); - } + ret = do_driver_get_monitored_process(prt,monitor); DRV_MONITOR_UNLOCK_PDL(prt); return ret; } @@ -7811,7 +7771,8 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, int driver_compare_monitors(const ErlDrvMonitor *monitor1, const ErlDrvMonitor *monitor2) { - return memcmp(monitor1,monitor2,sizeof(ErlDrvMonitor)); + return erts_oiref_storage_cmp((ErtsOIRefStorage *) monitor1, + (ErtsOIRefStorage *) monitor2); } void erts_fire_port_monitor(Port *prt, Eterm ref) diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c index acda51c9fc..7f60710124 100644 --- a/erts/emulator/beam/register.c +++ b/erts/emulator/beam/register.c @@ -272,13 +272,13 @@ erts_whereis_name_to_id(Process *c_p, Eterm name) int ix; HashBucket* b; #ifdef ERTS_SMP - ErtsProcLocks c_p_locks = c_p ? ERTS_PROC_LOCK_MAIN : 0; - -#ifdef ERTS_ENABLE_LOCK_CHECK - if (c_p) ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p); -#endif - + ErtsProcLocks c_p_locks = 0; + if (c_p) { + c_p_locks = ERTS_PROC_LOCK_MAIN; + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p); + } reg_safe_read_lock(c_p, &c_p_locks); + if (c_p && !c_p_locks) erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); #endif diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 14b8a5950d..c6ea8049c3 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -487,20 +487,6 @@ extern volatile int erts_break_requested; void erts_do_break_handling(void); #endif -#ifdef ERTS_WANT_GOT_SIGUSR1 -# ifndef UNIX -# define ERTS_GOT_SIGUSR1 0 -# else -# ifdef ERTS_SMP -extern erts_smp_atomic32_t erts_got_sigusr1; -# define ERTS_GOT_SIGUSR1 ((int) erts_smp_atomic32_read_mb(&erts_got_sigusr1)) -# else -extern volatile int erts_got_sigusr1; -# define ERTS_GOT_SIGUSR1 erts_got_sigusr1 -# endif -# endif -#endif - #ifdef ERTS_SMP extern erts_smp_atomic32_t erts_writing_erl_crash_dump; extern erts_tsd_key_t erts_is_crash_dumping_key; @@ -903,10 +889,13 @@ void sys_alloc_stat(SysAllocStat *); #define ERTS_REFC_DEBUG #endif -typedef erts_smp_atomic_t erts_refc_t; +typedef erts_atomic_t erts_refc_t; ERTS_GLB_INLINE void erts_refc_init(erts_refc_t *refcp, erts_aint_t val); ERTS_GLB_INLINE void erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_refc_inc_unless(erts_refc_t *refcp, + erts_aint_t unless_val, + erts_aint_t min_val); ERTS_GLB_INLINE erts_aint_t erts_refc_inctest(erts_refc_t *refcp, erts_aint_t min_val); ERTS_GLB_INLINE void erts_refc_dec(erts_refc_t *refcp, erts_aint_t min_val); @@ -922,27 +911,51 @@ ERTS_GLB_INLINE erts_aint_t erts_refc_read(erts_refc_t *refcp, ERTS_GLB_INLINE void erts_refc_init(erts_refc_t *refcp, erts_aint_t val) { - erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val); + erts_atomic_init_nob((erts_atomic_t *) refcp, val); } ERTS_GLB_INLINE void erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val) { #ifdef ERTS_REFC_DEBUG - erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_inc_read_nob((erts_atomic_t *) refcp); if (val < min_val) erts_exit(ERTS_ABORT_EXIT, "erts_refc_inc(): Bad refc found (refc=%ld < %ld)!\n", val, min_val); #else - erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp); + erts_atomic_inc_nob((erts_atomic_t *) refcp); #endif } ERTS_GLB_INLINE erts_aint_t +erts_refc_inc_unless(erts_refc_t *refcp, + erts_aint_t unless_val, + erts_aint_t min_val) +{ + erts_aint_t val = erts_atomic_read_nob((erts_atomic_t *) refcp); + while (1) { + erts_aint_t exp, new; +#ifdef ERTS_REFC_DEBUG + if (val < 0) + erts_exit(ERTS_ABORT_EXIT, + "erts_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + if (val == unless_val) + return val; + new = val + 1; + exp = val; + val = erts_atomic_cmpxchg_nob((erts_atomic_t *) refcp, new, exp); + if (val == exp) + return new; + } +} + +ERTS_GLB_INLINE erts_aint_t erts_refc_inctest(erts_refc_t *refcp, erts_aint_t min_val) { - erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_inc_read_nob((erts_atomic_t *) refcp); #ifdef ERTS_REFC_DEBUG if (val < min_val) erts_exit(ERTS_ABORT_EXIT, @@ -956,20 +969,20 @@ ERTS_GLB_INLINE void erts_refc_dec(erts_refc_t *refcp, erts_aint_t min_val) { #ifdef ERTS_REFC_DEBUG - erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_dec_read_nob((erts_atomic_t *) refcp); if (val < min_val) erts_exit(ERTS_ABORT_EXIT, "erts_refc_dec(): Bad refc found (refc=%ld < %ld)!\n", val, min_val); #else - erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp); + erts_atomic_dec_nob((erts_atomic_t *) refcp); #endif } ERTS_GLB_INLINE erts_aint_t erts_refc_dectest(erts_refc_t *refcp, erts_aint_t min_val) { - erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_dec_read_nob((erts_atomic_t *) refcp); #ifdef ERTS_REFC_DEBUG if (val < min_val) erts_exit(ERTS_ABORT_EXIT, @@ -983,20 +996,20 @@ ERTS_GLB_INLINE void erts_refc_add(erts_refc_t *refcp, erts_aint_t diff, erts_aint_t min_val) { #ifdef ERTS_REFC_DEBUG - erts_aint_t val = erts_smp_atomic_add_read_nob((erts_smp_atomic_t *) refcp, diff); + erts_aint_t val = erts_atomic_add_read_nob((erts_atomic_t *) refcp, diff); if (val < min_val) erts_exit(ERTS_ABORT_EXIT, "erts_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n", diff, val, min_val); #else - erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff); + erts_atomic_add_nob((erts_atomic_t *) refcp, diff); #endif } ERTS_GLB_INLINE erts_aint_t erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val) { - erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp); + erts_aint_t val = erts_atomic_read_nob((erts_atomic_t *) refcp); #ifdef ERTS_REFC_DEBUG if (val < min_val) erts_exit(ERTS_ABORT_EXIT, @@ -1008,6 +1021,140 @@ erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ +typedef erts_smp_atomic_t erts_smp_refc_t; + +ERTS_GLB_INLINE void erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val); +ERTS_GLB_INLINE void erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inc_unless(erts_smp_refc_t *refcp, + erts_aint_t unless_val, + erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inctest(erts_smp_refc_t *refcp, + erts_aint_t min_val); +ERTS_GLB_INLINE void erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_smp_refc_dectest(erts_smp_refc_t *refcp, + erts_aint_t min_val); +ERTS_GLB_INLINE void erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff, + erts_aint_t min_val); +ERTS_GLB_INLINE erts_aint_t erts_smp_refc_read(erts_smp_refc_t *refcp, + erts_aint_t min_val); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val) +{ + erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val); +} + +ERTS_GLB_INLINE void +erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ +#ifdef ERTS_REFC_DEBUG + erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp); + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_inc(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#else + erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp); +#endif +} + +ERTS_GLB_INLINE erts_aint_t +erts_smp_refc_inc_unless(erts_smp_refc_t *refcp, + erts_aint_t unless_val, + erts_aint_t min_val) +{ + erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp); + while (1) { + erts_aint_t exp, new; +#ifdef ERTS_REFC_DEBUG + if (val < 0) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + if (val == unless_val) + return val; + new = val + 1; + exp = val; + val = erts_smp_atomic_cmpxchg_nob((erts_smp_atomic_t *) refcp, new, exp); + if (val == exp) + return new; + } +} + + +ERTS_GLB_INLINE erts_aint_t +erts_smp_refc_inctest(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ + erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_inctest(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +ERTS_GLB_INLINE void +erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ +#ifdef ERTS_REFC_DEBUG + erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp); + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_dec(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#else + erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp); +#endif +} + +ERTS_GLB_INLINE erts_aint_t +erts_smp_refc_dectest(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ + erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_dectest(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +ERTS_GLB_INLINE void +erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff, erts_aint_t min_val) +{ +#ifdef ERTS_REFC_DEBUG + erts_aint_t val = erts_smp_atomic_add_read_nob((erts_smp_atomic_t *) refcp, diff); + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n", + diff, val, min_val); +#else + erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff); +#endif +} + +ERTS_GLB_INLINE erts_aint_t +erts_smp_refc_read(erts_smp_refc_t *refcp, erts_aint_t min_val) +{ + erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erts_exit(ERTS_ABORT_EXIT, + "erts_smp_refc_read(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + #ifdef ERTS_ENABLE_KERNEL_POLL extern int erts_use_kernel_poll; #endif diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 74a0681dd5..092a5320ba 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1838,7 +1838,7 @@ make_internal_hash(Eterm term) break; case REF_SUBTAG: UINT32_HASH(internal_ref_numbers(term)[0], HCONST_7); - ASSERT(internal_ref_no_of_numbers(term) == 3); + ASSERT(internal_ref_no_numbers(term) == 3); UINT32_HASH_2(internal_ref_numbers(term)[1], internal_ref_numbers(term)[2], HCONST_8); goto pop_next; @@ -1847,7 +1847,7 @@ make_internal_hash(Eterm term) { ExternalThing* thing = external_thing_ptr(term); - ASSERT(external_thing_ref_no_of_numbers(thing) == 3); + ASSERT(external_thing_ref_no_numbers(thing) == 3); /* See limitation #2 */ #ifdef ARCH_64 POINTER_HASH(thing->node, HCONST_7); @@ -2486,22 +2486,20 @@ tailrecur_ne: anum = external_thing_ref_numbers(athing); bnum = external_thing_ref_numbers(bthing); - alen = external_thing_ref_no_of_numbers(athing); - blen = external_thing_ref_no_of_numbers(bthing); + alen = external_thing_ref_no_numbers(athing); + blen = external_thing_ref_no_numbers(bthing); goto ref_common; + case REF_SUBTAG: - if (!is_internal_ref(b)) - goto not_equal; - { - RefThing* athing = ref_thing_ptr(a); - RefThing* bthing = ref_thing_ptr(b); - alen = internal_thing_ref_no_of_numbers(athing); - blen = internal_thing_ref_no_of_numbers(bthing); - anum = internal_thing_ref_numbers(athing); - bnum = internal_thing_ref_numbers(bthing); - } + if (!is_internal_ref(b)) + goto not_equal; + + alen = internal_ref_no_numbers(a); + anum = internal_ref_numbers(a); + blen = internal_ref_no_numbers(b); + bnum = internal_ref_numbers(b); ref_common: ASSERT(alen > 0 && blen > 0); @@ -3133,25 +3131,21 @@ tailrecur_ne: */ if (is_internal_ref(b)) { - RefThing* bthing = ref_thing_ptr(b); bnode = erts_this_node; - bnum = internal_thing_ref_numbers(bthing); - blen = internal_thing_ref_no_of_numbers(bthing); + blen = internal_ref_no_numbers(b); + bnum = internal_ref_numbers(b); } else if(is_external_ref(b)) { ExternalThing* bthing = external_thing_ptr(b); bnode = bthing->node; bnum = external_thing_ref_numbers(bthing); - blen = external_thing_ref_no_of_numbers(bthing); + blen = external_thing_ref_no_numbers(bthing); } else { a_tag = REF_DEF; goto mixed_types; } - { - RefThing* athing = ref_thing_ptr(a); - anode = erts_this_node; - anum = internal_thing_ref_numbers(athing); - alen = internal_thing_ref_no_of_numbers(athing); - } + anode = erts_this_node; + alen = internal_ref_no_numbers(a); + anum = internal_ref_numbers(a); ref_common: CMP_NODES(anode, bnode); @@ -3181,15 +3175,14 @@ tailrecur_ne: goto pop_next; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): if (is_internal_ref(b)) { - RefThing* bthing = ref_thing_ptr(b); bnode = erts_this_node; - bnum = internal_thing_ref_numbers(bthing); - blen = internal_thing_ref_no_of_numbers(bthing); + blen = internal_ref_no_numbers(b); + bnum = internal_ref_numbers(b); } else if (is_external_ref(b)) { ExternalThing* bthing = external_thing_ptr(b); bnode = bthing->node; bnum = external_thing_ref_numbers(bthing); - blen = external_thing_ref_no_of_numbers(bthing); + blen = external_thing_ref_no_numbers(bthing); } else { a_tag = EXTERNAL_REF_DEF; goto mixed_types; @@ -3198,7 +3191,7 @@ tailrecur_ne: ExternalThing* athing = external_thing_ptr(a); anode = athing->node; anum = external_thing_ref_numbers(athing); - alen = external_thing_ref_no_of_numbers(athing); + alen = external_thing_ref_no_numbers(athing); } goto ref_common; default: @@ -3575,40 +3568,41 @@ not_equal: Eterm store_external_or_ref_(Uint **hpp, ErlOffHeap* oh, Eterm ns) { + struct erl_off_heap_header *ohhp; Uint i; Uint size; - Uint *from_hp; - Uint *to_hp = *hpp; + Eterm *from_hp; + Eterm *to_hp = *hpp; ASSERT(is_external(ns) || is_internal_ref(ns)); - if(is_external(ns)) { - from_hp = external_val(ns); - size = thing_arityval(*from_hp) + 1; - *hpp += size; - - for(i = 0; i < size; i++) - to_hp[i] = from_hp[i]; - - erts_refc_inc(&((ExternalThing *) to_hp)->node->refc, 2); - - ((struct erl_off_heap_header*) to_hp)->next = oh->first; - oh->first = (struct erl_off_heap_header*) to_hp; - - return make_external(to_hp); - } - - /* Internal ref */ - from_hp = internal_ref_val(ns); - + from_hp = boxed_val(ns); size = thing_arityval(*from_hp) + 1; - *hpp += size; for(i = 0; i < size; i++) to_hp[i] = from_hp[i]; - return make_internal_ref(to_hp); + if (is_external_header(*from_hp)) { + ExternalThing *etp = (ExternalThing *) from_hp; + ASSERT(is_external(ns)); + erts_smp_refc_inc(&etp->node->refc, 2); + } + else if (is_ordinary_ref_thing(from_hp)) + return make_internal_ref(to_hp); + else { + ErtsMRefThing *mreft = (ErtsMRefThing *) from_hp; + ErtsMagicBinary *mb = mreft->mb; + ASSERT(is_magic_ref_thing(from_hp)); + erts_refc_inc(&mb->refc, 2); + OH_OVERHEAD(oh, mb->orig_size / sizeof(Eterm)); + } + + ohhp = (struct erl_off_heap_header*) to_hp; + ohhp->next = oh->first; + oh->first = ohhp; + + return make_boxed(to_hp); } Eterm @@ -3671,6 +3665,68 @@ intlist_to_buf(Eterm list, char *buf, Sint len) return -2; /* not enough space */ } +/* Fill buf with the contents of the unicode list. + * Return the number of bytes in the buffer, + * or -1 for type error, + * or -2 for not enough buffer space (buffer contains truncated result). + */ +Sint +erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len) +{ + Eterm* listptr; + Sint sz = 0; + + if (is_nil(list)) { + return 0; + } + if (is_not_list(list)) { + return -1; + } + listptr = list_val(list); + + while (len-- > 0) { + Sint val; + + if (is_not_small(CAR(listptr))) { + return -1; + } + val = signed_val(CAR(listptr)); + if (0 <= val && val < 0x80) { + buf[sz] = val; + sz++; + } else if (val < 0x800) { + buf[sz+0] = 0xC0 | (val >> 6); + buf[sz+1] = 0x80 | (val & 0x3F); + sz += 2; + } else if (val < 0x10000UL) { + if (0xD800 <= val && val <= 0xDFFF) { + return -1; + } + buf[sz+0] = 0xE0 | (val >> 12); + buf[sz+1] = 0x80 | ((val >> 6) & 0x3F); + buf[sz+2] = 0x80 | (val & 0x3F); + sz += 3; + } else if (val < 0x110000) { + buf[sz+0] = 0xF0 | (val >> 18); + buf[sz+1] = 0x80 | ((val >> 12) & 0x3F); + buf[sz+2] = 0x80 | ((val >> 6) & 0x3F); + buf[sz+3] = 0x80 | (val & 0x3F); + sz += 4; + } else { + return -1; + } + list = CDR(listptr); + if (is_nil(list)) { + return sz; + } + if (is_not_list(list)) { + return -1; + } + listptr = list_val(list); + } + return -2; /* not enough space */ +} + /* ** Convert an integer to a byte list ** return pointer to converted stuff (need not to be at start of buf!) diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index bfe0807df8..3ff68a8859 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. + * Copyright Ericsson AB 1997-2017. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -79,11 +79,10 @@ * Macros for testing file types. */ -#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR) -#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG) -#define ISDEV(st) \ - (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK) -#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK) +#define ISDIR(st) (S_ISDIR((st).st_mode)) +#define ISREG(st) (S_ISREG((st).st_mode)) +#define ISDEV(st) (S_ISCHR((st).st_mode) || S_ISBLK((st).st_mode)) +#define ISLNK(st) (S_ISLNK((st).st_mode)) #ifdef NO_UMASK #define FILE_MODE 0644 #define DIR_MODE 0755 @@ -366,33 +365,6 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ int fd; int mode; /* Open mode. */ - if (stat(name, &statbuf) < 0) { - /* statbuf is undefined: if the caller depends on it, - i.e. invoke_read_file(), fail the call immediately */ - if (pSize && flags == EFILE_MODE_READ) - return check_error(-1, errInfo); - } else if (!ISREG(statbuf)) { - /* - * For UNIX only, here is some ugly code to allow - * /dev/null to be opened as a file. - * - * Assumption: The i-node number for /dev/null cannot be zero. - */ - static ino_t dev_null_ino = 0; - - if (dev_null_ino == 0) { - struct stat nullstatbuf; - - if (stat("/dev/null", &nullstatbuf) >= 0) { - dev_null_ino = nullstatbuf.st_ino; - } - } - if (!(dev_null_ino && statbuf.st_ino == dev_null_ino)) { - errno = EISDIR; - return check_error(-1, errInfo); - } - } - switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) { case EFILE_MODE_READ: mode = O_RDONLY; @@ -411,16 +383,13 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ return check_error(-1, errInfo); } - if (flags & EFILE_MODE_APPEND) { mode &= ~O_TRUNC; mode |= O_APPEND; } - if (flags & EFILE_MODE_EXCL) { mode |= O_EXCL; } - if (flags & EFILE_MODE_SYNC) { #ifdef O_SYNC mode |= O_SYNC; @@ -430,15 +399,49 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ #endif } - fd = open(name, mode, FILE_MODE); +#ifdef HAVE_FSTAT + while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR)); + if (!check_error(fd, errInfo)) return 0; +#endif + + if ( +#ifdef HAVE_FSTAT + fstat(fd, &statbuf) < 0 +#else + stat(name, &statbuf) < 0 +#endif + ) { + /* statbuf is undefined: if the caller depends on it, + i.e. invoke_read_file(), fail the call immediately */ + if (pSize && flags == EFILE_MODE_READ) { + check_error(-1, errInfo); +#ifdef HAVE_FSTAT + efile_closefile(fd); +#endif + return 0; + } + } + else if (! ISREG(statbuf)) { + struct stat nullstatbuf; + /* + * For UNIX only, here is some ugly code to allow + * /dev/null to be opened as a file. + */ + if ( (stat("/dev/null", &nullstatbuf) < 0) + || (statbuf.st_ino != nullstatbuf.st_ino) + || (statbuf.st_dev != nullstatbuf.st_dev) ) { + errno = EISDIR; + return check_error(-1, errInfo); + } + } - if (!check_error(fd, errInfo)) - return 0; +#ifndef HAVE_FSTAT + while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR)); + if (!check_error(fd, errInfo)) return 0; +#endif *pfd = fd; - if (pSize) { - *pSize = statbuf.st_size; - } + if (pSize) *pSize = statbuf.st_size; return 1; } @@ -460,7 +463,7 @@ efile_may_openfile(Efile_error* errInfo, char *name) { void efile_closefile(int fd) { - close(fd); + while((close(fd) < 0) && (errno == EINTR)); } int diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 9c6ac4bd9c..688c82ab7a 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -381,12 +381,9 @@ BIF_RETTYPE hipe_bifs_ref_set_2(BIF_ALIST_2) static HipeLoaderState *get_loader_state(Eterm term) { - ProcBin *pb; + if (!is_internal_magic_ref(term)) return NULL; - if (!ERTS_TERM_IS_MAGIC_BINARY(term)) return NULL; - - pb = (ProcBin*) binary_val(term); - return hipe_get_loader_state(pb->val); + return hipe_get_loader_state(erts_magic_ref2bin(term)); } @@ -1008,7 +1005,7 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); fe->native_address = native_address; - if (erts_refc_dectest(&fe->refc, 0) == 0) + if (erts_smp_refc_dectest(&fe->refc, 0) == 0) erts_erase_fun_entry(fe); BIF_RET(am_true); } @@ -1982,8 +1979,8 @@ BIF_RETTYPE hipe_bifs_alloc_loader_state_1(BIF_ALIST_1) if (!magic) BIF_ERROR(BIF_P, BADARG); - hp = HAlloc(BIF_P, PROC_BIN_SIZE); - res = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), magic); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); + res = erts_mk_magic_ref(&hp, &MSO(BIF_P), magic); erts_refc_dec(&magic->refc, 1); BIF_RET(res); } diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 9a9252e8b8..e581f07f56 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -323,7 +323,7 @@ char *hipe_bs_allocate(int len) Binary *bptr; bptr = erts_bin_nrml_alloc(len); - erts_smp_atomic_init_nob(&bptr->refc, 1); + erts_refc_init(&bptr->refc, 1); return bptr->orig_bytes; } diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index b8a28bcc18..5e7ae8953a 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -51,7 +51,6 @@ #ifndef WANT_NONBLOCKING # define WANT_NONBLOCKING #endif -#define ERTS_WANT_GOT_SIGUSR1 #include "erl_poll.h" #if ERTS_POLL_USE_KQUEUE diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index e135dbff99..cb20c690b4 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -50,7 +50,6 @@ #endif #define ERTS_WANT_BREAK_HANDLING -#define ERTS_WANT_GOT_SIGUSR1 #define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ #include "sys.h" #include "erl_thr_progress.h" @@ -96,18 +95,10 @@ static int debug_log = 0; #endif #ifdef ERTS_SMP -erts_smp_atomic32_t erts_got_sigusr1; -#define ERTS_SET_GOT_SIGUSR1 \ - erts_smp_atomic32_set_mb(&erts_got_sigusr1, 1) -#define ERTS_UNSET_GOT_SIGUSR1 \ - erts_smp_atomic32_set_mb(&erts_got_sigusr1, 0) static erts_smp_atomic32_t have_prepared_crash_dump; #define ERTS_PREPARED_CRASH_DUMP \ ((int) erts_smp_atomic32_xchg_nob(&have_prepared_crash_dump, 1)) #else -volatile int erts_got_sigusr1; -#define ERTS_SET_GOT_SIGUSR1 (erts_got_sigusr1 = 1) -#define ERTS_UNSET_GOT_SIGUSR1 (erts_got_sigusr1 = 0) static volatile int have_prepared_crash_dump; #define ERTS_PREPARED_CRASH_DUMP \ (have_prepared_crash_dump++) @@ -116,7 +107,7 @@ static volatile int have_prepared_crash_dump; erts_smp_atomic_t sys_misc_mem_sz; #if defined(ERTS_SMP) -static void smp_sig_notify(char c); +static void smp_sig_notify(int signum); static int sig_notify_fds[2] = {-1, -1}; #ifdef ERTS_SYS_SUSPEND_SIGNAL @@ -152,7 +143,7 @@ volatile int erts_break_requested = 0; static struct termios initial_tty_mode; static int replace_intr = 0; /* assume yes initially, ttsl_init will clear it */ -int using_oldshell = 1; +int using_oldshell = 1; #ifdef ERTS_ENABLE_KERNEL_POLL @@ -403,13 +394,6 @@ erts_sys_pre_init(void) /* After creation in parent */ eid.thread_create_parent_func = thr_create_cleanup, -#ifdef ERTS_THR_HAVE_SIG_FUNCS - sigemptyset(&thr_create_sigmask); - sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */ - sigaddset(&thr_create_sigmask, SIGTERM); /* block terminate signal */ - sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */ -#endif - erts_thr_init(&eid); #ifdef ERTS_ENABLE_LOCK_CHECK @@ -428,11 +412,9 @@ erts_sys_pre_init(void) #ifdef ERTS_SMP erts_smp_atomic32_init_nob(&erts_break_requested, 0); - erts_smp_atomic32_init_nob(&erts_got_sigusr1, 0); erts_smp_atomic32_init_nob(&have_prepared_crash_dump, 0); #else erts_break_requested = 0; - erts_got_sigusr1 = 0; have_prepared_crash_dump = 0; #endif @@ -624,6 +606,28 @@ int erts_sys_prepare_crash_dump(int secs) return prepare_crash_dump(secs); } +static void signal_notify_requested(Eterm type) { + Process* p = NULL; + Eterm msg, *hp; + ErtsProcLocks locks = 0; + ErlOffHeap *ohp; + + Eterm id = erts_whereis_name_to_id(NULL, am_erl_signal_server); + + if ((p = (erts_pid2proc_opt(NULL, 0, id, 0, ERTS_P2P_FLG_INC_REFC))) != NULL) { + ErtsMessage *msgp = erts_alloc_message_heap(p, &locks, 3, &hp, &ohp); + + /* erl_signal_server ! {notify, sighup} */ + msg = TUPLE2(hp, am_notify, type); + erts_queue_message(p, locks, msgp, msg, am_system); + + if (locks) + erts_smp_proc_unlock(p, locks); + erts_proc_dec_refc(p); + } +} + + static ERTS_INLINE void break_requested(void) { @@ -641,76 +645,15 @@ break_requested(void) ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ } -/* set up signal handlers for break and quit */ -#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) -static RETSIGTYPE request_break(void) -#else static RETSIGTYPE request_break(int signum) -#endif { #ifdef ERTS_SMP - smp_sig_notify('I'); + smp_sig_notify(signum); #else break_requested(); #endif } -static void stop_requested(void) { - Process* p = NULL; - Eterm msg, *hp; - ErtsProcLocks locks = 0; - ErlOffHeap *ohp; - Eterm id = erts_whereis_name_to_id(NULL, am_init); - - if ((p = (erts_pid2proc_opt(NULL, 0, id, 0, ERTS_P2P_FLG_INC_REFC))) != NULL) { - ErtsMessage *msgp = erts_alloc_message_heap(p, &locks, 3, &hp, &ohp); - - /* init ! {stop,stop} */ - msg = TUPLE2(hp, am_stop, am_stop); - erts_queue_message(p, locks, msgp, msg, am_system); - - if (locks) - erts_smp_proc_unlock(p, locks); - erts_proc_dec_refc(p); - } -} - -#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) -static RETSIGTYPE request_stop(void) -#else -static RETSIGTYPE request_stop(int signum) -#endif -{ -#ifdef ERTS_SMP - smp_sig_notify('S'); -#else - stop_requested(); -#endif -} - - -static ERTS_INLINE void -sigusr1_exit(void) -{ - char env[21]; /* enough to hold any 64-bit integer */ - size_t envsz; - int i, secs = -1; - - /* We do this at interrupt level, since the main reason for - * wanting to generate a crash dump in this way is that the emulator - * is hung somewhere, so it won't be able to poll any flag we set here. - */ - ERTS_SET_GOT_SIGUSR1; - - envsz = sizeof(env); - if ((i = erts_sys_getenv_raw("ERL_CRASH_DUMP_SECONDS", env, &envsz)) >= 0) { - secs = i != 0 ? 0 : atoi(env); - } - - prepare_crash_dump(secs); - erts_exit(ERTS_DUMP_EXIT, "Received SIGUSR1\n"); -} - #ifdef ETHR_UNUSABLE_SIGUSRX #warning "Unusable SIGUSR1 & SIGUSR2. Disabling use of these signals" @@ -731,19 +674,6 @@ sys_thr_resume(erts_tid_t tid) { } #endif -#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) -static RETSIGTYPE user_signal1(void) -#else -static RETSIGTYPE user_signal1(int signum) -#endif -{ -#ifdef ERTS_SMP - smp_sig_notify('1'); -#else - sigusr1_exit(); -#endif -} - #ifdef ERTS_SYS_SUSPEND_SIGNAL #if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) static RETSIGTYPE suspend_signal(void) @@ -763,29 +693,101 @@ static RETSIGTYPE suspend_signal(int signum) #endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ -static void -quit_requested(void) -{ - erts_exit(ERTS_INTR_EXIT, ""); +/* + Signal Action Comment + ───────────────────────────────────────────────────────────── + SIGHUP Term Hangup detected on controlling terminal or death of controlling process + !SIGINT Term Interrupt from keyboard + SIGQUIT Core Quit from keyboard + !SIGILL Core Illegal Instruction + SIGABRT Core Abort signal from abort(3) + !SIGFPE Core Floating point exception + !SIGKILL Term Kill signal + !SIGSEGV Core Invalid memory reference + !SIGPIPE Term Broken pipe: write to pipe with no readers + SIGALRM Term Timer signal from alarm(2) + SIGTERM Term Termination signal + SIGUSR1 Term User-defined signal 1 + SIGUSR2 Term User-defined signal 2 + !SIGCHLD Ign Child stopped or terminated + !SIGCONT Cont Continue if stopped + SIGSTOP Stop Stop process + SIGTSTP Stop Stop typed at terminal + !SIGTTIN Stop Terminal input for background process + !SIGTTOU Stop Terminal output for background process +*/ + + +static ERTS_INLINE int +signalterm_to_signum(Eterm signal) +{ + switch (signal) { + case am_sighup: return SIGHUP; + /* case am_sigint: return SIGINT; */ + case am_sigquit: return SIGQUIT; + /* case am_sigill: return SIGILL; */ + case am_sigabrt: return SIGABRT; + /* case am_sigsegv: return SIGSEGV; */ + case am_sigalrm: return SIGALRM; + case am_sigterm: return SIGTERM; + case am_sigusr1: return SIGUSR1; + case am_sigusr2: return SIGUSR2; + case am_sigchld: return SIGCHLD; + case am_sigstop: return SIGSTOP; + case am_sigtstp: return SIGTSTP; + default: return 0; + } } -#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) -static RETSIGTYPE do_quit(void) -#else -static RETSIGTYPE do_quit(int signum) -#endif +static ERTS_INLINE Eterm +signum_to_signalterm(int signum) +{ + switch (signum) { + case SIGHUP: return am_sighup; + /* case SIGINT: return am_sigint; */ /* ^c */ + case SIGQUIT: return am_sigquit; /* ^\ */ + /* case SIGILL: return am_sigill; */ + case SIGABRT: return am_sigabrt; + /* case SIGSEGV: return am_sigsegv; */ + case SIGALRM: return am_sigalrm; + case SIGTERM: return am_sigterm; + case SIGUSR1: return am_sigusr1; + case SIGUSR2: return am_sigusr2; + case SIGCHLD: return am_sigchld; + case SIGSTOP: return am_sigstop; + case SIGTSTP: return am_sigtstp; /* ^z */ + default: return am_error; + } +} + +static RETSIGTYPE generic_signal_handler(int signum) { #ifdef ERTS_SMP - smp_sig_notify('Q'); + smp_sig_notify(signum); #else - quit_requested(); + Eterm signal = signum_to_signalterm(signum); + signal_notify_requested(signal); #endif } +int erts_set_signal(Eterm signal, Eterm type) { + int signum; + if ((signum = signalterm_to_signum(signal)) > 0) { + if (type == am_ignore) { + sys_signal(signum, SIG_IGN); + } else if (type == am_default) { + sys_signal(signum, SIG_DFL); + } else { + sys_signal(signum, generic_signal_handler); + } + return 1; + } + return 0; +} + /* Disable break */ void erts_set_ignore_break(void) { sys_signal(SIGINT, SIG_IGN); - sys_signal(SIGTERM, SIG_IGN); sys_signal(SIGQUIT, SIG_IGN); sys_signal(SIGTSTP, SIG_IGN); } @@ -797,11 +799,11 @@ void erts_replace_intr(void) { if (isatty(0)) { tcgetattr(0, &mode); - + /* here's an example of how to replace ctrl-c with ctrl-u */ /* mode.c_cc[VKILL] = 0; mode.c_cc[VINTR] = CKILL; */ - + mode.c_cc[VINTR] = 0; /* disable ctrl-c */ tcsetattr(0, TCSANOW, &mode); replace_intr = 1; @@ -810,12 +812,13 @@ void erts_replace_intr(void) { void init_break_handler(void) { - sys_signal(SIGINT, request_break); - sys_signal(SIGTERM, request_stop); + sys_signal(SIGINT, request_break); + sys_signal(SIGTERM, generic_signal_handler); + sys_signal(SIGHUP, generic_signal_handler); #ifndef ETHR_UNUSABLE_SIGUSRX - sys_signal(SIGUSR1, user_signal1); + sys_signal(SIGUSR1, generic_signal_handler); #endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ - sys_signal(SIGQUIT, do_quit); + sys_signal(SIGQUIT, generic_signal_handler); } void sys_init_suspend_handler(void) @@ -855,10 +858,7 @@ get_number(char **str_ptr) } } -void -os_flavor(char* namebuf, /* Where to return the name. */ - unsigned size) /* Size of name buffer. */ -{ +void os_flavor(char* namebuf, unsigned size) { struct utsname uts; /* Information about the system. */ char* s; @@ -871,22 +871,16 @@ os_flavor(char* namebuf, /* Where to return the name. */ strcpy(namebuf, uts.sysname); } -void -os_version(pMajor, pMinor, pBuild) -int* pMajor; /* Pointer to major version. */ -int* pMinor; /* Pointer to minor version. */ -int* pBuild; /* Pointer to build number. */ -{ +void os_version(int *pMajor, int *pMinor, int *pBuild) { struct utsname uts; /* Information about the system. */ char* release; /* Pointer to the release string: - * X.Y or X.Y.Z. - */ + * X.Y or X.Y.Z. */ (void) uname(&uts); release = uts.release; - *pMajor = get_number(&release); - *pMinor = get_number(&release); - *pBuild = get_number(&release); + *pMajor = get_number(&release); /* Pointer to major version. */ + *pMinor = get_number(&release); /* Pointer to minor version. */ + *pBuild = get_number(&release); /* Pointer to build number. */ } void init_getenv_state(GETENV_STATE *state) @@ -921,7 +915,7 @@ void erts_do_break_handling(void) { struct termios temp_mode; int saved = 0; - + /* * Most functions that do_break() calls are intentionally not thread safe; * therefore, make sure that all threads but this one are blocked before @@ -939,14 +933,14 @@ void erts_do_break_handling(void) tcsetattr(0,TCSANOW,&initial_tty_mode); saved = 1; } - + /* call the break handling function, reset the flag */ do_break(); ERTS_UNSET_BREAK_REQUESTED; fflush(stdout); - + /* after break we go back to saved settings */ if (using_oldshell && !replace_intr) { SET_NONBLOCKING(1); @@ -1054,37 +1048,12 @@ erts_sys_unsetenv(char *key) return res; } -void -sys_init_io(void) -{ -} - -#if (0) /* unused? */ -static int write_fill(fd, buf, len) -int fd, len; -char *buf; -{ - int i, done = 0; - - do { - if ((i = write(fd, buf+done, len-done)) < 0) { - if (errno != EINTR) - return (i); - i = 0; - } - done += i; - } while (done < len); - return (len); -} -#endif +void sys_init_io(void) { } +void erts_sys_alloc_init(void) { } extern const char pre_loaded_code[]; extern Preload pre_loaded[]; -void erts_sys_alloc_init(void) -{ -} - #if ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC void *erts_sys_aligned_alloc(UWord alignment, UWord size) { @@ -1185,9 +1154,7 @@ void sys_preload_end(Preload* p) Here we assume that all schedulers are stopped so that erl_poll does not interfere with the select below. */ -int sys_get_key(fd) -int fd; -{ +int sys_get_key(int fd) { int c, ret; unsigned char rbuf[64]; fd_set fds; @@ -1206,15 +1173,14 @@ int fd; if (c <= 0) return c; } - - return rbuf[0]; + return rbuf[0]; } extern int erts_initialized; void erl_assert_error(const char* expr, const char* func, const char* file, int line) -{ +{ fflush(stdout); fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n", file, line, func, expr); @@ -1239,7 +1205,7 @@ erl_debug(char* fmt, ...) { char sbuf[1024]; /* Temporary buffer. */ va_list va; - + if (debug_log) { va_start(va, fmt); vsprintf(sbuf, fmt, va); @@ -1268,14 +1234,14 @@ erl_sys_schedule(int runnable) static erts_smp_tid_t sig_dispatcher_tid; static void -smp_sig_notify(char c) +smp_sig_notify(int signum) { int res; do { /* write() is async-signal safe (according to posix) */ - res = write(sig_notify_fds[1], &c, 1); + res = write(sig_notify_fds[1], &signum, sizeof(int)); } while (res < 0 && errno == EINTR); - if (res != 1) { + if (res != sizeof(int)) { char msg[] = "smp_sig_notify(): Failed to notify signal-dispatcher thread " "about received signal"; @@ -1291,60 +1257,55 @@ signal_dispatcher_thread_func(void *unused) erts_lc_set_thread_name("signal_dispatcher"); #endif while (1) { - char buf[32]; - int res, i; + union {int signum; char buf[4];} sb; + Eterm signal; + int res, i = 0; /* Block on read() waiting for a signal notification to arrive... */ - res = read(sig_notify_fds[0], (void *) &buf[0], 32); + + do { + res = read(sig_notify_fds[0], (void *) &sb.buf[i], sizeof(int) - i); + i += res; + } while ((i != sizeof(int) && res >= 0) || (res < 0 && errno == EINTR)); + if (res < 0) { - if (errno == EINTR) - continue; erts_exit(ERTS_ABORT_EXIT, "signal-dispatcher thread got unexpected error: %s (%d)\n", erl_errno_id(errno), errno); } - for (i = 0; i < res; i++) { - /* - * NOTE 1: The signal dispatcher thread should not do work - * that takes a substantial amount of time (except - * perhaps in test and debug builds). It needs to - * be responsive, i.e, it should only dispatch work - * to other threads. - * - * NOTE 2: The signal dispatcher thread is not a blockable - * thread (i.e., not a thread managed by the - * erl_thr_progress module). This is intentional. - * We want to be able to interrupt writing of a crash - * dump by hitting C-c twice. Since it isn't a - * blockable thread it is important that it doesn't - * change the state of any data that a blocking thread - * expects to have exclusive access to (unless the - * signal dispatcher itself explicitly is blocking all - * blockable threads). - */ - switch (buf[i]) { - case 0: /* Emulator initialized */ + /* + * NOTE 1: The signal dispatcher thread should not do work + * that takes a substantial amount of time (except + * perhaps in test and debug builds). It needs to + * be responsive, i.e, it should only dispatch work + * to other threads. + * + * NOTE 2: The signal dispatcher thread is not a blockable + * thread (i.e., not a thread managed by the + * erl_thr_progress module). This is intentional. + * We want to be able to interrupt writing of a crash + * dump by hitting C-c twice. Since it isn't a + * blockable thread it is important that it doesn't + * change the state of any data that a blocking thread + * expects to have exclusive access to (unless the + * signal dispatcher itself explicitly is blocking all + * blockable threads). + */ + switch (sb.signum) { + case 0: continue; + case SIGINT: + break_requested(); break; - case 'S': /* SIGTERM */ - stop_requested(); - break; - case 'I': /* SIGINT */ - break_requested(); - break; - case 'Q': /* SIGQUIT */ - quit_requested(); - break; - case '1': /* SIGUSR1 */ - sigusr1_exit(); - break; - default: - erts_exit(ERTS_ABORT_EXIT, - "signal-dispatcher thread received unknown " - "signal notification: '%c'\n", - buf[i]); - } - } - ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); + default: + if ((signal = signum_to_signalterm(sb.signum)) == am_error) { + erts_exit(ERTS_ABORT_EXIT, + "signal-dispatcher thread received unknown " + "signal notification: '%d'\n", + sb.signum); + } + signal_notify_requested(signal); + } + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); } return NULL; } @@ -1387,9 +1348,9 @@ init_smp_sig_suspend(void) { int erts_darwin_main_thread_pipe[2]; int erts_darwin_main_thread_result_pipe[2]; -static void initialize_darwin_main_thread_pipes(void) +static void initialize_darwin_main_thread_pipes(void) { - if (pipe(erts_darwin_main_thread_pipe) < 0 || + if (pipe(erts_darwin_main_thread_pipe) < 0 || pipe(erts_darwin_main_thread_result_pipe) < 0) { erts_exit(ERTS_ERROR_EXIT,"Fatal error initializing Darwin main thread stealing"); } @@ -1555,5 +1516,4 @@ erl_sys_args(int* argc, char** argv) argv[j++] = argv[i]; } *argc = j; - } diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index f3881e0736..408b4f47ab 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -294,6 +294,10 @@ int erts_sys_prepare_crash_dump(int secs) return 0; } +int erts_set_signal(Eterm signal, Eterm type) { + return 0; +} + static void init_console(void) { diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 7c9927c4f3..6f9827002a 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -86,6 +86,7 @@ MODULES= \ num_bif_SUITE \ message_queue_data_SUITE \ op_SUITE \ + os_signal_SUITE \ port_SUITE \ port_bif_SUITE \ process_SUITE \ diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index f70fb0e501..339c827602 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -26,7 +26,7 @@ -export([all/0, suite/0, display/1, display_huge/0, erl_bif_types/1,guard_bifs_in_erl_bif_types/1, - shadow_comments/1, + shadow_comments/1,list_to_utf8_atom/1, specs/1,improper_bif_stubs/1,auto_imports/1, t_list_to_existing_atom/1,os_env/1,otp_7526/1, binary_to_atom/1,binary_to_existing_atom/1, @@ -43,7 +43,7 @@ all() -> [erl_bif_types, guard_bifs_in_erl_bif_types, shadow_comments, specs, improper_bif_stubs, auto_imports, t_list_to_existing_atom, os_env, otp_7526, - display, + display, list_to_utf8_atom, atom_to_binary, binary_to_atom, binary_to_existing_atom, erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, error_stacktrace, error_stacktrace_during_call_trace]. @@ -339,6 +339,38 @@ check_stub({_,F,A}, B) -> ct:fail(invalid_body) end. +list_to_utf8_atom(Config) when is_list(Config) -> + 'hello' = atom_roundtrip("hello"), + 'こんにちは' = atom_roundtrip("こんにちは"), + + %% Test all edge cases. + _ = atom_roundtrip([16#80]), + _ = atom_roundtrip([16#7F]), + _ = atom_roundtrip([16#FF]), + _ = atom_roundtrip([16#100]), + _ = atom_roundtrip([16#7FF]), + _ = atom_roundtrip([16#800]), + _ = atom_roundtrip([16#D7FF]), + atom_badarg([16#D800]), + atom_badarg([16#DFFF]), + _ = atom_roundtrip([16#E000]), + _ = atom_roundtrip([16#FFFF]), + _ = atom_roundtrip([16#1000]), + _ = atom_roundtrip([16#10FFFF]), + atom_badarg([16#110000]), + ok. + +atom_roundtrip(String) -> + Atom = list_to_atom(String), + Atom = list_to_existing_atom(String), + String = atom_to_list(Atom), + Atom. + +atom_badarg(String) -> + {'EXIT',{badarg,_}} = (catch list_to_atom(String)), + {'EXIT',{badarg,_}} = (catch list_to_existing_atom(String)), + ok. + t_list_to_existing_atom(Config) when is_list(Config) -> all = list_to_existing_atom("all"), ?MODULE = list_to_existing_atom(?MODULE_STRING), @@ -429,6 +461,8 @@ binary_to_atom(Config) when is_list(Config) -> Long = lists:seq(0, 254), LongAtom = list_to_atom(Long), LongBin = list_to_binary(Long), + UnicodeLongAtom = list_to_atom([$é || _ <- lists:seq(0, 254)]), + UnicodeLongBin = << <<"é"/utf8>> || _ <- lists:seq(0, 254)>>, %% latin1 '' = test_binary_to_atom(<<>>, latin1), @@ -440,12 +474,17 @@ binary_to_atom(Config) when is_list(Config) -> '' = test_binary_to_atom(<<>>, utf8), HalfLongAtom = test_binary_to_atom(HalfLongBin, utf8), HalfLongAtom = test_binary_to_atom(HalfLongBin, unicode), + UnicodeLongAtom = test_binary_to_atom(UnicodeLongBin, utf8), + UnicodeLongAtom = test_binary_to_atom(UnicodeLongBin, unicode), [] = [C || C <- lists:seq(128, 255), begin list_to_atom([C]) =/= test_binary_to_atom(<<C/utf8>>, utf8) end], + <<"こんにちは"/utf8>> = + atom_to_binary(test_binary_to_atom(<<"こんにちは"/utf8>>, utf8), utf8), + %% badarg failures. fail_binary_to_atom(atom), fail_binary_to_atom(42), @@ -464,10 +503,6 @@ binary_to_atom(Config) when is_list(Config) -> ?BADARG(binary_to_atom(id(<<255>>), utf8)), ?BADARG(binary_to_atom(id(<<255,0>>), utf8)), ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0. - [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(256, 16#D7FF)], - [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#E000, 16#FFFD)], - [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#10000, 16#8FFFF)], - [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#90000, 16#10FFFF)], %% system_limit failures. ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index b29520ab9f..d07166ed98 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -296,16 +296,16 @@ get_chunk(Config) when is_list(Config) -> {ok,my_code_test,Code} = compile:file(File, [binary]), %% Should work. - Chunk = get_chunk_ok("Atom", Code), - Chunk = get_chunk_ok("Atom", make_sub_binary(Code)), - Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)), + Chunk = get_chunk_ok("AtU8", Code), + Chunk = get_chunk_ok("AtU8", make_sub_binary(Code)), + Chunk = get_chunk_ok("AtU8", make_unaligned_sub_binary(Code)), %% Should fail. - {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")), + {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "AtU8")), {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")), %% Invalid beam code or missing chunk should return 'undefined'. - undefined = code:get_chunk(<<"not a beam module">>, "Atom"), + undefined = code:get_chunk(<<"not a beam module">>, "AtU8"), undefined = code:get_chunk(Code, "XXXX"), ok. diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 36d512e388..8959be8690 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -748,7 +748,7 @@ resource_hugo_do(Type) -> HugoBin = <<"Hugo Hacker">>, HugoPtr = alloc_resource(Type, HugoBin), Hugo = make_resource(HugoPtr), - <<>> = Hugo, + true = is_reference(Hugo), release_resource(HugoPtr), erlang:garbage_collect(), {HugoPtr,HugoBin} = get_resource(Type,Hugo), @@ -782,7 +782,7 @@ resource_otto_do(Type) -> OttoBin = <<"Otto Ordonnans">>, OttoPtr = alloc_resource(Type, OttoBin), Otto = make_resource(OttoPtr), - <<>> = Otto, + true = is_reference(Otto), %% forget resource term but keep referenced by NIF {OttoPtr, OttoBin}. @@ -805,8 +805,9 @@ resource_new_do2(Type) -> BinB = <<"NewB">>, ResA = make_new_resource(Type, BinA), ResB = make_new_resource(Type, BinB), - <<>> = ResA, - <<>> = ResB, + true = is_reference(ResA), + true = is_reference(ResB), + ResA /= ResB, {PtrA,BinA} = get_resource(Type, ResA), {PtrB,BinB} = get_resource(Type, ResB), true = (PtrA =/= PtrB), diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 4decb7f418..7331c5b2cd 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1027,6 +1027,7 @@ struct make_term_info unsigned reuse_push; unsigned reuse_pull; ErlNifResourceType* resource_type; + void *resource; ERL_NIF_TERM other_term; ERL_NIF_TERM blob; ErlNifPid to_pid; @@ -1139,12 +1140,7 @@ static ERL_NIF_TERM make_term_list0(struct make_term_info* mti, int n) } static ERL_NIF_TERM make_term_resource(struct make_term_info* mti, int n) { - void* resource = enif_alloc_resource(mti->resource_type, 10); - ERL_NIF_TERM term; - fill(resource, 10, n); - term = enif_make_resource(mti->dst_env, resource); - enif_release_resource(resource); - return term; + return enif_make_resource(mti->dst_env, mti->resource); } static ERL_NIF_TERM make_term_new_binary(struct make_term_info* mti, int n) { @@ -1249,23 +1245,39 @@ static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res) return 0; } -static ERL_NIF_TERM make_blob(ErlNifEnv* caller_env, ErlNifEnv* dst_env, - ERL_NIF_TERM other_term) + +static void +init_make_blob(struct make_term_info *mti, + ErlNifEnv* caller_env, + ERL_NIF_TERM other_term) { PrivData* priv = (PrivData*) enif_priv_data(caller_env); + mti->caller_env = caller_env; + mti->resource_type = priv->rt_arr[0].t; + mti->resource = enif_alloc_resource(mti->resource_type, 10); + fill(mti->resource, 10, 17); + mti->other_term = other_term; +} + +static void +fini_make_blob(struct make_term_info *mti) +{ + enif_release_resource(mti->resource); +} + +static ERL_NIF_TERM make_blob(struct make_term_info *mti, + ErlNifEnv* dst_env) +{ ERL_NIF_TERM term, list; int n = 0; - struct make_term_info mti; - mti.caller_env = caller_env; - mti.dst_env = dst_env; - mti.dst_env_valid = 1; - mti.reuse_push = 0; - mti.reuse_pull = 0; - mti.resource_type = priv->rt_arr[0].t; - mti.other_term = other_term; + + mti->reuse_push = 0; + mti->reuse_pull = 0; + mti->dst_env = dst_env; + mti->dst_env_valid = 1; list = enif_make_list(dst_env, 0); - while (make_term_n(&mti, n++, &term)) { + while (make_term_n(mti, n++, &term)) { list = enif_make_list_cell(dst_env, term, list); } return list; @@ -1277,13 +1289,16 @@ static ERL_NIF_TERM send_new_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ERL_NIF_TERM msg, copy; ErlNifEnv* msg_env; int res; + struct make_term_info mti; if (!enif_get_local_pid(env, argv[0], &to)) { return enif_make_badarg(env); } msg_env = enif_alloc_env(); - msg = make_blob(env,msg_env, argv[1]); - copy = make_blob(env,env, argv[1]); + init_make_blob(&mti, env, argv[1]); + msg = make_blob(&mti,msg_env); + copy = make_blob(&mti,env); + fini_make_blob(&mti); res = enif_send(env, &to, msg_env, msg); enif_free_env(msg_env); return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy); @@ -1303,6 +1318,8 @@ static ERL_NIF_TERM alloc_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar mti->reuse_push = 0; mti->reuse_pull = 0; mti->resource_type = priv->rt_arr[0].t; + mti->resource = enif_alloc_resource(mti->resource_type, 10); + fill(mti->resource, 10, 17); mti->other_term = enif_make_list(mti->dst_env, 0); mti->blob = enif_make_list(mti->dst_env, 0); mti->mtx = enif_mutex_create("nif_SUITE:mtx"); @@ -1320,6 +1337,7 @@ static void msgenv_dtor(ErlNifEnv* env, void* obj) if (mti->dst_env != NULL) { enif_free_env(mti->dst_env); } + enif_release_resource(mti->resource); enif_mutex_destroy(mti->mtx); enif_cond_destroy(mti->cond); } diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index af18545bff..7356f31b75 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -50,7 +50,8 @@ port_wrap/1, bad_nc/1, unique_pid/1, - iter_max_procs/1]). + iter_max_procs/1, + magic_ref/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -62,7 +63,7 @@ all() -> node_table_gc, dist_link_refc, dist_monitor_refc, node_controller_refc, ets_refc, match_spec_refc, timer_refc, otp_4715, pid_wrap, port_wrap, bad_nc, - unique_pid, iter_max_procs]. + unique_pid, iter_max_procs, magic_ref]. init_per_suite(Config) -> Config. @@ -889,10 +890,46 @@ chk_max_proc_line_until(NoMoreTests, Res) -> chk_max_proc_line_until(NoMoreTests, Res) end. +magic_ref(Config) when is_list(Config) -> + {MRef0, Addr0} = erts_debug:set_internal_state(make, magic_ref), + true = is_reference(MRef0), + {Addr0, 1, true} = erts_debug:get_internal_state({magic_ref,MRef0}), + MRef1 = binary_to_term(term_to_binary(MRef0)), + {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef1}), + MRef0 = MRef1, + Me = self(), + {Pid, Mon} = spawn_opt(fun () -> + receive + {Me, MRef} -> + Me ! {self(), erts_debug:get_internal_state({magic_ref,MRef})} + end + end, + [link, monitor]), + Pid ! {self(), MRef0}, + receive + {Pid, Info} -> + {Addr0, 3, true} = Info + end, + receive + {'DOWN', Mon, process, Pid, _} -> + ok + end, + {Addr0, 2, true} = erts_debug:get_internal_state({magic_ref,MRef0}), + id(MRef0), + id(MRef1), + MRefExt = term_to_binary(erts_debug:set_internal_state(make, magic_ref)), + garbage_collect(), + {MRef2, _Addr2} = binary_to_term(MRefExt), + true = is_reference(MRef2), + true = erts_debug:get_internal_state({magic_ref,MRef2}), + ok. %% %% -- Internal utils --------------------------------------------------------- %% +id(X) -> + X. + -define(ND_REFS, erts_debug:get_internal_state(node_and_dist_references)). node_container_refc_check(Node) when is_atom(Node) -> diff --git a/erts/emulator/test/os_signal_SUITE.erl b/erts/emulator/test/os_signal_SUITE.erl new file mode 100644 index 0000000000..9aa49a453e --- /dev/null +++ b/erts/emulator/test/os_signal_SUITE.erl @@ -0,0 +1,354 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% 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% +%% + +%% +%% File: os_signal_SUITE.erl +%% Author: Björn-Egil Dahlberg +%% Created: 2017-01-13 +%% + +-module(os_signal_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-export([all/0, suite/0]). +-export([init_per_testcase/2, end_per_testcase/2]). +-export([init_per_suite/1, end_per_suite/1]). + +-export([set_alarm/1, fork/0, get_exit_code/1]). + +% Test cases +-export([set_unset/1, + t_sighup/1, + t_sigusr1/1, + t_sigusr2/1, + t_sigterm/1, + t_sigalrm/1, + t_sigchld/1, + t_sigchld_fork/1]). + +-define(signal_server, erl_signal_server). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + case os:type() of + {win32, _} -> []; + _ -> [set_unset, + t_sighup, + t_sigusr1, + t_sigusr2, + t_sigterm, + t_sigalrm, + t_sigchld, + t_sigchld_fork] + end. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Pid = erlang:whereis(?signal_server), + true = erlang:unregister(?signal_server), + [{signal_server, Pid}|Config]. + +end_per_testcase(_Func, Config) -> + case proplists:get_value(signal_server, Config) of + undefined -> ok; + Pid -> + true = erlang:register(?signal_server, Pid), + ok + end. + +init_per_suite(Config) -> + load_nif(Config), + Config. + +end_per_suite(_Config) -> + ok. + +%% tests + +set_unset(_Config) -> + Signals = [sighup, %sigint, + sigquit, %sigill, + sigabrt, + sigalrm, sigterm, + sigusr1, sigusr2, + sigchld, + sigstop, sigtstp], + F1 = fun(Sig) -> ok = os:set_signal(Sig,handle) end, + F2 = fun(Sig) -> ok = os:set_signal(Sig,default) end, + F3 = fun(Sig) -> ok = os:set_signal(Sig,ignore) end, + %% set handle + ok = lists:foreach(F1, Signals), + %% set ignore + ok = lists:foreach(F2, Signals), + %% set default + ok = lists:foreach(F3, Signals), + ok. + +t_sighup(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sighup, handle), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sighup}, + {notify,sighup}, + {notify,sighup}] = Msgs1, + %% no proc + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sighup, ignore), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + ok = kill("HUP", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to handle (it's the default) + os:set_signal(sighup, handle), + ok. + +t_sigusr1(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sigusr1, handle), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigusr1}, + {notify,sigusr1}, + {notify,sigusr1}] = Msgs1, + %% no proc + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sigusr1, ignore), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + ok = kill("USR1", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to ignore (it's the default) + os:set_signal(sigusr1, handle), + ok. + +t_sigusr2(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sigusr2, handle), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigusr2}, + {notify,sigusr2}, + {notify,sigusr2}] = Msgs1, + %% no proc + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sigusr2, ignore), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + ok = kill("USR2", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to ignore (it's the default) + os:set_signal(sigusr2, ignore), + ok. + +t_sigterm(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sigterm, handle), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigterm}, + {notify,sigterm}, + {notify,sigterm}] = Msgs1, + %% no proc + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sigterm, ignore), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + ok = kill("TERM", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to handle (it's the default) + os:set_signal(sigterm, handle), + ok. + +t_sigchld(_Config) -> + Pid1 = setup_service(), + OsPid = os:getpid(), + os:set_signal(sigchld, handle), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigchld}, + {notify,sigchld}, + {notify,sigchld}] = Msgs1, + %% no proc + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + %% ignore + Pid2 = setup_service(), + os:set_signal(sigchld, ignore), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + ok = kill("CHLD", OsPid), + Msgs2 = fetch_msgs(Pid2), + io:format("Msgs2: ~p~n", [Msgs2]), + [] = Msgs2, + %% reset to handle (it's the default) + os:set_signal(sigchld, ignore), + ok. + + +t_sigalrm(_Config) -> + Pid1 = setup_service(), + ok = os:set_signal(sigalrm, handle), + ok = os_signal_SUITE:set_alarm(1), + receive after 3000 -> ok end, + Msgs1 = fetch_msgs(Pid1), + [{notify,sigalrm}] = Msgs1, + io:format("Msgs1: ~p~n", [Msgs1]), + os:set_signal(sigalrm, ignore), + Pid2 = setup_service(), + ok = os_signal_SUITE:set_alarm(1), + receive after 3000 -> ok end, + Msgs2 = fetch_msgs(Pid2), + [] = Msgs2, + io:format("Msgs2: ~p~n", [Msgs2]), + Pid3 = setup_service(), + os:set_signal(sigalrm, handle), + ok = os_signal_SUITE:set_alarm(1), + receive after 3000 -> ok end, + Msgs3 = fetch_msgs(Pid3), + [{notify,sigalrm}] = Msgs3, + io:format("Msgs3: ~p~n", [Msgs3]), + os:set_signal(sigalrm, ignore), + ok. + +t_sigchld_fork(_Config) -> + Pid1 = setup_service(), + ok = os:set_signal(sigchld, handle), + {ok,OsPid} = os_signal_SUITE:fork(), + receive after 3000 -> ok end, + Msgs1 = fetch_msgs(Pid1), + io:format("Msgs1: ~p~n", [Msgs1]), + [{notify,sigchld}] = Msgs1, + {ok,Status} = os_signal_SUITE:get_exit_code(OsPid), + io:format("exit status from ~w : ~w~n", [OsPid,Status]), + 42 = Status, + %% reset to ignore (it's the default) + os:set_signal(sigchld, ignore), + ok. + + +%% nif stubs + +set_alarm(_Secs) -> no. +fork() -> no. +get_exit_code(_OsPid) -> no. + +%% aux + +setup_service() -> + Pid = spawn_link(fun msgs/0), + true = erlang:register(?signal_server, Pid), + Pid. + +msgs() -> + msgs([]). +msgs(Ms) -> + receive + {Pid, fetch_msgs} -> Pid ! {self(), lists:reverse(Ms)}; + Msg -> + msgs([Msg|Ms]) + end. + +fetch_msgs(Pid) -> + Pid ! {self(), fetch_msgs}, + receive {Pid, Msgs} -> Msgs end. + +kill(Signal, Pid) -> + {0,_} = run("kill", ["-s", Signal, Pid]), + receive after 200 -> ok end, + ok. + +load_nif(Config) -> + Path = proplists:get_value(data_dir, Config), + ok = erlang:load_nif(filename:join(Path,"os_signal_nif"), 0). + +run(Program0, Args) -> run(".", Program0, Args). +run(Cwd, Program0, Args) when is_list(Cwd) -> + Program = case os:find_executable(Program0) of + Path when is_list(Path) -> + Path; + false -> + exit(no) + end, + Options = [{args,Args},binary,exit_status,stderr_to_stdout, + {line,4096}, {cd, Cwd}], + try open_port({spawn_executable,Program}, Options) of + Port -> + run_loop(Port, []) + catch + error:_ -> + exit(no) + end. + +run_loop(Port, Output) -> + receive + {Port,{exit_status,Status}} -> + {Status,lists:reverse(Output)}; + {Port,{data,{eol,Bin}}} -> + run_loop(Port, [Bin|Output]); + _Msg -> + run_loop(Port, Output) + end. diff --git a/erts/emulator/test/os_signal_SUITE_data/Makefile.src b/erts/emulator/test/os_signal_SUITE_data/Makefile.src new file mode 100644 index 0000000000..a7f5cdbba5 --- /dev/null +++ b/erts/emulator/test/os_signal_SUITE_data/Makefile.src @@ -0,0 +1,6 @@ + +NIF_LIBS = os_signal_nif@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ diff --git a/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c b/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c new file mode 100644 index 0000000000..78e1348383 --- /dev/null +++ b/erts/emulator/test/os_signal_SUITE_data/os_signal_nif.c @@ -0,0 +1,66 @@ +#include <sys/wait.h> +#include <stdlib.h> +#include <unistd.h> +#include <stdio.h> + +#include <erl_nif.h> + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static ERL_NIF_TERM set_alarm(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int t; + if (!enif_get_int(env, argv[0], &t)) { + return enif_make_badarg(env); + } + + alarm(t); + + return enif_make_atom(env, "ok"); +} + +static ERL_NIF_TERM fork_0(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + pid_t pid; + + pid = fork(); + + if (pid == 0) { + /* child */ + exit(42); + } + + return enif_make_tuple(env, 2, + enif_make_atom(env, "ok"), + enif_make_int(env, (int)pid)); +} + +static ERL_NIF_TERM get_exit_code(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int x; + pid_t pid; + if (!enif_get_int(env, argv[0], &x)) { + return enif_make_badarg(env); + } + + pid = (pid_t) x; + + waitpid(pid, &x, 0); + + return enif_make_tuple(env, 2, + enif_make_atom(env, "ok"), + enif_make_int(env, WEXITSTATUS(x))); +} + + +static ErlNifFunc nif_funcs[] = +{ + {"set_alarm", 1, set_alarm}, + {"fork", 0, fork_0}, + {"get_exit_code", 1, get_exit_code} +}; + +ERL_NIF_INIT(os_signal_SUITE,nif_funcs,load,NULL,NULL,NULL) diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c index 71c278881c..4134a3ff36 100644 --- a/erts/etc/common/escript.c +++ b/erts/etc/common/escript.c @@ -428,14 +428,6 @@ main(int argc, char** argv) argv[argc] = NULL; #endif - emulator = env = get_env("ESCRIPT_EMULATOR"); - if (emulator == NULL) { - emulator = get_default_emulator(argv[0]); - } - - if (strlen(emulator) >= PMAX) - error("Value of environment variable ESCRIPT_EMULATOR is too large"); - /* * Allocate the argv vector to be used for arguments to Erlang. * Arrange for starting to pushing information in the middle of @@ -446,21 +438,10 @@ main(int argc, char** argv) eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); eargv = eargv_base; eargc = 0; - push_words(emulator); eargc_base = eargc; eargv = eargv + eargv_size/2; eargc = 0; - free_env_val(env); - - /* - * Push initial arguments. - */ - - PUSH("+B"); - PUSH2("-boot", "start_clean"); - PUSH("-noshell"); - /* Determine basename of the executable */ for (basename = argv[0]+strlen(argv[0]); basename > argv[0] && !(IS_DIRSEP(basename[-1])); @@ -510,6 +491,27 @@ main(int argc, char** argv) efree(absname); } + /* Determine path to emulator */ + emulator = env = get_env("ESCRIPT_EMULATOR"); + + if (emulator == NULL) { + emulator = get_default_emulator(scriptname); + } + + if (strlen(emulator) >= PMAX) + error("Value of environment variable ESCRIPT_EMULATOR is too large"); + + /* + * Push initial arguments. + */ + + push_words(emulator); + free_env_val(env); + + PUSH("+B"); + PUSH2("-boot", "start_clean"); + PUSH("-noshell"); + /* * Read options from the %%! row in the script and add them as args */ diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index c7e2ac169d..2bf04a6518 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -775,7 +775,7 @@ define etp-pid-1 set $etp_pid_1 = (Eterm)($arg0) if ($etp_pid_1 & 0xF) == 0x3 if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 35) & 0x0fffffff) else set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff) @@ -835,7 +835,7 @@ define etp-port-1 set $etp_port_1 = (Eterm)($arg0) if ($etp_port_1 & 0xF) == 0x7 if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 36) & 0x0fffffff) else set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 4) & 0x0fffffff) @@ -952,30 +952,31 @@ define etp-ref-1 if ((Eterm)($arg0) & 0x3) != 0x2 printf "#NotBoxed<%#x>", (Eterm)($arg0) else - set $etp_ref_1_p = (RefThing *)((Eterm)($arg0) & ~0x3) + set $etp_ref_1_p = (ErtsORefThing *)((Eterm)($arg0) & ~0x3) if ($etp_ref_1_p->header & 0x3b) != 0x10 printf "#NotRef<%#x>", $etp_ref_1_p->header else - set $etp_ref_1_nump = (Uint32 *) 0 - set $etp_ref_1_error = 0 - if ($etp_ref_1_p->header >> 6) == 0 - set $etp_ref_1_error = 1 + if $etp_ref_1_p->header != etp_ref_header && $etp_ref_1_p->header != etp_magic_ref_header + printf "#InternalRefError<%#x>", ($arg0) else - if $etp_arch64 - set $etp_ref_1_i = (int) $etp_ref_1_p->data.ui32[0] - if (($etp_ref_1_i + 1) > (2 * ($etp_ref_1_p->header >> 6))) - set $etp_ref_1_error = 1 - else - set $etp_ref_1_nump = &$etp_ref_1_p->data.ui32[1] + set $etp_magic_ref = 0 + set $etp_ref_1_i = 3 + set $etp_ref_1_error = 0 + set $etp_ref_1_nump = (Uint32 *) 0 + if etp_ref_header == etp_magic_ref_header + if $etp_ref_1_p->marker != 0xffffffff + set $etp_magic_ref = 1 end + else + if $etp_ref_1_p->header == etp_magic_ref_header + set $etp_magic_ref = 1 + end + end + if $etp_magic_ref == 0 + set $etp_ref_1_nump = $etp_ref_1_p->num else - set $etp_ref_1_i = (int) ($etp_ref_1_p->header >> 6) - set $etp_ref_1_nump = &$etp_ref_1_p->data.ui32[0] + set $etp_ref_1_nump = ((ErtsMRefThing *) $etp_ref_1_p)->mb->refn end - end - if $etp_ref_1_error - printf "#InternalRefError<%#x>", ($arg0) - else printf "#Ref<0" set $etp_ref_1_i-- while $etp_ref_1_i >= 0 @@ -1593,7 +1594,7 @@ define etp-term-dump-pid set $etp_pid_1 = (Eterm)($arg0) if ($etp_pid_1 & 0xF) == 0x3 if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff) else set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff) @@ -1638,7 +1639,7 @@ define etp-pid2pix-1 # Args: Eterm # if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff) else set $etp_pix = (int) ((((Uint64) $arg0) >> 32) & 0x0fffffff) @@ -2271,7 +2272,7 @@ define etp-port-id2pix-1 # Args: Eterm # if (etp_arch_bits == 64) - if (etp_big_endian) + if (etp_endianness > 0) set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff) elser set $etp_pix = (int) ((((Uint64) $arg0) >> 32) & 0x0fffffff) @@ -2906,10 +2907,14 @@ define etp-system-info printf "Compile date: %s\n", etp_compile_date printf "Arch: %s\n", etp_arch printf "Endianness: " - if (etp_big_endian) + if (etp_endianness > 0) printf "Big\n" else - printf "Little\n" + if (etp_endianness < 0) + printf "Little\n" + else + printf "Unknown\n" + end end printf "Word size: %d-bit\n", etp_arch_bits printf "HiPE support: " diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 0799546c60..7cdf2931a1 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex ffddf2d54d..8123d63a9e 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index be7ceb928b..ca181343e3 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -83,6 +83,10 @@ | 'micro_seconds' | 'nano_seconds'. +-opaque prepared_code() :: reference(). + +-export_type([prepared_code/0]). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Native code BIF stubs and their types %% (BIF's actually implemented in this module goes last in the file) @@ -791,9 +795,9 @@ external_size(_Term, _Options) -> erlang:nif_error(undefined). %% finish_loading/2 --spec erlang:finish_loading(PreparedCodeBinaries) -> ok | Error when - PreparedCodeBinaries :: [PreparedCodeBinary], - PreparedCodeBinary :: binary(), +-spec erlang:finish_loading(PreparedCodeList) -> ok | Error when + PreparedCodeList :: [PreparedCode], + PreparedCode :: prepared_code(), ModuleList :: [module()], Error :: {not_purged,ModuleList} | {on_load,ModuleList}. finish_loading(_List) -> @@ -1030,7 +1034,7 @@ halt(_Status, _Options) -> %% has_prepared_code_on_load/1 -spec erlang:has_prepared_code_on_load(PreparedCode) -> boolean() when - PreparedCode :: binary(). + PreparedCode :: prepared_code(). has_prepared_code_on_load(_PreparedCode) -> erlang:nif_error(undefined). @@ -1447,7 +1451,7 @@ timestamp() -> -spec erlang:prepare_loading(Module, Code) -> PreparedCode | {error, Reason} when Module :: module(), Code :: binary(), - PreparedCode :: binary(), + PreparedCode :: prepared_code(), Reason :: bad_file. prepare_loading(_Module, _Code) -> erlang:nif_error(undefined). @@ -2007,8 +2011,8 @@ load_module(Mod, Code) -> case erlang:prepare_loading(Mod, Code) of {error,_}=Error -> Error; - Bin when erlang:is_binary(Bin) -> - case erlang:finish_loading([Bin]) of + Prep when erlang:is_reference(Prep) -> + case erlang:finish_loading([Prep]) of ok -> {module,Mod}; {Error,[Mod]} -> diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 551ca4ea40..86dc9a2957 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -932,15 +932,15 @@ load_rest([], _) -> prepare_loading_fun() -> fun(Mod, FullName, Beam) -> case erlang:prepare_loading(Mod, Beam) of - Prepared when is_binary(Prepared) -> + {error,_}=Error -> + Error; + Prepared -> case erlang:has_prepared_code_on_load(Prepared) of true -> {ok,{on_load,Beam,FullName}}; false -> {ok,{prepared,Prepared,FullName}} - end; - {error,_}=Error -> - Error + end end end. diff --git a/erts/test/system_smoke.spec b/erts/test/system_smoke.spec index 933d1ba22d..99092c1dab 100644 --- a/erts/test/system_smoke.spec +++ b/erts/test/system_smoke.spec @@ -1,3 +1,8 @@ {suites,"../system_test",[ethread_SUITE]}. -{cases,"../system_test",otp_SUITE,[undefined_functions]}. +{cases,"../system_test",otp_SUITE, + [undefined_functions, + deprecated_not_in_obsolete, + obsolete_but_not_deprecated, + call_to_size_1, + call_to_now_0]}. {skip_cases,"../system_test",ethread_SUITE,[max_threads],"Skip"}. diff --git a/erts/vsn.mk b/erts/vsn.mk index 028b114068..a0a991f5a9 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 8.2.1 +VSN = 8.2.2 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index a2f5dc674c..2fc2850591 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -21,7 +21,7 @@ -module(beam_asm). --export([module/4]). +-export([module/5]). -export([encode/2]). -export_type([fail/0,label/0,reg/0,src/0,module_code/0,function_name/0]). @@ -57,20 +57,20 @@ -type module_code() :: {module(),[_],[_],[asm_function()],pos_integer()}. --spec module(module_code(), exports(), [_], [compile:option()]) -> +-spec module(module_code(), exports(), [_], [compile:option()], [compile:option()]) -> {'ok',binary()}. -module(Code, Abst, SourceFile, Opts) -> - {ok,assemble(Code, Abst, SourceFile, Opts)}. +module(Code, Abst, SourceFile, Opts, CompilerOpts) -> + {ok,assemble(Code, Abst, SourceFile, Opts, CompilerOpts)}. -assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) -> +assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts, CompilerOpts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), Exp = cerl_sets:from_list(Exp0), {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), - build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts). + build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts, CompilerOpts). on_load(Fs0, Attr0) -> case proplists:get_value(on_load, Attr0) of @@ -113,7 +113,7 @@ assemble_function([H|T], Acc, Dict0) -> assemble_function([], Code, Dict) -> {Code, Dict}. -build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> +build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts, CompilerOpts) -> %% Create the code chunk. CodeChunk = chunk(<<"Code">>, @@ -125,9 +125,9 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> Code), %% Create the atom table chunk. - - {NumAtoms, AtomTab} = beam_dict:atom_table(Dict), - AtomChunk = chunk(<<"Atom">>, <<NumAtoms:32>>, AtomTab), + AtomEncoding = atom_encoding(CompilerOpts), + {NumAtoms, AtomTab} = beam_dict:atom_table(Dict, AtomEncoding), + AtomChunk = chunk(atom_chunk_name(AtomEncoding), <<NumAtoms:32>>, AtomTab), %% Create the import table chunk. @@ -203,6 +203,15 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> end, build_form(<<"BEAM">>, Chunks). +atom_encoding(Opts) -> + case proplists:get_bool(no_utf8_atoms, Opts) of + false -> utf8; + true -> latin1 + end. + +atom_chunk_name(utf8) -> <<"AtU8">>; +atom_chunk_name(latin1) -> <<"Atom">>. + %% finalize_fun_table(Essentials, MD5) -> FinalizedEssentials %% Update the 'old_uniq' field in the entry for each fun in the %% 'FunT' chunk. We'll use part of the MD5 for the module as a diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 719d799fd7..990e86062a 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -24,7 +24,7 @@ -export([new/0,opcode/2,highest_opcode/1, atom/2,local/4,export/4,import/4, string/2,lambda/3,literal/2,line/2,fname/2, - atom_table/1,local_table/1,export_table/1,import_table/1, + atom_table/2,local_table/1,export_table/1,import_table/1, string_table/1,lambda_table/1,literal_table/1, line_table/1]). @@ -197,15 +197,15 @@ fname(Name, #asm{fnames=Fnames}=Dict) -> end. %% Returns the atom table. -%% atom_table(Dict) -> {LastIndex,[Length,AtomString...]} --spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}. +%% atom_table(Dict, Encoding) -> {LastIndex,[Length,AtomString...]} +-spec atom_table(bdict(), latin1 | utf8) -> {non_neg_integer(), [[non_neg_integer(),...]]}. -atom_table(#asm{atoms=Atoms}) -> +atom_table(#asm{atoms=Atoms}, Encoding) -> NumAtoms = maps:size(Atoms), Sorted = lists:keysort(2, maps:to_list(Atoms)), {NumAtoms,[begin - L = atom_to_list(A), - [length(L)|L] + L = atom_to_binary(A, Encoding), + [byte_size(L),L] end || {A,_} <- Sorted]}. %% Returns the table of local functions. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 069add7890..dcd962df66 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -214,11 +214,21 @@ expand_opt(report, Os) -> expand_opt(return, Os) -> [return_errors,return_warnings|Os]; expand_opt(r12, Os) -> - [no_recv_opt,no_line_info|Os]; + [no_recv_opt,no_line_info,no_utf8_atoms|Os]; expand_opt(r13, Os) -> - [no_recv_opt,no_line_info|Os]; + [no_recv_opt,no_line_info,no_utf8_atoms|Os]; expand_opt(r14, Os) -> - [no_line_info|Os]; + [no_line_info,no_utf8_atoms|Os]; +expand_opt(r15, Os) -> + [no_utf8_atoms|Os]; +expand_opt(r16, Os) -> + [no_utf8_atoms|Os]; +expand_opt(r17, Os) -> + [no_utf8_atoms|Os]; +expand_opt(r18, Os) -> + [no_utf8_atoms|Os]; +expand_opt(r19, Os) -> + [no_utf8_atoms|Os]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; expand_opt(no_float_opt, Os) -> @@ -1376,13 +1386,14 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> save_core_code(Code, St) -> {ok,Code,St#compile{core_code=cerl:from_records(Code)}}. -beam_asm(Code0, #compile{ifile=File,abstract_code=Abst,mod_options=Opts0}=St) -> +beam_asm(Code0, #compile{ifile=File,abstract_code=Abst, + options=CompilerOpts,mod_options=Opts0}=St) -> Source = paranoid_absname(File), Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'}; (Other) -> Other end, Opts0), Opts2 = [O || O <- Opts1, effects_code_generation(O)], - case beam_asm:module(Code0, Abst, Source, Opts2) of + case beam_asm:module(Code0, Abst, Source, Opts2, CompilerOpts) of {ok,Code} -> {ok,Code,St#compile{abstract_code=[]}} end. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 8c09414a52..8d7facd727 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -30,7 +30,7 @@ file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, kernel_listing/1, encrypted_abstr/1, - strict_record/1, + strict_record/1, utf8_atoms/1, cover/1, env/1, core/1, core_roundtrip/1, asm/1, optimized_guards/1, sys_pre_attributes/1, dialyzer/1, @@ -48,7 +48,7 @@ all() -> [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, kernel_listing, encrypted_abstr, - strict_record, + strict_record, utf8_atoms, cover, env, core, core_roundtrip, asm, optimized_guards, sys_pre_attributes, dialyzer, warnings, pre_load_check, env_compiler_options]. @@ -450,8 +450,10 @@ do_kernel_listing({M,A}) -> try {ok,M,Kern} = compile:forms(A, [to_kernel]), IoList = v3_kernel_pp:format(Kern), - _ = iolist_size(IoList), - ok + case unicode:characters_to_binary(IoList) of + Bin when is_binary(Bin) -> + ok + end catch throw:{error,Error} -> io:format("*** compilation failure '~p' for module ~s\n", @@ -680,6 +682,23 @@ test_sloppy() -> {1,2} = record_access:test(Turtle), Turtle. +utf8_atoms(Config) when is_list(Config) -> + Anno = erl_anno:new(1), + Atom = binary_to_atom(<<"こんにちは"/utf8>>, utf8), + Forms = [{attribute,Anno,compile,[export_all]}, + {function,Anno,atom,0,[{clause,Anno,[],[],[{atom,Anno,Atom}]}]}], + + Utf8AtomForms = [{attribute,Anno,module,utf8_atom}|Forms], + {ok,utf8_atom,Utf8AtomBin} = + compile:forms(Utf8AtomForms, [binary]), + {ok,{utf8_atom,[{atoms,_}]}} = + beam_lib:chunks(Utf8AtomBin, [atoms]), + code:load_binary(utf8_atom, "compile_SUITE", Utf8AtomBin), + Atom = utf8_atom:atom(), + + NoUtf8AtomForms = [{attribute,Anno,module,no_utf8_atom}|Forms], + error = compile:forms(NoUtf8AtomForms, [binary, r19]). + env(Config) when is_list(Config) -> {Simple,Target} = get_files(Config, simple, env), {ok,Cwd} = file:get_cwd(), @@ -751,7 +770,7 @@ do_core_1(M, A, Outdir) -> {ok,M,Core0} = compile:forms(A, [to_core]), CoreFile = filename:join(Outdir, atom_to_list(M)++".core"), CorePP = core_pp:format(Core0), - ok = file:write_file(CoreFile, CorePP), + ok = file:write_file(CoreFile, unicode:characters_to_binary(CorePP)), %% Parse the .core file and return the result as Core Erlang Terms. Core = case compile:file(CoreFile, [report_errors,from_core,no_copt,to_core,binary]) of @@ -823,7 +842,7 @@ do_core_roundtrip_1(Mod, Abstr, Outdir) -> do_core_roundtrip_2(M, Core0, Outdir) -> CoreFile = filename:join(Outdir, atom_to_list(M)++".core"), CorePP = core_pp:format_all(Core0), - ok = file:write_file(CoreFile, CorePP), + ok = file:write_file(CoreFile, unicode:characters_to_binary(CorePP)), %% Parse the .core file and return the result as Core Erlang Terms. Core2 = case compile:file(CoreFile, [report_errors,from_core, diff --git a/lib/compiler/test/compile_SUITE_data/simple.erl b/lib/compiler/test/compile_SUITE_data/simple.erl index d8324dafaf..9385d101e0 100644 --- a/lib/compiler/test/compile_SUITE_data/simple.erl +++ b/lib/compiler/test/compile_SUITE_data/simple.erl @@ -19,7 +19,7 @@ %% -module(simple). --export([test/0]). +-export([test/0,unicode/0]). -ifdef(need_foo). -export([foo/0]). @@ -28,6 +28,9 @@ test() -> passed. +unicode() -> + {"это",'спутник'}. + %% Conditional inclusion. %% Compile with [{d, need_foo}, {d, foo_value, 42}]. diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index adb96fb87d..76dfaee482 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -227,7 +227,7 @@ effect(Config) when is_list(Config) -> lc_SUITE -> _ = [{'EXIT',{badarg,_}} = (catch binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(16#10000, 16#FFFFF)]; + C <- lists:seq(16#FF10000, 16#FFFFFFF)]; _ -> ok end, diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 38b49c7a76..44c3fc4f06 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -61,7 +61,6 @@ #include <openssl/evp.h> #include <openssl/hmac.h> - /* Helper macro to construct a OPENSSL_VERSION_NUMBER. * See openssl/opensslv.h */ @@ -285,6 +284,7 @@ static INLINE int DSA_set0_pqg(DSA *d, BIGNUM *p, BIGNUM *q, BIGNUM *g) static INLINE int DH_set0_key(DH *dh, BIGNUM *pub_key, BIGNUM *priv_key); static INLINE int DH_set0_pqg(DH *dh, BIGNUM *p, BIGNUM *q, BIGNUM *g); +static INLINE int DH_set_length(DH *dh, long length); static INLINE void DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g); static INLINE void DH_get0_key(const DH *dh, @@ -305,6 +305,12 @@ static INLINE int DH_set0_pqg(DH *dh, BIGNUM *p, BIGNUM *q, BIGNUM *g) return 1; } +static INLINE int DH_set_length(DH *dh, long length) +{ + dh->length = length; + return 1; +} + static INLINE void DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g) { @@ -430,7 +436,7 @@ static ErlNifFunc nif_funcs[] = { {"rsa_private_crypt", 4, rsa_private_crypt}, {"dh_generate_parameters_nif", 2, dh_generate_parameters_nif}, {"dh_check", 1, dh_check}, - {"dh_generate_key_nif", 3, dh_generate_key_nif}, + {"dh_generate_key_nif", 4, dh_generate_key_nif}, {"dh_compute_key_nif", 3, dh_compute_key_nif}, {"srp_value_B_nif", 5, srp_value_B_nif}, {"srp_user_secret_nif", 7, srp_user_secret_nif}, @@ -2867,7 +2873,7 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] } static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (PrivKey, DHParams=[P,G], Mpint) */ +{/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */ DH* dh_params; int pub_len, prv_len; unsigned char *pub_ptr, *prv_ptr; @@ -2875,6 +2881,7 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ int mpint; /* 0 or 4 */ BIGNUM *priv_key = NULL; BIGNUM *dh_p = NULL, *dh_g = NULL; + unsigned long len = 0; if (!(get_bn_from_bin(env, argv[0], &priv_key) || argv[0] == atom_undefined) @@ -2883,8 +2890,10 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ || !enif_get_list_cell(env, tail, &head, &tail) || !get_bn_from_bin(env, head, &dh_g) || !enif_is_empty_list(env, tail) - || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)) { - if (priv_key) BN_free(priv_key); + || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4) + || !enif_get_ulong(env, argv[3], &len) ) { + + if (priv_key) BN_free(priv_key); if (dh_p) BN_free(dh_p); if (dh_g) BN_free(dh_g); return enif_make_badarg(env); @@ -2894,6 +2903,15 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ DH_set0_key(dh_params, NULL, priv_key); DH_set0_pqg(dh_params, dh_p, NULL, dh_g); + if (len) { + if (len < BN_num_bits(dh_p)) + DH_set_length(dh_params, len); + else { + DH_free(dh_params); + return enif_make_badarg(env); + } + } + if (DH_generate_key(dh_params)) { const BIGNUM *pub_key, *priv_key; DH_get0_key(dh_params, &pub_key, &priv_key); diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index cbf141b3b0..a4b34657ba 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -103,7 +103,7 @@ <code>dh_private() = key_value() </code> - <code>dh_params() = [key_value()] = [P, G] </code> + <code>dh_params() = [key_value()] = [P, G] | [P, G, PrivateKeyBitLength]</code> <code>ecdh_public() = key_value() </code> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 9767a13dfc..5a915d4233 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -426,9 +426,15 @@ exor(Bin1, Bin2) -> generate_key(Type, Params) -> generate_key(Type, Params, undefined). -generate_key(dh, DHParameters, PrivateKey) -> +generate_key(dh, DHParameters0, PrivateKey) -> + {DHParameters, Len} = + case DHParameters0 of + [P,G,L] -> {[P,G], L}; + [P,G] -> {[P,G], 0} + end, dh_generate_key_nif(ensure_int_as_bin(PrivateKey), - map_ensure_int_as_bin(DHParameters), 0); + map_ensure_int_as_bin(DHParameters), + 0, Len); generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, PrivArg) when is_binary(Verifier), is_binary(Generator), is_binary(Prime), is_atom(Version) -> @@ -807,7 +813,7 @@ dh_check([_Prime,_Gen]) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% PrivKey = mpint() -dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint) -> ?nif_stub. +dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint, _Length) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% MyPrivKey, OthersPublicKey = mpint() diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index ae1e4d8c38..aeeb895a0c 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -114,7 +114,6 @@ loop(#server_state{parent = Parent} = State, %% The Analysis %%-------------------------------------------------------------------- -%% Calls to erlang:garbage_collect() help to reduce the heap size. analysis_start(Parent, Analysis, LegalWarnings) -> CServer = dialyzer_codeserver:new(), Plt = Analysis#analysis.plt, @@ -136,11 +135,9 @@ analysis_start(Parent, Analysis, LegalWarnings) -> %% Remote type postprocessing NewCServer = try - NewRecords = dialyzer_codeserver:get_temp_records(TmpCServer0), + TmpCServer1 = dialyzer_utils:merge_types(TmpCServer0, Plt), NewExpTypes = dialyzer_codeserver:get_temp_exported_types(TmpCServer0), - OldRecords = dialyzer_plt:get_types(Plt), OldExpTypes0 = dialyzer_plt:get_exported_types(Plt), - MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), RemMods = [case Analysis#analysis.start_from of byte_code -> list_to_atom(filename:basename(F, ".beam")); @@ -148,25 +145,20 @@ analysis_start(Parent, Analysis, LegalWarnings) -> end || F <- Files], OldExpTypes1 = dialyzer_utils:sets_filter(RemMods, OldExpTypes0), MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1), - TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0), TmpCServer2 = dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), - erlang:garbage_collect(), + erlang:garbage_collect(), % reduce heap size ?timing(State#analysis_state.timing_server, "remote", contracts_and_records(TmpCServer2)) catch throw:{error, _ErrorMsg} = Error -> exit(Error) end, - NewPlt0 = dialyzer_plt:insert_types(Plt, dialyzer_codeserver:get_records(NewCServer)), - ExpTypes = dialyzer_codeserver:get_exported_types(NewCServer), - NewPlt1 = dialyzer_plt:insert_exported_types(NewPlt0, ExpTypes), - State0 = State#analysis_state{plt = NewPlt1}, - dump_callgraph(Callgraph, State0, Analysis), + dump_callgraph(Callgraph, State, Analysis), %% Remove all old versions of the files being analyzed AllNodes = dialyzer_callgraph:all_nodes(Callgraph), - Plt1_a = dialyzer_plt:delete_list(NewPlt1, AllNodes), + Plt1_a = dialyzer_plt:delete_list(Plt, AllNodes), Plt1 = dialyzer_plt:insert_callbacks(Plt1_a, NewCServer), - State1 = State0#analysis_state{codeserver = NewCServer, plt = Plt1}, + State1 = State#analysis_state{codeserver = NewCServer, plt = Plt1}, Exports = dialyzer_codeserver:get_exports(NewCServer), NonExports = sets:subtract(sets:from_list(AllNodes), Exports), NonExportsList = sets:to_list(NonExports), @@ -176,14 +168,17 @@ analysis_start(Parent, Analysis, LegalWarnings) -> false -> Callgraph end, State2 = analyze_callgraph(NewCallgraph, State1), - #analysis_state{plt = MiniPlt2, doc_plt = DocPlt} = State2, + #analysis_state{plt = MiniPlt2, + doc_plt = DocPlt, + codeserver = Codeserver0} = State2, + {Codeserver, MiniPlt3} = move_data(Codeserver0, MiniPlt2), dialyzer_callgraph:dispose_race_server(NewCallgraph), rcv_and_send_ext_types(Parent), %% Since the PLT is never used, a dummy is sent: DummyPlt = dialyzer_plt:new(), - send_codeserver_plt(Parent, CServer, DummyPlt), - MiniPlt3 = dialyzer_plt:delete_list(MiniPlt2, NonExportsList), - send_analysis_done(Parent, MiniPlt3, DocPlt). + send_codeserver_plt(Parent, Codeserver, DummyPlt), + MiniPlt4 = dialyzer_plt:delete_list(MiniPlt3, NonExportsList), + send_analysis_done(Parent, MiniPlt4, DocPlt). contracts_and_records(CodeServer) -> Fun = contrs_and_recs(CodeServer), @@ -200,15 +195,20 @@ contracts_and_records(CodeServer) -> contrs_and_recs(TmpCServer2) -> fun() -> Parent = receive {Pid, go} -> Pid end, - {TmpCServer3, RecordDict} = - dialyzer_utils:process_record_remote_types(TmpCServer2), + TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), TmpServer4 = - dialyzer_contracts:process_contract_remote_types(TmpCServer3, - RecordDict), + dialyzer_contracts:process_contract_remote_types(TmpCServer3), dialyzer_codeserver:give_away(TmpServer4, Parent), exit(TmpServer4) end. +move_data(CServer, MiniPlt) -> + {CServer1, Records} = dialyzer_codeserver:extract_records(CServer), + MiniPlt1 = dialyzer_plt:insert_types(MiniPlt, Records), + {NewCServer, ExpTypes} = dialyzer_codeserver:extract_exported_types(CServer1), + NewMiniPlt = dialyzer_plt:insert_exported_types(MiniPlt1, ExpTypes), + {NewCServer, NewMiniPlt}. + analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver, doc_plt = DocPlt, plt = Plt, @@ -603,6 +603,7 @@ send_ext_types(Parent, ExtTypes) -> ok. send_codeserver_plt(Parent, CServer, Plt) -> + ok = dialyzer_codeserver:give_away(CServer, Parent), Parent ! {self(), cserver, CServer, Plt}, ok. diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 68f3d7a240..bb02bc8c0d 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -40,7 +40,7 @@ module_postorder_from_funs/2, new/0, get_depends_on/2, - get_required_by/2, + %% get_required_by/2, in_neighbours/2, renew_race_info/4, renew_race_code/2, @@ -250,12 +250,12 @@ get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In, Maps}}) -> get_depends_on(SCC, #callgraph{active_digraph = {'d', DG}}) -> digraph:out_neighbours(DG, SCC). --spec get_required_by(scc() | module(), callgraph()) -> [scc()]. +%% -spec get_required_by(scc() | module(), callgraph()) -> [scc()]. -get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In, Maps}}) -> - lookup_scc(SCC, In, Maps); -get_required_by(SCC, #callgraph{active_digraph = {'d', DG}}) -> - digraph:in_neighbours(DG, SCC). +%% get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In, Maps}}) -> +%% lookup_scc(SCC, In, Maps); +%% get_required_by(SCC, #callgraph{active_digraph = {'d', DG}}) -> +%% digraph:in_neighbours(DG, SCC). lookup_scc(SCC, Table, Maps) -> case ets_lookup_dict({'scc', SCC}, Maps) of @@ -285,9 +285,11 @@ module_postorder(#callgraph{digraph = DG}) -> Nodes = sets:from_list([M || {M,_F,_A} <- digraph_vertices(DG)]), MDG = digraph:new([acyclic]), digraph_confirm_vertices(sets:to_list(Nodes), MDG), - Foreach = fun({M1,M2}) -> digraph:add_edge(MDG, M1, M2) end, + Foreach = fun({M1,M2}) -> _ = digraph:add_edge(MDG, M1, M2) end, lists:foreach(Foreach, sets:to_list(Edges)), - {digraph_utils:topsort(MDG), {'d', MDG}}. + %% The out-neighbors of a vertex are the vertices called directly. + %% The used vertices are to occur *before* the calling vertex: + {lists:reverse(digraph_utils:topsort(MDG)), {'d', MDG}}. edge_fold({{M1,_,_},{M2,_,_}}, Set) -> case M1 =/= M2 of @@ -305,7 +307,7 @@ module_deps(#callgraph{digraph = DG}) -> Nodes = sets:from_list([M || {M,_F,_A} <- digraph_vertices(DG)]), MDG = digraph:new(), digraph_confirm_vertices(sets:to_list(Nodes), MDG), - Foreach = fun({M1,M2}) -> digraph:add_edge(MDG, M1, M2) end, + Foreach = fun({M1,M2}) -> check_add_edge(MDG, M1, M2) end, lists:foreach(Foreach, sets:to_list(Edges)), Deps = [{N, ordsets:from_list(digraph:in_neighbours(MDG, N))} || N <- sets:to_list(Nodes)], @@ -552,9 +554,21 @@ digraph_add_edge(From, To, DG) -> false -> digraph:add_vertex(DG, To); {To, _} -> ok end, - digraph:add_edge(DG, {From, To}, From, To, []), + check_add_edge(DG, {From, To}, From, To, []), ok. +check_add_edge(G, V1, V2) -> + case digraph:add_edge(G, V1, V2) of + {error, Error} -> exit({add_edge, V1, V2, Error}); + _Edge -> ok + end. + +check_add_edge(G, E, V1, V2, L) -> + case digraph:add_edge(G, E, V1, V2, L) of + {error, Error} -> exit({add_edge, E, V1, V2, L, Error}); + _Edge -> ok + end. + digraph_confirm_vertices([MFA|Left], DG) -> digraph:add_vertex(DG, MFA, confirmed), digraph_confirm_vertices(Left, DG); @@ -762,28 +776,53 @@ to_ps(#callgraph{} = CG, File, Args) -> ok. condensation(G) -> - SCCs = digraph_utils:strong_components(G), - %% Assign unique numbers to SCCs: - Ints = lists:seq(1, length(SCCs)), - IntToSCC = lists:zip(Ints, SCCs), - IntScc = sofs:relation(IntToSCC, [{int, scc}]), - %% Subsitute strong components for vertices in edges using the - %% unique numbers: - C2V = sofs:relation([{SC, V} || SC <- SCCs, V <- SC], [{scc, v}]), - I2V = sofs:relative_product(IntScc, C2V), % [{v, int}] - Es = sofs:relation(digraph:edges(G), [{v, v}]), - R1 = sofs:relative_product(I2V, Es), - R2 = sofs:relative_product(I2V, sofs:converse(R1)), - %% Create in- and out-neighbours: - In = sofs:relation_to_family(sofs:strict_relation(R2)), - R3 = sofs:converse(R2), - Out = sofs:relation_to_family(sofs:strict_relation(R3)), - [OutETS, InETS, MapsETS] = - [ets:new(Name,[{read_concurrency, true}]) || - Name <- [callgraph_deps_out, callgraph_deps_in, callgraph_scc_map]], - ets:insert(OutETS, sofs:to_external(Out)), - ets:insert(InETS, sofs:to_external(In)), - %% Create mappings from SCCs to unique integers, and the inverse: - ets:insert(MapsETS, lists:zip([{'scc', SCC} || SCC<- SCCs], Ints)), - ets:insert(MapsETS, IntToSCC), - {{'e', OutETS, InETS, MapsETS}, SCCs}. + erlang:garbage_collect(), % reduce heap size + {Pid, Ref} = erlang:spawn_monitor(do_condensation(G, self())), + receive {'DOWN', Ref, process, Pid, Result} -> + {SCCInts, OutETS, InETS, MapsETS} = Result, + NewSCCs = [ets:lookup_element(MapsETS, SCCInt, 2) || SCCInt <- SCCInts], + {{'e', OutETS, InETS, MapsETS}, NewSCCs} + end. + +-spec do_condensation(digraph:graph(), pid()) -> fun(() -> no_return()). + +do_condensation(G, Parent) -> + fun() -> + [OutETS, InETS, MapsETS] = + [ets:new(Name,[{read_concurrency, true}]) || + Name <- [callgraph_deps_out, callgraph_deps_in, callgraph_scc_map]], + SCCs = digraph_utils:strong_components(G), + %% Assign unique numbers to SCCs: + Ints = lists:seq(1, length(SCCs)), + IntToSCC = lists:zip(Ints, SCCs), + IntScc = sofs:relation(IntToSCC, [{int, scc}]), + %% Create mapping from unique integers to SCCs: + ets:insert(MapsETS, IntToSCC), + %% Subsitute strong components for vertices in edges using the + %% unique numbers: + C2V = sofs:relation([{SC, V} || SC <- SCCs, V <- SC], [{scc, v}]), + I2V = sofs:relative_product(IntScc, C2V), % [{v, int}] + Es = sofs:relation(digraph:edges(G), [{v, v}]), + R1 = sofs:relative_product(I2V, Es), + R2 = sofs:relative_product(I2V, sofs:converse(R1)), + R2Strict = sofs:strict_relation(R2), + %% Create out-neighbours: + Out = sofs:relation_to_family(sofs:converse(R2Strict)), + ets:insert(OutETS, sofs:to_external(Out)), + %% Sort the SCCs topologically: + DG = sofs:family_to_digraph(Out), + lists:foreach(fun(I) -> digraph:add_vertex(DG, I) end, Ints), + SCCInts0 = digraph_utils:topsort(DG), + digraph:delete(DG), + %% The out-neighbors of a vertex are the vertices called directly. + %% The used vertices are to occur *before* the calling vertex: + SCCInts = lists:reverse(SCCInts0), + %% Create in-neighbours: + In = sofs:relation_to_family(R2Strict), + ets:insert(InETS, sofs:to_external(In)), + %% Create mapping from SCCs to unique integers: + ets:insert(MapsETS, lists:zip([{'scc', SCC} || SCC<- SCCs], Ints)), + lists:foreach(fun(E) -> true = ets:give_away(E, Parent, any) + end, [OutETS, InETS, MapsETS]), + exit({SCCInts, OutETS, InETS, MapsETS}) + end. diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 158ee761af..8500c59ebe 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -30,6 +30,8 @@ -record(cl_state, {backend_pid :: pid() | 'undefined', + code_server = none :: 'none' + | dialyzer_codeserver:codeserver(), erlang_mode = false :: boolean(), external_calls = [] :: [mfa()], external_types = [] :: [mfa()], @@ -630,6 +632,9 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); + {BackendPid, cserver, CodeServer, _Plt} -> % Plt is ignored + NewState = State#cl_state{code_server = CodeServer}, + cl_loop(NewState, LogCache); {BackendPid, done, NewMiniPlt, _NewDocPlt} -> return_value(State, NewMiniPlt); {BackendPid, ext_calls, ExtCalls} -> @@ -647,7 +652,6 @@ cl_loop(State, LogCache) -> cl_error(State, Msg); _Other -> %% io:format("Received ~p\n", [_Other]), - %% Note: {BackendPid, cserver, CodeServer, Plt} is ignored. cl_loop(State, LogCache) end. @@ -688,18 +692,34 @@ cl_error(State, Msg) -> maybe_close_output_file(State), throw({dialyzer_error, lists:flatten(Msg)}). -return_value(State = #cl_state{erlang_mode = ErlangMode, +return_value(State = #cl_state{code_server = CodeServer, + erlang_mode = ErlangMode, mod_deps = ModDeps, output_plt = OutputPlt, plt_info = PltInfo, stored_warnings = StoredWarnings}, MiniPlt) -> + %% Just for now: + case CodeServer =:= none of + true -> + ok; + false -> + dialyzer_codeserver:delete(CodeServer) + end, case OutputPlt =:= none of true -> dialyzer_plt:delete(MiniPlt); false -> - Plt = dialyzer_plt:restore_full_plt(MiniPlt), - dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo) + Fun = to_file_fun(OutputPlt, MiniPlt, ModDeps, PltInfo), + {Pid, Ref} = erlang:spawn_monitor(Fun), + dialyzer_plt:give_away(MiniPlt, Pid), + Pid ! go, + receive {'DOWN', Ref, process, Pid, Result} -> + case Result of + ok -> ok; + Thrown -> throw(Thrown) + end + end end, UnknownWarnings = unknown_warnings(State), RetValue = @@ -720,6 +740,16 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, {RetValue, set_warning_id(AllWarnings)} end. +-spec to_file_fun(_, _, _, _) -> fun(() -> no_return()). + +to_file_fun(Filename, MiniPlt, ModDeps, PltInfo) -> + fun() -> + receive go -> ok end, + Plt = dialyzer_plt:restore_full_plt(MiniPlt), + dialyzer_plt:to_file(Filename, Plt, ModDeps, PltInfo), + exit(ok) + end. + unknown_warnings(State = #cl_state{legal_warnings = LegalWarnings}) -> Unknown = case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of true -> diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index f53c713bfe..a1a7370eff 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -26,18 +26,21 @@ give_away/2, finalize_contracts/1, finalize_exported_types/2, - finalize_records/2, + finalize_records/1, get_contracts/1, get_callbacks/1, get_exported_types/1, + extract_exported_types/1, get_exports/1, - get_records/1, + get_records_table/1, + extract_records/1, get_next_core_label/1, get_temp_contracts/2, - contracts_modules/1, + all_temp_modules/1, store_contracts/4, get_temp_exported_types/1, - get_temp_records/1, + get_temp_records_table/1, + lookup_temp_mod_records/2, insert/3, insert_exports/2, insert_temp_exported_types/2, @@ -52,7 +55,6 @@ lookup_meta_info/2, new/0, set_next_core_label/2, - set_temp_records/2, store_temp_records/3, translate_fake_file/3]). @@ -67,10 +69,8 @@ -type set_ets() :: ets:tid(). -type types() :: erl_types:type_table(). --type mod_records() :: erl_types:mod_records(). -type contracts() :: #{mfa() => dialyzer_contracts:file_contract()}. --type mod_contracts() :: dict:dict(module(), contracts()). %% A property-list of data compiled from -compile and -dialyzer attributes. -type meta_info() :: [{{'nowarn_function' | dial_warn_tag()}, @@ -80,8 +80,8 @@ -record(codeserver, {next_core_label = 0 :: label(), code :: dict_ets(), - exported_types :: set_ets(), % set(mfa()) - records :: map_ets(), + exported_types :: 'clean' | set_ets(), % set(mfa()) + records :: 'clean' | map_ets(), contracts :: map_ets(), callbacks :: map_ets(), fun_meta_info :: dict_ets(), % {mfa(), meta_info()} @@ -107,9 +107,6 @@ ets_map_store(Key, Element, Table) -> true = ets:insert(Table, {Key, Element}), Table. -ets_dict_store_dict(Dict, Table) -> - true = ets:insert(Table, dict:to_list(Dict)). - ets_dict_to_dict(Table) -> Fold = fun({Key,Value}, Dict) -> dict:store(Key, Value, Dict) end, ets:foldl(Fold, dict:new(), Table). @@ -164,11 +161,8 @@ new() -> -spec delete(codeserver()) -> 'ok'. -delete(#codeserver{code = Code, exported_types = ExportedTypes, - records = Records, contracts = Contracts, - callbacks = Callbacks}) -> - lists:foreach(fun ets:delete/1, - [Code, ExportedTypes, Records, Contracts, Callbacks]). +delete(CServer) -> + lists:foreach(fun(Table) -> true = ets:delete(Table) end, tables(CServer)). -spec insert(atom(), cerl:c_module(), codeserver()) -> codeserver(). @@ -222,6 +216,11 @@ is_exported(MFA, #codeserver{exports = Exports}) -> get_exported_types(#codeserver{exported_types = ExpTypes}) -> ets_set_to_set(ExpTypes). +-spec extract_exported_types(codeserver()) -> {codeserver(), set_ets()}. + +extract_exported_types(#codeserver{exported_types = ExpTypes} = CS) -> + {CS#codeserver{exported_types = 'clean'}, ExpTypes}. + -spec get_exports(codeserver()) -> sets:set(mfa()). get_exports(#codeserver{exports = Exports}) -> @@ -269,10 +268,15 @@ lookup_mod_records(Mod, #codeserver{records = RecDict}) when is_atom(Mod) -> {ok, Map} -> Map end. --spec get_records(codeserver()) -> mod_records(). +-spec get_records_table(codeserver()) -> map_ets(). + +get_records_table(#codeserver{records = RecDict}) -> + RecDict. -get_records(#codeserver{records = RecDict}) -> - ets_dict_to_dict(RecDict). +-spec extract_records(codeserver()) -> {codeserver(), map_ets()}. + +extract_records(#codeserver{records = RecDict} = CS) -> + {CS#codeserver{records = clean}, RecDict}. -spec store_temp_records(module(), types(), codeserver()) -> codeserver(). @@ -283,26 +287,26 @@ store_temp_records(Mod, Map, #codeserver{temp_records = TempRecDict} = CS) false -> CS#codeserver{temp_records = ets_map_store(Mod, Map, TempRecDict)} end. --spec get_temp_records(codeserver()) -> mod_records(). +-spec get_temp_records_table(codeserver()) -> map_ets(). -get_temp_records(#codeserver{temp_records = TempRecDict}) -> - ets_dict_to_dict(TempRecDict). +get_temp_records_table(#codeserver{temp_records = TempRecDict}) -> + TempRecDict. --spec set_temp_records(mod_records(), codeserver()) -> codeserver(). +-spec lookup_temp_mod_records(module(), codeserver()) -> types(). -set_temp_records(Dict, CS) -> - true = ets:delete(CS#codeserver.temp_records), - TempRecords = ets:new(dialyzer_codeserver_temp_records,[]), - true = ets_dict_store_dict(Dict, TempRecords), - CS#codeserver{temp_records = TempRecords}. +lookup_temp_mod_records(Mod, #codeserver{temp_records = TempRecDict}) -> + case ets_dict_find(Mod, TempRecDict) of + error -> maps:new(); + {ok, Map} -> Map + end. --spec finalize_records(mod_records(), codeserver()) -> codeserver(). +-spec finalize_records(codeserver()) -> codeserver(). -finalize_records(Dict, #codeserver{temp_records = TmpRecords, - records = Records} = CS) -> - true = ets:delete(TmpRecords), - true = ets_dict_store_dict(Dict, Records), - CS#codeserver{temp_records = clean}. +finalize_records(#codeserver{temp_records = TmpRecords, + records = Records} = CS) -> + true = ets:delete(Records), + ets:rename(TmpRecords, dialyzer_codeserver_records), + CS#codeserver{temp_records = clean, records = TmpRecords}. -spec lookup_mod_contracts(atom(), codeserver()) -> contracts(). @@ -331,10 +335,13 @@ lookup_meta_info(MorMFA, #codeserver{fun_meta_info = FunMetaInfo}) -> {ok, PropList} -> PropList end. --spec get_contracts(codeserver()) -> mod_contracts(). +-spec get_contracts(codeserver()) -> + dict:dict(mfa(), dialyzer_contracts:file_contract()). get_contracts(#codeserver{contracts = ContDict}) -> - ets_dict_to_dict(ContDict). + dict:filter(fun({_M, _F, _A}, _) -> true; + (_, _) -> false + end, ets_dict_to_dict(ContDict)). -spec get_callbacks(codeserver()) -> list(). @@ -348,12 +355,14 @@ store_temp_contracts(Mod, SpecMap, CallbackMap, #codeserver{temp_contracts = Cn, temp_callbacks = Cb} = CS) when is_atom(Mod) -> + %% Make sure Mod is stored even if there are not callbacks or + %% contracts. CS1 = CS#codeserver{temp_contracts = ets_map_store(Mod, SpecMap, Cn)}, CS1#codeserver{temp_callbacks = ets_map_store(Mod, CallbackMap, Cb)}. --spec contracts_modules(codeserver()) -> [module()]. +-spec all_temp_modules(codeserver()) -> [module()]. -contracts_modules(#codeserver{temp_contracts = TempContTable}) -> +all_temp_modules(#codeserver{temp_contracts = TempContTable}) -> ets:select(TempContTable, [{{'$1', '$2'}, [], ['$1']}]). -spec store_contracts(module(), contracts(), contracts(), codeserver()) -> @@ -380,17 +389,25 @@ get_temp_contracts(Mod, #codeserver{temp_contracts = TempContDict, -spec give_away(codeserver(), pid()) -> 'ok'. -give_away(#codeserver{temp_records = TempRecords, - temp_contracts = TempContracts, - temp_callbacks = TempCallbacks, - records = Records, - contracts = Contracts, - callbacks = Callbacks}, Pid) -> - _ = [true = ets:give_away(Table, Pid, any) || - Table <- [TempRecords, TempContracts, TempCallbacks, - Records, Contracts, Callbacks], - Table =/= clean], - ok. +give_away(CServer, Pid) -> + lists:foreach(fun(Table) -> true = ets:give_away(Table, Pid, any) + end, tables(CServer)). + +tables(#codeserver{code = Code, + fun_meta_info = FunMetaInfo, + exports = Exports, + temp_exported_types = TempExpTypes, + temp_records = TempRecords, + temp_contracts = TempContracts, + temp_callbacks = TempCallbacks, + exported_types = ExportedTypes, + records = Records, + contracts = Contracts, + callbacks = Callbacks}) -> + [Table || Table <- [Code, FunMetaInfo, Exports, TempExpTypes, + TempRecords, TempContracts, TempCallbacks, + ExportedTypes, Records, Contracts, Callbacks], + Table =/= clean]. -spec finalize_contracts(codeserver()) -> codeserver(). diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 2078e58ce8..5f24b5a668 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -24,7 +24,7 @@ get_contract_return/2, %% get_contract_signature/1, is_overloaded/1, - process_contract_remote_types/2, + process_contract_remote_types/1, store_tmp_contract/5]). -export_type([file_contract/0, plt_contracts/0]). @@ -139,18 +139,18 @@ sequence([], _Delimiter) -> ""; sequence([H], _Delimiter) -> H; sequence([H|T], Delimiter) -> H ++ Delimiter ++ sequence(T, Delimiter). --spec process_contract_remote_types(dialyzer_codeserver:codeserver(), - erl_types:mod_records()) -> +-spec process_contract_remote_types(dialyzer_codeserver:codeserver()) -> dialyzer_codeserver:codeserver(). -process_contract_remote_types(CodeServer, RecordDict) -> - Mods = dialyzer_codeserver:contracts_modules(CodeServer), +process_contract_remote_types(CodeServer) -> + Mods = dialyzer_codeserver:all_temp_modules(CodeServer), + RecordTable = dialyzer_codeserver:get_records_table(CodeServer), ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer), ContractFun = fun({{_M, _F, _A}=MFA, {File, TmpContract, Xtra}}, C0) -> #tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract, {NewCs, C2} = lists:mapfoldl(fun(CFun, C1) -> - CFun(ExpTypes, RecordDict, C1) + CFun(ExpTypes, RecordTable, C1) end, C0, CFuns), Args = general_domain(NewCs), Contract = #contract{contracts = NewCs, args = Args, forms = Forms}, @@ -177,7 +177,7 @@ process_contract_remote_types(CodeServer, RecordDict) -> -type fun_types() :: dict:dict(label(), erl_types:type_table()). --spec check_contracts([{mfa(), file_contract()}], +-spec check_contracts(orddict:orddict(mfa(), file_contract()), dialyzer_callgraph:callgraph(), fun_types(), opaques_fun()) -> plt_contracts(). @@ -206,7 +206,7 @@ check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) -> error -> NewContracts end end, - dict:fold(FoldFun, [], FunTypes). + orddict:from_list(dict:fold(FoldFun, [], FunTypes)). %% Checks all components of a contract -spec check_contract(#contract{}, erl_types:erl_type()) -> 'ok' | {'error', term()}. @@ -451,10 +451,10 @@ contract_from_form(Forms, MFA, RecDict, FileLine) -> contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], MFA, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = - fun(ExpTypes, AllRecords, Cache) -> + fun(ExpTypes, RecordTable, Cache) -> {NewType, NewCache} = try - from_form_with_check(Form, ExpTypes, MFA, AllRecords, Cache) + from_form_with_check(Form, ExpTypes, MFA, RecordTable, Cache) catch throw:{error, Msg} -> {File, Line} = FileLine, @@ -472,12 +472,12 @@ contract_from_form([{type, _L1, bounded_fun, [{type, _L2, 'fun', [_, _]} = Form, Constr]}| Left], MFA, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = - fun(ExpTypes, AllRecords, Cache) -> + fun(ExpTypes, RecordTable, Cache) -> {Constr1, VarTable, Cache1} = - process_constraints(Constr, MFA, RecDict, ExpTypes, AllRecords, + process_constraints(Constr, MFA, RecDict, ExpTypes, RecordTable, Cache), {NewType, NewCache} = - from_form_with_check(Form, ExpTypes, MFA, AllRecords, + from_form_with_check(Form, ExpTypes, MFA, RecordTable, VarTable, Cache1), NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType), {{NewTypeNoVars, Constr1}, NewCache} @@ -488,28 +488,28 @@ contract_from_form([{type, _L1, bounded_fun, contract_from_form([], _MFA, _RecDict, _FileLine, TypeAcc, FormAcc) -> {lists:reverse(TypeAcc), lists:reverse(FormAcc)}. -process_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, Cache) -> +process_constraints(Constrs, MFA, RecDict, ExpTypes, RecordTable, Cache) -> {Init0, NewCache} = initialize_constraints(Constrs, MFA, RecDict, ExpTypes, - AllRecords, Cache), + RecordTable, Cache), Init = remove_cycles(Init0), - constraints_fixpoint(Init, MFA, RecDict, ExpTypes, AllRecords, NewCache). + constraints_fixpoint(Init, MFA, RecDict, ExpTypes, RecordTable, NewCache). -initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, Cache) -> - initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, +initialize_constraints(Constrs, MFA, RecDict, ExpTypes, RecordTable, Cache) -> + initialize_constraints(Constrs, MFA, RecDict, ExpTypes, RecordTable, Cache, []). -initialize_constraints([], _MFA, _RecDict, _ExpTypes, _AllRecords, +initialize_constraints([], _MFA, _RecDict, _ExpTypes, _RecordTable, Cache, Acc) -> {Acc, Cache}; -initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, +initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, RecordTable, Cache, Acc) -> case Constr of {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} -> VarTable = erl_types:var_table__new(), {T1, NewCache} = - final_form(Type1, ExpTypes, MFA, AllRecords, VarTable, Cache), + final_form(Type1, ExpTypes, MFA, RecordTable, VarTable, Cache), Entry = {T1, Type2}, - initialize_constraints(Rest, MFA, RecDict, ExpTypes, AllRecords, + initialize_constraints(Rest, MFA, RecDict, ExpTypes, RecordTable, NewCache, [Entry|Acc]); {type, _, constraint, [{atom,_,Name}, List]} -> N = length(List), @@ -517,18 +517,18 @@ initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])}) end. -constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, AllRecords, Cache) -> +constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, RecordTable, Cache) -> VarTable = erl_types:var_table__new(), {VarTab, NewCache} = - constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, + constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, RecordTable, VarTable, Cache), constraints_fixpoint(VarTab, MFA, Constrs, RecDict, ExpTypes, - AllRecords, NewCache). + RecordTable, NewCache). constraints_fixpoint(OldVarTab, MFA, Constrs, RecDict, ExpTypes, - AllRecords, Cache) -> + RecordTable, Cache) -> {NewVarTab, NewCache} = - constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, + constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, RecordTable, OldVarTab, Cache), case NewVarTab of OldVarTab -> @@ -540,38 +540,38 @@ constraints_fixpoint(OldVarTab, MFA, Constrs, RecDict, ExpTypes, {FinalConstrs, NewVarTab, NewCache}; _Other -> constraints_fixpoint(NewVarTab, MFA, Constrs, RecDict, ExpTypes, - AllRecords, NewCache) + RecordTable, NewCache) end. -final_form(Form, ExpTypes, MFA, AllRecords, VarTable, Cache) -> - from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarTable, Cache). +final_form(Form, ExpTypes, MFA, RecordTable, VarTable, Cache) -> + from_form_with_check(Form, ExpTypes, MFA, RecordTable, VarTable, Cache). -from_form_with_check(Form, ExpTypes, MFA, AllRecords, Cache) -> +from_form_with_check(Form, ExpTypes, MFA, RecordTable, Cache) -> VarTable = erl_types:var_table__new(), - from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarTable, Cache). + from_form_with_check(Form, ExpTypes, MFA, RecordTable, VarTable, Cache). -from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarTable, Cache) -> +from_form_with_check(Form, ExpTypes, MFA, RecordTable, VarTable, Cache) -> Site = {spec, MFA}, - C1 = erl_types:t_check_record_fields(Form, ExpTypes, Site, AllRecords, + C1 = erl_types:t_check_record_fields(Form, ExpTypes, Site, RecordTable, VarTable, Cache), - erl_types:t_from_form(Form, ExpTypes, Site, AllRecords, VarTable, C1). + erl_types:t_from_form(Form, ExpTypes, Site, RecordTable, VarTable, C1). -constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, +constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, RecordTable, VarTab, Cache) -> {Subtypes, NewCache} = - constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, AllRecords, + constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, RecordTable, VarTab, Cache, []), {insert_constraints(Subtypes), NewCache}. -constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _AllRecords, +constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _RecordTable, _VarTab, Cache, Acc) -> {Acc, Cache}; -constraints_to_subs([{T1, Form2}|Rest], MFA, RecDict, ExpTypes, AllRecords, +constraints_to_subs([{T1, Form2}|Rest], MFA, RecDict, ExpTypes, RecordTable, VarTab, Cache, Acc) -> {T2, NewCache} = - final_form(Form2, ExpTypes, MFA, AllRecords, VarTab, Cache), + final_form(Form2, ExpTypes, MFA, RecordTable, VarTab, Cache), NewAcc = [{subtype, T1, T2}|Acc], - constraints_to_subs(Rest, MFA, RecDict, ExpTypes, AllRecords, + constraints_to_subs(Rest, MFA, RecDict, ExpTypes, RecordTable, VarTab, NewCache, NewAcc). %% Replaces variables with '_' when necessary to break up cycles among diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl index 99f95a4dca..7c1bc1de5a 100644 --- a/lib/dialyzer/src/dialyzer_coordinator.erl +++ b/lib/dialyzer/src/dialyzer_coordinator.erl @@ -76,6 +76,8 @@ active = 0 :: integer(), result :: result(), next_label = 0 :: integer(), + jobs :: [job()], + job_fun :: fun(), init_data :: init_data(), regulator :: regulator(), scc_to_pid :: scc_to_pid() @@ -108,16 +110,18 @@ spawn_jobs(Mode, Jobs, InitData, Timing) -> false -> unused end, Coordinator = {Collector, Regulator, SCCtoPID}, - Fold = - fun(Job, Count) -> - Pid = dialyzer_worker:launch(Mode, Job, InitData, Coordinator), - case TypesigOrDataflow of - true -> true = ets:insert(SCCtoPID, {Job, Pid}), ok; - false -> ok - end, - Count + 1 + JobFun = + fun(Job) -> + Pid = dialyzer_worker:launch(Mode, Job, InitData, Coordinator), + case TypesigOrDataflow of + true -> true = ets:insert(SCCtoPID, {Job, Pid}); + false -> true + end end, - JobCount = lists:foldl(Fold, 0, Jobs), + JobCount = length(Jobs), + NumberOfInitJobs = min(JobCount, 20 * dialyzer_utils:parallelism()), + {InitJobs, RestJobs} = lists:split(NumberOfInitJobs, Jobs), + lists:foreach(JobFun, InitJobs), Unit = case Mode of 'typesig' -> "SCCs"; @@ -129,11 +133,13 @@ spawn_jobs(Mode, Jobs, InitData, Timing) -> 'compile' -> dialyzer_analysis_callgraph:compile_init_result(); _ -> [] end, - #state{mode = Mode, active = JobCount, result = InitResult, next_label = 0, - init_data = InitData, regulator = Regulator, scc_to_pid = SCCtoPID}. + #state{mode = Mode, active = JobCount, result = InitResult, + next_label = 0, job_fun = JobFun, jobs = RestJobs, + init_data = InitData, regulator = Regulator, scc_to_pid = SCCtoPID}. collect_result(#state{mode = Mode, active = Active, result = Result, next_label = NextLabel, init_data = InitData, + jobs = JobsLeft, job_fun = JobFun, regulator = Regulator, scc_to_pid = SCCtoPID} = State) -> receive {next_label_request, Estimation, Pid} -> @@ -141,20 +147,35 @@ collect_result(#state{mode = Mode, active = Active, result = Result, collect_result(State#state{next_label = NextLabel + Estimation}); {done, Job, Data} -> NewResult = update_result(Mode, InitData, Job, Data, Result), + TypesigOrDataflow = (Mode =:= 'typesig') orelse (Mode =:= 'dataflow'), case Active of 1 -> kill_regulator(Regulator), case Mode of 'compile' -> {NewResult, NextLabel}; - X when X =:= 'typesig'; X =:= 'dataflow' -> + _ when TypesigOrDataflow -> ets:delete(SCCtoPID), NewResult; 'warnings' -> NewResult end; N -> - collect_result(State#state{result = NewResult, active = N - 1}) + case TypesigOrDataflow of + true -> true = ets:delete(SCCtoPID, Job); + false -> true + end, + NewJobsLeft = + case JobsLeft of + [] -> []; + [NewJob|JobsLeft1] -> + JobFun(NewJob), + JobsLeft1 + end, + NewState = State#state{result = NewResult, + jobs = NewJobsLeft, + active = N - 1}, + collect_result(NewState) end end. @@ -170,18 +191,20 @@ update_result(Mode, InitData, Job, Data, Result) -> end. -spec sccs_to_pids([scc() | module()], coordinator()) -> - {[dialyzer_worker:worker()], [scc() | module()]}. + [dialyzer_worker:worker()]. sccs_to_pids(SCCs, {_Collector, _Regulator, SCCtoPID}) -> Fold = - fun(SCC, {Pids, Unknown}) -> - try ets:lookup_element(SCCtoPID, SCC, 2) of - Result -> {[Result|Pids], Unknown} - catch - _:_ -> {Pids, [SCC|Unknown]} - end + fun(SCC, Pids) -> + %% The SCCs that SCC depends on have always been started. + try ets:lookup_element(SCCtoPID, SCC, 2) of + Pid when is_pid(Pid) -> + [Pid|Pids] + catch + _:_ -> Pids + end end, - lists:foldl(Fold, {[], []}, SCCs). + lists:foldl(Fold, [], SCCs). -spec job_done(job(), job_result(), coordinator()) -> ok. diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 37c22fef48..eb63e9e695 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -31,9 +31,8 @@ included_files/1, from_file/1, get_default_plt/0, - get_types/1, + get_module_types/2, get_exported_types/1, - %% insert/3, insert_list/2, insert_contract_list/2, insert_callbacks/2, @@ -143,6 +142,10 @@ delete_list(#plt{info = Info, types = Types, -spec insert_contract_list(plt(), dialyzer_contracts:plt_contracts()) -> plt(). +insert_contract_list(#plt{contracts = Contracts} = PLT, List) -> + NewContracts = dict:merge(fun(_MFA, _Old, New) -> New end, + Contracts, dict:from_list(List)), + PLT#plt{contracts = NewContracts}; insert_contract_list(#mini_plt{contracts = Contracts} = PLT, List) -> true = ets:insert(Contracts, List), PLT. @@ -184,20 +187,23 @@ lookup(Plt, Label) when is_integer(Label) -> lookup_1(#mini_plt{info = Info}, MFAorLabel) -> ets_table_lookup(Info, MFAorLabel). --spec insert_types(plt(), erl_types:mod_records()) -> plt(). +-spec insert_types(plt(), ets:tid()) -> plt(). -insert_types(PLT, Rec) -> - PLT#plt{types = Rec}. +insert_types(MiniPLT, Records) -> + ets:rename(Records, plt_types), + MiniPLT#mini_plt{types = Records}. --spec insert_exported_types(plt(), sets:set()) -> plt(). +-spec insert_exported_types(plt(), ets:tid()) -> plt(). -insert_exported_types(PLT, Set) -> - PLT#plt{exported_types = Set}. +insert_exported_types(MiniPLT, ExpTypes) -> + ets:rename(ExpTypes, plt_exported_types), + MiniPLT#mini_plt{exported_types = ExpTypes}. --spec get_types(plt()) -> erl_types:mod_records(). +-spec get_module_types(plt(), atom()) -> + 'none' | {'value', erl_types:type_table()}. -get_types(#plt{types = Types}) -> - Types. +get_module_types(#plt{types = Types}, M) when is_atom(M) -> + table_lookup(Types, M). -spec get_exported_types(plt()) -> sets:set(). @@ -520,10 +526,12 @@ get_mini_plt(#plt{info = Info, contracts = Contracts, callbacks = Callbacks, exported_types = ExpTypes}) -> - [ETSInfo, ETSTypes, ETSContracts, ETSCallbacks, ETSExpTypes] = + [ETSInfo, ETSContracts] = [ets:new(Name, [public]) || - Name <- [plt_info, plt_types, plt_contracts, plt_callbacks, - plt_exported_types]], + Name <- [plt_info, plt_contracts]], + [ETSTypes, ETSCallbacks, ETSExpTypes] = + [ets:new(Name, [compressed, public]) || + Name <- [plt_types, plt_callbacks, plt_exported_types]], CallbackList = dict:to_list(Callbacks), CallbacksByModule = [{M, [Cb || {{M1,_,_},_} = Cb <- CallbackList, M1 =:= M]} || diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 3c90f46e95..be685baf22 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -29,7 +29,7 @@ -export([ find_succ_types_for_scc/2, refine_one_module/2, - find_required_by/2, + %% find_required_by/2, find_depends_on/2, collect_warnings/2, lookup_names/2 @@ -236,10 +236,10 @@ refine_succ_typings(Modules, #st{codeserver = Codeserver, find_depends_on(SCC, {_Codeserver, Callgraph, _Plt, _Solvers}) -> dialyzer_callgraph:get_depends_on(SCC, Callgraph). --spec find_required_by(scc() | module(), fixpoint_init_data()) -> [scc()]. +%% -spec find_required_by(scc() | module(), fixpoint_init_data()) -> [scc()]. -find_required_by(SCC, {_Codeserver, Callgraph, _Plt, _Solvers}) -> - dialyzer_callgraph:get_required_by(SCC, Callgraph). +%% find_required_by(SCC, {_Codeserver, Callgraph, _Plt, _Solvers}) -> +%% dialyzer_callgraph:get_required_by(SCC, Callgraph). -spec lookup_names([label()], fixpoint_init_data()) -> [mfa_or_funlbl()]. diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index b33484bda4..c4f8adf7ee 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -81,7 +81,7 @@ -record(constraint_list, {type :: 'conj' | 'disj', list :: [constr()], deps :: deps(), - masks = maps:new() :: #{dep() => mask()}, + masks :: #{dep() => mask()} | 'undefined', id :: {'list', dep()} | 'undefined'}). -type constraint_list() :: #constraint_list{}. @@ -181,7 +181,6 @@ analyze_scc(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers0) -> M <- lists:usort([M || {M, _, _} <- SCC])], State2 = traverse_scc(SCC, CServer, DefSet, ModRecs, State1), State3 = state__finalize(State2), - erlang:garbage_collect(), Funs = state__scc(State3), pp_constrs_scc(Funs, State3), constraints_to_dot_scc(Funs, State3), @@ -202,7 +201,8 @@ traverse_scc([{M,_,_}=MFA|Left], Codeserver, DefSet, ModRecs, AccState) -> {M, Rec} = lists:keyfind(M, 1, ModRecs), TmpState1 = state__set_rec_dict(AccState, Rec), DummyLetrec = cerl:c_letrec([Def], cerl:c_atom(foo)), - {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState1), + TmpState2 = state__new_constraint_context(TmpState1), + {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState2), traverse_scc(Left, Codeserver, DefSet, ModRecs, NewAccState); traverse_scc([], _Codeserver, _DefSet, _ModRecs, AccState) -> AccState. @@ -2080,6 +2080,8 @@ v2_solve_disjunct(Disj, Map, V2State0) -> var_occurs_everywhere(V, Masks, NotFailed) -> ordsets:is_subset(NotFailed, get_mask(V, Masks)). +-dialyzer({no_improper_lists, [v2_solve_disj/10, v2_solve_conj/12]}). + v2_solve_disj([I|Is], [C|Cs], I, Map0, V2State0, UL, MapL, Eval, Uneval, Failed0) -> Id = C#constraint_list.id, @@ -2098,6 +2100,12 @@ v2_solve_disj([I|Is], [C|Cs], I, Map0, V2State0, UL, MapL, Eval, Uneval, end; v2_solve_disj([], [], _I, _Map, V2State, UL, MapL, Eval, Uneval, Failed) -> {ok, V2State, lists:reverse(Eval), UL, MapL, lists:reverse(Uneval), Failed}; +v2_solve_disj(every_i, Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed) -> + NewIs = case Cs of + [] -> []; + _ -> [I|every_i] + end, + v2_solve_disj(NewIs, Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed); v2_solve_disj(Is, [C|Cs], I, Map, V2State, UL, MapL, Eval, Uneval0, Failed) -> Uneval = [{I,C#constraint_list.id} || not is_failed_list(C, V2State)] ++ Uneval0, @@ -2169,7 +2177,7 @@ v2_solve_conj([I|Is], [Cs|Tail], I, Map0, Conj, IsFlat, V2State0, M = lists:keydelete(I, 1, vars_per_child(U, Masks)), {V2State2, NewF0} = save_updated_vars_list(AllCs, M, V2State1), {NewF, F} = lists:splitwith(fun(J) -> J < I end, NewF0), - Is1 = lists:umerge(Is, F), + Is1 = umerge_mask(Is, F), NewFs = [NewF|NewFs0], v2_solve_conj(Is1, Tail, I+1, Map, Conj, IsFlat, V2State2, [U|UL], NewFs, VarsUp, LastMap, LastFlags) @@ -2191,6 +2199,14 @@ v2_solve_conj([], _Cs, _I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, v2_solve_conj(NewFlags, Cs, 1, Map, Conj, IsFlat, V2State, [], [], [U|VarsUp], Map, NewFlags) end; +v2_solve_conj(every_i, Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, + LastMap, LastFlags) -> + NewIs = case Cs of + [] -> []; + _ -> [I|every_i] + end, + v2_solve_conj(NewIs, Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, + LastMap, LastFlags); v2_solve_conj(Is, [_|Tail], I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, LastMap, LastFlags) -> v2_solve_conj(Is, Tail, I+1, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, @@ -2207,7 +2223,12 @@ report_detected_loop(_) -> add_mask_to_flags(Flags, [Im|M], I, L) when I > Im -> add_mask_to_flags(Flags, M, I, [Im|L]); add_mask_to_flags(Flags, [_|M], _I, L) -> - {lists:umerge(M, Flags), lists:reverse(L)}. + {umerge_mask(Flags, M), lists:reverse(L)}. + +umerge_mask(every_i, _F) -> + every_i; +umerge_mask(Is, F) -> + lists:umerge(Is, F). get_mask(V, Masks) -> case maps:find(V, Masks) of @@ -2221,7 +2242,7 @@ get_flags(#v2_state{constr_data = ConData}=V2State0, C) -> error -> ?debug("get_flags Id=~w Flags=all ~w\n", [Id, length(Cs)]), V2State = V2State0#v2_state{constr_data = maps:put(Id, {[],[]}, ConData)}, - {V2State, lists:seq(1, length(Cs))}; + {V2State, every_i}; {ok, failed} -> {V2State0, failed_list}; {ok, {Part,U}} when U =/= [] -> @@ -2901,8 +2922,9 @@ state__get_rec_var(Fun, #state{fun_map = Map}) -> maps:find(Fun, Map). state__finalize(State) -> - State1 = enumerate_constraints(State), - order_fun_constraints(State1). + State1 = state__new_constraint_context(State), + State2 = enumerate_constraints(State1), + order_fun_constraints(State2). %% ============================================================================ %% @@ -2982,7 +3004,7 @@ find_constraint_deps([Type|Tail], Acc) -> NewAcc = [[t_var_name(D) || D <- t_collect_vars(Type)]|Acc], find_constraint_deps(Tail, NewAcc); find_constraint_deps([], Acc) -> - lists:flatten(Acc). + lists:append(Acc). mk_constraint_1(Lhs, eq, Rhs, Deps) when Lhs < Rhs -> #constraint{lhs = Lhs, op = eq, rhs = Rhs, deps = Deps}; @@ -3090,8 +3112,8 @@ expand_to_conjunctions(#constraint_list{type = disj, list = List}) -> List1 = [C || C <- List, is_simple_constraint(C)], %% Just an assert. [] = [C || #constraint{} = C <- List1], - Expanded = lists:flatten([expand_to_conjunctions(C) - || #constraint_list{} = C <- List]), + Expanded = lists:append([expand_to_conjunctions(C) + || #constraint_list{} = C <- List]), ReturnList = Expanded ++ List1, if length(ReturnList) > ?DISJ_NORM_FORM_LIMIT -> throw(too_many_disj); true -> ReturnList @@ -3116,8 +3138,10 @@ calculate_deps(List) -> calculate_deps([H|Tail], Acc) -> Deps = get_deps(H), calculate_deps(Tail, [Deps|Acc]); +calculate_deps([], []) -> []; +calculate_deps([], [L]) -> L; calculate_deps([], Acc) -> - ordsets:from_list(lists:flatten(Acc)). + lists:umerge(Acc). mk_conj_constraint_list(List) -> mk_constraint_list(conj, List). @@ -3185,7 +3209,8 @@ order_fun_constraints(State) -> order_fun_constraints([#constraint_ref{id = Id}|Tail], State) -> Cs = state__get_cs(Id, State), - {[NewCs], State1} = order_fun_constraints([Cs], [], [], State), + {[Cs1], State1} = order_fun_constraints([Cs], [], [], State), + NewCs = Cs1#constraint_list{deps = Cs#constraint_list.deps}, NewState = state__store_constrs(Id, NewCs, State1), order_fun_constraints(Tail, NewState); order_fun_constraints([], State) -> @@ -3193,23 +3218,31 @@ order_fun_constraints([], State) -> order_fun_constraints([#constraint_ref{} = C|Tail], Funs, Acc, State) -> order_fun_constraints(Tail, [C|Funs], Acc, State); -order_fun_constraints([#constraint_list{list = List, type = Type} = C|Tail], +order_fun_constraints([#constraint_list{list = List, + type = Type, + masks = OldMasks} = C|Tail], Funs, Acc, State) -> - {NewList, NewState} = - case Type of - conj -> order_fun_constraints(List, [], [], State); - disj -> - FoldFun = fun(X, AccState) -> - {[NewX], NewAccState} = - order_fun_constraints([X], [], [], AccState), - {NewX, NewAccState} - end, - lists:mapfoldl(FoldFun, State, List) - end, - C1 = update_constraint_list(C, NewList), - Masks = calculate_masks(NewList, 1, []), - NewAcc = [update_masks(C1, Masks)|Acc], - order_fun_constraints(Tail, Funs, NewAcc, NewState); + case OldMasks of + undefined -> + {NewList, NewState} = + case Type of + conj -> order_fun_constraints(List, [], [], State); + disj -> + FoldFun = fun(X, AccState) -> + {[NewX], NewAccState} = + order_fun_constraints([X], [], [], AccState), + {NewX, NewAccState} + end, + lists:mapfoldl(FoldFun, State, List) + end, + NewList2 = reset_deps(NewList, State), + C1 = update_constraint_list(C, NewList2), + Masks = calculate_masks(NewList, 1, []), + NewAcc = [update_masks(C1, Masks)|Acc], + order_fun_constraints(Tail, Funs, NewAcc, NewState); + M when is_map(M) -> + order_fun_constraints(Tail, Funs, [C|Acc], State) + end; order_fun_constraints([#constraint{} = C|Tail], Funs, Acc, State) -> order_fun_constraints(Tail, Funs, [C|Acc], State); order_fun_constraints([], Funs, Acc, State) -> @@ -3219,6 +3252,18 @@ order_fun_constraints([], Funs, Acc, State) -> update_masks(C, Masks) -> C#constraint_list{masks = Masks}. +reset_deps(ConstrList, #state{solvers = Solvers}) -> + case lists:member(v1, Solvers) of + true -> + ConstrList; + false -> + [reset_deps(Constr) || Constr <- ConstrList] + end. + +reset_deps(#constraint{}=C) -> C#constraint{deps = []}; +reset_deps(#constraint_list{}=C) -> C#constraint_list{deps = []}; +reset_deps(#constraint_ref{}=C) -> C#constraint_ref{deps = []}. + calculate_masks([C|Cs], I, L0) -> calculate_masks(Cs, I+1, [{V, I} || V <- get_deps(C)] ++ L0); calculate_masks([], _I, L) -> diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 432d27571b..9eaf95c1a2 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -37,9 +37,9 @@ get_fun_meta_info/3, is_suppressed_fun/2, is_suppressed_tag/3, - merge_records/2, pp_hook/0, process_record_remote_types/1, + merge_types/2, sets_filter/2, src_compiler_opts/0, refold_pattern/1, @@ -188,7 +188,6 @@ get_core_from_abstract_code(AbstrCode, Opts) -> %% ============================================================================ -type type_table() :: erl_types:type_table(). --type mod_records() :: dict:dict(module(), type_table()). -spec get_record_and_type_info(abstract_code()) -> {'ok', type_table()} | {'error', string()}. @@ -289,18 +288,18 @@ get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) -> get_record_fields([], _RecDict, Acc) -> lists:reverse(Acc). --spec process_record_remote_types(codeserver()) -> - {codeserver(), mod_records()}. +-spec process_record_remote_types(codeserver()) -> codeserver(). %% The field types are cached. Used during analysis when handling records. process_record_remote_types(CServer) -> - TempRecords = dialyzer_codeserver:get_temp_records(CServer), ExpTypes = dialyzer_codeserver:get_exported_types(CServer), - TempRecords1 = process_opaque_types0(TempRecords, ExpTypes), - %% A cache (not the field type cache) is used for speeding things up a bit. + Mods = dialyzer_codeserver:all_temp_modules(CServer), + process_opaque_types0(Mods, CServer, ExpTypes), VarTable = erl_types:var_table__new(), + RecordTable = dialyzer_codeserver:get_temp_records_table(CServer), ModuleFun = - fun({Module, Record}) -> + fun(Module) -> + RecordMap = dialyzer_codeserver:lookup_temp_mod_records(Module, CServer), RecordFun = fun({Key, Value}, C2) -> case Key of @@ -313,7 +312,7 @@ process_record_remote_types(CServer) -> {FieldT, C6} = erl_types:t_from_form (Field, ExpTypes, Site, - TempRecords1, VarTable, + RecordTable, VarTable, C5), {{FieldName, Field, FieldT}, C6} end, C4, Fields), @@ -328,30 +327,29 @@ process_record_remote_types(CServer) -> end, Cache = erl_types:cache__new(), {RecordList, _NewCache} = - lists:mapfoldl(RecordFun, Cache, maps:to_list(Record)), - {Module, maps:from_list(RecordList)} + lists:mapfoldl(RecordFun, Cache, maps:to_list(RecordMap)), + dialyzer_codeserver:store_temp_records(Module, + maps:from_list(RecordList), + CServer) end, - NewRecordsList = lists:map(ModuleFun, dict:to_list(TempRecords1)), - NewRecords = dict:from_list(NewRecordsList), - check_record_fields(NewRecords, ExpTypes), - {dialyzer_codeserver:finalize_records(NewRecords, CServer), NewRecords}. + lists:foreach(ModuleFun, Mods), + check_record_fields(Mods, CServer, ExpTypes), + dialyzer_codeserver:finalize_records(CServer). %% erl_types:t_from_form() substitutes the declaration of opaque types %% for the expanded type in some cases. To make sure the initial type, %% any(), is not used, the expansion is done twice. %% XXX: Recursive opaque types are not handled well. -process_opaque_types0(TempRecords0, TempExpTypes) -> - Cache = erl_types:cache__new(), - {TempRecords1, Cache1} = - process_opaque_types(TempRecords0, TempExpTypes, Cache), - {TempRecords, _NewCache} = - process_opaque_types(TempRecords1, TempExpTypes, Cache1), - TempRecords. - -process_opaque_types(TempRecords, TempExpTypes, Cache) -> +process_opaque_types0(AllModules, CServer, TempExpTypes) -> + process_opaque_types(AllModules, CServer, TempExpTypes), + process_opaque_types(AllModules, CServer, TempExpTypes). + +process_opaque_types(AllModules, CServer, TempExpTypes) -> VarTable = erl_types:var_table__new(), + RecordTable = dialyzer_codeserver:get_temp_records_table(CServer), ModuleFun = - fun({Module, Record}, C0) -> + fun(Module) -> + RecordMap = dialyzer_codeserver:lookup_temp_mod_records(Module, CServer), RecordFun = fun({Key, Value}, C2) -> case Key of @@ -360,32 +358,32 @@ process_opaque_types(TempRecords, TempExpTypes, Cache) -> Site = {type, {Module, Name, NArgs}}, {Type, C3} = erl_types:t_from_form(Form, TempExpTypes, Site, - TempRecords, VarTable, C2), + RecordTable, VarTable, C2), {{Key, {F, Type}}, C3}; _Other -> {{Key, Value}, C2} end end, - {RecordList, C1} = - lists:mapfoldl(RecordFun, C0, maps:to_list(Record)), - {{Module, maps:from_list(RecordList)}, C1} - %% dict:map(RecordFun, Record) + C0 = erl_types:cache__new(), + {RecordList, _NewCache} = + lists:mapfoldl(RecordFun, C0, maps:to_list(RecordMap)), + dialyzer_codeserver:store_temp_records(Module, + maps:from_list(RecordList), + CServer) end, - {TempRecordList, NewCache} = - lists:mapfoldl(ModuleFun, Cache, dict:to_list(TempRecords)), - {dict:from_list(TempRecordList), NewCache}. - %% dict:map(ModuleFun, TempRecords). + lists:foreach(ModuleFun, AllModules). -check_record_fields(Records, TempExpTypes) -> - Cache = erl_types:cache__new(), +check_record_fields(AllModules, CServer, TempExpTypes) -> VarTable = erl_types:var_table__new(), + RecordTable = dialyzer_codeserver:get_temp_records_table(CServer), CheckFun = - fun({Module, Element}, C0) -> + fun(Module) -> CheckForm = fun(Form, Site, C1) -> erl_types:t_check_record_fields(Form, TempExpTypes, - Site, Records, + Site, RecordTable, VarTable, C1) end, - ElemFun = + RecordMap = dialyzer_codeserver:lookup_temp_mod_records(Module, CServer), + RecordFun = fun({Key, Value}, C2) -> case Key of {record, Name} -> @@ -406,10 +404,10 @@ check_record_fields(Records, TempExpTypes) -> msg_with_position(Fun, FileLine) end end, - lists:foldl(ElemFun, C0, maps:to_list(Element)) + C0 = erl_types:cache__new(), + _ = lists:foldl(RecordFun, C0, maps:to_list(RecordMap)) end, - _NewCache = lists:foldl(CheckFun, Cache, dict:to_list(Records)), - ok. + lists:foreach(CheckFun, AllModules). msg_with_position(Fun, FileLine) -> try Fun() @@ -421,10 +419,37 @@ msg_with_position(Fun, FileLine) -> throw({error, NewMsg}) end. --spec merge_records(mod_records(), mod_records()) -> mod_records(). +-spec merge_types(codeserver(), dialyzer_plt:plt()) -> codeserver(). -merge_records(NewRecords, OldRecords) -> - dict:merge(fun(_Key, NewVal, _OldVal) -> NewVal end, NewRecords, OldRecords). +merge_types(CServer, Plt) -> + AllNewModules = dialyzer_codeserver:all_temp_modules(CServer), + AllNewModulesSet = sets:from_list(AllNewModules), + AllOldModulesSet = dialyzer_plt:all_modules(Plt), + AllModulesSet = sets:union(AllNewModulesSet, AllOldModulesSet), + ModuleFun = + fun(Module) -> + KeepOldFun = + fun() -> + case dialyzer_plt:get_module_types(Plt, Module) of + none -> no; + {value, OldRecords} -> + case sets:is_element(Module, AllNewModulesSet) of + true -> no; + false -> {yes, OldRecords} + end + end + end, + Records = + case KeepOldFun() of + no -> + dialyzer_codeserver:lookup_temp_mod_records(Module, CServer); + {yes, OldRecords} -> + OldRecords + end, + dialyzer_codeserver:store_temp_records(Module, Records, CServer) + end, + lists:foreach(ModuleFun, sets:to_list(AllModulesSet)), + CServer. %% ============================================================================ %% diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl index 418c9798b3..af0f2e9e08 100644 --- a/lib/dialyzer/src/dialyzer_worker.erl +++ b/lib/dialyzer/src/dialyzer_worker.erl @@ -56,10 +56,14 @@ launch(Mode, Job, InitData, Coordinator) -> %%-------------------------------------------------------------------- -init(#state{job = SCC, mode = Mode, init_data = InitData} = State) when +init(#state{job = SCC, mode = Mode, init_data = InitData, + coordinator = Coordinator} = State) when Mode =:= 'typesig'; Mode =:= 'dataflow' -> - DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData), - ?debug("Deps ~p: ~p\n",[SCC, DependsOn]), + DependsOnSCCs = dialyzer_succ_typings:find_depends_on(SCC, InitData), + ?debug("~w: Deps ~p: ~p\n", [self(), SCC, DependsOnSCCs]), + Pids = dialyzer_coordinator:sccs_to_pids(DependsOnSCCs, Coordinator), + ?debug("~w: PidsDeps ~p\n", [self(), Pids]), + DependsOn = [{Pid, erlang:monitor(process, Pid)} || Pid <- Pids], loop(updating, State#state{depends_on = DependsOn}); init(#state{mode = Mode} = State) when Mode =:= 'compile'; Mode =:= 'warnings' -> @@ -67,7 +71,7 @@ init(#state{mode = Mode} = State) when loop(updating, #state{mode = Mode} = State) when Mode =:= 'typesig'; Mode =:= 'dataflow' -> - ?debug("Update: ~p\n",[State#state.job]), + ?debug("~w: Update: ~p\n", [self(), State#state.job]), NextStatus = case waits_more_success_typings(State) of true -> waiting; @@ -76,11 +80,11 @@ loop(updating, #state{mode = Mode} = State) when loop(NextStatus, State); loop(waiting, #state{mode = Mode} = State) when Mode =:= 'typesig'; Mode =:= 'dataflow' -> - ?debug("Wait: ~p\n",[State#state.job]), + ?debug("~w: Wait: ~p\n", [self(), State#state.job]), NewState = wait_for_success_typings(State), loop(updating, NewState); loop(running, #state{mode = 'compile'} = State) -> - dialyzer_coordinator:request_activation(State#state.coordinator), + request_activation(State), ?debug("Compile: ~s\n",[State#state.job]), Result = case start_compilation(State) of @@ -92,51 +96,28 @@ loop(running, #state{mode = 'compile'} = State) -> end, report_to_coordinator(Result, State); loop(running, #state{mode = 'warnings'} = State) -> - dialyzer_coordinator:request_activation(State#state.coordinator), + request_activation(State), ?debug("Warning: ~s\n",[State#state.job]), Result = collect_warnings(State), report_to_coordinator(Result, State); loop(running, #state{mode = Mode} = State) when Mode =:= 'typesig'; Mode =:= 'dataflow' -> request_activation(State), - ?debug("Run: ~p\n",[State#state.job]), + ?debug("~w: Run: ~p\n", [self(), State#state.job]), NotFixpoint = do_work(State), - ok = broadcast_done(State), report_to_coordinator(NotFixpoint, State). waits_more_success_typings(#state{depends_on = Depends}) -> Depends =/= []. -broadcast_done(#state{job = SCC, init_data = InitData, - coordinator = Coordinator}) -> - RequiredBy = dialyzer_succ_typings:find_required_by(SCC, InitData), - {Callers, Unknown} = - dialyzer_coordinator:sccs_to_pids(RequiredBy, Coordinator), - send_done(Callers, SCC), - continue_broadcast_done(Unknown, SCC, Coordinator). - -send_done(Callers, SCC) -> - ?debug("Sending ~p: ~p\n",[SCC, Callers]), - SendSTFun = fun(PID) -> PID ! {done, SCC} end, - lists:foreach(SendSTFun, Callers). - -continue_broadcast_done([], _SCC, _Coordinator) -> ok; -continue_broadcast_done(Rest, SCC, Coordinator) -> - %% This time limit should be greater than the time required - %% by the coordinator to spawn all processes. - timer:sleep(500), - {Callers, Unknown} = dialyzer_coordinator:sccs_to_pids(Rest, Coordinator), - send_done(Callers, SCC), - continue_broadcast_done(Unknown, SCC, Coordinator). - wait_for_success_typings(#state{depends_on = DependsOn} = State) -> receive - {done, SCC} -> - ?debug("GOT ~p: ~p\n",[State#state.job, SCC]), - State#state{depends_on = DependsOn -- [SCC]} + {'DOWN', Ref, process, Pid, _Info} -> + ?debug("~w: ~p got DOWN: ~p\n", [self(), State#state.job, Pid]), + State#state{depends_on = DependsOn -- [{Pid, Ref}]} after 5000 -> - ?debug("Still Waiting ~p: ~p\n",[State#state.job, DependsOn]), + ?debug("~w: Still Waiting ~p:\n ~p\n", [self(), State#state.job, DependsOn]), State end. @@ -150,7 +131,7 @@ do_work(#state{mode = Mode, job = Job, init_data = InitData}) -> end. report_to_coordinator(Result, #state{job = Job, coordinator = Coordinator}) -> - ?debug("Done: ~p\n",[Job]), + ?debug("~w: Done: ~p\n",[self(), Job]), dialyzer_coordinator:job_done(Job, Result, Coordinator). start_compilation(#state{job = Job, init_data = InitData}) -> diff --git a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options index cb6a88786e..365b4798c5 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ {dialyzer_options, []}. -{time_limit, 2}. +{time_limit, 5}. diff --git a/lib/dialyzer/test/map_SUITE_data/dialyzer_options b/lib/dialyzer/test/map_SUITE_data/dialyzer_options index 50991c9bc5..02425c33f2 100644 --- a/lib/dialyzer/test/map_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/map_SUITE_data/dialyzer_options @@ -1 +1,2 @@ {dialyzer_options, []}. +{time_limit, 30}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options index 06ed52043a..cb301ff6a1 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ {dialyzer_options, [{warnings, [no_unused, no_return]}]}. -{time_limit, 20}. +{time_limit, 40}. diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index 460d4e2240..fbfa979e1b 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -26,6 +26,8 @@ build_plt(Config) -> end. beam_tests(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "beam_tests.plt"), Prog = <<" -module(no_auto_import). @@ -42,10 +44,12 @@ beam_tests(Config) when is_list(Config) -> ">>, Opts = [no_auto_import], {ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts), - [] = run_dialyzer(plt_build, [BeamFile], []), + [] = run_dialyzer(plt_build, [BeamFile], [{output_plt, Plt}]), ok. run_plt_check(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "run_plt_check.plt"), Mod1 = <<" -module(run_plt_check1). ">>, @@ -56,7 +60,7 @@ run_plt_check(Config) when is_list(Config) -> {ok, BeamFile1} = compile(Config, Mod1, run_plt_check1, []), {ok, BeamFile2} = compile(Config, Mod2A, run_plt_check2, []), - [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], []), + [] = run_dialyzer(plt_build, [BeamFile1, BeamFile2], [{output_plt, Plt}]), Mod2B = <<" -module(run_plt_check2). @@ -70,11 +74,13 @@ run_plt_check(Config) when is_list(Config) -> % callgraph warning as run_plt_check2:call/1 makes a call to unexported % function run_plt_check1:call/1. - [_] = run_dialyzer(plt_check, [], []), + [_] = run_dialyzer(plt_check, [], [{init_plt, Plt}]), ok. run_succ_typings(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Plt = filename:join(PrivDir, "run_succ_typings.plt"), Mod1A = <<" -module(run_succ_typings1). @@ -84,7 +90,7 @@ run_succ_typings(Config) when is_list(Config) -> ">>, {ok, BeamFile1} = compile(Config, Mod1A, run_succ_typings1, []), - [] = run_dialyzer(plt_build, [BeamFile1], []), + [] = run_dialyzer(plt_build, [BeamFile1], [{output_plt, Plt}]), Mod1B = <<" -module(run_succ_typings1). @@ -107,9 +113,11 @@ run_succ_typings(Config) when is_list(Config) -> {ok, BeamFile2} = compile(Config, Mod2, run_succ_typings2, []), % contract types warning as run_succ_typings2:call/0 makes a call to % run_succ_typings1:call/0, which returns a (not b) in the PLT. - [_] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, false}]), + [_] = run_dialyzer(succ_typings, [BeamFile2], + [{check_plt, false}, {init_plt, Plt}]), % warning not returned as run_succ_typings1 is updated in the PLT. - [] = run_dialyzer(succ_typings, [BeamFile2], [{check_plt, true}]), + [] = run_dialyzer(succ_typings, [BeamFile2], + [{check_plt, true}, {init_plt, Plt}]), ok. @@ -252,12 +260,9 @@ remove_plt(Config) -> ok. bad_dialyzer_attr(Config) -> - PrivDir = ?config(priv_dir, Config), - Prog1 = <<"-module(dial). -dialyzer({no_return, [undef/0]}).">>, {ok, Beam1} = compile(Config, Prog1, dial, []), - Plt = filename:join(PrivDir, "bad_attr.plt"), {dialyzer_error, "Analysis failed with error:\n" "Could not scan the following file(s):\n" diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 91ee104f77..9d46d4ac81 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2235,16 +2235,21 @@ t_has_var_list([]) -> false. -spec t_collect_vars(erl_type()) -> [erl_type()]. t_collect_vars(T) -> - t_collect_vars(T, []). + Vs = t_collect_vars(T, maps:new()), + [V || {V, _} <- maps:to_list(Vs)]. --spec t_collect_vars(erl_type(), [erl_type()]) -> [erl_type()]. +-type ctab() :: #{erl_type() => 'any'}. + +-spec t_collect_vars(erl_type(), ctab()) -> ctab(). t_collect_vars(?var(_) = Var, Acc) -> - ordsets:add_element(Var, Acc); + maps:put(Var, any, Acc); t_collect_vars(?function(Domain, Range), Acc) -> - ordsets:union(t_collect_vars(Domain, Acc), t_collect_vars(Range, [])); + Acc1 = t_collect_vars(Domain, Acc), + t_collect_vars(Range, Acc1); t_collect_vars(?list(Contents, Termination, _), Acc) -> - ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, [])); + Acc1 = t_collect_vars(Contents, Acc), + t_collect_vars(Termination, Acc1); t_collect_vars(?product(Types), Acc) -> t_collect_vars_list(Types, Acc); t_collect_vars(?tuple(?any, ?any, ?any), Acc) -> @@ -4424,9 +4429,17 @@ mod_name(Mod, Name) -> -type site() :: {'type', mta()} | {'spec', mfa()} | {'record', mra()}. -type cache_key() :: {module(), atom(), expand_depth(), [erl_type()], type_names()}. --opaque cache() :: #{cache_key() => {erl_type(), expand_limit()}}. +-type mod_type_table() :: ets:tid(). +-record(cache, + { + types = maps:new() :: #{cache_key() => {erl_type(), expand_limit()}}, + mod_recs = {mrecs, dict:new()} :: 'undefined' + | {'mrecs', mod_records()} + }). + +-opaque cache() :: #cache{}. --spec t_from_form(parse_form(), sets:set(mfa()), site(), mod_records(), +-spec t_from_form(parse_form(), sets:set(mfa()), site(), mod_type_table(), var_table(), cache()) -> {erl_type(), cache()}. t_from_form(Form, ExpTypes, Site, RecDict, VarTab, Cache) -> @@ -4438,11 +4451,12 @@ t_from_form(Form, ExpTypes, Site, RecDict, VarTab, Cache) -> t_from_form_without_remote(Form, Site, TypeTable) -> Module = site_module(Site), - RecDict = dict:from_list([{Module, TypeTable}]), + ModRecs = dict:from_list([{Module, TypeTable}]), ExpTypes = replace_by_none, VarTab = var_table__new(), - Cache = cache__new(), - t_from_form1(Form, ExpTypes, Site, RecDict, VarTab, Cache). + Cache0 = cache__new(), + Cache = Cache0#cache{mod_recs = {mrecs, ModRecs}}, + t_from_form1(Form, ExpTypes, Site, undefined, VarTab, Cache). %% REC_TYPE_LIMIT is used for limiting the depth of recursive types. %% EXPAND_LIMIT is used for limiting the size of types by @@ -4457,13 +4471,13 @@ t_from_form_without_remote(Form, Site, TypeTable) -> -record(from_form, {site :: site(), xtypes :: sets:set(mfa()) | 'replace_by_none', - mrecs :: mod_records(), + mrecs :: 'undefined' | mod_type_table(), vtab :: var_table(), tnames :: type_names()}). -spec t_from_form1(parse_form(), sets:set(mfa()) | 'replace_by_none', - site(), mod_records(), var_table(), cache()) -> - {erl_type(), cache()}. + site(), 'undefined' | mod_type_table(), var_table(), + cache()) -> {erl_type(), cache()}. t_from_form1(Form, ET, Site, MR, V, C) -> TypeNames = initial_typenames(Site), @@ -4709,13 +4723,13 @@ from_form({opaque, _L, Name, {Mod, Args, Rep}}, _S, _D, L, C) -> builtin_type(Name, Type, S, D, L, C) -> #from_form{site = Site, mrecs = MR} = S, M = site_module(Site), - case dict:find(M, MR) of - {ok, R} -> + case lookup_module_types(M, MR, C) of + {R, C1} -> case lookup_type(Name, 0, R) of {_, {{_M, _FL, _F, _A}, _T}} -> - type_from_form(Name, [], S, D, L, C); + type_from_form(Name, [], S, D, L, C1); error -> - {Type, L, C} + {Type, L, C1} end; error -> {Type, L, C} @@ -4728,9 +4742,9 @@ type_from_form(Name, Args, S, D, L, C) -> TypeName = {type, {Module, Name, ArgsLen}}, case can_unfold_more(TypeName, TypeNames) of true -> - {ok, R} = dict:find(Module, MR), + {R, C1} = lookup_module_types(Module, MR, C), type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, - S, D, L, C); + S, D, L, C1); false -> {t_any(), L, C} end. @@ -4782,24 +4796,24 @@ remote_from_form(RemMod, Name, Args, S, D, L, C) -> true -> ArgsLen = length(Args), MFA = {RemMod, Name, ArgsLen}, - case dict:find(RemMod, MR) of + case lookup_module_types(RemMod, MR, C) of error -> self() ! {self(), ext_types, MFA}, {t_any(), L, C}; - {ok, RemDict} -> + {RemDict, C1} -> case sets:is_element(MFA, ET) of true -> RemType = {type, MFA}, case can_unfold_more(RemType, TypeNames) of true -> remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, - RemType, TypeNames, S, D, L, C); + RemType, TypeNames, S, D, L, C1); false -> - {t_any(), L, C} + {t_any(), L, C1} end; false -> self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, - {t_any(), L, C} + {t_any(), L, C1} end end end. @@ -4874,15 +4888,15 @@ record_from_form({atom, _, Name}, ModFields, S, D0, L0, C) -> case can_unfold_more(RecordType, TypeNames) of true -> M = site_module(Site), - {ok, R} = dict:find(M, MR), + {R, C1} = lookup_module_types(M, MR, C), case lookup_record(Name, R) of {ok, DeclFields} -> NewTypeNames = [RecordType|TypeNames], Site1 = {record, {M, Name, length(DeclFields)}}, S1 = S#from_form{site = Site1, tnames = NewTypeNames}, Fun = fun(D, L) -> - {GetModRec, L1, C1} = - get_mod_record(ModFields, DeclFields, S1, D, L, C), + {GetModRec, L1, C2} = + get_mod_record(ModFields, DeclFields, S1, D, L, C1), case GetModRec of {error, FieldName} -> throw({error, @@ -4890,12 +4904,12 @@ record_from_form({atom, _, Name}, ModFields, S, D0, L0, C) -> [Name, FieldName])}); {ok, NewFields} -> S2 = S1#from_form{vtab = var_table__new()}, - {NewFields1, L2, C2} = - fields_from_form(NewFields, S2, D, L1, C1), + {NewFields1, L2, C3} = + fields_from_form(NewFields, S2, D, L1, C2), Rec = t_tuple( [t_atom(Name)|[Type || {_FieldName, Type} <- NewFields1]]), - {Rec, L2, C2} + {Rec, L2, C3} end end, recur_limit(Fun, D0, L0, RecordType, TypeNames); @@ -5026,7 +5040,7 @@ recur_limit(Fun, D, L, TypeName, TypeNames) -> end. -spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), - mod_records(), var_table(), cache()) -> cache(). + mod_type_table(), var_table(), cache()) -> cache(). t_check_record_fields(Form, ExpTypes, Site, RecDict, VarTable, Cache) -> State = #from_form{site = Site, @@ -5070,13 +5084,13 @@ check_record_fields({user_type, _L, _Name, Args}, S, C) -> check_record({atom, _, Name}, ModFields, S, C) -> #from_form{site = Site, mrecs = MR} = S, M = site_module(Site), - {ok, R} = dict:find(M, MR), + {R, C1} = lookup_module_types(M, MR, C), {ok, DeclFields} = lookup_record(Name, R), - case check_fields(Name, ModFields, DeclFields, S, C) of + case check_fields(Name, ModFields, DeclFields, S, C1) of {error, FieldName} -> throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", [Name, FieldName])}); - C1 -> C1 + C2 -> C2 end. check_fields(RecName, [{type, _, field_type, [{atom, _, Name}, Abstr]}|Left], @@ -5106,7 +5120,7 @@ site_module({_, {Module, _, _}}) -> -spec cache__new() -> cache(). cache__new() -> - maps:new(). + #cache{}. -spec cache_key(module(), atom(), [erl_type()], type_names(), expand_depth()) -> cache_key(). @@ -5123,8 +5137,8 @@ cache_key(Module, Name, ArgTypes, TypeNames, D) -> -spec cache_find(cache_key(), cache()) -> {erl_type(), expand_limit()} | 'error'. -cache_find(Key, Cache) -> - case maps:find(Key, Cache) of +cache_find(Key, #cache{types = Types}) -> + case maps:find(Key, Types) of {ok, Value} -> Value; error -> @@ -5136,8 +5150,9 @@ cache_find(Key, Cache) -> cache_put(_Key, _Type, DeltaL, Cache) when DeltaL < 0 -> %% The type is truncated; do not reuse it. Cache; -cache_put(Key, Type, DeltaL, Cache) -> - maps:put(Key, {Type, DeltaL}, Cache). +cache_put(Key, Type, DeltaL, #cache{types = Types} = Cache) -> + NewTypes = maps:put(Key, {Type, DeltaL}, Types), + Cache#cache{types = NewTypes}. -spec t_var_names([erl_type()]) -> [atom()]. @@ -5236,14 +5251,12 @@ t_form_to_string({type, _L, union, Args}) -> t_form_to_string({type, _L, Name, []} = T) -> try M = mod, - D0 = maps:new(), - MR = dict:from_list([{M, D0}]), Site = {type, {M,Name,0}}, V = var_table__new(), C = cache__new(), State = #from_form{site = Site, xtypes = sets:new(), - mrecs = MR, + mrecs = 'undefined', vtab = V, tnames = []}, {T1, _, _} = from_form(T, State, _Deep=1000, _ALot=1000000, C), @@ -5297,6 +5310,28 @@ is_erl_type(?unit) -> true; is_erl_type(#c{}) -> true; is_erl_type(_) -> false. +-spec lookup_module_types(module(), mod_type_table(), cache()) -> + 'error' | {type_table(), cache()}. + +lookup_module_types(Module, CodeTable, Cache) -> + #cache{mod_recs = ModRecs} = Cache, + case ModRecs of + undefined -> error; + {mrecs, MRecs} -> + case dict:find(Module, MRecs) of + {ok, R} -> + {R, Cache}; + error -> + try ets:lookup_element(CodeTable, Module, 2) of + R -> + NewMRecs = dict:store(Module, R, MRecs), + {R, Cache#cache{mod_recs = {mrecs, NewMRecs}}} + catch + _:_ -> error + end + end + end. + -spec lookup_record(atom(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 398fc7e5b6..5c3b5a2d3c 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.3.4</title> + <section><title>Inets 6.3.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct misstakes in ftp client introduced in inets-6.3.4</p> + <p> + Own Id: OTP-14203 Aux Id: OTP-13982 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.3.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 911f5b71a7..23d6483291 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1477,10 +1477,7 @@ handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when T handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = {recv_file, Fd}} = State) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} -> - case file_close(Fd) of - ok -> ok; - {error,einval} -> ok - end, + file_close(Fd), progress_report({transfer_size, 0}, State), activate_ctrl_connection(State), {noreply, State#state{dsock = undefined, data = <<>>}}; @@ -2066,10 +2063,7 @@ handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) -> end; handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) -> - case file_close(Fd) of - ok -> ok; - {error, einval} -> ok - end, + file_close(Fd), close_data_connection(State), ctrl_result_response(Status, State#state{dsock = undefined}, {error, epath}); @@ -2345,7 +2339,7 @@ accept_data_connection(#state{mode = passive} = State) -> send_ctrl_message(_S=#state{csock = Socket, verbose = Verbose}, Message) -> verbose(lists:flatten(Message),Verbose,send), ?DBG('<--ctrl ~p ---- ~s~p~n',[Socket,Message,_S]), - ok = send_message(Socket, Message). + _ = send_message(Socket, Message). send_data_message(_S=#state{dsock = Socket}, Message) -> ?DBG('<==data ~p ==== ~s~n~p~n',[Socket,Message,_S]), @@ -2366,37 +2360,44 @@ send_message({tcp, Socket}, Message) -> send_message({ssl, Socket}, Message) -> ssl:send(Socket, Message). -activate_ctrl_connection(#state{csock = Socket, ctrl_data = {<<>>, _, _}}) -> - ok = activate_connection(Socket); -activate_ctrl_connection(#state{csock = Socket}) -> - ok = activate_connection(Socket), +activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) -> + activate_connection(CSock); +activate_ctrl_connection(#state{csock = CSock}) -> + activate_connection(CSock), %% We have already received at least part of the next control message, %% that has been saved in ctrl_data, process this first. - self() ! {socket_type(Socket), unwrap_socket(Socket), <<>>}, + self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>}, ok. +activate_data_connection(#state{dsock = DSock} = State) -> + activate_connection(DSock), + State. + +activate_connection(Socket) -> + ignore_return_value( + case socket_type(Socket) of + tcp -> inet:setopts(unwrap_socket(Socket), [{active, once}]); + ssl -> ssl:setopts(unwrap_socket(Socket), [{active, once}]) + end). + + +ignore_return_value(_) -> ok. + unwrap_socket({tcp,Socket}) -> Socket; unwrap_socket({ssl,Socket}) -> Socket. socket_type({tcp,_Socket}) -> tcp; socket_type({ssl,_Socket}) -> ssl. -activate_data_connection(#state{dsock = Socket} = State) -> - ok = activate_connection(Socket), - State. - -activate_connection({tcp, Socket}) -> inet:setopts(Socket, [{active, once}]); -activate_connection({ssl, Socket}) -> ssl:setopts(Socket, [{active, once}]). - close_ctrl_connection(#state{csock = undefined}) -> ok; close_ctrl_connection(#state{csock = Socket}) -> close_connection(Socket). close_data_connection(#state{dsock = undefined}) -> ok; close_data_connection(#state{dsock = Socket}) -> close_connection(Socket). -close_connection({lsock,Socket}) -> gen_tcp:close(Socket); -close_connection({tcp, Socket}) -> gen_tcp:close(Socket); -close_connection({ssl, Socket}) -> ssl:close(Socket). +close_connection({lsock,Socket}) -> ignore_return_value( gen_tcp:close(Socket) ); +close_connection({tcp, Socket}) -> ignore_return_value( gen_tcp:close(Socket) ); +close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ). %% ------------ FILE HANDLING ---------------------------------------- send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) -> @@ -2408,7 +2409,7 @@ send_file(State, Fd) -> progress_report({binary, Bin}, State), send_file(State, Fd); {ok, _, _} -> - ok = file_close(Fd), + file_close(Fd), close_data_connection(State), progress_report({transfer_size, 0}, State), activate_ctrl_connection(State), @@ -2423,7 +2424,7 @@ file_open(File, Option) -> file:open(File, [raw, binary, Option]). file_close(Fd) -> - file:close(Fd). + ignore_return_value( file:close(Fd) ). file_read(Fd) -> case file:read(Fd, ?FILE_BUFSIZE) of diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index 7e20a9ba67..82273c8c74 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -241,9 +241,9 @@ handle_info({tcp_closed, _}, State) -> handle_info({ssl_closed, _}, State) -> {stop, normal, State}; handle_info({tcp_error, _, _} = Reason, State) -> - {stop, Reason, State}; + {stop, {shutdown, Reason}, State}; handle_info({ssl_error, _, _} = Reason, State) -> - {stop, Reason, State}; + {stop, {shutdown, Reason}, State}; %% Timeouts handle_info(timeout, #state{mfa = {_, parse, _}} = State) -> diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 3a31daeb20..d28d4cd766 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,10 +18,14 @@ %% %CopyrightEnd% {"%VSN%", [ + {<<"6.2.4">>, [{load_module, httpd_request_handler, + soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ + {<<"6.2.4">>, [{load_module, httpd_request_handler, + soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index eef5abd610..9591ab22ed 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.3.4 +INETS_VSN = 6.3.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 0db3aa50c5..b342fff0d3 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -19,7 +19,7 @@ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. - + </legalnotice> <title>kernel</title> @@ -58,6 +58,60 @@ </section> <section> + <title>OS Signal Event Handler</title> + <p>Asynchronous OS signals may be subscribed to via the Kernel applications event manager + (see <seealso marker="doc/design_principles:des_princ">OTP Design Principles</seealso> and + <seealso marker="stdlib:gen_event"><c>gen_event(3)</c></seealso>) registered as <c>erl_signal_server</c>. + A default signal handler is installed which handles the following signals:</p> + <taglist> + <tag><c>sigusr1</c></tag> + <item><p>The default handler will halt Erlang and produce a crashdump + with slogan "Received SIGUSR1". + This is equivalent to calling <c>erlang:halt("Received SIGUSR1")</c>. + </p></item> + + <tag><c>sigquit</c></tag> + <item><p>The default handler will halt Erlang immediately. + This is equivalent to calling <c>erlang:halt()</c>. + </p></item> + + <tag><c>sigterm</c></tag> + <item><p>The default handler will terminate Erlang normally. + This is equivalent to calling <c>init:stop()</c>. + </p></item> + </taglist> + + <section> + <title>Events</title> + <p>Any event handler added to <c>erl_signal_server</c> must handle the following events.</p> + <taglist> + <tag><c>sighup</c></tag> + <item><p>Hangup detected on controlling terminal or death of controlling process</p></item> + <tag><c>sigquit</c></tag> + <item><p>Quit from keyboard</p></item> + <tag><c>sigabrt</c></tag> + <item><p>Abort signal from abort</p></item> + <tag><c>sigalrm</c></tag> + <item><p>Timer signal from alarm</p></item> + <tag><c>sigterm</c></tag> + <item><p>Termination signal</p></item> + <tag><c>sigusr1</c></tag> + <item><p>User-defined signal 1</p></item> + <tag><c>sigusr2</c></tag> + <item><p>User-defined signal 2</p></item> + <tag><c>sigchld</c></tag> + <item><p>Child process stopped or terminated</p></item> + <tag><c>sigstop</c></tag> + <item><p>Stop process</p></item> + <tag><c>sigtstp</c></tag> + <item><p>Stop typed at terminal</p></item> + </taglist> + + <p>Setting OS signals are described in <seealso marker="os#set_signal/2"><c>os:set_signal/2</c></seealso>.</p> + </section> + </section> + + <section> <title>Configuration</title> <p>The following configuration parameters are defined for the Kernel application. For more information about configuration parameters, @@ -427,4 +481,3 @@ MaxT = TickTime + TickTime / 4</code> <seealso marker="stdlib:timer"><c>timer(3)</c></seealso></p> </section> </appref> - diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 739ac35d2a..6ba69d12a3 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -19,7 +19,7 @@ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. - + </legalnotice> <title>os</title> @@ -156,6 +156,32 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> </func> <func> + <name name="set_signal" arity="2"/> + <fsummary>Enables or disables handling of OS signals.</fsummary> + <desc> + <p>Enables or disables OS signals.</p> + <p>Each signal my be set to one of the following options:</p> + <taglist> + <tag><c>ignore</c></tag> + <item> + This signal will be ignored. + </item> + + <tag><c>default</c></tag> + <item> + This signal will use the default signal handler for the operating system. + </item> + + <tag><c>handle</c></tag> + <item> + This signal will notify <c>erl_signal_server</c> when it is received by + the Erlang runtime system. + </item> + </taglist> + </desc> + </func> + + <func> <name name="system_time" arity="0"/> <fsummary>Current OS system time.</fsummary> <desc> @@ -296,4 +322,3 @@ calendar:now_to_universal_time(TS), </func> </funcs> </erlref> - diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 2b72f78dcf..2a89faaf13 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -71,6 +71,7 @@ MODULES = \ erl_distribution \ erl_epmd \ erl_reply \ + erl_signal_handler \ erts_debug \ error_handler \ error_logger \ diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 5a7ca493cc..2a06d0cb15 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -489,13 +489,13 @@ prepare_check_uniq_1([], [_|_]=Errors) -> {error,Errors}. partition_on_load(Prep) -> - P = fun({_,{Bin,_,_}}) -> - erlang:has_prepared_code_on_load(Bin) + P = fun({_,{PC,_,_}}) -> + erlang:has_prepared_code_on_load(PC) end, lists:partition(P, Prep). verify_prepared([{M,{Prep,Name,_Native}}|T]) - when is_atom(M), is_binary(Prep), is_list(Name) -> + when is_atom(M), is_list(Name) -> try erlang:has_prepared_code_on_load(Prep) of false -> verify_prepared(T); @@ -562,10 +562,10 @@ prepare_loading_fun() -> GetNative = get_native_fun(), fun(Mod, FullName, Beam) -> case erlang:prepare_loading(Mod, Beam) of - Prepared when is_binary(Prepared) -> - {ok,{Prepared,FullName,GetNative(Beam)}}; {error,_}=Error -> - Error + Error; + Prepared -> + {ok,{Prepared,FullName,GetNative(Beam)}} end end. diff --git a/lib/kernel/src/erl_signal_handler.erl b/lib/kernel/src/erl_signal_handler.erl new file mode 100644 index 0000000000..8f924d2adc --- /dev/null +++ b/lib/kernel/src/erl_signal_handler.erl @@ -0,0 +1,57 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(erl_signal_handler). +-behaviour(gen_event). +-export([init/1, format_status/2, + handle_event/2, handle_call/2, handle_info/2, + terminate/2, code_change/3]). + +-record(state,{}). + +init(_Args) -> + {ok, #state{}}. + +handle_event(sigusr1, S) -> + erlang:halt("Received SIGUSR1"), + {ok, S}; +handle_event(sigquit, S) -> + erlang:halt(), + {ok, S}; +handle_event(sigterm, S) -> + error_logger:info_msg("SIGTERM received - shutting down~n"), + ok = init:stop(), + {ok, S}; +handle_event(_SignalMsg, S) -> + {ok, S}. + +handle_info(_Info, S) -> + {ok, S}. + +handle_call(_Request, S) -> + {ok, ok, S}. + +format_status(_Opt, [_Pdict,_S]) -> + ok. + +code_change(_OldVsn, S, _Extra) -> + {ok, S}. + +terminate(_Args, _S) -> + ok. diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index 3523f680a3..3ee8e2c6e6 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -360,8 +360,12 @@ init(Max) when is_integer(Max) -> %% go back. init({go_back, _PostState}) -> {ok, {?buffer_size, 0, []}}; -init(_) -> %% Start and just relay to other - {ok, []}. %% node if node(GLeader) =/= node(). +init(_) -> + %% The error logger process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + process_flag(message_queue_data, off_heap), + {ok, []}. -spec handle_event(term(), state()) -> {'ok', state()}. diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 1971df9038..79e72cdc6d 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1424,7 +1424,7 @@ path_open_first([Path|Rest], Name, Mode, LastError) -> case open(FileName, Mode) of {ok, Fd} -> {ok, Fd, FileName}; - {error, enoent} -> + {error, Reason} when Reason =:= enoent; Reason =:= enotdir -> path_open_first(Rest, Name, Mode, LastError); Error -> Error diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 4d08a55c7c..25e4ddd95c 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -34,6 +34,7 @@ erl_boot_server, erl_distribution, erl_reply, + erl_signal_handler, error_handler, error_logger, file, diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 3d0ef81318..59eca242b1 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -32,6 +32,14 @@ start(_, []) -> case supervisor:start_link({local, kernel_sup}, kernel, []) of {ok, Pid} -> + %% add signal handler + case whereis(erl_signal_server) of + %% in case of minimal mode + undefined -> ok; + _ -> + ok = gen_event:add_handler(erl_signal_server, erl_signal_handler, []) + end, + %% add error handler Type = get_error_logger_type(), case error_logger:swap_handler(Type) of ok -> {ok, Pid, []}; @@ -131,6 +139,9 @@ init([]) -> permanent, 2000, worker, [inet_db]}, NetSup = {net_sup, {erl_distribution, start_link, []}, permanent, infinity, supervisor,[erl_distribution]}, + SigSrv = #{id => erl_signal_server, + start => {gen_event, start_link, [{local, erl_signal_server}]}, + type => worker, restart => permanent, shutdown => 2000, modules => dynamic}, DistAC = start_dist_ac(), Timer = start_timer(), @@ -141,7 +152,7 @@ init([]) -> permanent, infinity, supervisor, [?MODULE]}, {ok, {SupFlags, [Code, Rpc, Global, InetDb | DistAC] ++ - [NetSup, Glo_grp, File, + [NetSup, Glo_grp, File, SigSrv, StdError, User, Config, SafeSupervisor] ++ Timer}} end; init(safe) -> diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index f8519d3a5e..c3ffcb3f70 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -29,7 +29,7 @@ -export([getenv/0, getenv/1, getenv/2, getpid/0, perf_counter/0, perf_counter/1, - putenv/2, system_time/0, system_time/1, + putenv/2, set_signal/2, system_time/0, system_time/1, timestamp/0, unsetenv/1]). -spec getenv() -> [string()]. @@ -104,6 +104,15 @@ timestamp() -> unsetenv(_) -> erlang:nif_error(undef). +-spec set_signal(Signal, Option) -> 'ok' when + Signal :: 'sighup' | 'sigquit' | 'sigabrt' | 'sigalrm' | + 'sigterm' | 'sigusr1' | 'sigusr2' | 'sigchld' | + 'sigstop' | 'sigtstp', + Option :: 'default' | 'handle' | 'ignore'. + +set_signal(_Signal, _Option) -> + erlang:nif_error(undef). + %%% End of BIFs -spec type() -> {Osfamily, Osname} when diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index 21bff02214..bd6ea26678 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -67,17 +67,27 @@ %%------------------------------------------------------------------------ + +%% The rex server may receive a huge amount of +%% messages. Make sure that they are stored off heap to +%% avoid exessive GCs. + +-define(SPAWN_OPTS, [{spawn_opt,[{message_queue_data,off_heap}]}]). + %% Remote execution and broadcasting facility -spec start() -> {'ok', pid()} | 'ignore' | {'error', term()}. start() -> - gen_server:start({local,?NAME}, ?MODULE, [], []). + gen_server:start({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS). -spec start_link() -> {'ok', pid()} | 'ignore' | {'error', term()}. start_link() -> - gen_server:start_link({local,?NAME}, ?MODULE, [], []). + %% The rex server process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + gen_server:start_link({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS). -spec stop() -> term(). diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 4914ce9e4c..f368232bfc 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -323,7 +323,7 @@ load_abs(Config) when is_list(Config) -> {error, nofile} = code:load_abs(TestDir ++ "/duuuumy_mod"), {error, badfile} = code:load_abs(TestDir ++ "/code_a_test"), {'EXIT', _} = (catch code:load_abs({})), - {'EXIT', _} = (catch code:load_abs("Non-latin-имя-файла")), + {error, nofile} = code:load_abs("Non-latin-имя-файла"), {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), code:stick_dir(TestDir), {error, sticky_directory} = code:load_abs(TestDir ++ "/code_b_test"), diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl index b6e7551741..bb01c2384d 100644 --- a/lib/kernel/test/error_logger_SUITE.erl +++ b/lib/kernel/test/error_logger_SUITE.erl @@ -30,6 +30,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, + off_heap/1, error_report/1, info_report/1, error/1, info/1, emulator/1, tty/1, logfile/1, add/1, delete/1]). @@ -45,7 +46,7 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [error_report, info_report, error, info, emulator, tty, + [off_heap, error_report, info_report, error, info, emulator, tty, logfile, add, delete]. groups() -> @@ -66,6 +67,16 @@ end_per_group(_GroupName, Config) -> %%----------------------------------------------------------------- +off_heap(_Config) -> + %% The error_logger process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + MQD = message_queue_data, + {MQD,off_heap} = process_info(whereis(error_logger), MQD), + ok. + +%%----------------------------------------------------------------- + error_report(Config) when is_list(Config) -> error_logger:add_report_handler(?MODULE, self()), Rep1 = [{tag1,"data1"},{tag2,data2},{tag3,3}], diff --git a/lib/kernel/test/multi_load_SUITE.erl b/lib/kernel/test/multi_load_SUITE.erl index 369e25ac64..920839f4f9 100644 --- a/lib/kernel/test/multi_load_SUITE.erl +++ b/lib/kernel/test/multi_load_SUITE.erl @@ -144,14 +144,14 @@ prep_magic([H|T]) -> prep_magic(Tuple) when is_tuple(Tuple) -> L = prep_magic(tuple_to_list(Tuple)), list_to_tuple(L); -prep_magic(Bin) when is_binary(Bin) -> - try erlang:has_prepared_code_on_load(Bin) of +prep_magic(Ref) when is_reference(Ref) -> + try erlang:has_prepared_code_on_load(Ref) of false -> - %% Create a different kind of magic binary. + %% Create a different kind of magic ref. ets:match_spec_compile([{'_',[true],['$_']}]) catch _:_ -> - Bin + Ref end; prep_magic(Other) -> Other. diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl index 1c72ddc87f..d76c4097d8 100644 --- a/lib/kernel/test/rpc_SUITE.erl +++ b/lib/kernel/test/rpc_SUITE.erl @@ -21,7 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). --export([call/1, block_call/1, multicall/1, multicall_timeout/1, +-export([off_heap/1, + call/1, block_call/1, multicall/1, multicall_timeout/1, multicall_dies/1, multicall_node_dies/1, called_dies/1, called_node_dies/1, called_throws/1, call_benchmark/1, async_call/1]). @@ -35,7 +36,7 @@ suite() -> {timetrap,{minutes,2}}]. all() -> - [call, block_call, multicall, multicall_timeout, + [off_heap, call, block_call, multicall, multicall_timeout, multicall_dies, multicall_node_dies, called_dies, called_node_dies, called_throws, call_benchmark, async_call]. @@ -55,6 +56,13 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +off_heap(_Config) -> + %% The rex server process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + MQD = message_queue_data, + {MQD,off_heap} = process_info(whereis(rex), MQD), + ok. %% Test different rpc calls. diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 51c98d0d3e..9f59759cb6 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -39,7 +39,23 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.14.2</title> + <section><title>Mnesia 4.14.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed crash in checkpoint handling when table was deleted + during backup.</p> + <p> + Own Id: OTP-14167</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.14.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl index 9eb939e8d3..fc626940b4 100644 --- a/lib/mnesia/src/mnesia_checkpoint.erl +++ b/lib/mnesia/src/mnesia_checkpoint.erl @@ -909,7 +909,7 @@ retainer_loop(Cp = #checkpoint_args{name=Name}) -> retainer_loop(Cp2); {From, {iter_end, Iter}} -> - retainer_fixtable(Iter#iter.oid_tab, false), + ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)), Iters = Cp#checkpoint_args.iterators -- [Iter], reply(From, Name, ok), retainer_loop(Cp#checkpoint_args{iterators = Iters}); @@ -971,7 +971,8 @@ do_stop(Cp) -> unset({checkpoint, Name}), lists:foreach(fun deactivate_tab/1, Cp#checkpoint_args.retainers), Iters = Cp#checkpoint_args.iterators, - lists:foreach(fun(I) -> retainer_fixtable(I#iter.oid_tab, false) end, Iters). + [?SAFE(retainer_fixtable(Tab, false)) || #iter{main_tab=Tab} <- Iters], + ok. deactivate_tab(R) -> Name = R#retainer.cp_name, @@ -1151,7 +1152,7 @@ do_change_copy(Cp, Tab, FromType, ToType) -> Cp#checkpoint_args{retainers = Rs, nodes = writers(Rs)}. check_iter(From, Iter) when Iter#iter.pid == From -> - retainer_fixtable(Iter#iter.oid_tab, false), + ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)), false; check_iter(_From, _Iter) -> true. diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index 7320d381ea..6f7531245f 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -114,7 +114,8 @@ handle_table_event({Oper, Record, TransId}, State) -> handle_system_event({mnesia_checkpoint_activated, _Checkpoint}, State) -> {ok, State}; -handle_system_event({mnesia_checkpoint_deactivated, _Checkpoint}, State) -> +handle_system_event({mnesia_checkpoint_deactivated, Checkpoint}, State) -> + report_error("Checkpoint '~p' has been deactivated, last table copy deleted.\n",[Checkpoint]), {ok, State}; handle_system_event({mnesia_up, Node}, State) -> diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl index e745ec9b04..044cf501fd 100644 --- a/lib/mnesia/test/mnesia_evil_backup.erl +++ b/lib/mnesia/test/mnesia_evil_backup.erl @@ -723,18 +723,18 @@ bup_records(File, Mod) -> exit(Reason) end. -sops_with_checkpoint(doc) -> +sops_with_checkpoint(doc) -> ["Test schema operations during a checkpoint"]; sops_with_checkpoint(suite) -> []; sops_with_checkpoint(Config) when is_list(Config) -> - Ns = ?acquire_nodes(2, Config), - + Ns = [N1,N2] = ?acquire_nodes(2, Config), + ?match({ok, cp1, Ns}, mnesia:activate_checkpoint([{name, cp1},{max,mnesia:system_info(tables)}])), - Tab = tab, + Tab = tab, ?match({atomic, ok}, mnesia:create_table(Tab, [{disc_copies,Ns}])), OldRecs = [{Tab, K, -K} || K <- lists:seq(1, 5)], [mnesia:dirty_write(R) || R <- OldRecs], - + ?match({ok, cp2, Ns}, mnesia:activate_checkpoint([{name, cp2},{max,mnesia:system_info(tables)}])), File1 = "cp1_delete_me.BUP", ?match(ok, mnesia:dirty_write({Tab,6,-6})), @@ -742,16 +742,16 @@ sops_with_checkpoint(Config) when is_list(Config) -> ?match(ok, mnesia:dirty_write({Tab,7,-7})), File2 = "cp2_delete_me.BUP", ?match(ok, mnesia:backup_checkpoint(cp2, File2)), - + ?match(ok, mnesia:deactivate_checkpoint(cp1)), ?match(ok, mnesia:backup_checkpoint(cp2, File1)), ?match(ok, mnesia:dirty_write({Tab,8,-8})), - + ?match({atomic,ok}, mnesia:delete_table(Tab)), ?match({error,_}, mnesia:backup_checkpoint(cp2, File2)), ?match({'EXIT',_}, mnesia:dirty_write({Tab,9,-9})), - ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])), + ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])), Test = fun(N) when N > 5 -> ?error("To many records in backup ~p ~n", [N]); (N) -> case mnesia:dirty_read(Tab,N) of [{Tab,N,B}] when -B =:= N -> ok; @@ -759,8 +759,29 @@ sops_with_checkpoint(Config) when is_list(Config) -> end end, [Test(N) || N <- mnesia:dirty_all_keys(Tab)], - ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])), - + ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])), + + %% Mnesia crashes when deleting a table during backup + ?match([], mnesia_test_lib:stop_mnesia([N2])), + Tab2 = ram, + ?match({atomic, ok}, mnesia:create_table(Tab2, [{ram_copies,[N1]}])), + ?match({ok, cp3, _}, mnesia:activate_checkpoint([{name, cp3}, + {ram_overrides_dump,true}, + {min,[Tab2]}])), + Write = fun Loop (N) -> + case N > 0 of + true -> + mnesia:dirty_write({Tab2, N+100, N+100}), + Loop(N-1); + false -> + ok + end + end, + ok = Write(100000), + spawn_link(fun() -> ?match({atomic, ok},mnesia:delete_table(Tab2)) end), + + %% We don't check result here, depends on timing of above call + mnesia:backup_checkpoint(cp3, File2), file:delete(File1), file:delete(File2), - ?verify_mnesia(Ns, []). + ?verify_mnesia([N1], [N2]). diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 439b21e58c..e272a469bb 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.14.2 +MNESIA_VSN = 4.14.3 diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index 0cea1fdcf0..200c728a62 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -58,7 +58,7 @@ binary_to_term_fun(Bin) -> try binary_to_term(Bin) of Term -> plain_html(io_lib:format("~p",[Term])) catch error:badarg -> - Warning = "This binary can not be coverted to an Erlang term", + Warning = "This binary can not be converted to an Erlang term", observer_html_lib:warning(Warning) end end. diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml index 5cc4c24889..5f710decc1 100644 --- a/lib/ssh/doc/src/ssh_app.xml +++ b/lib/ssh/doc/src/ssh_app.xml @@ -146,7 +146,10 @@ <item>diffie-hellman-group-exchange-sha1</item> <item>diffie-hellman-group-exchange-sha256</item> <item>diffie-hellman-group14-sha1</item> - <item>diffie-hellman-group1-sha1</item> + <item>diffie-hellman-group14-sha256</item> + <item>diffie-hellman-group16-sha512</item> + <item>diffie-hellman-group18-sha512</item> + <item>(diffie-hellman-group1-sha1, retired: can be enabled with the <c>preferred_algorithms</c> option)</item> </list> </item> @@ -157,7 +160,7 @@ <item>ecdsa-sha2-nistp384</item> <item>ecdsa-sha2-nistp521</item> <item>ssh-rsa</item> - <item>ssh-dss</item> + <item>(ssh-dss, retired: can be enabled with the <c>preferred_algorithms</c> option)</item> </list> </item> @@ -306,6 +309,8 @@ <p>Comment: Defines hmac-sha2-256 and hmac-sha2-512 </p> </item> + + <item>Work in progress: <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-kex-sha2">https://tools.ietf.org/html/draft-ietf-curdle-ssh-kex-sha2-05</url>, Key Exchange (KEX) Method Updates and Recommendations for Secure Shell (SSH)</item> </list> diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 76b7d8cd55..2bb7491b0c 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -48,4 +48,3 @@ "stdlib-3.1" ]}]}. - diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 8718e92fa2..dcf509ca09 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -609,13 +609,15 @@ handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> %%%---- diffie-hellman group exchange handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), send_bytes(GexGroup, D), + Ssh = ssh_transport:parallell_gen_key(Ssh1), {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), send_bytes(GexGroup, D), + Ssh = ssh_transport:parallell_gen_key(Ssh1), {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) -> @@ -1479,31 +1481,36 @@ renegotiation(_) -> false. %%-------------------------------------------------------------------- supported_host_keys(client, _, Options) -> try - case proplists:get_value(public_key, - proplists:get_value(preferred_algorithms,Options,[]) - ) of - undefined -> - ssh_transport:default_algorithms(public_key); - L -> - L -- (L--ssh_transport:default_algorithms(public_key)) - end + find_sup_hkeys(Options) of [] -> - {stop, {shutdown, "No public key algs"}}; + error({shutdown, "No public key algs"}); Algs -> [atom_to_list(A) || A<-Algs] catch exit:Reason -> - {stop, {shutdown, Reason}} + error({shutdown, Reason}) end; supported_host_keys(server, KeyCb, Options) -> - [atom_to_list(A) || A <- proplists:get_value(public_key, - proplists:get_value(preferred_algorithms,Options,[]), - ssh_transport:default_algorithms(public_key) - ), + [atom_to_list(A) || A <- find_sup_hkeys(Options), available_host_key(KeyCb, A, Options) ]. + +find_sup_hkeys(Options) -> + case proplists:get_value(public_key, + proplists:get_value(preferred_algorithms,Options,[]) + ) + of + undefined -> + ssh_transport:default_algorithms(public_key); + L -> + NonSupported = L--ssh_transport:supported_algorithms(public_key), + L -- NonSupported + end. + + + %% Alg :: atom() available_host_key(KeyCb, Alg, Opts) -> element(1, catch KeyCb:host_key(Alg, Opts)) == ok. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 37ec984237..5d178a202d 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -44,6 +44,7 @@ handle_kexdh_reply/2, handle_kex_ecdh_init/2, handle_kex_ecdh_reply/2, + parallell_gen_key/1, extract_public_key/1, ssh_packet/2, pack/2, sha/1, sign/3, verify/4]). @@ -78,6 +79,10 @@ default_algorithms() -> [{K,default_algorithms(K)} || K <- algo_classes()]. algo_classes() -> [kex, public_key, cipher, mac, compression]. +default_algorithms(kex) -> + supported_algorithms(kex, [ + 'diffie-hellman-group1-sha1' % Gone in OpenSSH 7.3.p1 + ]); default_algorithms(cipher) -> supported_algorithms(cipher, same(['AEAD_AES_128_GCM', @@ -94,34 +99,39 @@ supported_algorithms() -> [{K,supported_algorithms(K)} || K <- algo_classes()]. supported_algorithms(kex) -> select_crypto_supported( [ - {'ecdh-sha2-nistp256', [{public_keys,ecdh}, {ec_curve,secp256r1}, {hashs,sha256}]}, {'ecdh-sha2-nistp384', [{public_keys,ecdh}, {ec_curve,secp384r1}, {hashs,sha384}]}, - {'diffie-hellman-group14-sha1', [{public_keys,dh}, {hashs,sha}]}, + {'ecdh-sha2-nistp521', [{public_keys,ecdh}, {ec_curve,secp521r1}, {hashs,sha512}]}, + {'ecdh-sha2-nistp256', [{public_keys,ecdh}, {ec_curve,secp256r1}, {hashs,sha256}]}, {'diffie-hellman-group-exchange-sha256', [{public_keys,dh}, {hashs,sha256}]}, + {'diffie-hellman-group16-sha512', [{public_keys,dh}, {hashs,sha512}]}, % In OpenSSH 7.3.p1 + {'diffie-hellman-group18-sha512', [{public_keys,dh}, {hashs,sha512}]}, % In OpenSSH 7.3.p1 + {'diffie-hellman-group14-sha256', [{public_keys,dh}, {hashs,sha256}]}, % In OpenSSH 7.3.p1 + {'diffie-hellman-group14-sha1', [{public_keys,dh}, {hashs,sha}]}, {'diffie-hellman-group-exchange-sha1', [{public_keys,dh}, {hashs,sha}]}, - {'ecdh-sha2-nistp521', [{public_keys,ecdh}, {ec_curve,secp521r1}, {hashs,sha512}]}, {'diffie-hellman-group1-sha1', [{public_keys,dh}, {hashs,sha}]} ]); supported_algorithms(public_key) -> select_crypto_supported( - [{'ecdsa-sha2-nistp256', [{public_keys,ecdsa}, {hashs,sha256}, {ec_curve,secp256r1}]}, + [ {'ecdsa-sha2-nistp384', [{public_keys,ecdsa}, {hashs,sha384}, {ec_curve,secp384r1}]}, {'ecdsa-sha2-nistp521', [{public_keys,ecdsa}, {hashs,sha512}, {ec_curve,secp521r1}]}, + {'ecdsa-sha2-nistp256', [{public_keys,ecdsa}, {hashs,sha256}, {ec_curve,secp256r1}]}, {'ssh-rsa', [{public_keys,rsa}, {hashs,sha} ]}, - {'ssh-dss', [{public_keys,dss}, {hashs,sha} ]} + {'ssh-dss', [{public_keys,dss}, {hashs,sha} ]} % Gone in OpenSSH 7.3.p1 ]); supported_algorithms(cipher) -> same( select_crypto_supported( - [{'aes256-ctr', [{ciphers,{aes_ctr,256}}]}, - {'aes192-ctr', [{ciphers,{aes_ctr,192}}]}, - {'aes128-ctr', [{ciphers,{aes_ctr,128}}]}, - {'aes128-cbc', [{ciphers,aes_cbc128}]}, + [ + {'[email protected]', [{ciphers,{aes_gcm,256}}]}, + {'aes256-ctr', [{ciphers,{aes_ctr,256}}]}, + {'aes192-ctr', [{ciphers,{aes_ctr,192}}]}, {'[email protected]', [{ciphers,{aes_gcm,128}}]}, - {'[email protected]', [{ciphers,{aes_gcm,256}}]}, - {'AEAD_AES_128_GCM', [{ciphers,{aes_gcm,128}}]}, + {'aes128-ctr', [{ciphers,{aes_ctr,128}}]}, {'AEAD_AES_256_GCM', [{ciphers,{aes_gcm,256}}]}, + {'AEAD_AES_128_GCM', [{ciphers,{aes_gcm,128}}]}, + {'aes128-cbc', [{ciphers,aes_cbc128}]}, {'3des-cbc', [{ciphers,des3_cbc}]} ] )); @@ -274,11 +284,12 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, true -> key_exchange_first_msg(Algoritms#alg.kex, Ssh0#ssh{algorithms = Algoritms}); - _ -> + {false,Alg} -> %% TODO: Correct code? ssh_connection_handler:disconnect( #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Selection of key exchange algorithm failed" + description = "Selection of key exchange algorithm failed: " + ++ Alg }) end; @@ -288,45 +299,63 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, case verify_algorithm(Algoritms) of true -> {ok, Ssh#ssh{algorithms = Algoritms}}; - _ -> + {false,Alg} -> ssh_connection_handler:disconnect( #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Selection of key exchange algorithm failed" + description = "Selection of key exchange algorithm failed: " + ++ Alg }) end. -%% TODO: diffie-hellman-group14-sha1 should also be supported. -%% Maybe check more things ... - -verify_algorithm(#alg{kex = undefined}) -> false; -verify_algorithm(#alg{hkey = undefined}) -> false; -verify_algorithm(#alg{send_mac = undefined}) -> false; -verify_algorithm(#alg{recv_mac = undefined}) -> false; -verify_algorithm(#alg{encrypt = undefined}) -> false; -verify_algorithm(#alg{decrypt = undefined}) -> false; -verify_algorithm(#alg{compress = undefined}) -> false; -verify_algorithm(#alg{decompress = undefined}) -> false; -verify_algorithm(#alg{kex = Kex}) -> lists:member(Kex, supported_algorithms(kex)). +verify_algorithm(#alg{kex = undefined}) -> {false, "kex"}; +verify_algorithm(#alg{hkey = undefined}) -> {false, "hkey"}; +verify_algorithm(#alg{send_mac = undefined}) -> {false, "send_mac"}; +verify_algorithm(#alg{recv_mac = undefined}) -> {false, "recv_mac"}; +verify_algorithm(#alg{encrypt = undefined}) -> {false, "encrypt"}; +verify_algorithm(#alg{decrypt = undefined}) -> {false, "decrypt"}; +verify_algorithm(#alg{compress = undefined}) -> {false, "compress"}; +verify_algorithm(#alg{decompress = undefined}) -> {false, "decompress"}; +verify_algorithm(#alg{kex = Kex}) -> + case lists:member(Kex, supported_algorithms(kex)) of + true -> true; + false -> {false, "kex"} + end. %%%---------------------------------------------------------------- %%% %%% Key exchange initialization %%% key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group1-sha1' ; - Kex == 'diffie-hellman-group14-sha1' -> + Kex == 'diffie-hellman-group14-sha1' ; + Kex == 'diffie-hellman-group14-sha256' ; + Kex == 'diffie-hellman-group16-sha512' ; + Kex == 'diffie-hellman-group18-sha512' + -> {G, P} = dh_group(Kex), - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Ssh0#ssh.algorithms), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_init{e = Public}, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}}; key_exchange_first_msg(Kex, Ssh0=#ssh{opts=Opts}) when Kex == 'diffie-hellman-group-exchange-sha1' ; Kex == 'diffie-hellman-group-exchange-sha256' -> - {Min,NBits,Max} = + {Min,NBits0,Max} = proplists:get_value(dh_gex_limits, Opts, {?DEFAULT_DH_GROUP_MIN, ?DEFAULT_DH_GROUP_NBITS, ?DEFAULT_DH_GROUP_MAX}), + DhBits = dh_bits(Ssh0#ssh.algorithms), + NBits1 = + %% NIST Special Publication 800-57 Part 1 Revision 4: Recommendation for Key Management + if + DhBits =< 112 -> 2048; + DhBits =< 128 -> 3072; + DhBits =< 192 -> 7680; + true -> 8192 + end, + NBits = min(max(max(NBits0,NBits1),Min), Max), + {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_dh_gex_request{min = Min, n = NBits, @@ -348,14 +377,18 @@ key_exchange_first_msg(Kex, Ssh0) when Kex == 'ecdh-sha2-nistp256' ; %%% %%% diffie-hellman-group1-sha1 %%% diffie-hellman-group14-sha1 +%%% diffie-hellman-group14-sha256 +%%% diffie-hellman-group16-sha512 +%%% diffie-hellman-group18-sha512 %%% handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, - Ssh0 = #ssh{algorithms = #alg{kex=Kex}}) -> + Ssh0 = #ssh{algorithms = #alg{kex=Kex} = Algs}) -> %% server {G, P} = dh_group(Kex), if 1=<E, E=<(P-1) -> - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Algs), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), K = compute_key(dh, E, Private, [P,G]), MyPrivHostKey = get_host_key(Ssh0), MyPubHostKey = extract_public_key(MyPrivHostKey), @@ -426,12 +459,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0, {Min, Max} = adjust_gex_min_max(Min0, Max0, Opts), case public_key:dh_gex_group(Min, NBits, Max, proplists:get_value(dh_gex_groups,Opts)) of - {ok, {_Sz, {G,P}}} -> - {Public, Private} = generate_key(dh, [P,G]), + {ok, {_, {G,P}}} -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), {ok, SshPacket, - Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}, + Ssh#ssh{keyex_key = {x, {G, P}}, keyex_info = {Min0, Max0, NBits} }}; {error,_} -> @@ -461,12 +493,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, {Min, Max} = adjust_gex_min_max(Min0, Max0, Opts), case public_key:dh_gex_group(Min, NBits, Max, proplists:get_value(dh_gex_groups,Opts)) of - {ok, {_Sz, {G,P}}} -> - {Public, Private} = generate_key(dh, [P,G]), + {ok, {_, {G,P}}} -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), {ok, SshPacket, - Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}, + Ssh#ssh{keyex_key = {x, {G, P}}, keyex_info = {-1, -1, NBits} % flag for kex_h hash calc }}; {error,_} -> @@ -507,7 +538,8 @@ adjust_gex_min_max(Min0, Max0, Opts) -> handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) -> %% client - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Ssh0#ssh.algorithms), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0), % Pub = G^Priv mod P (def) @@ -746,9 +778,8 @@ accepted_host(Ssh, PeerName, Public, Opts) -> yes == yes_no(Ssh, "New host " ++ PeerName ++ " accept") end. -known_host_key(#ssh{opts = Opts, key_cb = Mod, peer = Peer} = Ssh, +known_host_key(#ssh{opts = Opts, key_cb = Mod, peer = {PeerName,_}} = Ssh, Public, Alg) -> - PeerName = peer_name(Peer), case Mod:is_host_key(Public, PeerName, Alg, Opts) of true -> ok; @@ -1117,6 +1148,51 @@ verify(PlainText, Hash, Sig, Key) -> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Unit: bytes + +-record(cipher_data, { + key_bytes, + iv_bytes, + block_bytes + }). + +%%% Start of a more parameterized crypto handling. +cipher('AEAD_AES_128_GCM') -> + #cipher_data{key_bytes = 16, + iv_bytes = 12, + block_bytes = 16}; + +cipher('AEAD_AES_256_GCM') -> + #cipher_data{key_bytes = 32, + iv_bytes = 12, + block_bytes = 16}; + +cipher('3des-cbc') -> + #cipher_data{key_bytes = 24, + iv_bytes = 8, + block_bytes = 8}; + +cipher('aes128-cbc') -> + #cipher_data{key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes128-ctr') -> + #cipher_data{key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes192-ctr') -> + #cipher_data{key_bytes = 24, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes256-ctr') -> + #cipher_data{key_bytes = 32, + iv_bytes = 16, + block_bytes = 16}. + + encrypt_init(#ssh{encrypt = none} = Ssh) -> {ok, Ssh}; encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> @@ -1497,11 +1573,11 @@ send_mac_init(SSH) -> common -> case SSH#ssh.role of client -> - KeySize = mac_key_size(SSH#ssh.send_mac), + KeySize = 8*mac_key_bytes(SSH#ssh.send_mac), Key = hash(SSH, "E", KeySize), {ok, SSH#ssh { send_mac_key = Key }}; server -> - KeySize = mac_key_size(SSH#ssh.send_mac), + KeySize = 8*mac_key_bytes(SSH#ssh.send_mac), Key = hash(SSH, "F", KeySize), {ok, SSH#ssh { send_mac_key = Key }} end; @@ -1520,10 +1596,10 @@ recv_mac_init(SSH) -> common -> case SSH#ssh.role of client -> - Key = hash(SSH, "F", mac_key_size(SSH#ssh.recv_mac)), + Key = hash(SSH, "F", 8*mac_key_bytes(SSH#ssh.recv_mac)), {ok, SSH#ssh { recv_mac_key = Key }}; server -> - Key = hash(SSH, "E", mac_key_size(SSH#ssh.recv_mac)), + Key = hash(SSH, "E", 8*mac_key_bytes(SSH#ssh.recv_mac)), {ok, SSH#ssh { recv_mac_key = Key }} end; aead -> @@ -1549,48 +1625,27 @@ mac('hmac-sha2-256', Key, SeqNum, Data) -> mac('hmac-sha2-512', Key, SeqNum, Data) -> crypto:hmac(sha512, Key, [<<?UINT32(SeqNum)>>, Data]). -%% return N hash bytes (HASH) -hash(SSH, Char, Bits) -> - HASH = - case SSH#ssh.kex of - 'diffie-hellman-group1-sha1' -> - fun(Data) -> crypto:hash(sha, Data) end; - 'diffie-hellman-group14-sha1' -> - fun(Data) -> crypto:hash(sha, Data) end; - - 'diffie-hellman-group-exchange-sha1' -> - fun(Data) -> crypto:hash(sha, Data) end; - 'diffie-hellman-group-exchange-sha256' -> - fun(Data) -> crypto:hash(sha256, Data) end; - - 'ecdh-sha2-nistp256' -> - fun(Data) -> crypto:hash(sha256,Data) end; - 'ecdh-sha2-nistp384' -> - fun(Data) -> crypto:hash(sha384,Data) end; - 'ecdh-sha2-nistp521' -> - fun(Data) -> crypto:hash(sha512,Data) end; - _ -> - exit({bad_algorithm,SSH#ssh.kex}) - end, - hash(SSH, Char, Bits, HASH). -hash(_SSH, _Char, 0, _HASH) -> +%%%---------------------------------------------------------------- +%% return N hash bytes (HASH) +hash(_SSH, _Char, 0) -> <<>>; -hash(SSH, Char, N, HASH) -> -K = SSH#ssh.shared_secret, % K = ssh_bits:mpint(SSH#ssh.shared_secret), +hash(SSH, Char, N) -> + HashAlg = sha(SSH#ssh.kex), + K = SSH#ssh.shared_secret, H = SSH#ssh.exchanged_hash, - SessionID = SSH#ssh.session_id, - K1 = HASH([K, H, Char, SessionID]), + K1 = crypto:hash(HashAlg, [K, H, Char, SSH#ssh.session_id]), Sz = N div 8, - <<Key:Sz/binary, _/binary>> = hash(K, H, K1, N-128, HASH), + <<Key:Sz/binary, _/binary>> = hash(K, H, K1, N-128, HashAlg), Key. -hash(_K, _H, Ki, N, _HASH) when N =< 0 -> +hash(_K, _H, Ki, N, _HashAlg) when N =< 0 -> Ki; -hash(K, H, Ki, N, HASH) -> - Kj = HASH([K, H, Ki]), - hash(K, H, <<Ki/binary, Kj/binary>>, N-128, HASH). +hash(K, H, Ki, N, HashAlg) -> + Kj = crypto:hash(HashAlg, [K, H, Ki]), + hash(K, H, <<Ki/binary, Kj/binary>>, N-128, HashAlg). +%%%---------------------------------------------------------------- kex_h(SSH, Key, E, F, K) -> KeyBin = public_key:ssh_encode(Key, ssh2_pubkey), L = <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version), @@ -1633,20 +1688,28 @@ sha(secp384r1) -> sha384; sha(secp521r1) -> sha512; sha('diffie-hellman-group1-sha1') -> sha; sha('diffie-hellman-group14-sha1') -> sha; +sha('diffie-hellman-group14-sha256') -> sha256; +sha('diffie-hellman-group16-sha512') -> sha512; +sha('diffie-hellman-group18-sha512') -> sha512; sha('diffie-hellman-group-exchange-sha1') -> sha; sha('diffie-hellman-group-exchange-sha256') -> sha256; sha(?'secp256r1') -> sha(secp256r1); sha(?'secp384r1') -> sha(secp384r1); -sha(?'secp521r1') -> sha(secp521r1). - - -mac_key_size('hmac-sha1') -> 20*8; -mac_key_size('hmac-sha1-96') -> 20*8; -mac_key_size('hmac-md5') -> 16*8; -mac_key_size('hmac-md5-96') -> 16*8; -mac_key_size('hmac-sha2-256')-> 32*8; -mac_key_size('hmac-sha2-512')-> 512; -mac_key_size(none) -> 0. +sha(?'secp521r1') -> sha(secp521r1); +sha('ecdh-sha2-nistp256') -> sha(secp256r1); +sha('ecdh-sha2-nistp384') -> sha(secp384r1); +sha('ecdh-sha2-nistp521') -> sha(secp521r1). + + +mac_key_bytes('hmac-sha1') -> 20; +mac_key_bytes('hmac-sha1-96') -> 20; +mac_key_bytes('hmac-md5') -> 16; +mac_key_bytes('hmac-md5-96') -> 16; +mac_key_bytes('hmac-sha2-256')-> 32; +mac_key_bytes('hmac-sha2-512')-> 64; +mac_key_bytes('AEAD_AES_128_GCM') -> 0; +mac_key_bytes('AEAD_AES_256_GCM') -> 0; +mac_key_bytes(none) -> 0. mac_digest_size('hmac-sha1') -> 20; mac_digest_size('hmac-sha1-96') -> 12; @@ -1658,9 +1721,6 @@ mac_digest_size('AEAD_AES_128_GCM') -> 16; mac_digest_size('AEAD_AES_256_GCM') -> 16; mac_digest_size(none) -> 0. -peer_name({Host, _}) -> - Host. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% Diffie-Hellman utils @@ -1668,9 +1728,19 @@ peer_name({Host, _}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% dh_group('diffie-hellman-group1-sha1') -> ?dh_group1; -dh_group('diffie-hellman-group14-sha1') -> ?dh_group14. +dh_group('diffie-hellman-group14-sha1') -> ?dh_group14; +dh_group('diffie-hellman-group14-sha256') -> ?dh_group14; +dh_group('diffie-hellman-group16-sha512') -> ?dh_group16; +dh_group('diffie-hellman-group18-sha512') -> ?dh_group18. %%%---------------------------------------------------------------- +parallell_gen_key(Ssh = #ssh{keyex_key = {x, {G, P}}, + algorithms = Algs}) -> + Sz = dh_bits(Algs), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), + Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}}. + + generate_key(Algorithm, Args) -> {Public,Private} = crypto:generate_key(Algorithm, Args), {crypto:bytes_to_integer(Public), crypto:bytes_to_integer(Private)}. @@ -1681,6 +1751,15 @@ compute_key(Algorithm, OthersPublic, MyPrivate, Args) -> crypto:bytes_to_integer(Shared). +dh_bits(#alg{encrypt = Encrypt, + send_mac = SendMac}) -> + C = cipher(Encrypt), + 8 * lists:max([C#cipher_data.key_bytes, + C#cipher_data.block_bytes, + C#cipher_data.iv_bytes, + mac_key_bytes(SendMac) + ]). + ecdh_curve('ecdh-sha2-nistp256') -> secp256r1; ecdh_curve('ecdh-sha2-nistp384') -> secp384r1; ecdh_curve('ecdh-sha2-nistp521') -> secp521r1. diff --git a/lib/ssh/src/ssh_transport.hrl b/lib/ssh/src/ssh_transport.hrl index f91cb1dd63..19b3f5c437 100644 --- a/lib/ssh/src/ssh_transport.hrl +++ b/lib/ssh/src/ssh_transport.hrl @@ -112,7 +112,7 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% diffie-hellman-group1-sha1 | diffie-hellman-group14-sha1 +%% diffie-hellman-group*-sha* -define(SSH_MSG_KEXDH_INIT, 30). -define(SSH_MSG_KEXDH_REPLY, 31). @@ -238,4 +238,15 @@ -define(dh_group14, {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AACAA68FFFFFFFFFFFFFFFF}). +%%% rfc 3526, ch5 +%%% Size 4096-bit +-define(dh_group16, + {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B2699C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C934063199FFFFFFFFFFFFFFFF}). + +%%% rfc 3526, ch7 +%%% Size 8192-bit +-define(dh_group18, + {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B2699C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C93402849236C3FAB4D27C7026C1D4DCB2602646DEC9751E763DBA37BDF8FF9406AD9E530EE5DB382F413001AEB06A53ED9027D831179727B0865A8918DA3EDBEBCF9B14ED44CE6CBACED4BB1BDB7F1447E6CC254B332051512BD7AF426FB8F401378CD2BF5983CA01C64B92ECF032EA15D1721D03F482D7CE6E74FEF6D55E702F46980C82B5A84031900B1C9E59E7C97FBEC7E8F323A97A7E36CC88BE0F1D45B7FF585AC54BD407B22B4154AACC8F6D7EBF48E1D814CC5ED20F8037E0A79715EEF29BE32806A1D58BB7C5DA76F550AA3D8A1FBFF0EB19CCB1A313D55CDA56C9EC2EF29632387FE8D76E3C0468043E8F663F4860EE12BF2D5B0B7474D6E694F91E6DBE115974A3926F12FEE5E438777CB6A932DF8CD8BEC4D073B931BA3BC832B68D9DD300741FA7BF8AFC47ED2576F6936BA424663AAB639C5AE4F5683423B4742BF1C978238F16CBE39D652DE3FDB8BEFC848AD922222E04A4037C0713EB57A81A23F0C73473FC646CEA306B4BCBC8862F8385DDFA9D4B7FA2C087E879683303ED5BDD3A062B3CF5B3A278A66D2A13F83F44F82DDF310EE074AB6A364597E899A0255DC164F31CC50846851DF9AB48195DED7EA1B1D510BD7EE74D73FAF36BC31ECFA268359046F4EB879F924009438B481C6CD7889A002ED5EE382BC9190DA6FC026E479558E4475677E9AA9E3050E2765694DFC81F56E880B96E7160C980DD98EDD3DFFFFFFFFFFFFFFFFF}). + + -endif. % -ifdef(ssh_transport). diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 14605ee44f..4327068b7b 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -198,8 +198,6 @@ try_exec_simple_group(Group, Config) -> %%-------------------------------------------------------------------- %% Testing all default groups -simple_exec_groups() -> [{timetrap,{minutes,8}}]. - simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), lists:foreach( diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 0a0ab5cdf7..cdf6cf9ae1 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -152,15 +152,27 @@ end_per_suite(_Config) -> %%-------------------------------------------------------------------- init_per_group(dsa_key, Config) -> - DataDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), - ssh_test_lib:setup_dsa(DataDir, PrivDir), - Config; + case lists:member('ssh-dss', + ssh_transport:default_algorithms(public_key)) of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, PrivDir), + Config; + false -> + {skip, unsupported_pub_key} + end; init_per_group(rsa_key, Config) -> - DataDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), - ssh_test_lib:setup_rsa(DataDir, PrivDir), - Config; + case lists:member('ssh-rsa', + ssh_transport:default_algorithms(public_key)) of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_rsa(DataDir, PrivDir), + Config; + false -> + {skip, unsupported_pub_key} + end; init_per_group(ecdsa_sha2_nistp256_key, Config) -> case lists:member('ecdsa-sha2-nistp256', ssh_transport:default_algorithms(public_key)) of @@ -195,15 +207,27 @@ init_per_group(ecdsa_sha2_nistp521_key, Config) -> {skip, unsupported_pub_key} end; init_per_group(rsa_pass_key, Config) -> - DataDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), - ssh_test_lib:setup_rsa_pass_pharse(DataDir, PrivDir, "Password"), - [{pass_phrase, {rsa_pass_phrase, "Password"}}| Config]; + case lists:member('ssh-rsa', + ssh_transport:default_algorithms(public_key)) of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_rsa_pass_pharse(DataDir, PrivDir, "Password"), + [{pass_phrase, {rsa_pass_phrase, "Password"}}| Config]; + false -> + {skip, unsupported_pub_key} + end; init_per_group(dsa_pass_key, Config) -> - DataDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), - ssh_test_lib:setup_dsa_pass_pharse(DataDir, PrivDir, "Password"), - [{pass_phrase, {dsa_pass_phrase, "Password"}}| Config]; + case lists:member('ssh-dss', + ssh_transport:default_algorithms(public_key)) of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_dsa_pass_pharse(DataDir, PrivDir, "Password"), + [{pass_phrase, {dsa_pass_phrase, "Password"}}| Config]; + false -> + {skip, unsupported_pub_key} + end; init_per_group(host_user_key_differs, Config) -> Data = proplists:get_value(data_dir, Config), Sys = filename:join(proplists:get_value(priv_dir, Config), system_rsa), @@ -220,10 +244,16 @@ init_per_group(host_user_key_differs, Config) -> ssh_test_lib:setup_rsa_known_host(Sys, Usr), Config; init_per_group(key_cb, Config) -> - DataDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), - ssh_test_lib:setup_dsa(DataDir, PrivDir), - Config; + case lists:member('ssh-rsa', + ssh_transport:default_algorithms(public_key)) of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_rsa(DataDir, PrivDir), + Config; + false -> + {skip, unsupported_pub_key} + end; init_per_group(internal_error, Config) -> DataDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), @@ -293,7 +323,7 @@ end_per_group(rsa_pass_key, Config) -> Config; end_per_group(key_cb, Config) -> PrivDir = proplists:get_value(priv_dir, Config), - ssh_test_lib:clean_dsa(PrivDir), + ssh_test_lib:clean_rsa(PrivDir), Config; end_per_group(internal_error, Config) -> PrivDir = proplists:get_value(priv_dir, Config), @@ -750,7 +780,7 @@ key_callback_options(Config) when is_list(Config) -> {user_dir, UserDir}, {failfun, fun ssh_test_lib:failfun/2}]), - {ok, PrivKey} = file:read_file(filename:join(UserDir, "id_dsa")), + {ok, PrivKey} = file:read_file(filename:join(UserDir, "id_rsa")), ConnectOpts = [{silently_accept_hosts, true}, {user_dir, NoPubKeyDir}, @@ -1206,7 +1236,7 @@ check_error("Invalid state") -> ok; check_error("Connection closed") -> ok; -check_error("Selection of key exchange algorithm failed") -> +check_error("Selection of key exchange algorithm failed"++_) -> ok; check_error(Error) -> ct:fail(Error). diff --git a/lib/ssh/test/ssh_key_cb.erl b/lib/ssh/test/ssh_key_cb.erl index 388ec2ecc1..12ff79efcd 100644 --- a/lib/ssh/test/ssh_key_cb.erl +++ b/lib/ssh/test/ssh_key_cb.erl @@ -33,9 +33,9 @@ add_host_key(_, _, _) -> is_host_key(_, _, _, _) -> true. -user_key('ssh-dss', Opts) -> +user_key('ssh-rsa', Opts) -> UserDir = proplists:get_value(user_dir, Opts), - KeyFile = filename:join(filename:dirname(UserDir), "id_dsa"), + KeyFile = filename:join(filename:dirname(UserDir), "id_rsa"), {ok, KeyBin} = file:read_file(KeyFile), [Entry] = public_key:pem_decode(KeyBin), Key = public_key:pem_entry_decode(Entry), diff --git a/lib/ssh/test/ssh_key_cb_options.erl b/lib/ssh/test/ssh_key_cb_options.erl index afccb34f0f..946a1254d0 100644 --- a/lib/ssh/test/ssh_key_cb_options.erl +++ b/lib/ssh/test/ssh_key_cb_options.erl @@ -33,7 +33,7 @@ add_host_key(_, _, _) -> is_host_key(_, _, _, _) -> true. -user_key('ssh-dss', Opts) -> +user_key('ssh-rsa', Opts) -> KeyCbOpts = proplists:get_value(key_cb_private, Opts), KeyBin = proplists:get_value(priv_key, KeyCbOpts), [Entry] = public_key:pem_decode(KeyBin), diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 86f5cb1746..bd2d72c36c 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -148,6 +148,7 @@ init_per_group(hardening_tests, Config) -> DataDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, PrivDir), + ssh_test_lib:setup_rsa(DataDir, PrivDir), Config; init_per_group(dir_options, Config) -> PrivDir = proplists:get_value(priv_dir, Config), diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 93d0bc2eb0..2c4fa8be88 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -34,6 +34,12 @@ -define(NEWLINE, <<"\r\n">>). -define(REKEY_DATA_TMO, 65000). +%%-define(DEFAULT_KEX, 'diffie-hellman-group1-sha1'). +-define(DEFAULT_KEX, 'diffie-hellman-group14-sha256'). + +-define(CIPHERS, ['aes256-ctr','aes192-ctr','aes128-ctr','aes128-cbc','3des-cbc']). +-define(DEFAULT_CIPHERS, [{client2server,?CIPHERS}, {server2client,?CIPHERS}]). + -define(v(Key, Config), proplists:get_value(Key, Config)). -define(v(Key, Config, Default), proplists:get_value(Key, Config, Default)). @@ -97,7 +103,9 @@ end_per_suite(Config) -> init_per_testcase(no_common_alg_server_disconnects, Config) -> - start_std_daemon(Config, [{preferred_algorithms,[{public_key,['ssh-rsa']}]}]); + start_std_daemon(Config, [{preferred_algorithms,[{public_key,['ssh-rsa']}, + {cipher,?DEFAULT_CIPHERS} + ]}]); init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ; TC == gex_client_init_option_groups_moduli_file ; @@ -107,7 +115,10 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ; TC == gex_client_old_request_noexact -> Opts = case TC of gex_client_init_option_groups -> - [{dh_gex_groups, [{2345, 3, 41}]}]; + [{dh_gex_groups, + [{1023, 5, + 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F + }]}]; gex_client_init_option_groups_file -> DataDir = proplists:get_value(data_dir, Config), F = filename:join(DataDir, "dh_group_test"), @@ -119,16 +130,19 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ; _ when TC == gex_server_gex_limit ; TC == gex_client_old_request_exact ; TC == gex_client_old_request_noexact -> - [{dh_gex_groups, [{ 500, 3, 17}, - {1000, 7, 91}, - {3000, 5, 61}]}, - {dh_gex_limits,{500,1500}} + [{dh_gex_groups, + [{1023, 2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323}, + {1535, 5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827}, + {3071, 2, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9429825A2B} + ]}, + {dh_gex_limits, {1023,2000}} ]; _ -> [] end, start_std_daemon(Config, - [{preferred_algorithms, ssh:default_algorithms()} + [{preferred_algorithms,[{cipher,?DEFAULT_CIPHERS} + ]} | Opts]); init_per_testcase(_TestCase, Config) -> check_std_daemon_works(Config, ?LINE). @@ -237,7 +251,10 @@ lib_works_as_server(Config) -> %% and finally connect to it with a regular Erlang SSH client: {ok,_} = std_connect(HostPort, Config, - [{preferred_algorithms,[{kex,['diffie-hellman-group1-sha1']}]}] + [{preferred_algorithms,[{kex,[?DEFAULT_KEX]}, + {cipher,?DEFAULT_CIPHERS} + ]} + ] ). %%-------------------------------------------------------------------- @@ -277,7 +294,9 @@ no_common_alg_server_disconnects(Config) -> [{silently_accept_hosts, true}, {user_dir, user_dir(Config)}, {user_interaction, false}, - {preferred_algorithms,[{public_key,['ssh-dss']}]} + {preferred_algorithms,[{public_key,['ssh-dss']}, + {cipher,?DEFAULT_CIPHERS} + ]} ]}, receive_hello, {send, hello}, @@ -311,7 +330,7 @@ no_common_alg_client_disconnects(Config) -> {match, #ssh_msg_kexinit{_='_'}, receive_msg}, {send, #ssh_msg_kexinit{ % with unsupported "SOME-UNSUPPORTED" cookie = <<80,158,95,51,174,35,73,130,246,141,200,49,180,190,82,234>>, - kex_algorithms = ["diffie-hellman-group1-sha1"], + kex_algorithms = [atom_to_list(?DEFAULT_KEX)], server_host_key_algorithms = ["SOME-UNSUPPORTED"], % SIC! encryption_algorithms_client_to_server = ["aes128-ctr"], encryption_algorithms_server_to_client = ["aes128-ctr"], @@ -332,7 +351,9 @@ no_common_alg_client_disconnects(Config) -> %% and finally connect to it with a regular Erlang SSH client %% which of course does not support SOME-UNSUPPORTED as pub key algo: - Result = std_connect(HostPort, Config, [{preferred_algorithms,[{public_key,['ssh-dss']}]}]), + Result = std_connect(HostPort, Config, [{preferred_algorithms,[{public_key,['ssh-dss']}, + {cipher,?DEFAULT_CIPHERS} + ]}]), ct:log("Result of connect is ~p",[Result]), receive @@ -351,20 +372,25 @@ no_common_alg_client_disconnects(Config) -> %%%-------------------------------------------------------------------- gex_client_init_option_groups(Config) -> - do_gex_client_init(Config, {2000, 2048, 4000}, - {3,41}). + do_gex_client_init(Config, {512, 2048, 4000}, + {5,16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F} + ). gex_client_init_option_groups_file(Config) -> do_gex_client_init(Config, {2000, 2048, 4000}, - {5,61}). + {5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F} + ). gex_client_init_option_groups_moduli_file(Config) -> do_gex_client_init(Config, {2000, 2048, 4000}, - {5,16#B7}). + {5, 16#DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F} + ). gex_server_gex_limit(Config) -> do_gex_client_init(Config, {1000, 3000, 4000}, - {7,91}). + %% {7,91}). + {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827} + ). do_gex_client_init(Config, {Min,N,Max}, {G,P}) -> @@ -376,7 +402,9 @@ do_gex_client_init(Config, {Min,N,Max}, {G,P}) -> [{silently_accept_hosts, true}, {user_dir, user_dir(Config)}, {user_interaction, false}, - {preferred_algorithms,[{kex,['diffie-hellman-group-exchange-sha1']}]} + {preferred_algorithms,[{kex,['diffie-hellman-group-exchange-sha1']}, + {cipher,?DEFAULT_CIPHERS} + ]} ]}, receive_hello, {send, hello}, @@ -390,8 +418,15 @@ do_gex_client_init(Config, {Min,N,Max}, {G,P}) -> ). %%%-------------------------------------------------------------------- -gex_client_old_request_exact(Config) -> do_gex_client_init_old(Config, 500, {3,17}). -gex_client_old_request_noexact(Config) -> do_gex_client_init_old(Config, 800, {7,91}). +gex_client_old_request_exact(Config) -> + do_gex_client_init_old(Config, 1023, + {2, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A771225323} + ). + +gex_client_old_request_noexact(Config) -> + do_gex_client_init_old(Config, 1400, + {5, 16#D1391174233D315398FE2830AC6B2B66BCCD01B0A634899F339B7879F1DB85712E9DC4E4B1C6C8355570C1D2DCB53493DF18175A9C53D1128B592B4C72D97136F5542FEB981CBFE8012FDD30361F288A42BD5EBB08BAB0A5640E1AC48763B2ABD1945FEE36B2D55E1D50A1C86CED9DD141C4E7BE2D32D9B562A0F8E2E927020E91F58B57EB9ACDDA106A59302D7E92AD5F6E851A45FA1CFE86029A0F727F65A8F475F33572E2FDAB6073F0C21B8B54C3823DB2EF068927E5D747498F96E1E827} + ). do_gex_client_init_old(Config, N, {G,P}) -> {ok,_} = @@ -402,7 +437,9 @@ do_gex_client_init_old(Config, N, {G,P}) -> [{silently_accept_hosts, true}, {user_dir, user_dir(Config)}, {user_interaction, false}, - {preferred_algorithms,[{kex,['diffie-hellman-group-exchange-sha1']}]} + {preferred_algorithms,[{kex,['diffie-hellman-group-exchange-sha1']}, + {cipher,?DEFAULT_CIPHERS} + ]} ]}, receive_hello, {send, hello}, @@ -572,7 +609,9 @@ client_handles_keyboard_interactive_0_pwds(Config) -> %% and finally connect to it with a regular Erlang SSH client: {ok,_} = std_connect(HostPort, Config, - [{preferred_algorithms,[{kex,['diffie-hellman-group1-sha1']}]}] + [{preferred_algorithms,[{kex,[?DEFAULT_KEX]}, + {cipher,?DEFAULT_CIPHERS} + ]}] ). @@ -623,6 +662,7 @@ stop_apps(_Config) -> setup_dirs(Config) -> DataDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, PrivDir), ssh_test_lib:setup_rsa(DataDir, PrivDir), Config. @@ -708,7 +748,9 @@ connect_and_kex(Config, InitialState) -> ssh_trpt_test_lib:exec( [{connect, server_host(Config),server_port(Config), - [{preferred_algorithms,[{kex,['diffie-hellman-group1-sha1']}]}, + [{preferred_algorithms,[{kex,[?DEFAULT_KEX]}, + {cipher,?DEFAULT_CIPHERS} + ]}, {silently_accept_hosts, true}, {user_dir, user_dir(Config)}, {user_interaction, false}]}, diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test index 2887bb4b60..87c4b4afc8 100644 --- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test +++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test @@ -1,3 +1,3 @@ -{2222, 5, 61}. -{1111, 7, 91}. +{1023, 5, 16#D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A770E2EC9F}. +{3071, 5, 16#DFAA35D35531E0F524F0099877A482D2AC8D589F374394A262A8E81A8A4FB2F65FADBAB395E05D147B29D486DFAA41F41597A256DA82A8B6F76401AED53D0253F956CEC610D417E42E3B287F7938FC24D8821B40BFA218A956EB7401BED6C96C68C7FD64F8170A8A76B953DD2F05420118F6B144D8FE48060A2BCB85056B478EDEF96DBC70427053ECD2958C074169E9550DD877779A3CF17C5AC850598C7586BEEA9DCFE9DD2A5FB62DF5F33EA7BC00CDA31B9D2DD721F979EA85B6E63F0C4E30BDDCD3A335522F9004C4ED50B15DC537F55324DD4FA119FB3F101467C6D7E1699DE4B3E3C478A8679B8EB3FA5C9B826B44530FD3BE9AD3063B240B0C853EBDDBD68DD940332D98F148D5D9E1DC977D60A0D23D0CA1198637FEAE4E7FAAC173AF2B84313A666CFB4EE6972811921D0AD867CE57F3BBC8D6CB057E3B66757BB46C9F72662624D44E14528327E3A7100E81A12C43C4E236118318CD90C8AA185BBB0C764826DAEAEE8DD245C5B451B4944E6122CC522D1C335C2EEF9424273F1F}. diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli index f6995ba4c9..6d2b4bcb59 100644 --- a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli +++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test.moduli @@ -1,3 +1,2 @@ -20151021104105 2 6 100 2222 5 B7 -20151021104106 2 6 100 1111 5 4F - +20120821044046 2 6 100 1023 2 D9277DAA27DB131C03B108D41A76B4DA8ACEECCCAE73D2E48CEDAAA70B09EF9F04FB020DCF36C51B8E485B26FABE0337E24232BE4F4E693548310244937433FB1A5758195DC73B84ADEF8237472C46747D79DC0A2CF8A57CE8DBD8F466A20F8551E7B1B824B2E4987A8816D9BC0741C2798F3EBAD3ADEBCC78FCE6A7711F2C6B +20120821050554 2 6 100 2047 5 DD2047CBDBB6F8E919BC63DE885B34D0FD6E3DB2887D8B46FE249886ACED6B46DFCD5553168185FD376122171CD8927E60120FA8D01F01D03E58281FEA9A1ABE97631C828E41815F34FDCDF787419FE13A3137649AA93D2584230DF5F24B5C00C88B7D7DE4367693428C730376F218A53E853B0851BAB7C53C15DA7839CBE1285DB63F6FA45C1BB59FE1C5BB918F0F8459D7EF60ACFF5C0FA0F3FCAD1C5F4CE4416D4F4B36B05CDCEBE4FB879E95847EFBC6449CD190248843BC7EDB145FBFC4EDBB1A3C959298F08F3BA2CFBE231BBE204BE6F906209D28BD4820AB3E7BE96C26AE8A809ADD8D1A5A0B008E9570FA4C4697E116B8119892C604293683A9635F diff --git a/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 56a33d6349..fd5157d603 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -65,6 +65,7 @@ init_per_suite(Config) -> {ok, FileInfo} = file:read_file_info(FileName), ok = file:write_file_info(FileName, FileInfo#file_info{mode = 8#400}), + ssh_test_lib:setup_rsa(DataDir, PrivDir), ssh_test_lib:setup_dsa(DataDir, PrivDir), Config end). @@ -73,6 +74,7 @@ end_per_suite(Config) -> UserDir = filename:join(proplists:get_value(priv_dir, Config), nopubkey), file:del_dir(UserDir), SysDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:clean_rsa(SysDir), ssh_test_lib:clean_dsa(SysDir), ok. diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/id_rsa b/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 286ac6e882..1673f52821 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -690,13 +690,16 @@ ssh_type() -> ssh_type1() -> try + ct:log("~p:~p os:find_executable(\"ssh\")",[?MODULE,?LINE]), case os:find_executable("ssh") of false -> ct:log("~p:~p Executable \"ssh\" not found",[?MODULE,?LINE]), not_found; - _ -> + Path -> + ct:log("~p:~p Found \"ssh\" at ~p",[?MODULE,?LINE,Path]), case os:cmd("ssh -V") of - "OpenSSH" ++ _ -> + Version = "OpenSSH" ++ _ -> + ct:log("~p:~p Found OpenSSH ~p",[?MODULE,?LINE,Version]), openSSH; Str -> ct:log("ssh client ~p is unknown",[Str]), diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index bc86000d81..0fa0f0c0e4 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -93,7 +93,10 @@ exec(Op, S0=#s{}) -> exit:Exit -> report_trace(exit, Exit, S1), - exit(Exit) + exit(Exit); + Cls:Err -> + ct:pal("Class=~p, Error=~p", [Cls,Err]), + error("fooooooO") end; exec(Op, {ok,S=#s{}}) -> exec(Op, S); exec(_, Error) -> Error. diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl index 54f83928ee..09d4c3e678 100644 --- a/lib/ssl/src/ssl_config.erl +++ b/lib/ssl/src/ssl_config.erl @@ -32,20 +32,20 @@ init(SslOpts, Role) -> init_manager_name(SslOpts#ssl_options.erl_dist), - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbHandle, OwnCert} + {ok, #{pem_cache := PemCache} = Config} = init_certificates(SslOpts, Role), PrivateKey = - init_private_key(PemCacheHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, + init_private_key(PemCache, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, SslOpts#ssl_options.password, Role), - DHParams = init_diffie_hellman(PemCacheHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), - {ok, CertDbRef, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, PrivateKey, DHParams}. + DHParams = init_diffie_hellman(PemCache, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), + {ok, Config#{private_key => PrivateKey, dh_params => DHParams}}. init_manager_name(false) -> put(ssl_manager, ssl_manager:name(normal)), - put(ssl_cache, ssl_pem_cache:name(normal)); + put(ssl_pem_cache, ssl_pem_cache:name(normal)); init_manager_name(true) -> put(ssl_manager, ssl_manager:name(dist)), - put(ssl_cache, ssl_pem_cache:name(dist)). + put(ssl_pem_cache, ssl_pem_cache:name(dist)). init_certificates(#ssl_options{cacerts = CaCerts, cacertfile = CACertFile, @@ -53,7 +53,7 @@ init_certificates(#ssl_options{cacerts = CaCerts, cert = Cert, crl_cache = CRLCache }, Role) -> - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo} = + {ok, Config} = try Certs = case CaCerts of undefined -> @@ -61,41 +61,37 @@ init_certificates(#ssl_options{cacerts = CaCerts, _ -> {der, CaCerts} end, - {ok, _, _, _, _, _, _} = ssl_manager:connection_init(Certs, Role, CRLCache) + {ok,_} = ssl_manager:connection_init(Certs, Role, CRLCache) catch _:Reason -> file_error(CACertFile, {cacertfile, Reason}) end, - init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, - CacheHandle, CRLDbInfo, CertFile, Role). + init_certificates(Cert, Config, CertFile, Role). -init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, - CRLDbInfo, <<>>, _) -> - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, undefined}; +init_certificates(undefined, Config, <<>>, _) -> + {ok, Config#{own_certificate => undefined}}; -init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, - CacheHandle, CRLDbInfo, CertFile, client) -> +init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, client) -> try %% Ignoring potential proxy-certificates see: %% http://dev.globus.org/wiki/Security/ProxyFileFormat - [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle), - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, OwnCert} + [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCache), + {ok, Config#{own_certificate => OwnCert}} catch _Error:_Reason -> - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CRLDbInfo, undefined} - end; + {ok, Config#{own_certificate => undefined}} + end; -init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, - PemCacheHandle, CacheRef, CRLDbInfo, CertFile, server) -> +init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, server) -> try - [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle), - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, OwnCert} + [OwnCert|_] = ssl_certificate:file_to_certificats(CertFile, PemCache), + {ok, Config#{own_certificate => OwnCert}} catch _:Reason -> file_error(CertFile, {certfile, Reason}) end; -init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, _, _) -> - {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, CRLDbInfo, Cert}. - +init_certificates(Cert, Config, _, _) -> + {ok, Config#{own_certificate => Cert}}. + init_private_key(_, undefined, <<>>, _Password, _Client) -> undefined; init_private_key(DbHandle, undefined, KeyFile, Password, _) -> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 6ed2fc83da..4fbac4cad3 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -323,8 +323,14 @@ handle_session(#server_hello{cipher_suite = CipherSuite, -spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}. %%-------------------------------------------------------------------- ssl_config(Opts, Role, State) -> - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, - OwnCert, Key, DHParams} = + {ok, #{cert_db_ref := Ref, + cert_db_handle := CertDbHandle, + fileref_db_handle := FileRefHandle, + session_cache := CacheHandle, + crl_db_info := CRLDbHandle, + private_key := Key, + dh_params := DHParams, + own_certificate := OwnCert}} = ssl_config:init(Opts, Role), Handshake = ssl_handshake:init_handshake_history(), TimeStamp = erlang:monotonic_time(), @@ -335,7 +341,7 @@ ssl_config(Opts, Role, State) -> file_ref_db = FileRefHandle, cert_db_ref = Ref, cert_db = CertDbHandle, - crl_db = CRLDbInfo, + crl_db = CRLDbHandle, session_cache = CacheHandle, private_key = Key, diffie_hellman_params = DHParams, @@ -2428,16 +2434,23 @@ handle_sni_extension(#sni{hostname = Hostname}, State0) -> undefined -> State0; _ -> - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, Key, DHParams} = - ssl_config:init(NewOptions, State0#state.role), - State0#state{ - session = State0#state.session#session{own_certificate = OwnCert}, - file_ref_db = FileRefHandle, - cert_db_ref = Ref, - cert_db = CertDbHandle, - crl_db = CRLDbHandle, - session_cache = CacheHandle, - private_key = Key, + {ok, #{cert_db_ref := Ref, + cert_db_handle := CertDbHandle, + fileref_db_handle := FileRefHandle, + session_cache := CacheHandle, + crl_db_info := CRLDbHandle, + private_key := Key, + dh_params := DHParams, + own_certificate := OwnCert}} = + ssl_config:init(NewOptions, State0#state.role), + State0#state{ + session = State0#state.session#session{own_certificate = OwnCert}, + file_ref_db = FileRefHandle, + cert_db_ref = Ref, + cert_db = CertDbHandle, + crl_db = CRLDbHandle, + session_cache = CacheHandle, + private_key = Key, diffie_hellman_params = DHParams, ssl_options = NewOptions, sni_hostname = Hostname diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 29b15f843f..2b82f18bb5 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -107,8 +107,7 @@ start_link_dist(Opts) -> %%-------------------------------------------------------------------- -spec connection_init(binary()| {der, list()}, client | server, {Cb :: atom(), Handle:: term()}) -> - {ok, certdb_ref(), db_handle(), db_handle(), - db_handle(), db_handle(), CRLInfo::term()}. + {ok, map()}. %% %% Description: Do necessary initializations for a new connection. %%-------------------------------------------------------------------- @@ -128,7 +127,7 @@ cache_pem_file(File, DbHandle) -> [Content] -> {ok, Content}; undefined -> - ssl_pem_cache:insert(File) + ssl_pem_cache:insert(File) end. %%-------------------------------------------------------------------- @@ -224,7 +223,7 @@ init([ManagerName, PemCacheName, Opts]) -> CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache), SessionLifeTime = proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'), - CertDb = ssl_pkix_db:create(), + CertDb = ssl_pkix_db:create(PemCacheName), ClientSessionCache = CacheCb:init([{role, client} | proplists:get_value(session_cb_init_args, Opts, [])]), @@ -261,18 +260,25 @@ init([ManagerName, PemCacheName, Opts]) -> handle_call({{connection_init, <<>>, Role, {CRLCb, UserCRLDb}}, _Pid}, _From, #state{certificate_db = [CertDb, FileRefDb, PemChace | _] = Db} = State) -> Ref = make_ref(), - Result = {ok, Ref, CertDb, FileRefDb, PemChace, - session_cache(Role, State), {CRLCb, crl_db_info(Db, UserCRLDb)}}, - {reply, Result, State#state{certificate_db = Db}}; + {reply, {ok, #{cert_db_ref => Ref, + cert_db_handle => CertDb, + fileref_db_handle => FileRefDb, + pem_cache => PemChace, + session_cache => session_cache(Role, State), + crl_db_info => {CRLCb, crl_db_info(Db, UserCRLDb)}}}, State}; handle_call({{connection_init, Trustedcerts, Role, {CRLCb, UserCRLDb}}, Pid}, _From, #state{certificate_db = [CertDb, FileRefDb, PemChace | _] = Db} = State) -> case add_trusted_certs(Pid, Trustedcerts, Db) of {ok, Ref} -> - {reply, {ok, Ref, CertDb, FileRefDb, PemChace, session_cache(Role, State), - {CRLCb, crl_db_info(Db, UserCRLDb)}}, State}; - {error, _} = Error -> - {reply, Error, State} + {reply, {ok, #{cert_db_ref => Ref, + cert_db_handle => CertDb, + fileref_db_handle => FileRefDb, + pem_cache => PemChace, + session_cache => session_cache(Role, State), + crl_db_info => {CRLCb, crl_db_info(Db, UserCRLDb)}}}, State}; + {error, _} = Error -> + {reply, Error, State} end; handle_call({{insert_crls, Path, CRLs}, _}, _From, diff --git a/lib/ssl/src/ssl_pem_cache.erl b/lib/ssl/src/ssl_pem_cache.erl index 2b31374bcc..f63a301f69 100644 --- a/lib/ssl/src/ssl_pem_cache.erl +++ b/lib/ssl/src/ssl_pem_cache.erl @@ -133,7 +133,7 @@ invalidate_pem(File) -> init([Name]) -> put(ssl_pem_cache, Name), process_flag(trap_exit, true), - PemCache = ssl_pkix_db:create_pem_cache(), + PemCache = ssl_pkix_db:create_pem_cache(Name), Interval = pem_check_interval(), erlang:send_after(Interval, self(), clear_pem_cache), {ok, #state{pem_cache = PemCache, diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index 961a555873..cde05bb16f 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -28,7 +28,7 @@ -include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/file.hrl"). --export([create/0, create_pem_cache/0, +-export([create/1, create_pem_cache/1, add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3, extract_trusted_certs/1, remove_trusted_certs/2, insert/3, remove/2, clear/1, db_size/1, @@ -40,13 +40,13 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec create() -> [db_handle(),...]. +-spec create(atom()) -> [db_handle(),...]. %% %% Description: Creates a new certificate db. %% Note: lookup_trusted_cert/4 may be called from any process but only %% the process that called create may call the other functions. %%-------------------------------------------------------------------- -create() -> +create(PEMCacheName) -> [%% Let connection process delete trusted certs %% that can only belong to one connection. (Supplied directly %% on DER format to ssl:connect/listen.) @@ -56,14 +56,14 @@ create() -> ets:new(ssl_otp_ca_ref_file_mapping, [set, protected]) }, %% Lookups in named table owned by ssl_pem_cache process - ssl_otp_pem_cache, + PEMCacheName, %% Default cache {ets:new(ssl_otp_crl_cache, [set, protected]), ets:new(ssl_otp_crl_issuer_mapping, [bag, protected])} ]. -create_pem_cache() -> - ets:new(ssl_otp_pem_cache, [named_table, set, protected]). +create_pem_cache(Name) -> + ets:new(Name, [named_table, set, protected]). %%-------------------------------------------------------------------- -spec remove([db_handle()]) -> ok. @@ -76,7 +76,9 @@ remove(Dbs) -> true = ets:delete(Db1); (undefined) -> ok; - (ssl_otp_pem_cache) -> + (ssl_pem_cache) -> + ok; + (ssl_pem_cache_dist) -> ok; (Db) -> true = ets:delete(Db) @@ -341,3 +343,4 @@ crl_issuer(DerCRL) -> CRL = public_key:der_decode('CertificateList', DerCRL), TBSCRL = CRL#'CertificateList'.tbsCertList, TBSCRL#'TBSCertList'.issuer. + diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index d7ee5c1f5d..461acf03be 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -63,7 +63,7 @@ -type label() :: integer(). -type chunkid() :: nonempty_string(). % approximation of the strings below -%% "Abst" | "Attr" | "CInf" | "ExpT" | "ImpT" | "LocT" | "Atom". +%% "Abst" | "Attr" | "CInf" | "ExpT" | "ImpT" | "LocT" | "Atom" | "AtU8". -type chunkname() :: 'abstract_code' | 'attributes' | 'compile_info' | 'exports' | 'labeled_exports' | 'imports' | 'indexed_imports' @@ -520,6 +520,8 @@ read_chunk_data(File0, ChunkNames0, Options) end. %% -> {ok, list()} | throw(Error) +check_chunks([atoms | Ids], File, IL, L) -> + check_chunks(Ids, File, ["Atom", "AtU8" | IL], [{atom_chunk, atoms} | L]); check_chunks([ChunkName | Ids], File, IL, L) when is_atom(ChunkName) -> ChunkId = chunk_name_to_id(ChunkName, File), check_chunks(Ids, File, [ChunkId | IL], [{ChunkId, ChunkName} | L]); @@ -537,6 +539,10 @@ scan_beam(File, What0, AllowMissingChunks) -> case scan_beam1(File, What0) of {missing, _FD, Mod, Data, What} when AllowMissingChunks -> {ok, Mod, [{Id, missing_chunk} || Id <- What] ++ Data}; + {missing, _FD, Mod, Data, ["Atom"]} -> + {ok, Mod, Data}; + {missing, _FD, Mod, Data, ["AtU8"]} -> + {ok, Mod, Data}; {missing, FD, _Mod, _Data, What} -> error({missing_chunk, filename(FD), hd(What)}); R -> @@ -581,18 +587,23 @@ scan_beam(FD, Pos, What, Mod, Data) -> error({invalid_beam_file, filename(FD), Pos}) end. -get_data(Cs, "Atom"=Id, FD, Size, Pos, Pos2, _Mod, Data) -> +get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, Encoding) -> NewCs = del_chunk(Id, Cs), {NFD, Chunk} = get_chunk(Id, Pos, Size, FD), <<_Num:32, Chunk2/binary>> = Chunk, - {Module, _} = extract_atom(Chunk2), + {Module, _} = extract_atom(Chunk2, Encoding), C = case Cs of info -> {Id, Pos, Size}; _ -> {Id, Chunk} end, - scan_beam(NFD, Pos2, NewCs, Module, [C | Data]); + scan_beam(NFD, Pos2, NewCs, Module, [C | Data]). + +get_data(Cs, "Atom" = Id, FD, Size, Pos, Pos2, _Mod, Data) -> + get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, latin1); +get_data(Cs, "AtU8" = Id, FD, Size, Pos, Pos2, _Mod, Data) -> + get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, utf8); get_data(info, Id, FD, Size, Pos, Pos2, Mod, Data) -> scan_beam(FD, Pos2, info, Mod, [{Id, Pos, Size} | Data]); get_data(Chunks, Id, FD, Size, Pos, Pos2, Mod, Data) -> @@ -624,6 +635,9 @@ get_chunk(Id, Pos, Size, FD) -> {NFD, Chunk} end. +chunks_to_data([{atom_chunk, Name} | CNs], Chunks, File, Cs, Module, Atoms, L) -> + {NewAtoms, Ret} = chunk_to_data(Name, <<"">>, File, Cs, Atoms, Module), + chunks_to_data(CNs, Chunks, File, Cs, Module, NewAtoms, [Ret | L]); chunks_to_data([{Id, Name} | CNs], Chunks, File, Cs, Module, Atoms, L) -> {_Id, Chunk} = lists:keyfind(Id, 1, Chunks), {NewAtoms, Ret} = chunk_to_data(Name, Chunk, File, Cs, Atoms, Module), @@ -651,7 +665,7 @@ chunk_to_data(abstract_code=Id, Chunk, File, _Cs, AtomTable, Mod) -> <<>> -> {AtomTable, {Id, no_abstract_code}}; <<0:8,N:8,Mode0:N/binary,Rest/binary>> -> - Mode = list_to_atom(binary_to_list(Mode0)), + Mode = binary_to_atom(Mode0, utf8), decrypt_abst(Mode, Mod, File, Id, AtomTable, Rest); _ -> case catch binary_to_term(Chunk) of @@ -683,7 +697,6 @@ chunk_to_data(ChunkId, Chunk, _File, _Cs, AtomTable, _Module) when is_list(ChunkId) -> {AtomTable, {ChunkId, Chunk}}. % Chunk is a binary -chunk_name_to_id(atoms, _) -> "Atom"; chunk_name_to_id(indexed_imports, _) -> "ImpT"; chunk_name_to_id(imports, _) -> "ImpT"; chunk_name_to_id(exports, _) -> "ExpT"; @@ -738,25 +751,30 @@ atm(AT, N) -> %% AT is updated. ensure_atoms({empty, AT}, Cs) -> - {_Id, AtomChunk} = lists:keyfind("Atom", 1, Cs), - extract_atoms(AtomChunk, AT), + case lists:keyfind("AtU8", 1, Cs) of + {_Id, AtomChunk} when is_binary(AtomChunk) -> + extract_atoms(AtomChunk, AT, utf8); + _ -> + {_Id, AtomChunk} = lists:keyfind("Atom", 1, Cs), + extract_atoms(AtomChunk, AT, latin1) + end, AT; ensure_atoms(AT, _Cs) -> AT. -extract_atoms(<<_Num:32, B/binary>>, AT) -> - extract_atoms(B, 1, AT). +extract_atoms(<<_Num:32, B/binary>>, AT, Encoding) -> + extract_atoms(B, 1, AT, Encoding). -extract_atoms(<<>>, _I, _AT) -> +extract_atoms(<<>>, _I, _AT, _Encoding) -> true; -extract_atoms(B, I, AT) -> - {Atom, B1} = extract_atom(B), +extract_atoms(B, I, AT, Encoding) -> + {Atom, B1} = extract_atom(B, Encoding), true = ets:insert(AT, {I, Atom}), - extract_atoms(B1, I+1, AT). + extract_atoms(B1, I+1, AT, Encoding). -extract_atom(<<Len, B/binary>>) -> +extract_atom(<<Len, B/binary>>, Encoding) -> <<SB:Len/binary, Tail/binary>> = B, - {list_to_atom(binary_to_list(SB)), Tail}. + {binary_to_atom(SB, Encoding), Tail}. %%% Utils. @@ -856,12 +874,12 @@ significant_chunks() -> %% for a module. They are listed in the order that they should be MD5:ed. md5_chunks() -> - ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"]. + ["Atom", "AtU8", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"]. %% The following chunks are mandatory in every Beam file. mandatory_chunks() -> - ["Code", "ExpT", "ImpT", "StrT", "Atom"]. + ["Code", "ExpT", "ImpT", "StrT"]. %%% ==================================================================== %%% The rest of the file handles encrypted debug info. diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index ccc827ca2d..45666fbcb4 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -24,7 +24,7 @@ -export_type([cp/0]). --opaque cp() :: {'am' | 'bm', binary()}. +-opaque cp() :: {'am' | 'bm', reference()}. -type part() :: {Start :: non_neg_integer(), Length :: integer()}. %%% BIFs. diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 5bc9475fc8..e81383775b 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1063,11 +1063,8 @@ foldl_bins([Bin | Bins], MP, Terms) -> compile_match_spec(select, ?PATTERN_TO_OBJECT_MATCH_SPEC('_') = Spec) -> {Spec, true}; compile_match_spec(select, Spec) -> - case catch ets:match_spec_compile(Spec) of - X when is_binary(X) -> - {Spec, {match_spec, X}}; - _ -> - badarg + try {Spec, {match_spec, ets:match_spec_compile(Spec)}} + catch error:_ -> badarg end; compile_match_spec(object, Pat) -> compile_match_spec(select, ?PATTERN_TO_OBJECT_MATCH_SPEC(Pat)); diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 20de06fd0b..d6fd1e3ea1 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -51,8 +51,8 @@ -type tab() :: atom() | tid(). -type type() :: set | ordered_set | bag | duplicate_bag. -type continuation() :: '$end_of_table' - | {tab(),integer(),integer(),binary(),list(),integer()} - | {tab(),_,_,integer(),binary(),list(),integer(),integer()}. + | {tab(),integer(),integer(),comp_match_spec(),list(),integer()} + | {tab(),_,_,integer(),comp_match_spec(),list(),integer(),integer()}. -opaque tid() :: integer(). @@ -488,7 +488,7 @@ update_element(_, _, _) -> %%% End of BIFs --opaque comp_match_spec() :: binary(). %% this one is REALLY opaque +-opaque comp_match_spec() :: reference(). -spec match_spec_run(List, CompiledMatchSpec) -> list() when List :: [tuple()], @@ -505,28 +505,28 @@ match_spec_run(List, CompiledMS) -> repair_continuation('$end_of_table', _) -> '$end_of_table'; %% ordered_set -repair_continuation(Untouched = {Table,Lastkey,EndCondition,N2,Bin,L2,N3,N4}, MS) +repair_continuation(Untouched = {Table,Lastkey,EndCondition,N2,MSRef,L2,N3,N4}, MS) when %% (is_atom(Table) or is_integer(Table)), is_integer(N2), - byte_size(Bin) =:= 0, + %% is_reference(MSRef), is_list(L2), is_integer(N3), is_integer(N4) -> - case ets:is_compiled_ms(Bin) of + case ets:is_compiled_ms(MSRef) of true -> Untouched; false -> {Table,Lastkey,EndCondition,N2,ets:match_spec_compile(MS),L2,N3,N4} end; %% set/bag/duplicate_bag -repair_continuation(Untouched = {Table,N1,N2,Bin,L,N3}, MS) +repair_continuation(Untouched = {Table,N1,N2,MSRef,L,N3}, MS) when %% (is_atom(Table) or is_integer(Table)), is_integer(N1), is_integer(N2), - byte_size(Bin) =:= 0, + %% is_reference(MSRef), is_list(L), is_integer(N3) -> - case ets:is_compiled_ms(Bin) of + case ets:is_compiled_ms(MSRef) of true -> Untouched; false -> diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 4521ecc0ef..279e15f703 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -81,12 +81,8 @@ normal(Conf) when is_list(Conf) -> NoOfTables = length(ets:all()), P0 = pps(), - CompileFlags = [{outdir,PrivDir}, debug_info], - {ok,_} = compile:file(Source, CompileFlags), - {ok, Binary} = file:read_file(BeamFile), - - do_normal(BeamFile), - do_normal(Binary), + do_normal(Source, PrivDir, BeamFile, []), + do_normal(Source, PrivDir, BeamFile, [no_utf8_atoms]), {ok,_} = compile:file(Source, [{outdir,PrivDir}, no_debug_info]), {ok, {simple, [{abstract_code, no_abstract_code}]}} = @@ -101,7 +97,15 @@ normal(Conf) when is_list(Conf) -> true = (P0 == pps()), ok. -do_normal(BeamFile) -> +do_normal(Source, PrivDir, BeamFile, Opts) -> + CompileFlags = [{outdir,PrivDir}, debug_info | Opts], + {ok,_} = compile:file(Source, CompileFlags), + {ok, Binary} = file:read_file(BeamFile), + + do_normal(BeamFile, Opts), + do_normal(Binary, Opts). + +do_normal(BeamFile, Opts) -> Imports = {imports, [{erlang, get_module_info, 1}, {erlang, get_module_info, 2}, {lists, member, 2}]}, @@ -130,20 +134,31 @@ do_normal(BeamFile) -> beam_lib:chunks(BeamFile, [abstract_code]), %% Test reading optional chunks. - All = ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"], + All = ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT", "AtU8"], {ok,{simple,Chunks}} = beam_lib:chunks(BeamFile, All, [allow_missing_chunks]), - verify_simple(Chunks). + case {verify_simple(Chunks),Opts} of + {{missing_chunk, AtomBin}, []} when is_binary(AtomBin) -> ok; + {{AtomBin, missing_chunk}, [no_utf8_atoms]} when is_binary(AtomBin) -> ok + end, -verify_simple([{"Atom", AtomBin}, + %% Make sure that reading the atom chunk works when the 'allow_missing_chunks' + %% option is used. + Some = ["Code",atoms,"ExpT","LitT"], + {ok,{simple,SomeChunks}} = beam_lib:chunks(BeamFile, Some, [allow_missing_chunks]), + [{"Code",<<_/binary>>},{atoms,[_|_]},{"ExpT",<<_/binary>>},{"LitT",missing_chunk}] = + SomeChunks. + +verify_simple([{"Atom", PlainAtomChunk}, {"Code", CodeBin}, {"StrT", StrBin}, {"ImpT", ImpBin}, {"ExpT", ExpBin}, {"FunT", missing_chunk}, - {"LitT", missing_chunk}]) - when is_binary(AtomBin), is_binary(CodeBin), is_binary(StrBin), + {"LitT", missing_chunk}, + {"AtU8", AtU8Chunk}]) + when is_binary(CodeBin), is_binary(StrBin), is_binary(ImpBin), is_binary(ExpBin) -> - ok. + {PlainAtomChunk, AtU8Chunk}. %% Read invalid beam files. error(Conf) when is_list(Conf) -> @@ -211,7 +226,7 @@ last_chunk(Bin) -> do_error(BeamFile, ACopy) -> %% evil tests Chunks = chunk_info(BeamFile), - {value, {_, AtomStart, _}} = lists:keysearch("Atom", 1, Chunks), + {value, {_, AtomStart, _}} = lists:keysearch("AtU8", 1, Chunks), {value, {_, ImportStart, _}} = lists:keysearch("ImpT", 1, Chunks), {value, {_, AbstractStart, _}} = lists:keysearch("Abst", 1, Chunks), {value, {_, AttributesStart, _}} = @@ -234,7 +249,7 @@ do_error(BeamFile, ACopy) -> verify(not_a_beam_file, beam_lib:info(BF7)), BF8 = set_byte(ACopy, BeamFile, 13, 17), - verify(missing_chunk, beam_lib:chunks(BF8, ["Atom"])), + verify(missing_chunk, beam_lib:chunks(BF8, ["AtU8"])), BF9 = set_byte(ACopy, BeamFile, CompileInfoStart+10, 17), verify(invalid_chunk, beam_lib:chunks(BF9, [compile_info])). diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index aa31fdde5a..95c9b47465 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -3012,8 +3012,13 @@ repair_continuation(Config) -> MS = [{'_',[],[true]}], - {[true], C1} = dets:select(Tab, MS, 1), - C2 = binary_to_term(term_to_binary(C1)), + SRes = term_to_binary(dets:select(Tab, MS, 1)), + %% Get rid of compiled match spec + lists:foreach(fun (P) -> + garbage_collect(P) + end, processes()), + {[true], C2} = binary_to_term(SRes), + {'EXIT', {badarg, _}} = (catch dets:select(C2)), C3 = dets:repair_continuation(C2, MS), {[true], C4} = dets:select(C3), diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 4ae734eb65..7d0ba967f9 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -772,10 +772,9 @@ unicode() -> erl_scan:string([1089]), {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([1089], {1,1}), - {error,{1,erl_scan,{illegal,atom}},1} = - erl_scan:string("'a"++[1089]++"b'", 1), - {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = - erl_scan:string("'a"++[1089]++"b'", {1,1}), + {error,{{1,3},erl_scan,{illegal,character}},{1,4}} = + erl_scan:string("'a" ++ [999999999] ++ "c'", {1,1}), + test("\"a"++[1089]++"b\""), {ok,[{char,1,1}],1} = erl_scan_string([$$,$\\,$^,1089], 1), @@ -786,8 +785,8 @@ unicode() -> erl_scan:format_error(Error), {error,{{1,1},erl_scan,_},{1,11}} = erl_scan:string("\"qa\\x{aaa}",{1,1}), - {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = - erl_scan:string("'qa\\x{aaa}'",{1,1}), + {error,{{1,1},erl_scan,_},{1,11}} = + erl_scan:string("'qa\\x{aaa}",{1,1}), {ok,[{char,1,1089}],1} = erl_scan_string([$$,1089], 1), @@ -904,9 +903,9 @@ more_chars() -> %% OTP-10302. Unicode characters scanner/parser. otp_10302(Config) when is_list(Config) -> %% From unicode(): - {error,{1,erl_scan,{illegal,atom}},1} = + {ok,[{atom,1,'aсb'}],1} = erl_scan:string("'a"++[1089]++"b'", 1), - {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = + {ok,[{atom,{1,1},'qaપ'}],{1,12}} = erl_scan:string("'qa\\x{aaa}'",{1,1}), {ok,[{char,1,1089}],1} = erl_scan_string([$$,1089], 1), diff --git a/lib/tools/emacs/erlang-edoc.el b/lib/tools/emacs/erlang-edoc.el index 2801aa8ae7..d0dcc81028 100644 --- a/lib/tools/emacs/erlang-edoc.el +++ b/lib/tools/emacs/erlang-edoc.el @@ -36,7 +36,7 @@ "Tags that can be used anywhere within a module.") (defvar erlang-edoc-overview-tags - '("author" "copyright" "reference" "see" "since" "title" "version") + '("author" "copyright" "doc" "reference" "see" "since" "title" "version") "Tags that can be used in an overview file.") (defvar erlang-edoc-module-tags @@ -45,8 +45,8 @@ "Tags that can be used before a module declaration.") (defvar erlang-edoc-function-tags - '("deprecated" "doc" "equiv" "hidden" "private" "see" "since" "spec" - "throws" "type") + '("deprecated" "doc" "equiv" "hidden" "param" "private" "returns" + "see" "since" "spec" "throws" "type") "Tags that can be used before a function definition.") (defvar erlang-edoc-predefined-macros @@ -169,4 +169,10 @@ (jit-lock-refontify)) (provide 'erlang-edoc) + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;;; erlang-edoc.el ends here diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index 3b85e6680a..38c40927f4 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -68,7 +68,7 @@ buffer and vice versa" ;;; (defun erlang-eunit-open-src-file-other-window (test-file-path) "Open the src file which corresponds to the an EUnit test file" - (find-file-other-window (erlang-eunit-src-filename test-file-path))) + (find-file-other-window (erlang-eunit-src-filename test-file-path))) ;;; Return the name and path of the EUnit test file ;;, (input may be either the source filename itself or the EUnit test filename) @@ -154,7 +154,7 @@ buffer and vice versa" ;;; Join filenames (defun filename-join (dir file) (if (or (= (elt file 0) ?/) - (= (car (last (append dir nil))) ?/)) + (= (car (last (append dir nil))) ?/)) (concat dir file) (concat dir "/" file))) @@ -299,7 +299,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;;; Compile source and EUnit test file and finally run EUnit tests for ;;; the current module (defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover) - "Compile the source and test files and run the EUnit test suite. + "Compile the source and test files and run the EUnit test suite. If under-cover is set to t, the module under test is compile for code coverage analysis. If under-cover is left out or not set, @@ -311,7 +311,7 @@ and the number of times each line is covered). With prefix arg, compiles for debug and runs tests with the verbose flag set." (erlang-eunit-record-recent-compile under-cover) (let ((src-filename (erlang-eunit-src-filename buffer-file-name)) - (test-filename (erlang-eunit-test-filename buffer-file-name))) + (test-filename (erlang-eunit-test-filename buffer-file-name))) ;; The purpose of out-maneuvering `save-some-buffers', as is done ;; below, is to ask the question about saving buffers only once, @@ -326,9 +326,9 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;; be placed in the source file instead. Any compilation error ;; will prevent the subsequent steps to be run (hence the `and') (and (erlang-eunit-compile-file src-filename under-cover) - (if (file-readable-p test-filename) - (erlang-eunit-compile-file test-filename) - t) + (if (file-readable-p test-filename) + (erlang-eunit-compile-file test-filename) + t) (apply test-fun test-args) (if under-cover (save-excursion @@ -381,16 +381,16 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (goto-char compilation-parsing-end) (erlang-eunit-all-list-elems-fulfill-p (lambda (re) (let ((continue t) - (result t)) - (while continue ; ignore warnings, stop at errors - (if (re-search-forward re (point-max) t) - (if (erlang-eunit-is-compilation-warning) - t - (setq result nil) - (setq continue nil)) - (setq result t) - (setq continue nil))) - result)) + (result t)) + (while continue ; ignore warnings, stop at errors + (if (re-search-forward re (point-max) t) + (if (erlang-eunit-is-compilation-warning) + t + (setq result nil) + (setq continue nil)) + (setq result t) + (setq continue nil))) + result)) (mapcar (lambda (e) (car e)) erlang-error-regexp-alist)))) (defun erlang-eunit-is-compilation-warning () @@ -402,7 +402,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (let ((matches-p t)) (while (and list matches-p) (if (not (funcall pred (car list))) - (setq matches-p nil)) + (setq matches-p nil)) (setq list (cdr list))) matches-p)) @@ -439,15 +439,21 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (defun erlang-eunit-ensure-keymap-for-key (key-seq) (let ((prefix-keys (butlast (append key-seq nil))) - (prefix-seq "")) + (prefix-seq "")) (while prefix-keys (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys)))) (setq prefix-keys (cdr prefix-keys)) (if (not (keymapp (lookup-key (current-local-map) prefix-seq))) - (local-set-key prefix-seq (make-sparse-keymap)))))) + (local-set-key prefix-seq (make-sparse-keymap)))))) (add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings) (provide 'erlang-eunit) -;; erlang-eunit ends here + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;; erlang-eunit.el ends here diff --git a/lib/tools/emacs/erlang-pkg.el b/lib/tools/emacs/erlang-pkg.el index 4d0aa6fcd3..02d6bebbf4 100644 --- a/lib/tools/emacs/erlang-pkg.el +++ b/lib/tools/emacs/erlang-pkg.el @@ -1,3 +1,3 @@ (define-package "erlang" "2.7.0" - "Erlang major mode" - '()) + "Erlang major mode" + '((emacs "24.1"))) diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el index 160057e179..c35f280bf4 100644 --- a/lib/tools/emacs/erlang-start.el +++ b/lib/tools/emacs/erlang-start.el @@ -39,7 +39,7 @@ ;; ;; Please state as exactly as possible: ;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, -;; and of any other relevant software. +;; and of any other relevant software. ;; - What the expected result was. ;; - What you did, preferably in a repeatable step-by-step form. ;; - A description of the unexpected result. @@ -60,7 +60,7 @@ ;; (autoload 'erlang-mode "erlang" "Major mode for editing Erlang code." t) -(autoload 'erlang-version "erlang" +(autoload 'erlang-version "erlang" "Return the current version of Erlang mode." t) (autoload 'erlang-shell "erlang" "Start a new Erlang shell." t) (autoload 'run-erlang "erlang" "Start a new Erlang shell." t) @@ -68,7 +68,7 @@ (autoload 'erlang-compile "erlang" "Compile Erlang module in current buffer." t) -(autoload 'erlang-man-module "erlang" +(autoload 'erlang-man-module "erlang" "Find manual page for MODULE." t) (autoload 'erlang-man-function "erlang" "Find manual page for NAME, where NAME is module:function." t) @@ -108,25 +108,22 @@ A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil) ;; ;; Associate files using interpreter "escript" with Erlang mode. -;; +;; ;;;###autoload (add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode)) ;; ;; Ignore files ending in ".jam", ".vee", and ".beam" when performing -;; file completion. +;; file completion and in dired omit mode. ;; ;;;###autoload (let ((erl-ext '(".jam" ".vee" ".beam"))) (while erl-ext - (let ((cie completion-ignored-extensions)) - (while (and cie (not (string-equal (car cie) (car erl-ext)))) - (setq cie (cdr cie))) - (if (null cie) - (setq completion-ignored-extensions - (cons (car erl-ext) completion-ignored-extensions)))) + (add-to-list 'completion-ignored-extensions (car erl-ext)) + (when (boundp 'dired-omit-extensions) + (add-to-list 'dired-omit-extensions (car erl-ext))) (setq erl-ext (cdr erl-ext)))) @@ -136,4 +133,9 @@ A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil) (provide 'erlang-start) +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;; erlang-start.el ends here. diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el index ba6190d194..ea5d637199 100644 --- a/lib/tools/emacs/erlang-test.el +++ b/lib/tools/emacs/erlang-test.el @@ -2,7 +2,7 @@ ;;; Unit tests for erlang.el. -;; Author: Johan Claesson +;; Author: Johan Claesson ;; Created: 2016-05-07 ;; Keywords: erlang, languages @@ -28,6 +28,27 @@ ;;; Commentary: ;; This library require GNU Emacs 25 or later. +;; +;; There are two ways to run emacs unit tests. +;; +;; 1. Within a running emacs process. Load this file. Then to run +;; all defined test cases: +;; +;; M-x ert RET t RET +;; +;; To run only the erlang test cases: +;; +;; M-x ert RET "^erlang" RET +;; +;; +;; 2. In a new stand-alone emacs process. This process exits +;; when it executed the tests. For example: +;; +;; emacs -Q -batch -L . -l erlang.el -l erlang-test.el \ +;; -f ert-run-tests-batch-and-exit +;; +;; The -L option adds a directory to the load-path. It should be the +;; directory containing erlang.el and erlang-test.el. ;;; Code: @@ -59,11 +80,12 @@ concatenated to form an erlang file to test on.") tags-file-name tags-table-list tags-table-set-list + tags-add-tables + tags-completion-table erlang-buffer erlang-mode-hook prog-mode-hook - erlang-shell-mode-hook - tags-add-tables) + erlang-shell-mode-hook) (unwind-protect (progn (setq-default tags-file-name nil) @@ -71,11 +93,14 @@ concatenated to form an erlang file to test on.") (erlang-test-create-erlang-file erlang-file) (erlang-test-compile-tags erlang-file tags-file) (setq erlang-buffer (find-file-noselect erlang-file)) - (with-current-buffer erlang-buffer - (setq-local tags-file-name tags-file)) - ;; Setting global tags-file-name is a workaround for - ;; GNU Emacs bug#23164. - (setq tags-file-name tags-file) + (if (< emacs-major-version 26) + (progn + (with-current-buffer erlang-buffer + (setq-local tags-file-name tags-file)) + ;; Setting global tags-file-name is a workaround for + ;; GNU Emacs bug#23164. + (setq tags-file-name tags-file)) + (visit-tags-table tags-file t)) (erlang-test-complete-at-point tags-file) (erlang-test-completion-table) (erlang-test-xref-find-definitions erlang-file erlang-buffer)) @@ -117,12 +142,20 @@ concatenated to form an erlang file to test on.") for line = 1 then (1+ line) do (when tagname (switch-to-buffer erlang-buffer) - (xref-find-definitions tagname) - (erlang-test-verify-pos erlang-file line) - (xref-find-definitions (concat "erlang_test:" tagname)) - (erlang-test-verify-pos erlang-file line))) - (xref-find-definitions "erlang_test:") - (erlang-test-verify-pos erlang-file 1)) + (erlang-test-xref-jump tagname erlang-file line) + (erlang-test-xref-jump (concat "erlang_test:" tagname) + erlang-file line))) + (erlang-test-xref-jump "erlang_test:" erlang-file 1)) + +(defun erlang-test-xref-jump (id expected-file expected-line) + (goto-char (point-max)) + (insert "\n%% " id) + (save-buffer) + (if (fboundp 'xref-find-definitions) + (xref-find-definitions (erlang-id-to-string + (erlang-get-identifier-at-point))) + (error "xref-find-definitions not defined (too old emacs?)")) + (erlang-test-verify-pos expected-file expected-line)) (defun erlang-test-verify-pos (expected-file expected-line) (should (string-equal (file-truename expected-file) @@ -136,13 +169,13 @@ concatenated to form an erlang file to test on.") (setq-local tags-file-name tags-file) (insert "\nerlang_test:fun") (erlang-complete-tag) - (should (looking-back "erlang_test:function")) + (should (looking-back "erlang_test:function" (point-at-bol))) (insert "\nfun") (erlang-complete-tag) - (should (looking-back "function")) + (should (looking-back "function" (point-at-bol))) (insert "\nerlang_") (erlang-complete-tag) - (should (looking-back "erlang_test:")))) + (should (looking-back "erlang_test:" (point-at-bol))))) (ert-deftest erlang-test-compile-options () @@ -179,6 +212,30 @@ concatenated to form an erlang file to test on.") erlang)) +(ert-deftest erlang-test-parse-id () + (cl-loop for id-string in '("fun/10" + "qualified-function module:fun/10" + "record reko" + "macro _SYMBOL" + "macro MACRO/10" + "module modula" + "macro" + nil) + for id-list in '((nil nil "fun" 10) + (qualified-function "module" "fun" 10) + (record nil "reko" nil) + (macro nil "_SYMBOL" nil) + (macro nil "MACRO" 10) + (module nil "modula" nil) + (nil nil "macro" nil) + nil) + for id-list2 = (erlang-id-to-list id-string) + do (should (equal id-list id-list2)) + for id-string2 = (erlang-id-to-string id-list) + do (should (equal id-string id-string2)) + collect id-list2)) + + (provide 'erlang-test) ;;; erlang-test.el ends here diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 51f7e8e26c..59b20c552e 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -4,6 +4,8 @@ ;; Author: Anders Lindgren ;; Keywords: erlang, languages, processes ;; Date: 2011-12-11 +;; Version: 2.7.0 +;; Package-Requires: ((emacs "24.1")) ;; %CopyrightBegin% ;; @@ -24,7 +26,7 @@ ;; %CopyrightEnd% ;; -;; Lars Thors�n's modifications of 2000-06-07 included. +;; Lars Thorsén's modifications of 2000-06-07 included. ;; The original version of this package was written by Robert Virding. ;; ;;; Commentary: @@ -85,30 +87,15 @@ (defconst erlang-version "2.7" "The version number of Erlang mode.") -(defvar erlang-root-dir nil +(defcustom erlang-root-dir nil "The directory where the Erlang system is installed. The name should not contain the trailing slash. Should this variable be nil, no manual pages will show up in the -Erlang mode menu.") - -(eval-and-compile - (defconst erlang-emacs-major-version - (if (boundp 'emacs-major-version) - emacs-major-version - (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) - (erlang-string-to-int (substring emacs-version - (match-beginning 1) (match-end 1)))) - "Major version number of Emacs.")) - -(eval-and-compile - (defconst erlang-emacs-minor-version - (if (boundp 'emacs-minor-version) - emacs-minor-version - (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) - (erlang-string-to-int (substring emacs-version - (match-beginning 2) (match-end 2)))) - "Minor version number of Emacs.")) +Erlang mode menu." + :group 'erlang + :type '(restricted-sexp :match-alternatives (stringp 'nil)) + :safe (lambda (val) (or (eq nil val) (stringp val)))) (defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) "Non-nil when running under XEmacs or Lucid Emacs.") @@ -129,7 +116,7 @@ Never EVER set this variable!") erlang-menu-man-items erlang-menu-personal-items erlang-menu-version-items) - "*List of menu item list to combine to create Erlang mode menu. + "List of menu item list to combine to create Erlang mode menu. External programs which temporarily add menu items to the Erlang mode menu may use this variable. Please use the function `add-hook' to add @@ -238,7 +225,7 @@ This variable is added to the list of Erlang menus stored in The menu is in the form described by the variable `erlang-menu-base-items'.") (defvar erlang-mode-hook nil - "*Functions to run when Erlang mode is activated. + "Functions to run when Erlang mode is activated. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -272,7 +259,7 @@ To use the example, copy the following lines to your `~/.emacs' file: (imenu-add-to-menubar \"Imenu\")))") (defvar erlang-load-hook nil - "*Functions to run when Erlang mode is loaded. + "Functions to run when Erlang mode is loaded. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -304,17 +291,20 @@ manual pages can be retrieved (note that you must set the value of A useful function is `tempo-template-erlang-normal-header'. \(This function only exists when the `tempo' package is available.)") -(defvar erlang-check-module-name 'ask - "*Non-nil means check that module name and file name agrees when saving. +(defcustom erlang-check-module-name 'ask + "Non-nil means check that module name and file name agrees when saving. -If the value of this variable is the atom `ask', the user is -prompted. If the value is t the source is silently changed.") +If the value of this variable is the symbol `ask', the user is +prompted. If the value is t the source is silently changed." + :group 'erlang + :type '(choice (const :tag "Check on save" 'ask) + (const :tag "Don't check on save" t))) (defvar erlang-electric-commands '(erlang-electric-comma erlang-electric-semicolon erlang-electric-gt) - "*List of activated electric commands. + "List of activated electric commands. The list should contain the electric commands which should be active. Currently, the available electric commands are: @@ -328,8 +318,8 @@ are activated. To deactivate all electric commands, set this variable to nil.") -(defvar erlang-electric-newline-inhibit t - "*Set to non-nil to inhibit newline after electric command. +(defcustom erlang-electric-newline-inhibit t + "Set to non-nil to inhibit newline after electric command. This is useful since a lot of people press return after executing an electric command. @@ -339,28 +329,32 @@ list `erlang-electric-newline-inhibit-list'. Note that commands in this list are required to set the variable `erlang-electric-newline-inhibit' to nil when the newline shouldn't be -inhibited.") +inhibited." + :group 'erlang + :type 'boolean + :safe 'booleanp) (defvar erlang-electric-newline-inhibit-list '(erlang-electric-semicolon erlang-electric-comma erlang-electric-gt) - "*Commands which can inhibit the next newline.") + "Commands which can inhibit the next newline.") -(defvar erlang-electric-semicolon-insert-blank-lines nil - "*Number of blank lines inserted before header, or nil. +(defcustom erlang-electric-semicolon-insert-blank-lines nil + "Number of blank lines inserted before header, or nil. This variable controls the behaviour of `erlang-electric-semicolon' when a new function header is generated. When nil, no blank line is inserted between the current line and the new header. When bound to a number it represents the number of blank lines which should be -inserted.") +inserted." + :group 'erlang) (defvar erlang-electric-semicolon-criteria '(erlang-next-lines-empty-p erlang-at-keyword-end-p erlang-at-end-of-function-p) - "*List of functions controlling `erlang-electric-semicolon'. + "List of functions controlling `erlang-electric-semicolon'. The functions in this list are called, in order, whenever a semicolon is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -381,7 +375,7 @@ The test is performed by the function `erlang-test-criteria-list'.") erlang-at-keyword-end-p erlang-at-end-of-clause-p erlang-at-end-of-function-p) - "*List of functions controlling `erlang-electric-comma'. + "List of functions controlling `erlang-electric-comma'. The functions in this list are called, in order, whenever a comma is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -399,7 +393,7 @@ The test is performed by the function `erlang-test-criteria-list'.") '(erlang-stop-when-in-type-spec erlang-next-lines-empty-p erlang-at-end-of-function-p) - "*List of functions controlling the arrow aspect of `erlang-electric-gt'. + "List of functions controlling the arrow aspect of `erlang-electric-gt'. The functions in this list are called, in order, whenever a `>' is typed. Each function in the list is called with no arguments, and should return one of the following values: @@ -415,7 +409,7 @@ The test is performed by the function `erlang-test-criteria-list'.") (defvar erlang-electric-newline-criteria '(t) - "*List of functions controlling `erlang-electric-newline'. + "List of functions controlling `erlang-electric-newline'. The electric newline commands indents the next line. Should the current line begin with a comment the comment start is copied to @@ -435,8 +429,8 @@ list, it is treated as a function triggering the electric command. The test is performed by the function `erlang-test-criteria-list'.") -(defvar erlang-next-lines-empty-threshold 2 - "*Number of blank lines required to activate an electric command. +(defcustom erlang-next-lines-empty-threshold 2 + "Number of blank lines required to activate an electric command. Actually, this value controls the behaviour of the function `erlang-next-lines-empty-p' which normally is a member of the @@ -457,46 +451,67 @@ function `erlang-next-lines-empty-p' would be removed from the criteria lists. Note that even if `erlang-next-lines-empty-p' should not trigger an -electric command, other functions in the criteria list could.") +electric command, other functions in the criteria list could." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) -(defvar erlang-new-clause-with-arguments nil - "*Non-nil means that the arguments are cloned when a clause is generated. +(defcustom erlang-new-clause-with-arguments nil + "Non-nil means that the arguments are cloned when a clause is generated. A new function header can be generated by calls to the function -`erlang-generate-new-clause' and by use of the electric semicolon.") +`erlang-generate-new-clause' and by use of the electric semicolon." + :group 'erlang + :type 'boolean + :safe 'booleanp) -(defvar erlang-compile-use-outdir t - "*When nil, go to the directory containing source file when compiling. +(defcustom erlang-compile-use-outdir t + "When nil, go to the directory containing source file when compiling. This is a workaround for a bug in the `outdir' option of compile. If the outdir is not in the current load path, Erlang doesn't load the object module after it has been compiled. To activate the workaround, place the following in your `~/.emacs' file: - (setq erlang-compile-use-outdir nil)") - -(defvar erlang-indent-level 4 - "*Indentation of Erlang calls/clauses within blocks.") -(put 'erlang-indent-level 'safe-local-variable 'integerp) - -(defvar erlang-icr-indent nil - "*Indentation of Erlang if/case/receive/ patterns. `nil' means - keeping default behavior. When non-nil, indent to th column of - if/case/receive.") - -(defvar erlang-indent-guard 2 - "*Indentation of Erlang guards.") -(put 'erlang-indent-guard 'safe-local-variable 'integerp) - -(defvar erlang-argument-indent 2 - "*Indentation of the first argument in a function call. + (setq erlang-compile-use-outdir nil)" + :group 'erlang + :type 'boolean + :safe 'booleanp) + +(defcustom erlang-indent-level 4 + "Indentation of Erlang calls/clauses within blocks." + :group 'erlang + :type 'integer + :safe 'integerp) + +(defcustom erlang-icr-indent nil + "Indentation of Erlang if/case/receive patterns. +nil means keeping default behavior. When non-nil, indent to the column of +if/case/receive." + :group 'erlang + :type 'boolean + :safe 'booleanp) + +(defcustom erlang-indent-guard 2 + "Indentation of Erlang guards." + :group 'erlang + :type 'integer + :safe 'integerp) + +(defcustom erlang-argument-indent 2 + "Indentation of the first argument in a function call. When nil, indent to the column after the `(' of the -function.") -(put 'erlang-argument-indent 'safe-local-variable '(lambda (val) (or (null val) (integerp val)))) - -(defvar erlang-tab-always-indent t - "*Non-nil means TAB in Erlang mode should always re-indent the current line, -regardless of where in the line point is when the TAB command is used.") +function." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) + +(defcustom erlang-tab-always-indent t + "Non-nil means TAB in Erlang mode should always re-indent the current line, +regardless of where in the line point is when the TAB command is used." + :group 'erlang + :type 'boolean + :safe 'booleanp) (defvar erlang-man-inhibit (eq system-type 'windows-nt) "Inhibit the creation of the Erlang Manual Pages menu. @@ -509,7 +524,7 @@ there is no attempt to create the menu.") ("Man - Modules" "/man/man3" t) ("Man - Files" "/man/man4" t) ("Man - Applications" "/man/man6" t)) - "*The man directories displayed in the Erlang menu. + "The man directories displayed in the Erlang menu. Each item in the list should be a list with three elements, the first the name of the menu, the second the directory, and the last a flag. @@ -517,17 +532,17 @@ Should the flag the nil, the directory is absolute, should it be non-nil the directory is relative to the variable `erlang-root-dir'.") (defvar erlang-man-max-menu-size 35 - "*The maximum number of menu items in one menu allowed.") + "The maximum number of menu items in one menu allowed.") (defvar erlang-man-display-function 'erlang-man-display - "*Function used to display man page. + "Function used to display man page. The function is called with one argument, the name of the file containing the man page. Use this variable when the default function, `erlang-man-display', does not work on your system.") (defvar erlang-compile-extra-opts '() - "*Additional options to the compilation command. + "Additional options to the compilation command. This is an elisp list of options. Each option can be either: - an atom - a dotted pair @@ -539,7 +554,7 @@ Example: '(bin_opt_info (i . \"/path1/include\") (i . \"/path2/include\"))") (".xrl\\'" . inferior-erlang-compute-leex-compile-command) (".yrl\\'" . inferior-erlang-compute-yecc-compile-command) ("." . inferior-erlang-compute-erl-compile-command)) - "*Alist of filename patterns vs corresponding compilation functions. + "Alist of filename patterns vs corresponding compilation functions. Each element looks like (REGEXP . FUNCTION). Compiling a file whose name matches REGEXP specifies FUNCTION to use to compute the compilation command. The FUNCTION will be called with two arguments: module name and @@ -547,14 +562,14 @@ default compilation options, like output directory. The FUNCTION is expected to return a string.") (defvar erlang-leex-compile-opts '() - "*Options to pass to leex when compiling xrl files. + "Options to pass to leex when compiling xrl files. This is an elisp list of options. Each option can be either: - an atom - a dotted pair - a string") (defvar erlang-yecc-compile-opts '() - "*Options to pass to yecc when compiling yrl files. + "Options to pass to yecc when compiling yrl files. This is an elisp list of options. Each option can be either: - an atom - a dotted pair @@ -562,7 +577,7 @@ This is an elisp list of options. Each option can be either: (eval-and-compile (defvar erlang-regexp-modern-p - (if (> erlang-emacs-major-version 21) t nil) + (if (> emacs-major-version 21) t nil) "Non-nil when this version of Emacs uses a modern version of regexp. Supporting \_< and \_> This is determined by checking the version of Emacs used.")) @@ -608,6 +623,24 @@ The regexp must be surrounded with a pair of regexp parentheses.")) This is used to determine matches in complex regexps which contains `erlang-variable-regexp'.")) +(defconst erlang-module-function-regexp + (eval-when-compile + (concat erlang-atom-regexp ":" erlang-atom-regexp)) + "Regexp matching an erlang module:function.") + +(defconst erlang-name-regexp + (concat "\\(" + "\\(?:\\sw\\|\\s_\\)+" + "\\|" + erlang-atom-quoted-regexp + "\\)") + "Matches a name of a function, macro or record") + +(defconst erlang-id-regexp + (concat "\\(?:\\(qualified-function\\|record\\|macro\\|module\\) \\)?" + "\\(?:" erlang-atom-regexp ":\\)?" + erlang-name-regexp "?" + "\\(?:/\\([0-9]+\\)\\)?")) (eval-and-compile (defun erlang-regexp-opt (strings &optional paren) @@ -983,7 +1016,7 @@ resulting regexp is surrounded by \\_< and \\_>." "Regexp which should match beginning of a clause.") (defvar erlang-file-name-extension-regexp "\\.erl$" - "*Regexp which should match an Erlang file name. + "Regexp which should match an Erlang file name. This regexp is used when an Erlang module name is extracted from the name of an Erlang source file. @@ -997,7 +1030,7 @@ tags system should interpret tags on the form `module:tag' for files written in other languages than Erlang.") (defvar erlang-inferior-shell-split-window t - "*If non-nil, when starting an inferior shell, split windows. + "If non-nil, when starting an inferior shell, split windows. If nil, the inferior shell replaces the window. This is the traditional behaviour.") @@ -1043,7 +1076,7 @@ behaviour.") (unless inferior-erlang-use-cmm (define-key map "\C-x`" 'erlang-next-error)) map) - "*Keymap used in Erlang mode.") + "Keymap used in Erlang mode.") (defvar erlang-mode-abbrev-table nil "Abbrev table in use in Erlang-mode buffers.") (defvar erlang-mode-syntax-table nil @@ -1310,29 +1343,6 @@ replaced by `erlang-etags-tags-completion-table'.") ;;; Avoid errors while compiling this file. -;; `eval-when-compile' is not defined in Emacs 18. We define it as a -;; no-op. -(or (fboundp 'eval-when-compile) - (defmacro eval-when-compile (&rest rest) nil)) - -;; These umm...functions are new in Emacs 20. And, yes, until version -;; 19.27 Emacs backquotes were this ugly. - -(or (fboundp 'unless) - (defmacro unless (condition &rest body) - "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil." - `((if (, condition) nil ,@body)))) - -(or (fboundp 'when) - (defmacro when (condition &rest body) - "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil." - `((if (, condition) (progn ,@body) nil)))) - -(or (fboundp 'char-before) - (defmacro char-before (&optional pos) - "Return the character in the current buffer just before POS." - `( (char-after (1- (or ,pos (point))))))) - ;; defvar some obsolete variables, which we still support for ;; backwards compatibility reasons. (eval-when-compile @@ -1360,20 +1370,11 @@ replaced by `erlang-etags-tags-completion-table'.") (defun erlang-version () "Return the current version of Erlang mode." (interactive) - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (message "Erlang mode version %s, written by Anders Lindgren" erlang-version)) erlang-version) -(defun erlang-interactive-p () - (if (fboundp 'called-interactively-p) - (called-interactively-p 'interactive) - (funcall (symbol-function 'interactive-p)))) - -(unless (fboundp 'prog-mode) - (defun prog-mode () - (use-local-map (make-keymap)))) - ;;;###autoload (define-derived-mode erlang-mode prog-mode "Erlang" "Major mode for editing Erlang source files in Emacs. @@ -1462,40 +1463,43 @@ Other commands: (add-to-list 'auto-mode-alist (cons r 'erlang-mode))) (defun erlang-syntax-table-init () - (if (null erlang-mode-syntax-table) - (let ((table (make-syntax-table))) - (modify-syntax-entry ?\n ">" table) - (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?# "." table) - ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards - ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems - (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $" - ;; we have to live with that for now..it is the best alternative - ;; that can be worked around with "string hat ends with \$" - (modify-syntax-entry ?% "<" table) - (modify-syntax-entry ?& "." table) - (modify-syntax-entry ?\' "\"" table) - (modify-syntax-entry ?* "." table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?/ "." table) - (modify-syntax-entry ?: "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?_ "_" table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?^ "'" table) - - ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. - ;;(modify-syntax-entry ?\253 "(?\273" table) - ;;(modify-syntax-entry ?\273 ")?\253" table) - - (setq erlang-mode-syntax-table table))) - + (erlang-ensure-syntax-table-is-initialized) (set-syntax-table erlang-mode-syntax-table)) +(defun erlang-ensure-syntax-table-is-initialized () + (unless erlang-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?# "." table) + ;; (modify-syntax-entry ?$ "\\" table) ;; Creates problems with indention afterwards + ;; (modify-syntax-entry ?$ "'" table) ;; Creates syntax highlighting and indention problems + (modify-syntax-entry ?$ "/" table) ;; Misses the corner case "string that ends with $" + ;; we have to live with that for now..it is the best alternative + ;; that can be worked around with "string that ends with \$" + (modify-syntax-entry ?% "<" table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?* "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?/ "." table) + (modify-syntax-entry ?: "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?^ "'" table) + + ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. + ;;(modify-syntax-entry ?\253 "(?\273" table) + ;;(modify-syntax-entry ?\273 ")?\253" table) + + (setq erlang-mode-syntax-table table)))) + + (defun erlang-electric-init () ;; Set up electric character functions to work with @@ -1541,7 +1545,7 @@ Other commands: (make-local-variable 'indent-region-function) (setq indent-region-function 'erlang-indent-region) (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent) - (if (<= erlang-emacs-major-version 18) + (if (<= emacs-major-version 18) (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent)) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'dabbrev-case-fold-search) nil) @@ -1778,7 +1782,7 @@ Please see the variable `erlang-menu-base-items'." (if (and popup (boundp 'mode-popup-menu)) (funcall (symbol-function 'set) 'mode-popup-menu erlang-xemacs-popup-menu)))) - ((>= erlang-emacs-major-version 19) + ((>= emacs-major-version 19) (define-key keymap (vector 'menu-bar (intern name)) (erlang-menu-make-keymap name items))) (t nil))) @@ -1961,7 +1965,9 @@ menu is left unchanged." The variable `erlang-man-dirs' contains entries describing the location of the manual pages." (interactive) - (if erlang-man-inhibit + (if (or erlang-man-inhibit + (and (boundp 'menu-bar-mode) + (not menu-bar-mode))) () (setq erlang-menu-man-items '(nil @@ -2000,7 +2006,7 @@ The format is described in the documentation of `erlang-man-dirs'." (setq dir (cond ((nth 2 (car dir-list)) ;; Relative to `erlang-root-dir'. (and (stringp erlang-root-dir) - (concat erlang-root-dir (nth 1 (car dir-list))))) + (erlang-man-dir (nth 1 (car dir-list))))) (t ;; Absolute (nth 1 (car dir-list))))) @@ -2018,6 +2024,8 @@ The format is described in the documentation of `erlang-man-dirs'." '(("Man Pages" (("Error! Why?" erlang-man-describe-error))))))) +(defun erlang-man-dir (subdir) + (concat erlang-root-dir "/lib/erlang/" subdir)) ;; Should the menu be to long, let's split it into a number of ;; smaller menus. Warning, this code contains beautiful @@ -2080,7 +2088,7 @@ menus is created." "Find manual page for MODULE, defaults to module of function under point. This function is aware of imported functions." (interactive - (list (let* ((mod (car-safe (erlang-get-function-under-point))) + (list (let* ((mod (erlang-default-module)) (input (read-string (format "Manual entry for module%s: " (if (or (null mod) (string= mod "")) @@ -2089,26 +2097,36 @@ This function is aware of imported functions." (if (string= input "") mod input)))) - (or module (setq module (car (erlang-get-function-under-point)))) - (if (or (null module) (string= module "")) - (error "No Erlang module name given")) + (setq module (or module + (erlang-default-module))) + (when (or (null module) (string= module "")) + (error "No Erlang module name given")) (let ((dir-list erlang-man-dirs) - (pat (concat "/" (regexp-quote module) "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")) + (pat (concat "/" (regexp-quote module) + "\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$")) (file nil) file-list) (while (and dir-list (null file)) - (setq file-list (erlang-man-get-files - (if (nth 2 (car dir-list)) - (concat erlang-root-dir (nth 1 (car dir-list))) - (nth 1 (car dir-list))))) - (while (and file-list (null file)) - (if (string-match pat (car file-list)) - (setq file (car file-list))) - (setq file-list (cdr file-list))) - (setq dir-list (cdr dir-list))) + (let ((dir (if (nth 2 (car dir-list)) + (erlang-man-dir (nth 1 (car dir-list))) + (nth 1 (car dir-list))))) + (when (file-directory-p dir) + (setq file-list (erlang-man-get-files dir)) + (while (and file-list (null file)) + (if (string-match pat (car file-list)) + (setq file (car file-list))) + (setq file-list (cdr file-list)))) + (setq dir-list (cdr dir-list)))) (if file (funcall erlang-man-display-function file) - (error "No manual page for module %s found" module)))) + ;; Did not found the manual file. Fallback to manual-entry. + (manual-entry module)))) + +(defun erlang-default-module () + (let ((id (erlang-get-identifier-at-point))) + (if (eq (erlang-id-kind id) 'qualified-function) + (erlang-id-module id) + (erlang-id-name id)))) ;; Warning, the function `erlang-man-function' is a hack! @@ -2128,37 +2146,28 @@ The entry for `function' is displayed. This function is aware of imported functions." (interactive - (list (let* ((mod-func (erlang-get-function-under-point)) - (mod (car-safe mod-func)) - (func (nth 1 mod-func)) + (list (let* ((default (erlang-default-function-or-module)) (input (read-string (format "Manual entry for `module:func' or `module'%s: " - (if (or (null mod) (string= mod "")) - "" - (format " (default %s:%s)" mod func)))))) + (if default + (format " (default %s)" default) + ""))))) (if (string= input "") - (if (and mod func) - (concat mod ":" func) - mod) + default input)))) - ;; Emacs 18 doesn't provide `man'... - (condition-case nil - (require 'man) - (error nil)) + (require 'man) + (setq name (or name + (erlang-default-function-or-module))) (let ((modname nil) (funcname nil)) - (cond ((null name) - (let ((mod-func (erlang-get-function-under-point))) - (setq modname (car-safe mod-func)) - (setq funcname (nth 1 mod-func)))) - ((string-match ":" name) + (cond ((string-match ":" name) (setq modname (substring name 0 (match-beginning 0))) (setq funcname (substring name (match-end 0) nil))) ((stringp name) (setq modname name))) - (if (or (null modname) (string= modname "")) - (error "No Erlang module name given")) + (when (or (null modname) (string= modname "")) + (error "No Erlang module name given")) (cond ((fboundp 'Man-notify-when-ready) ;; Emacs 19: The man command could possibly start an ;; asynchronous process, i.e. we must hook ourselves into @@ -2168,16 +2177,20 @@ This function is aware of imported functions." () (erlang-man-patch-notify) (setq erlang-man-function-name funcname)) - (condition-case nil + (condition-case err (erlang-man-module modname) - (error (setq erlang-man-function-name nil)))) + (error (setq erlang-man-function-name nil) + (signal (car err) (cdr err))))) (t (erlang-man-module modname) - (if funcname - (erlang-man-find-function - (or (get-buffer "*Manual Entry*") ; Emacs 18 - (current-buffer)) ; XEmacs - funcname)))))) + (when funcname + (erlang-man-find-function (current-buffer) funcname)))))) + +(defun erlang-default-function-or-module () + (let ((id (erlang-get-identifier-at-point))) + (if (eq (erlang-id-kind id) 'qualified-function) + (format "%s:%s" (erlang-id-module id) (erlang-id-name id)) + (erlang-id-name id)))) ;; Should the defadvice be at the top level, the package `advice' would @@ -2222,36 +2235,22 @@ command is executed asynchronously." (set-window-point win (point))) (message "Could not find function `%s'" func))))))) +(defvar erlang-man-file-regexp + "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$") (defun erlang-man-display (file) "Display FILE as a `man' file. This is the default manual page display function. The variables `erlang-man-display-function' contains the function to be used." - ;; Emacs 18 doesn't `provide' man. - (condition-case nil - (require 'man) - (error nil)) + (require 'man) (if file (let ((process-environment (copy-sequence process-environment))) - (if (string-match "\\(.*\\)/man[^/]*/\\([^.]+\\)\\.\\([124-9]\\|3\\(erl\\)?\\)\\(\\.gz\\)?$" file) + (if (string-match erlang-man-file-regexp file) (let ((dir (substring file (match-beginning 1) (match-end 1))) (page (substring file (match-beginning 2) (match-end 2)))) - (if (fboundp 'setenv) - (setenv "MANPATH" dir) - ;; Emacs 18 - (setq process-environment (cons (concat "MANPATH=" dir) - process-environment))) - (cond ((not (and (not erlang-xemacs-p) - (= erlang-emacs-major-version 19) - (< erlang-emacs-minor-version 29))) - (manual-entry page)) - (t - ;; Emacs 19.28 and earlier versions of 19: - ;; The manual-entry command unconditionally prompts - ;; the user :-( - (funcall (symbol-function 'Man-getpage-in-background) - page)))) + (setenv "MANPATH" dir) + (manual-entry page)) (error "Can't find man page for %s\n" file))))) @@ -2394,7 +2393,7 @@ can contain other `tempo' attributes. Please see the function The first character of DD is space if the value is less than 10." (let ((date (current-time-string))) (format "%2d %s %s" - (erlang-string-to-int (substring date 8 10)) + (string-to-number (substring date 8 10)) (substring date 4 7) (substring date -4)))) @@ -2956,10 +2955,10 @@ Return nil if inside string, t if in a comment." ((eq (car stack-top) '->) ;; If in fun definition use standard indent level not double ;;(if (not (eq (car (car (cdr stack))) 'fun)) - ;; Removed it made multi clause fun's look to bad + ;; Removed it made multi clause fun's look too bad (setq off (+ erlang-indent-level (if (not erlang-icr-indent) erlang-indent-level - erlang-icr-indent))))) + erlang-icr-indent))))) (let ((base (erlang-indent-find-base stack indent-point off skip))) ;; Special cases (goto-char indent-point) @@ -3597,7 +3596,7 @@ corresponds to the order of the parsed Erlang list." (erlang-remove-quotes (erlang-buffer-substring (match-beginning 1) (match-end 1))) - (erlang-string-to-int + (string-to-number (erlang-buffer-substring (match-beginning (+ 1 erlang-atom-regexp-matches)) @@ -3696,34 +3695,50 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.: (defun erlang-get-function-arity () "Return the number of arguments of function at point, or nil." - (and (looking-at (eval-when-compile - (concat "^" erlang-atom-regexp "\\s *("))) - (save-excursion - (goto-char (match-end 0)) - (condition-case nil - (let ((res 0) - (cont t)) - (while cont - (cond ((eobp) - (setq res nil) - (setq cont nil)) - ((looking-at "\\s *)") - (setq cont nil)) - ((looking-at "\\s *\\($\\|%\\)") - (forward-line 1)) - ((looking-at "\\s *<<[^>]*?>>") - (when (zerop res) - (setq res (+ 1 res))) - (goto-char (match-end 0))) - ((looking-at "\\s *,") - (setq res (+ 1 res)) - (goto-char (match-end 0))) - (t - (when (zerop res) - (setq res (+ 1 res))) - (forward-sexp 1)))) - res) - (error nil))))) + (erlang-get-arity-after-regexp (concat "^" erlang-atom-regexp "\\s *("))) + +(defun erlang-get-argument-list-arity () + "Return the number of arguments in argument list at point, or nil. +The point should be before the opening parenthesis of the +argument list before calling this function." + (erlang-get-arity-after-regexp "\\s *(")) + +(defun erlang-get-arity-after-regexp (regexp) + "Return the number of arguments in argument list after REGEXP, or nil." + (when (looking-at regexp) + (save-excursion + (goto-char (match-end 0)) + (erlang-get-arity)))) + +(defun erlang-get-arity () + "Return the number of arguments in argument list at point, or nil. +The point should be after the opening parenthesis of the argument +list before calling this function." + (condition-case nil + (let ((res 0) + (cont t)) + (while cont + (cond ((eobp) + (setq res nil) + (setq cont nil)) + ((looking-at "\\s *)") + (setq cont nil)) + ((looking-at "\\s *\\($\\|%\\)") + (forward-line 1)) + ((looking-at "\\s *<<[^>]*?>>") + (when (zerop res) + (setq res (+ 1 res))) + (goto-char (match-end 0))) + ((looking-at "\\s *,") + (setq res (+ 1 res)) + (goto-char (match-end 0))) + (t + (when (zerop res) + (setq res (+ 1 res))) + (forward-sexp 1)))) + res) + (error nil))) + (defun erlang-get-function-name-and-arity () "Return the name and arity of the function at point, or nil. @@ -3746,6 +3761,8 @@ The return value is a string of the form \"foo/1\"." (error nil))))) +;; Keeping erlang-get-function-under-point for backward compatibility. +;; It is used by erldoc.el and maybe other code out there. (defun erlang-get-function-under-point () "Return the module and function under the point, or nil. @@ -3755,44 +3772,141 @@ list of imported functions is searched. The following could be returned: (\"module\" \"function\") -- Both module and function name found. (nil \"function\") -- No module name was found. - nil -- No function name found + nil -- No function name found. + +See also `erlang-get-identifier-at-point'." + (let* ((id (erlang-get-identifier-at-point)) + (kind (erlang-id-kind id)) + (module (erlang-id-module id)) + (name (erlang-id-name id))) + (cond ((eq kind 'qualified-function) + (list module name)) + (name + (list nil name))))) + +(defun erlang-get-identifier-at-point () + "Return the erlang identifier at point, or nil. + +Should no explicit module name be present at the point, the +list of imported functions is searched. + +When an identifier is found return a list with 4 elements: + +1. Kind - One of the symbols qualified-function, record, macro, +module or nil. + +2. Module - Module name string or nil. In case of a +qualified-function a search fails if no entries with correct +module are found. For other kinds the module is just a +preference. If no matching entries are found the search will be +retried without regard to module. + +3. Name - String name of function, module, record or macro. -In the future the list may contain more elements." +4. Arity - Integer in case of functions and macros if the number +of arguments could be found, otherwise nil." (save-excursion - (let ((md (match-data)) - (res nil)) + (save-match-data (if (eq (char-syntax (following-char)) ? ) (skip-chars-backward " \t")) - (skip-chars-backward "a-zA-Z0-9_:'") - (cond ((looking-at (eval-when-compile - (concat erlang-atom-regexp ":" erlang-atom-regexp))) - (setq res (list - (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning 1) (match-end 1))) - (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning (1+ erlang-atom-regexp-matches)) - (match-end (1+ erlang-atom-regexp-matches))))))) - ((looking-at erlang-atom-regexp) - (let ((fk (erlang-remove-quotes - (erlang-buffer-substring - (match-beginning 0) (match-end 0)))) - (mod nil) - (imports (erlang-get-import))) - (while (and imports (null mod)) - (if (assoc fk (cdr (car imports))) - (setq mod (car (car imports))) - (setq imports (cdr imports)))) - (cond ((eq (preceding-char) ?#) - (setq fk (concat "-record(" fk))) - ((eq (preceding-char) ??) - (setq fk (concat "-define(" fk))) - ((and (null mod) (not (member fk erlang-int-bifs))) - (setq mod (erlang-get-module)))) - (setq res (list mod fk))))) - (store-match-data md) - res))) + (skip-chars-backward "[:word:]_:'") + (cond ((looking-at erlang-module-function-regexp) + (erlang-get-qualified-function-id-at-point)) + ((looking-at (concat erlang-atom-regexp ":")) + (erlang-get-module-id-at-point)) + ((looking-at erlang-name-regexp) + (erlang-get-some-other-id-at-point)))))) + +(defun erlang-get-qualified-function-id-at-point () + (let ((kind 'qualified-function) + (module (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 1) (match-end 1)))) + (name (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning (1+ erlang-atom-regexp-matches)) + (match-end (1+ erlang-atom-regexp-matches))))) + (arity (progn + (goto-char (match-end 0)) + (erlang-get-argument-list-arity)))) + (list kind module name arity))) + +(defun erlang-get-module-id-at-point () + (let ((kind 'module) + (module nil) + (name (erlang-remove-quotes + (erlang-buffer-substring (match-beginning 1) + (match-end 1)))) + (arity nil)) + (list kind module name arity))) + +(defun erlang-get-some-other-id-at-point () + (let ((name (erlang-remove-quotes + (erlang-buffer-substring + (match-beginning 0) (match-end 0)))) + (imports (erlang-get-import)) + kind module arity) + (while (and imports (null module)) + (if (assoc name (cdr (car imports))) + (setq module (car (car imports))) + (setq imports (cdr imports)))) + (cond ((eq (preceding-char) ?#) + (setq kind 'record)) + ((eq (preceding-char) ??) + (setq kind 'macro)) + ((and (null module) (not (member name erlang-int-bifs))) + (setq module (erlang-get-module)))) + (setq arity (progn + (goto-char (match-end 0)) + (erlang-get-argument-list-arity))) + (list kind module name arity))) + +(defmacro erlang-with-id (slots id-string &rest body) + (declare (indent 2)) + (let ((id-var (make-symbol "id"))) + `(let* ((,id-var (erlang-id-to-list ,id-string)) + ,@(mapcar (lambda (slot) + (list slot + (list (intern (format "erlang-id-%s" slot)) + id-var))) + slots)) + ,@body))) + +(defun erlang-id-to-string (id) + (when id + (erlang-with-id (kind module name arity) id + (format "%s%s%s%s" + (if kind (format "%s " kind) "") + (if module (format "%s:" module) "") + name + (if arity (format "/%s" arity) ""))))) + +(defun erlang-id-to-list (id) + (if (listp id) + id + (save-match-data + (erlang-ensure-syntax-table-is-initialized) + (with-syntax-table erlang-mode-syntax-table + (let (case-fold-search) + (when (string-match erlang-id-regexp id) + (list (when (match-string 1 id) + (intern (match-string 1 id))) + (match-string 2 id) + (match-string 3 id) + (when (match-string 4 id) + (string-to-number (match-string 4 id)))))))))) + +(defun erlang-id-kind (id) + (car (erlang-id-to-list id))) + +(defun erlang-id-module (id) + (nth 1 (erlang-id-to-list id))) + +(defun erlang-id-name (id) + (nth 2 (erlang-id-to-list id))) + +(defun erlang-id-arity (id) + (nth 3 (erlang-id-to-list id))) ;; TODO: Escape single quotes inside the string without @@ -3822,10 +3936,10 @@ In the future the list may contain more elements." "Returns non-nil if there is an exported function in the current buffer between point and MAX." (block nil - (while (and (not erlang-inhibit-exported-function-name-face) - (erlang-match-next-function max)) - (when (erlang-last-match-exported-p) - (return (match-data)))))) + (while (and (not erlang-inhibit-exported-function-name-face) + (erlang-match-next-function max)) + (when (erlang-last-match-exported-p) + (return (match-data)))))) (defun erlang-match-next-function (max) "Searches forward in current buffer for the next erlang function, @@ -4084,7 +4198,7 @@ non-whitespace characters following the point on the current line." nil))) -(defun erlang-electric-arrow\ off (&optional arg) +(defun erlang-electric-arrow (&optional arg) "Insert a '>'-sign and possibly a new indented line. This command is only `electric' when the `>' is part of an `->' arrow. @@ -4310,8 +4424,8 @@ This function is designed to be a member of a criteria list." (looking-at "end[^_a-zA-Z0-9]"))) -;; Erlang tags support which is aware of erlang modules. -;; +;;; Erlang tags support which is aware of erlang modules. + ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags ;; package works under XEmacs.) @@ -4369,7 +4483,7 @@ This function only works under Emacs 18 and Emacs 19. Currently, It is not implemented under XEmacs. (Hint: The Emacs 19 etags module works under XEmacs.)" (interactive) - (cond ((= erlang-emacs-major-version 18) + (cond ((= emacs-major-version 18) (require 'tags) (erlang-tags-define-keys (current-local-map)) (setq erlang-tags-installed t)) @@ -4409,20 +4523,6 @@ works under XEmacs.)" (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist) (erlang-menu-init)) - -(defun erlang-find-tag-default () - "Return the default tag. -Search `-import' list of imported functions. -Single quotes are been stripped away." - (let ((mod-func (erlang-get-function-under-point))) - (cond ((null mod-func) - nil) - ((null (car mod-func)) - (nth 1 mod-func)) - (t - (concat (car mod-func) ":" (nth 1 mod-func)))))) - - ;; Return `t' since it is used inside `tags-loop-form'. ;;;###autoload (defun erlang-find-tag (modtagname &optional next-p regexp-p) @@ -4609,7 +4709,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (list nil (if (< (prefix-numeric-value current-prefix-arg) 0) '- t)) - (let* ((default (erlang-find-tag-default)) + (let* ((default (erlang-default-function-or-module)) (prompt (if default (format "%s(default %s) " prompt default) prompt)) @@ -4633,7 +4733,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." ;; Make sure our functions are installed in TAGS files loaded ;; into Emacs while searching. (cond - ((>= erlang-emacs-major-version 20) + ((>= emacs-major-version 20) (setq erlang-tags-orig-format-functions (symbol-value 'tags-table-format-functions)) (funcall (symbol-function 'set) 'tags-table-format-functions @@ -4711,7 +4811,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (defun erlang-tags-remove-module-check () "Remove our own tags search functions." (cond - ((>= erlang-emacs-major-version 20) + ((>= emacs-major-version 20) (funcall (symbol-function 'set) 'tags-table-format-functions erlang-tags-orig-format-functions) @@ -4961,6 +5061,14 @@ about Erlang modules." ;; It adds awareness of the module:tag syntax in a similar way that is ;; done above for the old etags commands. +(defvar erlang-current-arity nil + "The arity of the function currently being searched. + +There is no information about arity in the TAGS file. +Consecutive functions with same name but different arity will +only get one entry in the TAGS file. Matching TAGS entries are +therefore selected without regarding arity. The arity is +considered first when it is time to jump to the definition.") (defun erlang-etags--xref-backend () 'erlang-etags) @@ -4970,13 +5078,14 @@ about Erlang modules." (and (erlang-soft-require 'xref) (erlang-soft-require 'cl-generic) + (erlang-soft-require 'eieio) ;; The purpose of using eval here is to avoid compilation - ;; warnings in emacsen without cl-defmethod. + ;; warnings in emacsen without cl-defmethod etc. (eval '(progn (cl-defmethod xref-backend-identifier-at-point ((_backend (eql erlang-etags))) - (erlang-find-tag-default)) + (erlang-id-to-string (erlang-get-identifier-at-point))) (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags)) identifier) @@ -4989,42 +5098,99 @@ about Erlang modules." (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql erlang-etags))) (let ((erlang-replace-etags-tags-completion-table t)) - (tags-completion-table)))))) - - + (tags-completion-table))) + + (defclass erlang-xref-location (xref-etags-location) ()) + + (defun erlang-convert-xrefs (xrefs) + (mapcar (lambda (xref) + (oset xref location (erlang-make-location + (oref xref location))) + xref) + xrefs)) + + (defun erlang-make-location (etags-location) + (with-slots (tag-info file) etags-location + (make-instance 'erlang-xref-location :tag-info tag-info + :file file))) + + (cl-defmethod xref-location-marker ((locus erlang-xref-location)) + (with-slots (tag-info file) locus + (with-current-buffer (find-file-noselect file) + (save-excursion + (or (erlang-goto-tag-location-by-arity tag-info) + (etags-goto-tag-location tag-info)) + ;; Reset erlang-current-arity. We want to jump to + ;; correct arity in the first attempt. That is now + ;; done. Possible remaining jumps will be from + ;; entries in the *xref* buffer and then we want to + ;; ignore the arity. (Alternatively we could remove + ;; all but one xref entry per file when we know the + ;; arity). + (setq erlang-current-arity nil) + (point-marker))))) + + (defun erlang-xref-context (xref) + (with-slots (tag-info) (xref-item-location xref) + (car tag-info)))))) + + +(defun erlang-goto-tag-location-by-arity (tag-info) + (when erlang-current-arity + (let* ((tag-text (car tag-info)) + (tag-pos (cdr (cdr tag-info))) + (tag-line (car (cdr tag-info))) + (regexp (erlang-tag-info-regexp tag-text)) + (startpos (or tag-pos + (when tag-line + (goto-char (point-min)) + (forward-line (1- tag-line)) + (point)) + (point-min)))) + (setq startpos (max (- startpos 2000) + (point-min))) + (goto-char startpos) + (let ((pos (or (erlang-search-by-arity regexp) + (unless (eq startpos (point-min)) + (goto-char (point-min)) + (erlang-search-by-arity regexp))))) + (when pos + (goto-char pos) + t))))) + +(defun erlang-tag-info-regexp (tag-text) + (concat "^" + (regexp-quote tag-text) + ;; Erlang function entries in TAGS includes the opening + ;; parenthesis for the argument list. Erlang macro entries + ;; do not. Add it here in order to end up in correct + ;; position for erlang-get-arity. + (if (string-prefix-p "-define" tag-text) + "\\s-*(" + ""))) + +(defun erlang-search-by-arity (regexp) + (let (pos) + (while (and (null pos) + (re-search-forward regexp nil t)) + (when (eq erlang-current-arity (save-excursion (erlang-get-arity))) + (setq pos (point-at-bol)))) + pos)) (defun erlang-xref-find-definitions (identifier &optional is-regexp) - (let ((id-list (split-string identifier ":"))) - (cond - ;; Handle "tag" - ((null (cdr id-list)) - (erlang-xref-find-definitions-tag identifier is-regexp)) - ;; Handle "module:" - ((string-equal (cadr id-list) "") - (erlang-xref-find-definitions-module (car id-list))) - ;; Handle "module:tag" - (t - (erlang-xref-find-definitions-module-tag (car id-list) - (cadr id-list) - is-regexp))))) - -(defun erlang-xref-find-definitions-tag (tag is-regexp) - "Find all definitions of TAG and reorder them so that -definitions in the currently visited file comes first." - (when (fboundp 'etags--xref-find-definitions) - (let* ((current-file (and (buffer-file-name) - (file-truename (buffer-file-name)))) - (xrefs (etags--xref-find-definitions tag is-regexp)) - local-xrefs non-local-xrefs) - (while xrefs - (if (string-equal (erlang-xref-truename-file (car xrefs)) - current-file) - (push (car xrefs) local-xrefs) - (push (car xrefs) non-local-xrefs)) - (setq xrefs (cdr xrefs))) - (append (reverse local-xrefs) - (reverse non-local-xrefs))))) + (erlang-with-id (kind module name arity) identifier + (setq erlang-current-arity arity) + (cond ((eq kind 'module) + (erlang-xref-find-definitions-module name)) + (module + (erlang-xref-find-definitions-module-tag module + name + (eq kind + 'qualified-function) + is-regexp)) + (t + (erlang-xref-find-definitions-tag kind name is-regexp))))) (defun erlang-xref-find-definitions-module (module) (and (fboundp 'xref-make) @@ -5048,17 +5214,58 @@ definitions in the currently visited file comes first." (setq files (cdr files)))))) (nreverse xrefs)))) -(defun erlang-xref-find-definitions-module-tag (module tag is-regexp) - "Find all definitions of TAG and filter away definitions -outside of MODULE." - (when (fboundp 'etags--xref-find-definitions) - (let ((xrefs (etags--xref-find-definitions tag is-regexp)) - xrefs-in-module) - (while xrefs - (when (string-equal module (erlang-xref-module (car xrefs))) - (push (car xrefs) xrefs-in-module)) - (setq xrefs (cdr xrefs))) - xrefs-in-module))) + +(defun erlang-xref-find-definitions-module-tag (module + tag + is-qualified + is-regexp) + "Find definitions of TAG and filter away definitions outside of +MODULE. If IS-QUALIFIED is nil and no definitions was found inside +the MODULE then return any definitions found outside. If +IS-REGEXP is non-nil then TAG is a regexp." + (and (fboundp 'etags--xref-find-definitions) + (fboundp 'erlang-convert-xrefs) + (let ((xrefs (erlang-convert-xrefs + (etags--xref-find-definitions tag is-regexp))) + xrefs-in-module) + (dolist (xref xrefs) + (when (string-equal module (erlang-xref-module xref)) + (push xref xrefs-in-module))) + (cond (is-qualified xrefs-in-module) + (xrefs-in-module xrefs-in-module) + (t xrefs))))) + +(defun erlang-xref-find-definitions-tag (kind tag is-regexp) + "Find all definitions of TAG and reorder them so that +definitions in the currently visited file comes first." + (and (fboundp 'etags--xref-find-definitions) + (fboundp 'erlang-convert-xrefs) + (let* ((current-file (and (buffer-file-name) + (file-truename (buffer-file-name)))) + (regexp (erlang-etags-regexp kind tag is-regexp)) + (xrefs (erlang-convert-xrefs + (etags--xref-find-definitions regexp t))) + local-xrefs non-local-xrefs) + (while xrefs + (let ((xref (car xrefs))) + (if (string-equal (erlang-xref-truename-file xref) + current-file) + (push xref local-xrefs) + (push xref non-local-xrefs)) + (setq xrefs (cdr xrefs)))) + (append (reverse local-xrefs) + (reverse non-local-xrefs))))) + +(defun erlang-etags-regexp (kind tag is-regexp) + (let ((tag-regexp (if is-regexp + tag + (regexp-quote tag)))) + (cond ((eq kind 'record) + (concat "-record\\s-*(\\s-*" tag-regexp)) + ((eq kind 'macro) + (concat "-define\\s-*(\\s-*" tag-regexp)) + (t tag-regexp)))) + (defun erlang-xref-module (xref) (erlang-get-module-from-file-name (erlang-xref-file xref))) @@ -5174,7 +5381,7 @@ future, a new shell on an already running host will be started." (defvar erlang-shell-mode-hook nil - "*User functions to run when an Erlang shell is started. + "User functions to run when an Erlang shell is started. This hook is used to change the behaviour of Erlang mode. It is normally used by the user to personalise the programming environment. @@ -5190,7 +5397,7 @@ Erlang source file is loaded into Emacs.") (defvar erlang-input-ring-file-name "~/.erlang_history" - "*When non-nil, file name used to store Erlang shell history information.") + "When non-nil, file name used to store Erlang shell history information.") (defun erlang-shell-mode () @@ -5290,7 +5497,7 @@ Selects Comint or Compilation mode command as appropriate." ;;; (defvar inferior-erlang-display-buffer-any-frame nil - "*When nil, `inferior-erlang-display-buffer' use only selected frame. + "When nil, `inferior-erlang-display-buffer' use only selected frame. When t, all frames are searched. When 'raise, the frame is raised.") (defvar inferior-erlang-shell-type 'newshell @@ -5303,10 +5510,10 @@ nil, the default shell is used. This variable influence the setting of other variables.") (defvar inferior-erlang-machine "erl" - "*The name of the Erlang shell.") + "The name of the Erlang shell.") (defvar inferior-erlang-machine-options '() - "*The options used when activating the Erlang shell. + "The options used when activating the Erlang shell. This must be a list of strings.") @@ -5317,7 +5524,7 @@ This must be a list of strings.") "The name of the inferior Erlang buffer.") (defvar inferior-erlang-prompt-timeout 60 - "*Number of seconds before `inferior-erlang-wait-prompt' timeouts. + "Number of seconds before `inferior-erlang-wait-prompt' timeouts. The time specified is waited after every output made by the inferior Erlang shell. When this variable is t, we assume that we always have @@ -5383,7 +5590,7 @@ editing control characters: (setq inferior-erlang-process (get-buffer-process inferior-erlang-buffer)) - (if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings + (if (> 21 emacs-major-version) ; funcalls to avoid compiler warnings (funcall (symbol-function 'set-process-query-on-exit-flag) inferior-erlang-process nil) (funcall (symbol-function 'process-kill-without-query) inferior-erlang-process)) @@ -5454,7 +5661,7 @@ frame will become deselected before the next command." (defun inferior-erlang-window (&optional all-frames) "Return the window containing the inferior Erlang, or nil." (and (inferior-erlang-running-p) - (if (and all-frames (>= erlang-emacs-major-version 19)) + (if (and all-frames (>= emacs-major-version 19)) (get-buffer-window inferior-erlang-buffer t) (get-buffer-window inferior-erlang-buffer)))) @@ -5551,7 +5758,7 @@ Return the position after the newly inserted command." (boundp 'comint-last-output-start)) (save-excursion (goto-char - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (symbol-value 'comint-last-input-end) (symbol-value 'comint-last-output-start))) (while (progn (skip-chars-forward "^\C-h") @@ -5570,7 +5777,7 @@ Return the position after the newly inserted command." (let ((pmark (process-mark (get-buffer-process (current-buffer))))) (save-excursion (goto-char - (if (erlang-interactive-p) + (if (called-interactively-p 'interactive) (symbol-value 'comint-last-input-end) (symbol-value 'comint-last-output-start))) (while (re-search-forward "\r+$" pmark t) @@ -5938,12 +6145,6 @@ it assumes that NEWDEF is loaded." (ad-unadvise 'Man-notify-when-ready) (ad-unadvise 'set-visited-file-name))))) - -(defun erlang-string-to-int (string) - (if (fboundp 'string-to-number) - (string-to-number string) - (funcall (symbol-function 'string-to-int) string))) - ;; The end... (provide 'erlang) @@ -5951,7 +6152,7 @@ it assumes that NEWDEF is loaded." (run-hooks 'erlang-load-hook) ;; Local variables: -;; coding: iso-8859-1 +;; coding: utf-8 ;; indent-tabs-mode: nil ;; End: diff --git a/lib/tools/emacs/erldoc.el b/lib/tools/emacs/erldoc.el index cb355374d9..e1fd661348 100644 --- a/lib/tools/emacs/erldoc.el +++ b/lib/tools/emacs/erldoc.el @@ -23,8 +23,8 @@ ;; Crawl Erlang/OTP HTML documentation and generate lookup tables. ;; ;; This package depends on `cl-lib', `pcase' and -;; `libxml-parse-html-region'; emacs 24+ compiled with libxml2 should -;; work. On emacs 24.1 and 24.2 do `M-x package-install RET cl-lib +;; `libxml-parse-html-region'. Emacs 24+ compiled with libxml2 should +;; work. On Emacs 24.1 and 24.2 do `M-x package-install RET cl-lib ;; RET' to install `cl-lib'. ;; ;; Please customise `erldoc-man-index' to point to your local OTP @@ -505,4 +505,10 @@ up the indexing." (browse-url (cdr (assoc topic (erldoc-user-guides))))) (provide 'erldoc) + +;; Local variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;;; erldoc.el ends here diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 3bff546243..18c4fe902d 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -129,31 +129,22 @@ extract(#analysis{macros = Macros, %% Process remote types NewCodeServer = try - NewRecords = dialyzer_codeserver:get_temp_records(CodeServer1), + CodeServer2 = + dialyzer_utils:merge_types(CodeServer1, + TrustPLT), % XXX change to the PLT? NewExpTypes = dialyzer_codeserver:get_temp_exported_types(CodeServer1), case sets:size(NewExpTypes) of 0 -> ok end, - OldRecords = dialyzer_plt:get_types(TrustPLT), % XXX change to the PLT? - MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), - CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1), CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2), - {CodeServer4, RecordDict} = - dialyzer_utils:process_record_remote_types(CodeServer3), - dialyzer_contracts:process_contract_remote_types(CodeServer4, RecordDict) + CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3), + dialyzer_contracts:process_contract_remote_types(CodeServer4) catch throw:{error, ErrorMsg} -> compile_error(ErrorMsg) end, %% Create TrustPLT - Contracts = dialyzer_codeserver:get_contracts(NewCodeServer), - Modules = dict:fetch_keys(Contracts), - FoldFun = - fun(Module, TmpPlt) -> - {ok, ModuleContracts} = dict:find(Module, Contracts), - SpecList = [{MFA, Contract} - || {MFA, {_FileLine, Contract}} <- maps:to_list(ModuleContracts)], - dialyzer_plt:insert_contract_list(TmpPlt, SpecList) - end, - NewTrustPLT = lists:foldl(FoldFun, TrustPLT, Modules), + ContractsDict = dialyzer_codeserver:get_contracts(NewCodeServer), + Contracts = orddict:from_list(dict:to_list(ContractsDict)), + NewTrustPLT = dialyzer_plt:insert_contract_list(TrustPLT, Contracts), Analysis#analysis{trust_plt = NewTrustPLT}. %%-------------------------------------------------------------------- @@ -835,19 +826,14 @@ collect_info(Analysis) -> TmpCServer = NewAnalysis#analysis.codeserver, NewCServer = try - NewRecords = dialyzer_codeserver:get_temp_records(TmpCServer), + TmpCServer1 = dialyzer_utils:merge_types(TmpCServer, NewPlt), NewExpTypes = dialyzer_codeserver:get_temp_exported_types(TmpCServer), - OldRecords = dialyzer_plt:get_types(NewPlt), OldExpTypes = dialyzer_plt:get_exported_types(NewPlt), - MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), MergedExpTypes = sets:union(NewExpTypes, OldExpTypes), - %% io:format("Merged Records ~p",[MergedRecords]), - TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer), TmpCServer2 = dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), - {TmpCServer3, RecordDict} = - dialyzer_utils:process_record_remote_types(TmpCServer2), - dialyzer_contracts:process_contract_remote_types(TmpCServer3, RecordDict) + TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), + dialyzer_contracts:process_contract_remote_types(TmpCServer3) catch throw:{error, ErrorMsg} -> fatal_error(ErrorMsg) @@ -19,9 +19,6 @@ # %CopyrightEnd% # -# Expected autoconf version -EXPECTED_AUTOCONF_VERSION=2.59 - # Global configuration variables # # NOTE: lazy_configure depends on '.' always being last directory @@ -288,30 +285,6 @@ do_autoconf () create_lib_configure_in distribute_config_helpers - if target_contains win32; then - # Select the correct autoconf on cygwin - save_want_autoconf_ver=$WANT_AUTOCONF_VER - WANT_AUTOCONF_VER=$EXPECTED_AUTOCONF_VERSION - export WANT_AUTOCONF_VER - fi - exp_ac_vsn=$EXPECTED_AUTOCONF_VERSION - ac_vsn_blob=`autoconf --version` - ac_vsn=`echo x$ac_vsn_blob | sed "s|[^0-9]*\([0-9][^ \t\n]*\).*|\1|"` - case "$ac_vsn" in - $exp_ac_vsn) - ;; - *) - echo "***************************************************" 1>&2 - echo "***************************************************" 1>&2 - echo "*** WARNING: System might fail to configure or" 1>&2 - echo "*** might be erroneously configured" 1>&2 - echo "*** since autoconf version $ac_vsn is used" 1>&2 - echo "*** instead of version $exp_ac_vsn!" 1>&2 - echo "***************************************************" 1>&2 - echo "***************************************************" 1>&2 - ;; - esac - if [ ! -z "$OVERRIDE_CONFIGURE" ]; then echo "Autoconf disabled on target $TARGET, but is performed on host" >&2 # We still use erts configure for erl_interface and VxWorks @@ -346,11 +319,6 @@ do_autoconf () done restore_vars OVERRIDE_TARGET TARGET - - if target_contains win32; then - WANT_AUTOCONF_VER=$save_want_autoconf_ver - export WANT_AUTOCONF_VER - fi } run_configure () @@ -583,7 +551,6 @@ do_lazy_configure () CONFIGURE_DIR=$dir \ EXTRA_CONFIGURE_DEPENDENCIES=$xc_dep \ EXTRA_CONFIG_STATUS_DEPENDENCIES=$xcs_dep \ - EXPECTED_AUTOCONF_VERSION=$EXPECTED_AUTOCONF_VERSION \ lazy_configure echo "=== Done configuring $dir" echo "" @@ -613,7 +580,6 @@ do_lazy_configure_clean () MAKE="$MAKE" TARGET=$TARGET \ ERL_TOP=$ERL_TOP \ CONFIGURE_DIR=$dir \ - EXPECTED_AUTOCONF_VERSION=$EXPECTED_AUTOCONF_VERSION \ lazy_configure_clean echo "=== Done cleaning configure in $dir" echo "" @@ -644,7 +610,6 @@ do_lazy_configure_target_clean () MAKE="$MAKE" TARGET=$TARGET \ ERL_TOP=$ERL_TOP \ CONFIGURE_DIR=$dir \ - EXPECTED_AUTOCONF_VERSION=$EXPECTED_AUTOCONF_VERSION \ lazy_configure_target_clean echo "=== Done target cleaning configure in $dir" echo "" diff --git a/otp_versions.table b/otp_versions.table index 575a358010..dbc656a543 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,5 @@ +OTP-19.2.3 : erts-8.2.2 inets-6.3.5 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.3 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : +OTP-19.2.2 : mnesia-4.14.3 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2.1 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2.1 : erts-8.2.1 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.2 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2 : common_test-1.13 compiler-7.0.3 crypto-3.7.2 dialyzer-3.0.3 edoc-0.8.1 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2 eunit-2.3.2 hipe-3.15.3 inets-6.3.4 kernel-5.1.1 mnesia-4.14.2 observer-2.3 odbc-2.12 parsetools-2.1.4 public_key-1.3 runtime_tools-1.11 sasl-3.0.2 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 wx-1.8 # asn1-4.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 diameter-1.12.1 eldap-1.2.2 et-1.6 gs-1.6.2 ic-4.4.2 jinterface-1.7.1 megaco-3.18.1 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 percept-0.9 reltool-0.7.2 snmp-5.2.4 typer-0.9.11 xmerl-1.3.12 : OTP-19.1.6 : erts-8.1.1 # asn1-4.0.4 common_test-1.12.3 compiler-7.0.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.1 debugger-4.2.1 dialyzer-3.0.2 diameter-1.12.1 edoc-0.8 eldap-1.2.2 erl_docgen-0.6 erl_interface-3.9.1 et-1.6 eunit-2.3.1 gs-1.6.2 hipe-3.15.2 ic-4.4.2 inets-6.3.3 jinterface-1.7.1 kernel-5.1 megaco-3.18.1 mnesia-4.14.1 observer-2.2.2 odbc-2.11.3 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.3 percept-0.9 public_key-1.2 reltool-0.7.2 runtime_tools-1.10.1 sasl-3.0.1 snmp-5.2.4 ssh-4.3.6 ssl-8.0.3 stdlib-3.1 syntax_tools-2.1 tools-2.8.6 typer-0.9.11 wx-1.7.1 xmerl-1.3.12 : @@ -15,6 +17,7 @@ OTP-19.0.3 : inets-6.3.2 kernel-5.0.1 ssl-8.0.1 # asn1-4.0.3 common_test-1.12.2 OTP-19.0.2 : compiler-7.0.1 erts-8.0.2 stdlib-3.0.1 # asn1-4.0.3 common_test-1.12.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 dialyzer-3.0.1 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2.1 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3.1 ssl-8.0 syntax_tools-2.0 tools-2.8.5 typer-0.9.11 wx-1.7 xmerl-1.3.11 : OTP-19.0.1 : dialyzer-3.0.1 erts-8.0.1 inets-6.3.1 observer-2.2.1 ssh-4.3.1 tools-2.8.5 # asn1-4.0.3 common_test-1.12.2 compiler-7.0 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 typer-0.9.11 wx-1.7 xmerl-1.3.11 : OTP-19.0 : asn1-4.0.3 common_test-1.12.2 compiler-7.0 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 dialyzer-3.0 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 erts-8.0 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 tools-2.8.4 typer-0.9.11 wx-1.7 xmerl-1.3.11 # : +OTP-18.3.4.5 : crypto-3.6.3.1 erts-7.3.1.3 inets-6.2.4.1 ssh-4.2.2.3 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3.4.4 : erts-7.3.1.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3.4.3 : ssh-4.2.2.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3.4.2 : common_test-1.12.1.1 erts-7.3.1.1 ssl-7.3.3.1 # asn1-4.0.2 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : diff --git a/scripts/build-otp b/scripts/build-otp new file mode 100755 index 0000000000..388fa8c276 --- /dev/null +++ b/scripts/build-otp @@ -0,0 +1,20 @@ +#!/bin/bash + +function do_and_log { + log="scripts/latest-log.$$" + echo -n "$1... " + if ./otp_build $2 $3 >$log 2>&1; then + echo "done." + else + echo "failed." + tail -n 200 $log + echo "*** Failed ***" + exit 1 + fi +} + +do_and_log "Autoconfing" autoconf +do_and_log "Configuring" configure +do_and_log "Building OTP" boot -a + +exit 0 diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml index f627145f9f..d08ddd0036 100644 --- a/system/doc/design_principles/statem.xml +++ b/system/doc/design_principles/statem.xml @@ -130,7 +130,7 @@ handle_event(EventType, EventContent, State, Data) -> {next_state, NewState, NewData} </pre> <p> - Se section + See section <seealso marker="#One Event Handler">One Event Handler</seealso> for an example. </p> @@ -887,7 +887,7 @@ stop() -> </p> <p> This type of time-out is useful to for example act on inactivity. - Let us start restart the code sequence + Let us restart the code sequence if no button is pressed for say 30 seconds: </p> <code type="erl"><![CDATA[ |