diff options
467 files changed, 14211 insertions, 6196 deletions
diff --git a/Makefile.in b/Makefile.in index 7baf5cc3aa..9ac516ca33 100644 --- a/Makefile.in +++ b/Makefile.in @@ -854,7 +854,8 @@ tests release_tests: $(TEST_DIRS) $(TEST_DIRS): if test -f $@/Makefile; then \ - (cd $@; $(MAKE) TESTROOT=$(TESTSUITE_ROOT) release_tests) || exit $$?; \ + (cd $@; $(MAKE) TESTROOT=$(TESTSUITE_ROOT) \ + PATH=$(ERL_TOP)/bin:$(BOOT_PREFIX)$${PATH} release_tests) || exit $$?; \ fi # diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex c14ccc2e7b..103ed82529 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 8983932f86..a5699221fe 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_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam Binary files differindex e540fe227b..d8f91ec36d 100644 --- a/bootstrap/lib/compiler/ebin/beam_bool.beam +++ b/bootstrap/lib/compiler/ebin/beam_bool.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex bde0cff4cb..02f82a9341 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 b902d84ffa..70523ca134 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 449ce06f60..b177adb455 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 2811a0e705..81e62b0a7d 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 0d4f028d48..377c738709 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_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex ea93fca2a0..f45b8d3124 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 f0503e4674..662edc0651 100644 --- a/bootstrap/lib/compiler/ebin/beam_listing.beam +++ b/bootstrap/lib/compiler/ebin/beam_listing.beam diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam Binary files differindex 0836e118c9..ae873a1082 100644 --- a/bootstrap/lib/compiler/ebin/beam_receive.beam +++ b/bootstrap/lib/compiler/ebin/beam_receive.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex 04d3416ef2..b1275f787a 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 e0a09eb146..67e6dbd8a1 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 a8bb6ec1a2..b80810bfb2 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 02226a600a..211c56424e 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex e6f76ad0d4..582604e3cc 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_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex b2d79c924c..673954eaac 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 4985e3d6da..bead5a1399 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 2421df60bd..ddb5278d00 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 de6f3e5c25..225fa95aea 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex 9d812001b8..f1841d810b 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam Binary files differindex c04176da61..91a86d9855 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 4a44c53aed..0764734cb1 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 2ed16cc07a..b07afc0938 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam Binary files differindex 3d6f3103e0..5b9e9d7c3e 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_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex 9d1629d9d4..12664c7270 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex dbc5fb5e3a..3a8d68a611 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 817938781d..ff7144c2bc 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 a52d44b32e..48b89b374b 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 4bec626689..485aa63dcb 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 d3ffc45a26..b7996884f4 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 be05505c35..5bdfcefb87 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 996836d78e..565691df01 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 98bd12a42f..4d1098bcec 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex 580dc1f888..3d2bf91b93 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 9ed647a94b..f0be53008b 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 15953c9931..cd01c579bf 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_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam Binary files differindex 96c17f1586..39197f3995 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_server.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam Binary files differindex d20390087d..c86598a689 100644 --- a/bootstrap/lib/kernel/ebin/dist_ac.beam +++ b/bootstrap/lib/kernel/ebin/dist_ac.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex b812127f18..b7bf2ea58e 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_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam Binary files differindex b35b96d8f0..3783cd7b11 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 71e2ad8c0d..7b03c3ea0d 100644 --- a/bootstrap/lib/kernel/ebin/file_server.beam +++ b/bootstrap/lib/kernel/ebin/file_server.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex a9e0e2c0d1..8049d8d729 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 c6fe47b456..f1e6fa219e 100644 --- a/bootstrap/lib/kernel/ebin/global_group.beam +++ b/bootstrap/lib/kernel/ebin/global_group.beam diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam Binary files differindex b8d55c4e29..67f78948d4 100644 --- a/bootstrap/lib/kernel/ebin/group.beam +++ b/bootstrap/lib/kernel/ebin/group.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex b638157e11..c4a1a850a7 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 0c4607063d..5a483c6265 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam Binary files differindex 145e039f7e..1bc785fa37 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/inet_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam Binary files differindex d937ef4a7b..fc1e2c8387 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 ee3fbaa584..d2c636d21f 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_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam Binary files differindex c53ecfb42a..4bf616ad46 100644 --- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam +++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam Binary files differindex f8d3102da7..14ca272933 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 c0f00a0c12..9e8e9fa4de 100644 --- a/bootstrap/lib/kernel/ebin/inet_res.beam +++ b/bootstrap/lib/kernel/ebin/inet_res.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam Binary files differindex b382eebf92..22f2db4182 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/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam Binary files differindex 40228eeeee..c5a63b6217 100644 --- a/bootstrap/lib/kernel/ebin/kernel_config.beam +++ b/bootstrap/lib/kernel/ebin/kernel_config.beam diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam Binary files differindex 8c8786eeb9..451d054667 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 df333e054e..1291f1cdfa 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/bootstrap/lib/kernel/ebin/packages.beam b/bootstrap/lib/kernel/ebin/packages.beam Binary files differindex c507624578..511c6a6e74 100644 --- a/bootstrap/lib/kernel/ebin/packages.beam +++ b/bootstrap/lib/kernel/ebin/packages.beam diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex 4e6817fc97..439bbc24f2 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam Binary files differindex 19391982e8..4355f300e9 100644 --- a/bootstrap/lib/kernel/ebin/rpc.beam +++ b/bootstrap/lib/kernel/ebin/rpc.beam diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam Binary files differindex e0232d9e54..f34c1a9bd1 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 df47a14304..6433bcf859 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 c2b4fef911..15b09a5f93 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex ea41ab7a42..8741e4d5df 100644 --- a/bootstrap/lib/stdlib/ebin/array.beam +++ b/bootstrap/lib/stdlib/ebin/array.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex 67a8554abe..b1f5baf3b8 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex bd37facf37..8c69197cbc 100644 --- a/bootstrap/lib/stdlib/ebin/c.beam +++ b/bootstrap/lib/stdlib/ebin/c.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex b53a1357ff..47cc5e70bb 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 c120ee12e3..d71185c9dd 100644 --- a/bootstrap/lib/stdlib/ebin/dets_server.beam +++ b/bootstrap/lib/stdlib/ebin/dets_server.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex 0a9420daa2..a372faf6ac 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v8.beam b/bootstrap/lib/stdlib/ebin/dets_v8.beam Binary files differindex 3ede6f8d47..a20f0469ce 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v8.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v8.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex 1ac657a547..a52d126adf 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 c5676edc4a..35e67d6c59 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 78814b1ad3..2c1788668d 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 ac2c41d2b7..a578c67e00 100644 --- a/bootstrap/lib/stdlib/ebin/digraph_utils.beam +++ b/bootstrap/lib/stdlib/ebin/digraph_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex d809fc21f6..0cc31bcac9 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam Binary files differindex deb6b97657..1ce1d02ef0 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 6aff9793a6..3184aabc87 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 a5431e7f04..c5c1d71941 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex c0c8cd7cdd..7b1eaf1f15 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 097c378dbd..c026e8401f 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 4416e29c9f..2c32b68322 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 c331d61d21..b5e7c1c24e 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 d9c3186502..9de0e978e3 100644 --- a/bootstrap/lib/stdlib/ebin/erl_tar.beam +++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex ed0e6b0d66..18066abf53 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 bcd7a65cc8..8bc5103946 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex 95fba9495b..0c910821f6 100644 --- a/bootstrap/lib/stdlib/ebin/file_sorter.beam +++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 8137fe9570..95188a534a 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 5f46d56d18..5ee3a82cb6 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 d5ab30b170..e37fa78649 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex ea2de10690..f7a239e18c 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 f2f40ef868..5d44d3f8f1 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 3d422580e9..5e23551fb3 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 25a8d64b78..fdb417b71e 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/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex 1ca5210612..1af64e9d63 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 76245fcd5e..6892fd2c9e 100644 --- a/bootstrap/lib/stdlib/ebin/orddict.beam +++ b/bootstrap/lib/stdlib/ebin/orddict.beam diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam Binary files differindex 43c8763e8f..a16364e1d9 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 704bd8a23d..6b5c081480 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 4e1b8a80d1..1576557a09 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 805f63930b..805203b00e 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam Binary files differindex 1ee81ea68e..9df28216b0 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 22d753562d..85125291e9 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 a08222f3d3..5ac7691a8f 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 50a60ed5b4..2a853ea58c 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex b1bc6498a6..5d9b1bd6c0 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex 54ff535fc3..d1fe9e0cf5 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 2fa7bc7050..6480117b9e 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 499d558dc0..724dfed4e6 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 f60983e084..5f8f714a78 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 28e3c03640..b560f13933 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam Binary files differindex 59d4697510..051c688e73 100644 --- a/bootstrap/lib/stdlib/ebin/zip.beam +++ b/bootstrap/lib/stdlib/ebin/zip.beam diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 4c84412dd6..88e8b284fb 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -285,7 +285,8 @@ <item>If E is <c><![CDATA[fun Name / Arity]]></c>, then Rep(E) = <c><![CDATA[{'fun',LINE,{function,Name,Arity}}]]></c>.</item> <item>If E is <c><![CDATA[fun Module:Name/Arity]]></c>, then - Rep(E) = <c><![CDATA[{'fun',LINE,{function,Module,Name,Arity}}]]></c>.</item> + Rep(E) = <c><![CDATA[{'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}]]></c>. + (Before the R15 release: Rep(E) = <c><![CDATA[{'fun',LINE,{function,Module,Name,Arity}}]]></c>.)</item> <item>If E is <c><![CDATA[fun Fc_1 ; ... ; Fc_k end]]></c> where each <c><![CDATA[Fc_i]]></c> is a function clause then Rep(E) = <c><![CDATA[{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}]]></c>.</item> diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 2fb03954b6..8e18dd6657 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -1638,12 +1638,19 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <fsummary>Cancel an asynchronous call</fsummary> <desc> <marker id="driver_async_cancel"></marker> - <p>This function cancels an asynchronous operation, by removing - it from the queue. Only functions in the queue can be - cancelled; if a function is executing, it's too late to - cancel it. The <c>async_free</c> function is also called.</p> - <p>The return value is 1 if the operation was removed from the - queue, otherwise 0.</p> + <p>This function used to cancel a scheduled asynchronous operation, + if it was still in the queue. It returned 1 if it succeeded, and + 0 if it failed.</p> + <p>Since it could not guarantee success, it was more or less useless. + The user had to implement synchronization of cancellation anyway. + It also unnecessarily complicated the implementation. Therefore, + as of OTP-R15B <c>driver_async_cancel()</c> is deprecated, and + scheduled for removal in OTP-R16. It will currently always fail, + and return 0.</p> + <warning><p><c>driver_async_cancel()</c> is deferred and will + be removed in the OTP-R16 release.</p> + </warning> + </desc> </func> <func> diff --git a/erts/doc/src/erl_ext_fig.gif b/erts/doc/src/erl_ext_fig.gif Binary files differindex 14d6bbc871..14d6bbc871 100755..100644 --- a/erts/doc/src/erl_ext_fig.gif +++ b/erts/doc/src/erl_ext_fig.gif diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 45b66a4909..b923a5f1fc 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -802,8 +802,7 @@ false</pre> <type> <v>MonitorRef = reference()</v> <v>OptionList = [Option]</v> - <v>Option = flush</v> - <v>Option = info</v> + <v> Option = flush | info</v> </type> <desc> <p>The returned value is <c>true</c> unless <c>info</c> is part @@ -1196,11 +1195,16 @@ true </item> <tag><c>{new_uniq, Uniq}</c></tag> <item> - <p><c>Uniq</c> (a binary) is a unique value for this fun.</p> + <p><c>Uniq</c> (a binary) is a unique value for this fun. + It is calculated from the compiled code for the entire module.</p> </item> <tag><c>{uniq, Uniq}</c></tag> <item> - <p><c>Uniq</c> (an integer) is a unique value for this fun.</p> + <p><c>Uniq</c> (an integer) is a unique value for this fun. + Starting in the R15 release, this integer is calculated from + the compiled code for the entire module. Before R15, this + integer was based on only the body of the fun. + </p> </item> </taglist> </desc> diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index 86e1e5168a..3b5ee5391c 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -58,11 +58,8 @@ <item>Allocator used for memory blocks that are expected to be long-lived, for example Erlang code.</item> <tag><c>fix_alloc</c></tag> - <item>A very fast allocator used for some fix-sized - data. <c>fix_alloc</c> manages a set of memory pools from - which memory blocks are handed out. <c>fix_alloc</c> - allocates memory pools from <c>ll_alloc</c>. Memory pools - that have been allocated are never deallocated.</item> + <item>A fast allocator used for some frequently used + fixed size data types.</item> <tag><c>std_alloc</c></tag> <item>Allocator used for most memory blocks not allocated via any of the other allocators described above.</item> @@ -83,7 +80,7 @@ where only small blocks are placed. Currently this allocator is disabled by default.</item> </taglist> - <p><c>sys_alloc</c> and <c>fix_alloc</c> are always enabled and + <p><c>sys_alloc</c> is always enabled and cannot be disabled. <c>mseg_alloc</c> is always enabled if it is available and an allocator that uses it is enabled. All other allocators can be <seealso marker="#M_e">enabled or disabled</seealso>. @@ -104,7 +101,7 @@ <marker id="alloc_util"></marker> <title>The alloc_util framework</title> <p>Internally a framework called <c>alloc_util</c> is used for - implementing allocators. <c>sys_alloc</c>, <c>fix_alloc</c>, and + implementing allocators. <c>sys_alloc</c>, and <c>mseg_alloc</c> do not use this framework; hence, the following does <em>not</em> apply to them.</p> <p>An allocator manages multiple areas, called carriers, in which @@ -212,6 +209,14 @@ This since it will only cause problems for other allocators.</p> </item> </taglist> + <p>Apart from the ordinary allocators described above a number of + pre-allocators are used for some specific data types. These + pre-allocators pre-allocate a fixed amount of memory for certain data + types when the run-time system starts. As long as there are available + pre-allocated memory, it will be used. When no pre-allocated memory is + available, memory will be allocated in ordinary allocators. These + pre-allocators are typically much faster than the ordinary allocators, + but can only satisfy a limited amount of requests.</p> </section> <note><p> @@ -272,18 +277,6 @@ Max cached segments. The maximum number of memory segments stored in the memory segment cache. Valid range is 0-30. Default value is 5.</item> - <tag><marker id="MMcci"><c><![CDATA[+MMcci <time>]]></c></marker></tag> - <item> - Cache check interval (in milliseconds). The memory segment - cache is checked for segments to destroy at an interval - determined by this parameter. Default value is 1000.</item> - </taglist> - <p>The following flags are available for configuration of - <c>fix_alloc</c>:</p> - <taglist> - <tag><marker id="MFe"><c>+MFe true</c></marker></tag> - <item> - Enable <c>fix_alloc</c>. Note: <c>fix_alloc</c> cannot be disabled.</item> </taglist> <p>The following flags are available for configuration of <c>sys_alloc</c>:</p> @@ -322,7 +315,7 @@ based on <c>alloc_util</c>. If <c>u</c> is used as subsystem identifier (i.e., <c><![CDATA[<S> = u]]></c>) all allocators based on <c>alloc_util</c> will be effected. If <c>B</c>, <c>D</c>, <c>E</c>, - <c>H</c>, <c>L</c>, <c>R</c>, <c>S</c>, or <c>T</c> is used as + <c>F</c>, <c>H</c>, <c>L</c>, <c>R</c>, <c>S</c>, or <c>T</c> is used as subsystem identifier, only the specific allocator identified will be effected:</p> <taglist> @@ -441,26 +434,23 @@ kilobytes). See <seealso marker="#mseg_mbc_sizes">the description on how sizes for mseg_alloc multiblock carriers are decided</seealso> in "the <c>alloc_util</c> framework" section.</item> - <tag><marker id="M_t"><c><![CDATA[+M<S>t true|false|<amount>]]></c></marker></tag> + <tag><marker id="M_t"><c><![CDATA[+M<S>t true|false]]></c></marker></tag> <item> - <p>Multiple, thread specific instances of the allocator. - This option will only have any effect on the runtime system - with SMP support. Default behaviour on the runtime system with - SMP support (<c>N</c> equals the number of scheduler threads):</p> + Multiple, thread specific instances of the allocator. + This option will only have any effect on the runtime system + with SMP support. Default behaviour on the runtime system with + SMP support: <taglist> - <tag><c>temp_alloc</c></tag> - <item><c>N + 1</c> instances.</item> <tag><c>ll_alloc</c></tag> <item><c>1</c> instance.</item> <tag>Other allocators</tag> - <item><c>N</c> instances when <c>N</c> is less than or equal to - <c>16</c>. <c>16</c> instances when <c>N</c> is greater than - <c>16</c>.</item> + <item><c>NoSchedulers+1</c> instances. Each scheduler will use + a lock-free instance of its own and other threads will use + a common instance.</item> </taglist> - <p><c>temp_alloc</c> will always use <c>N + 1</c> instances when - this option has been enabled regardless of the amount passed. - Other allocators will use the same amount of instances as the - amount passed as long as it isn't greater than <c>N</c>.</p> + It was previously (before ERTS version 5.9) possible to configure + a smaller amount of thread specific instances than schedulers. + This is, however, not possible any more. </item> </taglist> <p>Currently the following flags are available for configuration of diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 6cd9be5680..708d4ca0a3 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -721,7 +721,7 @@ RUN_OBJS = \ $(OBJDIR)/external.o $(OBJDIR)/dist.o \ $(OBJDIR)/binary.o $(OBJDIR)/erl_db.o \ $(OBJDIR)/erl_db_util.o $(OBJDIR)/erl_db_hash.o \ - $(OBJDIR)/erl_db_tree.o $(OBJDIR)/fix_alloc.o \ + $(OBJDIR)/erl_db_tree.o $(OBJDIR)/erl_thr_progress.o \ $(OBJDIR)/big.o $(OBJDIR)/hash.o \ $(OBJDIR)/index.o $(OBJDIR)/atom.o \ $(OBJDIR)/module.o $(OBJDIR)/export.o \ @@ -738,7 +738,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \ $(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \ $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \ - $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o + $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \ + $(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o ifeq ($(TARGET),win32) DRV_OBJS = \ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index e7308dbf43..71454b3e57 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -69,6 +69,8 @@ atom ac atom active atom all atom all_but_first +atom alloc_info +atom alloc_sizes atom allocated atom allocated_areas atom allocator @@ -555,5 +557,6 @@ atom warning_msg atom wordsize atom write_concurrency atom xor +atom x86 atom yes atom yield diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 2561d7a630..294b1578be 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -33,6 +33,7 @@ #include "beam_catches.h" #include "erl_binary.h" #include "erl_nif.h" +#include "erl_thr_progress.h" static void set_default_trace_pattern(Eterm module); static Eterm check_process_code(Process* rp, Module* modp); @@ -64,9 +65,7 @@ load_module_2(BIF_ALIST_2) goto error; } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); - - erts_export_consolidate(); + erts_smp_thr_progress_block(); hp = HAlloc(BIF_P, 3); sz = binary_size(BIF_ARG_2); @@ -103,7 +102,7 @@ load_module_2(BIF_ALIST_2) done: erts_free_aligned_binary_bytes(temp_alloc); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(res); @@ -118,12 +117,12 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); erts_export_consolidate(); purge_res = purge_module(atom_val(BIF_ARG_1)); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); if (purge_res < 0) { @@ -152,12 +151,12 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3) Eterm res; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); erts_export_consolidate(); res = erts_make_stub_module(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); return res; } @@ -239,7 +238,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1) goto badarg; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); { Module *modp = erts_get_module(BIF_ARG_1); @@ -260,7 +259,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1) } } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); if (res == am_badarg) { @@ -352,7 +351,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); if (BIF_ARG_2 == am_true) { int i; @@ -391,7 +390,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) modp->catches = BEAM_CATCHES_NIL; remove_from_address_table(code); } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(am_true); } @@ -728,10 +727,10 @@ delete_code(Process *c_p, ErtsProcLocks c_p_locks, Module* modp) if (modp->code != NULL && modp->code[MI_NUM_BREAKPOINTS] > 0) { if (c_p && c_p_locks) erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); erts_clear_module_break(modp); modp->code[MI_NUM_BREAKPOINTS] = 0; - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); if (c_p && c_p_locks) erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); } diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 773baad01f..dd31376a2d 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -167,7 +167,7 @@ erts_bp_init(void) { int erts_set_trace_break(Eterm mfa[3], int specified, Binary *match_spec, Eterm tracer_pid) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return set_break(mfa, specified, match_spec, (BeamInstr) BeamOp(op_i_trace_breakpoint), 0, tracer_pid); } @@ -175,7 +175,7 @@ erts_set_trace_break(Eterm mfa[3], int specified, Binary *match_spec, int erts_set_mtrace_break(Eterm mfa[3], int specified, Binary *match_spec, Eterm tracer_pid) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return set_break(mfa, specified, match_spec, (BeamInstr) BeamOp(op_i_mtrace_breakpoint), 0, tracer_pid); } @@ -184,7 +184,7 @@ erts_set_mtrace_break(Eterm mfa[3], int specified, Binary *match_spec, void erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, Eterm tracer_pid) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); set_function_break(NULL, pc, BREAK_IS_BIF, match_spec, (BeamInstr) BeamOp(op_i_mtrace_breakpoint), 0, tracer_pid); } @@ -198,35 +198,35 @@ void erts_clear_time_trace_bif(BeamInstr *pc) { int erts_set_debug_break(Eterm mfa[3], int specified) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return set_break(mfa, specified, NULL, (BeamInstr) BeamOp(op_i_debug_breakpoint), 0, NIL); } int erts_set_count_break(Eterm mfa[3], int specified, enum erts_break_op count_op) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return set_break(mfa, specified, NULL, (BeamInstr) BeamOp(op_i_count_breakpoint), count_op, NIL); } int erts_set_time_break(Eterm mfa[3], int specified, enum erts_break_op count_op) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return set_break(mfa, specified, NULL, (BeamInstr) BeamOp(op_i_time_breakpoint), count_op, NIL); } int erts_clear_trace_break(Eterm mfa[3], int specified) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return clear_break(mfa, specified, (BeamInstr) BeamOp(op_i_trace_breakpoint)); } int erts_clear_mtrace_break(Eterm mfa[3], int specified) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return clear_break(mfa, specified, (BeamInstr) BeamOp(op_i_mtrace_breakpoint)); } @@ -238,41 +238,41 @@ erts_clear_mtrace_bif(BeamInstr *pc) { int erts_clear_debug_break(Eterm mfa[3], int specified) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return clear_break(mfa, specified, (BeamInstr) BeamOp(op_i_debug_breakpoint)); } int erts_clear_count_break(Eterm mfa[3], int specified) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return clear_break(mfa, specified, (BeamInstr) BeamOp(op_i_count_breakpoint)); } int erts_clear_time_break(Eterm mfa[3], int specified) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return clear_break(mfa, specified, (BeamInstr) BeamOp(op_i_time_breakpoint)); } int erts_clear_break(Eterm mfa[3], int specified) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); return clear_break(mfa, specified, 0); } int erts_clear_module_break(Module *modp) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); ASSERT(modp); return clear_module_break(modp, NULL, 0, 0); } int erts_clear_function_break(Module *modp, BeamInstr *pc) { - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); ASSERT(modp); return clear_function_break(modp, pc, BREAK_IS_ERL, 0); } @@ -612,9 +612,13 @@ static void bp_hash_delete(bp_time_hash_t *hash) { static void bp_time_diff(bp_data_time_item_t *item, /* out */ process_breakpoint_time_t *pbt, /* in */ Uint ms, Uint s, Uint us) { - int dms,ds,dus; + int ds,dus; +#ifdef DEBUG + int dms; + dms = ms - pbt->ms; +#endif ds = s - pbt->s; dus = us - pbt->us; @@ -622,7 +626,9 @@ static void bp_time_diff(bp_data_time_item_t *item, /* out */ * this is ok. */ +#ifdef DEBUG ASSERT(dms >= 0 || ds >= 0 || dus >= 0); +#endif if (dus < 0) { dus += 1000000; @@ -975,7 +981,7 @@ static int set_function_break(Module *modp, BeamInstr *pc, int bif, BpDataTime *bdt = (BpDataTime *) bd; Uint i = 0; - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); if (count_op == erts_break_stop) { bdt->pause = 1; diff --git a/erts/emulator/beam/beam_catches.c b/erts/emulator/beam/beam_catches.c index e795b4efbd..a550ec5ad0 100644 --- a/erts/emulator/beam/beam_catches.c +++ b/erts/emulator/beam/beam_catches.c @@ -22,21 +22,27 @@ #endif #include "sys.h" #include "beam_catches.h" +#include "global.h" -/* XXX: should use dynamic reallocation */ -#define TABSIZ (16*1024) -static struct { +/* R14B04 has about 380 catches when starting erlang */ +#define DEFAULT_TABSIZE (1024) +typedef struct { BeamInstr *cp; unsigned cdr; -} beam_catches[TABSIZ]; +} beam_catch_t; static int free_list; static unsigned high_mark; +static unsigned tabsize; +static beam_catch_t *beam_catches; void beam_catches_init(void) { + tabsize = DEFAULT_TABSIZE; free_list = -1; high_mark = 0; + + beam_catches = erts_alloc(ERTS_ALC_T_CODE, sizeof(beam_catch_t)*DEFAULT_TABSIZE); } unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr) @@ -50,16 +56,21 @@ unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr) * This avoids the need to initialise the free list in * beam_catches_init(), which would cost O(TABSIZ) time. */ - if( (i = free_list) >= 0 ) { + if( free_list >= 0 ) { + i = free_list; free_list = beam_catches[i].cdr; - } else if( (i = high_mark) < TABSIZ ) { - high_mark = i + 1; + } else if( high_mark < tabsize ) { + i = high_mark; + high_mark++; } else { - fprintf(stderr, "beam_catches_cons: no free slots :-(\r\n"); - exit(1); + /* No free slots and table is full: realloc table */ + tabsize = 2*tabsize; + beam_catches = erts_realloc(ERTS_ALC_T_CODE, beam_catches, sizeof(beam_catch_t)*tabsize); + i = high_mark; + high_mark++; } - beam_catches[i].cp = cp; + beam_catches[i].cp = cp; beam_catches[i].cdr = cdr; return i; @@ -67,10 +78,8 @@ unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr) BeamInstr *beam_catches_car(unsigned i) { - if( i >= TABSIZ ) { - fprintf(stderr, - "beam_catches_car: index %#x is out of range\r\n", i); - abort(); + if( i >= tabsize ) { + erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i); } return beam_catches[i].cp; } @@ -80,18 +89,15 @@ void beam_catches_delmod(unsigned head, BeamInstr *code, unsigned code_bytes) unsigned i, cdr; for(i = head; i != (unsigned)-1;) { - if( i >= TABSIZ ) { - fprintf(stderr, - "beam_catches_delmod: index %#x is out of range\r\n", i); - abort(); + if( i >= tabsize ) { + erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i); } if( (char*)beam_catches[i].cp - (char*)code >= code_bytes ) { - fprintf(stderr, + erl_exit(1, "beam_catches_delmod: item %#x has cp %#lx which is not " "in module's range [%#lx,%#lx[\r\n", i, (long)beam_catches[i].cp, (long)code, (long)((char*)code + code_bytes)); - abort(); } beam_catches[i].cp = 0; cdr = beam_catches[i].cdr; diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index fffb172c68..8041c92162 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -37,6 +37,7 @@ #include "beam_load.h" #include "beam_bp.h" #include "erl_binary.h" +#include "erl_thr_progress.h" #ifdef ARCH_64 # define HEXF "%016bpX" @@ -49,15 +50,18 @@ void dbg_bt(Process* p, Eterm* sp); void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg); static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr); -Eterm -erts_debug_same_2(Process* p, Eterm term1, Eterm term2) + +BIF_RETTYPE +erts_debug_same_2(BIF_ALIST_2) { - return (term1 == term2) ? am_true : am_false; + return (BIF_ARG_1 == BIF_ARG_2) ? am_true : am_false; } -Eterm -erts_debug_flat_size_1(Process* p, Eterm term) +BIF_RETTYPE +erts_debug_flat_size_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm term = BIF_ARG_1; Uint size = size_object(term); if (IS_USMALL(0, size)) { @@ -68,9 +72,13 @@ erts_debug_flat_size_1(Process* p, Eterm term) } } -Eterm -erts_debug_breakpoint_2(Process* p, Eterm MFA, Eterm bool) + +BIF_RETTYPE +erts_debug_breakpoint_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm MFA = BIF_ARG_1; + Eterm bool = BIF_ARG_2; Eterm* tp; Eterm mfa[3]; int i; @@ -107,7 +115,7 @@ erts_debug_breakpoint_2(Process* p, Eterm MFA, Eterm bool) } erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); if (bool == am_true) { res = make_small(erts_set_debug_break(mfa, specified)); @@ -115,7 +123,7 @@ erts_debug_breakpoint_2(Process* p, Eterm MFA, Eterm bool) res = make_small(erts_clear_debug_break(mfa, specified)); } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); return res; @@ -175,9 +183,11 @@ erts_debug_instructions_0(BIF_ALIST_0) return res; } -Eterm -erts_debug_disassemble_1(Process* p, Eterm addr) +BIF_RETTYPE +erts_debug_disassemble_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm addr = BIF_ARG_1; erts_dsprintf_buf_t *dsbufp; Eterm* hp; Eterm* tp; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 76912ebbd6..9c5450bd48 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -36,6 +36,7 @@ #include "dist.h" #include "beam_bp.h" #include "beam_catches.h" +#include "erl_thr_progress.h" #ifdef HIPE #include "hipe_mode_switch.h" #include "hipe_bif1.h" @@ -70,7 +71,7 @@ do { \ } \ else \ erts_lc_check_exact(NULL, 0); \ - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); \ + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); \ } while (0) # define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN) @@ -303,44 +304,6 @@ extern int count_instructions; PROCESS_MAIN_CHK_LOCKS((P)); \ ERTS_SMP_UNREQ_PROC_MAIN_LOCK((P)) -#if defined(HYBRID) -# define POST_BIF_GC_SWAPIN_0(_p, _res) \ - if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ - _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \ - } \ - SWAPIN - -# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \ - if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ - _regs[0] = r(0); \ - _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \ - r(0) = _regs[0]; \ - } \ - SWAPIN -#else -# define POST_BIF_GC_SWAPIN_0(_p, _res) \ - ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ - PROCESS_MAIN_CHK_LOCKS((_p)); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \ - if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ - _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \ - E = (_p)->stop; \ - } \ - HTOP = HEAP_TOP((_p)) - -# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \ - ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ - PROCESS_MAIN_CHK_LOCKS((_p)); \ - if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ - _regs[0] = r(0); \ - _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \ - r(0) = _regs[0]; \ - E = (_p)->stop; \ - } \ - HTOP = HEAP_TOP((_p)) -#endif - #define db(N) (N) #define tb(N) (N) #define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N))) @@ -794,11 +757,11 @@ extern int count_instructions; } \ } while (0) -#define IsFunction2(F, A, Action) \ - do { \ - if (is_function_2(c_p, F, A) != am_true ) {\ - Action; \ - } \ +#define IsFunction2(F, A, Action) \ + do { \ + if (erl_is_function(c_p, F, A) != am_true ) { \ + Action; \ + } \ } while (0) #define IsTupleOfArity(Src, Arity, Fail) \ @@ -1541,9 +1504,17 @@ void process_main(void) PRE_BIF_SWAPOUT(c_p); c_p->fcalls = FCALLS - 1; - result = send_2(c_p, r(0), x(1)); + reg[0] = r(0); + result = erl_send(c_p, r(0), x(1)); PreFetch(0, next); - POST_BIF_GC_SWAPIN(c_p, result, reg, 2); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { + result = erts_gc_after_bif_call(c_p, result, reg, 2); + r(0) = reg[0]; + E = c_p->stop; + } + HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { r(0) = result; @@ -1551,10 +1522,9 @@ void process_main(void) NextPF(0, next); } else if (c_p->freason == TRAP) { SET_CP(c_p, I+1); - SET_I(*((BeamInstr **) (BeamInstr) ((c_p)->def_arg_reg + 3))); + SET_I(c_p->i); SWAPIN; - r(0) = c_p->def_arg_reg[0]; - x(1) = c_p->def_arg_reg[1]; + r(0) = reg[0]; Dispatch(); } goto find_func_info; @@ -2209,16 +2179,16 @@ void process_main(void) OpCase(bif1_fbsd): { - Eterm (*bf)(Process*, Eterm); - Eterm arg; + Eterm (*bf)(Process*, Eterm*); + Eterm tmp_reg[1]; Eterm result; - GetArg1(2, arg); + GetArg1(2, tmp_reg[0]); bf = (BifFunction) Arg(1); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, arg); + result = (*bf)(c_p, tmp_reg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2237,17 +2207,17 @@ void process_main(void) OpCase(bif1_body_bsd): { - Eterm (*bf)(Process*, Eterm); + Eterm (*bf)(Process*, Eterm*); - Eterm arg; + Eterm tmp_reg[1]; Eterm result; - GetArg1(1, arg); + GetArg1(1, tmp_reg[0]); bf = (BifFunction) Arg(0); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, arg); + result = (*bf)(c_p, tmp_reg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2256,7 +2226,7 @@ void process_main(void) if (is_value(result)) { StoreBifResult(2, result); } - reg[0] = arg; + reg[0] = tmp_reg[0]; SWAPOUT; I = handle_error(c_p, I, reg, bf); goto post_error_handling; @@ -2380,14 +2350,15 @@ void process_main(void) */ OpCase(i_bif2_fbd): { - Eterm (*bf)(Process*, Eterm, Eterm); + Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2}; + Eterm (*bf)(Process*, Eterm*); Eterm result; bf = (BifFunction) Arg(1); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, tmp_arg1, tmp_arg2); + result = (*bf)(c_p, tmp_reg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2405,13 +2376,14 @@ void process_main(void) */ OpCase(i_bif2_body_bd): { - Eterm (*bf)(Process*, Eterm, Eterm); + Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2}; + Eterm (*bf)(Process*, Eterm*); Eterm result; bf = (BifFunction) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, tmp_arg1, tmp_arg2); + result = (*bf)(c_p, tmp_reg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2431,77 +2403,9 @@ void process_main(void) * The most general BIF call. The BIF may build any amount of data * on the heap. The result is always returned in r(0). */ - OpCase(call_bif0_e): - { - Eterm (*bf)(Process*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); - - PRE_BIF_SWAPOUT(c_p); - c_p->fcalls = FCALLS - 1; - if (FCALLS <= 0) { - save_calls(c_p, (Export *) Arg(0)); - } - - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - r(0) = (*bf)(c_p, I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(r(0))); - ERTS_HOLE_CHECK(c_p); - POST_BIF_GC_SWAPIN_0(c_p, r(0)); - FCALLS = c_p->fcalls; - if (is_value(r(0))) { - CHECK_TERM(r(0)); - Next(1); - } - else if (c_p->freason == TRAP) { - goto call_bif_trap3; - } - - /* - * Error handling. SWAPOUT is not needed because it was done above. - */ - ASSERT(c_p->stop == E); - reg[0] = r(0); - I = handle_error(c_p, I, reg, bf); - goto post_error_handling; - } - - OpCase(call_bif1_e): - { - Eterm (*bf)(Process*, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); - Eterm result; - BeamInstr *next; - - c_p->fcalls = FCALLS - 1; - if (FCALLS <= 0) { - save_calls(c_p, (Export *) Arg(0)); - } - PreFetch(1, next); - PRE_BIF_SWAPOUT(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, r(0), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_HOLE_CHECK(c_p); - POST_BIF_GC_SWAPIN(c_p, result, reg, 1); - FCALLS = c_p->fcalls; - if (is_value(result)) { - r(0) = result; - CHECK_TERM(r(0)); - NextPF(1, next); - } else if (c_p->freason == TRAP) { - goto call_bif_trap3; - } - - /* - * Error handling. SWAPOUT is not needed because it was done above. - */ - ASSERT(c_p->stop == E); - reg[0] = r(0); - I = handle_error(c_p, I, reg, bf); - goto post_error_handling; - } - - OpCase(call_bif2_e): + OpCase(call_bif_e): { - Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); + Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); Eterm result; BeamInstr *next; @@ -2511,61 +2415,29 @@ void process_main(void) save_calls(c_p, (Export *) Arg(0)); } PreFetch(1, next); - CHECK_TERM(r(0)); - CHECK_TERM(x(1)); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, r(0), x(1), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_HOLE_CHECK(c_p); - POST_BIF_GC_SWAPIN(c_p, result, reg, 2); - FCALLS = c_p->fcalls; - if (is_value(result)) { - r(0) = result; - CHECK_TERM(r(0)); - NextPF(1, next); - } else if (c_p->freason == TRAP) { - goto call_bif_trap3; - } - - /* - * Error handling. SWAPOUT is not needed because it was done above. - */ - ASSERT(c_p->stop == E); reg[0] = r(0); - I = handle_error(c_p, I, reg, bf); - goto post_error_handling; - } - - OpCase(call_bif3_e): - { - Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); - Eterm result; - BeamInstr *next; - - PRE_BIF_SWAPOUT(c_p); - c_p->fcalls = FCALLS - 1; - if (FCALLS <= 0) { - save_calls(c_p, (Export *) Arg(0)); - } - PreFetch(1, next); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - result = (*bf)(c_p, r(0), x(1), x(2), I); + result = (*bf)(c_p, reg, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_HOLE_CHECK(c_p); - POST_BIF_GC_SWAPIN(c_p, result, reg, 3); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { + Uint arity = ((Export *)Arg(0))->code[2]; + result = erts_gc_after_bif_call(c_p, result, reg, arity); + E = c_p->stop; + } + HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { r(0) = result; CHECK_TERM(r(0)); NextPF(1, next); } else if (c_p->freason == TRAP) { - call_bif_trap3: SET_CP(c_p, I+2); - SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3))); + SET_I(c_p->i); SWAPIN; - r(0) = c_p->def_arg_reg[0]; - x(1) = c_p->def_arg_reg[1]; - x(2) = c_p->def_arg_reg[2]; + r(0) = reg[0]; Dispatch(); } @@ -2573,7 +2445,6 @@ void process_main(void) * Error handling. SWAPOUT is not needed because it was done above. */ ASSERT(c_p->stop == E); - reg[0] = r(0); I = handle_error(c_p, I, reg, bf); goto post_error_handling; } @@ -3326,64 +3197,23 @@ void process_main(void) ASSERT(bif_nif_arity <= 3); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - switch (bif_nif_arity) { - case 3: - { - Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - nif_bif_result = (*bf)(c_p, r(0), x(1), x(2), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - } - break; - case 2: - { - Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - nif_bif_result = (*bf)(c_p, r(0), x(1), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - } - break; - case 1: - { - Eterm (*bf)(Process*, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - nif_bif_result = (*bf)(c_p, r(0), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - } - break; - case 0: - { - Eterm (*bf)(Process*, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - nif_bif_result = (*bf)(c_p, I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - break; - } - default: - erl_exit(1, "apply_bif: invalid arity: %u\n", - bif_nif_arity); + reg[0] = r(0); + { + Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + nif_bif_result = (*bf)(c_p, reg, I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || + is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); } apply_bif_or_nif_epilogue: ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); ERTS_HOLE_CHECK(c_p); if (c_p->mbuf) { - reg[0] = r(0); nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result, reg, bif_nif_arity); - r(0) = reg[0]; } SWAPIN; /* There might have been a garbage collection. */ FCALLS = c_p->fcalls; @@ -3394,17 +3224,14 @@ void process_main(void) c_p->cp = 0; Goto(*I); } else if (c_p->freason == TRAP) { - SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3))); - r(0) = c_p->def_arg_reg[0]; - x(1) = c_p->def_arg_reg[1]; - x(2) = c_p->def_arg_reg[2]; + SET_I(c_p->i); + r(0) = reg[0]; if (c_p->flags & F_HIBERNATE_SCHED) { c_p->flags &= ~F_HIBERNATE_SCHED; goto do_schedule; } Dispatch(); } - reg[0] = r(0); I = handle_error(c_p, c_p->cp, reg, vbf); goto post_error_handling; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index de4b32b238..3836f1ae96 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -758,6 +758,14 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks, } /* + * Since the literal table *may* have contained external + * funs (containing references to export entries), now is + * the time to consolidate the export tables. + */ + + erts_export_consolidate(); + + /* * Load the code chunk. */ @@ -1570,10 +1578,15 @@ read_code_header(LoaderState* stp) /* * Verify the number of the highest opcode used. */ - GetInt(stp, 4, opcode_max); if (opcode_max > MAX_GENERIC_OPCODE) { - LoadError2(stp, "use of opcode %d; this emulator supports only up to %d", + LoadError2(stp, + "This BEAM file was compiled for a later version" + " of the run-time system than " ERLANG_OTP_RELEASE ".\n" + " To fix this, please recompile this module with an " + ERLANG_OTP_RELEASE " compiler.\n" + " (Use of opcode %d; this emulator supports " + "only up to %d.)", opcode_max, MAX_GENERIC_OPCODE); } @@ -5356,9 +5369,12 @@ find_function_from_pc(BeamInstr* pc) * Read a specific chunk from a Beam binary. */ -Eterm -code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk) +BIF_RETTYPE +code_get_chunk_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm Bin = BIF_ARG_1; + Eterm Chunk = BIF_ARG_2; LoaderState state; Uint chunk = 0; ErlSubBin* sb; @@ -5423,9 +5439,11 @@ code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk) * Calculate the MD5 for a module. */ -Eterm -code_module_md5_1(Process* p, Eterm Bin) +BIF_RETTYPE +code_module_md5_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm Bin = BIF_ARG_1; LoaderState state; byte* temp_alloc = NULL; @@ -5682,7 +5700,17 @@ patch_funentries(Eterm Patchlist) fe = erts_get_fun_entry(Mod, uniq, index); fe->native_address = (Uint *)native_address; - erts_refc_dec(&fe->refc, 1); + + /* Deliberate MEMORY LEAK of native fun entries!!! + * + * Uncomment line below when hipe code upgrade and purging works correctly. + * Today we may get cases when old (leaked) native code of a purged module + * gets called and tries to create instances of a deleted fun entry. + * + * Reproduced on a debug emulator with stdlib_test/qlc_SUITE:join_merge + * + * erts_refc_dec(&fe->refc, 1); + */ if (!patch(Addresses, (Uint) fe)) return 0; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 5b3261077b..8ab363a1ec 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -36,6 +36,7 @@ #include "beam_bp.h" #include "erl_db_util.h" #include "register.h" +#include "erl_thr_progress.h" static Export* flush_monitor_message_trap = NULL; static Export* set_cpu_topology_trap = NULL; @@ -1107,9 +1108,9 @@ BIF_RETTYPE hibernate_3(BIF_ALIST_3) /**********************************************************************/ -BIF_RETTYPE get_stacktrace_0(Process* p) +BIF_RETTYPE get_stacktrace_0(BIF_ALIST_0) { - Eterm t = build_stacktrace(p, p->ftrace); + Eterm t = build_stacktrace(BIF_P, BIF_P->ftrace); BIF_RET(t); } @@ -1119,10 +1120,10 @@ BIF_RETTYPE get_stacktrace_0(Process* p) * the process, and the final error value will be {Term,StackTrace}. */ -BIF_RETTYPE error_1(Process* p, Eterm term) +BIF_RETTYPE error_1(BIF_ALIST_1) { - p->fvalue = term; - BIF_ERROR(p, EXC_ERROR); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, EXC_ERROR); } /**********************************************************************/ @@ -1131,12 +1132,12 @@ BIF_RETTYPE error_1(Process* p, Eterm term) * in the stacktrace. */ -BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args) +BIF_RETTYPE error_2(BIF_ALIST_2) { - Eterm* hp = HAlloc(p, 3); + Eterm* hp = HAlloc(BIF_P, 3); - p->fvalue = TUPLE2(hp, value, args); - BIF_ERROR(p, EXC_ERROR_2); + BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2); + BIF_ERROR(BIF_P, EXC_ERROR_2); } /**********************************************************************/ @@ -1146,10 +1147,10 @@ BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args) * It is useful in stub functions for NIFs. */ -BIF_RETTYPE nif_error_1(Process* p, Eterm term) +BIF_RETTYPE nif_error_1(BIF_ALIST_1) { - p->fvalue = term; - BIF_ERROR(p, EXC_ERROR); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, EXC_ERROR); } /**********************************************************************/ @@ -1159,12 +1160,12 @@ BIF_RETTYPE nif_error_1(Process* p, Eterm term) * It is useful in stub functions for NIFs. */ -BIF_RETTYPE nif_error_2(Process* p, Eterm value, Eterm args) +BIF_RETTYPE nif_error_2(BIF_ALIST_2) { - Eterm* hp = HAlloc(p, 3); + Eterm* hp = HAlloc(BIF_P, 3); - p->fvalue = TUPLE2(hp, value, args); - BIF_ERROR(p, EXC_ERROR_2); + BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2); + BIF_ERROR(BIF_P, EXC_ERROR_2); } /**********************************************************************/ @@ -1183,8 +1184,12 @@ BIF_RETTYPE exit_1(BIF_ALIST_1) * If there is an error in the argument format, * return the atom 'badarg' instead. */ -Eterm -raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { +BIF_RETTYPE raise_3(BIF_ALIST_3) +{ + Process *c_p = BIF_P; + Eterm class = BIF_ARG_1; + Eterm value = BIF_ARG_2; + Eterm stacktrace = BIF_ARG_3; Eterm reason; Eterm l, *hp, *hp_end, *tp; int depth, cnt; @@ -1730,10 +1735,10 @@ BIF_RETTYPE whereis_1(BIF_ALIST_1) * erlang:'!'/2 */ -Eterm -ebif_bang_2(Process* p, Eterm To, Eterm Message) +BIF_RETTYPE +ebif_bang_2(BIF_ALIST_2) { - return send_2(p, To, Message); + return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2); } @@ -2070,8 +2075,13 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend) { } -Eterm -send_3(Process *p, Eterm to, Eterm msg, Eterm opts) { +BIF_RETTYPE send_3(BIF_ALIST_3) +{ + Process *p = BIF_P; + Eterm to = BIF_ARG_1; + Eterm msg = BIF_ARG_2; + Eterm opts = BIF_ARG_3; + int connect = !0; int suspend = !0; Eterm l = opts; @@ -2135,8 +2145,13 @@ send_3(Process *p, Eterm to, Eterm msg, Eterm opts) { BIF_ERROR(p, BADARG); } -Eterm -send_2(Process *p, Eterm to, Eterm msg) { +BIF_RETTYPE send_2(BIF_ALIST_2) +{ + return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +Eterm erl_send(Process *p, Eterm to, Eterm msg) +{ Sint result = do_send(p, to, msg, !0); if (result > 0) { @@ -3312,8 +3327,11 @@ time_to_parts(Eterm date, Sint* year, Sint* month, Sint* day, /* return the universal time */ BIF_RETTYPE -localtime_to_universaltime_2(Process *p, Eterm localtime, Eterm dst) +localtime_to_universaltime_2(BIF_ALIST_2) { + Process *p = BIF_P; + Eterm localtime = BIF_ARG_1; + Eterm dst = BIF_ARG_2; Sint year, month, day; Sint hour, minute, second; int isdst; @@ -3562,9 +3580,10 @@ BIF_RETTYPE erts_debug_display_1(BIF_ALIST_1) } -Eterm -display_string_1(Process* p, Eterm string) +BIF_RETTYPE display_string_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm string = BIF_ARG_1; int len = is_string(string); char *str; @@ -3580,8 +3599,7 @@ display_string_1(Process* p, Eterm string) BIF_RET(am_true); } -Eterm -display_nl_0(Process* p) +BIF_RETTYPE display_nl_0(BIF_ALIST_0) { erts_fprintf(stderr, "\n"); BIF_RET(am_true); @@ -3645,8 +3663,13 @@ BIF_RETTYPE function_exported_3(BIF_ALIST_3) /**********************************************************************/ -BIF_RETTYPE is_builtin_3(Process* p, Eterm Mod, Eterm Name, Eterm Arity) +BIF_RETTYPE is_builtin_3(BIF_ALIST_3) { + Process* p = BIF_P; + Eterm Mod = BIF_ARG_1; + Eterm Name = BIF_ARG_2; + Eterm Arity = BIF_ARG_3; + if (is_not_atom(Mod) || is_not_atom(Name) || is_not_small(Arity)) { BIF_ERROR(p, BADARG); } @@ -3711,9 +3734,11 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3) BIF_RET(make_export(hp)); } -Eterm -fun_to_list_1(Process* p, Eterm fun) +BIF_RETTYPE fun_to_list_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm fun = BIF_ARG_1; + if (is_not_any_fun(fun)) BIF_ERROR(p, BADARG); BIF_RET(term2list_dsprintf(p, fun)); @@ -4009,11 +4034,11 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); H_MIN_SIZE = erts_next_heap_size(n, 0); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(make_small(oval)); @@ -4025,11 +4050,11 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); BIN_VH_MIN_SIZE = erts_next_heap_size(n, 0); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(make_small(oval)); @@ -4051,7 +4076,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) erts_backtrace_depth = n; BIF_RET(make_small(oval)); } else if (BIF_ARG_1 == am_trace_control_word) { - BIF_RET(db_set_trace_control_word_1(BIF_P, BIF_ARG_2)); + BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2)); } else if (BIF_ARG_1 == am_sequential_tracer) { Eterm old_value = erts_set_system_seq_tracer(BIF_P, ERTS_PROC_LOCK_MAIN, @@ -4063,7 +4088,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) Uint i; ErlMessage* mp; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); for (i = 0; i < erts_max_processes; i++) { if (process_tab[i] != (Process*) 0) { @@ -4080,7 +4105,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) } } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(am_true); @@ -4291,8 +4316,7 @@ void erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_data, ret); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_data, ret); } } @@ -4300,8 +4324,7 @@ void erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_reason, am_undefined); } } @@ -4316,7 +4339,6 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, { ASSERT(is_atom(module) && is_atom(function)); if (skip_current_msgq(c_p)) { - Eterm unused; Eterm term; Eterm *hp; int i; @@ -4328,7 +4350,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, hp += 2; } term = TUPLE3(hp, module, function, term); - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_apply, term); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_apply, term); } } diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 8faa09feb8..d20089a9fb 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -26,14 +26,14 @@ extern Export* erts_format_cpu_topology_trap; #define BIF_P A__p -#define BIF_ALIST_0 Process* A__p -#define BIF_ALIST_1 Process* A__p, Eterm A_1 -#define BIF_ALIST_2 Process* A__p, Eterm A_1, Eterm A_2 -#define BIF_ALIST_3 Process* A__p, Eterm A_1, Eterm A_2, Eterm A_3 +#define BIF_ALIST_0 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST_1 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST_2 Process* A__p, Eterm* BIF__ARGS +#define BIF_ALIST_3 Process* A__p, Eterm* BIF__ARGS -#define BIF_ARG_1 A_1 -#define BIF_ARG_2 A_2 -#define BIF_ARG_3 A_3 +#define BIF_ARG_1 (BIF__ARGS[0]) +#define BIF_ARG_2 (BIF__ARGS[1]) +#define BIF_ARG_3 (BIF__ARGS[2]) #define BUMP_ALL_REDS(p) do { \ if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \ @@ -122,89 +122,106 @@ do { \ } while (0) -#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \ -do { \ - (Proc)->arity = 0; \ - *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->freason = TRAP; \ - (Ret) = THE_NON_VALUE; \ +#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \ +do { \ + (Proc)->arity = 0; \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ } while (0) -#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \ -do { \ - (Proc)->arity = 1; \ - (Proc)->def_arg_reg[0] = (Eterm) (A0); \ - *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->freason = TRAP; \ - (Ret) = THE_NON_VALUE; \ +#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->arity = 1; \ + reg[0] = (Eterm) (A0); \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ } while (0) -#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \ -do { \ - (Proc)->arity = 2; \ - (Proc)->def_arg_reg[0] = (Eterm) (A0); \ - (Proc)->def_arg_reg[1] = (Eterm) (A1); \ - *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ - (Proc)->freason = TRAP; \ - (Ret) = THE_NON_VALUE; \ +#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->arity = 2; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->arity = 3; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + reg[2] = (Eterm) (A2); \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ } while (0) -#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2)\ +#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\ do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ (Proc)->arity = 3; \ - (Proc)->def_arg_reg[0] = (Eterm) (A0); \ - (Proc)->def_arg_reg[1] = (Eterm) (A1); \ - (Proc)->def_arg_reg[2] = (Eterm) (A2); \ - *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + reg[2] = (Eterm) (A2); \ + (Proc)->i = (BeamInstr*) ((Trap)->address); \ (Proc)->freason = TRAP; \ - (Ret) = THE_NON_VALUE; \ } while (0) -#define BIF_TRAP0(p, Trap_) do { \ - (p)->arity = 0; \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP0(p, Trap_) do { \ + (p)->arity = 0; \ + (p)->i = (BeamInstr*) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP1(Trap_, p, A0) do { \ - (p)->arity = 1; \ - (p)->def_arg_reg[0] = (A0); \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP1(Trap_, p, A0) do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \ + (p)->arity = 1; \ + reg[0] = (A0); \ + (p)->i = (BeamInstr*) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP2(Trap_, p, A0, A1) do { \ - (p)->arity = 2; \ - (p)->def_arg_reg[0] = (A0); \ - (p)->def_arg_reg[1] = (A1); \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP2(Trap_, p, A0, A1) do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \ + (p)->arity = 2; \ + reg[0] = (A0); \ + reg[1] = (A1); \ + (p)->i = (BeamInstr*) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \ - (p)->arity = 3; \ - (p)->def_arg_reg[0] = (A0); \ - (p)->def_arg_reg[1] = (A1); \ - (p)->def_arg_reg[2] = (A2); \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \ + (p)->arity = 3; \ + reg[0] = (A0); \ + reg[1] = (A1); \ + reg[2] = (A2); \ + (p)->i = (BeamInstr*) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \ - (p)->arity = 0; \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \ + (p)->arity = 0; \ + (p)->i = (BeamInstr*) (Code_); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) -#define BIF_TRAP_CODE_PTR_(p, Code_) do { \ - *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \ - (p)->freason = TRAP; \ - return THE_NON_VALUE; \ +#define BIF_TRAP_CODE_PTR_(p, Code_) do { \ + (p)-> i = (BeamInstr*) (Code_); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ } while(0) extern Export bif_return_trap_export; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index ba30fa85b8..987008c937 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -160,10 +160,6 @@ bif erlang:md5_update/2 bif 'erl.util.crypt.md5':update/2 ebif_md5_update_2 bif erlang:md5_final/1 bif 'erl.util.crypt.md5':final/1 ebif_md5_final_1 -bif erlang:memory/0 -bif 'erl.lang':memory/0 ebif_memory_0 -bif erlang:memory/1 -bif 'erl.lang':memory/1 ebif_memory_1 bif erlang:module_loaded/1 bif 'erl.system.code':is_loaded/1 ebif_is_loaded_1 module_loaded_1 bif erlang:function_exported/3 diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 1fb39c6c67..29461877c5 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -356,8 +356,10 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) { Eterm bin; Uint size; - int offset; byte* bytes; +#ifdef DEBUG + int offset; +#endif if (is_nil(arg)) { BIF_RET(new_binary(p,(byte*)"",0)); @@ -372,7 +374,11 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) } bin = new_binary(p, (byte *)NULL, size); bytes = binary_bytes(bin); - offset = io_list_to_buf(arg, (char*) bytes, size); +#ifdef DEBUG + offset = +#endif + io_list_to_buf(arg, (char*) bytes, size); + ASSERT(offset == 0); BIF_RET(bin); diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 432b3d0780..784e55ecd2 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -37,6 +37,7 @@ #include "beam_load.h" #include "erl_instrument.h" #include "erl_bif_timer.h" +#include "erl_thr_progress.h" /* Forward declarations -- should really appear somewhere else */ static void process_killer(void); @@ -94,7 +95,7 @@ process_killer(void) erts_printf("(k)ill (n)ext (r)eturn:\n"); while(1) { if ((j = sys_get_key(0)) <= 0) - halt_0(0); + erl_exit(0, ""); switch(j) { case 'k': if (rp->status == P_WAITING) { @@ -653,20 +654,18 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) if (ERTS_SOMEONE_IS_CRASH_DUMPING) return; - /* Wait for all threads to block. If all threads haven't blocked +#ifdef ERTS_SMP + /* + * Wait for all managed threads to block. If all threads haven't blocked * after a minute, we go anyway and hope for the best... * * We do not release system again. We expect an exit() or abort() after * dump has been written. - * - * NOTE: We allow gc therefore it is important not to lock *any* - * process locks. */ - erts_smp_emergency_block_system(60000, ERTS_BS_FLG_ALLOW_GC); + erts_thr_progress_fatal_error_block(60000); /* Either worked or not... */ /* Allow us to pass certain places without locking... */ -#ifdef ERTS_SMP erts_smp_atomic32_set_mb(&erts_writing_erl_crash_dump, 1); erts_smp_tsd_set(erts_is_crash_dumping_key, (void *) 1); #else diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index ad042ec088..264374789c 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -41,6 +41,7 @@ #include "bif.h" #include "external.h" #include "erl_binary.h" +#include "erl_thr_progress.h" /* Turn this on to get printouts of all distribution messages * which go on the line @@ -430,11 +431,11 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); nodename = erts_this_dist_entry->sysname; - erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); + erts_smp_thr_progress_block(); erts_set_this_node(am_Noname, 0); erts_is_alive = 0; send_nodes_mon_msgs(NULL, am_nodedown, nodename, am_visible, nd_reason); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); } else { /* recursive call via erts_do_exit_port() will end up here */ @@ -2330,11 +2331,11 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) #endif erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); + erts_smp_thr_progress_block(); erts_set_this_node(BIF_ARG_1, (Uint32) creation); erts_is_alive = 1; send_nodes_mon_msgs(NULL, am_nodeup, BIF_ARG_1, am_visible, NIL); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(am_true); @@ -2730,85 +2731,92 @@ BIF_RETTYPE is_alive_0(BIF_ALIST_0) /**********************************************************************/ /* erlang:monitor_node(Node, Bool, Options) -> Bool */ -BIF_RETTYPE monitor_node_3(BIF_ALIST_3) +static BIF_RETTYPE +monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options) { DistEntry *dep; ErtsLink *lnk; Eterm l; - for (l = BIF_ARG_3; l != NIL && is_list(l); l = CDR(list_val(l))) { + for (l = Options; l != NIL && is_list(l); l = CDR(list_val(l))) { Eterm t = CAR(list_val(l)); /* allow_passive_connect the only available option right now */ if (t != am_allow_passive_connect) { - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } } if (l != NIL) { - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } - if (is_not_atom(BIF_ARG_1) || - ((BIF_ARG_2 != am_true) && (BIF_ARG_2 != am_false)) || + if (is_not_atom(Node) || + ((Bool != am_true) && (Bool != am_false)) || ((erts_this_node->sysname == am_Noname) - && (BIF_ARG_1 != erts_this_node->sysname))) { - BIF_ERROR(BIF_P, BADARG); + && (Node != erts_this_node->sysname))) { + BIF_ERROR(p, BADARG); } - dep = erts_sysname_to_connected_dist_entry(BIF_ARG_1); + dep = erts_sysname_to_connected_dist_entry(Node); if (!dep) { do_trap: - BIF_TRAP3(dmonitor_node_trap, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + BIF_TRAP3(dmonitor_node_trap, p, Node, Bool, Options); } if (dep == erts_this_dist_entry) goto done; - erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK); erts_smp_de_rlock(dep); if (ERTS_DE_IS_NOT_CONNECTED(dep)) { - erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); erts_smp_de_runlock(dep); goto do_trap; } erts_smp_de_links_lock(dep); erts_smp_de_runlock(dep); - if (BIF_ARG_2 == am_true) { + if (Bool == am_true) { ASSERT(dep->cid != NIL); lnk = erts_add_or_lookup_link(&(dep->node_links), LINK_NODE, - BIF_P->id); + p->id); ++ERTS_LINK_REFC(lnk); - lnk = erts_add_or_lookup_link(&(BIF_P->nlinks), LINK_NODE, BIF_ARG_1); + lnk = erts_add_or_lookup_link(&(p->nlinks), LINK_NODE, Node); ++ERTS_LINK_REFC(lnk); } else { - lnk = erts_lookup_link(dep->node_links, BIF_P->id); + lnk = erts_lookup_link(dep->node_links, p->id); if (lnk != NULL) { if ((--ERTS_LINK_REFC(lnk)) == 0) { erts_destroy_link(erts_remove_link(&(dep->node_links), - BIF_P->id)); + p->id)); } } - lnk = erts_lookup_link(BIF_P->nlinks, BIF_ARG_1); + lnk = erts_lookup_link(p->nlinks, Node); if (lnk != NULL) { if ((--ERTS_LINK_REFC(lnk)) == 0) { - erts_destroy_link(erts_remove_link(&(BIF_P->nlinks), - BIF_ARG_1)); + erts_destroy_link(erts_remove_link(&(p->nlinks), + Node)); } } } erts_smp_de_links_unlock(dep); - erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); done: erts_deref_dist_entry(dep); BIF_RET(am_true); } +BIF_RETTYPE monitor_node_3(BIF_ALIST_3) +{ + BIF_RET(monitor_node(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3)); +} + + /* monitor_node(Node, Bool) -> Bool */ BIF_RETTYPE monitor_node_2(BIF_ALIST_2) { - BIF_RET(monitor_node_3(BIF_P,BIF_ARG_1,BIF_ARG_2,NIL)); + BIF_RET(monitor_node(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL)); } BIF_RETTYPE net_kernel_dflag_unicode_io_1(BIF_ALIST_1) diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c index bcc7ea04ae..570cc59be2 100644 --- a/erts/emulator/beam/erl_afit_alloc.c +++ b/erts/emulator/beam/erl_afit_alloc.c @@ -65,16 +65,20 @@ erts_afalc_start(AFAllctr_t *afallctr, AFAllctrInit_t *afinit, AllctrInit_t *init) { - AFAllctr_t nulled_state = {{0}}; - /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc - warning. gcc warns if {0} is used as initializer of a struct when - the first member is a struct (not if, for example, the third member - is a struct). */ + struct { + int dummy; + AFAllctr_t allctr; + } zero = {0}; + /* The struct with a dummy element first is used in order to avoid (an + incorrect) gcc warning. gcc warns if {0} is used as initializer of + a struct when the first member is a struct (not if, for example, + the third member is a struct). */ + Allctr_t *allctr = (Allctr_t *) afallctr; - init->sbmbct = 0; /* Small mbc not supported by afit */ + sys_memcpy((void *) afallctr, (void *) &zero.allctr, sizeof(AFAllctr_t)); - sys_memcpy((void *) afallctr, (void *) &nulled_state, sizeof(AFAllctr_t)); + init->sbmbct = 0; /* Small mbc not supported by afit */ allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 9af80dd7a9..33d6cf5f2f 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -40,6 +40,8 @@ #include "erl_mseg.h" #include "erl_monitors.h" #include "erl_bif_timer.h" +#include "erl_cpu_topology.h" +#include "erl_thr_queue.h" #if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE) #include "erl_check_io.h" #endif @@ -54,7 +56,14 @@ #include "erl_ao_firstfit_alloc.h" -#define ERTS_ALC_DEFAULT_MAX_THR_PREF 16 +#if ERTS_MAX_NO_OF_SCHEDULERS > ERTS_AU_MAX_PREF_ALLOC_INSTANCES +# error "Too many schedulers; cannot create that many pref alloc instances" +#endif + +#define ERTS_ALC_FIX_TYPE_IX(T) \ + (ERTS_ALC_T2N((T)) - ERTS_ALC_N_MIN_A_FIXED_SIZE) + +#define ERTS_ALC_DEFAULT_MAX_THR_PREF ERTS_MAX_NO_OF_SCHEDULERS #if defined(SMALL_MEMORY) || defined(PURIFY) || defined(VALGRIND) #define AU_ALLOC_DEFAULT_ENABLE(X) 0 @@ -106,24 +115,43 @@ static ErtsAllocatorState_t eheap_alloc_state; static ErtsAllocatorState_t binary_alloc_state; static ErtsAllocatorState_t ets_alloc_state; static ErtsAllocatorState_t driver_alloc_state; +static ErtsAllocatorState_t fix_alloc_state; -ErtsAlcType_t erts_fix_core_allocator_ix; -#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE -static void *(*fix_core_allocator)(ErtsAlcType_t, void *, Uint); -static void *fix_core_extra; -static void *fix_core_alloc(Uint size) +typedef struct { + erts_smp_atomic32_t refc; + int only_sz; + Uint req_sched; + Process *proc; + Eterm ref; + Eterm ref_heap[REF_THING_SIZE]; + int allocs[ERTS_ALC_A_MAX-ERTS_ALC_A_MIN+1+2]; +} ErtsAllocInfoReq; + +#define ERTS_ALC_INFO_A_ALLOC_UTIL (ERTS_ALC_A_MAX + 1) +#define ERTS_ALC_INFO_A_MSEG_ALLOC (ERTS_ALC_A_MAX + 2) +#define ERTS_ALC_INFO_A_MAX ERTS_ALC_INFO_A_MSEG_ALLOC + +#if !HALFWORD_HEAP +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(aireq, + ErtsAllocInfoReq, + 5, + ERTS_ALC_T_AINFO_REQ) +#else +static ERTS_INLINE ErtsAllocInfoReq * +aireq_alloc(void) { - void *res; - res = (*fix_core_allocator)(ERTS_ALC_T_UNDEF, fix_core_extra, size); - if (erts_mtrace_enabled) - erts_mtrace_crr_alloc(res, - ERTS_ALC_A_FIXED_SIZE, - erts_fix_core_allocator_ix, - size); - return res; + return erts_alloc(ERTS_ALC_T_AINFO_REQ, sizeof(ErtsAllocInfoReq)); +} + +static ERTS_INLINE void +aireq_free(ErtsAllocInfoReq *ptr) +{ + erts_free(ERTS_ALC_T_AINFO_REQ, ptr); } #endif +ErtsAlcType_t erts_fix_core_allocator_ix; + enum allctr_type { GOODFIT, BESTFIT, @@ -181,6 +209,7 @@ typedef struct { struct au_init binary_alloc; struct au_init ets_alloc; struct au_init driver_alloc; + struct au_init fix_alloc; #if HALFWORD_HEAP struct au_init sbmbc_low_alloc; struct au_init std_low_alloc; @@ -393,46 +422,52 @@ set_default_driver_alloc_opts(struct au_init *ip) ip->init.util.ts = ERTS_ALC_MTA_DRIVER; } +static void +set_default_fix_alloc_opts(struct au_init *ip, + size_t *fix_type_sizes) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 1; + ip->atype = BESTFIT; + ip->init.bf.ao = 1; + ip->init.util.name_prefix = "fix_"; + ip->init.util.fix_type_size = fix_type_sizes; + ip->init.util.alloc_no = ERTS_ALC_A_FIXED_SIZE; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 128*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 128*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_FIXED_SIZE; +} + #ifdef ERTS_SMP static void adjust_tpref(struct au_init *ip, int no_sched) { if (ip->thr_spec) { - Uint allocs; - if (ip->thr_spec < 0) {/* User specified amount */ - allocs = abs(ip->thr_spec); - if (allocs > no_sched) - allocs = no_sched; - } - else if (no_sched > ERTS_ALC_DEFAULT_MAX_THR_PREF) - allocs = ERTS_ALC_DEFAULT_MAX_THR_PREF; - else - allocs = no_sched; - if (allocs <= 1) - ip->thr_spec = 0; - else { - ip->thr_spec = (int) allocs; - ip->thr_spec *= -1; /* thread preferred */ - - /* If default ... */ - - /* ... shrink main multi-block carrier size */ - if (ip->default_.mmbcs) - ip->init.util.mmbcs /= ERTS_MIN(4, allocs); - /* ... shrink largest multi-block carrier size */ - if (ip->default_.lmbcs) - ip->init.util.lmbcs /= ERTS_MIN(2, allocs); - /* ... shrink smallest multi-block carrier size */ - if (ip->default_.smbcs) - ip->init.util.smbcs /= ERTS_MIN(4, allocs); - /* ... and more than three allocators shrink - max mseg multi-block carriers */ - if (ip->default_.mmmbc && allocs > 2) { - ip->init.util.mmmbc /= ERTS_MIN(4, allocs - 1); - if (ip->init.util.mmmbc < 3) - ip->init.util.mmmbc = 3; - } + ip->thr_spec = no_sched; + ip->thr_spec *= -1; /* thread preferred */ + + /* If default ... */ + + /* ... shrink main multi-block carrier size */ + if (ip->default_.mmbcs) + ip->init.util.mmbcs /= ERTS_MIN(4, no_sched); + /* ... shrink largest multi-block carrier size */ + if (ip->default_.lmbcs) + ip->init.util.lmbcs /= ERTS_MIN(2, no_sched); + /* ... shrink smallest multi-block carrier size */ + if (ip->default_.smbcs) + ip->init.util.smbcs /= ERTS_MIN(4, no_sched); + /* ... and more than three allocators shrink + max mseg multi-block carriers */ + if (ip->default_.mmmbc && no_sched > 2) { + ip->init.util.mmmbc /= ERTS_MIN(4, no_sched - 1); + if (ip->init.util.mmmbc < 3) + ip->init.util.mmmbc = 3; } } } @@ -442,7 +477,7 @@ adjust_tpref(struct au_init *ip, int no_sched) static void handle_args(int *, char **, erts_alc_hndl_args_init_t *); static void -set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init); +set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu); static void start_au_allocator(ErtsAlcType_t alctr_n, @@ -456,8 +491,6 @@ refuse_af_strategy(struct au_init *init) init->atype = GOODFIT; } -static void init_thr_ix(int static_ixs); - #ifdef HARD_DEBUG static void hdbg_init(void); #endif @@ -466,7 +499,7 @@ void erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) { UWord extra_block_size = 0; - int i; + int i, ncpu; erts_alc_hndl_args_init_t init = { 0, #if HAVE_ERTS_MSEG @@ -474,17 +507,38 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) #endif ERTS_DEFAULT_TRIM_THRESHOLD, ERTS_DEFAULT_TOP_PAD, - ERTS_DEFAULT_ALCU_INIT + ERTS_DEFAULT_ALCU_INIT, }; + size_t fix_type_sizes[ERTS_ALC_NO_FIXED_SIZES] = {0}; + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_PROC)] + = sizeof(Process); +#if !HALFWORD_HEAP + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MONITOR_SH)] + = ERTS_MONITOR_SH_SIZE; + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NLINK_SH)] + = ERTS_LINK_SH_SIZE; +#endif + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_EV_D_STATE)] + = sizeof(ErtsDrvEventDataState); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)] + = sizeof(ErtsDrvSelectDataState); + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MSG_REF)] + = sizeof(ErlMessage); +#ifdef ERTS_SMP + fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)] + = sizeof(ErtsThrQElement_t); +#endif #ifdef HARD_DEBUG hdbg_init(); #endif erts_have_sbmbc_alloc = 0; + ncpu = eaiop->ncpu; + if (ncpu < 1) + ncpu = 1; erts_sys_alloc_init(); - init_thr_ix(erts_no_schedulers); erts_init_utils_mem(); set_default_sbmbc_alloc_opts(&init.sbmbc_alloc); @@ -496,20 +550,23 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_default_binary_alloc_opts(&init.binary_alloc); set_default_ets_alloc_opts(&init.ets_alloc); set_default_driver_alloc_opts(&init.driver_alloc); + set_default_fix_alloc_opts(&init.fix_alloc, + fix_type_sizes); if (argc && argv) handle_args(argc, argv, &init); - if (erts_no_schedulers <= 1) { - init.sbmbc_alloc.thr_spec = 0; - init.sl_alloc.thr_spec = 0; - init.std_alloc.thr_spec = 0; - init.ll_alloc.thr_spec = 0; - init.eheap_alloc.thr_spec = 0; - init.binary_alloc.thr_spec = 0; - init.ets_alloc.thr_spec = 0; - init.driver_alloc.thr_spec = 0; - } +#ifndef ERTS_SMP + init.sbmbc_alloc.thr_spec = 0; + init.sl_alloc.thr_spec = 0; + init.std_alloc.thr_spec = 0; + init.ll_alloc.thr_spec = 0; + init.eheap_alloc.thr_spec = 0; + init.binary_alloc.thr_spec = 0; + init.ets_alloc.thr_spec = 0; + init.driver_alloc.thr_spec = 0; + init.fix_alloc.thr_spec = 0; +#endif if (init.erts_alloc_config) { /* Adjust flags that erts_alloc_config won't like */ @@ -522,6 +579,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.binary_alloc.thr_spec = 0; init.ets_alloc.thr_spec = 0; init.driver_alloc.thr_spec = 0; + init.fix_alloc.thr_spec = 0; } #ifdef ERTS_SMP @@ -538,6 +596,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) adjust_tpref(&init.binary_alloc, erts_no_schedulers); adjust_tpref(&init.ets_alloc, erts_no_schedulers); adjust_tpref(&init.driver_alloc, erts_no_schedulers); + adjust_tpref(&init.fix_alloc, erts_no_schedulers); #else /* No thread specific if not smp */ @@ -556,6 +615,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) refuse_af_strategy(&init.binary_alloc); refuse_af_strategy(&init.ets_alloc); refuse_af_strategy(&init.driver_alloc); + refuse_af_strategy(&init.fix_alloc); #ifdef ERTS_SMP if (!init.temp_alloc.thr_spec) @@ -564,6 +624,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_mtrace_pre_init(); #if HAVE_ERTS_MSEG + init.mseg.nos = erts_no_schedulers; erts_mseg_init(&init.mseg); #endif erts_alcu_init(&init.alloc_util); @@ -583,20 +644,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_allctrs_info[i].extra = NULL; } -#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE -#if !defined(PURIFY) && !defined(VALGRIND) - erts_allctrs[ERTS_ALC_A_FIXED_SIZE].alloc = erts_fix_alloc; - erts_allctrs[ERTS_ALC_A_FIXED_SIZE].realloc = erts_fix_realloc; - erts_allctrs[ERTS_ALC_A_FIXED_SIZE].free = erts_fix_free; - erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].enabled = 1; -#else - erts_allctrs[ERTS_ALC_A_FIXED_SIZE].alloc = erts_sys_alloc; - erts_allctrs[ERTS_ALC_A_FIXED_SIZE].realloc = erts_sys_realloc; - erts_allctrs[ERTS_ALC_A_FIXED_SIZE].free = erts_sys_free; - erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].enabled = 0; -#endif -#endif - erts_allctrs[ERTS_ALC_A_SYSTEM].alloc = erts_sys_alloc; erts_allctrs[ERTS_ALC_A_SYSTEM].realloc = erts_sys_realloc; erts_allctrs[ERTS_ALC_A_SYSTEM].free = erts_sys_free; @@ -621,20 +668,21 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.ll_low_alloc.init.util.force = 1; init.ll_low_alloc.init.util.low_mem = 1; - set_au_allocator(ERTS_ALC_A_SBMBC_LOW, &init.sbmbc_low_alloc); - set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc); - set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc); + set_au_allocator(ERTS_ALC_A_SBMBC_LOW, &init.sbmbc_low_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc, ncpu); #endif /* HALFWORD */ - set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc); - set_au_allocator(ERTS_ALC_A_SBMBC, &init.sbmbc_alloc); - set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc); - set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc); - set_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc); - set_au_allocator(ERTS_ALC_A_EHEAP, &init.eheap_alloc); - set_au_allocator(ERTS_ALC_A_BINARY, &init.binary_alloc); - set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc); - set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc); + set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_SBMBC, &init.sbmbc_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_EHEAP, &init.eheap_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_BINARY, &init.binary_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, ncpu); for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { if (!erts_allctrs[i].alloc) @@ -650,10 +698,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) sys_alloc_opt(SYS_ALLOC_OPT_TRIM_THRESHOLD, init.trim_threshold); sys_alloc_opt(SYS_ALLOC_OPT_TOP_PAD, init.top_pad); - if (erts_allctrs_info[ERTS_FIX_CORE_ALLOCATOR].enabled) - erts_fix_core_allocator_ix = ERTS_FIX_CORE_ALLOCATOR; - else - erts_fix_core_allocator_ix = ERTS_ALC_A_SYSTEM; erts_mtrace_init(init.instr.mtrace, init.instr.nodename); @@ -710,49 +754,40 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) &init.driver_alloc, &driver_alloc_state); - fix_core_allocator = erts_allctrs[erts_fix_core_allocator_ix].alloc; - fix_core_extra = erts_allctrs[erts_fix_core_allocator_ix].extra; + start_au_allocator(ERTS_ALC_A_FIXED_SIZE, + &init.fix_alloc, + &fix_alloc_state); erts_mtrace_install_wrapper_functions(); extra_block_size += erts_instr_init(init.instr.stat, init.instr.map); +#if !HALFWORD_HEAP + init_aireq_alloc(); +#endif + #ifdef DEBUG extra_block_size += install_debug_functions(); #endif -#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE - - erts_init_fix_alloc(extra_block_size, fix_core_alloc); - +} -#if !defined(PURIFY) && !defined(VALGRIND) - erts_set_fix_size(ERTS_ALC_T_PROC, sizeof(Process)); - erts_set_fix_size(ERTS_ALC_T_DB_TABLE, sizeof(DbTable)); - erts_set_fix_size(ERTS_ALC_T_ATOM, sizeof(Atom)); +void +erts_alloc_late_init(void) +{ - erts_set_fix_size(ERTS_ALC_T_MODULE, sizeof(Module)); - erts_set_fix_size(ERTS_ALC_T_REG_PROC, sizeof(RegProc)); - erts_set_fix_size(ERTS_ALC_T_FUN_ENTRY, sizeof(ErlFunEntry)); -#ifdef ERTS_ALC_T_DRV_EV_D_STATE - erts_set_fix_size(ERTS_ALC_T_DRV_EV_D_STATE, - sizeof(ErtsDrvEventDataState)); -#endif -#ifdef ERTS_ALC_T_DRV_SEL_D_STATE - erts_set_fix_size(ERTS_ALC_T_DRV_SEL_D_STATE, - sizeof(ErtsDrvSelectDataState)); -#endif -#if !HALFWORD_HEAP - erts_set_fix_size(ERTS_ALC_T_EXPORT, sizeof(Export)); - erts_set_fix_size(ERTS_ALC_T_MONITOR_SH, ERTS_MONITOR_SH_SIZE*sizeof(Uint)); - erts_set_fix_size(ERTS_ALC_T_NLINK_SH, ERTS_LINK_SH_SIZE*sizeof(Uint)); -#endif -#endif -#endif +} +static void * +erts_realloc_fixed_size(ErtsAlcType_t type, void *extra, void *p, Uint size) +{ + erl_exit(ERTS_ABORT_EXIT, + "Attempt to reallocate a block of the fixed size type %s\n", + ERTS_ALC_T2TD(type)); } + static void -set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init) +set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu) { ErtsAllocatorFunctions_t *af = &erts_allctrs[alctr_n]; ErtsAllocatorInfo_t *ai = &erts_allctrs_info[alctr_n]; @@ -764,6 +799,12 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init) if (init->init.util.force) init->enable = 1; + tspec->enabled = 0; + tspec->dd = 0; + tspec->aix = alctr_n; + tspec->size = 0; + ai->thr_spec = 0; + if (!init->enable) { af->alloc = erts_sys_alloc; af->realloc = erts_sys_realloc; @@ -775,14 +816,14 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init) return; } - tspec->enabled = 0; - tspec->all_thr_safe = 0; - ai->thr_spec = 0; #ifdef USE_THREADS +#ifdef ERTS_SMP if (init->thr_spec) { if (init->thr_spec > 0) { af->alloc = erts_alcu_alloc_thr_spec; - if (init->init.util.ramv) + if (init->init.util.fix_type_size) + af->realloc = erts_realloc_fixed_size; + else if (init->init.util.ramv) af->realloc = erts_alcu_realloc_mv_thr_spec; else af->realloc = erts_alcu_realloc_thr_spec; @@ -790,12 +831,14 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init) } else { af->alloc = erts_alcu_alloc_thr_pref; - if (init->init.util.ramv) + if (init->init.util.fix_type_size) + af->realloc = erts_realloc_fixed_size; + else if (init->init.util.ramv) af->realloc = erts_alcu_realloc_mv_thr_pref; else af->realloc = erts_alcu_realloc_thr_pref; af->free = erts_alcu_free_thr_pref; - tspec->all_thr_safe = 1; + tspec->dd = 1; } tspec->enabled = 1; @@ -803,9 +846,13 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init) ai->thr_spec = tspec->size; } - else if (init->init.util.ts) { + else +#endif + if (init->init.util.ts) { af->alloc = erts_alcu_alloc_ts; - if (init->init.util.ramv) + if (init->init.util.fix_type_size) + af->realloc = erts_realloc_fixed_size; + else if (init->init.util.ramv) af->realloc = erts_alcu_realloc_mv_ts; else af->realloc = erts_alcu_realloc_ts; @@ -815,7 +862,9 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init) #endif { af->alloc = erts_alcu_alloc; - if (init->init.util.ramv) + if (init->init.util.fix_type_size) + af->realloc = erts_realloc_fixed_size; + else if (init->init.util.ramv) af->realloc = erts_alcu_realloc_mv; else af->realloc = erts_alcu_realloc; @@ -838,12 +887,14 @@ start_au_allocator(ErtsAlcType_t alctr_n, ErtsAllocatorFunctions_t *af = &erts_allctrs[alctr_n]; ErtsAllocatorInfo_t *ai = &erts_allctrs_info[alctr_n]; ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[alctr_n]; + ErtsAlcFixList_t *fix_lists = NULL; + size_t fix_list_size = 0; if (!init->enable) return; if (init->thr_spec) { - void *states = erts_sys_alloc(0, + char *states = erts_sys_alloc(0, NULL, ((sizeof(Allctr_t *) * (tspec->size + 1)) @@ -855,18 +906,40 @@ start_au_allocator(ErtsAlcType_t alctr_n, "Failed to allocate allocator states for %salloc\n", init->init.util.name_prefix); tspec->allctr = (Allctr_t **) states; - states = ((char *) states) + sizeof(Allctr_t *) * (tspec->size + 1); + states += sizeof(Allctr_t *) * (tspec->size + 1); states = ((((UWord) states) & ERTS_CACHE_LINE_MASK) - ? (void *) ((((UWord) states) & ~ERTS_CACHE_LINE_MASK) + ? (char *) ((((UWord) states) & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE) - : (void *) states); - tspec->allctr[0] = init->thr_spec > 0 ? (Allctr_t *) state : (Allctr_t *) NULL; + : (char *) states); + tspec->allctr[0] = (Allctr_t *) state; size = tspec->size; for (i = 1; i < size; i++) tspec->allctr[i] = (Allctr_t *) &((ErtsAllocatorState_t *) states)[i-1]; } + if (init->init.util.fix_type_size) { + size_t tot_fix_list_size; + fix_list_size = sizeof(ErtsAlcFixList_t)*ERTS_ALC_NO_FIXED_SIZES; + fix_list_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(fix_list_size); + tot_fix_list_size = fix_list_size; + if (init->thr_spec) + tot_fix_list_size *= tspec->size; + fix_lists = erts_sys_alloc(0, + NULL, + (tot_fix_list_size + + ERTS_CACHE_LINE_SIZE - 1)); + if (!fix_lists) + erl_exit(ERTS_ABORT_EXIT, + "Failed to allocate fix lists for %salloc\n", + init->init.util.name_prefix); + + if (((UWord) fix_lists) & ERTS_CACHE_LINE_MASK) + fix_lists = ((ErtsAlcFixList_t *) + ((((UWord) fix_lists) & ~ERTS_CACHE_LINE_MASK) + + ERTS_CACHE_LINE_SIZE)); + } + for (i = 0; i < size; i++) { void *as; atype = init->atype; @@ -877,25 +950,32 @@ start_au_allocator(ErtsAlcType_t alctr_n, as0 = (void *) tspec->allctr[i]; if (!as0) continue; - if (i == 0) { - if (atype == AFIT) - atype = GOODFIT; - init->init.util.ts = 1; + if (init->thr_spec < 0) { + init->init.util.ts = i == 0; + init->init.util.tspec = 0; + init->init.util.tpref = -1*init->thr_spec + 1; } else { - if (init->thr_spec < 0) { + if (i != 0) + init->init.util.ts = 0; + else { + if (atype == AFIT) + atype = GOODFIT; init->init.util.ts = 1; - init->init.util.tspec = 0; - init->init.util.tpref = -1*init->thr_spec; } - else { - init->init.util.ts = 0; - init->init.util.tspec = init->thr_spec + 1; - init->init.util.tpref = 0; - } - } + init->init.util.tspec = init->thr_spec + 1; + init->init.util.tpref = 0; + } + } + + if (fix_lists) { + init->init.util.fix = fix_lists; + fix_lists = ((ErtsAlcFixList_t *) + (((char *) fix_lists) + fix_list_size)); } + init->init.util.ix = i; + switch (atype) { case GOODFIT: as = (void *) erts_gfalc_start((GFAllctr_t *) as0, @@ -931,11 +1011,8 @@ start_au_allocator(ErtsAlcType_t alctr_n, af->extra = as; } - if (init->thr_spec) { + if (init->thr_spec) af->extra = tspec; - init->init.util.ts = 1; - } - ai->extra = af->extra; } @@ -1055,34 +1132,6 @@ get_amount_value(char *param_end, char** argv, int* ip) return (Uint) tmp; } -static int -get_bool_or_possitive_amount_value(int *bool, Uint *amount, - char *param_end, char** argv, int* ip) -{ - char *param = argv[*ip]+1; - char *value = get_value(param_end, argv, ip); - if (strcmp(value, "true") == 0) { - *bool = 1; - return 1; - } - else if (strcmp(value, "false") == 0) { - *bool = 0; - return 1; - } - else { - Sint tmp; - char *rest; - errno = 0; - tmp = (Sint) strtol(value, &rest, 10); - if (errno != 0 || rest == value || tmp <= 0) { - bad_value(param, param_end, value); - return -1; - } - *amount = (Uint) tmp; - return 0; - } -} - static void handle_au_arg(struct au_init *auip, char* sub_param, @@ -1197,25 +1246,16 @@ handle_au_arg(struct au_init *auip, goto bad_switch; break; case 't': { - Uint no; - int enable; - int res = get_bool_or_possitive_amount_value(&enable, - &no, - sub_param+1, - argv, - ip); - if (res > 0) - auip->thr_spec = enable ? 1 : 0; + int res = get_bool_value(sub_param+1, argv, ip); + if (res > 0) { + auip->thr_spec = 1; + break; + } else if (res == 0) { - int allocs = (int) no; - if (allocs < 0) - allocs = INT_MIN; - else { - allocs *= -1; - } - auip->thr_spec = allocs; + auip->thr_spec = 0; + break; } - break; + goto bad_switch; } default: bad_switch: @@ -1234,6 +1274,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) &init->eheap_alloc, &init->ll_alloc, &init->driver_alloc, + &init->fix_alloc, &init->sl_alloc, &init->temp_alloc }; @@ -1264,14 +1305,8 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) case 'E': handle_au_arg(&init->ets_alloc, &argv[i][3], argv, &i); break; - case 'F': /* fix_alloc */ - if (has_prefix("e", param+2)) { - arg = get_value(param+3, argv, &i); - if (strcmp("true", arg) != 0) - bad_value(param, param+3, arg); - } - else - bad_param(param, param+2); + case 'F': + handle_au_arg(&init->fix_alloc, &argv[i][3], argv, &i); break; case 'H': handle_au_arg(&init->eheap_alloc, &argv[i][3], argv, &i); @@ -1298,12 +1333,6 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) #endif get_amount_value(argv[i]+6, argv, &i); } - else if (has_prefix("cci", argv[i]+3)) { -#if HAVE_ERTS_MSEG - init->mseg.cci = -#endif - get_amount_value(argv[i]+6, argv, &i); - } else { bad_param(param, param+2); } @@ -1389,6 +1418,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) set_default_binary_alloc_opts(&init->binary_alloc); set_default_ets_alloc_opts(&init->ets_alloc); set_default_driver_alloc_opts(&init->driver_alloc); + set_default_driver_alloc_opts(&init->fix_alloc); init->driver_alloc.enable = 0; if (strcmp("r9c", arg) == 0) { @@ -1523,43 +1553,74 @@ static char *type_no_str(ErtsAlcType_t n) #define type_str(T) type_no_str(ERTS_ALC_T2N((T))) -erts_tsd_key_t thr_ix_key; -erts_spinlock_t alloc_thr_ix_lock; -int last_thr_ix; -int first_dyn_thr_ix; - -static void -init_thr_ix(int static_ixs) +void +erts_alloc_register_scheduler(void *vesdp) { - erts_tsd_key_create(&thr_ix_key); - erts_spinlock_init(&alloc_thr_ix_lock, "alloc_thr_ix_lock"); - last_thr_ix = -4711; - first_dyn_thr_ix = static_ixs+1; + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + int ix = (int) esdp->no; + int aix; + + for (aix = ERTS_ALC_A_MIN; aix <= ERTS_ALC_A_MAX; aix++) { + ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[aix]; + esdp->alloc_data.deallctr[aix] = NULL; + esdp->alloc_data.pref_ix[aix] = -1; + if (tspec->enabled) { + if (!tspec->dd) + esdp->alloc_data.pref_ix[aix] = ix; + else { + Allctr_t *allctr = tspec->allctr[ix]; + ASSERT(allctr); + esdp->alloc_data.deallctr[aix] = allctr; + esdp->alloc_data.pref_ix[aix] = ix; + } + } + } } -int -erts_alc_get_thr_ix(void) +void +erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp, + int *need_thr_progress, + int *more_work) { - int ix = (int)(long) erts_tsd_get(thr_ix_key); - if (ix == 0) { - erts_spin_lock(&alloc_thr_ix_lock); - last_thr_ix++; - if (last_thr_ix < 0) - last_thr_ix = first_dyn_thr_ix; - ix = last_thr_ix; - erts_spin_unlock(&alloc_thr_ix_lock); - erts_tsd_set(thr_ix_key, (void *)(long) ix); + ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; + int aix; + for (aix = ERTS_ALC_A_MIN; aix <= ERTS_ALC_A_MAX; aix++) { + Allctr_t *allctr; + if (esdp) + allctr = esdp->alloc_data.deallctr[aix]; + else { + ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[aix]; + if (tspec->enabled && tspec->dd) + allctr = tspec->allctr[0]; + else + allctr = NULL; + } + if (allctr) { + erts_alcu_check_delayed_dealloc(allctr, + 1, + need_thr_progress, + more_work); + } } - ASSERT(ix > 0); - return ix; } -void erts_alloc_reg_scheduler_id(Uint id) +erts_aint32_t +erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs) { - int ix = (int) id; - ASSERT(0 < ix && ix <= first_dyn_thr_ix); - ASSERT(0 == (int) (long) erts_tsd_get(thr_ix_key)); - erts_tsd_set(thr_ix_key, (void *)(long) ix); +#ifdef ERTS_SMP + ErtsAllocatorThrSpec_t *tspec; + tspec = &erts_allctr_thr_spec[ERTS_ALC_A_FIXED_SIZE]; + if (erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].thr_spec && tspec->enabled) + return erts_alcu_fix_alloc_shrink(tspec->allctr[ix], flgs); + if (ix == 0 && erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra) + return erts_alcu_fix_alloc_shrink( + erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra, flgs); +#else + if (ix == 1 && erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra) + return erts_alcu_fix_alloc_shrink( + erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra, flgs); +#endif + return 0; } static void @@ -1574,14 +1635,12 @@ erts_alloc_get_verify_unused_temp_alloc(Allctr_t **allctr) if (erts_allctrs_info[ERTS_ALC_A_TEMPORARY].alloc_util && erts_allctrs_info[ERTS_ALC_A_TEMPORARY].thr_spec) { ErtsAllocatorThrSpec_t *tspec; + int ix = ERTS_ALC_GET_THR_IX(); tspec = &erts_allctr_thr_spec[ERTS_ALC_A_TEMPORARY]; - if (!tspec->all_thr_safe) { - int ix = erts_alc_get_thr_ix(); - if (ix < tspec->size) { - *allctr = tspec->allctr[ix]; - return erts_alcu_verify_unused; - } + if (ix < tspec->size) { + *allctr = tspec->allctr[ix]; + return erts_alcu_verify_unused; } } @@ -1680,7 +1739,7 @@ erts_realloc_n_enomem(ErtsAlcType_t n, void *ptr, Uint size) } static ERTS_INLINE UWord -alcu_size(ErtsAlcType_t ai) +alcu_size(ErtsAlcType_t ai, ErtsAlcUFixInfo_t *fi, int fisz) { UWord res = 0; @@ -1690,22 +1749,20 @@ alcu_size(ErtsAlcType_t ai) if (!erts_allctrs_info[ai].thr_spec) { Allctr_t *allctr = erts_allctrs_info[ai].extra; AllctrSize_t asize; - erts_alcu_current_size(allctr, &asize); + erts_alcu_current_size(allctr, &asize, fi, fisz); res += asize.blocks; } else { ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[ai]; int i; - ASSERT(tspec->all_thr_safe); - ASSERT(tspec->enabled); for (i = tspec->size - 1; i >= 0; i--) { Allctr_t *allctr = tspec->allctr[i]; AllctrSize_t asize; if (allctr) { - erts_alcu_current_size(allctr, &asize); + erts_alcu_current_size(allctr, &asize, fi, fisz); res += asize.blocks; } } @@ -1733,7 +1790,6 @@ alcu_is_low(ErtsAlcType_t ai) int found_one = 0; # endif - ASSERT(tspec->all_thr_safe); ASSERT(tspec->enabled); for (i = tspec->size - 1; i >= 0; i--) { @@ -1757,11 +1813,24 @@ alcu_is_low(ErtsAlcType_t ai) } #endif /* HALFWORD */ +static ERTS_INLINE void +add_fix_values(UWord *ap, UWord *up, ErtsAlcUFixInfo_t *fi, ErtsAlcType_t type) +{ + int ix = ERTS_ALC_T2N(type) - ERTS_ALC_N_MIN_A_FIXED_SIZE; + ASSERT(0 <= ix && ix < ERTS_ALC_NO_FIXED_SIZES); + + *ap += (UWord) fi[ix].allocated; + *up += (UWord) fi[ix].used; +} + Eterm erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) { +/* + * NOTE! When updating this function, make sure to also update + * erlang:memory/[0,1] in $ERL_TOP/erts/preloaded/src/erlang.erl + */ #define ERTS_MEM_NEED_ALL_ALCU (!erts_instr_stat && want_tot_or_sys) - ErtsFixInfo efi; struct { int total; int processes; @@ -1800,6 +1869,9 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) Eterm res = THE_NON_VALUE; ErtsAlcType_t ai; int only_one_value = 0; + ErtsAlcUFixInfo_t fi[ERTS_ALC_NO_FIXED_SIZES] = {{0,0}}; + + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); /* Figure out whats wanted... */ @@ -1969,7 +2041,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) { switch (ai) { case ERTS_ALC_A_SYSTEM: - case ERTS_ALC_A_FIXED_SIZE: case ERTS_ALC_A_SBMBC: #if HALFWORD_HEAP case ERTS_ALC_A_SBMBC_LOW: @@ -2029,11 +2100,15 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) case ERTS_ALC_A_BINARY: save = &size.binary; break; + case ERTS_ALC_A_FIXED_SIZE: + asz = alcu_size(ai, fi, ERTS_ALC_NO_FIXED_SIZES); + size.total += asz; + continue; default: save = NULL; break; } - asz = alcu_size(ai); + asz = alcu_size(ai, NULL, 0); if (save) *save = asz; size.total += asz; @@ -2053,8 +2128,11 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) if (ERTS_MEM_NEED_ALL_ALCU) tmp = size.processes; - else - tmp = alcu_size(ERTS_ALC_A_EHEAP); + else { + alcu_size(ERTS_ALC_A_FIXED_SIZE, + fi, ERTS_ALC_NO_FIXED_SIZES); + tmp = alcu_size(ERTS_ALC_A_EHEAP, NULL, 0); + } tmp += erts_max_processes*sizeof(Process*); #ifdef HYBRID tmp += erts_max_processes*sizeof(Process*); @@ -2064,69 +2142,54 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) size.processes = size.processes_used = tmp; -#if HALFWORD_HEAP - /* BUG: We ignore link and monitor memory */ -#else - erts_fix_info(ERTS_ALC_T_NLINK_SH, &efi); - size.processes += efi.total; - size.processes_used += efi.used; + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_PROC); +#if !HALFWORD_HEAP + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_MONITOR_SH); - erts_fix_info(ERTS_ALC_T_MONITOR_SH, &efi); - size.processes += efi.total; - size.processes_used += efi.used; + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_NLINK_SH); #endif - - erts_fix_info(ERTS_ALC_T_PROC, &efi); - size.processes += efi.total; - size.processes_used += efi.used; - - erts_fix_info(ERTS_ALC_T_REG_PROC, &efi); - size.processes += efi.total; - size.processes_used += efi.used; - + add_fix_values(&size.processes, + &size.processes_used, + fi, + ERTS_ALC_T_MSG_REF); } if (want.atom || want.atom_used) { Uint reserved_atom_space, atom_space; erts_atom_get_text_space_sizes(&reserved_atom_space, &atom_space); size.atom = size.atom_used = atom_table_sz(); - erts_fix_info(ERTS_ALC_T_ATOM, &efi); - if (want.atom) { + if (want.atom) size.atom += reserved_atom_space; - size.atom += efi.total; - } - if (want.atom_used) { + if (want.atom_used) size.atom_used += atom_space; - size.atom_used += efi.used; - } } if (!ERTS_MEM_NEED_ALL_ALCU && want.binary) - size.binary = alcu_size(ERTS_ALC_A_BINARY); + size.binary = alcu_size(ERTS_ALC_A_BINARY, NULL, 0); if (want.code) { size.code = module_table_sz(); - erts_fix_info(ERTS_ALC_T_MODULE, &efi); - size.code += efi.used; size.code += export_table_sz(); -#if HALFWORD_HEAP size.code += export_list_size() * sizeof(Export); -#else - erts_fix_info(ERTS_ALC_T_EXPORT, &efi); - size.code += efi.used; -#endif size.code += erts_fun_table_sz(); - erts_fix_info(ERTS_ALC_T_FUN_ENTRY, &efi); - size.code += efi.used; size.code += allocated_modules*sizeof(Range); size.code += erts_total_code_size; } if (want.ets) { if (!ERTS_MEM_NEED_ALL_ALCU) - size.ets = alcu_size(ERTS_ALC_A_ETS); + size.ets = alcu_size(ERTS_ALC_A_ETS, NULL, 0); size.ets += erts_get_ets_misc_mem_size(); } @@ -2199,13 +2262,10 @@ struct aa_values { Eterm erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc) { -#define MAX_AA_VALUES \ - (20 + (ERTS_ALC_N_MAX_A_FIXED_SIZE - ERTS_ALC_N_MIN_A_FIXED_SIZE + 1)) - +#define MAX_AA_VALUES (23) struct aa_values values[MAX_AA_VALUES]; Eterm res = THE_NON_VALUE; int i, length; - ErtsFixInfo efi; Uint reserved_atom_space, atom_space; if (proc) { @@ -2270,6 +2330,11 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc) i++; values[i].arity = 2; + values[i].name = "export_list"; + values[i].ui[0] = export_list_size() * sizeof(Export); + i++; + + values[i].arity = 2; values[i].name = "register_table"; values[i].ui[0] = process_reg_sz(); i++; @@ -2314,22 +2379,15 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc) values[i].ui[0] = erts_tot_link_lh_size(); i++; - { - Uint n; - - for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE; - n <= ERTS_ALC_N_MAX_A_FIXED_SIZE; - n++) { - erts_fix_info(ERTS_ALC_N2T(n), &efi); - - values[i].arity = 3; - values[i].name = ERTS_ALC_N2TD(n); - values[i].ui[0] = efi.total; - values[i].ui[1] = efi.used; - i++; - } + values[i].arity = 2; + values[i].name = "process_table"; + values[i].ui[0] = erts_max_processes*sizeof(Process*); + i++; - } + values[i].arity = 2; + values[i].name = "ets_misc"; + values[i].ui[0] = erts_get_ets_misc_mem_size(); + i++; length = i; ASSERT(length <= MAX_AA_VALUES); @@ -2423,17 +2481,16 @@ erts_alloc_util_allocators(void *proc) Uint sz; int i; /* - * Currently all allocators except sys_alloc and fix_alloc are + * Currently all allocators except sys_alloc are * alloc_util allocators. */ - sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 2)*2; + sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 1)*2; ASSERT(sz > 0); hp = HAlloc((Process *) proc, sz); res = NIL; for (i = ERTS_ALC_A_MAX; i >= ERTS_ALC_A_MIN; i--) { switch (i) { case ERTS_ALC_A_SYSTEM: - case ERTS_ALC_A_FIXED_SIZE: break; default: { char *alc_str = (char *) ERTS_ALC_A2AD(i); @@ -2447,267 +2504,12 @@ erts_alloc_util_allocators(void *proc) return res; } -Eterm -erts_allocator_info_term(void *proc, Eterm which_alloc, int only_sz) -{ -#define ERTS_AIT_RET(R) \ - do { res = (R); goto done; } while (0) -#define ERTS_AIT_HALLOC(P, S) \ - do { hp = HAlloc((P), (S)); hp_end = hp + (S); } while (0) - - ErtsAlcType_t i; - Uint sz = 0; - Uint *hp = NULL; - Uint *hp_end = NULL; - Eterm res = am_undefined; - - if (is_not_atom(which_alloc)) - goto done; - - for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - if (erts_is_atom_str((char *) ERTS_ALC_A2AD(i), which_alloc)) { - if (!erts_allctrs_info[i].enabled) - ERTS_AIT_RET(am_false); - else { - if (erts_allctrs_info[i].alloc_util) { - Eterm ires, tmp; - Eterm **hpp; - Uint *szp; - Eterm (*info_func)(Allctr_t *, - int, - int *, - void *, - Uint **, - Uint *); - - info_func = (only_sz - ? erts_alcu_sz_info - : erts_alcu_info); - - if (erts_allctrs_info[i].thr_spec) { - ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[i]; - int j; - int block_system = !tspec->all_thr_safe; - - if (block_system) { - erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); - } - ASSERT(tspec->enabled); - - szp = &sz; - hpp = NULL; - - while (1) { - ires = NIL; - for (j = tspec->size - 1; j >= 0; j--) { - Allctr_t *allctr = tspec->allctr[j]; - if (allctr) { - tmp = erts_bld_tuple(hpp, - szp, - 3, - erts_bld_atom(hpp, - szp, - "instance"), - make_small((Uint) j), - (*info_func)(allctr, - hpp != NULL, - NULL, - NULL, - hpp, - szp)); - ires = erts_bld_cons(hpp, szp, tmp, ires); - } - } - if (hpp) - break; - ERTS_AIT_HALLOC((Process *) proc, sz); - hpp = &hp; - szp = NULL; - } - - if (block_system) { - erts_smp_release_system(); - erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); - } - } - else { - Allctr_t *allctr = erts_allctrs_info[i].extra; - szp = &sz; - hpp = NULL; - while (1) { - ires = NIL; - tmp = erts_bld_tuple(hpp, - szp, - 3, - erts_bld_atom(hpp, - szp, - "instance"), - make_small((Uint) 0), - (*info_func)(allctr, - hpp != NULL, - NULL, - NULL, - hpp, - szp)); - ires = erts_bld_cons(hpp, szp, tmp, ires); - if (hpp) - break; - ERTS_AIT_HALLOC((Process *) proc, sz); - hpp = &hp; - szp = NULL; - } - } - ERTS_AIT_RET(ires); - } - else { - Eterm *szp, **hpp; - - switch (i) { - case ERTS_ALC_A_SYSTEM: { - SysAllocStat sas; - Eterm opts_am; - Eterm opts; - Eterm as[4]; /* Ok even if !HEAP_ON_C_STACK, not really heap data on stack */ - Eterm ts[4]; /* Ok even if !HEAP_ON_C_STACK, not really heap data on stack */ - int l; - - if (only_sz) - ERTS_AIT_RET(NIL); - - sys_alloc_stat(&sas); - opts_am = am_atom_put("options", 7); - - szp = &sz; - hpp = NULL; - - restart_sys_alloc: - l = 0; - as[l] = am_atom_put("e", 1); - ts[l++] = am_true; - as[l] = am_atom_put("m", 1); - ts[l++] = am_atom_put("libc", 4); - if(sas.trim_threshold >= 0) { - as[l] = am_atom_put("tt", 2); - ts[l++] = erts_bld_uint(hpp, szp, - (Uint) sas.trim_threshold); - } - if(sas.top_pad >= 0) { - as[l] = am_atom_put("tp", 2); - ts[l++] = erts_bld_uint(hpp, szp, (Uint) sas.top_pad); - } - - opts = erts_bld_2tup_list(hpp, szp, l, as, ts); - res = erts_bld_2tup_list(hpp, szp, 1, &opts_am, &opts); - - if (szp) { - ERTS_AIT_HALLOC((Process *) proc, sz); - szp = NULL; - hpp = &hp; - goto restart_sys_alloc; - } - ERTS_AIT_RET(res); - } - case ERTS_ALC_A_FIXED_SIZE: { - ErtsAlcType_t n; - Eterm as[2], vs[2]; - - if (only_sz) - ERTS_AIT_RET(NIL); - - as[0] = am_atom_put("options", 7); - as[1] = am_atom_put("pools", 5); - - szp = &sz; - hpp = NULL; - - restart_fix_alloc: - - vs[0] = erts_bld_cons(hpp, szp, - erts_bld_tuple(hpp, szp, 2, - am_atom_put("e", - 1), - am_true), - NIL); - - vs[1] = NIL; - for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE; - n <= ERTS_ALC_N_MAX_A_FIXED_SIZE; - n++) { - ErtsFixInfo efi; - erts_fix_info(ERTS_ALC_N2T(n), &efi); - - vs[1] = erts_bld_cons( - hpp, szp, - erts_bld_tuple( - hpp, szp, 3, - am_atom_put((char *) ERTS_ALC_N2TD(n), - strlen(ERTS_ALC_N2TD(n))), - erts_bld_uint(hpp, szp, efi.total), - erts_bld_uint(hpp, szp, efi.used)), - vs[1]); - - } - - res = erts_bld_2tup_list(hpp, szp, 2, as, vs); - if (szp) { - ERTS_AIT_HALLOC((Process *) proc, sz); - szp = NULL; - hpp = &hp; - goto restart_fix_alloc; - } - ERTS_AIT_RET(res); - } - default: - ASSERT(0); - goto done; - } - } - } - } - } - - if (ERTS_IS_ATOM_STR("mseg_alloc", which_alloc)) { -#if HAVE_ERTS_MSEG - if (only_sz) - ERTS_AIT_RET(NIL); - erts_mseg_info(NULL, NULL, 0, NULL, &sz); - if (sz) - ERTS_AIT_HALLOC((Process *) proc, sz); - ERTS_AIT_RET(erts_mseg_info(NULL, NULL, 1, &hp, NULL)); -#else - ERTS_AIT_RET(am_false); -#endif - - } - else if (ERTS_IS_ATOM_STR("alloc_util", which_alloc)) { - if (only_sz) - ERTS_AIT_RET(NIL); - erts_alcu_au_info_options(NULL, NULL, NULL, &sz); - if (sz) - ERTS_AIT_HALLOC((Process *) proc, sz); - ERTS_AIT_RET(erts_alcu_au_info_options(NULL, NULL, &hp, NULL)); - } - - done: - if (hp) { - ASSERT(hp_end >= hp); - HRelease((Process *) proc, hp_end, hp); - } - return res; - -#undef ERTS_AIT_RET -#undef ERTS_AIT_HALLOC -} - void erts_allocator_info(int to, void *arg) { ErtsAlcType_t a; - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0) - || (ERTS_IS_CRASH_DUMPING - && erts_smp_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); for (a = ERTS_ALC_A_MIN; a <= ERTS_ALC_A_MAX; a++) { int ai; @@ -2748,22 +2550,6 @@ erts_allocator_info(int to, void *arg) erts_print(to, arg, "option tp: %d\n", sas.top_pad); break; } - case ERTS_ALC_A_FIXED_SIZE: { - ErtsAlcType_t n; - erts_print(to, arg, "option e: true\n"); - - for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE; - n <= ERTS_ALC_N_MAX_A_FIXED_SIZE; - n++) { - ErtsFixInfo efi; - erts_fix_info(ERTS_ALC_N2T(n), &efi); - erts_print(to, arg, "%s: %lu %lu\n", - ERTS_ALC_N2TD(n), - efi.total, - efi.used); - } - break; - } default: ASSERT(0); break; @@ -2774,8 +2560,18 @@ erts_allocator_info(int to, void *arg) } #if HAVE_ERTS_MSEG - erts_print(to, arg, "=allocator:mseg_alloc\n"); - erts_mseg_info(&to, arg, 0, NULL, NULL); + { +#ifdef ERTS_SMP + int max = (int) erts_no_schedulers; +#else + int max = 0; +#endif + int i; + for (i = 0; i <= max; i++) { + erts_print(to, arg, "=allocator:mseg_alloc[%d]\n", i); + erts_mseg_info(i, &to, arg, 0, NULL, NULL); + } + } #endif erts_print(to, arg, "=allocator:alloc_util\n"); @@ -2829,7 +2625,7 @@ erts_allocator_options(void *proc) use_mseg++; #endif if (erts_allctr_thr_spec[a].enabled) - allctr = erts_allctr_thr_spec[a].allctr[1]; + allctr = erts_allctr_thr_spec[a].allctr[0]; else allctr = erts_allctrs_info[a].extra; tmp = erts_alcu_info_options(allctr, NULL, NULL, hpp, szp); @@ -2878,7 +2674,7 @@ erts_allocator_options(void *proc) #if HAVE_ERTS_MSEG if (use_mseg) { atoms[length] = am_atom_put("mseg_alloc", 10); - terms[length++] = erts_mseg_info_options(NULL, NULL, hpp, szp); + terms[length++] = erts_mseg_info_options(0, NULL, NULL, hpp, szp); } #endif @@ -2982,6 +2778,313 @@ void *erts_alloc_permanent_cache_aligned(ErtsAlcType_t type, Uint size) return (void*)v; } +static void +reply_alloc_info(void *vair) +{ + ErtsAllocInfoReq *air = (ErtsAllocInfoReq *) vair; + Uint sched_id = erts_get_scheduler_id(); + int global_instances = air->req_sched == sched_id; + ErtsProcLocks rp_locks; + Process *rp = air->proc; + Eterm ref_copy = NIL, ai_list, msg; + Eterm *hp = NULL, *hp_end = NULL, *hp_start = NULL; + Eterm **hpp; + Uint sz, *szp; + ErlOffHeap *ohp = NULL; + ErlHeapFragment *bp = NULL; + int i; + Eterm (*info_func)(Allctr_t *, + int, + int *, + void *, + Uint **, + Uint *) = (air->only_sz + ? erts_alcu_sz_info + : erts_alcu_info); + + rp_locks = air->req_sched == sched_id ? ERTS_PROC_LOCK_MAIN : 0; + + sz = 0; + hpp = NULL; + szp = &sz; + + while (1) { + + if (hpp) + ref_copy = STORE_NC(hpp, ohp, air->ref); + else + *szp += REF_THING_SIZE; + + ai_list = NIL; + for (i = 0; air->allocs[i] != ERTS_ALC_A_INVALID; i++); + for (i--; i >= 0; i--) { + int ai = air->allocs[i]; + Allctr_t *allctr; + Eterm ainfo; + Eterm alloc_atom; + if (global_instances) { + switch (ai) { + case ERTS_ALC_A_SYSTEM: { + alloc_atom = erts_bld_atom(hpp, szp, "sys_alloc"); + ainfo = NIL; + if (!air->only_sz) { + SysAllocStat sas; + if (hpp) + sys_alloc_stat(&sas); + if (szp) { + /* ensure ehough heap */ + sas.top_pad = INT_MAX; + sas.trim_threshold = INT_MAX; + } + if (sas.top_pad >= 0) { + ainfo = erts_bld_cons( + hpp, szp, + erts_bld_tuple( + hpp, szp, 2, + erts_bld_atom(hpp, szp, "tp"), + erts_bld_uint( + hpp, szp, + (Uint) sas.top_pad)), + ainfo); + } + if (sas.trim_threshold >= 0) { + ainfo = erts_bld_cons( + hpp, szp, + erts_bld_tuple( + hpp, szp, 2, + erts_bld_atom(hpp, szp, "tt"), + erts_bld_uint( + hpp, szp, + (Uint) sas.trim_threshold)), + ainfo); + } + ainfo = erts_bld_cons(hpp, szp, + erts_bld_tuple( + hpp, szp, 2, + erts_bld_atom(hpp, szp, + "m"), + erts_bld_atom(hpp, szp, + "libc")), + ainfo); + ainfo = erts_bld_cons(hpp, szp, + erts_bld_tuple( + hpp, szp, 2, + erts_bld_atom(hpp, szp, + "e"), + am_true), + ainfo); + ainfo = erts_bld_tuple(hpp, szp, 2, + erts_bld_atom(hpp, szp, + "otps"), + ainfo); + } + ainfo = erts_bld_tuple(hpp, szp, 3, + alloc_atom, + make_small(0), + ainfo); + break; + } + case ERTS_ALC_INFO_A_ALLOC_UTIL: + alloc_atom = erts_bld_atom(hpp, szp, "alloc_util"); + ainfo = (air->only_sz + ? NIL + : erts_alcu_au_info_options(NULL, NULL, + hpp, szp)); + ainfo = erts_bld_tuple(hpp, szp, 3, + alloc_atom, + make_small(0), + ainfo); + break; + case ERTS_ALC_INFO_A_MSEG_ALLOC: + alloc_atom = erts_bld_atom(hpp, szp, "mseg_alloc"); +#if HAVE_ERTS_MSEG + ainfo = (air->only_sz + ? NIL + : erts_mseg_info(0, NULL, NULL, hpp != NULL, + hpp, szp)); + ainfo = erts_bld_tuple(hpp, szp, 3, + alloc_atom, + make_small(0), + ainfo); +#else + ainfo = erts_bld_tuple(hpp, szp, 2, alloc_atom, + am_false); +#endif + break; + default: + alloc_atom = erts_bld_atom(hpp, szp, + (char *) ERTS_ALC_A2AD(ai)); + if (!erts_allctrs_info[ai].enabled) + ainfo = erts_bld_tuple(hpp, szp, 2, alloc_atom, + am_false); + else if (erts_allctrs_info[ai].alloc_util) { + if (erts_allctrs_info[ai].thr_spec) + allctr = erts_allctr_thr_spec[ai].allctr[0]; + else + allctr = erts_allctrs_info[ai].extra; + ainfo = info_func(allctr, hpp != NULL, NULL, + NULL, hpp, szp); + ainfo = erts_bld_tuple(hpp, szp, 3, alloc_atom, + make_small(0), ainfo); + } + else { + erl_exit(ERTS_ABORT_EXIT, "%s:%d: internal error\n", + __FILE__, __LINE__); + } + } + ai_list = erts_bld_cons(hpp, szp, + ainfo, ai_list); + } + switch (ai) { + case ERTS_ALC_A_SYSTEM: + case ERTS_ALC_INFO_A_ALLOC_UTIL: + break; + case ERTS_ALC_INFO_A_MSEG_ALLOC: +#if HAVE_ERTS_MSEG && defined(ERTS_SMP) + alloc_atom = erts_bld_atom(hpp, szp, "mseg_alloc"); + ainfo = (air->only_sz + ? NIL + : erts_mseg_info(sched_id, NULL, NULL, + hpp != NULL, hpp, szp)); + ainfo = erts_bld_tuple(hpp, szp, 3, + alloc_atom, + make_small(sched_id), + ainfo); + ai_list = erts_bld_cons(hpp, szp, ainfo, ai_list); +#endif + break; + default: + if (erts_allctrs_info[ai].thr_spec) { + alloc_atom = erts_bld_atom(hpp, szp, + (char *) ERTS_ALC_A2AD(ai)); + allctr = erts_allctr_thr_spec[ai].allctr[sched_id]; + ainfo = info_func(allctr, hpp != NULL, NULL, + NULL, hpp, szp); + ai_list = erts_bld_cons(hpp, szp, + erts_bld_tuple( + hpp, szp, + 3, + alloc_atom, + make_small(sched_id), + ainfo), + ai_list); + } + break; + } + msg = erts_bld_tuple(hpp, szp, + 3, + ref_copy, + make_small(sched_id), + ai_list); + + } + if (hpp) + break; + + hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + hp_start = hp; + hp_end = hp + sz; + szp = NULL; + hpp = &hp; + } + if (bp) + bp = erts_resize_message_buffer(bp, hp - hp_start, &msg, 1); + else { + ASSERT(hp); + HRelease(rp, hp_end, hp); + } + + erts_queue_message(rp, &rp_locks, bp, msg, NIL); + + if (air->req_sched == sched_id) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); + + if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0) + aireq_free(air); +} + +int +erts_request_alloc_info(struct process *c_p, + Eterm ref, + Eterm allocs, + int only_sz) +{ + ErtsAllocInfoReq *air = aireq_alloc(); + Eterm req_ai[ERTS_ALC_A_MAX+1+2] = {0}; + Eterm alist; + Eterm *hp; + int airix = 0, ai; + + air->req_sched = erts_get_scheduler_id(); + + air->only_sz = only_sz; + + air->proc = c_p; + + if (is_not_internal_ref(ref)) + return 0; + + hp = &air->ref_heap[0]; + air->ref = STORE_NC(&hp, NULL, ref); + + if (is_not_list(allocs)) + return 0; + + alist = allocs; + + while (is_list(alist)) { + int saved = 0; + Eterm* consp = list_val(alist); + Eterm alloc = CAR(consp); + + for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) + if (erts_is_atom_str((char *) erts_alc_a2ad[ai], alloc)) + goto save_alloc; + if (erts_is_atom_str("mseg_alloc", alloc)) { + ai = ERTS_ALC_INFO_A_MSEG_ALLOC; + goto save_alloc; + } + if (erts_is_atom_str("alloc_util", alloc)) { + ai = ERTS_ALC_INFO_A_ALLOC_UTIL; + save_alloc: + if (req_ai[ai]) + return 0; + air->allocs[airix++] = ai; + req_ai[ai] = 1; + saved = 1; + } + + if (!saved) + return 0; + + alist = CDR(consp); + } + + if (is_not_nil(alist)) + return 0; + + air->allocs[airix] = ERTS_ALC_A_INVALID; + + erts_smp_atomic32_init_nob(&air->refc, + (erts_aint32_t) erts_no_schedulers); + + erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers); + +#ifdef ERTS_SMP + if (erts_no_schedulers > 1) + erts_schedule_multi_misc_aux_work(1, + erts_no_schedulers, + reply_alloc_info, + (void *) air); +#endif + + reply_alloc_info((void *) air); + + return 1; +} /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Deprecated functions * diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 80cb82c393..f4133cdb1a 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -43,43 +43,40 @@ # define ERTS_ALC_INLINE #endif -#define ERTS_FIX_CORE_ALLOCATOR ERTS_ALC_A_LONG_LIVED -extern ErtsAlcType_t erts_fix_core_allocator_ix; - -typedef struct { - Uint total; - Uint used; -} ErtsFixInfo; +#define ERTS_ALC_NO_FIXED_SIZES \ + (ERTS_ALC_N_MAX_A_FIXED_SIZE - ERTS_ALC_N_MIN_A_FIXED_SIZE + 1) void erts_sys_alloc_init(void); void *erts_sys_alloc(ErtsAlcType_t, void *, Uint); void *erts_sys_realloc(ErtsAlcType_t, void *, void *, Uint); void erts_sys_free(ErtsAlcType_t, void *, void *); - -void erts_init_fix_alloc(Uint, void *(*)(Uint)); -Uint erts_get_fix_size(ErtsAlcType_t); -void erts_set_fix_size(ErtsAlcType_t, Uint); -void erts_fix_info(ErtsAlcType_t, ErtsFixInfo *); -void *erts_fix_alloc(ErtsAlcType_t, void *, Uint); -void *erts_fix_realloc(ErtsAlcType_t, void *, void*, Uint); -void erts_fix_free(ErtsAlcType_t, void *, void*); - - Eterm erts_memory(int *, void *, void *, Eterm); Eterm erts_allocated_areas(int *, void *, void *); Eterm erts_alloc_util_allocators(void *proc); void erts_allocator_info(int, void *); -Eterm erts_allocator_info_term(void *proc, Eterm which_alloc, int only_sz); Eterm erts_allocator_options(void *proc); +struct process; + +int erts_request_alloc_info(struct process *c_p, Eterm ref, Eterm allocs, + int only_sz); + #define ERTS_ALLOC_INIT_DEF_OPTS_INITER {0} typedef struct { - int dummy; + int ncpu; } ErtsAllocInitOpts; +typedef struct { + Allctr_t *deallctr[ERTS_ALC_A_MAX+1]; + int pref_ix[ERTS_ALC_A_MAX+1]; + int flist_ix[ERTS_ALC_A_MAX+1]; + int pre_alc_ix; +} ErtsSchedAllocData; + void erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop); +void erts_alloc_late_init(void); #if defined(GET_ERTS_ALC_TEST) || defined(ERTS_ALC_INTERNAL__) /* Only for testing */ @@ -126,15 +123,19 @@ extern ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1]; typedef struct { int enabled; - int all_thr_safe; + int dd; + int aix; int size; Allctr_t **allctr; } ErtsAllocatorThrSpec_t; extern ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]; -int erts_alc_get_thr_ix(void); -void erts_alloc_reg_scheduler_id(Uint id); +void erts_alloc_register_scheduler(void *vesdp); +void erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp, + int *need_thr_progress, + int *more_work); +erts_aint32_t erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs); __decl_noreturn void erts_alloc_enomem(ErtsAlcType_t,Uint) __noreturn; @@ -252,6 +253,8 @@ void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size) #endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */ +#define ERTS_ALC_GET_THR_IX() ((int) erts_get_scheduler_id()) + typedef void (*erts_alloc_verify_func_t)(Allctr_t *); erts_alloc_verify_func_t @@ -436,136 +439,41 @@ NAME##_free(TYPE *p) \ } \ } -typedef struct { - void *start; - void *end; - int chunks_mem_size; -} erts_sched_pref_quick_alloc_data_t; - -#ifdef DEBUG -#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P) \ -do { \ - ASSERT((void *) (C) < (void *) (P)); \ - ASSERT((void *) (P) \ - < (void *) (((char *) (C)) + (A)->chunks_mem_size)); \ -} while (0) -#else -#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P) -#endif +#include "erl_sched_spec_pre_alloc.h" #define ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME, TYPE, PASZ) \ -union erts_qa_##NAME##__ { \ +union erts_sspa_##NAME##__ { \ + erts_sspa_blk_t next; \ TYPE type; \ - union erts_qa_##NAME##__ *next; \ }; \ -typedef struct { \ - erts_smp_spinlock_t lock; \ - union erts_qa_##NAME##__ *freelist; \ - union erts_qa_##NAME##__ pre_alloced[1]; \ -} erts_qa_##NAME##_chunk__; \ -static erts_sched_pref_quick_alloc_data_t *qa_data_##NAME##__; \ -static ERTS_INLINE erts_qa_##NAME##_chunk__ * \ -get_##NAME##_chunk_ix(int cix) \ -{ \ - char *ptr = (char *) qa_data_##NAME##__->start; \ - ptr += cix*qa_data_##NAME##__->chunks_mem_size; \ - return (erts_qa_##NAME##_chunk__ *) ptr; \ -} \ -static ERTS_INLINE erts_qa_##NAME##_chunk__ * \ -get_##NAME##_chunk_ptr(void *ptr) \ -{ \ - int cix; \ - size_t diff; \ - if (ptr < qa_data_##NAME##__->start || qa_data_##NAME##__->end <= ptr)\ - return NULL; \ - diff = ((char *) ptr) - ((char *) qa_data_##NAME##__->start); \ - cix = diff / qa_data_##NAME##__->chunks_mem_size; \ - return get_##NAME##_chunk_ix(cix); \ -} \ + \ +static erts_sspa_data_t *sspa_data_##NAME##__; \ + \ static void \ init_##NAME##_alloc(void) \ { \ - size_t tot_size; \ - size_t chunk_mem_size; \ - char *chunk_start; \ - int cix; \ - int no_blocks = ERTS_PRE_ALLOC_SIZE((PASZ)); \ - int no_blocks_per_chunk = 2*((no_blocks-1)/erts_no_schedulers + 1); \ - no_blocks = no_blocks_per_chunk * erts_no_schedulers; \ - chunk_mem_size = sizeof(erts_qa_##NAME##_chunk__); \ - chunk_mem_size += (sizeof(union erts_qa_##NAME##__) \ - * (no_blocks_per_chunk - 1)); \ - chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(chunk_mem_size); \ - tot_size = sizeof(erts_sched_pref_quick_alloc_data_t); \ - tot_size += ERTS_CACHE_LINE_SIZE - 1; \ - tot_size += chunk_mem_size*erts_no_schedulers; \ - qa_data_##NAME##__ = erts_alloc(ERTS_ALC_T_PRE_ALLOC_DATA,tot_size);\ - chunk_start = (((char *) qa_data_##NAME##__) \ - + sizeof(erts_sched_pref_quick_alloc_data_t)); \ - if ((((UWord) chunk_start) & ERTS_CACHE_LINE_MASK) != ((UWord) 0)) \ - chunk_start = ((char *) \ - ((((UWord) chunk_start) & ~ERTS_CACHE_LINE_MASK) \ - + ERTS_CACHE_LINE_SIZE)); \ - qa_data_##NAME##__->chunks_mem_size = chunk_mem_size; \ - qa_data_##NAME##__->start = (void *) chunk_start; \ - qa_data_##NAME##__->end = (chunk_start \ - + chunk_mem_size*erts_no_schedulers); \ - for (cix = 0; cix < erts_no_schedulers; cix++) { \ - int i; \ - erts_qa_##NAME##_chunk__ *chunk = get_##NAME##_chunk_ix(cix); \ - erts_smp_spinlock_init(&chunk->lock, #NAME "_alloc_lock"); \ - chunk->freelist = &chunk->pre_alloced[0]; \ - for (i = 1; i < no_blocks_per_chunk; i++) { \ - ERTS_PRE_ALLOC_CLOBBER(&chunk->pre_alloced[i-1], \ - union erts_qa_##NAME##__); \ - chunk->pre_alloced[i-1].next = &chunk->pre_alloced[i]; \ - } \ - ERTS_PRE_ALLOC_CLOBBER(&chunk->pre_alloced[no_blocks_per_chunk-1],\ - union erts_qa_##NAME##__); \ - chunk->pre_alloced[no_blocks_per_chunk-1].next = NULL; \ - } \ + sspa_data_##NAME##__ = \ + erts_sspa_create(sizeof(union erts_sspa_##NAME##__), \ + ERTS_PRE_ALLOC_SIZE((PASZ))); \ } \ -static ERTS_INLINE TYPE * \ + \ +static TYPE * \ NAME##_alloc(void) \ { \ - int cix = ((int) erts_get_scheduler_id()) - 1; \ - TYPE *res; \ - if (cix < 0) \ - res = NULL; \ - else { \ - erts_qa_##NAME##_chunk__ *chunk = get_##NAME##_chunk_ix(cix); \ - erts_smp_spin_lock(&chunk->lock); \ - if (!chunk->freelist) \ - res = NULL; \ - else { \ - res = &chunk->freelist->type; \ - chunk->freelist = chunk->freelist->next; \ - ERTS_SPPA_DBG_CHK_IN_CHNK(qa_data_##NAME##__, chunk, res); \ - } \ - erts_smp_spin_unlock(&chunk->lock); \ - } \ - return res; \ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); \ + if (!esdp) \ + return NULL; \ + return (TYPE *) erts_sspa_alloc(sspa_data_##NAME##__, \ + (int) esdp->no - 1); \ } \ -static ERTS_INLINE int \ + \ +static int \ NAME##_free(TYPE *p) \ { \ - erts_qa_##NAME##_chunk__ *chunk; \ - chunk = get_##NAME##_chunk_ptr((void *) p); \ - if (!chunk) \ - return 0; \ - else { \ - union erts_qa_##NAME##__ *up; \ - ERTS_SPPA_DBG_CHK_IN_CHNK(qa_data_##NAME##__, chunk, p); \ - up = ((union erts_qa_##NAME##__ *) \ - (((char *) p) \ - - ((char *) &((union erts_qa_##NAME##__ *) 0)->type))); \ - erts_smp_spin_lock(&chunk->lock); \ - ERTS_PRE_ALLOC_CLOBBER(up, union erts_qa_##NAME##__); \ - up->next = chunk->freelist; \ - chunk->freelist = up; \ - erts_smp_spin_unlock(&chunk->lock); \ - return 1; \ - } \ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); \ + return erts_sspa_free(sspa_data_##NAME##__, \ + esdp ? (int) esdp->no - 1 : -1, \ + (char *) p); \ } #ifdef DEBUG diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index eda0831441..962db8b831 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -50,6 +50,15 @@ # command line argument to make_alloc_types. The variable X is false # after a "+disable X" statement or if it has never been mentioned. ++if smp ++disable threads_no_smp ++else ++if threads ++enable threads_no_smp ++else ++disable threads_no_smp ++endif ++endif # --- Allocator declarations ------------------------------------------------- # @@ -133,29 +142,25 @@ class SYSTEM system_data # should be deallocated before the emulator starts executing Erlang # code again. # -# NOTE: When adding or removing a type which uses the FIXED_SIZE allocator, -# also add or remove initialization of the type in erts_alloc_init() -# (erl_alloc.c). -# # <TYPE> <ALLOCATOR> <CLASS> <DESCRIPTION> type SBMBC SBMBC SYSTEM small_block_mbc type PROC FIXED_SIZE PROCESSES proc -type ATOM FIXED_SIZE ATOM atom_entry -type MODULE FIXED_SIZE CODE module_entry -type REG_PROC FIXED_SIZE PROCESSES reg_proc +type ATOM LONG_LIVED ATOM atom_entry +type MODULE LONG_LIVED CODE module_entry +type REG_PROC STANDARD PROCESSES reg_proc type LINK_LH STANDARD PROCESSES link_lh type SUSPEND_MON STANDARD PROCESSES suspend_monitor type PEND_SUSPEND SHORT_LIVED PROCESSES pending_suspend type PROC_LIST SHORT_LIVED PROCESSES proc_list -type FUN_ENTRY FIXED_SIZE CODE fun_entry +type FUN_ENTRY LONG_LIVED CODE fun_entry type ATOM_TXT LONG_LIVED ATOM atom_text type BEAM_REGISTER EHEAP PROCESSES beam_register type HEAP EHEAP PROCESSES heap type OLD_HEAP EHEAP PROCESSES old_heap type HEAP_FRAG EHEAP PROCESSES heap_frag type TMP_HEAP TEMPORARY PROCESSES tmp_heap -type MSG_REF SHORT_LIVED PROCESSES msg_ref +type MSG_REF FIXED_SIZE PROCESSES msg_ref type MSG_ROOTS TEMPORARY PROCESSES msg_roots type ROOTSET TEMPORARY PROCESSES root_set type LOADER_TMP TEMPORARY CODE loader_tmp @@ -196,10 +201,10 @@ type LINEBUF STANDARD SYSTEM line_buf type IOQ STANDARD SYSTEM io_queue type BITS_BUF STANDARD SYSTEM bits_buf type TMP_DIST_BUF TEMPORARY SYSTEM tmp_dist_buf -type ASYNC_Q LONG_LIVED SYSTEM async_queue +type ASYNC_DATA LONG_LIVED SYSTEM internal_async_data type ESTACK TEMPORARY SYSTEM estack type PORT_CALL_BUF TEMPORARY SYSTEM port_call_buf -type DB_TABLE FIXED_SIZE ETS db_tab +type DB_TABLE ETS ETS db_tab type DB_FIXATION SHORT_LIVED ETS db_fixation type DB_FIX_DEL SHORT_LIVED ETS fixed_del type DB_TABLES LONG_LIVED ETS db_tabs @@ -256,6 +261,23 @@ type TMP_CPU_IDS SHORT_LIVED SYSTEM tmp_cpu_ids type EXT_TERM_DATA SHORT_LIVED PROCESSES external_term_data type ZLIB STANDARD SYSTEM zlib type CPU_GRPS_MAP LONG_LIVED SYSTEM cpu_groups_map +type AUX_WORK_TMO LONG_LIVED SYSTEM aux_work_timeouts +type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q + ++if threads_no_smp +# Need thread safe allocs, but std_alloc and fix_alloc are not; +# use driver_alloc which is... +type THR_Q_EL DRIVER SYSTEM thr_q_element +type THR_Q_EL_SL DRIVER SYSTEM sl_thr_q_element +type MISC_AUX_WORK DRIVER SYSTEM misc_aux_work ++else +type THR_Q_EL STANDARD SYSTEM thr_q_element +type THR_Q_EL_SL FIXED_SIZE SYSTEM sl_thr_q_element +type MISC_AUX_WORK SHORT_LIVED SYSTEM misc_aux_work ++endif +type THR_Q STANDARD SYSTEM thr_queue +type THR_Q_SL SHORT_LIVED SYSTEM short_lived_thr_queue +type THR_Q_LL LONG_LIVED SYSTEM long_lived_thr_queue +if smp type ASYNC SHORT_LIVED SYSTEM async @@ -271,8 +293,9 @@ type XPORTS_LIST SHORT_LIVED SYSTEM extra_port_list type PROC_LCK_WTR LONG_LIVED SYSTEM proc_lock_waiter type PROC_LCK_QS LONG_LIVED SYSTEM proc_lock_queues type RUNQ_BLNS LONG_LIVED SYSTEM run_queue_balancing -type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q -type MISC_AUX_WORK SHORT_LIVED SYSTEM misc_aux_work +type THR_PRGR_IDATA LONG_LIVED SYSTEM thr_prgr_internal_data +type THR_PRGR_DATA LONG_LIVED SYSTEM thr_prgr_data +type T_THR_PRGR_DATA SHORT_LIVED SYSTEM temp_thr_prgr_data +endif # @@ -285,12 +308,6 @@ type ETHR_STD STANDARD SYSTEM ethread_standard type ETHR_SL SHORT_LIVED SYSTEM ethread_short_lived type ETHR_LL LONG_LIVED SYSTEM ethread_long_lived -+ifnot smp - -type ARCALLBACK LONG_LIVED SYSTEM async_ready_callback - -+endif - +endif +if shared_heap @@ -346,10 +363,10 @@ type DB_MS_PSDO_PROC LONG_LIVED_LOW ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED_LOW SYSTEM scheduler_data type LL_TEMP_TERM LONG_LIVED_LOW SYSTEM ll_temp_term -# no FIXED_SIZE for low memory -type EXPORT STANDARD_LOW CODE export_entry +type EXPORT LONG_LIVED_LOW CODE export_entry type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh type NLINK_SH STANDARD_LOW PROCESSES nlink_sh +type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request +else # "fullword" @@ -362,9 +379,10 @@ type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data type LL_TEMP_TERM LONG_LIVED SYSTEM ll_temp_term -type EXPORT FIXED_SIZE CODE export_entry +type EXPORT LONG_LIVED CODE export_entry type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh type NLINK_SH FIXED_SIZE PROCESSES nlink_sh +type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request +endif diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index d51ed0c36d..af386c9197 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -46,6 +46,7 @@ #include "erl_alloc_util.h" #include "erl_mseg.h" #include "erl_threads.h" +#include "erl_thr_progress.h" #ifdef ERTS_ENABLE_LOCK_COUNT #include "erl_lock_count.h" @@ -61,6 +62,13 @@ #warning "* * * * * * * * * *" #endif +#define ERTS_ALCU_DD_OPS_LIM_HIGH 20 +#define ERTS_ALCU_DD_OPS_LIM_LOW 2 + +/* Fix alloc limit */ +#define ERTS_ALCU_FIX_MAX_LIST_SZ 1000 +#define ERTS_ALC_FIX_MAX_SHRINK_OPS 30 + #define ALLOC_ZERO_EQ_NULL 0 static int atoms_initialized = 0; @@ -269,7 +277,6 @@ static void check_blk_carrier(Allctr_t *, Block_t *); #define HARD_CHECK_BLK_CARRIER(A, B) #endif - /* Statistics updating ... */ #ifdef DEBUG @@ -465,26 +472,34 @@ do { \ #ifdef DEBUG #ifdef USE_THREADS -#define ERTS_ALCU_DBG_CHK_THR_SPEC(A) \ +#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A) \ do { \ if (!(A)->thread_safe) { \ - if (!(A)->debug.saved_tid) \ + if (!(A)->debug.saved_tid) { \ (A)->debug.tid = erts_thr_self(); \ + (A)->debug.saved_tid = 1; \ + } \ else { \ - ASSERT(ethr_equal_tids((A)->debug.tid, erts_thr_self())); \ + ERTS_SMP_LC_ASSERT( \ + ethr_equal_tids((A)->debug.tid, erts_thr_self()) \ + || erts_thr_progress_is_blocking()); \ } \ } \ } while (0) #else -#define ERTS_ALCU_DBG_CHK_THR_SPEC(A) +#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A) #endif #else -#define ERTS_ALCU_DBG_CHK_THR_SPEC(A) +#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A) #endif static void make_name_atoms(Allctr_t *allctr); +static Block_t *create_carrier(Allctr_t *, Uint, UWord); +static void destroy_carrier(Allctr_t *, Block_t *); +static void mbc_free(Allctr_t *allctr, void *p); + /* mseg ... */ @@ -651,6 +666,446 @@ static void destroy_sbmbc(Allctr_t *allctr, Block_t *blk); static Block_t *create_carrier(Allctr_t *, Uint, UWord); static void destroy_carrier(Allctr_t *, Block_t *); +#if 0 +#define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B) \ + do { if ((FIX)) chk_fix_list((A), (FIX), (IX), (B)); } while (0) +static void +chk_fix_list(Allctr_t *allctr, ErtsAlcFixList_t *fix, int ix, int before) +{ + void *p; + int n; + for (n = 0, p = fix[ix].list; p; p = *((void **) p)) + n++; + if (n != fix[ix].list_size) { + erts_fprintf(stderr, "FOUND IT ts=%d, sched=%d, ix=%d, n=%d, ls=%d %s!\n", + allctr->thread_safe, allctr->ix, ix, n, fix[ix].list_size, before ? "before" : "after"); + abort(); + } +} +#else +#define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B) +#endif + +erts_aint32_t +erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) +{ + int all_empty = 1; + erts_aint32_t res = 0; + int ix, o; + ErtsAlcFixList_t *fix = allctr->fix; + int flush = flgs == 0; + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); +#endif + + for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) { + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) { + fix[ix].limit = fix[ix].max_used; + if (fix[ix].limit < fix[ix].used) + fix[ix].limit = fix[ix].used; + fix[ix].max_used = fix[ix].used; + ASSERT(fix[ix].limit >= 0); + + } + if (flush) { + fix[ix].limit = 0; + fix[ix].max_used = fix[ix].used; + ASSERT(fix[ix].limit >= 0); + } + for (o = 0; o < ERTS_ALC_FIX_MAX_SHRINK_OPS || flush; o++) { + Block_t *blk; + void *ptr; + + if (!flush && fix[ix].limit >= fix[ix].allocated) + break; + if (fix[ix].list_size == 0) + break; + ptr = fix[ix].list; + fix[ix].list = *((void **) ptr); + fix[ix].list_size--; + + blk = UMEM2BLK(ptr); + + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk); + else + mbc_free(allctr, ptr); + + fix[ix].allocated--; + } + if (fix[ix].list_size != 0) { + if (fix[ix].limit < fix[ix].allocated) + res |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC; + all_empty = 0; + } + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + } + + if (all_empty && allctr->fix_shrink_scheduled) { + allctr->fix_shrink_scheduled = 0; + erts_set_aux_work_timeout(allctr->ix, + (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), + 0); + } + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_unlock(&allctr->mutex); +#endif + + return res; +} + +#ifdef ERTS_SMP + +#define ERTS_ALCU_DD_FIX_TYPE_OFFS \ + ((sizeof(ErtsAllctrDDBlock_t)-1)/sizeof(UWord) + 1) + +#define ERTS_AU_PREF_ALLOC_IX_MASK \ + ((((UWord) 1) << ERTS_AU_PREF_ALLOC_BITS) - 1) +#define ERTS_AU_PREF_ALLOC_SIZE_MASK \ + ((((UWord) 1) << (sizeof(UWord)*8 - ERTS_AU_PREF_ALLOC_BITS)) - 1) + +static ERTS_INLINE int +get_pref_allctr(void *extra, Allctr_t **allctr) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + int pref_ix; + + pref_ix = ERTS_ALC_GET_THR_IX(); + + ASSERT(sizeof(UWord) == sizeof(Allctr_t *)); + ASSERT(0 <= pref_ix && pref_ix < tspec->size); + + *allctr = tspec->allctr[pref_ix]; + return pref_ix; +} + +static ERTS_INLINE void * +get_used_allctr(void *extra, void *p, Allctr_t **allctr, UWord *sizep) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + void *ptr = (void *) (((char *) p) - sizeof(UWord)); + UWord ainfo = *((UWord *) ptr); + int aix = (int) (ainfo & ERTS_AU_PREF_ALLOC_IX_MASK); + *allctr = tspec->allctr[aix]; + if (sizep) + *sizep = ((ainfo >> ERTS_AU_PREF_ALLOC_BITS) + & ERTS_AU_PREF_ALLOC_SIZE_MASK); + return ptr; +} + +static ERTS_INLINE void * +put_used_allctr(void *p, int ix, UWord size) +{ + UWord ainfo = (size >= ERTS_AU_PREF_ALLOC_SIZE_MASK + ? ERTS_AU_PREF_ALLOC_SIZE_MASK + : size); + ainfo <<= ERTS_AU_PREF_ALLOC_BITS; + ainfo |= (UWord) ix; + *((UWord *) p) = ainfo; + return (void *) (((char *) p) + sizeof(UWord)); +} + +static void +init_dd_queue(ErtsAllctrDDQueue_t *ddq) +{ + erts_atomic_init_nob(&ddq->tail.data.marker.atmc_next, ERTS_AINT_NULL); + erts_atomic_init_nob(&ddq->tail.data.last, + (erts_aint_t) &ddq->tail.data.marker); + erts_atomic_init_nob(&ddq->tail.data.um_refc[0], 0); + erts_atomic_init_nob(&ddq->tail.data.um_refc[1], 0); + erts_atomic32_init_nob(&ddq->tail.data.um_refc_ix, 0); + ddq->head.first = &ddq->tail.data.marker; + ddq->head.unref_end = &ddq->tail.data.marker; + ddq->head.next.thr_progress = erts_thr_progress_current(); + ddq->head.next.thr_progress_reached = 1; + ddq->head.next.um_refc_ix = 1; + ddq->head.next.unref_end = &ddq->tail.data.marker; + ddq->head.used_marker = 1; +} + +static ERTS_INLINE erts_aint_t +ddq_managed_thread_enqueue(ErtsAllctrDDQueue_t *ddq, void *ptr) +{ + erts_aint_t ilast, itmp; + ErtsAllctrDDBlock_t *this = ptr; + + erts_atomic_init_nob(&this->atmc_next, ERTS_AINT_NULL); + + /* Enqueue at end of list... */ + + ilast = erts_atomic_read_nob(&ddq->tail.data.last); + while (1) { + ErtsAllctrDDBlock_t *last = (ErtsAllctrDDBlock_t *) ilast; + itmp = erts_atomic_cmpxchg_mb(&last->atmc_next, + (erts_aint_t) this, + ERTS_AINT_NULL); + if (itmp == ERTS_AINT_NULL) + break; + ilast = itmp; + } + + /* Move last pointer forward... */ + while (1) { + if (erts_atomic_read_rb(&this->atmc_next) != ERTS_AINT_NULL) { + /* Someone else will move it forward */ + return erts_atomic_read_rb(&ddq->tail.data.last); + } + itmp = erts_atomic_cmpxchg_mb(&ddq->tail.data.last, + (erts_aint_t) this, + ilast); + if (ilast == itmp) + return (erts_aint_t) this; + ilast = itmp; + } +} + +static ERTS_INLINE int +ddq_enqueue(ErtsAlcType_t type, ErtsAllctrDDQueue_t *ddq, void *ptr) +{ + erts_aint_t ilast; + int um_refc_ix = 0; + int managed_thread = erts_thr_progress_is_managed_thread(); + if (!managed_thread) { + um_refc_ix = erts_atomic32_read_acqb(&ddq->tail.data.um_refc_ix); + while (1) { + int tmp_um_refc_ix; + erts_atomic_inc_acqb(&ddq->tail.data.um_refc[um_refc_ix]); + tmp_um_refc_ix = erts_atomic32_read_acqb(&ddq->tail.data.um_refc_ix); + if (tmp_um_refc_ix == um_refc_ix) + break; + erts_atomic_dec_relb(&ddq->tail.data.um_refc[um_refc_ix]); + um_refc_ix = tmp_um_refc_ix; + } + } + + ilast = ddq_managed_thread_enqueue(ddq, ptr); + + if (!managed_thread) + erts_atomic_dec_relb(&ddq->tail.data.um_refc[um_refc_ix]); + return ilast == (erts_aint_t) ptr; +} + +static ERTS_INLINE void * +ddq_dequeue(ErtsAllctrDDQueue_t *ddq) +{ + ErtsAllctrDDBlock_t *blk; + + if (ddq->head.first == ddq->head.unref_end) + return NULL; + + blk = ddq->head.first; + if (blk == &ddq->tail.data.marker) { + ASSERT(ddq->head.used_marker); + ddq->head.used_marker = 0; + blk = ((ErtsAllctrDDBlock_t *) + erts_atomic_read_nob(&blk->atmc_next)); + if (blk == ddq->head.unref_end) { + ddq->head.first = blk; + return NULL; + } + } + + ddq->head.first = ((ErtsAllctrDDBlock_t *) + erts_atomic_read_nob(&blk->atmc_next)); + + ASSERT(ddq->head.first); + + return (void *) blk; +} + +static int +ddq_check_incoming(ErtsAllctrDDQueue_t *ddq) +{ + erts_aint_t ilast = erts_atomic_read_nob(&ddq->tail.data.last); + if (((ErtsAllctrDDBlock_t *) ilast) == &ddq->tail.data.marker + && ddq->head.first == &ddq->tail.data.marker) { + /* Nothing more to do... */ + return 0; + } + + if (ddq->head.next.thr_progress_reached + || erts_thr_progress_has_reached(ddq->head.next.thr_progress)) { + int um_refc_ix; + ddq->head.next.thr_progress_reached = 1; + um_refc_ix = ddq->head.next.um_refc_ix; + if (erts_atomic_read_acqb(&ddq->tail.data.um_refc[um_refc_ix]) == 0) { + /* Move unreferenced end pointer forward... */ + + ddq->head.unref_end = ddq->head.next.unref_end; + + if (!ddq->head.used_marker + && ddq->head.unref_end == (ErtsAllctrDDBlock_t *) ilast) { + ddq->head.used_marker = 1; + ilast = ddq_managed_thread_enqueue(ddq, &ddq->tail.data.marker); + } + + if (ddq->head.unref_end == (ErtsAllctrDDBlock_t *) ilast) + ERTS_THR_MEMORY_BARRIER; + else { + ddq->head.next.unref_end = (ErtsAllctrDDBlock_t *) ilast; + ERTS_THR_MEMORY_BARRIER; + ddq->head.next.thr_progress = erts_thr_progress_later(); + erts_atomic32_set_relb(&ddq->tail.data.um_refc_ix, + um_refc_ix); + ddq->head.next.um_refc_ix = um_refc_ix == 0 ? 1 : 0; + ddq->head.next.thr_progress_reached = 0; + } + } + } + return 1; +} + +static ERTS_INLINE int +handle_delayed_dealloc(Allctr_t *allctr, + int allctr_locked, + int use_limit, + int ops_limit, + int *need_thr_progress, + int *need_more_work) +{ + int need_thr_prgr = 0; + int need_mr_wrk = 0; + int have_checked_incoming = 0; + int ops = 0; + ErtsAlcFixList_t *fix; + int res; + ErtsAllctrDDQueue_t *ddq; + + if (allctr->thread_safe && !allctr_locked) + erts_mtx_lock(&allctr->mutex); + + ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); + + fix = allctr->fix; + + ddq = &allctr->dd.q; + + res = 0; + + while (1) { + Block_t *blk; + void *ptr; + int ix; + + if (use_limit && ++ops > ops_limit) { + if (ddq->head.first != ddq->head.unref_end) { + need_mr_wrk = 1; + if (need_more_work) + *need_more_work |= 1; + } + break; + } + + dequeue: + ptr = ddq_dequeue(ddq); + if (!ptr) { + if (have_checked_incoming) + break; + need_thr_prgr = ddq_check_incoming(ddq); + if (need_thr_progress) + *need_thr_progress |= need_thr_prgr; + have_checked_incoming = 1; + goto dequeue; + } + + res = 1; + + INC_CC(allctr->calls.this_free); + + if (fix) { + ErtsAlcType_t type; + + type = (ErtsAlcType_t) ((UWord *) ptr)[ERTS_ALCU_DD_FIX_TYPE_OFFS]; + ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE; + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + fix[ix].used--; + if (fix[ix].allocated < fix[ix].limit + && fix[ix].list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) { + *((void **) ptr) = fix[ix].list; + fix[ix].list = ptr; + fix[ix].list_size++; + if (!allctr->fix_shrink_scheduled) { + allctr->fix_shrink_scheduled = 1; + erts_set_aux_work_timeout( + allctr->ix, + (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), + 1); + } + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + continue; + } + fix[ix].allocated--; + if (fix[ix].list && fix[ix].allocated > fix[ix].limit) { + blk = UMEM2BLK(ptr); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk); + else + mbc_free(allctr, ptr); + ptr = fix[ix].list; + fix[ix].list = *((void **) ptr); + fix[ix].list_size--; + fix[ix].allocated--; + } + } + + blk = UMEM2BLK(ptr); + + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk); + else + mbc_free(allctr, ptr); + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + } + + if (need_thr_progress && !(need_thr_prgr | need_mr_wrk)) { + need_thr_prgr = ddq_check_incoming(ddq); + *need_thr_progress |= need_thr_prgr; + } + + if (allctr->thread_safe && !allctr_locked) + erts_mtx_unlock(&allctr->mutex); + return res; +} + +static ERTS_INLINE void +enqueue_dealloc_other_instance(ErtsAlcType_t type, Allctr_t *allctr, void *ptr) +{ + if (allctr->fix) + ((UWord *) ptr)[ERTS_ALCU_DD_FIX_TYPE_OFFS] = (UWord) type; + + if (ddq_enqueue(type, &allctr->dd.q, ptr)) + erts_alloc_notify_delayed_dealloc(allctr->ix); +} + +#endif + +void +erts_alcu_check_delayed_dealloc(Allctr_t *allctr, + int limit, + int *need_thr_progress, + int *more_work) +{ +#ifdef ERTS_SMP + handle_delayed_dealloc(allctr, + 0, + limit, + ERTS_ALCU_DD_OPS_LIM_HIGH, + need_thr_progress, + more_work); +#endif +} + +#define ERTS_ALCU_HANDLE_DD_IN_OP(Allctr, Locked) \ + handle_delayed_dealloc((Allctr), (Locked), 1, \ + ERTS_ALCU_DD_OPS_LIM_LOW, NULL, NULL) + /* Multi block carrier alloc/realloc/free ... */ /* NOTE! mbc_alloc() may in case of memory shortage place the requested @@ -680,8 +1135,21 @@ mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp, Uint32 *alcu_flgsp) } } +#ifdef ERTS_SMP + if (allctr->dd.use) + ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); +#endif + blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0, *alcu_flgsp); +#ifdef ERTS_SMP + if (!blk && allctr->dd.use) { + if (ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1)) + blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0, + *alcu_flgsp); + } +#endif + if (!blk) { if ((*alcu_flgsp) & ERTS_ALCU_FLG_SBMBC) blk = create_sbmbc(allctr, get_blk_sz); @@ -939,6 +1407,11 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) Uint is_last_blk; #endif /* #ifndef MBC_REALLOC_ALWAYS_MOVES */ +#ifdef ERTS_SMP + if (allctr->dd.use) + ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); +#endif + ASSERT(p); ASSERT(size); ASSERT(size < allctr->sbc_threshold); @@ -1005,7 +1478,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) cand_blk, cand_blk_sz, alcu_flgs); - if (new_blk || cand_blk != blk) goto move_into_new_blk; } @@ -1441,7 +1913,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) goto try_sys_alloc; if (flags & CFLG_FORCE_MSEG) goto try_mseg; - if (erts_mseg_no() >= max_mseg_carriers) + if (erts_mseg_no(&allctr->mseg_opt) >= max_mseg_carriers) goto try_sys_alloc; if (flags & CFLG_SBC) { if (allctr->sbcs.curr.norm.mseg.no >= allctr->max_mseg_sbcs) @@ -1840,8 +2312,12 @@ static struct { Eterm ycs; /* Eterm sbmbcs; */ + + Eterm fix_types; + Eterm mbcs; Eterm sbcs; + Eterm sys_alloc_carriers_size; #if HAVE_ERTS_MSEG Eterm mseg_alloc_carriers_size; @@ -1871,6 +2347,8 @@ static struct { #endif } am; +static Eterm fix_type_atoms[ERTS_ALC_NO_FIXED_SIZES]; + static ERTS_INLINE void atom_init(Eterm *atom, char *name) { *atom = am_atom_put(name, strlen(name)); @@ -1891,6 +2369,7 @@ init_atoms(Allctr_t *allctr) erts_mtx_lock(&init_atoms_mtx); if (!atoms_initialized) { + int ix; #ifdef DEBUG Eterm *atom; @@ -1933,8 +2412,12 @@ init_atoms(Allctr_t *allctr) AM_INIT(ycs); /*AM_INIT(sbmbcs);*/ + + AM_INIT(fix_types); + AM_INIT(mbcs); AM_INIT(sbcs); + AM_INIT(sys_alloc_carriers_size); #if HAVE_ERTS_MSEG AM_INIT(mseg_alloc_carriers_size); @@ -1965,6 +2448,13 @@ init_atoms(Allctr_t *allctr) ASSERT(*atom != THE_NON_VALUE); } #endif + + for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) { + ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix; + char *name = (char *) ERTS_ALC_N2TD(n); + size_t len = strlen(name); + fix_type_atoms[ix] = am_atom_put(name, len); + } } @@ -2043,6 +2533,48 @@ add_4tup(Uint **hpp, Uint *szp, Eterm *lp, } static Eterm +sz_info_fix(Allctr_t *allctr, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res; + int ix; + ErtsAlcFixList_t *fix = allctr->fix; + + ASSERT(fix); + + res = NIL; + + for (ix = ERTS_ALC_NO_FIXED_SIZES-1; ix >= 0; ix--) { + ErtsAlcType_t n = ix + ERTS_ALC_N_MIN_A_FIXED_SIZE; + Uint alloced = (fix[ix].type_size * fix[ix].allocated); + Uint used = fix[ix].type_size*fix[ix].used; + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + erts_print(to, + arg, + "fix type: %s %bpu %bpu\n", + (char *) ERTS_ALC_N2TD(n), + alloced, + used); + } + + if (hpp || szp) { + add_3tup(hpp, szp, &res, + fix_type_atoms[ix], + bld_unstable_uint(hpp, szp, alloced), + bld_unstable_uint(hpp, szp, used)); + } + } + + return res; +} + +static Eterm sz_info_carriers(Allctr_t *allctr, CarriersStats_t *cs, char *prefix, @@ -2590,7 +3122,7 @@ erts_alcu_sz_info(Allctr_t *allctr, Uint **hpp, Uint *szp) { - Eterm res, sbmbcs, mbcs, sbcs; + Eterm res, sbmbcs, mbcs, sbcs, fix = THE_NON_VALUE; res = THE_NON_VALUE; @@ -2607,6 +3139,8 @@ erts_alcu_sz_info(Allctr_t *allctr, erts_mtx_lock(&allctr->mutex); #endif + ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); + if (hpp || szp) ensure_atoms_initialized(allctr); @@ -2619,6 +3153,8 @@ erts_alcu_sz_info(Allctr_t *allctr, update_max_ever_values(&allctr->mbcs); update_max_ever_values(&allctr->sbcs); + if (allctr->fix) + fix = sz_info_fix(allctr, print_to_p, print_to_arg, hpp, szp); sbmbcs = sz_info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p, print_to_arg, hpp, szp); mbcs = sz_info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, @@ -2631,6 +3167,8 @@ erts_alcu_sz_info(Allctr_t *allctr, add_2tup(hpp, szp, &res, am.sbcs, sbcs); add_2tup(hpp, szp, &res, am.mbcs, mbcs); add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs); + if (allctr->fix) + add_2tup(hpp, szp, &res, am.fix_types, fix); } if (begin_max_period) { @@ -2656,7 +3194,7 @@ erts_alcu_info(Allctr_t *allctr, Uint **hpp, Uint *szp) { - Eterm res, sett, sbmbcs, mbcs, sbcs, calls; + Eterm res, sett, sbmbcs, mbcs, sbcs, calls, fix = THE_NON_VALUE; res = THE_NON_VALUE; @@ -2673,6 +3211,8 @@ erts_alcu_info(Allctr_t *allctr, erts_mtx_lock(&allctr->mutex); #endif + ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); + if (hpp || szp) ensure_atoms_initialized(allctr); @@ -2694,6 +3234,8 @@ erts_alcu_info(Allctr_t *allctr, } sett = info_options(allctr, print_to_p, print_to_arg, hpp, szp); + if (allctr->fix) + fix = sz_info_fix(allctr, print_to_p, print_to_arg, hpp, szp); sbmbcs = info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p, print_to_arg, hpp, szp); mbcs = info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, @@ -2709,6 +3251,8 @@ erts_alcu_info(Allctr_t *allctr, add_2tup(hpp, szp, &res, am.sbcs, sbcs); add_2tup(hpp, szp, &res, am.mbcs, mbcs); add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs); + if (allctr->fix) + add_2tup(hpp, szp, &res, am.fix_types, fix); add_2tup(hpp, szp, &res, am.options, sett); add_3tup(hpp, szp, &res, am.versions, @@ -2733,7 +3277,7 @@ erts_alcu_info(Allctr_t *allctr, void -erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size) +erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t *fi, int fisz) { #ifdef USE_THREADS @@ -2751,6 +3295,18 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size) size->blocks += allctr->sbmbcs.blocks.curr.size; size->blocks += allctr->sbcs.blocks.curr.size; + if (fi) { + int ix; + for (ix = 0; ix < fisz; ix++) { + if (allctr->fix) { + fi[ix].allocated += (allctr->fix[ix].type_size + * allctr->fix[ix].allocated); + fi[ix].used += (allctr->fix[ix].type_size + * allctr->fix[ix].used); + } + } + } + #ifdef USE_THREADS if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); @@ -2764,12 +3320,16 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) { Allctr_t *allctr = (Allctr_t *) extra; void *res; + ErtsAlcFixList_t *fix; ASSERT(initialized); ASSERT(allctr); - ERTS_ALCU_DBG_CHK_THR_SPEC(allctr); + ERTS_SMP_LC_ASSERT(!allctr->thread_safe + || erts_lc_mtx_is_locked(&allctr->mutex)); + + ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); #if ALLOC_ZERO_EQ_NULL if (!size) @@ -2778,18 +3338,61 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) INC_CC(allctr->calls.this_alloc); + fix = allctr->fix; + if (fix) { + int ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE; + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + fix[ix].used++; + res = fix[ix].list; + if (res) { + fix[ix].list_size--; + fix[ix].list = *((void **) res); + if (fix[ix].list && fix[ix].allocated > fix[ix].limit) { + void *p = fix[ix].list; + Block_t *blk; + fix[ix].list = *((void **) p); + fix[ix].list_size--; + blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk); + else + mbc_free(allctr, p); + fix[ix].allocated--; + } + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + return res; + } + if (size < 2*sizeof(UWord)) + size += sizeof(UWord); + if (fix[ix].limit < fix[ix].used) + fix[ix].limit = fix[ix].used; + if (fix[ix].max_used < fix[ix].used) + fix[ix].max_used = fix[ix].used; + fix[ix].allocated++; + } + if (size >= allctr->sbc_threshold) { + Block_t *blk; +#ifdef ERTS_SMP + if (allctr->dd.use) + ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); +#endif #if HALFWORD_HEAP - Block_t *blk = create_carrier(allctr, size, - CFLG_SBC | CFLG_FORCE_MSEG); + blk = create_carrier(allctr, size, + CFLG_SBC | CFLG_FORCE_MSEG); #else - Block_t *blk = create_carrier(allctr, size, CFLG_SBC); + blk = create_carrier(allctr, size, CFLG_SBC); #endif res = blk ? BLK2UMEM(blk) : NULL; } else res = mbc_alloc(allctr, size); + if (!res && fix) { + int ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE; + fix[ix].allocated--; + fix[ix].used--; + } return res; } @@ -2818,29 +3421,28 @@ erts_alcu_alloc_ts(ErtsAlcType_t type, void *extra, Uint size) return res; } +#ifdef ERTS_SMP + void * erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size) { ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; - int ix = erts_alc_get_thr_ix(); + int ix; Allctr_t *allctr; - int unlock; void *res; - ASSERT(ix > 0); - if (ix < tspec->size) { - allctr = tspec->allctr[ix]; - unlock = 0; - } - else { - allctr = tspec->allctr[0]; - unlock = 1; + ix = ERTS_ALC_GET_THR_IX(); + + ASSERT(0 <= ix && ix < tspec->size); + + allctr = tspec->allctr[ix]; + + if (allctr->thread_safe) erts_mtx_lock(&allctr->mutex); - } res = do_erts_alcu_alloc(type, allctr, size); - if (unlock) + if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); DEBUG_CHECK_ALIGNMENT(res); @@ -2851,51 +3453,96 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size) void * erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size) { - ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; - int ix = erts_alc_get_thr_ix(); - Allctr_t *allctr; + int pref_ix; + Allctr_t *pref_allctr; void *res; - ASSERT(sizeof(UWord) == sizeof(Allctr_t *)); - ASSERT(ix > 0); - if (ix >= tspec->size) - ix = (ix % (tspec->size - 1)) + 1; - allctr = tspec->allctr[ix]; - erts_mtx_lock(&allctr->mutex); - res = do_erts_alcu_alloc(type, allctr, size + sizeof(UWord)); - if (res) { - *((Allctr_t **) res) = allctr; - res = (void *) (((char *) res) + sizeof(UWord)); - } - erts_mtx_unlock(&allctr->mutex); + pref_ix = get_pref_allctr(extra, &pref_allctr); + + if (pref_allctr->thread_safe) + erts_mtx_lock(&pref_allctr->mutex); + + ERTS_ALCU_DBG_CHK_THR_ACCESS(pref_allctr); + + res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(UWord)); + if (pref_allctr->thread_safe) + erts_mtx_unlock(&pref_allctr->mutex); + + if (res) + res = put_used_allctr(res, pref_ix, size); + DEBUG_CHECK_ALIGNMENT(res); + + return res; } #endif +#endif + /* ------------------------------------------------------------------------- */ static ERTS_INLINE void do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p) { + int ix; Allctr_t *allctr = (Allctr_t *) extra; ASSERT(initialized); ASSERT(allctr); - ERTS_ALCU_DBG_CHK_THR_SPEC(allctr); + ERTS_SMP_LC_ASSERT(!allctr->thread_safe + || erts_lc_mtx_is_locked(&allctr->mutex)); + + ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); if (p) { + ErtsAlcFixList_t *fix = allctr->fix; Block_t *blk; INC_CC(allctr->calls.this_free); + if (fix) { + ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE; + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + fix[ix].used--; + if (fix[ix].allocated < fix[ix].limit + && fix[ix].list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) { + *((void **) p) = fix[ix].list; + fix[ix].list = p; + fix[ix].list_size++; + if (!allctr->fix_shrink_scheduled) { + allctr->fix_shrink_scheduled = 1; + erts_set_aux_work_timeout( + allctr->ix, + (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), + 1); + } + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + return; + } + fix[ix].allocated--; + if (fix[ix].list && fix[ix].allocated > fix[ix].limit) { + blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk); + else + mbc_free(allctr, p); + p = fix[ix].list; + fix[ix].list = *((void **) p); + fix[ix].list_size--; + fix[ix].allocated--; + } + } + blk = UMEM2BLK(p); if (IS_SBC_BLK(blk)) destroy_carrier(allctr, blk); else mbc_free(allctr, p); + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); } } @@ -2915,44 +3562,56 @@ erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p) erts_mtx_unlock(&allctr->mutex); } +#ifdef ERTS_SMP + void erts_alcu_free_thr_spec(ErtsAlcType_t type, void *extra, void *p) { ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; - int ix = erts_alc_get_thr_ix(); - int unlock; + int ix; Allctr_t *allctr; - ASSERT(ix > 0); - if (ix < tspec->size) { - allctr = tspec->allctr[ix]; - unlock = 0; - } - else { - allctr = tspec->allctr[0]; - unlock = 1; + ix = ERTS_ALC_GET_THR_IX(); + + ASSERT(0 <= ix && ix < tspec->size); + + allctr = tspec->allctr[ix]; + + if (allctr->thread_safe) erts_mtx_lock(&allctr->mutex); - } do_erts_alcu_free(type, allctr, p); - if (unlock) + + if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); } void -erts_alcu_free_thr_pref(ErtsAlcType_t type, void *unused, void *p) +erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p) { if (p) { - void *ptr = (void *) (((char *) p) - sizeof(UWord)); - Allctr_t *allctr = *((Allctr_t **) ptr); - erts_mtx_lock(&allctr->mutex); - do_erts_alcu_free(type, allctr, ptr); - erts_mtx_unlock(&allctr->mutex); + Allctr_t *pref_allctr, *used_allctr; + void *ptr; + + get_pref_allctr(extra, &pref_allctr); + ptr = get_used_allctr(extra, p, &used_allctr, NULL); + if (pref_allctr != used_allctr) + enqueue_dealloc_other_instance(type, used_allctr, ptr); + else { + if (used_allctr->thread_safe) + erts_mtx_lock(&used_allctr->mutex); + ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr); + do_erts_alcu_free(type, used_allctr, ptr); + if (used_allctr->thread_safe) + erts_mtx_unlock(&used_allctr->mutex); + } } } #endif +#endif + /* ------------------------------------------------------------------------- */ static ERTS_INLINE void * @@ -2970,7 +3629,10 @@ do_erts_alcu_realloc(ErtsAlcType_t type, ASSERT(allctr); - ERTS_ALCU_DBG_CHK_THR_SPEC(allctr); + ERTS_SMP_LC_ASSERT(!allctr->thread_safe + || erts_lc_mtx_is_locked(&allctr->mutex)); + + ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); if (!p) { res = do_erts_alcu_alloc(type, extra, size); @@ -3063,6 +3725,10 @@ do_erts_alcu_realloc(ErtsAlcType_t type, } else { Block_t *new_blk; +#ifdef ERTS_SMP + if (allctr->dd.use) + ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); +#endif if(IS_SBC_BLK(blk)) { do_carrier_resize: #if HALFWORD_HEAP @@ -3166,30 +3832,29 @@ erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size) return res; } +#ifdef ERTS_SMP + void * erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra, void *ptr, Uint size) { ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; - int ix = erts_alc_get_thr_ix(); + int ix; Allctr_t *allctr; - int unlock; void *res; - ASSERT(ix > 0); - if (ix < tspec->size) { - allctr = tspec->allctr[ix]; - unlock = 0; - } - else { - allctr = tspec->allctr[0]; - unlock = 1; + ix = ERTS_ALC_GET_THR_IX(); + + ASSERT(0 <= ix && ix < tspec->size); + + allctr = tspec->allctr[ix]; + + if (allctr->thread_safe) erts_mtx_lock(&allctr->mutex); - } res = do_erts_alcu_realloc(type, allctr, ptr, size, 0); - if (unlock) + if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); DEBUG_CHECK_ALIGNMENT(res); @@ -3202,26 +3867,22 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra, void *ptr, Uint size) { ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; - int ix = erts_alc_get_thr_ix(); + int ix; Allctr_t *allctr; - int unlock; void *res; - ASSERT(ix > 0); - if (ix < tspec->size) { - allctr = tspec->allctr[ix]; - unlock = 0; - } - else { - allctr = tspec->allctr[0]; - unlock = 1; - erts_mtx_lock(&allctr->mutex); - } + ix = ERTS_ALC_GET_THR_IX(); + ASSERT(0 <= ix && ix < tspec->size); + + allctr = tspec->allctr[ix]; + + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); res = do_erts_alcu_alloc(type, allctr, size); if (!res) { - if (unlock) + if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); res = erts_alcu_realloc_thr_spec(type, allctr, ptr, size); } @@ -3235,7 +3896,7 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra, cpy_size = size; sys_memcpy(res, ptr, cpy_size); do_erts_alcu_free(type, allctr, ptr); - if (unlock) + if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); } @@ -3244,129 +3905,101 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra, return res; } -void * -erts_alcu_realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size) +static ERTS_INLINE void * +realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size, + int force_move) { - ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; - int ix; + int pref_ix; void *ptr, *res; Allctr_t *pref_allctr, *used_allctr; + UWord old_user_size; if (!p) return erts_alcu_alloc_thr_pref(type, extra, size); - ptr = (void *) (((char *) p) - sizeof(UWord)); - used_allctr = *((Allctr_t **) ptr); + pref_ix = get_pref_allctr(extra, &pref_allctr); + ptr = get_used_allctr(extra, p, &used_allctr, &old_user_size); - ix = erts_alc_get_thr_ix(); - ASSERT(ix > 0); - if (ix >= tspec->size) - ix = (ix % (tspec->size - 1)) + 1; - pref_allctr = tspec->allctr[ix]; ASSERT(used_allctr && pref_allctr); - erts_mtx_lock(&used_allctr->mutex); - res = do_erts_alcu_realloc(type, - used_allctr, - ptr, - size + sizeof(UWord), - (pref_allctr != used_allctr - ? ERTS_ALCU_FLG_FAIL_REALLOC_MOVE - : 0)); - erts_mtx_unlock(&used_allctr->mutex); - if (res) { - ASSERT(used_allctr == *((Allctr_t **) res)); - res = (void *) (((char *) res) + sizeof(UWord)); - DEBUG_CHECK_ALIGNMENT(res); + if (!force_move && used_allctr == pref_allctr) { + if (used_allctr->thread_safe) + erts_mtx_lock(&used_allctr->mutex); + ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr); + res = do_erts_alcu_realloc(type, + used_allctr, + ptr, + size + sizeof(UWord), + 0); + if (used_allctr->thread_safe) + erts_mtx_unlock(&used_allctr->mutex); + if (res) + res = put_used_allctr(res, pref_ix, size); } else { - erts_mtx_lock(&pref_allctr->mutex); + if (pref_allctr->thread_safe) + erts_mtx_lock(&pref_allctr->mutex); res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(UWord)); - erts_mtx_unlock(&pref_allctr->mutex); + if (pref_allctr->thread_safe && (!force_move + || used_allctr != pref_allctr)) + erts_mtx_unlock(&pref_allctr->mutex); if (res) { Block_t *blk; size_t cpy_size; - *((Allctr_t **) res) = pref_allctr; - res = (void *) (((char *) res) + sizeof(UWord)); + res = put_used_allctr(res, pref_ix, size); DEBUG_CHECK_ALIGNMENT(res); - erts_mtx_lock(&used_allctr->mutex); blk = UMEM2BLK(ptr); - cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ - sizeof(UWord); + if (old_user_size != ERTS_AU_PREF_ALLOC_SIZE_MASK) + cpy_size = old_user_size; + else { + if (used_allctr->thread_safe && (!force_move + || used_allctr != pref_allctr)) + erts_mtx_lock(&used_allctr->mutex); + ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&used_allctr->mutex)); + cpy_size = BLK_SZ(blk); + if (used_allctr->thread_safe && (!force_move + || used_allctr != pref_allctr)) + erts_mtx_unlock(&used_allctr->mutex); + cpy_size -= ABLK_HDR_SZ + sizeof(UWord); + } if (cpy_size > size) cpy_size = size; sys_memcpy(res, p, cpy_size); - do_erts_alcu_free(type, used_allctr, ptr); - erts_mtx_unlock(&used_allctr->mutex); + + if (!force_move || used_allctr != pref_allctr) + enqueue_dealloc_other_instance(type, used_allctr, ptr); + else { + do_erts_alcu_free(type, used_allctr, ptr); + ASSERT(pref_allctr == used_allctr); + if (pref_allctr->thread_safe) + erts_mtx_unlock(&pref_allctr->mutex); + } } } return res; } +void * +erts_alcu_realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size) +{ + return realloc_thr_pref(type, extra, p, size, 0); +} void * erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size) { - ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; - int ix; - void *ptr, *res; - Allctr_t *pref_allctr, *used_allctr; - - if (!p) - return erts_alcu_alloc_thr_pref(type, extra, size); - - ptr = (void *) (((char *) p) - sizeof(UWord)); - used_allctr = *((Allctr_t **) ptr); - - ix = erts_alc_get_thr_ix(); - ASSERT(ix > 0); - if (ix >= tspec->size) - ix = (ix % (tspec->size - 1)) + 1; - pref_allctr = tspec->allctr[ix]; - ASSERT(used_allctr && pref_allctr); - - erts_mtx_lock(&pref_allctr->mutex); - res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(UWord)); - if (!res) { - erts_mtx_unlock(&pref_allctr->mutex); - res = erts_alcu_realloc_thr_pref(type, extra, p, size); - } - else { - Block_t *blk; - size_t cpy_size; - Allctr_t *allctr; - - *((Allctr_t **) res) = pref_allctr; - res = (void *) (((char *) res) + sizeof(UWord)); - - DEBUG_CHECK_ALIGNMENT(res); - - if (used_allctr == pref_allctr) - allctr = pref_allctr; - else { - erts_mtx_unlock(&pref_allctr->mutex); - allctr = used_allctr; - erts_mtx_lock(&allctr->mutex); - } - - blk = UMEM2BLK(ptr); - cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ - sizeof(UWord); - if (cpy_size > size) - cpy_size = size; - sys_memcpy(res, p, cpy_size); - do_erts_alcu_free(type, allctr, ptr); - erts_mtx_unlock(&allctr->mutex); - } - - return res; + return realloc_thr_pref(type, extra, p, size, 1); } #endif +#endif + /* ------------------------------------------------------------------------- */ int @@ -3381,6 +4014,10 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) sys_memcpy((void *) &allctr->mseg_opt, (void *) &erts_mseg_default_opt, sizeof(ErtsMsegOpt_t)); +#ifdef ERTS_SMP + if (init->tspec || init->tpref) + allctr->mseg_opt.sched_spec = 1; +#endif # if HALFWORD_HEAP allctr->mseg_opt.low_mem = init->low_mem; # endif @@ -3390,6 +4027,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) if (!allctr->name_prefix) goto error; + allctr->ix = init->ix; allctr->alloc_no = init->alloc_no; if (allctr->alloc_no < ERTS_ALC_A_MIN || ERTS_ALC_A_MAX < allctr->alloc_no) @@ -3431,6 +4069,18 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) goto error; allctr->min_block_size = UNIT_CEILING(allctr->min_block_size + sizeof(UWord)); +#if ERTS_SMP + if (init->tpref) { + Uint sz = sizeof(Block_t); + sz += ERTS_ALCU_DD_FIX_TYPE_OFFS*sizeof(UWord); + if (init->fix) + sz += sizeof(UWord); + sz = UNIT_CEILING(sz); + if (sz > allctr->min_block_size) + allctr->min_block_size = sz; + } +#endif + allctr->sbmbc_threshold = init->sbmbct; @@ -3493,7 +4143,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) if (allctr->mbc_header_size < sizeof(Carrier_t)) goto error; -#ifdef USE_THREADS +#ifdef ERTS_SMP + allctr->dd.use = 0; if (init->tpref) { allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size + FBLK_FTR_SZ @@ -3507,6 +4158,9 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) + sizeof(UWord)) - ABLK_HDR_SZ - sizeof(UWord)); + + allctr->dd.use = 1; + init_dd_queue(&allctr->dd.q); } else #endif @@ -3548,6 +4202,21 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) } + if (init->fix) { + int i; + allctr->fix = init->fix; + allctr->fix_shrink_scheduled = 0; + for (i = 0; i < ERTS_ALC_NO_FIXED_SIZES; i++) { + allctr->fix[i].max_used = 0; + allctr->fix[i].limit = 0; + allctr->fix[i].type_size = init->fix_type_size[i]; + allctr->fix[i].list_size = 0; + allctr->fix[i].list = NULL; + allctr->fix[i].allocated = 0; + allctr->fix[i].used = 0; + } + } + return 1; error: diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index fed4d3dbe6..df560a0de2 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -20,10 +20,13 @@ #ifndef ERL_ALLOC_UTIL__ #define ERL_ALLOC_UTIL__ -#define ERTS_ALCU_VSN_STR "2.2" +#define ERTS_ALCU_VSN_STR "3.0" #include "erl_alloc_types.h" +#define ERTS_AU_PREF_ALLOC_BITS 11 +#define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS) + typedef struct Allctr_t_ Allctr_t; typedef struct { @@ -35,6 +38,7 @@ typedef struct { char *name_prefix; ErtsAlcType_t alloc_no; int force; + int ix; int ts; int tspec; int tpref; @@ -53,6 +57,9 @@ typedef struct { UWord mbcgs; UWord sbmbct; UWord sbmbcs; + + void *fix; + size_t *fix_type_size; } AllctrInit_t; typedef struct { @@ -60,6 +67,11 @@ typedef struct { UWord carriers; } AllctrSize_t; +typedef struct { + UWord allocated; + UWord used; +} ErtsAlcUFixInfo_t; + #ifndef SMALL_MEMORY #define ERTS_DEFAULT_ALCU_INIT { \ @@ -71,6 +83,7 @@ typedef struct { NULL, \ ERTS_ALC_A_INVALID, /* (number) alloc_no: allocator number */\ 0, /* (bool) force: force enabled */\ + 0, /* (number) ix: instance index */\ 1, /* (bool) ts: thread safe */\ 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ @@ -88,7 +101,10 @@ typedef struct { 1024*1024, /* (bytes) smbcs: smallest mbc size */\ 10, /* (amount) mbcgs: mbc growth stages */\ 256, /* (bytes) sbmbct: small block mbc threshold */\ - 8*1024 /* (bytes) sbmbcs: small block mbc size */\ + 8*1024, /* (bytes) sbmbcs: small block mbc size */ \ + /* --- Data not options -------------------------------------------- */\ + NULL, /* (ptr) fix */\ + NULL /* (ptr) fix_type_size */\ } #else /* if SMALL_MEMORY */ @@ -102,6 +118,7 @@ typedef struct { NULL, \ ERTS_ALC_A_INVALID, /* (number) alloc_no: allocator number */\ 0, /* (bool) force: force enabled */\ + 0, /* (number) ix: instance index */\ 1, /* (bool) ts: thread safe */\ 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ @@ -118,7 +135,10 @@ typedef struct { 128*1024, /* (bytes) smbcs: smallest mbc size */\ 10, /* (amount) mbcgs: mbc growth stages */\ 256, /* (bytes) sbmbct: small block mbc threshold */\ - 8*1024 /* (bytes) sbmbcs: small block mbc size */\ + 8*1024, /* (bytes) sbmbcs: small block mbc size */ \ + /* --- Data not options -------------------------------------------- */\ + NULL, /* (ptr) fix */\ + NULL /* (ptr) fix_type_size */\ } #endif @@ -132,6 +152,7 @@ void * erts_alcu_alloc_ts(ErtsAlcType_t, void *, Uint); void * erts_alcu_realloc_ts(ErtsAlcType_t, void *, void *, Uint); void * erts_alcu_realloc_mv_ts(ErtsAlcType_t, void *, void *, Uint); void erts_alcu_free_ts(ErtsAlcType_t, void *, void *); +#ifdef ERTS_SMP void * erts_alcu_alloc_thr_spec(ErtsAlcType_t, void *, Uint); void * erts_alcu_realloc_thr_spec(ErtsAlcType_t, void *, void *, Uint); void * erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t, void *, void *, Uint); @@ -141,12 +162,16 @@ void * erts_alcu_realloc_thr_pref(ErtsAlcType_t, void *, void *, Uint); void * erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t, void *, void *, Uint); void erts_alcu_free_thr_pref(ErtsAlcType_t, void *, void *); #endif +#endif Eterm erts_alcu_au_info_options(int *, void *, Uint **, Uint *); Eterm erts_alcu_info_options(Allctr_t *, int *, void *, Uint **, Uint *); Eterm erts_alcu_sz_info(Allctr_t *, int, int *, void *, Uint **, Uint *); Eterm erts_alcu_info(Allctr_t *, int, int *, void *, Uint **, Uint *); void erts_alcu_init(AlcUInit_t *); -void erts_alcu_current_size(Allctr_t *, AllctrSize_t *); +void erts_alcu_current_size(Allctr_t *, AllctrSize_t *, + ErtsAlcUFixInfo_t *, int); +void erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, int *); +erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); #endif @@ -246,7 +271,74 @@ typedef struct { } blocks; } CarriersStats_t; +#ifdef ERTS_SMP + +typedef union ErtsAllctrDDBlock_t_ ErtsAllctrDDBlock_t; + +union ErtsAllctrDDBlock_t_ { + erts_atomic_t atmc_next; + ErtsAllctrDDBlock_t *ptr_next; +}; + +typedef struct { + ErtsAllctrDDBlock_t marker; + erts_atomic_t last; + erts_atomic_t um_refc[2]; + erts_atomic32_t um_refc_ix; +} ErtsDDTail_t; + +typedef struct { + /* + * This structure needs to be cache line aligned for best + * performance. + */ + union { + /* Modified by threads returning memory to this allocator */ + ErtsDDTail_t data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsDDTail_t))]; + } tail; + /* + * Everything below this point is *only* accessed by the + * thread owning the allocator. + */ + struct { + ErtsAllctrDDBlock_t *first; + ErtsAllctrDDBlock_t *unref_end; + struct { + ErtsThrPrgrVal thr_progress; + int thr_progress_reached; + int um_refc_ix; + ErtsAllctrDDBlock_t *unref_end; + } next; + int used_marker; + } head; +} ErtsAllctrDDQueue_t; + +#endif + +typedef struct { + size_t type_size; + SWord list_size; + void *list; + SWord max_used; + SWord limit; + SWord allocated; + SWord used; +} ErtsAlcFixList_t; + struct Allctr_t_ { +#ifdef ERTS_SMP + struct { + /* + * We want the queue at the beginning of + * the Allctr_t struct, due to cache line + * alignment reasons. + */ + ErtsAllctrDDQueue_t q; + int use; + int ix; + } dd; +#endif /* Allocator name prefix */ char * name_prefix; @@ -254,6 +346,9 @@ struct Allctr_t_ { /* Allocator number */ ErtsAlcType_t alloc_no; + /* Instance index */ + int ix; + /* Alloc, realloc and free names as atoms */ struct { Eterm alloc; @@ -278,6 +373,7 @@ struct Allctr_t_ { Uint mbc_growth_stages; Uint sbmbc_threshold; Uint sbmbc_size; + #if HAVE_ERTS_MSEG ErtsMsegOpt_t mseg_opt; #endif @@ -315,6 +411,10 @@ struct Allctr_t_ { void (*check_mbc) (Allctr_t *, Carrier_t *); #endif + int fix_n_base; + int fix_shrink_scheduled; + ErtsAlcFixList_t *fix; + #ifdef USE_THREADS /* Mutex for this allocator */ erts_mtx_t mutex; @@ -323,6 +423,7 @@ struct Allctr_t_ { Allctr_t *prev; Allctr_t *next; } ts_list; + #endif int atoms_initialized; diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c index 90d8ea7300..5bdb752d3a 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.c +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -170,14 +170,18 @@ erts_aoffalc_start(AOFFAllctr_t *alc, AOFFAllctrInit_t* aoffinit, AllctrInit_t *init) { - AOFFAllctr_t nulled_state = {{0}}; - /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc - warning. gcc warns if {0} is used as initializer of a struct when - the first member is a struct (not if, for example, the third member - is a struct). */ + struct { + int dummy; + AOFFAllctr_t allctr; + } zero = {0}; + /* The struct with a dummy element first is used in order to avoid (an + incorrect) gcc warning. gcc warns if {0} is used as initializer of + a struct when the first member is a struct (not if, for example, + the third member is a struct). */ + Allctr_t *allctr = (Allctr_t *) alc; - sys_memcpy((void *) alc, (void *) &nulled_state, sizeof(AOFFAllctr_t)); + sys_memcpy((void *) alc, (void *) &zero.allctr, sizeof(AOFFAllctr_t)); allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c index 64fad9fe0e..5150a8a507 100644 --- a/erts/emulator/beam/erl_arith.c +++ b/erts/emulator/beam/erl_arith.c @@ -164,14 +164,14 @@ BIF_RETTYPE bxor_2(BIF_ALIST_2) BIF_RET(erts_bxor(BIF_P, BIF_ARG_1, BIF_ARG_2)); } -BIF_RETTYPE bsl_2(Process* p, Eterm arg1, Eterm arg2) +BIF_RETTYPE bsl_2(BIF_ALIST_2) { - BIF_RET(shift(p, arg1, arg2, 0)); + BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 0)); } -BIF_RETTYPE bsr_2(Process* p, Eterm arg1, Eterm arg2) +BIF_RETTYPE bsr_2(BIF_ALIST_2) { - BIF_RET(shift(p, arg1, arg2, 1)); + BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 1)); } static Eterm diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index 91b64411d4..2dc7237f7c 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -24,10 +24,18 @@ #include "erl_sys_driver.h" #include "global.h" #include "erl_threads.h" +#include "erl_thr_queue.h" +#include "erl_async.h" + +#define ERTS_MAX_ASYNC_READY_CALLS_IN_SEQ 20 + +#define ERTS_ASYNC_PRINT_JOB 0 + +#if !defined(ERTS_SMP) && defined(USE_THREADS) && !ERTS_USE_ASYNC_READY_Q +# error "Need async ready queue in non-smp case" +#endif typedef struct _erl_async { - struct _erl_async* next; - struct _erl_async* prev; DE_Handle* hndl; /* The DE_Handle is needed when port is gone */ Eterm port; long async_id; @@ -35,345 +43,498 @@ typedef struct _erl_async { ErlDrvPDL pdl; void (*async_invoke)(void*); void (*async_free)(void*); -} ErlAsync; +#if ERTS_USE_ASYNC_READY_Q + Uint sched_id; + union { + ErtsThrQPrepEnQ_t *prep_enq; + ErtsThrQFinDeQ_t fin_deq; + } q; +#endif +} ErtsAsync; + +#if ERTS_USE_ASYNC_READY_Q + +/* + * We can do without the enqueue mutex since it isn't needed for + * thread safety. Its only purpose is to put async threads to sleep + * during a blast of ready async jobs. This in order to reduce + * contention on the enqueue end of the async ready queues. During + * such a blast without the enqueue mutex much cpu time is consumed + * by the async threads without them doing much progress which in turn + * slow down progress of scheduler threads. + */ +#define ERTS_USE_ASYNC_READY_ENQ_MTX 1 + +#if ERTS_USE_ASYNC_READY_ENQ_MTX typedef struct { - erts_mtx_t mtx; - erts_cnd_t cv; - erts_tid_t thr; - int len; -#ifndef ERTS_SMP - int hndl; + erts_mtx_t enq_mtx; +} ErtsAsyncReadyQXData; + #endif - ErlAsync* head; - ErlAsync* tail; -#ifdef ERTS_ENABLE_LOCK_CHECK - int no; + +typedef struct { +#if ERTS_USE_ASYNC_READY_ENQ_MTX + union { + ErtsAsyncReadyQXData data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE( + sizeof(ErtsAsyncReadyQXData))]; + } x; #endif -} AsyncQueue; + ErtsThrQ_t thr_q; + ErtsThrQFinDeQ_t fin_deq; +} ErtsAsyncReadyQ; -static erts_smp_spinlock_t async_id_lock; -static long async_id = 0; +typedef union { + ErtsAsyncReadyQ arq; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncReadyQ))]; +} ErtsAlgndAsyncReadyQ; -#ifndef ERTS_SMP +#endif /* ERTS_USE_ASYNC_READY_Q */ -erts_mtx_t async_ready_mtx; -static ErlAsync* async_ready_list = NULL; +typedef struct { + ErtsThrQ_t thr_q; + erts_tid_t thr_id; +} ErtsAsyncQ; + +typedef union { + ErtsAsyncQ aq; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncQ))]; +} ErtsAlgndAsyncQ; +typedef struct { + int no_initialized; + erts_mtx_t mtx; + erts_cnd_t cnd; + erts_atomic_t id; +} ErtsAsyncInit; + +typedef struct { + union { + ErtsAsyncInit data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncInit))]; + } init; + ErtsAlgndAsyncQ *queue; +#if ERTS_USE_ASYNC_READY_Q + ErtsAlgndAsyncReadyQ *ready_queue; #endif +} ErtsAsyncData; -/* -** Initialize worker threads (if supported) -*/ +int erts_async_max_threads; /* Initialized by erl_init.c */ +int erts_async_thread_suggested_stack_size; /* Initialized by erl_init.c */ -/* Detach from driver */ -static void async_detach(DE_Handle* dh) -{ - return; -} +static ErtsAsyncData *async; +#ifndef USE_THREADS -#ifdef USE_THREADS +void +erts_init_async(void) +{ -static AsyncQueue* async_q; +} -static void* async_main(void*); -static void async_add(ErlAsync*, AsyncQueue*); +#else -#ifndef ERTS_SMP -typedef struct ErtsAsyncReadyCallback_ ErtsAsyncReadyCallback; -struct ErtsAsyncReadyCallback_ { - struct ErtsAsyncReadyCallback_ *next; - void (*callback)(void); -}; +static void *async_main(void *); -static ErtsAsyncReadyCallback *callbacks; -static int async_handle; +static ERTS_INLINE ErtsAsyncQ * +async_q(int i) +{ + return &async->queue[i].aq; +} + +#if ERTS_USE_ASYNC_READY_Q -int erts_register_async_ready_callback(void (*funcp)(void)) +static ERTS_INLINE ErtsAsyncReadyQ * +async_ready_q(Uint sched_id) { - ErtsAsyncReadyCallback *cb = erts_alloc(ERTS_ALC_T_ARCALLBACK, - sizeof(ErtsAsyncReadyCallback)); - cb->next = callbacks; - cb->callback = funcp; - erts_mtx_lock(&async_ready_mtx); - callbacks = cb; - erts_mtx_unlock(&async_ready_mtx); - return async_handle; + return &async->ready_queue[((int)sched_id)-1].arq; } + #endif -int init_async(int hndl) +void +erts_init_async(void) { - erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; - AsyncQueue* q; - int i; + async = NULL; + if (erts_async_max_threads > 0) { +#if ERTS_USE_ASYNC_READY_Q + ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT; +#endif + erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; + char *ptr; + size_t tot_size = 0; + int i; + + tot_size += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncData)); + tot_size += sizeof(ErtsAlgndAsyncQ)*erts_async_max_threads; +#if ERTS_USE_ASYNC_READY_Q + tot_size += sizeof(ErtsAlgndAsyncReadyQ)*erts_no_schedulers; +#endif - thr_opts.detached = 0; - thr_opts.suggested_stack_size = erts_async_thread_suggested_stack_size; - -#ifndef ERTS_SMP - callbacks = NULL; - async_handle = hndl; - erts_mtx_init(&async_ready_mtx, "async_ready"); - async_ready_list = NULL; -#endif - - async_id = 0; - erts_smp_spinlock_init(&async_id_lock, "async_id"); - - async_q = q = (AsyncQueue*) - (erts_async_max_threads - ? erts_alloc(ERTS_ALC_T_ASYNC_Q, - erts_async_max_threads * sizeof(AsyncQueue)) - : NULL); - for (i = 0; i < erts_async_max_threads; i++) { - q->head = NULL; - q->tail = NULL; - q->len = 0; -#ifndef ERTS_SMP - q->hndl = hndl; -#endif -#ifdef ERTS_ENABLE_LOCK_CHECK - q->no = i; -#endif - erts_mtx_init(&q->mtx, "asyncq"); - erts_cnd_init(&q->cv); - erts_thr_create(&q->thr, async_main, (void*)q, &thr_opts); - q++; - } - return 0; -} + ptr = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_ASYNC_DATA, + tot_size); + async = (ErtsAsyncData *) ptr; + ptr += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncData)); -int exit_async() -{ - int i; + async->init.data.no_initialized = 0; + erts_mtx_init(&async->init.data.mtx, "async_init_mtx"); + erts_cnd_init(&async->init.data.cnd); + erts_atomic_init_nob(&async->init.data.id, 0); - /* terminate threads */ - for (i = 0; i < erts_async_max_threads; i++) { - ErlAsync* a = (ErlAsync*) erts_alloc(ERTS_ALC_T_ASYNC, - sizeof(ErlAsync)); - a->port = NIL; - async_add(a, &async_q[i]); - } + async->queue = (ErtsAlgndAsyncQ *) ptr; + ptr += sizeof(ErtsAlgndAsyncQ)*erts_async_max_threads; - for (i = 0; i < erts_async_max_threads; i++) { - erts_thr_join(async_q[i].thr, NULL); - erts_mtx_destroy(&async_q[i].mtx); - erts_cnd_destroy(&async_q[i].cv); - } -#ifndef ERTS_SMP - erts_mtx_destroy(&async_ready_mtx); +#if ERTS_USE_ASYNC_READY_Q + + qinit.live.queue = ERTS_THR_Q_LIVE_LONG; + qinit.live.objects = ERTS_THR_Q_LIVE_SHORT; + qinit.notify = erts_notify_check_async_ready_queue; + + async->ready_queue = (ErtsAlgndAsyncReadyQ *) ptr; + ptr += sizeof(ErtsAlgndAsyncReadyQ)*erts_no_schedulers; + + for (i = 1; i <= erts_no_schedulers; i++) { + ErtsAsyncReadyQ *arq = async_ready_q(i); +#if ERTS_USE_ASYNC_READY_ENQ_MTX + erts_mtx_init(&arq->x.data.enq_mtx, "async_enq_mtx"); #endif - if (async_q) - erts_free(ERTS_ALC_T_ASYNC_Q, (void *) async_q); - return 0; + erts_thr_q_finalize_dequeue_state_init(&arq->fin_deq); + qinit.arg = (void *) (SWord) i; + erts_thr_q_initialize(&arq->thr_q, &qinit); + } + +#endif + + /* Create async threads... */ + + thr_opts.detached = 0; + thr_opts.suggested_stack_size + = erts_async_thread_suggested_stack_size; + + for (i = 0; i < erts_async_max_threads; i++) { + ErtsAsyncQ *aq = async_q(i); + erts_thr_create(&aq->thr_id, async_main, (void*) aq, &thr_opts); + } + + /* Wait for async threads to initialize... */ + + erts_mtx_lock(&async->init.data.mtx); + while (async->init.data.no_initialized != erts_async_max_threads) + erts_cnd_wait(&async->init.data.cnd, &async->init.data.mtx); + erts_mtx_unlock(&async->init.data.mtx); + + erts_mtx_destroy(&async->init.data.mtx); + erts_cnd_destroy(&async->init.data.cnd); + + } } +#if ERTS_USE_ASYNC_READY_Q -static void async_add(ErlAsync* a, AsyncQueue* q) +void * +erts_get_async_ready_queue(Uint sched_id) +{ + return (void *) async ? async_ready_q(sched_id) : NULL; +} + +#endif + +static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q) { if (is_internal_port(a->port)) { - ERTS_LC_ASSERT(erts_drvportid2port(a->port)); +#if ERTS_USE_ASYNC_READY_Q + ErtsAsyncReadyQ *arq = async_ready_q(a->sched_id); + a->q.prep_enq = erts_thr_q_prepare_enqueue(&arq->thr_q); +#endif /* make sure the driver will stay around */ - driver_lock_driver(internal_port_index(a->port)); + if (a->hndl) + erts_ddll_reference_referenced_driver(a->hndl); } - erts_mtx_lock(&q->mtx); +#if ERTS_ASYNC_PRINT_JOB + erts_fprintf(stderr, "-> %ld\n", a->async_id); +#endif - if (q->len == 0) { - q->head = a; - q->tail = a; - q->len = 1; - erts_cnd_signal(&q->cv); - } - else { /* no need to signal (since the worker is working) */ - a->next = q->head; - q->head->prev = a; - q->head = a; - q->len++; - } - erts_mtx_unlock(&q->mtx); + erts_thr_q_enqueue(&q->thr_q, a); } -static ErlAsync* async_get(AsyncQueue* q) +static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q, + erts_tse_t *tse, + ErtsThrQPrepEnQ_t **prep_enq) { - ErlAsync* a; +#if ERTS_USE_ASYNC_READY_Q + int saved_fin_deq = 0; + ErtsThrQFinDeQ_t fin_deq; +#endif - erts_mtx_lock(&q->mtx); - while((a = q->tail) == NULL) { - erts_cnd_wait(&q->cv, &q->mtx); - } + while (1) { + ErtsAsync *a = (ErtsAsync *) erts_thr_q_dequeue(q); + if (a) { + +#if ERTS_USE_ASYNC_READY_Q + *prep_enq = a->q.prep_enq; + erts_thr_q_get_finalize_dequeue_data(q, &a->q.fin_deq); + if (saved_fin_deq) + erts_thr_q_append_finalize_dequeue_data(&a->q.fin_deq, &fin_deq); +#endif + + return a; + } + + if (ERTS_THR_Q_DIRTY != erts_thr_q_clean(q)) { + ErtsThrQFinDeQ_t tmp_fin_deq; + + erts_tse_reset(tse); + +#if ERTS_USE_ASYNC_READY_Q + chk_fin_deq: + if (erts_thr_q_get_finalize_dequeue_data(q, &tmp_fin_deq)) { + if (!saved_fin_deq) { + erts_thr_q_finalize_dequeue_state_init(&fin_deq); + saved_fin_deq = 1; + } + erts_thr_q_append_finalize_dequeue_data(&fin_deq, + &tmp_fin_deq); + } +#endif + + switch (erts_thr_q_inspect(q, 1)) { + case ERTS_THR_Q_DIRTY: + break; #ifdef ERTS_SMP - ASSERT(a && q->tail == a); + case ERTS_THR_Q_NEED_THR_PRGR: { + ErtsThrPrgrVal prgr = erts_thr_q_need_thr_progress(q); + erts_thr_progress_wakeup(NULL, prgr); + /* + * We do no dequeue finalizing in hope that a new async + * job will arrive before we are woken due to thread + * progress... + */ + erts_tse_wait(tse); + break; + } #endif - if (q->head == q->tail) { - q->head = q->tail = NULL; - q->len = 0; - } - else { - q->tail->prev->next = NULL; - q->tail = q->tail->prev; - q->len--; + case ERTS_THR_Q_CLEAN: + +#if ERTS_USE_ASYNC_READY_Q + if (saved_fin_deq) { + if (erts_thr_q_finalize_dequeue(&fin_deq)) + goto chk_fin_deq; + else + saved_fin_deq = 0; + } +#endif + + erts_tse_wait(tse); + break; + + default: + ASSERT(0); + break; + } + + } } - erts_mtx_unlock(&q->mtx); - return a; } - -static int async_del(long id) +static ERTS_INLINE void call_async_ready(ErtsAsync *a) { - int i; - /* scan all queue for an entry with async_id == 'id' */ - - for (i = 0; i < erts_async_max_threads; i++) { - ErlAsync* a; - erts_mtx_lock(&async_q[i].mtx); - - a = async_q[i].head; - while(a != NULL) { - if (a->async_id == id) { - if (a->prev != NULL) - a->prev->next = a->next; - else - async_q[i].head = a->next; - if (a->next != NULL) - a->next->prev = a->prev; - else - async_q[i].tail = a->prev; - async_q[i].len--; - erts_mtx_unlock(&async_q[i].mtx); - if (a->async_free != NULL) - a->async_free(a->async_data); - async_detach(a->hndl); - erts_free(ERTS_ALC_T_ASYNC, a); - return 1; - } - a = a->next; + Port *p = erts_id2port_sflgs(a->port, + NULL, + 0, + ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); + if (!p) { + if (a->async_free) + a->async_free(a->async_data); + } + else { + if (async_ready(p, a->async_data)) { + if (a->async_free) + a->async_free(a->async_data); } - erts_mtx_unlock(&async_q[i].mtx); + erts_port_release(p); } - return 0; + if (a->hndl) + erts_ddll_dereference_driver(a->hndl); } -static void* async_main(void* arg) +static ERTS_INLINE void async_reply(ErtsAsync *a, ErtsThrQPrepEnQ_t *prep_enq) { - AsyncQueue* q = (AsyncQueue*) arg; +#if ERTS_USE_ASYNC_READY_Q + ErtsAsyncReadyQ *arq; -#ifdef ERTS_ENABLE_LOCK_CHECK - { - char buf[27]; - erts_snprintf(&buf[0], 27, "async %d", q->no); - erts_lc_set_thread_name(&buf[0]); - } + if (a->pdl) + driver_pdl_dec_refc(a->pdl); + +#if ERTS_ASYNC_PRINT_JOB + erts_fprintf(stderr, "=>> %ld\n", a->async_id); #endif - while(1) { - ErlAsync* a = async_get(q); + arq = async_ready_q(a->sched_id); - if (a->port == NIL) { /* TIME TO DIE SIGNAL */ - erts_free(ERTS_ALC_T_ASYNC, (void *) a); - break; - } - else { - (*a->async_invoke)(a->async_data); - /* Major problem if the code for async_invoke - or async_free is removed during a blocking operation */ +#if ERTS_USE_ASYNC_READY_ENQ_MTX + erts_mtx_lock(&arq->x.data.enq_mtx); +#endif + + erts_thr_q_enqueue_prepared(&arq->thr_q, (void *) a, prep_enq); + +#if ERTS_USE_ASYNC_READY_ENQ_MTX + erts_mtx_unlock(&arq->x.data.enq_mtx); +#endif + +#else /* ERTS_USE_ASYNC_READY_Q */ + + call_async_ready(a); + if (a->pdl) + driver_pdl_dec_refc(a->pdl); + erts_free(ERTS_ALC_T_ASYNC, (void *) a); + +#endif /* ERTS_USE_ASYNC_READY_Q */ +} + + +static void +async_wakeup(void *vtse) +{ + erts_tse_set((erts_tse_t *) vtse); +} + +static erts_tse_t *async_thread_init(ErtsAsyncQ *aq) +{ + ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT; + erts_tse_t *tse = erts_tse_fetch(); #ifdef ERTS_SMP - { - Port *p; - p = erts_id2port_sflgs(a->port, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); - if (!p) { - if (a->async_free) - (*a->async_free)(a->async_data); - } - else { - if (async_ready(p, a->async_data)) { - if (a->async_free) - (*a->async_free)(a->async_data); - } - async_detach(a->hndl); - erts_port_release(p); - } - if (a->pdl) { - driver_pdl_dec_refc(a->pdl); - } - erts_free(ERTS_ALC_T_ASYNC, (void *) a); - } -#else - if (a->pdl) { - driver_pdl_dec_refc(a->pdl); - } - erts_mtx_lock(&async_ready_mtx); - a->next = async_ready_list; - async_ready_list = a; - erts_mtx_unlock(&async_ready_mtx); - sys_async_ready(q->hndl); + ErtsThrPrgrCallbacks callbacks; + + callbacks.arg = (void *) tse; + callbacks.wakeup = async_wakeup; + callbacks.prepare_wait = NULL; + callbacks.wait = NULL; + + erts_thr_progress_register_unmanaged_thread(&callbacks); #endif - } - } - return NULL; + qinit.live.queue = ERTS_THR_Q_LIVE_LONG; + qinit.live.objects = ERTS_THR_Q_LIVE_SHORT; + qinit.arg = (void *) tse; + qinit.notify = async_wakeup; +#if ERTS_USE_ASYNC_READY_Q + qinit.auto_finalize_dequeue = 0; +#endif + + erts_thr_q_initialize(&aq->thr_q, &qinit); + + /* Inform main thread that we are done initializing... */ + erts_mtx_lock(&async->init.data.mtx); + async->init.data.no_initialized++; + erts_cnd_signal(&async->init.data.cnd); + erts_mtx_unlock(&async->init.data.mtx); + + return tse; } +static void *async_main(void* arg) +{ + ErtsAsyncQ *aq = (ErtsAsyncQ *) arg; + erts_tse_t *tse = async_thread_init(aq); + + while (1) { + ErtsThrQPrepEnQ_t *prep_enq; + ErtsAsync *a = async_get(&aq->thr_q, tse, &prep_enq); + if (is_nil(a->port)) + break; /* Time to die */ +#if ERTS_ASYNC_PRINT_JOB + erts_fprintf(stderr, "<- %ld\n", a->async_id); #endif -#ifndef ERTS_SMP + a->async_invoke(a->async_data); + + async_reply(a, prep_enq); + } + + return NULL; +} + +#endif /* USE_THREADS */ -int check_async_ready(void) +void +erts_exit_flush_async(void) { #ifdef USE_THREADS - ErtsAsyncReadyCallback *cbs; + int i; + ErtsAsync a; + a.port = NIL; + /* + * Terminate threads in order to flush queues. We do not + * bother to clean everything up since we are about to + * terminate the runtime system and a cleanup would only + * delay the termination. + */ + for (i = 0; i < erts_async_max_threads; i++) + async_add(&a, async_q(i)); + for (i = 0; i < erts_async_max_threads; i++) + erts_thr_join(async->queue[i].aq.thr_id, NULL); #endif - ErlAsync* a; - int count = 0; +} - erts_mtx_lock(&async_ready_mtx); - a = async_ready_list; - async_ready_list = NULL; -#ifdef USE_THREADS - cbs = callbacks; -#endif - erts_mtx_unlock(&async_ready_mtx); - - while(a != NULL) { - ErlAsync* a_next = a->next; - /* Every port not dead */ - Port *p = erts_id2port_sflgs(a->port, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); - if (!p) { - if (a->async_free) - (*a->async_free)(a->async_data); - } - else { - count++; - if (async_ready(p, a->async_data)) { - if (a->async_free != NULL) - (*a->async_free)(a->async_data); - } - async_detach(a->hndl); - erts_port_release(p); +#if defined(USE_THREADS) && ERTS_USE_ASYNC_READY_Q + +int erts_check_async_ready(void *varq) +{ + ErtsAsyncReadyQ *arq = (ErtsAsyncReadyQ *) varq; + int res = 1; + int i; + + for (i = 0; i < ERTS_MAX_ASYNC_READY_CALLS_IN_SEQ; i++) { + ErtsAsync *a = (ErtsAsync *) erts_thr_q_dequeue(&arq->thr_q); + if (!a) { + res = 0; + break; } + +#if ERTS_ASYNC_PRINT_JOB + erts_fprintf(stderr, "<<= %ld\n", a->async_id); +#endif + erts_thr_q_append_finalize_dequeue_data(&arq->fin_deq, &a->q.fin_deq); + call_async_ready(a); erts_free(ERTS_ALC_T_ASYNC, (void *) a); - a = a_next; } -#ifdef USE_THREADS - for (; cbs; cbs = cbs->next) - (*cbs->callback)(); -#endif - return count; + + erts_thr_q_finalize_dequeue(&arq->fin_deq); + + return res; } +int erts_async_ready_clean(void *varq, void *val) +{ + ErtsAsyncReadyQ *arq = (ErtsAsyncReadyQ *) varq; + ErtsThrQCleanState_t cstate; + + cstate = erts_thr_q_clean(&arq->thr_q); + + if (erts_thr_q_finalize_dequeue(&arq->fin_deq)) + return ERTS_ASYNC_READY_DIRTY; + + switch (cstate) { + case ERTS_THR_Q_DIRTY: + return ERTS_ASYNC_READY_DIRTY; +#ifdef ERTS_SMP + case ERTS_THR_Q_NEED_THR_PRGR: + *((ErtsThrPrgrVal *) val) + = erts_thr_q_need_thr_progress(&arq->thr_q); + return ERTS_ASYNC_READY_NEED_THR_PRGR; #endif + case ERTS_THR_Q_CLEAN: + break; + } + return ERTS_ASYNC_READY_CLEAN; +} +#endif /* ** Schedule async_invoke on a worker thread @@ -393,19 +554,29 @@ long driver_async(ErlDrvPort ix, unsigned int* key, void (*async_invoke)(void*), void* async_data, void (*async_free)(void*)) { - ErlAsync* a = (ErlAsync*) erts_alloc(ERTS_ALC_T_ASYNC, sizeof(ErlAsync)); - Port* prt = erts_drvport2port(ix); + ErtsAsync* a; + Port* prt; long id; unsigned int qix; +#if ERTS_USE_ASYNC_READY_Q + Uint sched_id; + sched_id = erts_get_scheduler_id(); + if (!sched_id) + sched_id = 1; +#endif + prt = erts_drvport2port(ix); if (!prt) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - a->next = NULL; - a->prev = NULL; + a = (ErtsAsync*) erts_alloc(ERTS_ALC_T_ASYNC, sizeof(ErtsAsync)); + +#if ERTS_USE_ASYNC_READY_Q + a->sched_id = sched_id; +#endif a->hndl = (DE_Handle*)prt->drv_ptr->handle; a->port = prt->id; a->pdl = NULL; @@ -413,12 +584,16 @@ long driver_async(ErlDrvPort ix, unsigned int* key, a->async_invoke = async_invoke; a->async_free = async_free; - erts_smp_spin_lock(&async_id_lock); - async_id = (async_id + 1) & 0x7fffffff; - if (async_id == 0) - async_id++; - id = async_id; - erts_smp_spin_unlock(&async_id_lock); + if (!async) + id = 0; + else { + do { + id = erts_atomic_inc_read_nob(&async->init.data.id); + } while (id == 0); + if (id < 0) + id *= -1; + ASSERT(id > 0); + } a->async_id = id; @@ -437,7 +612,7 @@ long driver_async(ErlDrvPort ix, unsigned int* key, driver_pdl_inc_refc(prt->port_data_lock); a->pdl = prt->port_data_lock; } - async_add(a, &async_q[qix]); + async_add(a, async_q(qix)); return id; } #endif @@ -455,10 +630,16 @@ long driver_async(ErlDrvPort ix, unsigned int* key, int driver_async_cancel(unsigned int id) { -#ifdef USE_THREADS - if (erts_async_max_threads > 0) - return async_del(id); -#endif + /* + * Not supported anymore. Always fail (which is backward + * compatible). + * + * This functionality could be implemented again. However, + * it is (and always has been) completely useless since + * it doesn't give you any guarantees whatsoever. The user + * needs to (and always have had to) synchronize in his/her + * own code in order to get any guarantees. + */ return 0; } diff --git a/erts/emulator/beam/erl_async.h b/erts/emulator/beam/erl_async.h new file mode 100644 index 0000000000..95374a8fc9 --- /dev/null +++ b/erts/emulator/beam/erl_async.h @@ -0,0 +1,66 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ + +#ifndef ERL_ASYNC_H__ +#define ERL_ASYNC_H__ + +#define ERTS_MAX_NO_OF_ASYNC_THREADS 1024 +extern int erts_async_max_threads; +#define ERTS_ASYNC_THREAD_MIN_STACK_SIZE 16 /* Kilo words */ +#define ERTS_ASYNC_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */ +extern int erts_async_thread_suggested_stack_size; + +#ifdef USE_THREADS + +#ifdef ERTS_SMP +/* + * With smp support we can choose to have, or not to + * have an async ready queue. + */ +#define ERTS_USE_ASYNC_READY_Q 1 +#endif + +#ifndef ERTS_SMP +/* In non-smp case we *need* the async ready queue */ +# undef ERTS_USE_ASYNC_READY_Q +# define ERTS_USE_ASYNC_READY_Q 1 +#endif + +#ifndef ERTS_USE_ASYNC_READY_Q +# define ERTS_USE_ASYNC_READY_Q 0 +#endif + +#if ERTS_USE_ASYNC_READY_Q +int erts_check_async_ready(void *); +int erts_async_ready_clean(void *, void *); +void *erts_get_async_ready_queue(Uint sched_id); +#define ERTS_ASYNC_READY_CLEAN 0 +#define ERTS_ASYNC_READY_DIRTY 1 +#ifdef ERTS_SMP +#define ERTS_ASYNC_READY_NEED_THR_PRGR 2 +#endif +#endif /* ERTS_USE_ASYNC_READY_Q */ + +#endif /* USE_THREADS */ + +void erts_init_async(void); +void erts_exit_flush_async(void); + + +#endif /* ERL_ASYNC_H__ */ diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c index f2199d41a1..c50fdeb4e8 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.c +++ b/erts/emulator/beam/erl_bestfit_alloc.c @@ -161,14 +161,18 @@ erts_bfalc_start(BFAllctr_t *bfallctr, BFAllctrInit_t *bfinit, AllctrInit_t *init) { - BFAllctr_t nulled_state = {{0}}; - /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc - warning. gcc warns if {0} is used as initializer of a struct when - the first member is a struct (not if, for example, the third member - is a struct). */ + struct { + int dummy; + BFAllctr_t allctr; + } zero = {0}; + /* The struct with a dummy element first is used in order to avoid (an + incorrect) gcc warning. gcc warns if {0} is used as initializer of + a struct when the first member is a struct (not if, for example, + the third member is a struct). */ + Allctr_t *allctr = (Allctr_t *) bfallctr; - sys_memcpy((void *) bfallctr, (void *) &nulled_state, sizeof(BFAllctr_t)); + sys_memcpy((void *) bfallctr, (void *) &zero.allctr, sizeof(BFAllctr_t)); bfallctr->address_order = bfinit->ao; diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 684fa5d12f..6d022e0d11 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -65,6 +65,10 @@ static Export binary_copy_trap_export; static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2); static Uint max_loop_limit; +static BIF_RETTYPE +binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); +static BIF_RETTYPE +binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); void erts_init_bif_binary(void) { @@ -1399,6 +1403,12 @@ static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3) BIF_RETTYPE binary_match_3(BIF_ALIST_3) { + return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static BIF_RETTYPE +binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) +{ Uint hsstart; Uint hsend; Eterm *tp; @@ -1408,17 +1418,17 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3) int runres; Eterm result; - if (is_not_binary(BIF_ARG_1)) { + if (is_not_binary(arg1)) { goto badarg; } - if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) { + if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) { goto badarg; } if (hsend == 0) { BIF_RET(am_nomatch); } - if (is_tuple(BIF_ARG_2)) { - tp = tuple_val(BIF_ARG_2); + if (is_tuple(arg2)) { + tp = tuple_val(arg2); if (arityval(*tp) != 2 || is_not_atom(tp[1])) { goto badarg; } @@ -1437,13 +1447,13 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3) goto badarg; } bin_term = tp[2]; - } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) { + } else if (do_binary_match_compile(arg2,&type,&bin)) { goto badarg; } - runres = do_binary_match(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin,NIL,&result); + runres = do_binary_match(p,arg1,hsstart,hsend,type,bin,NIL,&result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + Eterm *hp = HAlloc(p, PROC_BIN_SIZE); + bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } @@ -1451,17 +1461,23 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3) case DO_BIN_MATCH_OK: BIF_RET(result); case DO_BIN_MATCH_RESTART: - BUMP_ALL_REDS(BIF_P); - BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result, bin_term); + BUMP_ALL_REDS(p); + BIF_TRAP3(&binary_match_trap_export, p, arg1, result, bin_term); default: goto badarg; } badarg: - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } BIF_RETTYPE binary_matches_3(BIF_ALIST_3) { + return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static BIF_RETTYPE +binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) +{ Uint hsstart, hsend; Eterm *tp; Eterm type; @@ -1470,17 +1486,17 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3) int runres; Eterm result; - if (is_not_binary(BIF_ARG_1)) { + if (is_not_binary(arg1)) { goto badarg; } - if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) { + if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) { goto badarg; } if (hsend == 0) { BIF_RET(NIL); } - if (is_tuple(BIF_ARG_2)) { - tp = tuple_val(BIF_ARG_2); + if (is_tuple(arg2)) { + tp = tuple_val(arg2); if (arityval(*tp) != 2 || is_not_atom(tp[1])) { goto badarg; } @@ -1499,14 +1515,14 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3) goto badarg; } bin_term = tp[2]; - } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) { + } else if (do_binary_match_compile(arg2,&type,&bin)) { goto badarg; } - runres = do_binary_matches(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin, + runres = do_binary_matches(p,arg1,hsstart,hsend,type,bin, NIL,&result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { - Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE); - bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + Eterm *hp = HAlloc(p, PROC_BIN_SIZE); + bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } @@ -1514,26 +1530,26 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3) case DO_BIN_MATCH_OK: BIF_RET(result); case DO_BIN_MATCH_RESTART: - BUMP_ALL_REDS(BIF_P); - BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result, + BUMP_ALL_REDS(p); + BIF_TRAP3(&binary_matches_trap_export, p, arg1, result, bin_term); default: goto badarg; } badarg: - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } BIF_RETTYPE binary_match_2(BIF_ALIST_2) { - return binary_match_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); + return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); } BIF_RETTYPE binary_matches_2(BIF_ALIST_2) { - return binary_matches_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); + return binary_matches(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); } diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index d714eacd06..a9fd28c66b 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -142,9 +142,11 @@ static void ddll_no_more_references(void *vdh); * really load and add as LOADED {ok,loaded} {ok,pending_driver} * {error, permanent} {error,load_error()} */ -BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, - Eterm name_term, Eterm options) +BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3) { + Eterm path_term = BIF_ARG_1; + Eterm name_term = BIF_ARG_2; + Eterm options = BIF_ARG_3; char *path = NULL; Uint path_len; char *name = NULL; @@ -236,7 +238,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, sys_strcpy(path+path_len,name); #if DDLL_SMP - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); #endif if ((drv = lookup_driver(name)) != NULL) { @@ -247,7 +249,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, } else { dh = drv->handle; if (dh->status == ERL_DE_OK) { - int is_last = is_last_user(dh,p); + int is_last = is_last_user(dh, BIF_P); if (reload == 1 && !is_last) { /*Want reload if no other users, but there are others...*/ @@ -261,7 +263,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, soft_error_term = am_inconsistent; goto soft_error; } - if ((old = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) == + if ((old = find_proc_entry(dh, BIF_P, + ERL_DE_PROC_LOADED)) == NULL) { soft_error_term = am_not_loaded_by_this_process; goto soft_error; @@ -272,7 +275,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, } /* Reload requested and granted */ dereference_all_processes(dh); - set_driver_reloading(dh, p, path, name, flags); + set_driver_reloading(dh, BIF_P, path, name, flags); if (dh->flags & ERL_DE_FL_KILL_PORTS) { kill_ports = 1; } @@ -286,7 +289,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, soft_error_term = am_inconsistent; goto soft_error; } - add_proc_loaded(dh,p); + add_proc_loaded(dh, BIF_P); erts_ddll_reference_driver(dh); monitor = 0; ok_term = mkatom("already_loaded"); @@ -308,7 +311,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, notify_all(dh, drv->name, ERL_DE_PROC_AWAIT_UNLOAD, am_UP, am_unload_cancelled); - add_proc_loaded(dh,p); + add_proc_loaded(dh, BIF_P); erts_ddll_reference_driver(dh); monitor = 0; ok_term = mkatom("already_loaded"); @@ -325,7 +328,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, goto soft_error; } /* Load of granted unload... */ - add_proc_loaded_deref(dh,p); /* Dont reference, will happen after reload */ + /* Don't reference, will happen after reload */ + add_proc_loaded_deref(dh, BIF_P); ++monitor; ok_term = am_pending_driver; } else { /* ERL_DE_PERMANENT */ @@ -345,7 +349,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, goto soft_error; } else { dh->flags = flags; - add_proc_loaded(dh,p); + add_proc_loaded(dh, BIF_P); first_ddll_reference(dh); monitor = 0; ok_term = mkatom("loaded"); @@ -397,18 +401,18 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, #if DDLL_SMP erts_ddll_reference_driver(dh); unlock_drv_list(); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); erts_ddll_dereference_driver(dh); #endif - p->flags |= F_USING_DDLL; + BIF_P->flags |= F_USING_DDLL; if (monitor) { - Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_LOAD); - hp = HAlloc(p,4); + Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_LOAD); + hp = HAlloc(BIF_P, 4); t = TUPLE3(hp, am_ok, ok_term, mref); } else { - hp = HAlloc(p,3); + hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_ok, ok_term); } #if DDLL_SMP @@ -416,33 +420,33 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, #endif erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); BIF_RET(t); soft_error: #if DDLL_SMP unlock_drv_list(); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); #endif if (do_build_load_error) { - soft_error_term = build_load_error(p, build_this_load_error); + soft_error_term = build_load_error(BIF_P, build_this_load_error); } - hp = HAlloc(p,3); + hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_error, soft_error_term); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); BIF_RET(t); error: assert_drv_list_not_locked(); - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P)); if (path != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); } if (name != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); } - BIF_ERROR(p,BADARG); + BIF_ERROR(BIF_P, BADARG); } /* @@ -481,8 +485,10 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, any AWAIT_LOAD-waiters with {'DOWN', ref(), driver, name(), load_cancelled} If the driver made itself permanent, {'UP', ref(), driver, name(), permanent} */ -Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options) +Eterm erl_ddll_try_unload_2(BIF_ALIST_2) { + Eterm name_term = BIF_ARG_1; + Eterm options = BIF_ARG_2; char *name = NULL; Eterm ok_term = NIL; Eterm soft_error_term = NIL; @@ -495,7 +501,7 @@ Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options) Eterm l; int kill_ports = 0; - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); for(l = options; is_list(l); l = CDR(list_val(l))) { Eterm opt = CAR(list_val(l)); @@ -548,7 +554,7 @@ Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options) if (dh->flags & ERL_DE_FL_KILL_PORTS) { kill_ports = 1; } - if ((pe = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) == NULL) { + if ((pe = find_proc_entry(dh, BIF_P, ERL_DE_PROC_LOADED)) == NULL) { if (num_procs(dh, ERL_DE_PROC_LOADED) > 0) { soft_error_term = am_not_loaded_by_this_process; goto soft_error; @@ -624,22 +630,22 @@ done: #if DDLL_SMP erts_ddll_reference_driver(dh); unlock_drv_list(); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); lock_drv_list(); erts_ddll_dereference_driver(dh); #endif erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); - p->flags |= F_USING_DDLL; + BIF_P->flags |= F_USING_DDLL; if (monitor > 0) { - Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_UNLOAD); - hp = HAlloc(p,4); + Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_UNLOAD); + hp = HAlloc(BIF_P, 4); t = TUPLE3(hp, am_ok, ok_term, mref); } else { - hp = HAlloc(p,3); + hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_ok, ok_term); } if (kill_ports > 1) { - ERTS_BIF_CHK_EXITED(p); /* May be exited by port killing */ + ERTS_BIF_CHK_EXITED(BIF_P); /* May be exited by port killing */ } #if DDLL_SMP unlock_drv_list(); @@ -651,8 +657,8 @@ soft_error: unlock_drv_list(); #endif erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); - hp = HAlloc(p,3); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + hp = HAlloc(BIF_P, 3); t = TUPLE2(hp, am_error, soft_error_term); BIF_RET(t); @@ -661,21 +667,21 @@ soft_error: if (name != NULL) { erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); } - erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); - BIF_ERROR(p,BADARG); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_ERROR(BIF_P, BADARG); } /* * A shadow of the "real" demonitor BIF */ -BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref) +BIF_RETTYPE erl_ddll_demonitor_1(BIF_ALIST_1) { - if (is_not_internal_ref(ref)) { - BIF_ERROR(p, BADARG); + if (is_not_internal_ref(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); } - if (p->flags & F_USING_DDLL) { - erts_ddll_remove_monitor(p, ref, ERTS_PROC_LOCK_MAIN); + if (BIF_P->flags & F_USING_DDLL) { + erts_ddll_remove_monitor(BIF_P, BIF_ARG_1, ERTS_PROC_LOCK_MAIN); } BIF_RET(am_true); } @@ -683,18 +689,18 @@ BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref) /* * A shadow of the "real" monitor BIF */ -BIF_RETTYPE erl_ddll_monitor_2(Process *p, Eterm dr, Eterm what) +BIF_RETTYPE erl_ddll_monitor_2(BIF_ALIST_2) { - if (dr != am_driver) { - BIF_ERROR(p,BADARG); + if (BIF_ARG_1 != am_driver) { + BIF_ERROR(BIF_P, BADARG); } - return erts_ddll_monitor_driver(p, what, ERTS_PROC_LOCK_MAIN); + return erts_ddll_monitor_driver(BIF_P, BIF_ARG_2, ERTS_PROC_LOCK_MAIN); } /* * Return list of loaded drivers {ok,[string()]} */ -Eterm erl_ddll_loaded_drivers_0(Process *p) +BIF_RETTYPE erl_ddll_loaded_drivers_0(BIF_ALIST_0) { Eterm *hp; int need = 3; @@ -706,7 +712,7 @@ Eterm erl_ddll_loaded_drivers_0(Process *p) for (drv = driver_list; drv; drv = drv->next) { need += sys_strlen(drv->name)*2+2; } - hp = HAlloc(p,need); + hp = HAlloc(BIF_P, need); for (drv = driver_list; drv; drv = drv->next) { Eterm l; l = buf_to_intlist(&hp, drv->name, sys_strlen(drv->name), NIL); @@ -726,8 +732,11 @@ Eterm erl_ddll_loaded_drivers_0(Process *p) * item is processes, driver_options, port_count, linked_in_driver, * permanent, awaiting_load, awaiting_unload */ -Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item) +BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2) { + Process *p = BIF_P; + Eterm name_term = BIF_ARG_1; + Eterm item = BIF_ARG_2; char *name = NULL; Eterm res = NIL; erts_driver_t *drv; @@ -850,8 +859,10 @@ Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item) * Backend for erl_ddll:format_error, handles all "soft" errors returned by builtins, * possibly by calling the system specific error handler */ -Eterm erl_ddll_format_error_int_1(Process *p, Eterm code_term) +BIF_RETTYPE erl_ddll_format_error_int_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm code_term = BIF_ARG_1; char *errstring = NULL; int errint; int len; diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index e17325b64f..a79feaebdb 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -39,6 +39,8 @@ #include "dist.h" #include "erl_gc.h" #include "erl_cpu_topology.h" +#include "erl_async.h" +#include "erl_thr_progress.h" #ifdef HIPE #include "hipe_arch.h" #endif @@ -52,6 +54,9 @@ #include <valgrind/memcheck.h> #endif +static Export* alloc_info_trap = NULL; +static Export* alloc_sizes_trap = NULL; + #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) /* Keep erts_system_version as a global variable for easy access from a core */ @@ -119,6 +124,12 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE # define PERFMON_GETPCR _IOR('P', 2, unsigned long long) #endif +/* Cached, pre-built {OsType,OsFlavor} and {Major,Minor,Build} tuples */ +static Eterm os_type_tuple; +static Eterm os_version_tuple; + +static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item); + static Eterm current_function(Process* p, Process* rp, Eterm** hpp, int full_info); static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp); @@ -1728,9 +1739,19 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ sel = *tp++; - if (sel == am_allocator_sizes && arity == 2) { - return erts_allocator_info_term(BIF_P, *tp, 1); - } else if (sel == am_wordsize && arity == 2) { + if (sel == am_allocator_sizes) { + switch (arity) { + case 2: + ERTS_BIF_PREP_TRAP1(ret, alloc_sizes_trap, BIF_P, *tp); + return ret; + case 3: + if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1)) + return am_true; + default: + goto badarg; + } + } + else if (sel == am_wordsize && arity == 2) { if (tp[0] == am_internal) { return make_small(sizeof(Eterm)); } @@ -1777,8 +1798,17 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ } else goto badarg; - } else if (sel == am_allocator && arity == 2) { - return erts_allocator_info_term(BIF_P, *tp, 0); + } else if (sel == am_allocator) { + switch (arity) { + case 2: + ERTS_BIF_PREP_TRAP1(ret, alloc_info_trap, BIF_P, *tp); + return ret; + case 3: + if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 0)) + return am_true; + default: + goto badarg; + } } else if (ERTS_IS_ATOM_STR("internal_cpu_topology", sel) && arity == 2) { return erts_get_cpu_topology_term(BIF_P, *tp); } else if (ERTS_IS_ATOM_STR("cpu_topology", sel) && arity == 2) { @@ -2100,7 +2130,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_undefined); #endif } else if (BIF_ARG_1 == am_trace_control_word) { - BIF_RET(db_get_trace_control_word_0(BIF_P)); + BIF_RET(db_get_trace_control_word(BIF_P)); } else if (ERTS_IS_ATOM_STR("ets_realloc_moves", BIF_ARG_1)) { BIF_RET((erts_ets_realloc_always_moves) ? am_true : am_false); } else if (ERTS_IS_ATOM_STR("ets_always_compress", BIF_ARG_1)) { @@ -2160,7 +2190,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) /* Need to be the only thread running... */ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); if (BIF_ARG_1 == am_info) info(ERTS_PRINT_DSBUF, (void *) dsbufp); @@ -2171,7 +2201,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) else distribution_info(ERTS_PRINT_DSBUF, (void *) dsbufp); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); ASSERT(dsbufp && dsbufp->str); @@ -2183,7 +2213,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) i = 0; /* Need to be the only thread running... */ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); for (dep = erts_visible_dist_entries; dep; dep = dep->next) ++i; for (dep = erts_hidden_dist_entries; dep; dep = dep->next) @@ -2206,7 +2236,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) res = CONS(hp, tpl, res); hp += 2; } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(res); } else if (BIF_ARG_1 == am_system_version) { @@ -2227,16 +2257,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) return erts_instr_get_type_info(BIF_P); } else if (BIF_ARG_1 == am_os_type) { - Eterm type = am_atom_put(os_type, strlen(os_type)); - Eterm flav, tup; - char *buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ - - os_flavor(buf, 1024); - flav = am_atom_put(buf, strlen(buf)); - hp = HAlloc(BIF_P, 3); - tup = TUPLE2(hp, type, flav); - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_RET(tup); + BIF_RET(os_type_tuple); } else if (BIF_ARG_1 == am_allocator) { BIF_RET(erts_allocator_options((void *) BIF_P)); @@ -2262,16 +2283,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_false); } else if (BIF_ARG_1 == am_os_version) { - int major, minor, build; - Eterm tup; - - os_version(&major, &minor, &build); - hp = HAlloc(BIF_P, 4); - tup = TUPLE3(hp, - make_small(major), - make_small(minor), - make_small(build)); - BIF_RET(tup); + BIF_RET(os_version_tuple); } else if (BIF_ARG_1 == am_version) { int n = strlen(ERLANG_VERSION); @@ -2641,8 +2653,12 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) res = erts_bld_uint(&hp, NULL, erts_dist_buf_busy_limit); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("print_ethread_info", BIF_ARG_1)) { +#if defined(ETHR_NATIVE_ATOMIC32_IMPL) \ + || defined(ETHR_NATIVE_ATOMIC64_IMPL) \ + || defined(ETHR_NATIVE_DW_ATOMIC_IMPL) int i; char **str; +#endif #ifdef ETHR_NATIVE_ATOMIC32_IMPL erts_printf("32-bit native atomics: %s\n", ETHR_NATIVE_ATOMIC32_IMPL); @@ -2705,13 +2721,21 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) #endif BIF_RET(am_true); } +#ifdef ERTS_SMP + else if (ERTS_IS_ATOM_STR("thread_progress", BIF_ARG_1)) { + erts_thr_progress_dbg_print_state(); + BIF_RET(am_true); + } +#endif BIF_ERROR(BIF_P, BADARG); } -Eterm -port_info_1(Process* p, Eterm pid) +BIF_RETTYPE +port_info_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm pid = BIF_ARG_1; static Eterm keys[] = { am_name, am_links, @@ -2734,7 +2758,7 @@ port_info_1(Process* p, Eterm pid) for (i = 0; i < ASIZE(keys); i++) { Eterm item; - item = port_info_2(p, pid, keys[i]); + item = port_info(p, pid, keys[i]); if (is_non_value(item)) { return THE_NON_VALUE; } @@ -2743,7 +2767,7 @@ port_info_1(Process* p, Eterm pid) } items[i] = item; } - reg_name = port_info_2(p, pid, am_registered_name); + reg_name = port_info(p, pid, am_registered_name); /* * Build the resulting list. @@ -2779,24 +2803,27 @@ port_info_1(Process* p, Eterm pid) BIF_RETTYPE port_info_2(BIF_ALIST_2) { + return port_info(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item) +{ BIF_RETTYPE ret; - Eterm portid = BIF_ARG_1; Port *prt; - Eterm item = BIF_ARG_2; Eterm res; Eterm* hp; int count; if (is_internal_port(portid)) - prt = erts_id2port(portid, BIF_P, ERTS_PROC_LOCK_MAIN); + prt = erts_id2port(portid, p, ERTS_PROC_LOCK_MAIN); else if (is_atom(portid)) - erts_whereis_name(BIF_P, ERTS_PROC_LOCK_MAIN, + erts_whereis_name(p, ERTS_PROC_LOCK_MAIN, portid, NULL, 0, 0, &prt); else if (is_external_port(portid) && external_port_dist_entry(portid) == erts_this_dist_entry) BIF_RET(am_undefined); else { - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } if (!prt) { @@ -2804,7 +2831,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) } if (item == am_id) { - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); res = make_small(internal_port_number(portid)); } else if (item == am_links) { @@ -2816,10 +2843,10 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) erts_doforall_links(prt->nlinks, &collect_one_link, &mic); - hp = HAlloc(BIF_P, 3 + mic.sz); + hp = HAlloc(p, 3 + mic.sz); res = NIL; for (i = 0; i < mic.mi_i; i++) { - item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity); + item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity); res = CONS(hp, item, res); hp += 2; } @@ -2835,11 +2862,11 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) erts_doforall_monitors(prt->monitors, &collect_one_origin_monitor, &mic); - hp = HAlloc(BIF_P, 3 + mic.sz); + hp = HAlloc(p, 3 + mic.sz); res = NIL; for (i = 0; i < mic.mi_i; i++) { Eterm t; - item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity); + item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity); t = TUPLE2(hp, am_process, item); hp += 3; res = CONS(hp, t, res); @@ -2851,25 +2878,25 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) else if (item == am_name) { count = sys_strlen(prt->name); - hp = HAlloc(BIF_P, 3 + 2*count); + hp = HAlloc(p, 3 + 2*count); res = buf_to_intlist(&hp, prt->name, count, NIL); } else if (item == am_connected) { - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); res = prt->connected; /* internal pid */ } else if (item == am_input) { Uint hsz = 3; Uint n = prt->bytes_in; (void) erts_bld_uint(NULL, &hsz, n); - hp = HAlloc(BIF_P, hsz); + hp = HAlloc(p, hsz); res = erts_bld_uint(&hp, NULL, n); } else if (item == am_output) { Uint hsz = 3; Uint n = prt->bytes_out; (void) erts_bld_uint(NULL, &hsz, n); - hp = HAlloc(BIF_P, hsz); + hp = HAlloc(p, hsz); res = erts_bld_uint(&hp, NULL, n); } else if (item == am_registered_name) { @@ -2879,7 +2906,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) ERTS_BIF_PREP_RET(ret, NIL); goto done; } else { - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); res = reg->name; } } @@ -2891,7 +2918,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) Uint size = 0; ErlHeapFragment* bp; - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); erts_doforall_links(prt->nlinks, &one_link_size, &size); @@ -2908,18 +2935,18 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) hard to retrieve... */ (void) erts_bld_uint(NULL, &hsz, size); - hp = HAlloc(BIF_P, hsz); + hp = HAlloc(p, hsz); res = erts_bld_uint(&hp, NULL, size); } else if (item == am_queue_size) { Uint ioq_size = erts_port_ioq_size(prt); Uint hsz = 3; (void) erts_bld_uint(NULL, &hsz, ioq_size); - hp = HAlloc(BIF_P, hsz); + hp = HAlloc(p, hsz); res = erts_bld_uint(&hp, NULL, ioq_size); } else if (ERTS_IS_ATOM_STR("locking", item)) { - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); #ifndef ERTS_SMP res = am_false; #else @@ -2938,7 +2965,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) #endif } else { - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + ERTS_BIF_PREP_ERROR(ret, p, BADARG); goto done; } @@ -2952,9 +2979,12 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2) } -Eterm -fun_info_2(Process* p, Eterm fun, Eterm what) +BIF_RETTYPE +fun_info_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm fun = BIF_ARG_1; + Eterm what = BIF_ARG_2; Eterm* hp; Eterm val; @@ -3265,26 +3295,6 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } -BIF_RETTYPE memory_0(BIF_ALIST_0) -{ - BIF_RETTYPE res = erts_memory(NULL, NULL, BIF_P, THE_NON_VALUE); - switch (res) { - case am_badarg: BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); /* never... */ - case am_notsup: BIF_ERROR(BIF_P, EXC_NOTSUP); - default: BIF_RET(res); - } -} - -BIF_RETTYPE memory_1(BIF_ALIST_1) -{ - BIF_RETTYPE res = erts_memory(NULL, NULL, BIF_P, BIF_ARG_1); - switch (res) { - case am_badarg: BIF_ERROR(BIF_P, BADARG); - case am_notsup: BIF_ERROR(BIF_P, EXC_NOTSUP); - default: BIF_RET(res); - } -} - BIF_RETTYPE error_logger_warning_map_0(BIF_ALIST_0) { BIF_RET(erts_error_logger_warnings); @@ -3386,6 +3396,15 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) BIF_RET(am_false); #endif } + else if (ERTS_IS_ATOM_STR("memory", BIF_ARG_1)) { + Eterm res; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_thr_progress_block(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + res = erts_memory(NULL, NULL, BIF_P, THE_NON_VALUE); + erts_smp_thr_progress_unblock(); + BIF_RET(res); + } } else if (is_tuple(BIF_ARG_1)) { Eterm* tp = tuple_val(BIF_ARG_1); @@ -3588,6 +3607,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) static erts_smp_atomic_t hipe_test_reschedule_flag; + BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) { /* @@ -3638,10 +3658,10 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) if (ms > 0) { erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); if (block) - erts_smp_block_system(0); + erts_smp_thr_progress_block(); while (erts_milli_sleep((long) ms) != 0); if (block) - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); } BIF_RET(am_true); @@ -3851,16 +3871,23 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); old_use_opt = !erts_disable_proc_not_running_opt; erts_disable_proc_not_running_opt = !use_opt; - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(old_use_opt ? am_true : am_false); #else BIF_ERROR(BIF_P, EXC_NOTSUP); #endif } + else if (ERTS_IS_ATOM_STR("wait", BIF_ARG_1)) { + if (ERTS_IS_ATOM_STR("deallocations", BIF_ARG_2)) { + if (erts_debug_wait_deallocations(BIF_P)) { + ERTS_BIF_YIELD_RETURN(BIF_P, am_ok); + } + } + } } BIF_ERROR(BIF_P, BADARG); @@ -4019,7 +4046,7 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) Eterm* hp; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_SUSPEND); data = erts_lcnt_get_data(); @@ -4037,17 +4064,17 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) erts_lcnt_clear_rt_opt(ERTS_LCNT_OPT_SUSPEND); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(res); } else if (BIF_ARG_1 == am_clear) { erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); erts_lcnt_clear_counters(); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(am_ok); @@ -4058,7 +4085,7 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) case 2: if (ERTS_IS_ATOM_STR("copy_save", tp[1])) { erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); if (tp[2] == am_true) { res = erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_COPYSAVE) ? am_true : am_false; @@ -4068,17 +4095,17 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) res = erts_lcnt_clear_rt_opt(ERTS_LCNT_OPT_COPYSAVE) ? am_true : am_false; } else { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_ERROR(BIF_P, BADARG); } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("process_locks", tp[1])) { erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); if (tp[2] == am_true) { res = erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_PROCLOCK) ? am_true : am_false; @@ -4088,11 +4115,11 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) res = erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_PROCLOCK) ? am_true : am_false; } else { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_ERROR(BIF_P, BADARG); } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(res); } @@ -4107,11 +4134,35 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } +static void os_info_init(void) +{ + Eterm type = am_atom_put(os_type, strlen(os_type)); + Eterm flav; + int major, minor, build; + char* buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ + Eterm* hp; + + os_flavor(buf, 1024); + flav = am_atom_put(buf, strlen(buf)); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm)); + os_type_tuple = TUPLE2(hp, type, flav); + hp += 3; + os_version(&major, &minor, &build); + os_version_tuple = TUPLE3(hp, + make_small(major), + make_small(minor), + make_small(build)); +} + void erts_bif_info_init(void) { erts_smp_atomic_init_nob(&available_internal_state, 0); erts_smp_atomic_init_nob(&hipe_test_reschedule_flag, 0); + alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1); + alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1); process_info_init(); + os_info_init(); } diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index 47c48e74d6..1805366cfe 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -34,27 +34,7 @@ static Eterm keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List); -/* - * erlang:'++'/2 - */ - -Eterm -ebif_plusplus_2(Process* p, Eterm A, Eterm B) -{ - return append_2(p, A, B); -} - -/* - * erlang:'--'/2 - */ - -Eterm -ebif_minusminus_2(Process* p, Eterm A, Eterm B) -{ - return subtract_2(p, A, B); -} - -BIF_RETTYPE append_2(BIF_ALIST_2) +static BIF_RETTYPE append(Process* p, Eterm A, Eterm B) { Eterm list; Eterm copy; @@ -63,18 +43,18 @@ BIF_RETTYPE append_2(BIF_ALIST_2) Eterm* hp; int i; - if ((i = list_length(BIF_ARG_1)) < 0) { - BIF_ERROR(BIF_P, BADARG); + if ((i = list_length(A)) < 0) { + BIF_ERROR(p, BADARG); } if (i == 0) { - BIF_RET(BIF_ARG_2); - } else if (is_nil(BIF_ARG_2)) { - BIF_RET(BIF_ARG_1); + BIF_RET(B); + } else if (is_nil(B)) { + BIF_RET(A); } need = 2*i; - hp = HAlloc(BIF_P, need); - list = BIF_ARG_1; + hp = HAlloc(p, need); + list = A; copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2)); list = CDR(list_val(list)); hp += 2; @@ -85,12 +65,31 @@ BIF_RETTYPE append_2(BIF_ALIST_2) list = CDR(listp); hp += 2; } - CDR(list_val(last)) = BIF_ARG_2; + CDR(list_val(last)) = B; BIF_RET(copy); } +/* + * erlang:'++'/2 + */ + +Eterm +ebif_plusplus_2(BIF_ALIST_2) +{ + return append(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +BIF_RETTYPE append_2(BIF_ALIST_2) +{ + return append(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +/* + * erlang:'--'/2 + */ + #define SMALL_VEC_SIZE 10 -BIF_RETTYPE subtract_2(BIF_ALIST_2) +static Eterm subtract(Process* p, Eterm A, Eterm B) { Eterm list; Eterm* hp; @@ -103,17 +102,17 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) int n; int m; - if ((n = list_length(BIF_ARG_1)) < 0) { - BIF_ERROR(BIF_P, BADARG); + if ((n = list_length(A)) < 0) { + BIF_ERROR(p, BADARG); } - if ((m = list_length(BIF_ARG_2)) < 0) { - BIF_ERROR(BIF_P, BADARG); + if ((m = list_length(B)) < 0) { + BIF_ERROR(p, BADARG); } if (n == 0) BIF_RET(NIL); if (m == 0) - BIF_RET(BIF_ARG_1); + BIF_RET(A); /* allocate element vector */ if (n <= SMALL_VEC_SIZE) @@ -123,7 +122,7 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) /* PUT ALL ELEMENTS IN VP */ vp = vec_p; - list = BIF_ARG_1; + list = A; i = n; while(i--) { Eterm* listp = list_val(list); @@ -132,7 +131,7 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) } /* UNMARK ALL DELETED CELLS */ - list = BIF_ARG_2; + list = B; m = 0; /* number of deleted elements */ while(is_list(list)) { Eterm* listp = list_val(list); @@ -153,11 +152,11 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) if (m == n) /* All deleted ? */ res = NIL; else if (m == 0) /* None deleted ? */ - res = BIF_ARG_1; + res = A; else { /* REBUILD LIST */ res = NIL; need = 2*(n - m); - hp = HAlloc(BIF_P, need); + hp = HAlloc(p, need); vp = vec_p + n - 1; while(vp >= vec_p) { if (is_value(*vp)) { @@ -172,6 +171,16 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2) BIF_RET(res); } +BIF_RETTYPE ebif_minusminus_2(BIF_ALIST_2) +{ + return subtract(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +BIF_RETTYPE subtract_2(BIF_ALIST_2) +{ + return subtract(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + BIF_RETTYPE lists_member_2(BIF_ALIST_2) { Eterm term; @@ -278,11 +287,12 @@ BIF_RETTYPE lists_reverse_2(BIF_ALIST_2) } BIF_RETTYPE -lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +lists_keymember_3(BIF_ALIST_3) { Eterm res; - res = keyfind(BIF_lists_keymember_3, p, Key, Pos, List); + res = keyfind(BIF_lists_keymember_3, BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); if (is_value(res) && is_tuple(res)) { return am_true; } else { @@ -291,23 +301,25 @@ lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List) } BIF_RETTYPE -lists_keysearch_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +lists_keysearch_3(BIF_ALIST_3) { Eterm res; - res = keyfind(BIF_lists_keysearch_3, p, Key, Pos, List); + res = keyfind(BIF_lists_keysearch_3, BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); if (is_non_value(res) || is_not_tuple(res)) { return res; } else { /* Tuple */ - Eterm* hp = HAlloc(p, 3); + Eterm* hp = HAlloc(BIF_P, 3); return TUPLE2(hp, am_value, res); } } BIF_RETTYPE -lists_keyfind_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +lists_keyfind_3(BIF_ALIST_3) { - return keyfind(BIF_lists_keyfind_3, p, Key, Pos, List); + return keyfind(BIF_lists_keyfind_3, BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } static Eterm diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c index deda7adc1f..13f8b1f63c 100644 --- a/erts/emulator/beam/erl_bif_op.c +++ b/erts/emulator/beam/erl_bif_op.c @@ -225,18 +225,23 @@ BIF_RETTYPE is_function_1(BIF_ALIST_1) BIF_RETTYPE is_function_2(BIF_ALIST_2) { + BIF_RET(erl_is_function(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2) +{ Sint arity; /* * Verify argument 2 (arity); arity must be >= 0. */ - if (is_small(BIF_ARG_2)) { - arity = signed_val(BIF_ARG_2); + if (is_small(arg2)) { + arity = signed_val(arg2); if (arity < 0) { error: - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } - } else if (is_big(BIF_ARG_2) && !bignum_header_is_neg(*big_val(BIF_ARG_2))) { + } else if (is_big(arg2) && !bignum_header_is_neg(*big_val(arg2))) { /* A positive bignum is OK, but can't possibly match. */ arity = -1; } else { @@ -244,20 +249,20 @@ BIF_RETTYPE is_function_2(BIF_ALIST_2) goto error; } - if (is_fun(BIF_ARG_1)) { - ErlFunThing* funp = (ErlFunThing *) fun_val(BIF_ARG_1); + if (is_fun(arg1)) { + ErlFunThing* funp = (ErlFunThing *) fun_val(arg1); if (funp->arity == (Uint) arity) { BIF_RET(am_true); } - } else if (is_export(BIF_ARG_1)) { - Export* exp = (Export *) EXPAND_POINTER((export_val(BIF_ARG_1))[1]); + } else if (is_export(arg1)) { + Export* exp = (Export *) EXPAND_POINTER((export_val(arg1))[1]); if (exp->code[2] == (Uint) arity) { BIF_RET(am_true); } - } else if (is_tuple(BIF_ARG_1)) { - Eterm* tp = tuple_val(BIF_ARG_1); + } else if (is_tuple(arg1)) { + Eterm* tp = tuple_val(arg1); if (tp[0] == make_arityval(2) && is_atom(tp[1]) && is_atom(tp[2])) { BIF_RET(am_true); } diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c index 954b1f9729..58d48199fa 100644 --- a/erts/emulator/beam/erl_bif_os.c +++ b/erts/emulator/beam/erl_bif_os.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * Copyright Ericsson AB 1999-2010. 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 @@ -53,20 +53,18 @@ BIF_RETTYPE os_timestamp_0(BIF_ALIST_0) } -Eterm -os_getpid_0(Process* p) +BIF_RETTYPE os_getpid_0(BIF_ALIST_0) { char pid_string[21]; /* enough for a 64 bit number */ int n; Eterm* hp; sys_get_pid(pid_string); /* In sys.c */ n = sys_strlen(pid_string); - hp = HAlloc(p, n*2); + hp = HAlloc(BIF_P, n*2); BIF_RET(buf_to_intlist(&hp, pid_string, n, NIL)); } -Eterm -os_getenv_0(Process* p) +BIF_RETTYPE os_getenv_0(BIF_ALIST_0) { GETENV_STATE state; char *cp; @@ -80,7 +78,7 @@ os_getenv_0(Process* p) ret = NIL; while ((cp = getenv_string(&state)) != NULL) { len = strlen(cp); - hp = HAlloc(p, len*2+2); + hp = HAlloc(BIF_P, len*2+2); str = buf_to_intlist(&hp, cp, len, NIL); ret = CONS(hp, str, ret); } @@ -90,9 +88,11 @@ os_getenv_0(Process* p) return ret; } -Eterm -os_getenv_1(Process* p, Eterm key) + +BIF_RETTYPE os_getenv_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm key = BIF_ARG_1; Eterm str; int len, res; char *key_str, *val; @@ -145,9 +145,11 @@ os_getenv_1(Process* p, Eterm key) BIF_RET(str); } -Eterm -os_putenv_2(Process* p, Eterm key, Eterm value) +BIF_RETTYPE os_putenv_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm key = BIF_ARG_1; + Eterm value = BIF_ARG_2; char def_buf[1024]; char *buf = NULL; int sep_ix, i, key_len, value_len, tot_len; diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 3fd35dd963..b21cda6347 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -48,6 +48,9 @@ static void free_args(char **); char *erts_default_arg0 = "default"; +static BIF_RETTYPE +port_call(Process* p, Eterm arg1, Eterm arg2, Eterm arg3); + BIF_RETTYPE open_port_2(BIF_ALIST_2) { int port_num; @@ -117,11 +120,9 @@ id_or_name2port(Process *c_p, Eterm id) #define ERTS_PORT_COMMAND_FLAG_FORCE (((Uint32) 1) << 0) #define ERTS_PORT_COMMAND_FLAG_NOSUSPEND (((Uint32) 1) << 1) -static BIF_RETTYPE do_port_command(Process *BIF_P, - Eterm BIF_ARG_1, - Eterm BIF_ARG_2, - Eterm BIF_ARG_3, - Uint32 flags) +static BIF_RETTYPE +do_port_command(Process *BIF_P, Eterm arg1, Eterm arg2, Eterm arg3, + Uint32 flags) { BIF_RETTYPE res; Port *p; @@ -135,7 +136,7 @@ static BIF_RETTYPE do_port_command(Process *BIF_P, profile_runnable_proc(BIF_P, am_inactive); } - p = id_or_name2port(BIF_P, BIF_ARG_1); + p = id_or_name2port(BIF_P, arg1); if (!p) { if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { trace_virtual_sched(BIF_P, am_in); @@ -172,13 +173,13 @@ static BIF_RETTYPE do_port_command(Process *BIF_P, monitor_generic(BIF_P, am_busy_port, p->id); } ERTS_BIF_PREP_YIELD3(res, bif_export[BIF_port_command_3], BIF_P, - BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + arg1, arg2, arg3); } } else { int wres; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); ERTS_SMP_CHK_NO_PROC_LOCKS; - wres = erts_write_to_port(BIF_P->id, p, BIF_ARG_2); + wres = erts_write_to_port(BIF_P->id, p, arg2); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); if (wres != 0) { ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); @@ -237,11 +238,17 @@ BIF_RETTYPE port_command_3(BIF_ALIST_3) BIF_RETTYPE port_call_2(BIF_ALIST_2) { - return port_call_3(BIF_P,BIF_ARG_1,make_small(0),BIF_ARG_2); + return port_call(BIF_P,BIF_ARG_1, make_small(0), BIF_ARG_2); } BIF_RETTYPE port_call_3(BIF_ALIST_3) { + return port_call(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static BIF_RETTYPE +port_call(Process* c_p, Eterm arg1, Eterm arg2, Eterm arg3) +{ Uint op; Port *p; Uint size; @@ -266,15 +273,15 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) /* trace of port scheduling with virtual process descheduling * lock wait */ - if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(BIF_P, am_out); + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(c_p, am_out); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { - profile_runnable_proc(BIF_P, am_inactive); + profile_runnable_proc(c_p, am_inactive); } - p = id_or_name2port(BIF_P, BIF_ARG_1); + p = id_or_name2port(c_p, arg1); if (!p) { error: if (port_resp != port_result && @@ -286,22 +293,22 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) /* Need to virtual schedule in the process if there * was an error. */ - if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(BIF_P, am_in); + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(c_p, am_in); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { - profile_runnable_proc(BIF_P, am_active); + profile_runnable_proc(c_p, am_active); } if (p) erts_port_release(p); #ifdef ERTS_SMP - ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN); + ERTS_SMP_BIF_CHK_PENDING_EXIT(c_p, ERTS_PROC_LOCK_MAIN); #else - ERTS_BIF_CHK_EXITED(BIF_P); + ERTS_BIF_CHK_EXITED(c_p); #endif - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(c_p, BADARG); } if ((drv = p->drv_ptr) == NULL) { @@ -310,10 +317,10 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) if (drv->call == NULL) { goto error; } - if (!term_to_Uint(BIF_ARG_2, &op)) { + if (!term_to_Uint(arg2, &op)) { goto error; } - p->caller = BIF_P->id; + p->caller = c_p->id; /* Lock taken, virtual schedule of port */ if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { @@ -323,19 +330,19 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { profile_runnable_port(p, am_active); } - size = erts_encode_ext_size(BIF_ARG_3); + size = erts_encode_ext_size(arg3); if (size > sizeof(port_input)) bytes = erts_alloc(ERTS_ALC_T_PORT_CALL_BUF, size); endp = bytes; - erts_encode_ext(BIF_ARG_3, &endp); + erts_encode_ext(arg3, &endp); real_size = endp - bytes; if (real_size > size) { erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", __FILE__, __LINE__, endp - (bytes + size)); } - erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); prc = (char *) port_resp; fpe_was_unmasked = erts_block_fpe(); ret = drv->call((ErlDrvData)p->drv_data, @@ -356,7 +363,7 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) port_resp = (byte *) prc; p->caller = NIL; - erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); #ifdef HARDDEBUG { int z; @@ -382,14 +389,14 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) if (result_size < 0) { goto error; } - hp = HAlloc(BIF_P, result_size); + hp = HAlloc(c_p, result_size); hp_end = hp + result_size; endp = port_resp; - res = erts_decode_ext(&hp, &MSO(BIF_P), &endp); + res = erts_decode_ext(&hp, &MSO(c_p), &endp); if (res == THE_NON_VALUE) { goto error; } - HRelease(BIF_P, hp_end, hp); + HRelease(c_p, hp_end, hp); if (port_resp != port_result && !(ret_flags & DRIVER_CALL_KEEP_BUFFER)) { driver_free(port_resp); } @@ -398,16 +405,16 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3) if (p) erts_port_release(p); #ifdef ERTS_SMP - ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN); + ERTS_SMP_BIF_CHK_PENDING_EXIT(c_p, ERTS_PROC_LOCK_MAIN); #else - ERTS_BIF_CHK_EXITED(BIF_P); + ERTS_BIF_CHK_EXITED(c_p); #endif - if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(BIF_P, am_in); + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(c_p, am_in); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { - profile_runnable_proc(BIF_P, am_active); + profile_runnable_proc(c_p, am_active); } return res; diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c index 26891c4348..6b843d2e08 100644 --- a/erts/emulator/beam/erl_bif_re.c +++ b/erts/emulator/beam/erl_bif_re.c @@ -45,6 +45,7 @@ static Export *urun_trap_exportp = NULL; static Export *ucompile_trap_exportp = NULL; static BIF_RETTYPE re_exec_trap(BIF_ALIST_3); +static BIF_RETTYPE re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); static void *erts_erts_pcre_malloc(size_t size) { return erts_alloc(ERTS_ALC_T_RE_HEAP,size); @@ -414,8 +415,8 @@ build_compile_result(Process *p, Eterm error_tag, pcre *result, int errcode, con * Compile BIFs */ -BIF_RETTYPE -re_compile_2(BIF_ALIST_2) +static BIF_RETTYPE +re_compile(Process* p, Eterm arg1, Eterm arg2) { Uint slen; char *expr; @@ -429,43 +430,49 @@ re_compile_2(BIF_ALIST_2) int unicode = 0; - if (parse_options(BIF_ARG_2,&options,NULL,&pflags,NULL,NULL) + if (parse_options(arg2,&options,NULL,&pflags,NULL,NULL) < 0) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } if (pflags & PARSE_FLAG_UNIQUE_EXEC_OPT) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0; - if (pflags & PARSE_FLAG_UNICODE && !is_binary(BIF_ARG_1)) { - BIF_TRAP2(ucompile_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2); + if (pflags & PARSE_FLAG_UNICODE && !is_binary(arg1)) { + BIF_TRAP2(ucompile_trap_exportp, p, arg1, arg2); } - if (erts_iolist_size(BIF_ARG_1, &slen)) { - BIF_ERROR(BIF_P,BADARG); + if (erts_iolist_size(arg1, &slen)) { + BIF_ERROR(p,BADARG); } expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1); - if (io_list_to_buf(BIF_ARG_1, expr, slen) != 0) { + if (io_list_to_buf(arg1, expr, slen) != 0) { erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } expr[slen]='\0'; result = erts_pcre_compile2(expr, options, &errcode, &errstr, &errofset, default_table); - ret = build_compile_result(BIF_P, am_error, result, errcode, + ret = build_compile_result(p, am_error, result, errcode, errstr, errofset, unicode, 1); erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); BIF_RET(ret); } BIF_RETTYPE +re_compile_2(BIF_ALIST_2) +{ + return re_compile(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +BIF_RETTYPE re_compile_1(BIF_ALIST_1) { - return re_compile_2(BIF_P,BIF_ARG_1,NIL); + return re_compile(BIF_P, BIF_ARG_1, NIL); } /* @@ -845,8 +852,8 @@ build_capture(Eterm capture_spec[CAPSPEC_SIZE], const pcre *code) /* * The actual re:run/2,3 BIFs */ -BIF_RETTYPE -re_run_3(BIF_ALIST_3) +static BIF_RETTYPE +re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) { const pcre *code_tmp; RestartContext restart; @@ -865,15 +872,15 @@ re_run_3(BIF_ALIST_3) Eterm capture[CAPSPEC_SIZE]; int is_list_cap; - if (parse_options(BIF_ARG_3,&comp_options,&options,&pflags,&startoffset,capture) + if (parse_options(arg3,&comp_options,&options,&pflags,&startoffset,capture) < 0) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } is_list_cap = ((pflags & PARSE_FLAG_CAPTURE_OPT) && (capture[CAPSPEC_TYPE] == am_list)); - if (is_not_tuple(BIF_ARG_2) || (arityval(*tuple_val(BIF_ARG_2)) != 4)) { - if (is_binary(BIF_ARG_2) || is_list(BIF_ARG_2) || is_nil(BIF_ARG_2)) { + if (is_not_tuple(arg2) || (arityval(*tuple_val(arg2)) != 4)) { + if (is_binary(arg2) || is_list(arg2) || is_nil(arg2)) { /* Compile from textual RE */ Uint slen; char *expr; @@ -884,19 +891,19 @@ re_run_3(BIF_ALIST_3) int capture_count; if (pflags & PARSE_FLAG_UNICODE && - (!is_binary(BIF_ARG_2) || !is_binary(BIF_ARG_1) || + (!is_binary(arg2) || !is_binary(arg1) || (is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) { - BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + BIF_TRAP3(urun_trap_exportp, p, arg1, arg2, arg3); } - if (erts_iolist_size(BIF_ARG_2, &slen)) { - BIF_ERROR(BIF_P,BADARG); + if (erts_iolist_size(arg2, &slen)) { + BIF_ERROR(p,BADARG); } expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1); - if (io_list_to_buf(BIF_ARG_2, expr, slen) != 0) { + if (io_list_to_buf(arg2, expr, slen) != 0) { erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } expr[slen]='\0'; result = erts_pcre_compile2(expr, comp_options, &errcode, @@ -905,11 +912,11 @@ re_run_3(BIF_ALIST_3) erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); /* Compilation error gives badarg except in the compile function */ - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } if (pflags & PARSE_FLAG_GLOBAL) { Eterm precompiled = - build_compile_result(BIF_P, am_error, + build_compile_result(p, am_error, result, errcode, errstr, errofset, (pflags & @@ -917,13 +924,13 @@ re_run_3(BIF_ALIST_3) 0); Eterm *hp,r; erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); - hp = HAlloc(BIF_P,4); - /* BIF_ARG_2 is in the tuple just to make exceptions right */ - r = TUPLE3(hp,BIF_ARG_3, + hp = HAlloc(p,4); + /* arg2 is in the tuple just to make exceptions right */ + r = TUPLE3(hp,arg3, ((pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) ? am_true : - am_false), BIF_ARG_2); - BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, precompiled, r); + am_false), arg2); + BIF_TRAP3(grun_trap_exportp, p, arg1, precompiled, r); } erts_pcre_fullinfo(result, NULL, PCRE_INFO_SIZE, &code_size); @@ -935,31 +942,31 @@ re_run_3(BIF_ALIST_3) erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); /*unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0;*/ } else { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } } else { if (pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } - tp = tuple_val(BIF_ARG_2); + tp = tuple_val(arg2); if (tp[1] != am_re_pattern || is_not_small(tp[2]) || is_not_small(tp[3]) || is_not_binary(tp[4])) { - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } if (unsigned_val(tp[3]) && - (!is_binary(BIF_ARG_1) || + (!is_binary(arg1) || (is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) { /* unicode */ - BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, - BIF_ARG_3); + BIF_TRAP3(urun_trap_exportp, p, arg1, arg2, + arg3); } if (pflags & PARSE_FLAG_GLOBAL) { Eterm *hp,r; - hp = HAlloc(BIF_P,3); - r = TUPLE2(hp,BIF_ARG_3,am_false); - BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, + hp = HAlloc(p,3); + r = TUPLE2(hp,arg3,am_false); + BIF_TRAP3(grun_trap_exportp, p, arg1, arg2, r); } @@ -968,7 +975,7 @@ re_run_3(BIF_ALIST_3) if ((code_tmp = (const pcre *) erts_get_aligned_binary_bytes(tp[4], &temp_alloc)) == NULL) { erts_free_aligned_binary_bytes(temp_alloc); - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } restart.code = erts_alloc(ERTS_ALC_T_RE_SUBJECT, code_size); memcpy(restart.code, code_tmp, code_size); @@ -980,7 +987,7 @@ re_run_3(BIF_ALIST_3) restart.ovector = erts_alloc(ERTS_ALC_T_RE_SUBJECT, ovsize * sizeof(int)); restart.extra.flags = PCRE_EXTRA_TABLES | PCRE_EXTRA_LOOP_LIMIT; restart.extra.tables = default_table; - restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(BIF_P) * LOOP_FACTOR; + restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(p) * LOOP_FACTOR; loop_limit_tmp = max_loop_limit; /* To lesser probability of race in debug situation (erts_debug) */ if (restart.extra.loop_limit > loop_limit_tmp) { @@ -996,7 +1003,7 @@ re_run_3(BIF_ALIST_3) if ((restart.ret_info = build_capture(capture,restart.code)) == NULL) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } } @@ -1004,7 +1011,7 @@ re_run_3(BIF_ALIST_3) copying, also binary returns can be sub binaries in that case */ restart.flags = 0; - if (is_binary(BIF_ARG_1)) { + if (is_binary(arg1)) { Eterm real_bin; Uint offset; Eterm* bptr; @@ -1012,9 +1019,9 @@ re_run_3(BIF_ALIST_3) int bitsize; ProcBin* pb; - ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); + ERTS_GET_REAL_BIN(arg1, real_bin, offset, bitoffs, bitsize); - slength = binary_size(BIF_ARG_1); + slength = binary_size(arg1); bptr = binary_val(real_bin); if (bitsize != 0 || bitoffs != 0 || (*bptr != HEADER_PROC_BIN)) { goto handle_iolist; @@ -1027,24 +1034,24 @@ re_run_3(BIF_ALIST_3) restart.flags |= RESTART_FLAG_SUBJECT_IN_BINARY; } else { handle_iolist: - if (erts_iolist_size(BIF_ARG_1, &slength)) { + if (erts_iolist_size(arg1, &slength)) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); if (restart.ret_info != NULL) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info); } - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } restart.subject = erts_alloc(ERTS_ALC_T_RE_SUBJECT, slength); - if (io_list_to_buf(BIF_ARG_1, restart.subject, slength) != 0) { + if (io_list_to_buf(arg1, restart.subject, slength) != 0) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); erts_free(ERTS_ALC_T_RE_SUBJECT, restart.subject); if (restart.ret_info != NULL) { erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info); } - BIF_ERROR(BIF_P,BADARG); + BIF_ERROR(p,BADARG); } } @@ -1056,7 +1063,7 @@ handle_iolist: rc = erts_pcre_exec(restart.code, &(restart.extra), restart.subject, slength, startoffset, options, restart.ovector, ovsize); ASSERT(loop_count != 0xFFFFFFFF); - BUMP_REDS(BIF_P, loop_count / LOOP_FACTOR); + BUMP_REDS(p, loop_count / LOOP_FACTOR); if (rc == PCRE_ERROR_LOOP_LIMIT) { /* Trap */ Binary *mbp = erts_create_magic_binary(sizeof(RestartContext), @@ -1065,17 +1072,17 @@ handle_iolist: Eterm magic_bin; Eterm *hp; memcpy(restartp,&restart,sizeof(RestartContext)); - BUMP_ALL_REDS(BIF_P); - hp = HAlloc(BIF_P, PROC_BIN_SIZE); - magic_bin = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mbp); + BUMP_ALL_REDS(p); + hp = HAlloc(p, PROC_BIN_SIZE); + magic_bin = erts_mk_magic_binary_term(&hp, &MSO(p), mbp); BIF_TRAP3(&re_exec_trap_export, - BIF_P, - BIF_ARG_1, - BIF_ARG_2 /* To avoid GC of precompiled code, XXX: not utilized yet */, + p, + arg1, + arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */, magic_bin); } - res = build_exec_return(BIF_P, rc, &restart, BIF_ARG_1); + res = build_exec_return(p, rc, &restart, arg1); cleanup_restart_context(&restart); @@ -1083,9 +1090,15 @@ handle_iolist: } BIF_RETTYPE +re_run_3(BIF_ALIST_3) +{ + return re_run(BIF_P,BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +BIF_RETTYPE re_run_2(BIF_ALIST_2) { - return re_run_3(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL); + return re_run(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL); } /* diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c index db771bd216..a922a33da3 100644 --- a/erts/emulator/beam/erl_bif_timer.c +++ b/erts/emulator/beam/erl_bif_timer.c @@ -26,6 +26,7 @@ #include "bif.h" #include "error.h" #include "big.h" +#include "erl_thr_progress.h" /**************************************************************************** ** BIF Timer support @@ -686,7 +687,7 @@ erts_bif_timer_foreach(void (*func)(Eterm, Eterm, ErlHeapFragment *, void *), { int i; - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); for (i = 0; i < TIMER_HASH_VEC_SZ; i++) { ErtsBifTimer *btm; diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 7a08182e18..b0a58c80ea 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -37,6 +37,7 @@ #include "erl_version.h" #include "beam_bp.h" #include "erl_binary.h" +#include "erl_thr_progress.h" #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) @@ -47,6 +48,11 @@ static Binary *erts_default_meta_match_spec; static struct trace_pattern_flags erts_default_trace_pattern_flags; static Eterm erts_default_meta_tracer_pid; +static Eterm +trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist); +static BIF_RETTYPE +system_monitor(Process *p, Eterm monitor_pid, Eterm list); + static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/ static int already_traced(Process *p, Process *tracee_p, Eterm tracer); static int port_already_traced(Process *p, Port *tracee_port, Eterm tracer); @@ -76,13 +82,19 @@ erts_bif_trace_init(void) */ Eterm -trace_pattern_2(Process* p, Eterm MFA, Eterm Pattern) +trace_pattern_2(BIF_ALIST_2) { - return trace_pattern_3(p,MFA,Pattern,NIL); + return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL); } Eterm -trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) +trace_pattern_3(BIF_ALIST_3) +{ + return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static Eterm +trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) { DeclareTmpHeap(mfa,3,p); /* Not really heap here, but might be when setting pattern */ int i; @@ -97,7 +109,7 @@ trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) Eterm meta_tracer_pid = p->id; erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); UseTmpHeap(3,p); /* @@ -326,7 +338,7 @@ trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) done: UnUseTmpHeap(3,p); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); return make_small(matches); @@ -336,7 +348,7 @@ trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) MatchSetUnref(match_prog_set); UnUseTmpHeap(3,p); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); BIF_ERROR(p, BADARG); } @@ -435,9 +447,12 @@ erts_trace_flags(Eterm List, return 0; } -Eterm -trace_3(Process* p, Eterm pid_spec, Eterm how, Eterm list) +Eterm trace_3(BIF_ALIST_3) { + Process* p = BIF_P; + Eterm pid_spec = BIF_ARG_1; + Eterm how = BIF_ARG_2; + Eterm list = BIF_ARG_3; int on; Eterm tracer = NIL; int matches = 0; @@ -630,7 +645,7 @@ trace_3(Process* p, Eterm pid_spec, Eterm how, Eterm list) #ifdef ERTS_SMP erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); system_blocked = 1; #endif @@ -711,7 +726,7 @@ trace_3(Process* p, Eterm pid_spec, Eterm how, Eterm list) #ifdef ERTS_SMP if (system_blocked) { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); } #endif @@ -726,7 +741,7 @@ trace_3(Process* p, Eterm pid_spec, Eterm how, Eterm list) #ifdef ERTS_SMP if (system_blocked) { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); } #endif @@ -820,9 +835,11 @@ static int already_traced(Process *c_p, Process *tracee_p, Eterm tracer) * Return information about a process or an external function being traced. */ -Eterm -trace_info_2(Process* p, Eterm What, Eterm Key) +Eterm trace_info_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm What = BIF_ARG_1; + Eterm Key = BIF_ARG_2; Eterm res; if (What == am_on_load) { res = trace_info_on_load(p, Key); @@ -1060,7 +1077,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) #ifdef ERTS_SMP if ( (key == am_call_time) || (key == am_all)) { erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); } #endif @@ -1068,7 +1085,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) #ifdef ERTS_SMP if ( (key == am_call_time) || (key == am_all)) { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); } #endif @@ -1752,23 +1769,20 @@ new_seq_trace_token(Process* p) } } -BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) +BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) { - Eterm item; Eterm res; Eterm* hp; Uint current_flag; - if (is_not_atom(BIF_ARG_1)) { - BIF_ERROR(BIF_P, BADARG); + if (is_not_atom(item)) { + BIF_ERROR(p, BADARG); } - item = BIF_ARG_1; - - if (SEQ_TRACE_TOKEN(BIF_P) == NIL) { + if (SEQ_TRACE_TOKEN(p) == NIL) { if ((item == am_send) || (item == am_receive) || (item == am_print) || (item == am_timestamp)) { - hp = HAlloc(BIF_P,3); + hp = HAlloc(p,3); res = TUPLE2(hp, item, am_false); BIF_RET(res); } else if ((item == am_label) || (item == am_serial)) { @@ -1778,35 +1792,40 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) } } - if (BIF_ARG_1 == am_send) { + if (item == am_send) { current_flag = SEQ_TRACE_SEND; - } else if (BIF_ARG_1 == am_receive) { + } else if (item == am_receive) { current_flag = SEQ_TRACE_RECEIVE; - } else if (BIF_ARG_1 == am_print) { + } else if (item == am_print) { current_flag = SEQ_TRACE_PRINT; - } else if (BIF_ARG_1 == am_timestamp) { + } else if (item == am_timestamp) { current_flag = SEQ_TRACE_TIMESTAMP; } else { current_flag = 0; } if (current_flag) { - res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(BIF_P)) & current_flag ? + res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(p)) & current_flag ? am_true : am_false; } else if (item == am_label) { - res = SEQ_TRACE_TOKEN_LABEL(BIF_P); + res = SEQ_TRACE_TOKEN_LABEL(p); } else if (item == am_serial) { - hp = HAlloc(BIF_P, 3); - res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(BIF_P), SEQ_TRACE_TOKEN_SERIAL(BIF_P)); + hp = HAlloc(p, 3); + res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(p), SEQ_TRACE_TOKEN_SERIAL(p)); } else { error: - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } - hp = HAlloc(BIF_P, 3); + hp = HAlloc(p, 3); res = TUPLE2(hp, item, res); BIF_RET(res); } +BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) +{ + BIF_RET(erl_seq_trace_info(BIF_P, BIF_ARG_1)); +} + /* seq_trace_print(Message) -> true | false This function passes Message to the system_tracer @@ -1852,7 +1871,7 @@ void erts_system_monitor_clear(Process *c_p) { #ifdef ERTS_SMP if (c_p) { erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); } #endif erts_set_system_monitor(NIL); @@ -1862,7 +1881,7 @@ void erts_system_monitor_clear(Process *c_p) { erts_system_monitor_flags.busy_dist_port = 0; #ifdef ERTS_SMP if (c_p) { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); } #endif @@ -1919,23 +1938,35 @@ static Eterm system_monitor_get(Process *p) } -BIF_RETTYPE system_monitor_0(Process *p) { - BIF_RET(system_monitor_get(p)); +BIF_RETTYPE system_monitor_0(BIF_ALIST_0) +{ + BIF_RET(system_monitor_get(BIF_P)); } -BIF_RETTYPE system_monitor_1(Process *p, Eterm spec) { +BIF_RETTYPE system_monitor_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm spec = BIF_ARG_1; + if (spec == am_undefined) { - BIF_RET(system_monitor_2(p, spec, NIL)); + BIF_RET(system_monitor(p, spec, NIL)); } else if (is_tuple(spec)) { Eterm *tp = tuple_val(spec); if (tp[0] != make_arityval(2)) goto error; - BIF_RET(system_monitor_2(p, tp[1], tp[2])); + BIF_RET(system_monitor(p, tp[1], tp[2])); } error: BIF_ERROR(p, BADARG); } -BIF_RETTYPE system_monitor_2(Process *p, Eterm monitor_pid, Eterm list) { +BIF_RETTYPE system_monitor_2(BIF_ALIST_2) +{ + return system_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +static BIF_RETTYPE +system_monitor(Process *p, Eterm monitor_pid, Eterm list) +{ Eterm prev; int system_blocked = 0; @@ -1951,7 +1982,7 @@ BIF_RETTYPE system_monitor_2(Process *p, Eterm monitor_pid, Eterm list) { system_blocked = 1; erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0)) goto error; @@ -1985,7 +2016,7 @@ BIF_RETTYPE system_monitor_2(Process *p, Eterm monitor_pid, Eterm list) { erts_system_monitor_flags.busy_port = !!busy_port; erts_system_monitor_flags.busy_dist_port = !!busy_dist_port; - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); BIF_RET(prev); } @@ -1993,7 +2024,7 @@ BIF_RETTYPE system_monitor_2(Process *p, Eterm monitor_pid, Eterm list) { error: if (system_blocked) { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); } @@ -2006,7 +2037,7 @@ void erts_system_profile_clear(Process *c_p) { #ifdef ERTS_SMP if (c_p) { erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); } #endif erts_set_system_profile(NIL); @@ -2016,7 +2047,7 @@ void erts_system_profile_clear(Process *c_p) { erts_system_profile_flags.exclusive = 0; #ifdef ERTS_SMP if (c_p) { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); } #endif @@ -2053,11 +2084,16 @@ static Eterm system_profile_get(Process *p) { } } -BIF_RETTYPE system_profile_0(Process *p) { - BIF_RET(system_profile_get(p)); +BIF_RETTYPE system_profile_0(BIF_ALIST_0) +{ + BIF_RET(system_profile_get(BIF_P)); } -BIF_RETTYPE system_profile_2(Process *p, Eterm profiler, Eterm list) { +BIF_RETTYPE system_profile_2(BIF_ALIST_2) +{ + Process *p = BIF_P; + Eterm profiler = BIF_ARG_1; + Eterm list = BIF_ARG_2; Eterm prev; int system_blocked = 0; Process *profiler_p = NULL; @@ -2075,7 +2111,7 @@ BIF_RETTYPE system_profile_2(Process *p, Eterm profiler, Eterm list) { system_blocked = 1; erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); /* Check if valid process, no locks are taken */ @@ -2117,7 +2153,7 @@ BIF_RETTYPE system_profile_2(Process *p, Eterm profiler, Eterm list) { erts_system_profile_flags.runnable_procs = !!runnable_procs; erts_system_profile_flags.exclusive = !!exclusive; - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); BIF_RET(prev); @@ -2126,7 +2162,7 @@ BIF_RETTYPE system_profile_2(Process *p, Eterm profiler, Eterm list) { error: if (system_blocked) { - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); } diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 0327850cb9..0079c13287 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -129,8 +129,6 @@ static Uint meta_main_tab_slot_mask; /* The slot index part of an unnamed tab static Uint meta_main_tab_seq_incr; static Uint meta_main_tab_seq_cnt = 0; /* To give unique(-ish) table identifiers */ - - /* ** The meta hash table of all NAMED ets tables */ @@ -202,12 +200,17 @@ static int free_table_cont(Process *p, int first, int clean_meta_tab); static void print_table(int to, void *to_arg, int show, DbTable* tb); -static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1); -static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1); -static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1); -static BIF_RETTYPE ets_delete_trap(Process *p, Eterm a1); +static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1); +static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1); +static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1); +static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1); static Eterm table_info(Process* p, DbTable* tb, Eterm What); +static BIF_RETTYPE ets_select1(Process* p, Eterm arg1); +static BIF_RETTYPE ets_select2(Process* p, Eterm arg1, Eterm arg2); +static BIF_RETTYPE ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3); + + /* * Exported global */ @@ -277,8 +280,7 @@ static void schedule_free_dbtable(DbTable* tb) ASSERT(scheds >= 1); ASSERT(erts_refc_read(&tb->common.ref, 0) == 0); erts_refc_init(&tb->common.ref, scheds); - ERTS_THR_MEMORY_BARRIER; - erts_smp_schedule_misc_aux_work(0, scheds, chk_free_dbtable, tb); + erts_schedule_multi_misc_aux_work(0, scheds, chk_free_dbtable, tb); #else free_dbtable(tb); #endif @@ -1297,7 +1299,9 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) Uint32 status; Sint keypos; int is_named, is_fine_locked, frequent_read, is_compressed; +#ifdef DEBUG int cret; +#endif DeclareTmpHeap(meta_tuple,3,BIF_P); DbTableMethod* meth; erts_smp_rwmtx_t *mmtl; @@ -1445,7 +1449,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.fixations = NULL; tb->common.compress = is_compressed; - cret = meth->db_create(BIF_P, tb); +#ifdef DEBUG + cret = +#endif + meth->db_create(BIF_P, tb); ASSERT(cret == DB_ERROR_NONE); erts_smp_spin_lock(&meta_main_tab_main_lock); @@ -1942,8 +1949,10 @@ BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2) /* ** This is for trapping, cannot be called directly. */ -static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1) +static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; BIF_RETTYPE result; DbTable* tb; int cret; @@ -2109,7 +2118,7 @@ BIF_RETTYPE ets_slot_2(BIF_ALIST_2) BIF_RETTYPE ets_match_1(BIF_ALIST_1) { - return ets_select_1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ARG_1); } BIF_RETTYPE ets_match_2(BIF_ALIST_2) @@ -2125,7 +2134,7 @@ BIF_RETTYPE ets_match_2(BIF_ALIST_2) ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select_2(BIF_P, BIF_ARG_1, ms); + res = ets_select2(BIF_P, BIF_ARG_1, ms); UnUseTmpHeap(8,BIF_P); return res; } @@ -2143,7 +2152,7 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3) ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); + res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); UnUseTmpHeap(8,BIF_P); return res; } @@ -2151,6 +2160,12 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3) BIF_RETTYPE ets_select_3(BIF_ALIST_3) { + return ets_select3(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static BIF_RETTYPE +ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3) +{ BIF_RETTYPE result; DbTable* tb; int cret; @@ -2161,22 +2176,22 @@ BIF_RETTYPE ets_select_3(BIF_ALIST_3) CHECK_TABLES(); /* Chunk size strictly greater than 0 */ - if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) { - BIF_ERROR(BIF_P, BADARG); + if (is_not_small(arg3) || (chunk_size = signed_val(arg3)) <= 0) { + BIF_ERROR(p, BADARG); } - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); + if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(p, BADARG); } - safety = ITERATION_SAFETY(BIF_P,tb); + safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select_chunk(BIF_P, tb, - BIF_ARG_2, chunk_size, + cret = tb->common.meth->db_select_chunk(p, tb, + arg2, chunk_size, 0 /* not reversed */, &ret); - if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { - fix_table_locked(BIF_P, tb); + if (DID_TRAP(p,ret) && safety != ITER_SAFE) { + fix_table_locked(p, tb); } if (safety == ITER_UNSAFE) { local_unfix_table(tb); @@ -2188,22 +2203,24 @@ BIF_RETTYPE ets_select_3(BIF_ALIST_3) ERTS_BIF_PREP_RET(result, ret); break; case DB_ERROR_SYSRES: - ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT); break; default: - ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + ERTS_BIF_PREP_ERROR(result, p, BADARG); break; } - erts_match_set_release_result(BIF_P); + erts_match_set_release_result(p); return result; } /* We get here instead of in the real BIF when trapping */ -static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1) +static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; BIF_RETTYPE result; DbTable* tb; int cret; @@ -2248,6 +2265,11 @@ static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1) BIF_RETTYPE ets_select_1(BIF_ALIST_1) { + return ets_select1(BIF_P, BIF_ARG_1); +} + +static BIF_RETTYPE ets_select1(Process *p, Eterm arg1) +{ BIF_RETTYPE result; DbTable* tb; int cret; @@ -2261,28 +2283,27 @@ BIF_RETTYPE ets_select_1(BIF_ALIST_1) * Make sure that the table exists. */ - if (!is_tuple(BIF_ARG_1)) { - if (BIF_ARG_1 == am_EOT) { + if (!is_tuple(arg1)) { + if (arg1 == am_EOT) { BIF_RET(am_EOT); } - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(p, BADARG); } - tptr = tuple_val(BIF_ARG_1); + tptr = tuple_val(arg1); if (arityval(*tptr) < 1 || - (tb = db_get_table(BIF_P, tptr[1], DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); + (tb = db_get_table(p, tptr[1], DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(p, BADARG); } - safety = ITERATION_SAFETY(BIF_P,tb); + safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select_continue(BIF_P,tb, - BIF_ARG_1, &ret); + cret = tb->common.meth->db_select_continue(p,tb, arg1, &ret); - if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { - fix_table_locked(BIF_P, tb); + if (DID_TRAP(p,ret) && safety != ITER_SAFE) { + fix_table_locked(p, tb); } if (safety == ITER_UNSAFE) { local_unfix_table(tb); @@ -2294,20 +2315,26 @@ BIF_RETTYPE ets_select_1(BIF_ALIST_1) ERTS_BIF_PREP_RET(result, ret); break; case DB_ERROR_SYSRES: - ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT); break; default: - ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + ERTS_BIF_PREP_ERROR(result, p, BADARG); break; } - erts_match_set_release_result(BIF_P); + erts_match_set_release_result(p); return result; } BIF_RETTYPE ets_select_2(BIF_ALIST_2) { + return ets_select2(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +static BIF_RETTYPE +ets_select2(Process* p, Eterm arg1, Eterm arg2) +{ BIF_RETTYPE result; DbTable* tb; int cret; @@ -2320,19 +2347,19 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2) * Make sure that the table exists. */ - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); + if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(p, BADARG); } - safety = ITERATION_SAFETY(BIF_P,tb); + safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select(BIF_P, tb, BIF_ARG_2, + cret = tb->common.meth->db_select(p, tb, arg2, 0, &ret); - if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { - fix_table_locked(BIF_P, tb); + if (DID_TRAP(p,ret) && safety != ITER_SAFE) { + fix_table_locked(p, tb); } if (safety == ITER_UNSAFE) { local_unfix_table(tb); @@ -2344,21 +2371,23 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2) ERTS_BIF_PREP_RET(result, ret); break; case DB_ERROR_SYSRES: - ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT); break; default: - ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + ERTS_BIF_PREP_ERROR(result, p, BADARG); break; } - erts_match_set_release_result(BIF_P); + erts_match_set_release_result(p); return result; } /* We get here instead of in the real BIF when trapping */ -static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1) +static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; BIF_RETTYPE result; DbTable* tb; int cret; @@ -2499,7 +2528,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3) BIF_RETTYPE ets_select_reverse_1(BIF_ALIST_1) { - return ets_select_1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ARG_1); } BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) @@ -2553,7 +2582,7 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) */ BIF_RETTYPE ets_match_object_1(BIF_ALIST_1) { - return ets_select_1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ARG_1); } BIF_RETTYPE ets_match_object_2(BIF_ALIST_2) @@ -2569,7 +2598,7 @@ BIF_RETTYPE ets_match_object_2(BIF_ALIST_2) ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select_2(BIF_P, BIF_ARG_1, ms); + res = ets_select2(BIF_P, BIF_ARG_1, ms); UnUseTmpHeap(8,BIF_P); return res; } @@ -2587,7 +2616,7 @@ BIF_RETTYPE ets_match_object_3(BIF_ALIST_3) ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); + res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); UnUseTmpHeap(8,BIF_P); return res; } @@ -2606,7 +2635,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) int i; Eterm* hp; /*Process* rp = NULL;*/ + /* If/when we implement lockless private tables: Eterm owner; + */ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) { @@ -2615,7 +2646,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } + /* If/when we implement lockless private tables: owner = tb->common.owner; + */ /* If/when we implement lockless private tables: if ((tb->common.status & DB_PRIVATE) && owner != BIF_P->id) { @@ -3521,8 +3554,10 @@ static void free_heir_data(DbTable* tb) #endif } -static BIF_RETTYPE ets_delete_trap(Process *p, Eterm cont) +static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm cont = BIF_ARG_1; int trap; Eterm* ptr = big_val(cont); DbTable *tb = *((DbTable **) (UWord) (ptr + 1)); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index c6f0d80e32..312050b931 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -344,8 +344,8 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b, int *done); static int do_partly_bound_can_match_greater(Eterm a, Eterm b, int *done); -static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1, - Eterm a2, Eterm a3); +static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3); + /* Method interface functions */ static int db_first_tree(Process *p, DbTable *tbl, @@ -844,8 +844,12 @@ static int db_slot_tree(Process *p, DbTable *tbl, -static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1, Eterm a2, Eterm a3) +static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3) { + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; + Eterm a2 = BIF_ARG_2; + Eterm a3 = BIF_ARG_3; Eterm list; Eterm result; Eterm* hp; diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 7dfbb2ed02..4821a7d9fb 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -35,6 +35,7 @@ #include "bif.h" #include "big.h" #include "erl_binary.h" +#include "erl_thr_progress.h" #include "erl_db_util.h" @@ -495,7 +496,7 @@ static erts_smp_atomic32_t trace_control_word; /* This needs to be here, before the bif table... */ -static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val); +static Eterm db_set_trace_control_word_fake_1(BIF_ALIST_1); /* ** The table of callable bif's, i e guard bif's and @@ -908,14 +909,18 @@ static void db_free_tmp_uncompressed(DbTerm* obj); /* ** Pseudo BIF:s to be callable from the PAM VM. */ - -BIF_RETTYPE db_get_trace_control_word_0(Process *p) +BIF_RETTYPE db_get_trace_control_word(Process *p) { Uint32 tcw = (Uint32) erts_smp_atomic32_read_acqb(&trace_control_word); BIF_RET(erts_make_integer((Uint) tcw, p)); } -BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new) +BIF_RETTYPE db_get_trace_control_word_0(BIF_ALIST_0) +{ + BIF_RET(db_get_trace_control_word(BIF_P)); +} + +BIF_RETTYPE db_set_trace_control_word(Process *p, Eterm new) { Uint val; Uint32 old_tcw; @@ -923,20 +928,27 @@ BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new) BIF_ERROR(p, BADARG); if (val != ((Uint32)val)) BIF_ERROR(p, BADARG); - + old_tcw = (Uint32) erts_smp_atomic32_xchg_relb(&trace_control_word, (erts_aint32_t) val); BIF_RET(erts_make_integer((Uint) old_tcw, p)); } -static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm new) +BIF_RETTYPE db_set_trace_control_word_1(BIF_ALIST_1) { + BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_1)); +} + +static Eterm db_set_trace_control_word_fake_1(BIF_ALIST_1) +{ + Process *p = BIF_P; + Eterm new = BIF_ARG_1; Uint val; if (!term_to_Uint(new, &val)) BIF_ERROR(p, BADARG); if (val != ((Uint32)val)) BIF_ERROR(p, BADARG); - BIF_RET(db_get_trace_control_word_0(p)); + BIF_RET(db_get_trace_control_word(p)); } /* @@ -1704,6 +1716,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Process *current_scheduled; ErtsSchedulerData *esdp; Eterm (*bif)(Process*, ...); + Eterm bif_args[3]; int fail_label; int atomic_trace; #if HALFWORD_HEAP @@ -1734,14 +1747,14 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, if (! atomic_trace) { \ erts_refc_inc(&bprog->refc, 2); \ erts_smp_proc_unlock((p), ERTS_PROC_LOCK_MAIN); \ - erts_smp_block_system(0); \ + erts_smp_thr_progress_block(); \ atomic_trace = !0; \ } \ } while (0) #define END_ATOMIC_TRACE(p) \ do { \ if (atomic_trace) { \ - erts_smp_release_system(); \ + erts_smp_thr_progress_unblock(); \ erts_smp_proc_lock((p), ERTS_PROC_LOCK_MAIN); \ if (erts_refc_dectest(&bprog->refc, 0) == 0) {\ erts_bin_free(bprog); \ @@ -1957,7 +1970,7 @@ restart: break; case matchCall0: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc); + t = (*bif)(build_proc, bif_args); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1968,7 +1981,7 @@ restart: break; case matchCall1: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc, esp[-1]); + t = (*bif)(build_proc, esp-1); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1979,7 +1992,9 @@ restart: break; case matchCall2: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc, esp[-1], esp[-2]); + bif_args[0] = esp[-1]; + bif_args[1] = esp[-2]; + t = (*bif)(build_proc, bif_args); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1991,7 +2006,10 @@ restart: break; case matchCall3: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(build_proc, esp[-1], esp[-2], esp[-3]); + bif_args[0] = esp[-1]; + bif_args[1] = esp[-2]; + bif_args[2] = esp[-3]; + t = (*bif)(build_proc, bif_args); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -2846,7 +2864,9 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) Uint new_sz = offset + db_size_dbterm_comp(tb, obj); byte* basep; DbTerm* newp; +#ifdef DEBUG byte* top; +#endif ASSERT(tb->compress); if (old != 0) { @@ -2868,7 +2888,10 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) } newp->size = size_object(obj); - top = copy_to_comp(tb, obj, newp, new_sz); +#ifdef DEBUG + top = +#endif + copy_to_comp(tb, obj, newp, new_sz); ASSERT(top <= basep + new_sz); /* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */ @@ -4970,7 +4993,7 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) static Eterm seq_trace_fake(Process *p, Eterm arg1) { - Eterm result = seq_trace_info_1(p,arg1); + Eterm result = erl_seq_trace_info(p, arg1); if (is_tuple(result) && *tuple_val(result) == 2) { return (tuple_val(result))[2]; } diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index bb1751d309..6a96e174e1 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -326,8 +326,10 @@ ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b) (T)->common.owner == (P)->id) /* Function prototypes */ -Eterm db_get_trace_control_word_0(Process *p); -Eterm db_set_trace_control_word_1(Process *p, Eterm val); +BIF_RETTYPE db_get_trace_control_word(Process* p); +BIF_RETTYPE db_set_trace_control_word(Process* p, Eterm tcw); +BIF_RETTYPE db_get_trace_control_word_0(BIF_ALIST_0); +BIF_RETTYPE db_set_trace_control_word_1(BIF_ALIST_1); void db_initialize_util(void); Eterm db_getkey(int keypos, Eterm obj); diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 401967a8de..ae0c9def90 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -28,6 +28,14 @@ # include "config.h" #endif +#define ERL_DRV_DEPRECATED_FUNC +#ifdef __GNUC__ +# if __GNUC__ >= 3 +# undef ERL_DRV_DEPRECATED_FUNC +# define ERL_DRV_DEPRECATED_FUNC __attribute__((deprecated)) +# endif +#endif + #ifdef SIZEOF_CHAR # define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR # undef SIZEOF_CHAR @@ -582,8 +590,11 @@ EXTERN long driver_async(ErlDrvPort ix, void* async_data, void (*async_free)(void*)); - -EXTERN int driver_async_cancel(unsigned int key); +/* + * driver_async_cancel() is deprecated. It is scheduled for removal + * in OTP-R16. For more information see the erl_driver(3) documentation. + */ +EXTERN int driver_async_cancel(unsigned int key) ERL_DRV_DEPRECATED_FUNC; /* Locks the driver in the machine "forever", there is no unlock function. Note that this is almost never useful, as an open diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c index dc578f6d2a..a49a155701 100644 --- a/erts/emulator/beam/erl_drv_thread.c +++ b/erts/emulator/beam/erl_drv_thread.c @@ -158,7 +158,9 @@ erl_drv_mutex_create(char *name) (sizeof(ErlDrvMutex) + (name ? sys_strlen(name) + 1 : 0))); if (dmtx) { - if (ethr_mutex_init(&dmtx->mtx) != 0) { + ethr_mutex_opt opt = ETHR_MUTEX_OPT_DEFAULT_INITER; + opt.posix_compliant = 1; + if (ethr_mutex_init_opt(&dmtx->mtx, &opt) != 0) { erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx); dmtx = NULL; } @@ -226,7 +228,9 @@ erl_drv_cond_create(char *name) (sizeof(ErlDrvCond) + (name ? sys_strlen(name) + 1 : 0))); if (dcnd) { - if (ethr_cond_init(&dcnd->cnd) != 0) { + ethr_cond_opt opt = ETHR_COND_OPT_DEFAULT_INITER; + opt.posix_compliant = 1; + if (ethr_cond_init_opt(&dcnd->cnd, &opt) != 0) { erts_free(ERTS_ALC_T_DRV_CND, (void *) dcnd); dcnd = NULL; } diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index e3445bcdc5..c29352a227 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -315,7 +315,12 @@ erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) if (is_non_value(result)) { if (p->freason == TRAP) { - cost = erts_garbage_collect(p, 0, p->def_arg_reg, p->arity); + #if HIPE + if (regs == NULL) { + regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array; + } + #endif + cost = erts_garbage_collect(p, 0, regs, p->arity); } else { cost = erts_garbage_collect(p, 0, regs, arity); } @@ -357,8 +362,6 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) } erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC); - ERTS_CHK_OFFHEAP(p); ErtsGcQuickSanityCheck(p); @@ -392,8 +395,6 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) trace_gc(p, am_gc_end); } - erts_smp_locked_activity_end(ERTS_ACTIVITY_GC); - if (erts_system_monitor_long_gc != 0) { Uint ms2, s2, us2; Sint t; @@ -477,7 +478,6 @@ erts_garbage_collect_hibernate(Process* p) p->gcstatus = p->status; p->status = P_GARBING; erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC); ErtsGcQuickSanityCheck(p); ASSERT(p->mbuf_sz == 0); ASSERT(p->mbuf == 0); @@ -591,7 +591,6 @@ erts_garbage_collect_hibernate(Process* p) erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); p->status = p->gcstatus; erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_locked_activity_end(ERTS_ACTIVITY_GC); } @@ -616,7 +615,6 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size) p->gcstatus = p->status; p->status = P_GARBING; erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC); /* * We assume that the caller has already done a major collection @@ -719,7 +717,6 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size) erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); p->status = p->gcstatus; erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_locked_activity_end(ERTS_ACTIVITY_GC); } static int diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c index 8322b233ac..e7d4ac2b67 100644 --- a/erts/emulator/beam/erl_goodfit_alloc.c +++ b/erts/emulator/beam/erl_goodfit_alloc.c @@ -190,16 +190,20 @@ erts_gfalc_start(GFAllctr_t *gfallctr, GFAllctrInit_t *gfinit, AllctrInit_t *init) { - GFAllctr_t nulled_state = {{0}}; - /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc - warning. gcc warns if {0} is used as initializer of a struct when - the first member is a struct (not if, for example, the third member - is a struct). */ + struct { + int dummy; + GFAllctr_t allctr; + } zero = {0}; + /* The struct with a dummy element first is used in order to avoid (an + incorrect) gcc warning. gcc warns if {0} is used as initializer of + a struct when the first member is a struct (not if, for example, + the third member is a struct). */ + Allctr_t *allctr = (Allctr_t *) gfallctr; - init->sbmbct = 0; /* Small mbc not yet supported by goodfit */ + sys_memcpy((void *) gfallctr, (void *) &zero.allctr, sizeof(GFAllctr_t)); - sys_memcpy((void *) gfallctr, (void *) &nulled_state, sizeof(GFAllctr_t)); + init->sbmbct = 0; /* Small mbc not yet supported by goodfit */ allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 8a297cded0..7c047891d9 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -42,6 +42,9 @@ #include "erl_misc_utils.h" #include "packet_parser.h" #include "erl_cpu_topology.h" +#include "erl_thr_progress.h" +#include "erl_thr_queue.h" +#include "erl_async.h" #ifdef HIPE #include "hipe_mode_switch.h" /* for hipe_mode_switch_init() */ @@ -68,6 +71,8 @@ static void erl_init(int ncpu); #define ERTS_MIN_COMPAT_REL 7 +static erts_atomic_t exiting; + #ifdef ERTS_SMP erts_smp_atomic32_t erts_writing_erl_crash_dump; erts_tsd_key_t erts_is_crash_dumping_key; @@ -99,8 +104,6 @@ int erts_backtrace_depth; /* How many functions to show in a backtrace * in error codes. */ -int erts_async_max_threads; /* number of threads for async support */ -int erts_async_thread_suggested_stack_size; erts_smp_atomic32_t erts_max_gen_gcs; Eterm erts_error_logger_warnings; /* What to map warning logs to, am_error, @@ -247,10 +250,6 @@ erl_init(int ncpu) { init_benchmarking(); -#ifdef ERTS_SMP - erts_system_block_init(); -#endif - erts_init_monitors(); erts_init_gc(); erts_init_time(); @@ -260,6 +259,8 @@ erl_init(int ncpu) no_schedulers, no_schedulers_online); erts_init_cpu_topology(); /* Must be after init_scheduling */ + erts_alloc_late_init(); + H_MIN_SIZE = erts_next_heap_size(H_MIN_SIZE, 0); BIN_VH_MIN_SIZE = erts_next_heap_size(BIN_VH_MIN_SIZE, 0); @@ -281,6 +282,7 @@ erl_init(int ncpu) erts_init_node_tables(); init_dist(); erl_drv_thr_init(); + erts_init_async(); init_io(); init_copy(); init_load(); @@ -607,6 +609,8 @@ early_init(int *argc, char **argv) /* int max_main_threads; int max_reader_groups; int reader_groups; + char envbuf[21]; /* enough for any 64-bit integer */ + size_t envbufsz; use_multi_run_queue = 1; erts_printf_eterm_func = erts_printf_term; @@ -644,6 +648,10 @@ early_init(int *argc, char **argv) /* erts_use_r9_pids_ports = 0; erts_sys_pre_init(); + erts_atomic_init_nob(&exiting, 0); +#ifdef ERTS_SMP + erts_thr_progress_pre_init(); +#endif #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_init(); @@ -675,6 +683,16 @@ early_init(int *argc, char **argv) /* schdlrs = no_schedulers; schdlrs_onln = no_schedulers_online; + envbufsz = sizeof(envbuf); + + /* erts_sys_getenv() not initialized yet; need erts_sys_getenv__() */ + if (erts_sys_getenv__("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 0) + erts_async_max_threads = atoi(envbuf); + else + erts_async_max_threads = 0; + if (erts_async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS) + erts_async_max_threads = ERTS_MAX_NO_OF_ASYNC_THREADS; + if (argc && argv) { int i = 1; while (i < *argc) { @@ -702,6 +720,20 @@ early_init(int *argc, char **argv) /* } break; } + case 'A': { + /* set number of threads in thread pool */ + char *arg = get_arg(argv[i]+2, argv[i+1], &i); + if (((erts_async_max_threads = atoi(arg)) < 0) || + (erts_async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS)) { + erts_fprintf(stderr, + "bad number of async threads %s\n", + arg); + erts_usage(); + VERBOSE(DEBUG_SYSTEM, ("using %d async-threads\n", + erts_async_max_threads)); + } + break; + } case 'S' : { int tot, onln; char *arg = get_arg(argv[i]+2, argv[i+1], &i); @@ -767,11 +799,29 @@ early_init(int *argc, char **argv) /* erts_no_schedulers = (Uint) no_schedulers; #endif + erts_early_init_scheduling(no_schedulers); + alloc_opts.ncpu = ncpu; erts_alloc_init(argc, argv, &alloc_opts); /* Handles (and removes) -M flags. */ /* Require allocators */ - erts_early_init_scheduling(); +#ifdef ERTS_SMP + /* + * Thread progress management: + * + * * Managed threads: + * ** Scheduler threads (see erl_process.c) + * ** Aux thread (see erl_process.c) + * ** Sys message dispatcher thread (see erl_trace.c) + * + * * Unmanaged threads that need to register: + * ** Async threads (see erl_async.c) + */ + erts_thr_progress_init(no_schedulers, + no_schedulers+2, + erts_async_max_threads); +#endif + erts_thr_q_init(); erts_init_utils(); erts_early_init_cpu_topology(no_schedulers, &max_main_threads, @@ -851,7 +901,6 @@ erl_start(int argc, char **argv) int have_break_handler = 1; char envbuf[21]; /* enough for any 64-bit integer */ size_t envbufsz; - int async_max_threads = erts_async_max_threads; int ncpu = early_init(&argc, argv); envbufsz = sizeof(envbuf); @@ -867,11 +916,6 @@ erl_start(int argc, char **argv) (erts_aint32_t) max_gen_gcs); } - envbufsz = sizeof(envbuf); - if (erts_sys_getenv("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 0) { - async_max_threads = atoi(envbuf); - } - #if (defined(__APPLE__) && defined(__MACH__)) || defined(__DARWIN__) /* * The default stack size on MacOS X is too small for pcre. @@ -1301,17 +1345,8 @@ erl_start(int argc, char **argv) break; } - case 'A': - /* set number of threads in thread pool */ - arg = get_arg(argv[i]+2, argv[i+1], &i); - if (((async_max_threads = atoi(arg)) < 0) || - (async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS)) { - erts_fprintf(stderr, "bad number of async threads %s\n", arg); - erts_usage(); - } - - VERBOSE(DEBUG_SYSTEM, ("using %d async-threads\n", - async_max_threads)); + case 'A': /* Was handled in early init just read past it */ + (void) get_arg(argv[i]+2, argv[i+1], &i); break; case 'a': @@ -1400,10 +1435,6 @@ erl_start(int argc, char **argv) i++; } -#ifdef USE_THREADS - erts_async_max_threads = async_max_threads; -#endif - /* Delayed check of +P flag */ if (erts_max_processes < ERTS_MIN_PROCESSES || erts_max_processes > ERTS_MAX_PROCESSES @@ -1449,6 +1480,10 @@ erl_start(int argc, char **argv) erts_sys_main_thread(); /* May or may not return! */ #else erts_thr_set_main_status(1, 1); +#if ERTS_USE_ASYNC_READY_Q + erts_get_scheduler_data()->aux_work_data.async_ready.queue + = erts_get_async_ready_queue(1); +#endif set_main_stack_size(); process_main(); #endif @@ -1474,6 +1509,29 @@ __decl_noreturn void erts_thr_fatal_error(int err, char *what) static void system_cleanup(int exit_code) { + /* + * Make sure only one thread exits the runtime system. + */ + if (erts_atomic_inc_read_nob(&exiting) != 1) { + /* + * Another thread is currently exiting the system; + * wait for it to do its job. + */ +#ifdef ERTS_SMP + if (erts_thr_progress_is_managed_thread()) { + /* + * The exiting thread might be waiting for + * us to block; need to update status... + */ + erts_thr_progress_active(NULL, 0); + erts_thr_progress_prepare_wait(NULL); + } +#endif + /* Wait forever... */ + while (1) + erts_milli_sleep(10000000); + } + /* No cleanup wanted if ... * 1. we are about to do an abnormal exit * 2. we haven't finished initializing, or @@ -1493,7 +1551,6 @@ system_cleanup(int exit_code) #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_check_exact(NULL, 0); #endif - erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); /* We never release it... */ #endif #ifdef HYBRID @@ -1522,17 +1579,7 @@ system_cleanup(int exit_code) erts_cleanup_incgc(); #endif -#if defined(USE_THREADS) - exit_async(); -#endif -#if HAVE_ERTS_MSEG - erts_mseg_exit(); -#endif - - /* - * A lot more cleaning could/should have been done... - */ - + erts_exit_flush_async(); } /* @@ -1549,10 +1596,10 @@ __decl_noreturn void erl_exit0(char *file, int line, int n, char *fmt,...) va_start(args, fmt); - save_statistics(); - system_cleanup(n); + save_statistics(); + an = abs(n); if (erts_mtrace_enabled) @@ -1589,10 +1636,10 @@ __decl_noreturn void erl_exit(int n, char *fmt,...) va_start(args, fmt); - save_statistics(); - system_cleanup(n); + save_statistics(); + an = abs(n); if (erts_mtrace_enabled) diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 587d82f2bb..44da6b6c51 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -110,10 +110,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "fun_tab", NULL }, { "environ", NULL }, #endif - { "asyncq", "address" }, -#ifndef ERTS_SMP - { "async_ready", NULL }, -#endif { "efile_drv", "address" }, #if defined(ENABLE_CHILD_WAITER_THREAD) || defined(ERTS_SMP) { "child_status", NULL }, @@ -125,7 +121,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "drv_ev_state", "address" }, { "safe_hash", "address" }, { "pollset_rm_list", NULL }, - { "removed_fd_pre_alloc_lock", NULL }, + { "removed_fd_pre_alloc_lock", "address" }, { "state_prealloc", NULL }, { "schdlr_sspnd", NULL }, { "run_queue", "address" }, @@ -138,6 +134,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "alcu_init_atoms", NULL }, { "mseg_init_atoms", NULL }, { "drv_tsd", NULL }, + { "async_enq_mtx", NULL }, #ifdef ERTS_SMP { "sys_msg_q", NULL }, { "atom_tab", NULL }, @@ -151,10 +148,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "mtrace_op", NULL }, { "instr_x", NULL }, { "instr", NULL }, - { "fix_alloc", "index" }, { "alcu_allocator", "index" }, { "sbmbc_alloc", "index" }, - { "alcu_delayed_free", "index" }, { "mseg", NULL }, #if HALFWORD_HEAP { "pmmap", NULL }, @@ -175,15 +170,12 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "timeofday", NULL }, { "breakpoints", NULL }, { "pollsets_lock", NULL }, - { "async_id", NULL }, { "pix_lock", "address" }, { "run_queues_lists", NULL }, - { "misc_aux_work_queue", "index" }, - { "misc_aux_work_pre_alloc_lock", "address" }, { "sched_stat", NULL }, { "run_queue_sleep_list", "address" }, #endif - { "alloc_thr_ix_lock", NULL }, + { "async_init_mtx", NULL }, #ifdef ERTS_SMP { "proc_lck_qs_alloc", NULL }, #endif diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index 47597f302b..1a84950120 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -948,8 +948,10 @@ static void erts_dump_links(ErtsLink *root, int indent) erts_destroy_tmp_dsbuf(dsbufp); } -Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid) +Eterm erts_debug_dump_monitors_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm pid = BIF_ARG_1; Process *rp; DistEntry *dep; rp = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid, ERTS_PROC_LOCK_LINK); @@ -976,8 +978,10 @@ Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid) } } -Eterm erts_debug_dump_links_1(Process *p, Eterm pid) +Eterm erts_debug_dump_links_1(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm pid = BIF_ARG_1; Process *rp; DistEntry *dep; if (is_internal_port(pid)) { diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c index b1478758a1..358c67bf20 100644 --- a/erts/emulator/beam/erl_mtrace.c +++ b/erts/emulator/beam/erl_mtrace.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2010. All Rights Reserved. + * Copyright Ericsson AB 2003-2011. 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 @@ -503,12 +503,6 @@ write_trace_header(char *nodename, char *pid, char *hostname) case ERTS_ALC_A_SYSTEM: PUT_UI16(tracep, ERTS_MTRACE_SEGMENT_ID); break; - case ERTS_ALC_A_FIXED_SIZE: - if (erts_allctrs_info[ERTS_FIX_CORE_ALLOCATOR].enabled) - PUT_UI16(tracep, ERTS_FIX_CORE_ALLOCATOR); - else - PUT_UI16(tracep, ERTS_ALC_A_SYSTEM); - break; default: PUT_UI16(tracep, ERTS_MTRACE_SEGMENT_ID); break; diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 51f1fad811..62798bb2c1 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -32,6 +32,7 @@ #include "error.h" #include "big.h" #include "beam_bp.h" +#include "erl_thr_progress.h" #include <limits.h> #include <stddef.h> /* offsetof */ @@ -130,10 +131,13 @@ static void pre_nif_noproc(ErlNifEnv* env, struct erl_module_nif* mod_nif) env->tmp_obj_list = NULL; } -/* Temporary object header, auto-deallocated when NIF returns. */ +/* Temporary object header, auto-deallocated when NIF returns + * or when independent environment is cleared. + */ struct enif_tmp_obj_t { struct enif_tmp_obj_t* next; void (*dtor)(struct enif_tmp_obj_t*); + ErtsAlcType_t allocator; /*char data[];*/ }; @@ -244,7 +248,7 @@ ErlNifEnv* enif_alloc_env(void) msg_env->env.hp_end = phony_heap; msg_env->env.heap_frag = NULL; msg_env->env.mod_nif = NULL; - msg_env->env.tmp_obj_list = (struct enif_tmp_obj_t*) 1; /* invalid non-NULL */ + msg_env->env.tmp_obj_list = NULL; msg_env->env.proc = &msg_env->phony_proc; memset(&msg_env->phony_proc, 0, sizeof(Process)); HEAP_START(&msg_env->phony_proc) = phony_heap; @@ -289,6 +293,7 @@ void enif_clear_env(ErlNifEnv* env) menv->env.hp = menv->env.hp_end = HEAP_TOP(p); ASSERT(!is_offheap(&MSO(p))); + free_tmp_objs(env); } int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg) @@ -440,24 +445,31 @@ int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term) return is_number(term); } +static ERTS_INLINE int is_proc_bound(ErlNifEnv* env) +{ + return env->mod_nif != NULL; +} + static void aligned_binary_dtor(struct enif_tmp_obj_t* obj) { - erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP); + erts_free_aligned_binary_bytes_extra((byte*)obj, obj->allocator); } int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) { + ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF; union { struct enif_tmp_obj_t* tmp; byte* raw_ptr; }u; u.tmp = NULL; - bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, ERTS_ALC_T_TMP, + bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, allocator, sizeof(struct enif_tmp_obj_t)); if (bin->data == NULL) { return 0; } if (u.tmp != NULL) { + u.tmp->allocator = allocator; u.tmp->next = env->tmp_obj_list; u.tmp->dtor = &aligned_binary_dtor; env->tmp_obj_list = u.tmp; @@ -471,12 +483,13 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) static void tmp_alloc_dtor(struct enif_tmp_obj_t* obj) { - erts_free(ERTS_ALC_T_TMP, obj); + erts_free(obj->allocator, obj); } int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin) { struct enif_tmp_obj_t* tobj; + ErtsAlcType_t allocator; Uint sz; if (is_binary(term)) { return enif_inspect_binary(env,term,bin); @@ -491,8 +504,10 @@ int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin) if (erts_iolist_size(term, &sz)) { return 0; } - - tobj = erts_alloc(ERTS_ALC_T_TMP, sz + sizeof(struct enif_tmp_obj_t)); + + allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF; + tobj = erts_alloc(allocator, sz + sizeof(struct enif_tmp_obj_t)); + tobj->allocator = allocator; tobj->next = env->tmp_obj_list; tobj->dtor = &tmp_alloc_dtor; env->tmp_obj_list = tobj; @@ -681,6 +696,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ErlSubBin* sb; Eterm orig; Uint offset, bit_offset, bit_size; +#ifdef DEBUG unsigned src_size; ASSERT(is_binary(bin_term)); @@ -688,6 +704,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ASSERT(pos <= src_size); ASSERT(size <= src_size); ASSERT(pos + size <= src_size); +#endif sb = (ErlSubBin*) alloc_heap(env, ERL_SUB_BIN_SIZE); ERTS_GET_REAL_BIN(bin_term, orig, offset, bit_offset, bit_size); sb->thing_word = HEADER_SUB_BIN; @@ -1188,7 +1205,7 @@ enif_open_resource_type(ErlNifEnv* env, ErlNifResourceFlags op = flags; Eterm module_am, name_am; - ASSERT(erts_smp_is_system_blocked(0)); + ASSERT(erts_smp_thr_progress_is_blocking()); ASSERT(module_str == NULL); /* for now... */ module_am = make_atom(env->mod_nif->mod->module); name_am = enif_make_atom(env, name_str); @@ -1482,7 +1499,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) /* Block system (is this the right place to do it?) */ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); /* Find calling module */ ASSERT(BIF_P->current != NULL); @@ -1671,7 +1688,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) erts_sys_ddll_free_error(&errdesc); } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_free(ERTS_ALC_T_TMP, lib_name); BIF_RET(ret); @@ -1683,7 +1700,7 @@ erts_unload_nif(struct erl_module_nif* lib) { ErlNifResourceType* rt; ErlNifResourceType* next; - ASSERT(erts_smp_is_system_blocked(0)); + ASSERT(erts_smp_thr_progress_is_blocking()); ASSERT(lib != NULL); ASSERT(lib->mod != NULL); for (rt = resource_type_list.next; @@ -1743,8 +1760,10 @@ struct readonly_check_t }; static void add_readonly_check(ErlNifEnv* env, unsigned char* ptr, unsigned sz) { - struct readonly_check_t* obj = erts_alloc(ERTS_ALC_T_TMP, + ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF; + struct readonly_check_t* obj = erts_alloc(allocator, sizeof(struct readonly_check_t)); + obj->hdr.allocator = allocator; obj->hdr.next = env->tmp_obj_list; env->tmp_obj_list = &obj->hdr; obj->hdr.dtor = &readonly_check_dtor; @@ -1761,7 +1780,7 @@ static void readonly_check_dtor(struct enif_tmp_obj_t* o) " %x != %x\r\nABORTING\r\n", chksum, obj->checksum); abort(); } - erts_free(ERTS_ALC_T_TMP, obj); + erts_free(obj->hdr.allocator, obj); } static unsigned calc_checksum(unsigned char* ptr, unsigned size) { diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 18f2c022eb..6396af09d0 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -266,6 +266,199 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); */ #endif + +#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) + +/* Inline functions for compile time type checking of arguments to + variadic functions. +*/ + +# define ERL_NIF_INLINE __inline__ + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_tuple(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_tuple(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_tuple(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_tuple(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_tuple(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_tuple(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_tuple(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_tuple(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_tuple(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_list(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_list(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_list(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_list(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_list(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_list(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_list(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_list(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_list(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +# undef ERL_NIF_INLINE + +#else /* fallback with macros */ + #ifndef enif_make_list1 # define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1) # define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2) @@ -285,6 +478,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); # define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7) # define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8) # define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) +#endif + +#endif /* __GNUC__ && !WIN32 */ + +#ifndef enif_make_pid # define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid)) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index af3873995e..908ba755ed 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -26,6 +26,7 @@ #include "dist.h" #include "big.h" #include "error.h" +#include "erl_thr_progress.h" Hash erts_dist_table; Hash erts_node_table; @@ -907,7 +908,7 @@ erts_get_node_and_dist_references(struct process *proc) #endif erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); /* No need to lock any thing since we are alone... */ if (references_atoms_need_init) { @@ -951,7 +952,7 @@ erts_get_node_and_dist_references(struct process *proc) delete_reference_table(); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); return res; } diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 6aa5161b08..87b8e5131b 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -711,23 +711,6 @@ typedef struct { int *resp; } ErtsPortTaskExeBlockData; -static void -prepare_for_block(void *vd) -{ - ErtsPortTaskExeBlockData *d = (ErtsPortTaskExeBlockData *) vd; - erts_smp_runq_unlock(d->runq); -} - -static void -resume_after_block(void *vd) -{ - ErtsPortTaskExeBlockData *d = (ErtsPortTaskExeBlockData *) vd; - erts_smp_runq_lock(d->runq); - if (d->resp) - *d->resp = (erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks) - != (erts_aint_t) 0); -} - /* * Run all scheduled tasks for the first port in run queue. If * new tasks appear while running reschedule port (free task is @@ -752,11 +735,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); - erts_smp_activity_begin(ERTS_ACTIVITY_IO, - prepare_for_block, - resume_after_block, - (void *) &blk_data); - ERTS_PT_CHK_PORTQ(runq); pp = pop_port(runq); @@ -988,10 +966,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) done: blk_data.resp = &res; - erts_smp_activity_end(ERTS_ACTIVITY_IO, - prepare_for_block, - resume_after_block, - (void *) &blk_data); ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 5ceb4ce9a8..a3c1c9577b 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -39,6 +39,9 @@ #include "erl_binary.h" #include "beam_bp.h" #include "erl_cpu_topology.h" +#include "erl_thr_progress.h" +#include "erl_thr_queue.h" +#include "erl_async.h" #define ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED (2000*CONTEXT_REDS) #define ERTS_RUNQ_CALL_CHECK_BALANCE_REDS \ @@ -124,9 +127,10 @@ ErtsLcPSDLocks erts_psd_required_locks[ERTS_PSD_SIZE]; #endif #ifdef ERTS_SMP - int erts_disable_proc_not_running_opt; +static ErtsAuxWorkData *aux_thread_aux_work_data; + #define ERTS_SCHDLR_SSPND_CHNG_WAITER (((erts_aint32_t) 1) << 0) #define ERTS_SCHDLR_SSPND_CHNG_MSB (((erts_aint32_t) 1) << 1) #define ERTS_SCHDLR_SSPND_CHNG_ONLN (((erts_aint32_t) 1) << 2) @@ -213,8 +217,6 @@ Uint erts_no_run_queues; ErtsAlignedSchedulerData *erts_aligned_scheduler_data; -#ifdef ERTS_SMP - typedef union { ErtsSchedulerSleepInfo ssi; char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsSchedulerSleepInfo))]; @@ -222,8 +224,6 @@ typedef union { static ErtsAlignedSchedulerSleepInfo *aligned_sched_sleep_info; -#endif - #ifndef BM_COUNTERS static int processes_busy; #endif @@ -285,8 +285,9 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(proclist, ERTS_ALC_T_PROC_LIST) #define ERTS_SCHED_SLEEP_INFO_IX(IX) \ - (ASSERT_EXPR(0 <= (IX) && (IX) < erts_no_schedulers), \ - &aligned_sched_sleep_info[(IX)].ssi) + (ASSERT_EXPR(-1 <= ((int) (IX)) \ + && ((int) (IX)) < ((int) erts_no_schedulers)), \ + &aligned_sched_sleep_info[(IX)].ssi) #define ERTS_FOREACH_RUNQ(RQVAR, DO) \ do { \ @@ -339,6 +340,66 @@ static void exec_misc_ops(ErtsRunQueue *); static void print_function_from_pc(int to, void *to_arg, BeamInstr* x); static int stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg); + +static void aux_work_timeout(void *unused); +static void aux_work_timeout_early_init(int no_schedulers); +static void aux_work_timeout_late_init(void); +static void setup_aux_work_timer(void); + +#if defined(DEBUG) || 0 +#define ERTS_DBG_CHK_AUX_WORK_VAL(V) dbg_chk_aux_work_val((V)) +static void +dbg_chk_aux_work_val(erts_aint32_t value) +{ + erts_aint32_t valid = 0; + +#ifdef ERTS_SSI_AUX_WORK_SET_TMO + valid |= ERTS_SSI_AUX_WORK_SET_TMO; +#endif +#ifdef ERTS_SSI_AUX_WORK_CHECK_CHILDREN + valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN; +#endif +#ifdef ERTS_SSI_AUX_WORK_MISC + valid |= ERTS_SSI_AUX_WORK_MISC; +#endif +#ifdef ERTS_SSI_AUX_WORK_MISC_THR_PRGR + valid |= ERTS_SSI_AUX_WORK_MISC_THR_PRGR; +#endif +#ifdef ERTS_SSI_AUX_WORK_ASYNC_READY + valid |= ERTS_SSI_AUX_WORK_ASYNC_READY; +#endif +#ifdef ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN + valid |= ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; +#endif + +#ifdef ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + valid |= ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM; +#endif +#ifdef ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC + valid |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC; +#endif +#ifdef ERTS_SSI_AUX_WORK_DD + valid |= ERTS_SSI_AUX_WORK_DD; +#endif +#ifdef ERTS_SSI_AUX_WORK_DD + valid |= ERTS_SSI_AUX_WORK_DD_THR_PRGR; +#endif +#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK + valid |= ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK; +#endif + + if (~valid & value) + erl_exit(ERTS_ABORT_EXIT, + "Invalid aux_work value found: 0x%x\n", + ~valid & value); +} +#define ERTS_DBG_CHK_SSI_AUX_WORK(SSI) \ + ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&(SSI)->aux_work)) +#else +#define ERTS_DBG_CHK_AUX_WORK_VAL(V) +#define ERTS_DBG_CHK_SSI_AUX_WORK(SSI) +#endif + #ifdef ERTS_SMP static void handle_pending_exiters(ErtsProcList *); @@ -577,6 +638,13 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags) case ERTS_SSI_FLG_POLL_SLEEPING: erts_sys_schedule_interrupt(1); break; + case ERTS_SSI_FLG_POLL_SLEEPING|ERTS_SSI_FLG_TSE_SLEEPING: + /* + * Thread progress blocking while poll sleeping; need + * to signal on both... + */ + erts_sys_schedule_interrupt(1); + /* fall through */ case ERTS_SSI_FLG_TSE_SLEEPING: erts_tse_set(ssi->event); break; @@ -589,189 +657,712 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags) } } +#endif + +static ERTS_INLINE void +set_aux_work_flags_wakeup_nob(ErtsSchedulerSleepInfo *ssi, + erts_aint32_t flgs) +{ + erts_aint32_t old_flgs; + + ERTS_DBG_CHK_SSI_AUX_WORK(ssi); + + old_flgs = erts_atomic32_read_nob(&ssi->aux_work); + if ((old_flgs & flgs) == 0) { + + old_flgs = erts_atomic32_read_bor_nob(&ssi->aux_work, flgs); + + if ((old_flgs & flgs) == 0) { +#ifdef ERTS_SMP + erts_sched_poke(ssi); +#else + erts_sys_schedule_interrupt(1); +#endif + } + } +} + +#if 0 /* Currently not used */ + +static ERTS_INLINE void +set_aux_work_flags_wakeup_relb(ErtsSchedulerSleepInfo *ssi, + erts_aint32_t flgs) +{ + erts_aint32_t old_flgs; + + ERTS_DBG_CHK_SSI_AUX_WORK(ssi); + + old_flgs = erts_atomic32_read_bor_relb(&ssi->aux_work, flgs); + + if ((old_flgs & flgs) == 0) { +#ifdef ERTS_SMP + erts_sched_poke(ssi); +#else + erts_sys_schedule_interrupt(1); +#endif + } +} + +#endif + +static ERTS_INLINE erts_aint32_t +set_aux_work_flags(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flgs) +{ + return erts_atomic32_read_bor_nob(&ssi->aux_work, flgs); +} + +static ERTS_INLINE erts_aint32_t +unset_aux_work_flags(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flgs) +{ + return erts_atomic32_read_band_nob(&ssi->aux_work, ~flgs); +} + typedef struct erts_misc_aux_work_t_ erts_misc_aux_work_t; struct erts_misc_aux_work_t_ { - erts_misc_aux_work_t *next; void (*func)(void *); void *arg; }; -typedef struct { - erts_smp_mtx_t mtx; - erts_misc_aux_work_t *first; - erts_misc_aux_work_t *last; -} erts_misc_aux_work_q_t; +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(misc_aux_work, + erts_misc_aux_work_t, + 200, + ERTS_ALC_T_MISC_AUX_WORK) typedef union { - erts_misc_aux_work_q_t data; - char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_misc_aux_work_q_t))]; + ErtsThrQ_t q; + char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrQ_t))]; } erts_algnd_misc_aux_work_q_t; static erts_algnd_misc_aux_work_q_t *misc_aux_work_queues; -ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(misc_aux_work, - erts_misc_aux_work_t, - 200, - ERTS_ALC_T_MISC_AUX_WORK) +static void +notify_aux_work(void *vssi) +{ + set_aux_work_flags_wakeup_nob((ErtsSchedulerSleepInfo *) vssi, + ERTS_SSI_AUX_WORK_MISC); +} static void init_misc_aux_work(void) { int ix; + ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT; + qinit.notify = notify_aux_work; init_misc_aux_work_alloc(); misc_aux_work_queues = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_MISC_AUX_WORK_Q, - erts_no_schedulers * - sizeof(erts_algnd_misc_aux_work_q_t)); + sizeof(erts_algnd_misc_aux_work_q_t) + * (erts_no_schedulers+1)); + +#ifdef ERTS_SMP + ix = 0; /* aux_thread + schedulers */ +#else + ix = 1; /* scheduler only */ +#endif - for (ix = 0; ix < erts_no_schedulers; ix++) { - erts_smp_mtx_init_x(&misc_aux_work_queues[ix].data.mtx, - "misc_aux_work_queue", - make_small(ix + 1)); - misc_aux_work_queues[ix].data.first = NULL; - misc_aux_work_queues[ix].data.last = NULL; + for (; ix <= erts_no_schedulers; ix++) { + qinit.arg = (void *) ERTS_SCHED_SLEEP_INFO_IX(ix-1); + erts_thr_q_initialize(&misc_aux_work_queues[ix].q, &qinit); } } -static void -handle_misc_aux_work(ErtsSchedulerData *esdp) -{ - int ix = (int) esdp->no - 1; - erts_misc_aux_work_t *mawp; +static erts_aint32_t +misc_aux_work_clean(ErtsThrQ_t *q, + ErtsAuxWorkData *awdp, + erts_aint32_t aux_work) +{ + switch (erts_thr_q_clean(q)) { + case ERTS_THR_Q_DIRTY: + set_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC); + return aux_work | ERTS_SSI_AUX_WORK_MISC; +#ifdef ERTS_SMP + case ERTS_THR_Q_NEED_THR_PRGR: + set_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC_THR_PRGR); + erts_thr_progress_wakeup(awdp->esdp, + erts_thr_q_need_thr_progress(q)); +#endif + case ERTS_THR_Q_CLEAN: + break; + } + return aux_work; +} - erts_smp_mtx_lock(&misc_aux_work_queues[ix].data.mtx); - mawp = misc_aux_work_queues[ix].data.first; - misc_aux_work_queues[ix].data.first = NULL; - misc_aux_work_queues[ix].data.last = NULL; - erts_smp_mtx_unlock(&misc_aux_work_queues[ix].data.mtx); +static erts_aint32_t +handle_misc_aux_work(ErtsAuxWorkData *awdp, + erts_aint32_t aux_work) +{ + ErtsThrQ_t *q = &misc_aux_work_queues[awdp->sched_id].q; - while (mawp) { - erts_misc_aux_work_t *free_mawp; + unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC); + while (1) { + erts_misc_aux_work_t *mawp = erts_thr_q_dequeue(q); + if (!mawp) + break; mawp->func(mawp->arg); - free_mawp = mawp; - mawp = mawp->next; - misc_aux_work_free(free_mawp); + misc_aux_work_free(mawp); } + + return misc_aux_work_clean(q, awdp, aux_work & ~ERTS_SSI_AUX_WORK_MISC); +} + +#ifdef ERTS_SMP + +static erts_aint32_t +handle_misc_aux_work_thr_prgr(ErtsAuxWorkData *awdp, + erts_aint32_t aux_work) +{ + if (!erts_thr_progress_has_reached(awdp->misc.thr_prgr)) + return aux_work; + + unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC_THR_PRGR); + + return misc_aux_work_clean(&misc_aux_work_queues[awdp->sched_id].q, + awdp, + aux_work & ~ERTS_SSI_AUX_WORK_MISC_THR_PRGR); +} + +#endif + +static ERTS_INLINE void +schedule_misc_aux_work(int sched_id, + void (*func)(void *), + void *arg) +{ + ErtsThrQ_t *q; + erts_misc_aux_work_t *mawp; + +#ifdef ERTS_SMP + ASSERT(0 <= sched_id && sched_id <= erts_no_schedulers); +#else + ASSERT(sched_id == 1); +#endif + + q = &misc_aux_work_queues[sched_id].q; + mawp = misc_aux_work_alloc(); + mawp->func = func; + mawp->arg = arg; + erts_thr_q_enqueue(q, mawp); +} + +void +erts_schedule_misc_aux_work(int sched_id, + void (*func)(void *), + void *arg) +{ + schedule_misc_aux_work(sched_id, func, arg); } void -erts_smp_schedule_misc_aux_work(int ignore_self, - int max_sched, - void (*func)(void *), - void *arg) +erts_schedule_multi_misc_aux_work(int ignore_self, + int max_sched, + void (*func)(void *), + void *arg) { - int ix, ignore_ix = -1; + int id, self = 0; if (ignore_self) { ErtsSchedulerData *esdp = erts_get_scheduler_data(); if (esdp) - ignore_ix = (int) esdp->no - 1; + self = (int) esdp->no; } - ASSERT(0 <= max_sched && max_sched <= erts_no_schedulers); + ASSERT(0 < max_sched && max_sched <= erts_no_schedulers); - for (ix = 0; ix < max_sched; ix++) { - erts_aint32_t aux_work; - erts_misc_aux_work_t *mawp; - ErtsSchedulerSleepInfo *ssi; - if (ix == ignore_ix) + for (id = 1; id <= max_sched; id++) { + if (id == self) continue; + schedule_misc_aux_work(id, func, arg); + } +} - mawp = misc_aux_work_alloc(); +#if ERTS_USE_ASYNC_READY_Q - mawp->func = func; - mawp->arg = arg; - mawp->next = NULL; +void +erts_notify_check_async_ready_queue(void *vno) +{ + int ix = ((int) (SWord) vno) -1; + set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(ix), + ERTS_SSI_AUX_WORK_ASYNC_READY); +} - erts_smp_mtx_lock(&misc_aux_work_queues[ix].data.mtx); - if (!misc_aux_work_queues[ix].data.last) - misc_aux_work_queues[ix].data.first = mawp; - else - misc_aux_work_queues[ix].data.last->next = mawp; - misc_aux_work_queues[ix].data.last = mawp; - erts_smp_mtx_unlock(&misc_aux_work_queues[ix].data.mtx); - - ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); - aux_work = erts_smp_atomic32_read_bor_nob(&ssi->aux_work, - ERTS_SSI_AUX_WORK_MISC); - if ((aux_work & ERTS_SSI_AUX_WORK_MISC) == 0) - erts_sched_poke(ssi); - } +static erts_aint32_t +handle_async_ready(ErtsAuxWorkData *awdp, + erts_aint32_t aux_work) +{ + ErtsSchedulerSleepInfo *ssi = awdp->ssi; + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY); + if (erts_check_async_ready(awdp->async_ready.queue)) { + if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY) + & ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN) { + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN); + aux_work &= ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; + } + return aux_work; + } +#ifdef ERTS_SMP + awdp->async_ready.need_thr_prgr = 0; +#endif + set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN); + return ((aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY) + | ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN); } +static erts_aint32_t +handle_async_ready_clean(ErtsAuxWorkData *awdp, + erts_aint32_t aux_work) +{ + void *thr_prgr_p; + +#ifdef ERTS_SMP + if (awdp->async_ready.need_thr_prgr + && !erts_thr_progress_has_reached(awdp->misc.thr_prgr)) { + return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; + } + + awdp->async_ready.need_thr_prgr = 0; + thr_prgr_p = (void *) &awdp->async_ready.thr_prgr; +#else + thr_prgr_p = NULL; +#endif + + switch (erts_async_ready_clean(awdp->async_ready.queue, thr_prgr_p)) { + case ERTS_ASYNC_READY_CLEAN: + unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN); + return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; +#ifdef ERTS_SMP + case ERTS_ASYNC_READY_NEED_THR_PRGR: + erts_thr_progress_wakeup(awdp->esdp, + awdp->async_ready.thr_prgr); + awdp->async_ready.need_thr_prgr = 1; +#endif + default: + return aux_work; + } +} + +#endif + +static erts_aint32_t +handle_fix_alloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) +{ + ErtsSchedulerSleepInfo *ssi = awdp->ssi; + erts_aint32_t res; + + unset_aux_work_flags(ssi, (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC)); + aux_work &= ~(ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC); + res = erts_alloc_fix_alloc_shrink(awdp->sched_id, aux_work); + if (res) { + set_aux_work_flags(ssi, res); + aux_work |= res; + } + + return aux_work; +} + +#ifdef ERTS_SMP + +void +erts_alloc_notify_delayed_dealloc(int ix) +{ + set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(ix-1), + ERTS_SSI_AUX_WORK_DD); +} + +static erts_aint32_t +handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) +{ + ErtsSchedulerSleepInfo *ssi = awdp->ssi; + int need_thr_progress = 0; + int more_work = 0; + + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD); + erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, + &need_thr_progress, + &more_work); + if (more_work) { + if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD) + & ERTS_SSI_AUX_WORK_DD_THR_PRGR) { + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR); + aux_work &= ~ERTS_SSI_AUX_WORK_DD_THR_PRGR; + } + return aux_work; + } + + if (need_thr_progress) { + set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR); + awdp->dd.thr_prgr = erts_thr_progress_later(); + erts_thr_progress_wakeup(awdp->esdp, awdp->dd.thr_prgr); + } + else if (awdp->dd.completed_callback) { + awdp->dd.completed_callback(awdp->dd.completed_arg); + awdp->dd.completed_callback = NULL; + awdp->dd.completed_arg = NULL; + } + return aux_work & ~ERTS_SSI_AUX_WORK_DD; +} + +static erts_aint32_t +handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) +{ + ErtsSchedulerSleepInfo *ssi; + int need_thr_progress; + int more_work; + + if (!erts_thr_progress_has_reached(awdp->dd.thr_prgr)) + return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR; + + ssi = awdp->ssi; + need_thr_progress = 0; + more_work = 0; + + erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, + &need_thr_progress, + &more_work); + if (more_work) { + set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD); + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR); + return ((aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR) + | ERTS_SSI_AUX_WORK_DD); + } + + if (need_thr_progress) { + awdp->dd.thr_prgr = erts_thr_progress_later(); + erts_thr_progress_wakeup(awdp->esdp, awdp->dd.thr_prgr); + } + else { + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR); + if (awdp->dd.completed_callback) { + awdp->dd.completed_callback(awdp->dd.completed_arg); + awdp->dd.completed_callback = NULL; + awdp->dd.completed_arg = NULL; + } + } + + return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR; +} + +static erts_atomic32_t completed_dealloc_count; + +static void +completed_dealloc(void *vproc) +{ + if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == 0) { + erts_resume((Process *) vproc, (ErtsProcLocks) 0); + erts_smp_proc_dec_refc((Process *) vproc); + } +} + +static void +setup_completed_dealloc(void *vproc) +{ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ErtsAuxWorkData *awdp = (esdp + ? &esdp->aux_work_data + : aux_thread_aux_work_data); + erts_alloc_fix_alloc_shrink(awdp->sched_id, 0); + set_aux_work_flags_wakeup_nob(awdp->ssi, ERTS_SSI_AUX_WORK_DD); + awdp->dd.completed_callback = completed_dealloc; + awdp->dd.completed_arg = vproc; +} + +static void +prep_setup_completed_dealloc(void *vproc) +{ + erts_aint32_t count = (erts_aint32_t) (erts_no_schedulers+1); + if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == count) { + /* scheduler threads */ + erts_schedule_multi_misc_aux_work(0, + erts_no_schedulers, + setup_completed_dealloc, + vproc); + /* aux_thread */ + erts_schedule_misc_aux_work(0, + setup_completed_dealloc, + vproc); + } +} + +#endif /* ERTS_SMP */ + +int +erts_debug_wait_deallocations(Process *c_p) +{ +#ifndef ERTS_SMP + erts_alloc_fix_alloc_shrink(1, 0); + return 1; +#else + /* Only one process at a time can do this */ + erts_aint32_t count = (erts_aint32_t) (2*(erts_no_schedulers+1)); + if (0 == erts_atomic32_cmpxchg_mb(&completed_dealloc_count, + count, + 0)) { + erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); + erts_smp_proc_inc_refc(c_p); + /* scheduler threads */ + erts_schedule_multi_misc_aux_work(0, + erts_no_schedulers, + prep_setup_completed_dealloc, + (void *) c_p); + /* aux_thread */ + erts_schedule_misc_aux_work(0, + prep_setup_completed_dealloc, + (void *) c_p); + return 1; + } + return 0; +#endif +} + + #ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN void erts_smp_notify_check_children_needed(void) { int i; + for (i = 0; i < erts_no_schedulers; i++) + set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(i), + ERTS_SSI_AUX_WORK_CHECK_CHILDREN); +} - for (i = 0; i < erts_no_schedulers; i++) { - erts_aint32_t aux_work; - ErtsSchedulerSleepInfo *ssi; - ssi = ERTS_SCHED_SLEEP_INFO_IX(i); - aux_work = erts_smp_atomic32_read_bor_nob(&ssi->aux_work, - ERTS_SSI_AUX_WORK_CHECK_CHILDREN); - if (!(aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN)) - erts_sched_poke(ssi); - } +static erts_aint32_t +handle_check_children(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) +{ + unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_CHECK_CHILDREN); + erts_check_children(); + return aux_work & ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN; +} + +#endif + +#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK + +static erts_aint32_t +handle_mseg_cache_check(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) +{ + unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK); + erts_mseg_cache_check(); + return aux_work & ~ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK; } + #endif -#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK +static erts_aint32_t +handle_setup_aux_work_timer(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) +{ + unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_SET_TMO); + setup_aux_work_timer(); + return aux_work & ~ERTS_SSI_AUX_WORK_SET_TMO; +} + static ERTS_INLINE erts_aint32_t -blockable_aux_work(ErtsSchedulerData *esdp, - ErtsSchedulerSleepInfo *ssi, - erts_aint32_t aux_work) +handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { - if (aux_work & ERTS_SSI_BLOCKABLE_AUX_WORK_MASK) { - if (aux_work & ERTS_SSI_AUX_WORK_MISC) { - aux_work = erts_smp_atomic32_read_band_nob(&ssi->aux_work, - ~ERTS_SSI_AUX_WORK_MISC); - aux_work &= ~ERTS_SSI_AUX_WORK_MISC; - handle_misc_aux_work(esdp); - } + /* + * Handlers are *only* allowed to modify flags in return value + * and ssi flags that are explicity handled by the handler. + * Handlers are, e.g., not allowed to read the ssi flag field and + * then unconditionally return that value. + */ + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + if (aux_work & ERTS_SSI_AUX_WORK_SET_TMO) { + aux_work = handle_setup_aux_work_timer(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } +#ifdef ERTS_SMP + if (aux_work & ERTS_SSI_AUX_WORK_MISC_THR_PRGR) { + aux_work = handle_misc_aux_work_thr_prgr(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } +#endif + if (aux_work & ERTS_SSI_AUX_WORK_MISC) { + aux_work = handle_misc_aux_work(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } +#if ERTS_USE_ASYNC_READY_Q + if (aux_work & ERTS_SSI_AUX_WORK_ASYNC_READY) { + aux_work = handle_async_ready(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } + if (aux_work & ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN) { + aux_work = handle_async_ready_clean(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } +#endif #ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN - if (aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN) { - aux_work = erts_smp_atomic32_band_nob(&ssi->aux_work, - ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN); - aux_work &= ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN; - erts_check_children(); - } + if (aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN) { + aux_work = handle_check_children(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } +#endif + if (aux_work & (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC)) { + aux_work = handle_fix_alloc(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } +#ifdef ERTS_SMP + if (aux_work & ERTS_SSI_AUX_WORK_DD) { + aux_work = handle_delayed_dealloc(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } + if (aux_work & ERTS_SSI_AUX_WORK_DD_THR_PRGR) { + aux_work = handle_delayed_dealloc_thr_prgr(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + } #endif +#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK + if (aux_work & ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK) { + aux_work = handle_mseg_cache_check(awdp, aux_work); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); } +#endif + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); return aux_work; } -#endif +typedef struct { + union { + ErlTimer data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErlTimer))]; + } timer; -#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK -static ERTS_INLINE erts_aint32_t -nonblockable_aux_work(ErtsSchedulerData *esdp, - ErtsSchedulerSleepInfo *ssi, - erts_aint32_t aux_work) + int initialized; + erts_atomic32_t refc; + erts_atomic32_t type[1]; +} ErtsAuxWorkTmo; + +static ErtsAuxWorkTmo *aux_work_tmo; + +static void +aux_work_timeout_early_init(int no_schedulers) { - if (aux_work & ERTS_SSI_NONBLOCKABLE_AUX_WORK_MASK) { + int i; + UWord p; + + /* + * This is done really early. Our own allocators have + * not been started yet. + */ + + p = (UWord) malloc((sizeof(ErtsAuxWorkTmo) + + sizeof(erts_atomic32_t)*(no_schedulers+1)) + + ERTS_CACHE_LINE_SIZE-1); + if (p & ERTS_CACHE_LINE_MASK) + p = (p & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE; + ASSERT((p & ERTS_CACHE_LINE_MASK) == 0); + + aux_work_tmo = (ErtsAuxWorkTmo *) p; + aux_work_tmo->initialized = 0; + erts_atomic32_init_nob(&aux_work_tmo->refc, 0); + for (i = 0; i <= no_schedulers; i++) + erts_atomic32_init_nob(&aux_work_tmo->type[i], 0); +} +void +aux_work_timeout_late_init(void) +{ + aux_work_tmo->initialized = 1; + if (erts_atomic32_read_nob(&aux_work_tmo->refc)) { + aux_work_tmo->timer.data.active = 0; + erts_set_timer(&aux_work_tmo->timer.data, + aux_work_timeout, + NULL, + NULL, + 1000); } } -#endif static void -prepare_for_block(void *vrq) +aux_work_timeout(void *unused) { - erts_smp_runq_unlock((ErtsRunQueue *) vrq); + erts_aint32_t refc; + int i; +#ifdef ERTS_SMP + i = 0; +#else + i = 1; +#endif + + for (; i <= erts_no_schedulers; i++) { + erts_aint32_t type; + type = erts_atomic32_read_acqb(&aux_work_tmo->type[i]); + if (type) + set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(i-1), + type); + } + + refc = erts_atomic32_read_nob(&aux_work_tmo->refc); + ASSERT(refc >= 1); + if (refc != 1 + || 1 != erts_atomic32_cmpxchg_relb(&aux_work_tmo->refc, 0, 1)) { + /* Setup next timeout... */ + aux_work_tmo->timer.data.active = 0; + erts_set_timer(&aux_work_tmo->timer.data, + aux_work_timeout, + NULL, + NULL, + 1000); + } } static void -resume_after_block(void *vrq) +setup_aux_work_timer(void) { - erts_smp_runq_lock((ErtsRunQueue *) vrq); +#ifndef ERTS_SMP + if (!erts_get_scheduler_data()) + set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(0), + ERTS_SSI_AUX_WORK_SET_TMO); + else +#endif + { + aux_work_tmo->timer.data.active = 0; + erts_set_timer(&aux_work_tmo->timer.data, + aux_work_timeout, + NULL, + NULL, + 1000); + } } +erts_aint32_t +erts_set_aux_work_timeout(int ix, erts_aint32_t type, int enable) +{ + erts_aint32_t old, refc; + +#ifndef ERTS_SMP + ix = 1; #endif + ERTS_DBG_CHK_AUX_WORK_VAL(type); + ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&aux_work_tmo->type[ix])); +// erts_fprintf(stderr, "t(%d, 0x%x, %d)\n", ix, type, enable); + + if (!enable) { + old = erts_atomic32_read_band_mb(&aux_work_tmo->type[ix], ~type); + ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&aux_work_tmo->type[ix])); + if (old != 0 && (old & ~type) == 0) + erts_atomic32_dec_relb(&aux_work_tmo->refc); + return old; + } + + old = erts_atomic32_read_bor_mb(&aux_work_tmo->type[ix], type); + ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&aux_work_tmo->type[ix])); + if (old == 0 && type != 0) { + refc = erts_atomic32_inc_read_acqb(&aux_work_tmo->refc); + if (refc == 1) { + erts_atomic32_inc_acqb(&aux_work_tmo->refc); + if (aux_work_tmo->initialized) + setup_aux_work_timer(); + } + } + return old; +} + + + static ERTS_INLINE void sched_waiting_sys(Uint no, ErtsRunQueue *rq) { @@ -800,8 +1391,6 @@ sched_active_sys(Uint no, ErtsRunQueue *rq) Uint erts_active_schedulers(void) { - /* RRRRRRRRR */ - Uint as = erts_no_schedulers; ERTS_ATOMIC_FOREACH_RUNQ(rq, as -= abs(rq->waiting)); @@ -988,6 +1577,10 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type) if (sleep_type == ERTS_SSI_FLG_TSE_SLEEPING) erts_tse_reset(ssi->event); + else { + ASSERT(sleep_type == ERTS_SSI_FLG_POLL_SLEEPING); + erts_sys_schedule_interrupt(0); + } while (1) { oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs); @@ -1006,16 +1599,127 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type) (((FLGS) & (ERTS_SSI_FLG_WAITING|ERTS_SSI_FLG_SUSPENDED)) \ != ERTS_SSI_FLG_WAITING) + +static void +thr_prgr_wakeup(void *vssi) +{ + erts_sched_poke((ErtsSchedulerSleepInfo *) vssi); +} + +static void +thr_prgr_prep_wait(void *vssi) +{ + ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi; + erts_smp_atomic32_read_bor_acqb(&ssi->flags, + ERTS_SSI_FLG_SLEEPING); +} + +static void +thr_prgr_wait(void *vssi) +{ + ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi; + erts_aint32_t xflgs = ERTS_SSI_FLG_SLEEPING; + + erts_tse_reset(ssi->event); + + while (1) { + erts_aint32_t aflgs, nflgs; + nflgs = xflgs | ERTS_SSI_FLG_TSE_SLEEPING; + aflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs); + if (aflgs == xflgs) { + erts_tse_wait(ssi->event); + break; + } + if ((aflgs & ERTS_SSI_FLG_SLEEPING) == 0) + break; + xflgs = aflgs; + } +} + +static void +thr_prgr_fin_wait(void *vssi) +{ + ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi; + erts_smp_atomic32_read_band_nob(&ssi->flags, + ~(ERTS_SSI_FLG_SLEEPING + | ERTS_SSI_FLG_TSE_SLEEPING)); +} + +static void init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp); + +static void * +aux_thread(void *unused) +{ + ErtsAuxWorkData *awdp = aux_thread_aux_work_data; + ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(-1); + erts_aint32_t aux_work; + ErtsThrPrgrCallbacks callbacks; + int thr_prgr_active = 1; + + ssi->event = erts_tse_fetch(); + + callbacks.arg = (void *) ssi; + callbacks.wakeup = thr_prgr_wakeup; + callbacks.prepare_wait = thr_prgr_prep_wait; + callbacks.wait = thr_prgr_wait; + callbacks.finalize_wait = thr_prgr_fin_wait; + + erts_thr_progress_register_managed_thread(NULL, &callbacks, 1); + init_aux_work_data(awdp, NULL); + awdp->ssi = ssi; + + sched_prep_spin_wait(ssi); + + while (1) { + erts_aint32_t flgs; + + aux_work = erts_atomic32_read_acqb(&ssi->aux_work); + if (aux_work) { + if (!thr_prgr_active) + erts_thr_progress_active(NULL, thr_prgr_active = 1); + aux_work = handle_aux_work(awdp, aux_work); + if (aux_work && erts_thr_progress_update(NULL)) + erts_thr_progress_leader_update(NULL); + } + + if (!aux_work) { + if (thr_prgr_active) + erts_thr_progress_active(NULL, thr_prgr_active = 0); + erts_thr_progress_prepare_wait(NULL); + + flgs = sched_spin_wait(ssi, 0); + + if (flgs & ERTS_SSI_FLG_SLEEPING) { + ASSERT(flgs & ERTS_SSI_FLG_WAITING); + flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING); + if (flgs & ERTS_SSI_FLG_SLEEPING) { + int res; + ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING); + ASSERT(flgs & ERTS_SSI_FLG_WAITING); + do { + res = erts_tse_wait(ssi->event); + } while (res == EINTR); + } + } + erts_thr_progress_finalize_wait(NULL); + } + + flgs = sched_prep_spin_wait(ssi); + } + return NULL; +} + +#endif /* ERTS_SMP */ + static void scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) { ErtsSchedulerSleepInfo *ssi = esdp->ssi; int spincount; + erts_aint32_t aux_work = 0; +#ifdef ERTS_SMP + int thr_prgr_active = 1; erts_aint32_t flgs; -#if defined(ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK) \ - || defined(ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK) - erts_aint32_t aux_work; -#endif ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); @@ -1049,34 +1753,38 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) tse_wait: -#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work); - tse_blockable_aux_work: - aux_work = blockable_aux_work(esdp, ssi, aux_work); -#endif - erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); - while (1) { -#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK -#ifndef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work); -#endif - nonblockable_aux_work(esdp, ssi, aux_work); -#endif + aux_work = erts_atomic32_read_acqb(&ssi->aux_work); + if (aux_work) { + if (!thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 1); + aux_work = handle_aux_work(&esdp->aux_work_data, aux_work); + if (aux_work && erts_thr_progress_update(esdp)) + erts_thr_progress_leader_update(esdp); + } - flgs = sched_spin_wait(ssi, spincount); - if (flgs & ERTS_SSI_FLG_SLEEPING) { - ASSERT(flgs & ERTS_SSI_FLG_WAITING); - flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING); + if (aux_work) + flgs = erts_smp_atomic32_read_acqb(&ssi->flags); + else { + if (thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 0); + erts_thr_progress_prepare_wait(esdp); + + flgs = sched_spin_wait(ssi, spincount); if (flgs & ERTS_SSI_FLG_SLEEPING) { - int res; - ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING); ASSERT(flgs & ERTS_SSI_FLG_WAITING); - do { - res = erts_tse_wait(ssi->event); - } while (res == EINTR); + flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING); + if (flgs & ERTS_SSI_FLG_SLEEPING) { + int res; + ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING); + ASSERT(flgs & ERTS_SSI_FLG_WAITING); + do { + res = erts_tse_wait(ssi->event); + } while (res == EINTR); + } } + erts_thr_progress_finalize_wait(esdp); } if (!(flgs & ERTS_SSI_FLG_WAITING)) { @@ -1092,26 +1800,21 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) break; } -#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work); - if (aux_work & ERTS_SSI_BLOCKABLE_AUX_WORK_MASK) { - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); - goto tse_blockable_aux_work; - } -#endif - } - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); - if (flgs & ~ERTS_SSI_FLG_SUSPENDED) erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); + if (!thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 1); + erts_smp_runq_lock(rq); sched_active(esdp->no, rq); } - else { + else +#endif + { erts_aint_t dt; erts_smp_atomic32_set_relb(&function_calls, 0); @@ -1135,18 +1838,27 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (dt) erts_bump_timer(dt); sys_aux_work: - -#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work); - aux_work = blockable_aux_work(esdp, ssi, aux_work); +#ifndef ERTS_SMP + erts_sys_schedule_interrupt(0); #endif -#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK -#ifndef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work); + + aux_work = erts_atomic32_read_acqb(&ssi->aux_work); + if (aux_work) { +#ifdef ERTS_SMP + if (!thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 1); #endif - nonblockable_aux_work(esdp, ssi, aux_work); + aux_work = handle_aux_work(&esdp->aux_work_data, aux_work); +#ifdef ERTS_SMP + if (aux_work && erts_thr_progress_update(esdp)) + erts_thr_progress_leader_update(esdp); #endif + } +#ifndef ERTS_SMP + if (rq->len != 0 || rq->misc.start) + goto sys_woken; +#else flgs = erts_smp_atomic32_read_acqb(&ssi->flags); if (!(flgs & ERTS_SSI_FLG_WAITING)) { ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING)); @@ -1168,10 +1880,12 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) goto tse_wait; } } +#endif } erts_smp_runq_lock(rq); +#ifdef ERTS_SMP /* * If we got new I/O tasks we aren't allowed to * sleep in erl_sys_schedule(). @@ -1183,64 +1897,88 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * Got to check that we still got I/O tasks; otherwise * we have to wait in erl_sys_schedule() after all... */ - if (prepare_for_sys_schedule()) - goto do_sys_schedule; - - /* - * Not allowed to wait in erl_sys_schedule; - * do tse wait instead... - */ - sched_change_waiting_sys_to_waiting(esdp->no, rq); + if (!prepare_for_sys_schedule()) { + /* + * Not allowed to wait in erl_sys_schedule; + * do tse wait instead... + */ + sched_change_waiting_sys_to_waiting(esdp->no, rq); + erts_smp_runq_unlock(rq); + spincount = 0; + goto tse_wait; + } + } +#endif + if (aux_work) { erts_smp_runq_unlock(rq); - spincount = 0; - goto tse_wait; + goto sys_poll_aux_work; } - else { - do_sys_schedule: - erts_sys_schedule_interrupt(0); - flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_POLL_SLEEPING); - if (!(flgs & ERTS_SSI_FLG_SLEEPING)) { - if (!(flgs & ERTS_SSI_FLG_WAITING)) - goto sys_locked_woken; - erts_smp_runq_unlock(rq); - flgs = sched_prep_cont_spin_wait(ssi); - if (!(flgs & ERTS_SSI_FLG_WAITING)) { - ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING)); - goto sys_woken; - } - ASSERT(!erts_port_task_have_outstanding_io_tasks()); - goto sys_poll_aux_work; +#ifdef ERTS_SMP + flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_POLL_SLEEPING); + if (!(flgs & ERTS_SSI_FLG_SLEEPING)) { + if (!(flgs & ERTS_SSI_FLG_WAITING)) { + ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING)); + goto sys_locked_woken; + } + erts_smp_runq_unlock(rq); + flgs = sched_prep_cont_spin_wait(ssi); + if (!(flgs & ERTS_SSI_FLG_WAITING)) { + ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING)); + goto sys_woken; } + ASSERT(!erts_port_task_have_outstanding_io_tasks()); + goto sys_poll_aux_work; + } - ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING); - ASSERT(flgs & ERTS_SSI_FLG_WAITING); + ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING); + ASSERT(flgs & ERTS_SSI_FLG_WAITING); +#endif - erts_smp_runq_unlock(rq); + erts_smp_runq_unlock(rq); - ASSERT(!erts_port_task_have_outstanding_io_tasks()); +#ifdef ERTS_SMP + if (thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 0); +#endif - erl_sys_schedule(0); + ASSERT(!erts_port_task_have_outstanding_io_tasks()); - dt = erts_do_time_read_and_reset(); - if (dt) erts_bump_timer(dt); + erl_sys_schedule(0); - flgs = sched_prep_cont_spin_wait(ssi); - if (flgs & ERTS_SSI_FLG_WAITING) - goto sys_aux_work; + dt = erts_do_time_read_and_reset(); + if (dt) erts_bump_timer(dt); + +#ifndef ERTS_SMP + if (rq->len == 0 && !rq->misc.start) + goto sys_aux_work; + sys_woken: +#else + flgs = sched_prep_cont_spin_wait(ssi); + if (flgs & ERTS_SSI_FLG_WAITING) + goto sys_aux_work; - sys_woken: + sys_woken: + if (!thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 1); + erts_smp_runq_lock(rq); + sys_locked_woken: + if (!thr_prgr_active) { + erts_smp_runq_unlock(rq); + erts_thr_progress_active(esdp, thr_prgr_active = 1); erts_smp_runq_lock(rq); - sys_locked_woken: - clear_sys_scheduling(); - if (flgs & ~ERTS_SSI_FLG_SUSPENDED) - erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); - sched_active_sys(esdp->no, rq); } + clear_sys_scheduling(); + if (flgs & ~ERTS_SSI_FLG_SUSPENDED) + erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); +#endif + sched_active_sys(esdp->no, rq); } ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); } +#ifdef ERTS_SMP + static ERTS_INLINE erts_aint32_t ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi) { @@ -2547,8 +3285,9 @@ erts_debug_nbalance(void) } void -erts_early_init_scheduling(void) +erts_early_init_scheduling(int no_schedulers) { + aux_work_timeout_early_init(no_schedulers); wakeup_other_limit = ERTS_WAKEUP_OTHER_LIMIT_MEDIUM; } @@ -2569,12 +3308,32 @@ erts_sched_set_wakeup_limit(char *str) return EINVAL; return 0; } - + +static void +init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp) +{ + awdp->sched_id = esdp ? (int) esdp->no : 0; + awdp->esdp = esdp; + awdp->ssi = esdp ? esdp->ssi : NULL; +#ifdef ERTS_SMP + awdp->misc.thr_prgr = ERTS_THR_PRGR_VAL_WAITING; + awdp->dd.thr_prgr = ERTS_THR_PRGR_VAL_WAITING; + awdp->dd.completed_callback = NULL; + awdp->dd.completed_arg = NULL; +#endif +#ifdef ERTS_USE_ASYNC_READY_Q +#ifdef ERTS_SMP + awdp->async_ready.need_thr_prgr = 0; + awdp->async_ready.thr_prgr = ERTS_THR_PRGR_VAL_WAITING; +#endif + awdp->async_ready.queue = NULL; +#endif +} void erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) { - int ix, n; + int ix, n, no_ssi; #ifndef ERTS_SMP mrq = 0; @@ -2684,23 +3443,31 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) n = (int) no_schedulers; erts_no_schedulers = n; -#ifdef ERTS_SMP /* Create and initialize scheduler sleep info */ - +#ifdef ERTS_SMP + no_ssi = n+1; +#else + no_ssi = 1; +#endif aligned_sched_sleep_info = - erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_SLP_INFO, - n * sizeof(ErtsAlignedSchedulerSleepInfo)); - - for (ix = 0; ix < n; ix++) { - ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); + erts_alloc_permanent_cache_aligned( + ERTS_ALC_T_SCHDLR_SLP_INFO, + no_ssi*sizeof(ErtsAlignedSchedulerSleepInfo)); + for (ix = 0; ix < no_ssi; ix++) { + ErtsSchedulerSleepInfo *ssi = &aligned_sched_sleep_info[ix].ssi; +#ifdef ERTS_SMP #if 0 /* no need to initialize these... */ ssi->next = NULL; ssi->prev = NULL; #endif erts_smp_atomic32_init_nob(&ssi->flags, 0); ssi->event = NULL; /* initialized in sched_thread_func */ - erts_smp_atomic32_init_nob(&ssi->aux_work, 0); +#endif + erts_atomic32_init_nob(&ssi->aux_work, 0); } + +#ifdef ERTS_SMP + aligned_sched_sleep_info++; #endif /* Create and initialize scheduler specific data */ @@ -2714,7 +3481,6 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) #ifdef ERTS_SMP erts_bits_init_state(&esdp->erl_bits_state); esdp->match_pseudo_process = NULL; - esdp->ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); esdp->free_process = NULL; #endif esdp->x_reg_array = @@ -2728,6 +3494,7 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) esdp->num_tmp_heap_used = 0; #endif esdp->no = (Uint) ix+1; + esdp->ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); esdp->current_process = NULL; esdp->current_port = NULL; @@ -2748,9 +3515,19 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) #ifdef ERTS_SMP erts_smp_atomic32_init_nob(&esdp->chk_cpu_bind, 0); #endif + init_aux_work_data(&esdp->aux_work_data, esdp); } + init_misc_aux_work(); + #ifdef ERTS_SMP + + erts_atomic32_init_nob(&completed_dealloc_count, 0); /* debug only */ + + aux_thread_aux_work_data = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA, + sizeof(ErtsAuxWorkData)); + erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd"); erts_smp_cnd_init(&schdlr_sspnd.cnd); @@ -2812,6 +3589,8 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) /* init port tasks */ erts_port_task_init(); + aux_work_timeout_late_init(); + #ifndef ERTS_SMP #ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC erts_scheduler_data->verify_unused_temp_alloc @@ -2946,18 +3725,6 @@ erts_get_max_no_executing_schedulers(void) #ifdef ERTS_SMP static void -susp_sched_prep_block(void *unused) -{ - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); -} - -static void -susp_sched_resume_block(void *unused) -{ - erts_smp_mtx_lock(&schdlr_sspnd.mtx); -} - -static void scheduler_ix_resume_wake(Uint ix) { ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); @@ -3061,10 +3828,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) long active_schedulers; int curr_online = 1; int wake = 0; -#if defined(ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK) \ - || defined(ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK) erts_aint32_t aux_work; -#endif + int thr_prgr_active = 1; /* * Schedulers may be suspended in two different ways: @@ -3137,38 +3902,40 @@ suspend_scheduler(ErtsSchedulerData *esdp) break; erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - -#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work); - blockable_aux_work: - blockable_aux_work(esdp, ssi, aux_work); -#endif - - erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); while (1) { erts_aint32_t flgs; -#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK -#ifndef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = erts_smp_atomic32_read(&ssi->aux_work); -#endif - nonblockable_aux_work(esdp, ssi, aux_work); -#endif - flgs = sched_spin_suspended(ssi, - ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT); - if (flgs == (ERTS_SSI_FLG_SLEEPING - | ERTS_SSI_FLG_WAITING - | ERTS_SSI_FLG_SUSPENDED)) { - flgs = sched_set_suspended_sleeptype(ssi); + aux_work = erts_atomic32_read_acqb(&ssi->aux_work); + if (aux_work) { + if (!thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 1); + aux_work = handle_aux_work(&esdp->aux_work_data, aux_work); + if (aux_work && erts_thr_progress_update(esdp)) + erts_thr_progress_leader_update(esdp); + } + + if (!aux_work) { + if (thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 0); + erts_thr_progress_prepare_wait(esdp); + flgs = sched_spin_suspended(ssi, + ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT); if (flgs == (ERTS_SSI_FLG_SLEEPING - | ERTS_SSI_FLG_TSE_SLEEPING | ERTS_SSI_FLG_WAITING | ERTS_SSI_FLG_SUSPENDED)) { - int res; - do { - res = erts_tse_wait(ssi->event); - } while (res == EINTR); + flgs = sched_set_suspended_sleeptype(ssi); + if (flgs == (ERTS_SSI_FLG_SLEEPING + | ERTS_SSI_FLG_TSE_SLEEPING + | ERTS_SSI_FLG_WAITING + | ERTS_SSI_FLG_SUSPENDED)) { + int res; + + do { + res = erts_tse_wait(ssi->event); + } while (res == EINTR); + } } + erts_thr_progress_finalize_wait(esdp); } flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING @@ -3178,20 +3945,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); if (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER) break; - - -#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work); - if (aux_work & ERTS_SSI_BLOCKABLE_AUX_WORK_MASK) { - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); - goto blockable_aux_work; - } -#endif - } - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); - erts_smp_mtx_lock(&schdlr_sspnd.mtx); changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); } @@ -3216,6 +3971,9 @@ suspend_scheduler(ErtsSchedulerData *esdp) if (erts_system_profile_flags.scheduler) profile_scheduler(make_small(esdp->no), am_active); + if (!thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 1); + erts_smp_runq_lock(esdp->run_queue); non_empty_runq(esdp->run_queue); @@ -3298,12 +4056,16 @@ erts_set_schedulers_online(Process *p, Sint new_no, Sint *old_no) { - int ix, res, no, have_unlocked_plocks; + ErtsSchedulerData *esdp; + int ix, res, no, have_unlocked_plocks, end_wait; erts_aint32_t changing; if (new_no < 1 || erts_no_schedulers < new_no) return ERTS_SCHDLR_SSPND_EINVAL; + esdp = ERTS_PROC_GET_SCHDATA(p); + end_wait = 0; + erts_smp_mtx_lock(&schdlr_sspnd.mtx); have_unlocked_plocks = 0; @@ -3420,16 +4182,21 @@ erts_set_schedulers_online(Process *p, } } - erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, - susp_sched_prep_block, - susp_sched_resume_block, - NULL); + if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) { + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (plocks && !have_unlocked_plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + erts_thr_progress_active(esdp, 0); + erts_thr_progress_prepare_wait(esdp); + end_wait = 1; + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + } + while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, - susp_sched_prep_block, - susp_sched_resume_block, - NULL); + ASSERT(res != ERTS_SCHDLR_SSPND_DONE ? (ERTS_SCHDLR_SSPND_CHNG_WAITER & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)) @@ -3437,10 +4204,15 @@ erts_set_schedulers_online(Process *p, == erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))); erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, ~ERTS_SCHDLR_SSPND_CHNG_WAITER); + } } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (end_wait) { + erts_thr_progress_finalize_wait(esdp); + erts_thr_progress_active(esdp, 1); + } if (have_unlocked_plocks) erts_smp_proc_lock(p, plocks); @@ -3525,17 +4297,38 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) erts_smp_mtx_unlock(&balance_info.update_mtx); erts_smp_mtx_lock(&schdlr_sspnd.mtx); } - erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, - susp_sched_prep_block, - susp_sched_resume_block, - NULL); - while (erts_smp_atomic32_read_nob(&schdlr_sspnd.active) - != schdlr_sspnd.msb.wait_active) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, - susp_sched_prep_block, - susp_sched_resume_block, - NULL); + + if (erts_smp_atomic32_read_nob(&schdlr_sspnd.active) + != schdlr_sspnd.msb.wait_active) { + ErtsSchedulerData *esdp; + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + + if (plocks && !have_unlocked_plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + + esdp = ERTS_PROC_GET_SCHDATA(p); + + erts_thr_progress_active(esdp, 0); + erts_thr_progress_prepare_wait(esdp); + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + + while (erts_smp_atomic32_read_nob(&schdlr_sspnd.active) + != schdlr_sspnd.msb.wait_active) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, + &schdlr_sspnd.mtx); + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + + erts_thr_progress_active(esdp, 1); + erts_thr_progress_finalize_wait(esdp); + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + + } ASSERT(res != ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED ? (ERTS_SCHDLR_SSPND_CHNG_WAITER & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)) @@ -3723,8 +4516,19 @@ erts_multi_scheduling_blockers(Process *p) static void * sched_thread_func(void *vesdp) { + ErtsThrPrgrCallbacks callbacks; + ErtsSchedulerData *esdp = vesdp; + Uint no = esdp->no; #ifdef ERTS_SMP - Uint no = ((ErtsSchedulerData *) vesdp)->no; + ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = erts_tse_fetch(); + callbacks.arg = (void *) esdp->ssi; + callbacks.wakeup = thr_prgr_wakeup; + callbacks.prepare_wait = thr_prgr_prep_wait; + callbacks.wait = thr_prgr_wait; + callbacks.finalize_wait = thr_prgr_fin_wait; + + erts_thr_progress_register_managed_thread(esdp, &callbacks, 0); + erts_alloc_register_scheduler(vesdp); #endif #ifdef ERTS_ENABLE_LOCK_CHECK { @@ -3733,22 +4537,30 @@ sched_thread_func(void *vesdp) erts_lc_set_thread_name(&buf[0]); } #endif - erts_alloc_reg_scheduler_id(no); erts_tsd_set(sched_data_key, vesdp); #ifdef ERTS_SMP +#if HAVE_ERTS_MSEG + erts_mseg_late_init(); +#endif +#if ERTS_USE_ASYNC_READY_Q + esdp->aux_work_data.async_ready.queue = erts_get_async_ready_queue(no); +#endif - erts_sched_init_check_cpu_bind((ErtsSchedulerData *) vesdp); + erts_sched_init_check_cpu_bind(esdp); erts_proc_lock_prepare_proc_lock_waiter(); - ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = erts_tse_fetch(); - - #endif - erts_register_blockable_thread(); + #ifdef HIPE hipe_thread_signal_init(); #endif erts_thread_init_float(); + + if (no == 1) { + erts_thr_progress_active(esdp, 0); + erts_thr_progress_prepare_wait(esdp); + } + erts_smp_mtx_lock(&schdlr_sspnd.mtx); ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.changing) @@ -3757,41 +4569,39 @@ sched_thread_func(void *vesdp) if (--schdlr_sspnd.curr_online == schdlr_sspnd.wait_curr_online) { erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, ~ERTS_SCHDLR_SSPND_CHNG_ONLN); - if (((ErtsSchedulerData *) vesdp)->no != 1) + if (no != 1) erts_smp_cnd_signal(&schdlr_sspnd.cnd); } - if (((ErtsSchedulerData *) vesdp)->no == 1) { - if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) { - erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, - susp_sched_prep_block, - susp_sched_resume_block, - NULL); - while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, - susp_sched_prep_block, - susp_sched_resume_block, - NULL); - } + if (no == 1) { + while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); ERTS_SCHDLR_SSPND_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (no == 1) { + erts_thr_progress_finalize_wait(esdp); + erts_thr_progress_active(esdp, 1); + } + #ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC - ((ErtsSchedulerData *) vesdp)->verify_unused_temp_alloc + esdp->verify_unused_temp_alloc = erts_alloc_get_verify_unused_temp_alloc( - &((ErtsSchedulerData *) vesdp)->verify_unused_temp_alloc_data); + &esdp->verify_unused_temp_alloc_data); ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL); #endif process_main(); /* No schedulers should *ever* terminate */ - erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %beu terminated\n", - ((ErtsSchedulerData *) vesdp)->no); + erl_exit(ERTS_ABORT_EXIT, + "Scheduler thread number %beu terminated\n", + no); return NULL; } +static ethr_tid aux_tid; + void erts_start_schedulers(void) { @@ -3811,8 +4621,6 @@ erts_start_schedulers(void) res = ENOTSUP; } - erts_block_system(0); - while (actual < wanted) { ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(actual); actual++; @@ -3825,7 +4633,12 @@ erts_start_schedulers(void) } erts_no_schedulers = actual; - erts_release_system(); + + ERTS_THR_MEMORY_BARRIER; + + res = ethr_thr_create(&aux_tid, aux_thread, NULL, &opts); + if (res != 0) + erl_exit(1, "Failed to create aux thread\n"); if (actual < 1) erl_exit(1, @@ -5186,7 +5999,7 @@ Process *schedule(Process *p, int calls) input_reductions = INPUT_REDUCTIONS; } - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); /* * Clean up after the process being scheduled out. @@ -5324,7 +6137,8 @@ Process *schedule(Process *p, int calls) } - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); + check_activities_to_run: { #ifdef ERTS_SMP @@ -5334,7 +6148,7 @@ Process *schedule(Process *p, int calls) check_balance(rq); } - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); if (rq->flags & ERTS_RUNQ_FLGS_IMMIGRATE_QMASK) @@ -5358,42 +6172,38 @@ Process *schedule(Process *p, int calls) } } -#if defined(ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK) \ - || defined(ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK) { - ErtsSchedulerSleepInfo *ssi = esdp->ssi; - erts_aint32_t aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work); - if (aux_work) { + erts_aint32_t aux_work; + int leader_update = erts_thr_progress_update(esdp); + aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work); + if (aux_work | leader_update) { erts_smp_runq_unlock(rq); -#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - aux_work = blockable_aux_work(esdp, ssi, aux_work); -#endif -#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK - nonblockable_aux_work(esdp, ssi, aux_work); -#endif + if (leader_update) + erts_thr_progress_leader_update(esdp); + if (aux_work) + handle_aux_work(&esdp->aux_work_data, aux_work); erts_smp_runq_lock(rq); } } -#endif - - erts_smp_chk_system_block(prepare_for_block, - resume_after_block, - (void *) rq); - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); -#endif +#else /* ERTS_SMP */ + { + erts_aint32_t aux_work; + aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work); + if (aux_work) + handle_aux_work(&esdp->aux_work_data, aux_work); + } +#endif /* ERTS_SMP */ ASSERT(rq->len == rq->procs.len + rq->ports.info.len); -#ifndef ERTS_SMP + if (rq->len == 0 && !rq->misc.start) { - if (rq->len == 0 && !rq->misc.start) - goto do_sys_schedule; +#ifdef ERTS_SMP -#else /* ERTS_SMP */ - if (rq->len == 0 && !rq->misc.start) { ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); rq->wakeup_other = 0; @@ -5424,26 +6234,17 @@ Process *schedule(Process *p, int calls) } } +#endif + scheduler_wait(&fcalls, esdp, rq); +#ifdef ERTS_SMP non_empty_runq(rq); +#endif goto check_activities_to_run; } - else -#endif /* ERTS_SMP */ - if (fcalls > input_reductions && prepare_for_sys_schedule()) { - int runnable; - -#ifdef ERTS_SMP - runnable = 1; -#else - do_sys_schedule: - runnable = rq->len != 0; - if (!runnable) - sched_waiting_sys(esdp->no, rq); -#endif - + else if (fcalls > input_reductions && prepare_for_sys_schedule()) { /* * Schedule system-level activities. */ @@ -5453,11 +6254,11 @@ Process *schedule(Process *p, int calls) ASSERT(!erts_port_task_have_outstanding_io_tasks()); -#ifdef ERTS_SMP - /* erts_sys_schedule_interrupt(0); */ +#if 0 /* Not needed since we wont wait in sys schedule */ + erts_sys_schedule_interrupt(0); #endif erts_smp_runq_unlock(rq); - erl_sys_schedule(runnable); + erl_sys_schedule(1); dt = erts_do_time_read_and_reset(); if (dt) erts_bump_timer(dt); #ifdef ERTS_SMP @@ -5465,8 +6266,6 @@ Process *schedule(Process *p, int calls) clear_sys_scheduling(); goto continue_check_activities_to_run; #else - if (!runnable) - sched_active_sys(esdp->no, rq); goto check_activities_to_run; #endif } @@ -5714,14 +6513,14 @@ erts_sched_stat_modify(int what) int ix; switch (what) { case ERTS_SCHED_STAT_MODIFY_ENABLE: - erts_smp_block_system(0); + erts_smp_thr_progress_block(); erts_sched_stat.enabled = 1; - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); break; case ERTS_SCHED_STAT_MODIFY_DISABLE: - erts_smp_block_system(0); + erts_smp_thr_progress_block(); erts_sched_stat.enabled = 1; - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); break; case ERTS_SCHED_STAT_MODIFY_CLEAR: erts_smp_spin_lock(&erts_sched_stat.lock); @@ -5781,20 +6580,9 @@ erts_sched_stat_term(Process *p, int total) void erts_schedule_misc_op(void (*func)(void *), void *arg) { - ErtsRunQueue *rq; - ErtsMiscOpList *molp = misc_op_list_alloc(); ErtsSchedulerData *esdp = erts_get_scheduler_data(); - - if (esdp) { - rq = esdp->run_queue; - } else { - /* - * This can only happen when the sys msg dispatcher - * thread schedules misc ops (this happens *very* - * seldom; only when trace drivers are unloaded). - */ - rq = ERTS_RUNQ_IX(0); - } + ErtsRunQueue *rq = esdp ? esdp->run_queue : ERTS_RUNQ_IX(0); + ErtsMiscOpList *molp = misc_op_list_alloc(); erts_smp_runq_lock(rq); @@ -5887,7 +6675,7 @@ erts_get_exact_total_reductions(Process *c_p, Uint *redsp, Uint *diffp) * Wait for other schedulers to schedule out their processes * and update 'reductions'. */ - erts_smp_block_system(0); + erts_smp_thr_progress_block(); for (reds = 0, ix = 0; ix < erts_no_run_queues; ix++) reds += ERTS_RUNQ_IX(ix)->procs.reductions; if (redsp) @@ -5895,7 +6683,7 @@ erts_get_exact_total_reductions(Process *c_p, Uint *redsp, Uint *diffp) if (diffp) *diffp = reds - last_exact_reductions; last_exact_reductions = reds; - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); } @@ -8700,6 +9488,22 @@ init_processes_bif(void) * Debug stuff */ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) +int +erts_dbg_check_halloc_lock(Process *p) +{ + if (ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)) + return 1; + if (p->id == ERTS_INVALID_PID) + return 1; + if (p->scheduler_data && p == p->scheduler_data->match_pseudo_process) + return 1; + if (erts_thr_progress_is_blocking()) + return 1; + return 0; +} +#endif + Eterm erts_debug_processes(Process *c_p) { diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 627f10b142..4027fade35 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -53,11 +53,18 @@ typedef struct process Process; #include "erl_time.h" #include "erl_atom_table.h" #include "external.h" +#include "erl_mseg.h" +#include "erl_async.h" #ifdef HIPE #include "hipe_process.h" #endif +#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY +#define ERL_THR_PROGRESS_TSD_TYPE_ONLY +#include "erl_thr_progress.h" +#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY + struct ErtsNodesMonitor_; struct port; @@ -242,16 +249,25 @@ typedef enum { | ERTS_SSI_FLG_WAITING \ | ERTS_SSI_FLG_SUSPENDED) -#define ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK - -#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 0) -#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 1) +#define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 0) +#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 1) +#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 2) +#ifdef ERTS_SMP +#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR (((erts_aint32_t) 1) << 3) +#endif +#define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM (((erts_aint32_t) 1) << 4) +#define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC (((erts_aint32_t) 1) << 5) +#define ERTS_SSI_AUX_WORK_ASYNC_READY (((erts_aint32_t) 1) << 6) +#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN (((erts_aint32_t) 1) << 7) +#ifdef ERTS_SMP +#define ERTS_SSI_AUX_WORK_DD (((erts_aint32_t) 1) << 8) +#define ERTS_SSI_AUX_WORK_DD_THR_PRGR (((erts_aint32_t) 1) << 9) +#endif +#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 10) -#define ERTS_SSI_BLOCKABLE_AUX_WORK_MASK \ - (ERTS_SSI_AUX_WORK_CHECK_CHILDREN \ - | ERTS_SSI_AUX_WORK_MISC) -#define ERTS_SSI_NONBLOCKABLE_AUX_WORK_MASK \ - (0) +#if !HAVE_ERTS_MSEG +# undef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK +#endif typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo; @@ -261,11 +277,13 @@ typedef struct { } ErtsSchedulerSleepList; struct ErtsSchedulerSleepInfo_ { +#ifdef ERTS_SMP ErtsSchedulerSleepInfo *next; ErtsSchedulerSleepInfo *prev; erts_smp_atomic32_t flags; erts_tse_t *event; - erts_smp_atomic32_t aux_work; +#endif + erts_atomic32_t aux_work; }; /* times to reschedule low prio process before running */ @@ -386,6 +404,34 @@ do { \ (RQ)->wakeup_other_reds += (REDS); \ } while (0) +typedef struct { + int sched_id; + ErtsSchedulerData *esdp; + ErtsSchedulerSleepInfo *ssi; + struct { + int ix; +#ifdef ERTS_SMP + ErtsThrPrgrVal thr_prgr; +#endif + } misc; +#ifdef ERTS_SMP + struct { + ErtsThrPrgrVal thr_prgr; + void (*completed_callback)(void *); + void (*completed_arg)(void *); + } dd; +#endif +#ifdef ERTS_USE_ASYNC_READY_Q + struct { +#ifdef ERTS_SMP + int need_thr_prgr; + ErtsThrPrgrVal thr_prgr; +#endif + void *queue; + } async_ready; +#endif +} ErtsAuxWorkData; + struct ErtsSchedulerData_ { /* * Keep X registers first (so we get as many low @@ -399,8 +445,8 @@ struct ErtsSchedulerData_ { ethr_tid tid; /* Thread id */ struct erl_bits_state erl_bits_state; /* erl_bits.c state */ void *match_pseudo_process; /* erl_db_util.c:db_prog_match() */ - ErtsSchedulerSleepInfo *ssi; Process *free_process; + ErtsThrPrgrData thr_progress_data; #endif #if !HEAP_ON_C_STACK Eterm tmp_heap[TMP_HEAP_SIZE]; @@ -409,16 +455,19 @@ struct ErtsSchedulerData_ { Eterm cmp_tmp_heap[CMP_TMP_HEAP_SIZE]; Eterm erl_arith_tmp_heap[ERL_ARITH_TMP_HEAP_SIZE]; #endif - + ErtsSchedulerSleepInfo *ssi; Process *current_process; Uint no; /* Scheduler number */ struct port *current_port; ErtsRunQueue *run_queue; int virtual_reds; int cpu_id; /* >= 0 when bound */ + ErtsAuxWorkData aux_work_data; ErtsAtomCacheMap atom_cache_map; + ErtsSchedAllocData alloc_data; + #ifdef ERTS_SMP /* NOTE: These fields are modified under held mutexes by other threads */ erts_smp_atomic32_t chk_cpu_bind; /* Only used when common run queue */ @@ -1028,7 +1077,7 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; void erts_pre_init_process(void); void erts_late_init_process(void); -void erts_early_init_scheduling(void); +void erts_early_init_scheduling(int); void erts_init_scheduling(int, int, int); ErtsProcList *erts_proclist_create(Process *); @@ -1037,6 +1086,9 @@ int erts_proclist_same(ErtsProcList *, Process *); int erts_sched_set_wakeup_limit(char *str); +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) +int erts_dbg_check_halloc_lock(Process *p); +#endif #ifdef DEBUG void erts_dbg_multi_scheduling_return_trap(Process *, Eterm); #endif @@ -1054,13 +1106,20 @@ erts_block_multi_scheduling(Process *, ErtsProcLocks, int, int); int erts_is_multi_scheduling_blocked(void); Eterm erts_multi_scheduling_blockers(Process *); void erts_start_schedulers(void); +void erts_alloc_notify_delayed_dealloc(int); void erts_smp_notify_check_children_needed(void); -void -erts_smp_schedule_misc_aux_work(int ignore_self, - int max_sched, - void (*func)(void *), - void *arg); #endif +#if ERTS_USE_ASYNC_READY_Q +void erts_notify_check_async_ready_queue(void *); +#endif +void erts_schedule_misc_aux_work(int sched_id, + void (*func)(void *), + void *arg); +void erts_schedule_multi_misc_aux_work(int ignore_self, + int max_sched, + void (*func)(void *), + void *arg); +erts_aint32_t erts_set_aux_work_timeout(int, erts_aint32_t, int); void erts_sched_notify_check_cpu_bind(void); Uint erts_active_schedulers(void); void erts_init_process(int); @@ -1144,6 +1203,7 @@ Sint erts_test_next_pid(int, Uint); Eterm erts_debug_processes(Process *c_p); Eterm erts_debug_processes_bif_info(Process *c_p); Uint erts_debug_nbalance(void); +int erts_debug_wait_deallocations(Process *c_p); #ifdef ERTS_SMP # define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data) @@ -1214,16 +1274,11 @@ erts_psd_get(Process *p, int ix) #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p); if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].get_locks) - ERTS_SMP_LC_ASSERT(locks - || erts_is_system_blocked(0) - || (ERTS_IS_CRASH_DUMPING - && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + ERTS_SMP_LC_ASSERT(locks || erts_thr_progress_is_blocking()); else { locks &= erts_psd_required_locks[ix].get_locks; ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].get_locks == locks - || erts_is_system_blocked(0) - || (ERTS_IS_CRASH_DUMPING - && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + || erts_thr_progress_is_blocking()); } #endif ASSERT(0 <= ix && ix < ERTS_PSD_SIZE); @@ -1240,16 +1295,11 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p); if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].set_locks) - ERTS_SMP_LC_ASSERT(locks - || erts_is_system_blocked(0) - || (ERTS_IS_CRASH_DUMPING - && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + ERTS_SMP_LC_ASSERT(locks || erts_thr_progress_is_blocking()); else { locks &= erts_psd_required_locks[ix].set_locks; ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks == locks - || erts_is_system_blocked(0) - || (ERTS_IS_CRASH_DUMPING - && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + || erts_thr_progress_is_blocking()); } #endif ASSERT(0 <= ix && ix < ERTS_PSD_SIZE); @@ -1596,8 +1646,6 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi) erts_aint32_t flags; ERTS_THR_MEMORY_BARRIER; flags = erts_smp_atomic32_read_nob(&ssi->flags); - ASSERT(!(flags & ERTS_SSI_FLG_SLEEPING) - || (flags & ERTS_SSI_FLG_WAITING)); if (flags & ERTS_SSI_FLG_SLEEPING) { flags = erts_smp_atomic32_read_band_nob(&ssi->flags, ~ERTS_SSI_FLGS_SLEEP); erts_sched_finish_poke(ssi, flags); diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 83379d7352..b4d20480c5 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -669,7 +669,9 @@ proc_safelock(Process *a_proc, ErtsProcLocks b_need_locks) { Process *p1, *p2; +#ifdef ERTS_ENABLE_LOCK_CHECK Eterm pid1, pid2; +#endif erts_pix_lock_t *pix_lck1, *pix_lck2; ErtsProcLocks need_locks1, have_locks1, need_locks2, have_locks2; ErtsProcLocks unlock_mask; @@ -684,24 +686,32 @@ proc_safelock(Process *a_proc, if (a_proc) { if (a_proc->id < b_proc->id) { p1 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = a_proc->id; +#endif pix_lck1 = a_pix_lck; need_locks1 = a_need_locks; have_locks1 = a_have_locks; p2 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = b_proc->id; +#endif pix_lck2 = b_pix_lck; need_locks2 = b_need_locks; have_locks2 = b_have_locks; } else if (a_proc->id > b_proc->id) { p1 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = b_proc->id; +#endif pix_lck1 = b_pix_lck; need_locks1 = b_need_locks; have_locks1 = b_have_locks; p2 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = a_proc->id; +#endif pix_lck2 = a_pix_lck; need_locks2 = a_need_locks; have_locks2 = a_have_locks; @@ -710,12 +720,16 @@ proc_safelock(Process *a_proc, ERTS_LC_ASSERT(a_proc == b_proc); ERTS_LC_ASSERT(a_proc->id == b_proc->id); p1 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = a_proc->id; +#endif pix_lck1 = a_pix_lck; need_locks1 = a_need_locks | b_need_locks; have_locks1 = a_have_locks | b_have_locks; p2 = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = 0; +#endif pix_lck2 = NULL; need_locks2 = 0; have_locks2 = 0; @@ -723,12 +737,16 @@ proc_safelock(Process *a_proc, } else { p1 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = b_proc->id; +#endif pix_lck1 = b_pix_lck; need_locks1 = b_need_locks; have_locks1 = b_have_locks; p2 = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = 0; +#endif pix_lck2 = NULL; need_locks2 = 0; have_locks2 = 0; diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index cd3b2182fd..97f250138e 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -651,7 +651,7 @@ ERTS_GLB_INLINE int erts_smp_proc_trylock(Process *, ErtsProcLocks); ERTS_GLB_INLINE void erts_smp_proc_inc_refc(Process *); ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *); - +ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *, Sint32); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -737,6 +737,21 @@ ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *p) #endif } +ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *p, Sint32 refc) +{ +#ifdef ERTS_SMP + Process *fp; + erts_pix_lock_t *pixlck = ERTS_PID2PIXLOCK(p->id); + erts_pix_lock(pixlck); + ERTS_LC_ASSERT(p->lock.refc > 0); + p->lock.refc += refc; + fp = p->lock.refc == 0 ? p : NULL; + erts_pix_unlock(pixlck); + if (fp) + erts_free_proc(fp); +#endif +} + #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.c b/erts/emulator/beam/erl_sched_spec_pre_alloc.c new file mode 100644 index 0000000000..a7ccea7403 --- /dev/null +++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.c @@ -0,0 +1,305 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ + +/* + * Description: Scheduler specific pre-allocators. Each scheduler + * thread allocates memory in its own private chunk of + * memory. Memory blocks deallocated by remote + * schedulers (or other threads) are passed back to + * the chunk owner via a lock-free data structure. + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef ERTS_SMP + +#include "erl_process.h" +#include "erl_thr_progress.h" + +erts_sspa_data_t * +erts_sspa_create(size_t blk_sz, int pa_size) +{ + erts_sspa_data_t *data; + size_t tot_size; + size_t chunk_mem_size; + char *p; + char *chunk_start; + int cix; + int no_blocks = pa_size; + int no_blocks_per_chunk; + + if (erts_no_schedulers == 1) + no_blocks_per_chunk = no_blocks; + else { + int extra = (no_blocks - 1)/4 + 1; + if (extra == 0) + extra = 1; + no_blocks_per_chunk = no_blocks; + no_blocks_per_chunk += extra*erts_no_schedulers; + no_blocks_per_chunk /= erts_no_schedulers; + } + no_blocks = no_blocks_per_chunk * erts_no_schedulers; + chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_chunk_header_t)); + chunk_mem_size += blk_sz * no_blocks_per_chunk; + chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(chunk_mem_size); + tot_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_data_t)); + tot_size += chunk_mem_size*erts_no_schedulers; + + p = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_PRE_ALLOC_DATA, tot_size); + data = (erts_sspa_data_t *) p; + p += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_data_t)); + chunk_start = p; + + data->chunks_mem_size = chunk_mem_size; + data->start = chunk_start; + data->end = chunk_start + chunk_mem_size*erts_no_schedulers; + + /* Initialize all chunks */ + for (cix = 0; cix < erts_no_schedulers; cix++) { + erts_sspa_chunk_t *chnk = erts_sspa_cix2chunk(data, cix); + erts_sspa_chunk_header_t *chdr = &chnk->aligned.header; + erts_sspa_blk_t *blk; + int i; + + erts_atomic_init_nob(&chdr->tail.data.last, (erts_aint_t) &chdr->tail.data.marker); + erts_atomic_init_nob(&chdr->tail.data.marker.next_atmc, ERTS_AINT_NULL); + erts_atomic_init_nob(&chdr->tail.data.um_refc[0], 0); + erts_atomic_init_nob(&chdr->tail.data.um_refc[1], 0); + erts_atomic32_init_nob(&chdr->tail.data.um_refc_ix, 0); + + chdr->head.no_thr_progress_check = 0; + chdr->head.used_marker = 1; + chdr->head.first = &chdr->tail.data.marker; + chdr->head.unref_end = &chdr->tail.data.marker; + chdr->head.next.thr_progress = erts_thr_progress_current(); + chdr->head.next.thr_progress_reached = 1; + chdr->head.next.um_refc_ix = 1; + chdr->head.next.unref_end = &chdr->tail.data.marker; + + p = &chnk->data[0]; + chdr->local.first = (erts_sspa_blk_t *) p; + blk = (erts_sspa_blk_t *) p; + for (i = 0; i < no_blocks_per_chunk; i++) { + blk = (erts_sspa_blk_t *) p; + p += blk_sz; + blk->next_ptr = (erts_sspa_blk_t *) p; + } + + blk->next_ptr = NULL; + chdr->local.last = blk; + chdr->local.cnt = no_blocks_per_chunk; + chdr->local.lim = no_blocks_per_chunk / 3; + + ERTS_SSPA_DBG_CHK_LCL(chdr); + } + + return data; +} + +static ERTS_INLINE erts_aint_t +enqueue_remote_managed_thread(erts_sspa_chunk_header_t *chdr, + erts_sspa_blk_t *this, + int want_last) +{ + erts_aint_t ilast, itmp; + + erts_atomic_init_nob(&this->next_atmc, ERTS_AINT_NULL); + + /* Enqueue at end of list... */ + + ilast = erts_atomic_read_nob(&chdr->tail.data.last); + while (1) { + erts_sspa_blk_t *last = (erts_sspa_blk_t *) ilast; + itmp = erts_atomic_cmpxchg_mb(&last->next_atmc, + (erts_aint_t) this, + ERTS_AINT_NULL); + if (itmp == ERTS_AINT_NULL) + break; + ilast = itmp; + } + + /* Move last pointer forward... */ + while (1) { + erts_aint_t itmp; + if (want_last) { + if (erts_atomic_read_rb(&this->next_atmc) != ERTS_AINT_NULL) { + /* Someone else will move it forward */ + return erts_atomic_read_nob(&chdr->tail.data.last); + } + } + else { + if (erts_atomic_read_nob(&this->next_atmc) != ERTS_AINT_NULL) { + /* Someone else will move it forward */ + return ERTS_AINT_NULL; + } + } + itmp = erts_atomic_cmpxchg_mb(&chdr->tail.data.last, + (erts_aint_t) this, + ilast); + if (ilast == itmp) + return want_last ? (erts_aint_t) this : ERTS_AINT_NULL; + ilast = itmp; + } +} + +void +erts_sspa_remote_free(erts_sspa_chunk_header_t *chdr, erts_sspa_blk_t *blk) +{ + int um_refc_ix = 0; + int managed_thread = erts_thr_progress_is_managed_thread(); + if (!managed_thread) { + um_refc_ix = erts_atomic32_read_acqb(&chdr->tail.data.um_refc_ix); + while (1) { + int tmp_um_refc_ix; + erts_atomic_inc_acqb(&chdr->tail.data.um_refc[um_refc_ix]); + tmp_um_refc_ix = erts_atomic32_read_acqb(&chdr->tail.data.um_refc_ix); + if (tmp_um_refc_ix == um_refc_ix) + break; + erts_atomic_dec_relb(&chdr->tail.data.um_refc[um_refc_ix]); + um_refc_ix = tmp_um_refc_ix; + } + } + + (void) enqueue_remote_managed_thread(chdr, blk, 0); + + if (!managed_thread) + erts_atomic_dec_relb(&chdr->tail.data.um_refc[um_refc_ix]); +} + +static ERTS_INLINE void +fetch_remote(erts_sspa_chunk_header_t *chdr, int max) +{ + int new_local = 0; + + if (chdr->head.no_thr_progress_check < ERTS_SSPA_FORCE_THR_CHECK_PROGRESS) + chdr->head.no_thr_progress_check++; + else { + erts_aint_t ilast; + + chdr->head.no_thr_progress_check = 0; + + ilast = erts_atomic_read_nob(&chdr->tail.data.last); + if (((erts_sspa_blk_t *) ilast) == &chdr->tail.data.marker + && chdr->head.first == &chdr->tail.data.marker) + return; + + if (chdr->head.next.thr_progress_reached + || erts_thr_progress_has_reached(chdr->head.next.thr_progress)) { + int um_refc_ix; + chdr->head.next.thr_progress_reached = 1; + um_refc_ix = chdr->head.next.um_refc_ix; + if (erts_atomic_read_acqb(&chdr->tail.data.um_refc[um_refc_ix]) == 0) { + + /* Move unreferenced end pointer forward... */ + + chdr->head.unref_end = chdr->head.next.unref_end; + + if (!chdr->head.used_marker + && chdr->head.unref_end == (erts_sspa_blk_t *) ilast) { + /* Need to equeue marker */ + chdr->head.used_marker = 1; + ilast = enqueue_remote_managed_thread(chdr, + &chdr->tail.data.marker, + 1); + } + + if (chdr->head.unref_end == (erts_sspa_blk_t *) ilast) + ERTS_THR_MEMORY_BARRIER; + else { + chdr->head.next.unref_end = (erts_sspa_blk_t *) ilast; + ERTS_THR_MEMORY_BARRIER; + chdr->head.next.thr_progress = erts_thr_progress_later(); + erts_atomic32_set_relb(&chdr->tail.data.um_refc_ix, + um_refc_ix); + chdr->head.next.um_refc_ix = um_refc_ix == 0 ? 1 : 0; + chdr->head.next.thr_progress_reached = 0; + } + } + } + } + + if (new_local < max && chdr->head.first != chdr->head.unref_end) { + erts_sspa_blk_t *first, *this, *next, *last; + first = chdr->head.first; + if (first == &chdr->tail.data.marker) { + chdr->head.used_marker = 0; + first = ((erts_sspa_blk_t *) + erts_atomic_read_nob(&first->next_atmc)); + chdr->head.first = first; + } + if (first != chdr->head.unref_end) { + + ERTS_SSPA_DBG_CHK_LCL(chdr); + + this = last = first; + do { + next = (erts_sspa_blk_t *) erts_atomic_read_nob(&this->next_atmc); + if (this == &chdr->tail.data.marker) + chdr->head.used_marker = 0; + else { + last->next_ptr = this; + last = this; + new_local++; + } + this = next; + } while (new_local < max && this != chdr->head.unref_end); + chdr->head.first = this; + if (!chdr->local.last) + chdr->local.first = first; + else + chdr->local.last->next_ptr = first; + chdr->local.last = last; + last->next_ptr = NULL; + chdr->local.cnt += new_local; + + ERTS_SSPA_DBG_CHK_LCL(chdr); + } + } + +} + +erts_sspa_blk_t * +erts_sspa_process_remote_frees(erts_sspa_chunk_header_t *chdr, + erts_sspa_blk_t *old_res) +{ + erts_sspa_blk_t *res = old_res; + + fetch_remote(chdr, ERTS_SSPA_MAX_GET_NEW_LOCAL); + + if (!res && chdr->local.first) { + + ERTS_SSPA_DBG_CHK_LCL(chdr); + + res = chdr->local.first; + chdr->local.first = res->next_ptr; + chdr->local.cnt--; + if (!chdr->local.first) + chdr->local.last = NULL; + + ERTS_SSPA_DBG_CHK_LCL(chdr); + } + + return res; +} + +#endif /* ERTS_SMP */ diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.h b/erts/emulator/beam/erl_sched_spec_pre_alloc.h new file mode 100644 index 0000000000..d36066c399 --- /dev/null +++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.h @@ -0,0 +1,239 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ + +/* + * Description: Scheduler specific pre-allocators. Each scheduler + * thread allocates memory in its own private chunk of + * memory. Memory blocks deallocated by remote + * schedulers (or other threads) are passed back to + * the chunk owner via a lock-free data structure. + * + * Author: Rickard Green + */ + +#ifndef ERTS_SCHED_SPEC_PRE_ALLOC_H__ +#define ERTS_SCHED_SPEC_PRE_ALLOC_H__ + +#ifdef ERTS_SMP + +#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY +#define ERL_THR_PROGRESS_TSD_TYPE_ONLY +#include "erl_thr_progress.h" +#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY + +#ifdef DEBUG +#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P) \ +do { \ + ASSERT((void *) (C) < (void *) (P)); \ + ASSERT((void *) (P) \ + < (void *) (((char *) (C)) + (A)->chunks_mem_size)); \ +} while (0) +#else +#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P) +#endif + +#ifdef DEBUG +extern Uint erts_no_schedulers; +#endif + +#define ERTS_SSPA_FORCE_THR_CHECK_PROGRESS 10 +#define ERTS_SSPA_MAX_GET_NEW_LOCAL 5 + +typedef struct { + char *start; + char *end; + int chunks_mem_size; +} erts_sspa_data_t; + +typedef union erts_sspa_blk_t_ erts_sspa_blk_t; +union erts_sspa_blk_t_ { + erts_atomic_t next_atmc; + erts_sspa_blk_t *next_ptr; +}; + +typedef struct { + erts_sspa_blk_t *first; + erts_sspa_blk_t *last; + int cnt; + int lim; +} erts_sspa_local_freelist_t; + +typedef struct { + erts_sspa_blk_t marker; + erts_atomic_t last; + erts_atomic_t um_refc[2]; + erts_atomic32_t um_refc_ix; +} erts_sspa_tail_t; + +typedef struct { + /* + * This structure needs to be cache line aligned for best + * performance. + */ + union { + /* Modified by threads returning memory to this chunk */ + erts_sspa_tail_t data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_tail_t))]; + } tail; + /* + * Everything below this point is *only* accessed by the + * thread owning this chunk. + */ + struct { + int no_thr_progress_check; + int used_marker; + erts_sspa_blk_t *first; + erts_sspa_blk_t *unref_end; + struct { + ErtsThrPrgrVal thr_progress; + int thr_progress_reached; + int um_refc_ix; + erts_sspa_blk_t *unref_end; + } next; + } head; + erts_sspa_local_freelist_t local; +} erts_sspa_chunk_header_t; + +typedef struct { + union { + erts_sspa_chunk_header_t header; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE( + sizeof(erts_sspa_chunk_header_t))]; + } aligned; + char data[1]; +} erts_sspa_chunk_t; + +#ifdef DEBUG +ERTS_GLB_INLINE void +check_local_list(erts_sspa_chunk_header_t *chdr); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE void +check_local_list(erts_sspa_chunk_header_t *chdr) +{ + erts_sspa_blk_t *blk; + int n = 0; + for (blk = chdr->local.first; blk; blk = blk->next_ptr) + n++; + ASSERT(n == chdr->local.cnt); +} +#endif +#define ERTS_SSPA_DBG_CHK_LCL(CHDR) check_local_list((CHDR)) +#else +#define ERTS_SSPA_DBG_CHK_LCL(CHDR) +#endif + +erts_sspa_data_t *erts_sspa_create(size_t blk_sz, + int pa_size); +void erts_sspa_remote_free(erts_sspa_chunk_header_t *chdr, + erts_sspa_blk_t *blk); +erts_sspa_blk_t *erts_sspa_process_remote_frees(erts_sspa_chunk_header_t *chdr, + erts_sspa_blk_t *old_res); + +ERTS_GLB_INLINE erts_sspa_chunk_t *erts_sspa_cix2chunk(erts_sspa_data_t *data, + int cix); +ERTS_GLB_INLINE int erts_sspa_ptr2cix(erts_sspa_data_t *data, void *ptr); +ERTS_GLB_INLINE char *erts_sspa_alloc(erts_sspa_data_t *data, int cix); +ERTS_GLB_INLINE int erts_sspa_free(erts_sspa_data_t *data, int cix, char *blk); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE erts_sspa_chunk_t * +erts_sspa_cix2chunk(erts_sspa_data_t *data, int cix) +{ + ASSERT(0 <= cix && cix < erts_no_schedulers); + return (erts_sspa_chunk_t *) (data->start + cix*data->chunks_mem_size); +} + +ERTS_GLB_INLINE int +erts_sspa_ptr2cix(erts_sspa_data_t *data, void *ptr) +{ + int cix; + size_t diff; + if ((char *) ptr < data->start || data->end <= (char *) ptr) + return -1; + diff = ((char *) ptr) - data->start; + cix = (int) diff / data->chunks_mem_size; + ASSERT(0 <= cix && cix < erts_no_schedulers); + return cix; +} + +ERTS_GLB_INLINE char * +erts_sspa_alloc(erts_sspa_data_t *data, int cix) +{ + erts_sspa_chunk_t *chnk; + erts_sspa_chunk_header_t *chdr; + erts_sspa_blk_t *res; + + chnk = erts_sspa_cix2chunk(data, cix); + chdr = &chnk->aligned.header; + res = chdr->local.first; + ERTS_SSPA_DBG_CHK_LCL(chdr); + if (res) { + ERTS_SSPA_DBG_CHK_LCL(chdr); + chdr->local.first = res->next_ptr; + chdr->local.cnt--; + if (!chdr->local.first) + chdr->local.last = NULL; + ERTS_SSPA_DBG_CHK_LCL(chdr); + } + if (chdr->local.cnt <= chdr->local.lim) + return (char *) erts_sspa_process_remote_frees(chdr, res); + else if (chdr->head.no_thr_progress_check < ERTS_SSPA_FORCE_THR_CHECK_PROGRESS) + chdr->head.no_thr_progress_check++; + ASSERT(res); + return (char *) res; +} + +ERTS_GLB_INLINE int +erts_sspa_free(erts_sspa_data_t *data, int cix, char *cblk) +{ + erts_sspa_chunk_t *chnk; + erts_sspa_chunk_header_t *chdr; + erts_sspa_blk_t *blk = (erts_sspa_blk_t *) cblk; + int chnk_cix = erts_sspa_ptr2cix(data, blk); + + if (chnk_cix < 0) + return 0; + + chnk = erts_sspa_cix2chunk(data, chnk_cix); + chdr = &chnk->aligned.header; + if (chnk_cix != cix) { + /* Remote chunk */ + erts_sspa_remote_free(chdr, blk); + } + else { + /* Local chunk */ + ERTS_SSPA_DBG_CHK_LCL(chdr); + blk->next_ptr = chdr->local.first; + chdr->local.first = blk; + if (!chdr->local.last) + chdr->local.last = blk; + chdr->local.cnt++; + ERTS_SSPA_DBG_CHK_LCL(chdr); + } + + return 1; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERTS_SMP */ + +#endif /* ERTS_SCHED_SPEC_PRE_ALLOC_H__ */ diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h index a89ddfbcc1..63179dfad4 100644 --- a/erts/emulator/beam/erl_smp.h +++ b/erts/emulator/beam/erl_smp.h @@ -822,6 +822,16 @@ erts_smp_cnd_wait(erts_smp_cnd_t *cnd, erts_smp_mtx_t *mtx) #endif } +/* + * IMPORTANT note about erts_smp_cnd_signal() and erts_smp_cnd_broadcast() + * + * POSIX allow a call to `pthread_cond_signal' or `pthread_cond_broadcast' + * even though the associated mutex/mutexes isn't/aren't locked by the + * caller. Our implementation do not allow that in order to avoid a + * performance penalty. That is, all associated mutexes *need* to be + * locked by the caller of erts_smp_cnd_signal()/erts_smp_cnd_broadcast()! + */ + ERTS_GLB_INLINE void erts_smp_cnd_signal(erts_smp_cnd_t *cnd) { diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 1d75fa313c..bc20b2d798 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -331,7 +331,13 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm) * we now use a non-zero bit-pattern in debug mode. */ #if ET_DEBUG -#define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT) +# ifdef HIPE + /* A very large (or negative) value as work-around for ugly hipe-bifs + that return untagged integers (eg hipe_bs_put_utf8) */ +# define THE_NON_VALUE _make_header((Uint)~0,_TAG_HEADER_FLOAT) +# else +# define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT) +# endif #else #define THE_NON_VALUE (0) #endif diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c new file mode 100644 index 0000000000..9324bcde51 --- /dev/null +++ b/erts/emulator/beam/erl_thr_progress.c @@ -0,0 +1,1373 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ + +/* + * Description: Thread progress information. Used by lock free algorithms + * to determine when all involved threads are guaranteed to + * have passed a specific point of execution. + * + * Usage instructions below. + * + * Author: Rickard Green + */ + +/* + * ------ Usage instructions ----------------------------------------------- + * + * This module keeps track of the progress of a set of managed threads. Only + * threads that behave well can be allowed to be managed. A managed thread + * should update its thread progress frequently. Currently only scheduler + * threads and the aux_thread are managed threads. We typically do not want + * any async threads as managed threads since they cannot guarantee a + * frequent update of thread progress, since they execute user implemented + * driver code. + * + * erts_thr_progress_current() returns the global current thread progress + * value of managed threads. I.e., the latest progress value that all + * managed threads have reached. Thread progress values are opaque. + * + * erts_thr_progress_has_reached(VAL) returns a value != 0 if current + * global thread progress has reached or passed VAL. + * + * erts_thr_progress_later() returns a thread progress value in the future + * which no managed thread have yet reached. + * + * All threads issue a full memory barrier when reaching a new thread + * progress value. They only reach new thread progress values in specific + * controlled states when calling erts_thr_progress_update(). Schedulers + * call erts_thr_progress_update() in between execution of processes, + * when going to sleep and when waking up. + * + * Sleeping managed threads are considered to have reached next thread + * progress value immediately. They are not woken and do therefore not + * issue any memory barriers when reaching a new thread progress value. + * A sleeping thread do however immediately issue a memory barrier upon + * wakeup. + * + * Both managed and registered unmanaged threads may request wakeup when + * the global thread progress reach a certain value using + * erts_thr_progress_wakeup(). + * + * Note that thread progress values are opaque, and that you are only + * allowed to use thread progress values retrieved from this API! + * + * ------------------------------------------------------------------------- + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include <stddef.h> /* offsetof() */ +#include "erl_thr_progress.h" +#include "global.h" + +#ifdef ERTS_SMP + +/* + * We use a 64-bit value for thread progress. By this wrapping of + * the thread progress will more or less never occur. + * + * On 32-bit systems we therefore need a double word atomic. + */ + +#define ERTS_THR_PRGR_PRINT_LEADER 0 +#define ERTS_THR_PRGR_PRINT_VAL 0 +#define ERTS_THR_PRGR_PRINT_BLOCKERS 0 + +#define ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL 100 + +#define ERTS_THR_PRGR_LFLG_BLOCK (((erts_aint32_t) 1) << 31) +#define ERTS_THR_PRGR_LFLG_NO_LEADER (((erts_aint32_t) 1) << 30) +#define ERTS_THR_PRGR_LFLG_ACTIVE_MASK (~(ERTS_THR_PRGR_LFLG_NO_LEADER \ + | ERTS_THR_PRGR_LFLG_BLOCK)) + +#define ERTS_THR_PRGR_LFLGS_ACTIVE(LFLGS) \ + ((LFLGS) & ERTS_THR_PRGR_LFLG_ACTIVE_MASK) + +#define ERTS_THR_PRGR_LFLGS_ALL_WAITING(LFLGS) \ + (((LFLGS) & (ERTS_THR_PRGR_LFLG_NO_LEADER \ + |ERTS_THR_PRGR_LFLG_ACTIVE_MASK)) \ + == ERTS_THR_PRGR_LFLG_NO_LEADER) + +#define read_acqb erts_thr_prgr_read_acqb__ + +#ifdef ARCH_64 + +static ERTS_INLINE void +set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) +{ + erts_atomic_set_mb(atmc, val); +} + +static ERTS_INLINE void +set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) +{ + erts_atomic_set_nob(atmc, val); +} + +static ERTS_INLINE ErtsThrPrgrVal +read_nob(ERTS_THR_PRGR_ATOMIC *atmc) +{ + return (ErtsThrPrgrVal) erts_atomic_read_nob(atmc); +} + +static ERTS_INLINE void +init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) +{ + erts_atomic_init_nob(atmc, val); +} + +#else + +#undef dw_sint_to_val +#define dw_sint_to_val erts_thr_prgr_dw_sint_to_val__ + +static void +val_to_dw_sint(ethr_dw_sint_t *dw_sint, ErtsThrPrgrVal val) +{ +#ifdef ETHR_SU_DW_NAINT_T__ + dw_sint->dw_sint = (ETHR_SU_DW_NAINT_T__) val; +#else + dw_sint->sint[ETHR_DW_SINT_LOW_WORD] + = (ethr_sint_t) (val & 0xffffffff); + dw_sint->sint[ETHR_DW_SINT_HIGH_WORD] + = (ethr_sint_t) ((val >> 32) & 0xffffffff); +#endif +} + +static ERTS_INLINE void +set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) +{ + ethr_dw_sint_t dw_sint; + val_to_dw_sint(&dw_sint, val); + erts_dw_atomic_set_mb(atmc, &dw_sint); +} + +static ERTS_INLINE void +set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) +{ + ethr_dw_sint_t dw_sint; + val_to_dw_sint(&dw_sint, val); + erts_dw_atomic_set_nob(atmc, &dw_sint); +} + +static ERTS_INLINE ErtsThrPrgrVal +read_nob(ERTS_THR_PRGR_ATOMIC *atmc) +{ + ethr_dw_sint_t dw_sint; + erts_dw_atomic_read_nob(atmc, &dw_sint); + return erts_thr_prgr_dw_sint_to_val__(&dw_sint); +} + +static ERTS_INLINE void +init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) +{ + ethr_dw_sint_t dw_sint; + val_to_dw_sint(&dw_sint, val); + erts_dw_atomic_init_nob(atmc, &dw_sint); +} + +#endif + +/* #define ERTS_THR_PROGRESS_STATE_DEBUG */ + +#ifdef ERTS_THR_PROGRESS_STATE_DEBUG + +#ifdef __GNUC__ +#warning "Thread progress state debug is on" +#endif + +#define ERTS_THR_PROGRESS_STATE_DEBUG_LEADER (((erts_aint32_t) 1) << 0) +#define ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE (((erts_aint32_t) 1) << 1) + +#define ERTS_THR_PROGRESS_STATE_DEBUG_INIT(ID) \ + erts_atomic32_init_nob(&intrnl->thr[(ID)].data.state_debug, \ + ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE) + +#define ERTS_THR_PROGRESS_STATE_DEBUG_SET_ACTIVE(ID, ON) \ +do { \ + erts_aint32_t state_debug__; \ + state_debug__ = erts_atomic32_read_nob(&intrnl->thr[(ID)].data.state_debug); \ + if ((ON)) \ + state_debug__ |= ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE; \ + else \ + state_debug__ &= ~ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE; \ + erts_atomic32_set_nob(&intrnl->thr[(ID)].data.state_debug, state_debug__); \ +} while (0) + +#define ERTS_THR_PROGRESS_STATE_DEBUG_SET_LEADER(ID, ON) \ +do { \ + erts_aint32_t state_debug__; \ + state_debug__ = erts_atomic32_read_nob(&intrnl->thr[(ID)].data.state_debug); \ + if ((ON)) \ + state_debug__ |= ERTS_THR_PROGRESS_STATE_DEBUG_LEADER; \ + else \ + state_debug__ &= ~ERTS_THR_PROGRESS_STATE_DEBUG_LEADER; \ + erts_atomic32_set_nob(&intrnl->thr[(ID)].data.state_debug, state_debug__); \ +} while (0) + +#else + +#define ERTS_THR_PROGRESS_STATE_DEBUG_INIT(ID) +#define ERTS_THR_PROGRESS_STATE_DEBUG_SET_ACTIVE(ID, ON) +#define ERTS_THR_PROGRESS_STATE_DEBUG_SET_LEADER(ID, ON) + +#endif /* ERTS_THR_PROGRESS_STATE_DEBUG */ + +#define ERTS_THR_PRGR_BLCKR_INVALID (~((erts_aint32_t) 0)) +#define ERTS_THR_PRGR_BLCKR_UNMANAGED (((erts_aint32_t) 1) << 31) + +#define ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING (((erts_aint32_t) 1) << 31) + +#define ERTS_THR_PRGR_BM_BITS 32 +#define ERTS_THR_PRGR_BM_SHIFT 5 +#define ERTS_THR_PRGR_BM_MASK 0x1f + +#define ERTS_THR_PRGR_WAKEUP_DATA_MASK (ERTS_THR_PRGR_WAKEUP_DATA_SIZE - 1) + +#define ERTS_THR_PRGR_WAKEUP_IX(V) \ + ((int) ((V) & ERTS_THR_PRGR_WAKEUP_DATA_MASK)) + +typedef struct { + erts_atomic32_t len; + int id[1]; +} ErtsThrPrgrManagedWakeupData; + +typedef struct { + erts_atomic32_t len; + int high_sz; + int low_sz; + erts_atomic32_t *high; + erts_atomic32_t *low; +} ErtsThrPrgrUnmanagedWakeupData; + +typedef struct { + erts_atomic32_t lflgs; + erts_atomic32_t block_count; + erts_atomic_t blocker_event; + erts_atomic32_t pref_wakeup_used; + erts_atomic32_t managed_count; + erts_atomic32_t managed_id; + erts_atomic32_t unmanaged_id; +} ErtsThrPrgrMiscData; + +typedef struct { + ERTS_THR_PRGR_ATOMIC current; +#ifdef ERTS_THR_PROGRESS_STATE_DEBUG + erts_atomic32_t state_debug; +#endif +} ErtsThrPrgrElement; + +typedef union { + ErtsThrPrgrElement data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrPrgrElement))]; +} ErtsThrPrgrArray; + +typedef struct { + union { + ErtsThrPrgrMiscData data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE( + sizeof(ErtsThrPrgrMiscData))]; + } misc; + ErtsThrPrgrArray *thr; + struct { + int no; + ErtsThrPrgrCallbacks *callbacks; + ErtsThrPrgrManagedWakeupData *data[ERTS_THR_PRGR_WAKEUP_DATA_SIZE]; + } managed; + struct { + int no; + ErtsThrPrgrCallbacks *callbacks; + ErtsThrPrgrUnmanagedWakeupData *data[ERTS_THR_PRGR_WAKEUP_DATA_SIZE]; + } unmanaged; +} ErtsThrPrgrInternalData; + +static ErtsThrPrgrInternalData *intrnl; + +ErtsThrPrgr erts_thr_prgr__; + +erts_tsd_key_t erts_thr_prgr_data_key__; + +static void handle_wakeup_requests(ErtsThrPrgrVal current); +static int got_sched_wakeups(void); +static erts_aint32_t block_thread(ErtsThrPrgrData *tpd); + +static ERTS_INLINE void +wakeup_managed(int id) +{ + ErtsThrPrgrCallbacks *cbp = &intrnl->managed.callbacks[id]; + ASSERT(0 <= id && id < intrnl->managed.no); + cbp->wakeup(cbp->arg); +} + + +static ERTS_INLINE void +wakeup_unmanaged(int id) +{ + ErtsThrPrgrCallbacks *cbp = &intrnl->unmanaged.callbacks[id]; + ASSERT(0 <= id && id < intrnl->unmanaged.no); + cbp->wakeup(cbp->arg); +} + +static ERTS_INLINE ErtsThrPrgrData * +perhaps_thr_prgr_data(ErtsSchedulerData *esdp) +{ + if (esdp) + return &esdp->thr_progress_data; + else + return erts_tsd_get(erts_thr_prgr_data_key__); +} + +static ERTS_INLINE ErtsThrPrgrData * +thr_prgr_data(ErtsSchedulerData *esdp) +{ + ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(esdp); + ASSERT(tpd); + return tpd; +} + +static void +init_tmp_thr_prgr_data(ErtsThrPrgrData *tpd) +{ + tpd->id = -1; + tpd->is_managed = 0; + tpd->is_blocking = 0; + tpd->is_temporary = 1; + + erts_tsd_set(erts_thr_prgr_data_key__, (void *) tpd); +} + +static ERTS_INLINE ErtsThrPrgrData * +tmp_thr_prgr_data(ErtsSchedulerData *esdp) +{ + ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(esdp); + + if (!tpd) { + /* + * We only allocate the part up to the wakeup_request field + * which is the first field only used by registered threads + */ + tpd = erts_alloc(ERTS_ALC_T_T_THR_PRGR_DATA, + offsetof(ErtsThrPrgrData, wakeup_request)); + init_tmp_thr_prgr_data(tpd); + } + + return tpd; +} + +static ERTS_INLINE void +return_tmp_thr_prgr_data(ErtsThrPrgrData *tpd) +{ + if (tpd->is_temporary) { + erts_tsd_set(erts_thr_prgr_data_key__, NULL); + erts_free(ERTS_ALC_T_T_THR_PRGR_DATA, tpd); + } +} + +static ERTS_INLINE int +block_count_dec(void) +{ + erts_aint32_t block_count; + block_count = erts_atomic32_dec_read_mb(&intrnl->misc.data.block_count); + if (block_count == 0) { + erts_tse_t *event; + event = ((erts_tse_t*) + erts_atomic_read_nob(&intrnl->misc.data.blocker_event)); + if (event) + erts_tse_set(event); + return 1; + } + + return (block_count & ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING) == 0; +} + +static ERTS_INLINE int +block_count_inc(void) +{ + erts_aint32_t block_count; + block_count = erts_atomic32_inc_read_mb(&intrnl->misc.data.block_count); + return (block_count & ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING) == 0; +} + + +void +erts_thr_progress_pre_init(void) +{ + intrnl = NULL; + erts_tsd_key_create(&erts_thr_prgr_data_key__); + init_nob(&erts_thr_prgr__.current, 0); +} + +void +erts_thr_progress_init(int no_schedulers, int managed, int unmanaged) +{ + int i, j, um_low, um_high; + char *ptr; + size_t cb_sz, intrnl_sz, thr_arr_sz, m_wakeup_size, um_wakeup_size, + tot_size; + + intrnl_sz = sizeof(ErtsThrPrgrInternalData); + intrnl_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(intrnl_sz); + + cb_sz = sizeof(ErtsThrPrgrCallbacks)*(managed+unmanaged); + cb_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(cb_sz); + + thr_arr_sz = sizeof(ErtsThrPrgrArray)*managed; + ASSERT(thr_arr_sz == ERTS_ALC_CACHE_LINE_ALIGN_SIZE(thr_arr_sz)); + + m_wakeup_size = sizeof(ErtsThrPrgrManagedWakeupData); + m_wakeup_size += (managed - 1)*sizeof(int); + m_wakeup_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(m_wakeup_size); + + um_low = (unmanaged - 1)/ERTS_THR_PRGR_BM_BITS + 1; + um_high = (um_low - 1)/ERTS_THR_PRGR_BM_BITS + 1; + + um_wakeup_size = sizeof(ErtsThrPrgrUnmanagedWakeupData); + um_wakeup_size += (um_high + um_low)*sizeof(erts_atomic32_t); + um_wakeup_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(um_wakeup_size); + + tot_size = intrnl_sz; + tot_size += cb_sz; + tot_size += thr_arr_sz; + tot_size += m_wakeup_size*ERTS_THR_PRGR_WAKEUP_DATA_SIZE; + tot_size += um_wakeup_size*ERTS_THR_PRGR_WAKEUP_DATA_SIZE; + + ptr = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_THR_PRGR_IDATA, + tot_size); + + intrnl = (ErtsThrPrgrInternalData *) ptr; + ptr += intrnl_sz; + + erts_atomic32_init_nob(&intrnl->misc.data.lflgs, + ERTS_THR_PRGR_LFLG_NO_LEADER); + erts_atomic32_init_nob(&intrnl->misc.data.block_count, + (ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING + | (erts_aint32_t) managed)); + erts_atomic_init_nob(&intrnl->misc.data.blocker_event, ERTS_AINT_NULL); + erts_atomic32_init_nob(&intrnl->misc.data.pref_wakeup_used, 0); + erts_atomic32_init_nob(&intrnl->misc.data.managed_count, 0); + erts_atomic32_init_nob(&intrnl->misc.data.managed_id, no_schedulers); + erts_atomic32_init_nob(&intrnl->misc.data.unmanaged_id, -1); + + intrnl->thr = (ErtsThrPrgrArray *) ptr; + ptr += thr_arr_sz; + for (i = 0; i < managed; i++) + init_nob(&intrnl->thr[i].data.current, 0); + + intrnl->managed.callbacks = (ErtsThrPrgrCallbacks *) ptr; + intrnl->unmanaged.callbacks = &intrnl->managed.callbacks[managed]; + ptr += cb_sz; + + intrnl->managed.no = managed; + for (i = 0; i < managed; i++) { + intrnl->managed.callbacks[i].arg = NULL; + intrnl->managed.callbacks[i].wakeup = NULL; + } + + intrnl->unmanaged.no = unmanaged; + for (i = 0; i < unmanaged; i++) { + intrnl->unmanaged.callbacks[i].arg = NULL; + intrnl->unmanaged.callbacks[i].wakeup = NULL; + } + + for (i = 0; i < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; i++) { + intrnl->managed.data[i] = (ErtsThrPrgrManagedWakeupData *) ptr; + erts_atomic32_init_nob(&intrnl->managed.data[i]->len, 0); + ptr += m_wakeup_size; + } + + for (i = 0; i < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; i++) { + erts_atomic32_t *bm; + intrnl->unmanaged.data[i] = (ErtsThrPrgrUnmanagedWakeupData *) ptr; + erts_atomic32_init_nob(&intrnl->unmanaged.data[i]->len, 0); + bm = (erts_atomic32_t *) (ptr + sizeof(ErtsThrPrgrUnmanagedWakeupData)); + intrnl->unmanaged.data[i]->high = bm; + intrnl->unmanaged.data[i]->high_sz = um_high; + for (j = 0; j < um_high; j++) + erts_atomic32_init_nob(&intrnl->unmanaged.data[i]->high[j], 0); + intrnl->unmanaged.data[i]->low + = &intrnl->unmanaged.data[i]->high[um_high]; + intrnl->unmanaged.data[i]->low_sz = um_low; + for (j = 0; j < um_low; j++) + erts_atomic32_init_nob(&intrnl->unmanaged.data[i]->low[j], 0); + ptr += um_wakeup_size; + } + ERTS_THR_MEMORY_BARRIER; +} + +static void +init_wakeup_request_array(ErtsThrPrgrVal *w) +{ + int i; + ErtsThrPrgrVal current; + + current = read_acqb(&erts_thr_prgr__.current); + for (i = 0; i < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; i++) { + w[i] = current - ((ErtsThrPrgrVal) (ERTS_THR_PRGR_WAKEUP_DATA_SIZE + i)); + if (w[i] > current) + w[i]--; + } +} + +void +erts_thr_progress_register_unmanaged_thread(ErtsThrPrgrCallbacks *callbacks) +{ + ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL); + int is_blocking = 0; + + if (tpd) { + if (!tpd->is_temporary) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:%s(): Double register of thread\n", + __FILE__, __LINE__, __func__); + is_blocking = tpd->is_blocking; + return_tmp_thr_prgr_data(tpd); + } + + /* + * We only allocate the part up to the leader field + * which is the first field only used by managed threads + */ + tpd = erts_alloc(ERTS_ALC_T_THR_PRGR_DATA, + offsetof(ErtsThrPrgrData, leader)); + tpd->id = (int) erts_atomic32_inc_read_nob(&intrnl->misc.data.unmanaged_id); + tpd->is_managed = 0; + tpd->is_blocking = is_blocking; + tpd->is_temporary = 0; + ASSERT(tpd->id >= 0); + if (tpd->id >= intrnl->unmanaged.no) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:%s(): Too many unmanaged registered threads\n", + __FILE__, __LINE__, __func__); + + init_wakeup_request_array(&tpd->wakeup_request[0]); + erts_tsd_set(erts_thr_prgr_data_key__, (void *) tpd); + + ASSERT(callbacks->wakeup); + + intrnl->unmanaged.callbacks[tpd->id] = *callbacks; +} + + +void +erts_thr_progress_register_managed_thread(ErtsSchedulerData *esdp, + ErtsThrPrgrCallbacks *callbacks, + int pref_wakeup) +{ + ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL); + int is_blocking = 0, managed; + + if (tpd) { + if (!tpd->is_temporary) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:%s(): Double register of thread\n", + __FILE__, __LINE__, __func__); + is_blocking = tpd->is_blocking; + return_tmp_thr_prgr_data(tpd); + } + + if (esdp) + tpd = &esdp->thr_progress_data; + else + tpd = erts_alloc(ERTS_ALC_T_THR_PRGR_DATA, sizeof(ErtsThrPrgrData)); + + if (pref_wakeup + && !erts_atomic32_xchg_nob(&intrnl->misc.data.pref_wakeup_used, 1)) + tpd->id = 0; + else if (esdp) + tpd->id = (int) esdp->no; + else + tpd->id = erts_atomic32_inc_read_nob(&intrnl->misc.data.managed_id); + ASSERT(tpd->id >= 0); + if (tpd->id >= intrnl->managed.no) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:%s(): Too many managed registered threads\n", + __FILE__, __LINE__, __func__); + + tpd->is_managed = 1; + tpd->is_blocking = is_blocking; + tpd->is_temporary = 0; + + init_wakeup_request_array(&tpd->wakeup_request[0]); + + ERTS_THR_PROGRESS_STATE_DEBUG_INIT(tpd->id); + + tpd->leader = 0; + tpd->active = 1; + tpd->previous.local = 0; + tpd->previous.current = ERTS_THR_PRGR_VAL_WAITING; + erts_tsd_set(erts_thr_prgr_data_key__, (void *) tpd); + + erts_atomic32_inc_nob(&intrnl->misc.data.lflgs); + + ASSERT(callbacks->wakeup); + ASSERT(callbacks->prepare_wait); + ASSERT(callbacks->wait); + ASSERT(callbacks->finalize_wait); + + intrnl->managed.callbacks[tpd->id] = *callbacks; + + callbacks->prepare_wait(callbacks->arg); + managed = erts_atomic32_inc_read_relb(&intrnl->misc.data.managed_count); + if (managed != intrnl->managed.no) { + /* Wait until all managed threads have registered... */ + do { + callbacks->wait(callbacks->arg); + callbacks->prepare_wait(callbacks->arg); + managed = erts_atomic32_read_acqb(&intrnl->misc.data.managed_count); + } while (managed != intrnl->managed.no); + } + else { + int id; + /* All managed threads have registered; lets go... */ + for (id = 0; id < managed; id++) + if (id != tpd->id) + wakeup_managed(id); + } + callbacks->finalize_wait(callbacks->arg); +} + +static ERTS_INLINE int +leader_update(ErtsThrPrgrData *tpd) +{ +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); +#endif + if (!tpd->leader) { + /* Probably need to block... */ + block_thread(tpd); + } + else { + erts_aint32_t lflgs; + ErtsThrPrgrVal next; + int ix, sz, make_progress; + + if (tpd->previous.current == ERTS_THR_PRGR_VAL_WAITING) { + /* Took over as leader from another thread */ + tpd->previous.current = read_acqb(&erts_thr_prgr__.current); + tpd->previous.next = tpd->previous.current; + tpd->previous.next++; + if (tpd->previous.next == ERTS_THR_PRGR_VAL_WAITING) + tpd->previous.next = 0; + } + + if (tpd->previous.local == tpd->previous.current) { + ErtsThrPrgrVal val = tpd->previous.current + 1; + if (val == ERTS_THR_PRGR_VAL_WAITING) + val = 0; + tpd->previous.local = val; + set_mb(&intrnl->thr[tpd->id].data.current, val); + } + + next = tpd->previous.next; + + make_progress = 1; + sz = intrnl->managed.no; + for (ix = 0; ix < sz; ix++) { + ErtsThrPrgrVal tmp; + tmp = read_nob(&intrnl->thr[ix].data.current); + if (tmp != next && tmp != ERTS_THR_PRGR_VAL_WAITING) { + make_progress = 0; + ASSERT(erts_thr_progress_has_passed__(next, tmp)); + break; + } + } + + if (make_progress) { + ErtsThrPrgrVal current = next; + + next++; + if (next == ERTS_THR_PRGR_VAL_WAITING) + next = 0; + + set_nob(&intrnl->thr[tpd->id].data.current, next); + set_mb(&erts_thr_prgr__.current, current); + tpd->previous.local = next; + tpd->previous.next = next; + tpd->previous.current = current; + +#if ERTS_THR_PRGR_PRINT_VAL + if (current % 1000 == 0) + erts_fprintf(stderr, "%b64u\n", current); +#endif + handle_wakeup_requests(current); + } + + if (tpd->active) { + lflgs = erts_atomic32_read_nob(&intrnl->misc.data.lflgs); + if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK) + (void) block_thread(tpd); + } + else { + tpd->leader = 0; + tpd->previous.current = ERTS_THR_PRGR_VAL_WAITING; +#if ERTS_THR_PRGR_PRINT_LEADER + erts_fprintf(stderr, "L <- %d\n", tpd->id); +#endif + + ERTS_THR_PROGRESS_STATE_DEBUG_SET_LEADER(tpd->id, 0); + + lflgs = erts_atomic32_read_bor_relb(&intrnl->misc.data.lflgs, + ERTS_THR_PRGR_LFLG_NO_LEADER); + if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK) + lflgs = block_thread(tpd); + if (ERTS_THR_PRGR_LFLGS_ACTIVE(lflgs) == 0 && got_sched_wakeups()) + wakeup_managed(0); + } + } + + return tpd->leader; +} + +static int +update(ErtsThrPrgrData *tpd) +{ + int res; + ErtsThrPrgrVal val; + + if (tpd->leader) + res = 1; + else { + erts_aint32_t lflgs; + res = 0; + val = read_acqb(&erts_thr_prgr__.current); + if (tpd->previous.local == val) { + val++; + if (val == ERTS_THR_PRGR_VAL_WAITING) + val = 0; + tpd->previous.local = val; + set_mb(&intrnl->thr[tpd->id].data.current, val); + } + + lflgs = erts_atomic32_read_nob(&intrnl->misc.data.lflgs); + if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK) + res = 1; /* Need to block in leader_update() */ + + if ((lflgs & ERTS_THR_PRGR_LFLG_NO_LEADER) + && (tpd->active || ERTS_THR_PRGR_LFLGS_ACTIVE(lflgs) == 0)) { + /* Try to take over leadership... */ + erts_aint32_t olflgs; + olflgs = erts_atomic32_read_band_acqb( + &intrnl->misc.data.lflgs, + ~ERTS_THR_PRGR_LFLG_NO_LEADER); + if (olflgs & ERTS_THR_PRGR_LFLG_NO_LEADER) { + tpd->leader = 1; +#if ERTS_THR_PRGR_PRINT_LEADER + erts_fprintf(stderr, "L -> %d\n", tpd->id); +#endif + ERTS_THR_PROGRESS_STATE_DEBUG_SET_LEADER(tpd->id, 1); + } + } + res |= tpd->leader; + } + return res; +} + +int +erts_thr_progress_update(ErtsSchedulerData *esdp) +{ + return update(thr_prgr_data(esdp)); +} + + +int +erts_thr_progress_leader_update(ErtsSchedulerData *esdp) +{ + return leader_update(thr_prgr_data(esdp)); +} + +void +erts_thr_progress_prepare_wait(ErtsSchedulerData *esdp) +{ + erts_aint32_t lflgs; + ErtsThrPrgrData *tpd = thr_prgr_data(esdp); + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); +#endif + + block_count_dec(); + + tpd->previous.local = ERTS_THR_PRGR_VAL_WAITING; + set_mb(&intrnl->thr[tpd->id].data.current, ERTS_THR_PRGR_VAL_WAITING); + + lflgs = erts_atomic32_read_nob(&intrnl->misc.data.lflgs); + if (ERTS_THR_PRGR_LFLGS_ALL_WAITING(lflgs) && got_sched_wakeups()) + wakeup_managed(0); /* Someone need to make progress */ +} + +void +erts_thr_progress_finalize_wait(ErtsSchedulerData *esdp) +{ + ErtsThrPrgrData *tpd = thr_prgr_data(esdp); + ErtsThrPrgrVal current, val; + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); +#endif + + /* + * We aren't allowed to continue until our thread + * progress is past global current. + */ + val = current = read_acqb(&erts_thr_prgr__.current); + while (1) { + val++; + if (val == ERTS_THR_PRGR_VAL_WAITING) + val = 0; + tpd->previous.local = val; + set_mb(&intrnl->thr[tpd->id].data.current, val); + val = read_acqb(&erts_thr_prgr__.current); + if (current == val) + break; + current = val; + } + if (block_count_inc()) + block_thread(tpd); + if (update(tpd)) + leader_update(tpd); +} + +void +erts_thr_progress_active(ErtsSchedulerData *esdp, int on) +{ + ErtsThrPrgrData *tpd = thr_prgr_data(esdp); + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); +#endif + + ERTS_THR_PROGRESS_STATE_DEBUG_SET_ACTIVE(tpd->id, on); + + if (on) { + ASSERT(!tpd->active); + tpd->active = 1; + erts_atomic32_inc_nob(&intrnl->misc.data.lflgs); + } + else { + ASSERT(tpd->active); + tpd->active = 0; + erts_atomic32_dec_nob(&intrnl->misc.data.lflgs); + if (update(tpd)) + leader_update(tpd); + } + +#ifdef DEBUG + { + erts_aint32_t n = erts_atomic32_read_nob(&intrnl->misc.data.lflgs); + n &= ERTS_THR_PRGR_LFLG_ACTIVE_MASK; + ASSERT(tpd->active <= n && n <= intrnl->managed.no); + } +#endif + +} + +static ERTS_INLINE int +has_reached_wakeup(ErtsThrPrgrVal wakeup) +{ + /* + * Exactly the same as erts_thr_progress_has_reached(), but + * also verify valid wakeup requests in debug mode. + */ + ErtsThrPrgrVal current; + + current = read_acqb(&erts_thr_prgr__.current); + +#if ERTS_THR_PRGR_DBG_CHK_WAKEUP_REQUEST_VALUE + { + ErtsThrPrgrVal limit; + /* + * erts_thr_progress_later() returns values which are + * equal to 'current + 2'. That is, users should never + * get a hold of values larger than that. + * + * That is, valid values are values less than 'current + 3'. + * + * Values larger than this won't work with the wakeup + * algorithm. + */ + + limit = current + 3; + if (limit == ERTS_THR_PRGR_VAL_WAITING) + limit = 0; + else if (limit < current) /* Wrapped */ + limit + 1; + + if (!erts_thr_progress_has_passed__(limit, wakeup)) + erl_exit(ERTS_ABORT_EXIT, + "Invalid wakeup request value found:" + " current=%b64u, wakeup=%b64u, limit=%b64u", + current, wakeup, limit); + } +#endif + + if (current == wakeup) + return 1; + return erts_thr_progress_has_passed__(current, wakeup); +} + +static void +request_wakeup_managed(ErtsThrPrgrData *tpd, ErtsThrPrgrVal value) +{ + ErtsThrPrgrManagedWakeupData *mwd; + int ix, wix; + + /* + * Only managed threads that aren't in waiting state + * are allowed to call this function. + */ + + ASSERT(tpd->is_managed); + ASSERT(tpd->previous.local != ERTS_THR_PRGR_VAL_WAITING); + + if (has_reached_wakeup(value)) + wakeup_managed(tpd->id); + + wix = ERTS_THR_PRGR_WAKEUP_IX(value); + if (tpd->wakeup_request[wix] == value) + return; /* Already got a request registered */ + + ASSERT(erts_thr_progress_has_passed__(value, + tpd->wakeup_request[wix])); + + + if (tpd->previous.local == value) { + /* + * We have already confirmed this value. We need to request + * wakeup for a value later than our latest confirmed value in + * order to prevent progress from reaching the requested value + * while we are writing the request. + * + * It is ok to move the wakeup request forward since the only + * guarantee we make (and can make) is that the thread will be + * woken some time *after* the requested value has been reached. + */ + value++; + if (value == ERTS_THR_PRGR_VAL_WAITING) + value = 0; + + wix = ERTS_THR_PRGR_WAKEUP_IX(value); + if (tpd->wakeup_request[wix] == value) + return; /* Already got a request registered */ + + ASSERT(erts_thr_progress_has_passed__(value, + tpd->wakeup_request[wix])); + } + + tpd->wakeup_request[wix] = value; + + mwd = intrnl->managed.data[wix]; + + ix = erts_atomic32_inc_read_nob(&mwd->len) - 1; + mwd->id[ix] = tpd->id; + + ASSERT(!erts_thr_progress_has_reached(value)); + + /* + * This thread is guarranteed to issue a full memory barrier: + * - after the request has been written, but + * - before the global thread progress reach the (possibly + * increased) requested wakeup value. + */ +} + +static void +request_wakeup_unmanaged(ErtsThrPrgrData *tpd, ErtsThrPrgrVal value) +{ + int wix, ix, id, bit; + ErtsThrPrgrUnmanagedWakeupData *umwd; + + ASSERT(!tpd->is_managed); + + /* + * Thread progress *can* reach and pass our requested value while + * we are writing the request. + */ + + if (has_reached_wakeup(value)) + wakeup_unmanaged(tpd->id); + + wix = ERTS_THR_PRGR_WAKEUP_IX(value); + + if (tpd->wakeup_request[wix] == value) + return; /* Already got a request registered */ + + ASSERT(erts_thr_progress_has_passed__(value, + tpd->wakeup_request[wix])); + + umwd = intrnl->unmanaged.data[wix]; + + id = tpd->id; + + bit = id & ERTS_THR_PRGR_BM_MASK; + ix = id >> ERTS_THR_PRGR_BM_SHIFT; + ASSERT(0 <= ix && ix < umwd->low_sz); + erts_atomic32_read_bor_nob(&umwd->low[ix], 1 << bit); + + bit = ix & ERTS_THR_PRGR_BM_MASK; + ix >>= ERTS_THR_PRGR_BM_SHIFT; + ASSERT(0 <= ix && ix < umwd->high_sz); + erts_atomic32_read_bor_nob(&umwd->high[ix], 1 << bit); + + erts_atomic32_inc_mb(&umwd->len); + + if (erts_thr_progress_has_reached(value)) + wakeup_unmanaged(tpd->id); + else + tpd->wakeup_request[wix] = value; +} + +void +erts_thr_progress_wakeup(ErtsSchedulerData *esdp, + ErtsThrPrgrVal value) +{ + ErtsThrPrgrData *tpd = thr_prgr_data(esdp); + ASSERT(!tpd->is_temporary); + if (tpd->is_managed) + request_wakeup_managed(tpd, value); + else + request_wakeup_unmanaged(tpd, value); +} + +static void +wakeup_unmanaged_threads(ErtsThrPrgrUnmanagedWakeupData *umwd) +{ + int hix; + for (hix = 0; hix < umwd->high_sz; hix++) { + erts_aint32_t hmask = erts_atomic32_read_nob(&umwd->high[hix]); + if (hmask) { + int hbase = hix << ERTS_THR_PRGR_BM_SHIFT; + int hbit; + for (hbit = 0; hbit < ERTS_THR_PRGR_BM_BITS; hbit++) { + if (hmask & (1 << hbit)) { + erts_aint_t lmask; + int lix = hbase + hbit; + ASSERT(0 <= lix && lix < umwd->low_sz); + lmask = erts_atomic32_read_nob(&umwd->low[lix]); + if (lmask) { + int lbase = lix << ERTS_THR_PRGR_BM_SHIFT; + int lbit; + for (lbit = 0; lbit < ERTS_THR_PRGR_BM_BITS; lbit++) { + if (lmask & (1 << lbit)) { + int id = lbase + lbit; + wakeup_unmanaged(id); + } + } + erts_atomic32_set_nob(&umwd->low[lix], 0); + } + } + } + erts_atomic32_set_nob(&umwd->high[hix], 0); + } + } +} + + +static void +handle_wakeup_requests(ErtsThrPrgrVal current) +{ + ErtsThrPrgrManagedWakeupData *mwd; + ErtsThrPrgrUnmanagedWakeupData *umwd; + int wix, len, i; + + wix = ERTS_THR_PRGR_WAKEUP_IX(current); + + mwd = intrnl->managed.data[wix]; + len = erts_atomic32_read_nob(&mwd->len); + ASSERT(len >= 0); + if (len) { + for (i = 0; i < len; i++) + wakeup_managed(mwd->id[i]); + erts_atomic32_set_nob(&mwd->len, 0); + } + + umwd = intrnl->unmanaged.data[wix]; + len = erts_atomic32_read_nob(&umwd->len); + ASSERT(len >= 0); + if (len) { + wakeup_unmanaged_threads(umwd); + erts_atomic32_set_nob(&umwd->len, 0); + } + +} + +static int +got_sched_wakeups(void) +{ + int wix; + + ERTS_THR_MEMORY_BARRIER; + + for (wix = 0; wix < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; wix++) { + ErtsThrPrgrManagedWakeupData **mwd = intrnl->managed.data; + if (erts_atomic32_read_nob(&mwd[wix]->len)) + return 1; + } + for (wix = 0; wix < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; wix++) { + ErtsThrPrgrUnmanagedWakeupData **umwd = intrnl->unmanaged.data; + if (erts_atomic32_read_nob(&umwd[wix]->len)) + return 1; + } + return 0; +} + +static erts_aint32_t +block_thread(ErtsThrPrgrData *tpd) +{ + erts_aint32_t lflgs; + ErtsThrPrgrCallbacks *cbp = &intrnl->managed.callbacks[tpd->id]; + + do { + block_count_dec(); + + while (1) { + cbp->prepare_wait(cbp->arg); + lflgs = erts_atomic32_read_nob(&intrnl->misc.data.lflgs); + if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK) + cbp->wait(cbp->arg); + else + break; + } + + } while (block_count_inc()); + + cbp->finalize_wait(cbp->arg); + + return lflgs; +} + +static erts_aint32_t +thr_progress_block(ErtsThrPrgrData *tpd, int wait) +{ + erts_tse_t *event = NULL; /* Remove erroneous warning... sigh... */ + erts_aint32_t lflgs, bc; + + if (tpd->is_blocking++) + return (erts_aint32_t) 0; + + while (1) { + lflgs = erts_atomic32_read_bor_nob(&intrnl->misc.data.lflgs, + ERTS_THR_PRGR_LFLG_BLOCK); + if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK) + block_thread(tpd); + else + break; + } + +#if ERTS_THR_PRGR_PRINT_BLOCKERS + erts_fprintf(stderr, "block(%d)\n", tpd->id); +#endif + + ASSERT(ERTS_AINT_NULL + == erts_atomic_read_nob(&intrnl->misc.data.blocker_event)); + + if (wait) { + event = erts_tse_fetch(); + erts_tse_reset(event); + erts_atomic_set_nob(&intrnl->misc.data.blocker_event, + (erts_aint_t) event); + } + if (tpd->is_managed) + erts_atomic32_dec_nob(&intrnl->misc.data.block_count); + bc = erts_atomic32_read_band_mb(&intrnl->misc.data.block_count, + ~ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING); + bc &= ~ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING; + if (wait) { + while (bc != 0) { + erts_tse_wait(event); + erts_tse_reset(event); + bc = erts_atomic32_read_acqb(&intrnl->misc.data.block_count); + } + } + return bc; + +} + +void +erts_thr_progress_block(void) +{ + thr_progress_block(tmp_thr_prgr_data(NULL), 1); +} + +void +erts_thr_progress_fatal_error_block(SWord timeout) +{ + ErtsThrPrgrData tpd_buf; + ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL); + erts_aint32_t bc; + SWord time_left = timeout; + SysTimeval to; + + /* + * Counting poll intervals may give us a too long timeout + * if cpu is busy. If we got tolerant time of day we use it + * to prevent this. + */ + if (!erts_disable_tolerant_timeofday) { + erts_get_timeval(&to); + to.tv_sec += timeout / 1000; + to.tv_sec += timeout % 1000; + } + + if (!tpd) { + /* + * We stack allocate since failure to allocate memory may + * have caused the problem in the first place. This is ok + * since we never complete an unblock after a fatal error + * block. + */ + tpd = &tpd_buf; + init_tmp_thr_prgr_data(tpd); + } + + bc = thr_progress_block(tpd, 0); + if (bc == 0) + return; /* Succefully blocked all managed threads */ + + while (1) { + if (erts_milli_sleep(ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL) == 0) + time_left -= ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL; + bc = erts_atomic32_read_acqb(&intrnl->misc.data.block_count); + if (bc == 0) + break; /* Succefully blocked all managed threads */ + if (time_left <= 0) + break; /* Timeout */ + if (!erts_disable_tolerant_timeofday) { + SysTimeval now; + erts_get_timeval(&now); + if (now.tv_sec > to.tv_sec) + break; /* Timeout */ + if (now.tv_sec == to.tv_sec && now.tv_usec >= to.tv_usec) + break; /* Timeout */ + } + } +} + +void +erts_thr_progress_unblock(void) +{ + erts_tse_t *event; + int id, break_id, sz, wakeup; + ErtsThrPrgrData *tpd = thr_prgr_data(NULL); + + ASSERT(tpd->is_blocking); + if (--tpd->is_blocking) + return; + + sz = intrnl->managed.no; + + wakeup = 1; + if (!tpd->is_managed) + id = break_id = tpd->id < 0 ? 0 : tpd->id % sz; + else { + break_id = tpd->id; + id = break_id + 1; + if (id >= sz) + id = 0; + if (id == break_id) + wakeup = 0; + erts_atomic32_inc_nob(&intrnl->misc.data.block_count); + } + + event = ((erts_tse_t *) + erts_atomic_read_nob(&intrnl->misc.data.blocker_event)); + ASSERT(event); + erts_atomic_set_nob(&intrnl->misc.data.blocker_event, ERTS_AINT_NULL); + + erts_atomic32_read_bor_relb(&intrnl->misc.data.block_count, + ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING); +#if ERTS_THR_PRGR_PRINT_BLOCKERS + erts_fprintf(stderr, "unblock(%d)\n", tpd->id); +#endif + erts_atomic32_read_band_mb(&intrnl->misc.data.lflgs, + ~ERTS_THR_PRGR_LFLG_BLOCK); + + if (wakeup) { + do { + ErtsThrPrgrVal tmp; + tmp = read_nob(&intrnl->thr[id].data.current); + if (tmp != ERTS_THR_PRGR_VAL_WAITING) + wakeup_managed(id); + if (++id >= sz) + id = 0; + } while (id != break_id); + } + + return_tmp_thr_prgr_data(tpd); + erts_tse_return(event); +} + +int +erts_thr_progress_is_blocking(void) +{ + ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL); + return tpd && tpd->is_blocking; +} + +void erts_thr_progress_dbg_print_state(void) +{ + int id; + int sz = intrnl->managed.no; + + erts_fprintf(stderr, "--- thread progress ---\n"); + erts_fprintf(stderr,"current=%b64u\n", erts_thr_progress_current()); + for (id = 0; id < sz; id++) { + ErtsThrPrgrVal current = read_nob(&intrnl->thr[id].data.current); +#ifdef ERTS_THR_PROGRESS_STATE_DEBUG + erts_aint32_t state_debug; + char *active, *leader; + + state_debug = erts_atomic32_read_nob(&intrnl->thr[id].data.state_debug); + active = (state_debug & ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE + ? "true" + : "false"); + leader = (state_debug & ERTS_THR_PROGRESS_STATE_DEBUG_LEADER + ? "true" + : "false"); +#endif + if (current == ERTS_THR_PRGR_VAL_WAITING) + erts_fprintf(stderr, + " id=%d, current=WAITING" +#ifdef ERTS_THR_PROGRESS_STATE_DEBUG + ", active=%s, leader=%s" +#endif + "\n", id +#ifdef ERTS_THR_PROGRESS_STATE_DEBUG + , active, leader +#endif + ); + else + erts_fprintf(stderr, + " id=%d, current=%b64u" +#ifdef ERTS_THR_PROGRESS_STATE_DEBUG + ", active=%s, leader=%s" +#endif + "\n", id, current +#ifdef ERTS_THR_PROGRESS_STATE_DEBUG + , active, leader +#endif + ); + } + erts_fprintf(stderr, "-----------------------\n"); + + +} + +#endif diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h new file mode 100644 index 0000000000..68d14174b9 --- /dev/null +++ b/erts/emulator/beam/erl_thr_progress.h @@ -0,0 +1,233 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ + +/* + * Description: Thread progress information. Used by lock free algorithms + * to determine when all involved threads are guaranteed to + * have passed a specific point of execution. + * + * Usage instructions can be found in ert_thr_progress.c + * + * Author: Rickard Green + */ + +#if !defined(ERL_THR_PROGRESS_H__TSD_TYPE__) +#define ERL_THR_PROGRESS_H__TSD_TYPE__ + +#include "sys.h" + +#ifndef ERTS_SMP + +#define erts_smp_thr_progress_block() ((void) 0) +#define erts_smp_thr_progress_unblock() ((void) 0) +#define erts_smp_thr_progress_is_blocking() 1 + +#else /* ERTS_SMP */ + +#define erts_smp_thr_progress_block erts_thr_progress_block +#define erts_smp_thr_progress_unblock erts_thr_progress_unblock +#define erts_smp_thr_progress_is_blocking erts_thr_progress_is_blocking + +void erts_thr_progress_fatal_error_block(SWord timeout); +void erts_thr_progress_block(void); +void erts_thr_progress_unblock(void); +int erts_thr_progress_is_blocking(void); + +typedef Uint64 ErtsThrPrgrVal; + +#define ERTS_THR_PRGR_WAKEUP_DATA_SIZE 4 /* Need to be an even power of 2. */ + +typedef struct { + int id; + int is_managed; + int is_blocking; + int is_temporary; + + /* --- Part below only for registered threads --- */ + + ErtsThrPrgrVal wakeup_request[ERTS_THR_PRGR_WAKEUP_DATA_SIZE]; + + /* --- Part below only for managed threads --- */ + + int leader; /* Needs to be first in the managed threads part */ + int active; + struct { + ErtsThrPrgrVal local; + ErtsThrPrgrVal next; + ErtsThrPrgrVal current; + } previous; +} ErtsThrPrgrData; +#endif /* ERTS_SMP */ + +#endif + +#if !defined(ERL_THR_PROGRESS_H__) && !defined(ERL_THR_PROGRESS_TSD_TYPE_ONLY) +#define ERL_THR_PROGRESS_H__ + +#include "erl_threads.h" +#include "erl_process.h" + +#ifdef ERTS_SMP + +#define ERTS_THR_PRGR_VAL_WAITING (~((ErtsThrPrgrVal) 0)) + +extern erts_tsd_key_t erts_thr_prgr_data_key__; + +#ifdef ARCH_64 +# define ERTS_THR_PRGR_ATOMIC erts_atomic_t +#else /* ARCH_32 */ +# define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t +#endif + +typedef struct { + void *arg; + void (*wakeup)(void *); + void (*prepare_wait)(void *); + void (*wait)(void *); + void (*finalize_wait)(void *); +} ErtsThrPrgrCallbacks; + +typedef struct { + ERTS_THR_PRGR_ATOMIC current; +} ErtsThrPrgr; + +extern ErtsThrPrgr erts_thr_prgr__; + +void erts_thr_progress_pre_init(void); +void erts_thr_progress_init(int no_schedulers, int managed, int unmanaged); +void erts_thr_progress_register_managed_thread(ErtsSchedulerData *esdp, + ErtsThrPrgrCallbacks *, + int); +void erts_thr_progress_register_unmanaged_thread(ErtsThrPrgrCallbacks *); +void erts_thr_progress_active(ErtsSchedulerData *esdp, int on); +void erts_thr_progress_wakeup(ErtsSchedulerData *esdp, + ErtsThrPrgrVal value); +int erts_thr_progress_update(ErtsSchedulerData *esdp); +int erts_thr_progress_leader_update(ErtsSchedulerData *esdp); +void erts_thr_progress_prepare_wait(ErtsSchedulerData *esdp); +void erts_thr_progress_finalize_wait(ErtsSchedulerData *esdp); + +void erts_thr_progress_dbg_print_state(void); + +#ifdef ARCH_32 +#define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_dw_sint_to_val__(ethr_dw_sint_t *dw_sint); +#endif +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc); + +ERTS_GLB_INLINE int erts_thr_progress_is_managed_thread(void); +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_progress_later(void); +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_progress_current(void); +ERTS_GLB_INLINE int erts_thr_progress_has_passed__(ErtsThrPrgrVal val1, ErtsThrPrgrVal val2); +ERTS_GLB_INLINE int erts_thr_progress_has_reached(ErtsThrPrgrVal val); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#ifdef ARCH_64 + +ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc) +{ + return (ErtsThrPrgrVal) erts_atomic_read_acqb(atmc); +} + +#else /* ARCH_32 */ + +ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_prgr_dw_sint_to_val__(ethr_dw_sint_t *dw_sint) +{ +#ifdef ETHR_SU_DW_NAINT_T__ + return (ErtsThrPrgrVal) dw_sint->dw_sint; +#else + ErtsThrPrgrVal res; + res = (ErtsThrPrgrVal) ((Uint32) dw_sint->sint[ETHR_DW_SINT_HIGH_WORD]); + res <<= 32; + res |= (ErtsThrPrgrVal) ((Uint32) dw_sint->sint[ETHR_DW_SINT_LOW_WORD]); + return res; +#endif +} + +ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc) +{ + ethr_dw_sint_t dw_sint; + erts_dw_atomic_read_acqb(atmc, &dw_sint); + return erts_thr_prgr_dw_sint_to_val__(&dw_sint); +} + +#endif + +ERTS_GLB_INLINE int +erts_thr_progress_is_managed_thread(void) +{ + ErtsThrPrgrData *tpd = erts_tsd_get(erts_thr_prgr_data_key__); + return tpd && tpd->is_managed; +} + +ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_progress_later(void) +{ + ErtsThrPrgrVal val = erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current); + if (val == (ERTS_THR_PRGR_VAL_WAITING-((ErtsThrPrgrVal)2))) + return ((ErtsThrPrgrVal) 0); + else if (val == (ERTS_THR_PRGR_VAL_WAITING-((ErtsThrPrgrVal)1))) + return ((ErtsThrPrgrVal) 1); + else + return val + ((ErtsThrPrgrVal) 2); +} + +ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_progress_current(void) +{ + return erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current); +} + +ERTS_GLB_INLINE int +erts_thr_progress_has_passed__(ErtsThrPrgrVal val1, ErtsThrPrgrVal val0) +{ + if ((((((ErtsThrPrgrVal) 1) << 63) & val1) + ^ ((((ErtsThrPrgrVal) 1) << 63) & val0)) != 0) { + /* May have wrapped... */ + if (val1 < (((ErtsThrPrgrVal) 1) << 62) + && val0 > (((ErtsThrPrgrVal) 3) << 62)) { + /* + * 'val1' has wrapped but 'val0' has not yet wrapped. While in + * these ranges 'current' is considered later than 'val0'. + */ + return 1; + } + } + return val1 > val0; +} + +ERTS_GLB_INLINE int +erts_thr_progress_has_reached(ErtsThrPrgrVal val) +{ + ErtsThrPrgrVal current; + current = erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current); + if (current == val) + return 1; + return erts_thr_progress_has_passed__(current, val); +} + +#endif + +#endif /* ERTS_SMP */ + +#endif diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c new file mode 100644 index 0000000000..9ac4cd4b8e --- /dev/null +++ b/erts/emulator/beam/erl_thr_queue.c @@ -0,0 +1,745 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ + +/* + * Description: Lock-free queue for communication between threads. + * + * Currently only a many-to-one version has been, + * implemented, i.e., many threads can enqueue but + * only one thread can dequeue at a time. It doesn't + * have to be the same thread dequeuing every time, but + * synchronization so that only one thread dequeues + * at a time has to be provided by other means. + * + * When/If the need for a many-to-many queue arises, + * this implementation can relatively easy be extended + * to support that too. + * + * Usage instructions below. + * + * Author: Rickard Green + */ + +/* + * ------ Usage instructions ----------------------------------------------- + * + * Dequeuing generates garbage that needs to be cleaned up. + * erts_thr_q_dequeue() automatically cleans, but garbage may have to be + * cleaned up also when the queue is empty. This is done by calling + * erts_thr_q_clean(). In the SMP case thread progress may have to be made + * before cleaning can continue. If so, erts_thr_q_need_thr_progress() in + * combination with erts_thr_progress_wakeup() can be used in order to + * request a wakeup at appropriate time. + * + * Enqueuing implies memory allocation and dequeuing implies memory + * deallocation. Memory allocation can be moved to another more suitable + * thread using erts_thr_q_prepare_enqueue() together with + * erts_thr_q_enqueue_prepared() instead of using erts_thr_q_enqueue(). + * Memory deallocation can can be moved to another more suitable thread by + * disabling auto_finalize_dequeue when initializing the queue and then use + * erts_thr_q_get_finalize_dequeue_data() together + * erts_thr_q_finalize_dequeue() after dequeuing or cleaning. + * + * Ending the life of the queue using either erts_thr_q_destroy() + * or erts_thr_q_finalize() impies cleaning the queue. Both functions + * return the cleaning result and may have to be called multiple times + * until the queue is clean. Once one of these functions have been called + * enqueuing is not allowed. This has to be synchronized by the user. + * If auto_finalize_dequeue has been disabled, the finalize dequeue + * functionality has to be called after ending the life of the queue just + * as when dequeuing or cleaning on a queue that is alive. + * + * ------------------------------------------------------------------------- + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_thr_queue.h" + +#if defined(DEBUG) +#define ERTS_THR_Q_DBG_CHK_DATA 1 +#else +#define ERTS_THR_Q_DBG_CHK_DATA 0 +#endif + +#define ERTS_THR_Q_MAX_CLEAN_REACHED_HEAD_COUNT 100 +#define ERTS_THR_Q_MAX_SCHED_CLEAN_OPS 50 +#define ERTS_THR_Q_MAX_DEQUEUE_CLEAN_OPS 3 + +#define ERTS_THR_Q_MAX_FINI_DEQ_OPS 50 + +#ifdef ERTS_SMP +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(sl_element, + ErtsThrQElement_t, + 1000, + ERTS_ALC_T_THR_Q_EL_SL) +#else + +static void +init_sl_element_alloc(void) +{ +} + +static ErtsThrQElement_t * +sl_element_alloc(void) +{ + return erts_alloc(ERTS_ALC_T_THR_Q_EL_SL, + sizeof(ErtsThrQElement_t)); +} + +static void +sl_element_free(ErtsThrQElement_t *p) +{ + erts_free(ERTS_ALC_T_THR_Q_EL_SL, p); +} + +#endif + +typedef union { + ErtsThrQ_t q; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrQ_t))]; +} ErtsAlignedThrQ_t; + +void +erts_thr_q_init(void) +{ + init_sl_element_alloc(); +} + +static void noop_callback(void *arg) { } + +void +erts_thr_q_initialize(ErtsThrQ_t *q, ErtsThrQInit_t *qi) +{ +#ifndef USE_THREADS + q->init = *qi; + if (!q->init.notify) + q->init.notify = noop_callback; + q->first = NULL; + q->last = NULL; + q->q.blk = NULL; +#else + erts_atomic_init_nob(&q->tail.data.marker.next.atmc, ERTS_AINT_NULL); + q->tail.data.marker.data.ptr = NULL; + erts_atomic_init_nob(&q->tail.data.last, + (erts_aint_t) &q->tail.data.marker); + erts_atomic_init_nob(&q->tail.data.um_refc[0], 0); + erts_atomic_init_nob(&q->tail.data.um_refc[1], 0); + erts_atomic32_init_nob(&q->tail.data.um_refc_ix, 0); + q->tail.data.live = qi->live.objects; + q->tail.data.arg = qi->arg; + q->tail.data.notify = qi->notify; + if (!q->tail.data.notify) + q->tail.data.notify = noop_callback; + + q->head.head.ptr = &q->tail.data.marker; + q->head.live = qi->live.objects; + q->head.first = &q->tail.data.marker; + q->head.unref_end = &q->tail.data.marker; + q->head.clean_reached_head_count = 0; + q->head.deq_fini.automatic = qi->auto_finalize_dequeue; + q->head.deq_fini.start = NULL; + q->head.deq_fini.end = NULL; +#ifdef ERTS_SMP + q->head.next.thr_progress = erts_thr_progress_current(); + q->head.next.thr_progress_reached = 1; +#endif + q->head.next.um_refc_ix = 1; + q->head.next.unref_end = &q->tail.data.marker; + q->head.used_marker = 1; + q->head.arg = qi->arg; + q->head.notify = q->tail.data.notify; + q->q.finalizing = 0; + q->q.live = qi->live.queue; + q->q.blk = NULL; +#endif +} + +ErtsThrQCleanState_t +erts_thr_q_finalize(ErtsThrQ_t *q) +{ +#ifdef USE_THREADS + q->q.finalizing = 1; +#endif + while (erts_thr_q_dequeue(q)); + return erts_thr_q_clean(q); +} + +ErtsThrQ_t * +erts_thr_q_create(ErtsThrQInit_t *qi) +{ + ErtsAlcType_t atype; + ErtsThrQ_t *q, *qblk; + UWord qw; + + switch (qi->live.queue) { + case ERTS_THR_Q_LIVE_SHORT: + atype = ERTS_ALC_T_THR_Q_SL; + break; + case ERTS_THR_Q_LIVE_LONG: + atype = ERTS_ALC_T_THR_Q_LL; + break; + default: + atype = ERTS_ALC_T_THR_Q; + break; + } + + qw = (UWord) erts_alloc(atype, + sizeof(ErtsThrQ_t) + (ERTS_CACHE_LINE_SIZE-1)); + qblk = (ErtsThrQ_t *) qw; + if (qw & ERTS_CACHE_LINE_MASK) + qw = (qw & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE; + ASSERT((qw & ERTS_CACHE_LINE_MASK) == 0); + q = (ErtsThrQ_t *) qw; + erts_thr_q_initialize(q, qi); + q->q.blk = qblk; + return q; +} + +ErtsThrQCleanState_t +erts_thr_q_destroy(ErtsThrQ_t *q) +{ + if (!q->q.blk) + erl_exit(ERTS_ABORT_EXIT, + "Trying to destroy not created thread queue\n"); + return erts_thr_q_finalize(q); +} + +#ifdef USE_THREADS + +static void +destroy(ErtsThrQ_t *q) +{ + ErtsAlcType_t atype; + switch (q->q.live) { + case ERTS_THR_Q_LIVE_SHORT: + atype = ERTS_ALC_T_THR_Q_SL; + break; + case ERTS_THR_Q_LIVE_LONG: + atype = ERTS_ALC_T_THR_Q_LL; + break; + default: + atype = ERTS_ALC_T_THR_Q; + break; + } + erts_free(atype, q->q.blk); +} + +#endif + +static ERTS_INLINE ErtsThrQElement_t * +element_live_alloc(ErtsThrQLive_t live) +{ + switch (live) { + case ERTS_THR_Q_LIVE_SHORT: + return sl_element_alloc(); + default: + return (ErtsThrQElement_t *) erts_alloc(ERTS_ALC_T_THR_Q_EL, + sizeof(ErtsThrQElement_t)); + } +} + +static ERTS_INLINE ErtsThrQElement_t * +element_alloc(ErtsThrQ_t *q) +{ + ErtsThrQLive_t live; +#ifdef USE_THREADS + live = q->tail.data.live; +#else + live = q->init.live.objects; +#endif + return element_live_alloc(live); +} + +static ERTS_INLINE void +element_live_free(ErtsThrQLive_t live, ErtsThrQElement_t *el) +{ + switch (live) { + case ERTS_THR_Q_LIVE_SHORT: + sl_element_free(el); + break; + default: + erts_free(ERTS_ALC_T_THR_Q_EL, el); + } +} + +static ERTS_INLINE void +element_free(ErtsThrQ_t *q, ErtsThrQElement_t *el) +{ + ErtsThrQLive_t live; +#ifdef USE_THREADS + live = q->head.live; +#else + live = q->init.live.objects; +#endif + element_live_free(live, el); +} + +#ifdef USE_THREADS + +static ERTS_INLINE ErtsThrQElement_t * +enqueue_managed(ErtsThrQ_t *q, ErtsThrQElement_t *this, int want_last) +{ + erts_aint_t ilast, itmp; + + erts_atomic_init_nob(&this->next.atmc, ERTS_AINT_NULL); + /* Enqueue at end of list... */ + + ilast = erts_atomic_read_nob(&q->tail.data.last); + while (1) { + ErtsThrQElement_t *last = (ErtsThrQElement_t *) ilast; + itmp = erts_atomic_cmpxchg_mb(&last->next.atmc, + (erts_aint_t) this, + ERTS_AINT_NULL); + if (itmp == ERTS_AINT_NULL) + break; + ilast = itmp; + } + + /* Move last pointer forward... */ + while (1) { + if (want_last) { + if (erts_atomic_read_rb(&this->next.atmc) != ERTS_AINT_NULL) { + /* Someone else will move it forward */ + ilast = erts_atomic_read_rb(&q->tail.data.last); + return (ErtsThrQElement_t *) ilast; + } + } + else { + if (erts_atomic_read_nob(&this->next.atmc) != ERTS_AINT_NULL) { + /* Someone else will move it forward */ + return NULL; + } + } + itmp = erts_atomic_cmpxchg_mb(&q->tail.data.last, + (erts_aint_t) this, + ilast); + if (ilast == itmp) + return want_last ? this : NULL; + ilast = itmp; + } +} + +static ErtsThrQCleanState_t +clean(ErtsThrQ_t *q, int max_ops, int do_notify) +{ + erts_aint_t ilast; + int um_refc_ix; + int ops; + + for (ops = 0; ops < max_ops; ops++) { + ErtsThrQElement_t *tmp; + restart: + ASSERT(q->head.first); + if (q->head.first == q->head.head.ptr) { + q->head.clean_reached_head_count++; + if (q->head.clean_reached_head_count + >= ERTS_THR_Q_MAX_CLEAN_REACHED_HEAD_COUNT) { + q->head.clean_reached_head_count = 0; + break; + } + goto inspect_head; + } + if (q->head.first == q->head.unref_end) + break; + if (q->head.first == &q->tail.data.marker) { + q->head.used_marker = 0; + q->head.first = q->head.first->next.ptr; + goto restart; + } + tmp = q->head.first; + q->head.first = q->head.first->next.ptr; + if (q->head.deq_fini.automatic) + element_free(q, tmp); + else { + tmp->data.ptr = (void *) (UWord) q->head.live; + if (!q->head.deq_fini.start) + q->head.deq_fini.start = tmp; + else if (q->head.deq_fini.end->next.ptr == &q->tail.data.marker) + q->head.deq_fini.end->next.ptr = tmp; + q->head.deq_fini.end = tmp; + } + } + + ilast = erts_atomic_read_nob(&q->tail.data.last); + if (q->head.first == ((ErtsThrQElement_t *) ilast) + && ((ErtsThrQElement_t *) ilast) == &q->tail.data.marker + && q->head.first == &q->tail.data.marker) { + /* Empty and clean queue */ + if (q->q.finalizing) + destroy(q); + return ERTS_THR_Q_CLEAN; + } + +#ifdef ERTS_SMP + if (q->head.next.thr_progress_reached + || erts_thr_progress_has_reached(q->head.next.thr_progress)) { + q->head.next.thr_progress_reached = 1; +#endif + um_refc_ix = q->head.next.um_refc_ix; + if (erts_atomic_read_acqb(&q->tail.data.um_refc[um_refc_ix]) == 0) { + /* Move unreferenced end pointer forward... */ + q->head.clean_reached_head_count = 0; + q->head.unref_end = q->head.next.unref_end; + + if (!q->head.used_marker + && q->head.unref_end == (ErtsThrQElement_t *) ilast) { + q->head.used_marker = 1; + ilast = (erts_aint_t) enqueue_managed(q, + &q->tail.data.marker, + 1); + if (q->head.head.ptr == q->head.unref_end) { + ErtsThrQElement_t *next; + next = ((ErtsThrQElement_t *) + erts_atomic_read_acqb(&q->head.head.ptr->next.atmc)); + if (next == &q->tail.data.marker) { + q->head.head.ptr->next.ptr = &q->tail.data.marker; + q->head.head.ptr = &q->tail.data.marker; + } + } + } + + if (q->head.unref_end == (ErtsThrQElement_t *) ilast) + ERTS_THR_MEMORY_BARRIER; + else { + q->head.next.unref_end = (ErtsThrQElement_t *) ilast; + ERTS_THR_MEMORY_BARRIER; +#ifdef ERTS_SMP + q->head.next.thr_progress = erts_thr_progress_later(); +#endif + erts_atomic32_set_relb(&q->tail.data.um_refc_ix, + um_refc_ix); + q->head.next.um_refc_ix = um_refc_ix == 0 ? 1 : 0; +#ifdef ERTS_SMP + q->head.next.thr_progress_reached = 0; +#endif + } + } +#ifdef ERTS_SMP + } +#endif + + if (q->head.first == q->head.head.ptr) { + inspect_head: + if (!q->head.used_marker) { + erts_aint_t inext; + inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + if (inext == ERTS_AINT_NULL) { + q->head.used_marker = 1; + (void) enqueue_managed(q, &q->tail.data.marker, 0); + inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + if (inext == (erts_aint_t) &q->tail.data.marker) { + q->head.head.ptr->next.ptr = &q->tail.data.marker; + q->head.head.ptr = &q->tail.data.marker; +#ifdef ERTS_SMP + if (!q->head.next.thr_progress_reached) + return ERTS_THR_Q_NEED_THR_PRGR; +#else + if (do_notify) + q->head.notify(q->head.arg); +#endif + return ERTS_THR_Q_DIRTY; + } + } + } + return ERTS_THR_Q_CLEAN; + } + + if (q->head.first != q->head.unref_end) { + if (do_notify) + q->head.notify(q->head.arg); + return ERTS_THR_Q_DIRTY; + } + +#ifdef ERTS_SMP + if (!q->head.next.thr_progress_reached) + return ERTS_THR_Q_NEED_THR_PRGR; +#endif + + return ERTS_THR_Q_CLEAN; /* Waiting for unmanaged threads to complete... */ +} + +#endif + +ErtsThrQCleanState_t +erts_thr_q_clean(ErtsThrQ_t *q) +{ +#ifdef USE_THREADS + return clean(q, ERTS_THR_Q_MAX_SCHED_CLEAN_OPS, 0); +#else + return ERTS_THR_Q_CLEAN; +#endif +} + +ErtsThrQCleanState_t +erts_thr_q_inspect(ErtsThrQ_t *q, int ensure_empty) +{ +#ifdef USE_THREADS + if (ensure_empty) { + erts_aint_t inext; + inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + if (inext != ERTS_AINT_NULL) { + if (&q->tail.data.marker != (ErtsThrQElement_t *) inext) + return ERTS_THR_Q_DIRTY; + else { + q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext; + q->head.head.ptr = (ErtsThrQElement_t *) inext; + inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + if (inext != ERTS_AINT_NULL) + return ERTS_THR_Q_DIRTY; + } + } + } + + if (q->head.first == q->head.head.ptr) { + if (!q->head.used_marker) { + erts_aint_t inext; + inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + if (inext == ERTS_AINT_NULL) + return ERTS_THR_Q_DIRTY; + } + return ERTS_THR_Q_CLEAN; + } + + if (q->head.first != q->head.unref_end) + return ERTS_THR_Q_DIRTY; + +#ifdef ERTS_SMP + if (!q->head.next.thr_progress_reached) + return ERTS_THR_Q_NEED_THR_PRGR; +#endif +#endif + return ERTS_THR_Q_CLEAN; +} + +static void +enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this) +{ +#ifndef USE_THREADS + ASSERT(data); + + this->next.ptr = NULL; + this->data.ptr = data; + + if (q->last) + q->last->next.ptr = this; + else { + q->first = q->last = this; + q->init.notify(q->init.arg); + } +#else + int notify; + int um_refc_ix = 0; +#ifdef ERTS_SMP + int unmanaged_thread; +#endif + +#if ERTS_THR_Q_DBG_CHK_DATA + if (!data) + erl_exit(ERTS_ABORT_EXIT, "Missing data in enqueue\n"); +#endif + + ASSERT(!q->q.finalizing); + + this->data.ptr = data; + +#ifdef ERTS_SMP + unmanaged_thread = !erts_thr_progress_is_managed_thread(); + if (unmanaged_thread) +#endif + { + um_refc_ix = erts_atomic32_read_acqb(&q->tail.data.um_refc_ix); + while (1) { + int tmp_um_refc_ix; + erts_atomic_inc_acqb(&q->tail.data.um_refc[um_refc_ix]); + tmp_um_refc_ix = erts_atomic32_read_acqb(&q->tail.data.um_refc_ix); + if (tmp_um_refc_ix == um_refc_ix) + break; + erts_atomic_dec_relb(&q->tail.data.um_refc[um_refc_ix]); + um_refc_ix = tmp_um_refc_ix; + } + } + + notify = this == enqueue_managed(q, this, 1); + + +#ifdef ERTS_SMP + if (unmanaged_thread) +#endif + { + if (notify) + erts_atomic_dec_relb(&q->tail.data.um_refc[um_refc_ix]); + else if (erts_atomic_dec_read_relb(&q->tail.data.um_refc[um_refc_ix]) == 0) + notify = 1; + } + if (notify) + q->tail.data.notify(q->tail.data.arg); +#endif +} + +void +erts_thr_q_enqueue(ErtsThrQ_t *q, void *data) +{ + enqueue(q, data, element_alloc(q)); +} + +ErtsThrQPrepEnQ_t * +erts_thr_q_prepare_enqueue(ErtsThrQ_t *q) +{ + return (ErtsThrQPrepEnQ_t *) element_alloc(q); +} + +int +erts_thr_q_get_finalize_dequeue_data(ErtsThrQ_t *q, ErtsThrQFinDeQ_t *fdp) +{ +#ifndef USE_THREADS + return 0; +#else +#ifdef DEBUG + if (!q->head.deq_fini.start) { + ASSERT(!q->head.deq_fini.end); + } + else { + ErtsThrQElement_t *e = q->head.deq_fini.start; + ErtsThrQElement_t *end = q->head.deq_fini.end; + while (e != end) { + ASSERT(q->head.head.ptr != e); + ASSERT(q->head.first != e); + ASSERT(q->head.unref_end != e); + e = e->next.ptr; + } + } +#endif + fdp->start = q->head.deq_fini.start; + fdp->end = q->head.deq_fini.end; + if (fdp->end) + fdp->end->next.ptr = NULL; + q->head.deq_fini.start = NULL; + q->head.deq_fini.end = NULL; + return fdp->start != NULL; +#endif +} + +void +erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *fdp0, + ErtsThrQFinDeQ_t *fdp1) +{ +#ifdef USE_THREADS + if (fdp1->start) { + if (fdp0->end) + fdp0->end->next.ptr = fdp1->start; + else + fdp0->start = fdp1->start; + fdp0->end = fdp1->end; + } +#endif +} + + +int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *state) +{ +#ifdef USE_THREADS + ErtsThrQElement_t *start = state->start; + if (start) { + ErtsThrQLive_t live; + int i; + for (i = 0; i < ERTS_THR_Q_MAX_FINI_DEQ_OPS; i++) { + ErtsThrQElement_t *tmp; + if (!start) + break; + tmp = start; + start = start->next.ptr; + live = (ErtsThrQLive_t) (UWord) tmp->data.ptr; + element_live_free(live, tmp); + } + state->start = start; + if (start) + return 1; /* More to do */ + state->end = NULL; + } +#endif + return 0; +} + +void +erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *state) +{ +#ifdef USE_THREADS + state->start = NULL; + state->end = NULL; +#endif +} + + +void +erts_thr_q_enqueue_prepared(ErtsThrQ_t *q, void *data, ErtsThrQPrepEnQ_t *prep) +{ + ASSERT(prep); + enqueue(q, data, (ErtsThrQElement_t *) prep); +} + +void * +erts_thr_q_dequeue(ErtsThrQ_t *q) +{ +#ifndef USE_THREADS + void *res; + ErtsThrQElement_t *tmp; + + if (!q->first) + return NULL; + tmp = q->first; + res = tmp->data.ptr; + q->first = tmp->next.ptr; + if (!q->first) + q->last = NULL; + + element_free(q, tmp); + + return res; +#else + erts_aint_t inext; + void *res; + + inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + if (inext == ERTS_AINT_NULL) + return NULL; + q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext; + q->head.head.ptr = (ErtsThrQElement_t *) inext; + if (q->head.head.ptr == &q->tail.data.marker) { + inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); + if (inext == ERTS_AINT_NULL) + return NULL; + q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext; + q->head.head.ptr = (ErtsThrQElement_t *) inext; + } + res = q->head.head.ptr->data.ptr; +#if ERTS_THR_Q_DBG_CHK_DATA + q->head.head.ptr->data.ptr = NULL; + if (!res) + erl_exit(ERTS_ABORT_EXIT, "Missing data in dequeue\n"); +#endif + clean(q, + (q->head.deq_fini.automatic + ? ERTS_THR_Q_MAX_DEQUEUE_CLEAN_OPS + : ERTS_THR_Q_MAX_SCHED_CLEAN_OPS), 1); + return res; +#endif +} diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h new file mode 100644 index 0000000000..407c23f5eb --- /dev/null +++ b/erts/emulator/beam/erl_thr_queue.h @@ -0,0 +1,211 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ + +/* + * Description: Lock-free queue for communication between threads. + * + * Currently only a many-to-one version has been, + * implemented, i.e., many threads can enqueue but + * only one thread can dequeue at a time. It doesn't + * have to be the same thread dequeuing every time, but + * synchronization so that only one thread dequeues + * at a time has to be provided by other means. + * + * When/If the need for a many-to-many queue arises, + * this implementation can relatively easy be extended + * to support that too. + * + * Usage instructions can be found in erts_thr_queue.c + * + * Author: Rickard Green + */ + +#ifndef ERL_THR_QUEUE_H__ +#define ERL_THR_QUEUE_H__ + +#include "sys.h" +#include "erl_threads.h" +#include "erl_alloc.h" +#include "erl_thr_progress.h" + +typedef enum { + ERTS_THR_Q_LIVE_UNDEF, + ERTS_THR_Q_LIVE_SHORT, + ERTS_THR_Q_LIVE_LONG +} ErtsThrQLive_t; + +#define ERTS_THR_Q_INIT_DEFAULT \ +{ \ + { \ + ERTS_THR_Q_LIVE_UNDEF, \ + ERTS_THR_Q_LIVE_SHORT \ + }, \ + NULL, \ + NULL, \ + 1 \ +} + +typedef struct ErtsThrQ_t_ ErtsThrQ_t; + +typedef struct { + struct { + ErtsThrQLive_t queue; + ErtsThrQLive_t objects; + } live; + void *arg; + void (*notify)(void *); + int auto_finalize_dequeue; +} ErtsThrQInit_t; + +typedef struct ErtsThrQElement_t_ ErtsThrQElement_t; +typedef struct ErtsThrQElement_t ErtsThrQPrepEnQ_t; + +typedef union { + erts_atomic_t atmc; + ErtsThrQElement_t *ptr; +} ErtsThrQPtr_t; + +struct ErtsThrQElement_t_ { + ErtsThrQPtr_t next; + union { + erts_atomic_t atmc; + void *ptr; + } data; +}; + +typedef struct { + ErtsThrQElement_t *start; + ErtsThrQElement_t *end; +} ErtsThrQFinDeQ_t; + +typedef enum { + ERTS_THR_Q_CLEAN, +#ifdef ERTS_SMP + ERTS_THR_Q_NEED_THR_PRGR, +#endif + ERTS_THR_Q_DIRTY, +} ErtsThrQCleanState_t; + +#ifdef USE_THREADS + +typedef struct { + ErtsThrQElement_t marker; + erts_atomic_t last; + erts_atomic_t um_refc[2]; + erts_atomic32_t um_refc_ix; + ErtsThrQLive_t live; +#ifdef ERTS_SMP + erts_atomic32_t thr_prgr_clean_scheduled; +#endif + void *arg; + void (*notify)(void *); +} ErtsThrQTail_t; + +struct ErtsThrQ_t_ { + /* + * This structure needs to be cache line aligned for best + * performance. + */ + union { + /* Modified by threads enqueuing */ + ErtsThrQTail_t data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrQTail_t))]; + } tail; + /* + * Everything below this point is *only* accessed by the + * thread dequeuing. + */ + struct { + ErtsThrQPtr_t head; + ErtsThrQLive_t live; + ErtsThrQElement_t *first; + ErtsThrQElement_t *unref_end; + int clean_reached_head_count; + struct { + int automatic; + ErtsThrQElement_t *start; + ErtsThrQElement_t *end; + } deq_fini; + struct { +#ifdef ERTS_SMP + ErtsThrPrgrVal thr_progress; + int thr_progress_reached; +#endif + int um_refc_ix; + ErtsThrQElement_t *unref_end; + } next; + int used_marker; + void *arg; + void (*notify)(void *); + } head; + struct { + int finalizing; + ErtsThrQLive_t live; + void *blk; + } q; +}; + +#else /* !USE_THREADS */ + +struct ErtsThrQ_t_ { + ErtsThrQInit_t init; + ErtsThrQElement_t *first; + ErtsThrQElement_t *last; + struct { + void *blk; + } q; +}; + +#endif + +void erts_thr_q_init(void); +void erts_thr_q_initialize(ErtsThrQ_t *, ErtsThrQInit_t *); +ErtsThrQCleanState_t erts_thr_q_finalize(ErtsThrQ_t *); +ErtsThrQ_t *erts_thr_q_create(ErtsThrQInit_t *); +ErtsThrQCleanState_t erts_thr_q_destroy(ErtsThrQ_t *); +ErtsThrQCleanState_t erts_thr_q_clean(ErtsThrQ_t *); +ErtsThrQCleanState_t erts_thr_q_inspect(ErtsThrQ_t *, int); +ErtsThrQPrepEnQ_t *erts_thr_q_prepare_enqueue(ErtsThrQ_t *); +void erts_thr_q_enqueue_prepared(ErtsThrQ_t *, void *, ErtsThrQPrepEnQ_t *); +void erts_thr_q_enqueue(ErtsThrQ_t *, void *); +void * erts_thr_q_dequeue(ErtsThrQ_t *); +int erts_thr_q_get_finalize_dequeue_data(ErtsThrQ_t *, + ErtsThrQFinDeQ_t *); +void erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *, + ErtsThrQFinDeQ_t *); +int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *); +void erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *); + +#ifdef ERTS_SMP +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_q_need_thr_progress(ErtsThrQ_t *q); +#endif + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#ifdef ERTS_SMP +ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_q_need_thr_progress(ErtsThrQ_t *q) +{ + return q->head.next.thr_progress; +} +#endif + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERL_THR_QUEUE_H__ */ diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 12eaf39ec7..065e7077c0 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -92,6 +92,8 @@ typedef struct { #endif } erts_rwmtx_t; +#define ERTS_MTX_OPT_DEFAULT_INITER ETHR_MUTEX_OPT_DEFAULT_INITER +#define ERTS_CND_OPT_DEFAULT_INITER ETHR_COND_OPT_DEFAULT_INITER #define ERTS_RWMTX_OPT_DEFAULT_INITER ETHR_RWMUTEX_OPT_DEFAULT_INITER #define ERTS_RWMTX_TYPE_NORMAL ETHR_RWMUTEX_TYPE_NORMAL #define ERTS_RWMTX_TYPE_FREQUENT_READ ETHR_RWMUTEX_TYPE_FREQUENT_READ @@ -193,6 +195,8 @@ typedef struct { int gcc_is_buggy; } erts_rwlock_t; #endif /* #ifdef USE_THREADS */ +#define ERTS_AINT_NULL ((erts_aint_t) NULL) + #define ERTS_AINT_T_MAX (~(((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1))) #define ERTS_AINT_T_MIN ((((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1))) #define ERTS_AINT32_T_MAX (~(((erts_aint32_t) 1) << (sizeof(erts_aint32_t)*8-1))) @@ -1128,6 +1132,16 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx) #endif } +/* + * IMPORTANT note about erts_cnd_signal() and erts_cnd_broadcast() + * + * POSIX allow a call to `pthread_cond_signal' or `pthread_cond_broadcast' + * even though the associated mutex/mutexes isn't/aren't locked by the + * caller. Our implementation do not allow that in order to avoid a + * performance penalty. That is, all associated mutexes *need* to be + * locked by the caller of erts_cnd_signal()/erts_cnd_broadcast()! + */ + ERTS_GLB_INLINE void erts_cnd_signal(erts_cnd_t *cnd) { diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 8833137112..b487dbf054 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -36,6 +36,7 @@ #include "error.h" #include "erl_binary.h" #include "erl_bits.h" +#include "erl_thr_progress.h" #if 0 #define DEBUG_PRINTOUTS @@ -159,7 +160,7 @@ static Uint active_sched; void erts_system_profile_setup_active_schedulers(void) { - ERTS_SMP_LC_ASSERT(erts_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking()); active_sched = erts_active_schedulers(); } @@ -1940,7 +1941,8 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) Eterm* hp; int need; - ERTS_SMP_LC_ASSERT((erts_proc_lc_my_proc_locks(t_p) != 0) || erts_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT((erts_proc_lc_my_proc_locks(t_p) != 0) + || erts_thr_progress_is_blocking()); if (is_internal_port(t_p->tracer_proc)) { #define LOCAL_HEAP_SIZE (5+5) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); @@ -2092,8 +2094,7 @@ void save_calls(Process *p, Export *e) * entries instead of the original BIF functions. */ Eterm -erts_bif_trace(int bif_index, Process* p, - Eterm arg1, Eterm arg2, Eterm arg3, BeamInstr *I) +erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) { Eterm result; int meta = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_META); @@ -2107,10 +2108,10 @@ erts_bif_trace(int bif_index, Process* p, * no tracing will occur. Doing the whole else branch will * also do nothing, only slower. */ - Eterm (*func)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = bif_table[bif_index].f; - result = func(p, arg1, arg2, arg3, I); + Eterm (*func)(Process*, Eterm*, BeamInstr*) = bif_table[bif_index].f; + result = func(p, args, I); } else { - Eterm (*func)(Process*, Eterm, Eterm, Eterm, BeamInstr*); + Eterm (*func)(Process*, Eterm*, BeamInstr*); Export* ep = bif_export[bif_index]; Uint32 flags = 0, flags_meta = 0; int global = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_GLOBAL); @@ -2122,8 +2123,6 @@ erts_bif_trace(int bif_index, Process* p, * export entry */ BeamInstr *cp = p->cp; - Eterm args[3] = {arg1, arg2, arg3}; - /* * Make continuation pointer OK, it is not during direct BIF calls, * but it is correct during apply of bif. @@ -2155,7 +2154,7 @@ erts_bif_trace(int bif_index, Process* p, func = bif_table[bif_index].f; - result = func(p, arg1, arg2, arg3, I); + result = func(p, args, I); if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) { BeamInstr i_return_trace = beam_return_trace[0]; @@ -2745,7 +2744,8 @@ trace_port(Port *t_p, Eterm what, Eterm data) { Eterm mess; Eterm* hp; - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); if (is_internal_port(t_p->tracer_proc)) { #define LOCAL_HEAP_SIZE (5+5) @@ -3021,8 +3021,6 @@ static ErtsSysMsgQ *sys_message_queue_end; static erts_tid_t sys_msg_dispatcher_tid; static erts_cnd_t smq_cnd; -static int dispatcher_waiting; - ERTS_QUALLOC_IMPL(smq_element, ErtsSysMsgQ, 20, ERTS_ALC_T_SYS_MSG_Q) static void @@ -3066,18 +3064,6 @@ enqueue_sys_msg(enum ErtsSysMsgType type, erts_smp_mtx_unlock(&smq_mtx); } -static void -prepare_for_block(void *unused) -{ - erts_smp_mtx_unlock(&smq_mtx); -} - -static void -resume_after_block(void *unused) -{ - erts_smp_mtx_lock(&smq_mtx); -} - void erts_queue_error_logger_message(Eterm from, Eterm msg, ErlHeapFragment *bp) { @@ -3143,10 +3129,10 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) && !erts_system_monitor_flags.busy_port && !erts_system_monitor_flags.busy_dist_port) break; /* Everything is disabled */ - erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); + erts_smp_thr_progress_block(); if (system_monitor == receiver || receiver == NIL) erts_system_monitor_clear(NULL); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); break; case SYS_MSG_TYPE_SYSPROF: if (receiver == NIL @@ -3156,11 +3142,11 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) && !erts_system_profile_flags.scheduler) break; /* Block system to clear flags */ - erts_smp_block_system(0); + erts_smp_thr_progress_block(); if (system_profile == receiver || receiver == NIL) { erts_system_profile_clear(NULL); } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); break; case SYS_MSG_TYPE_ERRLGR: { char *no_elgger = "(no error logger present)"; @@ -3201,22 +3187,68 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) } } +static void +sys_msg_dispatcher_wakeup(void *vwait_p) +{ + int *wait_p = (int *) vwait_p; + erts_smp_mtx_lock(&smq_mtx); + *wait_p = 0; + erts_smp_cnd_signal(&smq_cnd); + erts_smp_mtx_unlock(&smq_mtx); +} + +static void +sys_msg_dispatcher_prep_wait(void *vwait_p) +{ + int *wait_p = (int *) vwait_p; + erts_smp_mtx_lock(&smq_mtx); + *wait_p = 1; + erts_smp_mtx_unlock(&smq_mtx); +} + +static void +sys_msg_dispatcher_fin_wait(void *vwait_p) +{ + int *wait_p = (int *) vwait_p; + erts_smp_mtx_lock(&smq_mtx); + *wait_p = 0; + erts_smp_mtx_unlock(&smq_mtx); +} + +static void +sys_msg_dispatcher_wait(void *vwait_p) +{ + int *wait_p = (int *) vwait_p; + erts_smp_mtx_lock(&smq_mtx); + while (*wait_p) + erts_smp_cnd_wait(&smq_cnd, &smq_mtx); + erts_smp_mtx_unlock(&smq_mtx); +} + static void * sys_msg_dispatcher_func(void *unused) { + ErtsThrPrgrCallbacks callbacks; ErtsSysMsgQ *local_sys_message_queue = NULL; + int wait = 0; #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_set_thread_name("system message dispatcher"); #endif - erts_register_blockable_thread(); - erts_smp_activity_begin(ERTS_ACTIVITY_IO, NULL, NULL, NULL); + callbacks.arg = (void *) &wait; + callbacks.wakeup = sys_msg_dispatcher_wakeup; + callbacks.prepare_wait = sys_msg_dispatcher_prep_wait; + callbacks.wait = sys_msg_dispatcher_wait; + callbacks.finalize_wait = sys_msg_dispatcher_fin_wait; + + erts_thr_progress_register_managed_thread(NULL, &callbacks, 0); while (1) { + int end_wait = 0; ErtsSysMsgQ *smqp; - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); erts_smp_mtx_lock(&smq_mtx); @@ -3228,20 +3260,16 @@ sys_msg_dispatcher_func(void *unused) } /* Fetch current trace message queue ... */ - erts_smp_activity_change(ERTS_ACTIVITY_IO, - ERTS_ACTIVITY_WAIT, - prepare_for_block, - resume_after_block, - NULL); - dispatcher_waiting = 1; + if (!sys_message_queue) { + erts_smp_mtx_unlock(&smq_mtx); + end_wait = 1; + erts_thr_progress_active(NULL, 0); + erts_thr_progress_prepare_wait(NULL); + erts_smp_mtx_lock(&smq_mtx); + } + while (!sys_message_queue) erts_smp_cnd_wait(&smq_cnd, &smq_mtx); - dispatcher_waiting = 0; - erts_smp_activity_change(ERTS_ACTIVITY_WAIT, - ERTS_ACTIVITY_IO, - prepare_for_block, - resume_after_block, - NULL); local_sys_message_queue = sys_message_queue; sys_message_queue = NULL; @@ -3249,6 +3277,11 @@ sys_msg_dispatcher_func(void *unused) erts_smp_mtx_unlock(&smq_mtx); + if (end_wait) { + erts_thr_progress_finalize_wait(NULL); + erts_thr_progress_active(NULL, 1); + } + /* Send trace messages ... */ ASSERT(local_sys_message_queue); @@ -3259,6 +3292,9 @@ sys_msg_dispatcher_func(void *unused) Process *proc = NULL; Port *port = NULL; + if (erts_thr_progress_update(NULL)) + erts_thr_progress_leader_update(NULL); + #ifdef DEBUG_PRINTOUTS print_msg_type(smqp); #endif @@ -3372,7 +3408,6 @@ sys_msg_dispatcher_func(void *unused) } } - erts_smp_activity_end(ERTS_ACTIVITY_IO, NULL, NULL, NULL); return NULL; } @@ -3422,7 +3457,6 @@ init_sys_msg_dispatcher(void) sys_message_queue_end = NULL; erts_smp_cnd_init(&smq_cnd); erts_smp_mtx_init(&smq_mtx, "sys_msg_q"); - dispatcher_waiting = 0; erts_smp_thr_create(&sys_msg_dispatcher_tid, sys_msg_dispatcher_func, NULL, diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index bd5f3cc4c1..fca785a4de 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -47,7 +47,7 @@ typedef struct _restart_context { static Uint max_loop_limit; -static BIF_RETTYPE utf8_to_list(BIF_ALIST_1); +static BIF_RETTYPE utf8_to_list(Process *p, Eterm arg1); static BIF_RETTYPE finalize_list_to_list(Process *p, byte *bytes, Eterm rest, @@ -1828,13 +1828,13 @@ static BIF_RETTYPE characters_to_list_trap_4(BIF_ALIST_1) * Instead of building an utf8 buffer, we analyze the binary given and use that. */ -static BIF_RETTYPE utf8_to_list(BIF_ALIST_1) +static BIF_RETTYPE utf8_to_list(Process* p, Eterm arg) { - if (!is_binary(BIF_ARG_1) || aligned_binary_size(BIF_ARG_1) < 0) { - BIF_ERROR(BIF_P,BADARG); + if (!is_binary(arg) || aligned_binary_size(arg) < 0) { + BIF_ERROR(p, BADARG); } - return do_bif_utf8_to_list(BIF_P, BIF_ARG_1, 0U, 0U, 0U, - ERTS_UTF8_ANALYZE_MORE,NIL); + return do_bif_utf8_to_list(p, arg, 0U, 0U, 0U, + ERTS_UTF8_ANALYZE_MORE, NIL); } diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index f810392e60..5dc307e383 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -83,11 +83,7 @@ #define CP_SIZE 1 #define ErtsHAllocLockCheck(P) \ - ERTS_SMP_LC_ASSERT((ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks((P))) \ - || ((P)->id == ERTS_INVALID_PID) \ - || ((P)->scheduler_data \ - && (P) == (P)->scheduler_data->match_pseudo_process) \ - || erts_is_system_blocked(0)) + ERTS_SMP_LC_ASSERT(erts_dbg_check_halloc_lock((P))) #ifdef DEBUG diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c index 5bc402fe22..18d62dac1d 100644 --- a/erts/emulator/beam/export.c +++ b/erts/emulator/beam/export.c @@ -208,7 +208,8 @@ erts_export_put(Eterm mod, Eterm func, unsigned int arity) Export e; int ix; - ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_initialized == 0 + || erts_smp_thr_progress_is_blocking()); ASSERT(is_atom(mod)); ASSERT(is_atom(func)); e.code[0] = mod; @@ -265,7 +266,8 @@ erts_export_consolidate(void) HashInfo hi; #endif - ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_initialized == 0 + || erts_smp_thr_progress_is_blocking()); export_write_lock(); erts_index_merge(&secondary_export_table, &export_table); diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 6953e7fe7d..80ce4b969c 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -988,16 +988,16 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2) } -Eterm -term_to_binary_1(Process* p, Eterm Term) +BIF_RETTYPE term_to_binary_1(BIF_ALIST_1) { - return erts_term_to_binary(p, Term, 0, TERM_TO_BINARY_DFLAGS); + return erts_term_to_binary(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS); } - -Eterm -term_to_binary_2(Process* p, Eterm Term, Eterm Flags) +BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) { + Process* p = BIF_P; + Eterm Term = BIF_ARG_1; + Eterm Flags = BIF_ARG_2; int level = 0; Uint flags = TERM_TO_BINARY_DFLAGS; @@ -1256,8 +1256,11 @@ BIF_RETTYPE binary_to_term_2(BIF_ALIST_2) } Eterm -external_size_1(Process* p, Eterm Term) +external_size_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm Term = BIF_ARG_1; + Uint size = erts_encode_ext_size(Term); if (IS_USMALL(0, size)) { BIF_RET(make_small(size)); @@ -1268,13 +1271,13 @@ external_size_1(Process* p, Eterm Term) } Eterm -external_size_2(Process* p, Eterm Term, Eterm Flags) +external_size_2(BIF_ALIST_2) { Uint size; Uint flags = TERM_TO_BINARY_DFLAGS; - while (is_list(Flags)) { - Eterm arg = CAR(list_val(Flags)); + while (is_list(BIF_ARG_2)) { + Eterm arg = CAR(list_val(BIF_ARG_2)); Eterm* tp; if (is_tuple(arg) && *(tp = tuple_val(arg)) == make_arityval(2)) { @@ -1293,19 +1296,19 @@ external_size_2(Process* p, Eterm Term, Eterm Flags) } } else { error: - BIF_ERROR(p, BADARG); + BIF_ERROR(BIF_P, BADARG); } - Flags = CDR(list_val(Flags)); + BIF_ARG_2 = CDR(list_val(BIF_ARG_2)); } - if (is_not_nil(Flags)) { + if (is_not_nil(BIF_ARG_2)) { goto error; } - size = erts_encode_ext_size_2(Term, flags); + size = erts_encode_ext_size_2(BIF_ARG_1, flags); if (IS_USMALL(0, size)) { BIF_RET(make_small(size)); } else { - Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); BIF_RET(uint_to_big(size, hp)); } } diff --git a/erts/emulator/beam/fix_alloc.c b/erts/emulator/beam/fix_alloc.c deleted file mode 100644 index 5637281597..0000000000 --- a/erts/emulator/beam/fix_alloc.c +++ /dev/null @@ -1,287 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2009. 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% - */ -/* General purpose Memory allocator for fixed block size objects */ -/* This allocater is at least an order of magnitude faster than malloc() */ - - -#define NOPERBLOCK 20 -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "sys.h" -#include "erl_vm.h" -#include "global.h" -#include "erl_db.h" - -#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE - -#if ERTS_ALC_MTA_FIXED_SIZE -#include "erl_threads.h" -#include "erl_smp.h" -# ifdef ERTS_SMP -# define FA_LOCK(FA) erts_smp_spin_lock(&(FA)->slck) -# define FA_UNLOCK(FA) erts_smp_spin_unlock(&(FA)->slck) -# else -# define FA_LOCK(FA) erts_mtx_lock(&(FA)->mtx) -# define FA_UNLOCK(FA) erts_mtx_unlock(&(FA)->mtx) -# endif -#else -# define FA_LOCK(FA) -# define FA_UNLOCK(FA) -#endif - -typedef union {double d; long l;} align_t; - -typedef struct fix_alloc_block { - struct fix_alloc_block *next; - align_t mem[1]; -} FixAllocBlock; - -typedef struct fix_alloc { - Uint item_size; - void *freelist; - Uint no_free; - Uint no_blocks; - FixAllocBlock *blocks; -#if ERTS_ALC_MTA_FIXED_SIZE -# ifdef ERTS_SMP - erts_smp_spinlock_t slck; -# else - erts_mtx_t mtx; -# endif -#endif -} FixAlloc; - -static void *(*core_alloc)(Uint); -static Uint xblk_sz; - -static FixAlloc **fa; -#define FA_SZ (1 + ERTS_ALC_N_MAX_A_FIXED_SIZE - ERTS_ALC_N_MIN_A_FIXED_SIZE) - -#define FIX_IX(N) ((N) - ERTS_ALC_N_MIN_A_FIXED_SIZE) - -#define FIX_POOL_SZ(I_SZ) \ - ((I_SZ)*NOPERBLOCK + sizeof(FixAllocBlock) - sizeof(align_t)) - -#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE -static int first_time; -#endif - -void erts_init_fix_alloc(Uint extra_block_size, - void *(*alloc)(Uint)) -{ - int i; - - xblk_sz = extra_block_size; - core_alloc = alloc; - - fa = (FixAlloc **) (*core_alloc)(FA_SZ * sizeof(FixAlloc *)); - if (!fa) - erts_alloc_enomem(ERTS_ALC_T_UNDEF, FA_SZ * sizeof(FixAlloc *)); - - for (i = 0; i < FA_SZ; i++) - fa[i] = NULL; -#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE - first_time = 1; -#endif -} - -Uint -erts_get_fix_size(ErtsAlcType_t type) -{ - Uint i = FIX_IX(ERTS_ALC_T2N(type)); - return i < FA_SZ && fa[i] ? fa[i]->item_size : 0; -} - -void -erts_set_fix_size(ErtsAlcType_t type, Uint size) -{ - Uint sz; - Uint i; - FixAlloc *fs; - ErtsAlcType_t t_no = ERTS_ALC_T2N(type); - sz = xblk_sz + size; - -#ifdef DEBUG - ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no); - ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE); -#endif - - while (sz % sizeof(align_t) != 0) /* Alignment */ - sz++; - - i = FIX_IX(t_no); - fs = (FixAlloc *) (*core_alloc)(sizeof(FixAlloc)); - if (!fs) - erts_alloc_n_enomem(t_no, sizeof(FixAlloc)); - - fs->item_size = sz; - fs->no_blocks = 0; - fs->no_free = 0; - fs->blocks = NULL; - fs->freelist = NULL; - if (fa[i]) - erl_exit(-1, "Attempt to overwrite existing fix size (%d)", i); - fa[i] = fs; - -#if ERTS_ALC_MTA_FIXED_SIZE -#ifdef ERTS_SMP - erts_smp_spinlock_init_x(&fs->slck, "fix_alloc", make_small(i)); -#else - erts_mtx_init_x(&fs->mtx, "fix_alloc", make_small(i)); -#endif -#endif - -} - -void -erts_fix_info(ErtsAlcType_t type, ErtsFixInfo *efip) -{ - Uint i; - FixAlloc *f; -#ifdef DEBUG - FixAllocBlock *b; - void *fp; -#endif - Uint real_item_size; - ErtsAlcType_t t_no = ERTS_ALC_T2N(type); - - ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no); - ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE); - - i = FIX_IX(t_no); - f = fa[i]; - - efip->total = sizeof(FixAlloc *); - efip->used = 0; - if (!f) - return; - - real_item_size = f->item_size - xblk_sz; - - FA_LOCK(f); - - efip->total += sizeof(FixAlloc); - efip->total += f->no_blocks*FIX_POOL_SZ(real_item_size); - efip->used = efip->total - f->no_free*real_item_size; - -#ifdef DEBUG - ASSERT(efip->total >= efip->used); - for(i = 0, b = f->blocks; b; i++, b = b->next); - ASSERT(f->no_blocks == i); - for (i = 0, fp = f->freelist; fp; i++, fp = *((void **) fp)); - ASSERT(f->no_free == i); -#endif - - FA_UNLOCK(f); - -} - -void -erts_fix_free(ErtsAlcType_t t_no, void *extra, void* ptr) -{ - Uint i; - FixAlloc *f; - - ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no); - ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE); - - i = FIX_IX(t_no); - f = fa[i]; - - FA_LOCK(f); - *((void **) ptr) = f->freelist; - f->freelist = ptr; - f->no_free++; - FA_UNLOCK(f); -} - - -void *erts_fix_realloc(ErtsAlcType_t t_no, void *extra, void* ptr, Uint size) -{ - erts_alc_fatal_error(ERTS_ALC_E_NOTSUP, ERTS_ALC_O_REALLOC, t_no); - return NULL; -} - -void *erts_fix_alloc(ErtsAlcType_t t_no, void *extra, Uint size) -{ - void *ret; - int i; - FixAlloc *f; - -#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE - ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no); - ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE); - if (first_time) { /* Check that all sizes have been initialized */ - int i; - for (i = 0; i < FA_SZ; i++) - ASSERT(fa[i]); - first_time = 0; - } -#endif - - - i = FIX_IX(t_no); - f = fa[i]; - - ASSERT(f); - ASSERT(f->item_size >= size); - - FA_LOCK(f); - if (f->freelist == NULL) { /* Gotta alloc some more mem */ - char *ptr; - FixAllocBlock *bl; - Uint n; - - - FA_UNLOCK(f); - bl = (*core_alloc)(FIX_POOL_SZ(f->item_size)); - if (!bl) - return NULL; - - FA_LOCK(f); - bl->next = f->blocks; /* link in first */ - f->blocks = bl; - - n = NOPERBLOCK; - ptr = (char *) &f->blocks->mem[0]; - while(n--) { - *((void **) ptr) = f->freelist; - f->freelist = (void *) ptr; - ptr += f->item_size; - } -#if !ERTS_ALC_MTA_FIXED_SIZE - ASSERT(f->no_free == 0); -#endif - f->no_free += NOPERBLOCK; - f->no_blocks++; - } - - ret = f->freelist; - f->freelist = *((void **) f->freelist); - ASSERT(f->no_free > 0); - f->no_free--; - - FA_UNLOCK(f); - - return ret; -} - -#endif /* #ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE */ diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index a967aa0e3e..4a4973baab 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -42,12 +42,6 @@ typedef struct port Port; #include "erl_port_task.h" -#define ERTS_MAX_NO_OF_ASYNC_THREADS 1024 -extern int erts_async_max_threads; -#define ERTS_ASYNC_THREAD_MIN_STACK_SIZE 16 /* Kilo words */ -#define ERTS_ASYNC_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */ -extern int erts_async_thread_suggested_stack_size; - typedef struct erts_driver_t_ erts_driver_t; #define SMALL_IO_QUEUE 5 /* Number of fixed elements */ @@ -547,7 +541,7 @@ ERTS_GLB_INLINE void erts_may_save_closed_port(Port *prt) tombstone = (Eterm*) erts_smp_atomic_add_read_nob(&erts_dead_ports_ptr, -(erts_aint_t)sizeof(Eterm)); ASSERT(tombstone+1 != NULL); - ASSERT(prt->snapshot == erts_smp_atomic_read_nob(&erts_ports_snapshot) - 1); + ASSERT(prt->snapshot == erts_smp_atomic32_read_nob(&erts_ports_snapshot) - 1); *tombstone = prt->id; } /*else no ongoing snapshot or port was already included or created after snapshot */ @@ -852,10 +846,16 @@ void erts_queue_monitor_message(Process *, Eterm, Eterm); void erts_init_bif(void); +Eterm erl_send(Process *p, Eterm to, Eterm msg); + +/* erl_bif_op.c */ + +Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); /* erl_bif_port.c */ /* erl_bif_trace.c */ +Eterm erl_seq_trace_info(Process *p, Eterm arg1); void erts_system_monitor_clear(Process *c_p); void erts_system_profile_clear(Process *c_p); @@ -1641,8 +1641,7 @@ void monitor_generic(Process *p, Eterm type, Eterm spec); Uint erts_trace_flag2bit(Eterm flag); int erts_trace_flags(Eterm List, Uint *pMask, Eterm *pTracer, int *pCpuTimestamp); -Eterm erts_bif_trace(int bif_index, Process* p, - Eterm arg1, Eterm arg2, Eterm arg3, BeamInstr *I); +Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I); #ifdef ERTS_SMP void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 151c776a3d..fff720634d 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -42,6 +42,7 @@ #include "erl_bits.h" #include "erl_version.h" #include "error.h" +#include "erl_async.h" extern ErlDrvEntry fd_driver_entry; extern ErlDrvEntry vanilla_driver_entry; @@ -4579,7 +4580,10 @@ int driver_lock_driver(ErlDrvPort ix) erts_smp_mtx_lock(&erts_driver_list_lock); - if (prt == NULL) return -1; + if (prt == NULL) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + return -1; + } ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if ((dh = (DE_Handle*)prt->drv_ptr->handle ) == NULL) { diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c index 91e4ccce70..b93b1ad09a 100644 --- a/erts/emulator/beam/module.c +++ b/erts/emulator/beam/module.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -108,7 +108,8 @@ erts_put_module(Eterm mod) int index; ASSERT(is_atom(mod)); - ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0)); + ERTS_SMP_LC_ASSERT(erts_initialized == 0 + || erts_smp_thr_progress_is_blocking()); e.module = atom_val(mod); index = index_put(&module_table, (void*) &e); return (Module*) erts_index_lookup(&module_table, index); diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 34bd5d0653..fc53a88a3a 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -845,11 +845,11 @@ call_ext_only u==3 u$func:erlang:apply/3 => i_apply_only # thus there is no need to generate any return instruction. # -call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif1 Bif -call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif1 Bif +call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif Bif +call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif Bif -call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif1 Bif -call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif +call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif Bif +call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif Bif # # The error/1 and error/2 BIFs never execute the instruction following them; @@ -859,13 +859,13 @@ call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif # the continuation pointer on the stack. # -call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif1 Bif -call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif2 Bif +call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif Bif +call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif Bif call_ext_only Ar=u==1 Bif=u$bif:erlang:error/1 => \ - allocate u Ar | call_bif1 Bif + allocate u Ar | call_bif Bif call_ext_only Ar=u==2 Bif=u$bif:erlang:error/2 => \ - allocate u Ar | call_bif2 Bif + allocate u Ar | call_bif Bif # # The yield/0 BIF is an instruction @@ -889,24 +889,12 @@ call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate # To make trapping and stack backtraces work correctly, we make sure that # the continuation pointer is always stored on the stack. -call_ext u==0 Bif=u$is_bif => call_bif0 Bif -call_ext u==1 Bif=u$is_bif => call_bif1 Bif -call_ext u==2 Bif=u$is_bif => call_bif2 Bif -call_ext u==3 Bif=$is_bif => call_bif3 Bif +call_ext u Bif=u$is_bif => call_bif Bif -call_ext_last u==0 Bif=u$is_bif D => call_bif0 Bif | deallocate_return D -call_ext_last u==1 Bif=u$is_bif D => call_bif1 Bif | deallocate_return D -call_ext_last u==2 Bif=u$is_bif D => call_bif2 Bif | deallocate_return D -call_ext_last u==3 Bif=u$is_bif D => call_bif3 Bif | deallocate_return D +call_ext_last u Bif=u$is_bif D => call_bif Bif | deallocate_return D -call_ext_only Ar=u==0 Bif=u$is_bif => \ - allocate u Ar | call_bif0 Bif | deallocate_return u -call_ext_only Ar=u==1 Bif=u$is_bif => \ - allocate u Ar | call_bif1 Bif | deallocate_return u -call_ext_only Ar=u==2 Bif=u$is_bif => \ - allocate u Ar | call_bif2 Bif | deallocate_return u -call_ext_only Ar=u==3 Bif=u$is_bif => \ - allocate u Ar | call_bif3 Bif | deallocate_return u +call_ext_only Ar=u Bif=u$is_bif => \ + allocate u Ar | call_bif Bif | deallocate_return u # # Any remaining calls are calls to Erlang functions, not BIFs. @@ -933,10 +921,7 @@ i_apply_fun_only i_hibernate -call_bif0 e -call_bif1 e -call_bif2 e -call_bif3 e +call_bif e # # Calls to non-building and guard BIFs. diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 669a601b35..f9cbcc5892 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -475,15 +475,6 @@ __decl_noreturn void __noreturn erl_exit(int n, char*, ...); #define ERTS_ABORT_EXIT (INT_MIN + 1) /* no crash dump; only abort() */ #define ERTS_DUMP_EXIT (127) /* crash dump; then exit() */ - -#ifndef ERTS_SMP -int check_async_ready(void); -#ifdef USE_THREADS -void sys_async_ready(int hndl); -int erts_register_async_ready_callback(void (*funcp)(void)); -#endif -#endif - Eterm erts_check_io_info(void *p); /* Size of misc memory allocated from system dependent code */ @@ -616,13 +607,10 @@ extern char *erts_sys_ddll_error(int code); * System interfaces for startup. */ - -#ifdef ERTS_SMP void erts_sys_schedule_interrupt(int set); +#ifdef ERTS_SMP void erts_sys_schedule_interrupt_timed(int set, long msec); void erts_sys_main_thread(void); -#else -#define erts_sys_schedule_interrupt(Set) #endif extern void erts_sys_prepare_crash_dump(void); @@ -674,6 +662,8 @@ int erts_sys_putenv(char *key_value, int sep_ix); *size), a value > 0 if value buffer is too small (*size is set to needed size), and a value < 0 on failure. */ int erts_sys_getenv(char *key, char *value, size_t *size); +/* erts_sys_getenv__() is only allowed to be used in early init phase */ +int erts_sys_getenv__(char *key, char *value, size_t *size); /* Easier to use, but not as efficient, environment functions */ char *erts_read_env(char *key); @@ -697,291 +687,14 @@ int erts_write_env(char *key, char *value); int sys_alloc_opt(int, int); typedef struct { - Sint trim_threshold; - Sint top_pad; - Sint mmap_threshold; - Sint mmap_max; + int trim_threshold; + int top_pad; + int mmap_threshold; + int mmap_max; } SysAllocStat; void sys_alloc_stat(SysAllocStat *); -/* Block the whole system... */ - -#define ERTS_BS_FLG_ALLOW_GC (((Uint32) 1) << 0) -#define ERTS_BS_FLG_ALLOW_IO (((Uint32) 1) << 1) - -/* Activities... */ -typedef enum { - ERTS_ACTIVITY_UNDEFINED, /* Undefined activity */ - ERTS_ACTIVITY_WAIT, /* Waiting */ - ERTS_ACTIVITY_GC, /* Garbage collecting */ - ERTS_ACTIVITY_IO /* I/O including message passing to erl procs */ -} erts_activity_t; - -#ifdef ERTS_SMP - -typedef enum { - ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED, - ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY, - ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY -} erts_activity_error_t; - -typedef struct { - erts_smp_atomic32_t do_block; - struct { - erts_smp_atomic32_t wait; - erts_smp_atomic32_t gc; - erts_smp_atomic32_t io; - } in_activity; -} erts_system_block_state_t; - -extern erts_system_block_state_t erts_system_block_state; - -int erts_is_system_blocked(erts_activity_t allowed_activities); -void erts_block_me(void (*prepare)(void *), void (*resume)(void *), void *arg); -void erts_register_blockable_thread(void); -void erts_unregister_blockable_thread(void); -void erts_note_activity_begin(erts_activity_t activity); -void -erts_check_block(erts_activity_t old_activity, - erts_activity_t new_activity, - int locked, - void (*prepare)(void *), - void (*resume)(void *), - void *arg); -void erts_block_system(Uint32 allowed_activities); -int erts_emergency_block_system(long timeout, Uint32 allowed_activities); -void erts_release_system(void); -void erts_system_block_init(void); -void erts_set_activity_error(erts_activity_error_t, char *, int); -#ifdef ERTS_ENABLE_LOCK_CHECK -void erts_lc_activity_change_begin(void); -void erts_lc_activity_change_end(void); -int erts_lc_is_blocking(void); -#define ERTS_LC_IS_BLOCKING \ - (erts_smp_pending_system_block() && erts_lc_is_blocking()) -#endif -#endif - -#define erts_smp_activity_begin(NACT, PRP, RSM, ARG) \ - erts_smp_set_activity(ERTS_ACTIVITY_UNDEFINED, \ - (NACT), \ - 0, \ - (PRP), \ - (RSM), \ - (ARG), \ - __FILE__, \ - __LINE__) -#define erts_smp_activity_change(OACT, NACT, PRP, RSM, ARG) \ - erts_smp_set_activity((OACT), \ - (NACT), \ - 0, \ - (PRP), \ - (RSM), \ - (ARG), \ - __FILE__, \ - __LINE__) -#define erts_smp_activity_end(OACT, PRP, RSM, ARG) \ - erts_smp_set_activity((OACT), \ - ERTS_ACTIVITY_UNDEFINED, \ - 0, \ - (PRP), \ - (RSM), \ - (ARG), \ - __FILE__, \ - __LINE__) - -#define erts_smp_locked_activity_begin(NACT) \ - erts_smp_set_activity(ERTS_ACTIVITY_UNDEFINED, \ - (NACT), \ - 1, \ - NULL, \ - NULL, \ - NULL, \ - __FILE__, \ - __LINE__) -#define erts_smp_locked_activity_change(OACT, NACT) \ - erts_smp_set_activity((OACT), \ - (NACT), \ - 1, \ - NULL, \ - NULL, \ - NULL, \ - __FILE__, \ - __LINE__) -#define erts_smp_locked_activity_end(OACT) \ - erts_smp_set_activity((OACT), \ - ERTS_ACTIVITY_UNDEFINED, \ - 1, \ - NULL, \ - NULL, \ - NULL, \ - __FILE__, \ - __LINE__) - - -ERTS_GLB_INLINE int erts_smp_is_system_blocked(erts_activity_t allowed_activities); -ERTS_GLB_INLINE void erts_smp_block_system(Uint32 allowed_activities); -ERTS_GLB_INLINE int erts_smp_emergency_block_system(long timeout, - Uint32 allowed_activities); -ERTS_GLB_INLINE void erts_smp_release_system(void); -ERTS_GLB_INLINE int erts_smp_pending_system_block(void); -ERTS_GLB_INLINE void erts_smp_chk_system_block(void (*prepare)(void *), - void (*resume)(void *), - void *arg); -ERTS_GLB_INLINE void -erts_smp_set_activity(erts_activity_t old_activity, - erts_activity_t new_activity, - int locked, - void (*prepare)(void *), - void (*resume)(void *), - void *arg, - char *file, - int line); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - - -ERTS_GLB_INLINE int -erts_smp_is_system_blocked(erts_activity_t allowed_activities) -{ -#ifdef ERTS_SMP - return erts_is_system_blocked(allowed_activities); -#else - return 1; -#endif -} - -ERTS_GLB_INLINE void -erts_smp_block_system(Uint32 allowed_activities) -{ -#ifdef ERTS_SMP - erts_block_system(allowed_activities); -#endif -} - -ERTS_GLB_INLINE int -erts_smp_emergency_block_system(long timeout, Uint32 allowed_activities) -{ -#ifdef ERTS_SMP - return erts_emergency_block_system(timeout, allowed_activities); -#else - return 0; -#endif -} - -ERTS_GLB_INLINE void -erts_smp_release_system(void) -{ -#ifdef ERTS_SMP - erts_release_system(); -#endif -} - -ERTS_GLB_INLINE int -erts_smp_pending_system_block(void) -{ -#ifdef ERTS_SMP - return (int) erts_smp_atomic32_read_nob(&erts_system_block_state.do_block); -#else - return 0; -#endif -} - - -ERTS_GLB_INLINE void -erts_smp_chk_system_block(void (*prepare)(void *), - void (*resume)(void *), - void *arg) -{ -#ifdef ERTS_SMP - if (erts_smp_pending_system_block()) - erts_block_me(prepare, resume, arg); -#endif -} - -ERTS_GLB_INLINE void -erts_smp_set_activity(erts_activity_t old_activity, - erts_activity_t new_activity, - int locked, - void (*prepare)(void *), - void (*resume)(void *), - void *arg, - char *file, - int line) -{ -#ifdef ERTS_SMP -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_activity_change_begin(); -#endif - switch (old_activity) { - case ERTS_ACTIVITY_UNDEFINED: - break; - case ERTS_ACTIVITY_WAIT: - erts_smp_atomic32_dec_acqb(&erts_system_block_state.in_activity.wait); - if (locked) { - /* You are not allowed to leave activity waiting - * without supplying the possibility to block - * unlocked. - */ - erts_set_activity_error(ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED, - file, line); - } - break; - case ERTS_ACTIVITY_GC: - erts_smp_atomic32_dec_acqb(&erts_system_block_state.in_activity.gc); - break; - case ERTS_ACTIVITY_IO: - erts_smp_atomic32_dec_acqb(&erts_system_block_state.in_activity.io); - break; - default: - erts_set_activity_error(ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY, - file, line); - break; - } - - /* We are not allowed to block when going to activity waiting... */ - if (new_activity != ERTS_ACTIVITY_WAIT && erts_smp_pending_system_block()) - erts_check_block(old_activity,new_activity,locked,prepare,resume,arg); - - switch (new_activity) { - case ERTS_ACTIVITY_UNDEFINED: - break; - case ERTS_ACTIVITY_WAIT: - erts_smp_atomic32_inc_mb(&erts_system_block_state.in_activity.wait); - break; - case ERTS_ACTIVITY_GC: - erts_smp_atomic32_inc_mb(&erts_system_block_state.in_activity.gc); - break; - case ERTS_ACTIVITY_IO: - erts_smp_atomic32_inc_mb(&erts_system_block_state.in_activity.io); - break; - default: - erts_set_activity_error(ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY, - file, line); - break; - } - - switch (new_activity) { - case ERTS_ACTIVITY_WAIT: - case ERTS_ACTIVITY_GC: - case ERTS_ACTIVITY_IO: - if (erts_smp_pending_system_block()) - erts_note_activity_begin(new_activity); - break; - default: - break; - } - -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_activity_change_end(); -#endif - -#endif -} - -#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ - #if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK) #undef ERTS_REFC_DEBUG #define ERTS_REFC_DEBUG diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index 8fa8c1cfe0..db9a24e0a3 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -444,7 +444,7 @@ erts_time_left(ErlTimer *p) } #ifdef DEBUG -void erts_p_slpq() +void erts_p_slpq(void) { int i; ErlTimer* p; diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 825cb140b2..1bd178f280 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -42,6 +42,9 @@ #include "erl_threads.h" #include "erl_smp.h" #include "erl_time.h" +#include "erl_thr_progress.h" +#include "erl_thr_queue.h" +#include "erl_sched_spec_pre_alloc.h" #undef M_TRIM_THRESHOLD #undef M_TOP_PAD @@ -75,6 +78,7 @@ typedef struct { #ifdef ERTS_SMP +#if 0 /* Unused */ static void dispatch_profile_msg_q(profile_sched_msg_q *psmq) { @@ -86,6 +90,7 @@ dispatch_profile_msg_q(profile_sched_msg_q *psmq) profile_scheduler_q(make_small(msg->scheduler_id), msg->state, am_undefined, msg->Ms, msg->s, msg->us); } } +#endif #endif @@ -3317,10 +3322,10 @@ erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer) #endif -static Sint trim_threshold; -static Sint top_pad; -static Sint mmap_threshold; -static Sint mmap_max; +static int trim_threshold; +static int top_pad; +static int mmap_threshold; +static int mmap_max; Uint tot_bin_allocated; @@ -3343,8 +3348,8 @@ int sys_alloc_opt(int opt, int value) { #if HAVE_MALLOPT - Sint m_opt; - Sint *curr_val; + int m_opt; + int *curr_val; switch(opt) { case SYS_ALLOC_OPT_TRIM_THRESHOLD: @@ -3384,7 +3389,7 @@ sys_alloc_opt(int opt, int value) } if(mallopt(m_opt, value)) { - *curr_val = (Sint) value; + *curr_val = value; return 1; } @@ -3403,688 +3408,6 @@ sys_alloc_stat(SysAllocStat *sasp) } -#ifdef ERTS_SMP - -/* Local system block state */ - -struct { - int emergency; - long emergency_timeout; - erts_smp_cnd_t watchdog_cnd; - erts_smp_tid_t watchdog_tid; - int threads_to_block; - int have_blocker; - erts_smp_tid_t blocker_tid; - int recursive_block; - Uint32 allowed_activities; - erts_smp_tsd_key_t blockable_key; - erts_smp_mtx_t mtx; - erts_smp_cnd_t cnd; -#ifdef ERTS_ENABLE_LOCK_CHECK - int activity_changing; - int checking; -#endif -} system_block_state; - -/* Global system block state */ -erts_system_block_state_t erts_system_block_state; - - -static ERTS_INLINE int -is_blockable_thread(void) -{ - return erts_smp_tsd_get(system_block_state.blockable_key) != NULL; -} - -static ERTS_INLINE int -is_blocker(void) -{ - return (system_block_state.have_blocker - && erts_smp_equal_tids(system_block_state.blocker_tid, - erts_smp_thr_self())); -} - -#ifdef ERTS_ENABLE_LOCK_CHECK -int -erts_lc_is_blocking(void) -{ - int res; - erts_smp_mtx_lock(&system_block_state.mtx); - res = erts_smp_pending_system_block() && is_blocker(); - erts_smp_mtx_unlock(&system_block_state.mtx); - return res; -} -#endif - -static ERTS_INLINE void -block_me(void (*prepare)(void *), - void (*resume)(void *), - void *arg, - int mtx_locked, - int want_to_block, - int update_act_changing, - profile_sched_msg_q *psmq) -{ - if (prepare) - (*prepare)(arg); - - /* Locks might be held... */ - - if (!mtx_locked) - erts_smp_mtx_lock(&system_block_state.mtx); - - if (erts_smp_pending_system_block() && !is_blocker()) { - int is_blockable = is_blockable_thread(); - ASSERT(is_blockable); - - if (is_blockable) - system_block_state.threads_to_block--; - - if (erts_system_profile_flags.scheduler && psmq) { - ErtsSchedulerData *esdp = erts_get_scheduler_data(); - if (esdp) { - profile_sched_msg *msg = NULL; - - ASSERT(psmq->n < 2); - msg = &((psmq->msg)[psmq->n]); - msg->scheduler_id = esdp->no; - get_now(&(msg->Ms), &(msg->s), &(msg->us)); - msg->no_schedulers = 0; - msg->state = am_inactive; - psmq->n++; - } - } - -#ifdef ERTS_ENABLE_LOCK_CHECK - if (update_act_changing) - system_block_state.activity_changing--; -#endif - - erts_smp_cnd_broadcast(&system_block_state.cnd); - - do { - erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); - } while (erts_smp_pending_system_block() - && !(want_to_block && !system_block_state.have_blocker)); - -#ifdef ERTS_ENABLE_LOCK_CHECK - if (update_act_changing) - system_block_state.activity_changing++; -#endif - if (erts_system_profile_flags.scheduler && psmq) { - ErtsSchedulerData *esdp = erts_get_scheduler_data(); - if (esdp) { - profile_sched_msg *msg = NULL; - - ASSERT(psmq->n < 2); - msg = &((psmq->msg)[psmq->n]); - msg->scheduler_id = esdp->no; - get_now(&(msg->Ms), &(msg->s), &(msg->us)); - msg->no_schedulers = 0; - msg->state = am_active; - psmq->n++; - } - } - - if (is_blockable) - system_block_state.threads_to_block++; - } - - if (!mtx_locked) - erts_smp_mtx_unlock(&system_block_state.mtx); - - if (resume) - (*resume)(arg); -} - -void -erts_block_me(void (*prepare)(void *), - void (*resume)(void *), - void *arg) -{ - profile_sched_msg_q psmq; - psmq.n = 0; - if (prepare) - (*prepare)(arg); - -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_check_exact(NULL, 0); /* No locks should be locked */ -#endif - - block_me(NULL, NULL, NULL, 0, 0, 0, &psmq); - - if (erts_system_profile_flags.scheduler && psmq.n > 0) - dispatch_profile_msg_q(&psmq); - - if (resume) - (*resume)(arg); -} - -void -erts_register_blockable_thread(void) -{ - profile_sched_msg_q psmq; - psmq.n = 0; - if (!is_blockable_thread()) { - erts_smp_mtx_lock(&system_block_state.mtx); - system_block_state.threads_to_block++; - erts_smp_tsd_set(system_block_state.blockable_key, - (void *) &erts_system_block_state); - - /* Someone might be waiting for us to block... */ - if (erts_smp_pending_system_block()) - block_me(NULL, NULL, NULL, 1, 0, 0, &psmq); - erts_smp_mtx_unlock(&system_block_state.mtx); - - if (erts_system_profile_flags.scheduler && psmq.n > 0) - dispatch_profile_msg_q(&psmq); - } -} - -void -erts_unregister_blockable_thread(void) -{ - if (is_blockable_thread()) { - erts_smp_mtx_lock(&system_block_state.mtx); - system_block_state.threads_to_block--; - ASSERT(system_block_state.threads_to_block >= 0); - erts_smp_tsd_set(system_block_state.blockable_key, NULL); - - /* Someone might be waiting for us to block... */ - if (erts_smp_pending_system_block()) - erts_smp_cnd_broadcast(&system_block_state.cnd); - erts_smp_mtx_unlock(&system_block_state.mtx); - } -} - -void -erts_note_activity_begin(erts_activity_t activity) -{ - erts_smp_mtx_lock(&system_block_state.mtx); - if (erts_smp_pending_system_block()) { - Uint32 broadcast = 0; - switch (activity) { - case ERTS_ACTIVITY_GC: - broadcast = (system_block_state.allowed_activities - & ERTS_BS_FLG_ALLOW_GC); - break; - case ERTS_ACTIVITY_IO: - broadcast = (system_block_state.allowed_activities - & ERTS_BS_FLG_ALLOW_IO); - break; - case ERTS_ACTIVITY_WAIT: - broadcast = 1; - break; - default: - abort(); - break; - } - if (broadcast) - erts_smp_cnd_broadcast(&system_block_state.cnd); - } - erts_smp_mtx_unlock(&system_block_state.mtx); -} - -void -erts_check_block(erts_activity_t old_activity, - erts_activity_t new_activity, - int locked, - void (*prepare)(void *), - void (*resume)(void *), - void *arg) -{ - int do_block; - profile_sched_msg_q psmq; - - psmq.n = 0; - if (!locked && prepare) - (*prepare)(arg); - - erts_smp_mtx_lock(&system_block_state.mtx); - - /* First check if it is ok to block... */ - if (!locked) - do_block = 1; - else { - switch (old_activity) { - case ERTS_ACTIVITY_UNDEFINED: - do_block = 0; - break; - case ERTS_ACTIVITY_GC: - do_block = (system_block_state.allowed_activities - & ERTS_BS_FLG_ALLOW_GC); - break; - case ERTS_ACTIVITY_IO: - do_block = (system_block_state.allowed_activities - & ERTS_BS_FLG_ALLOW_IO); - break; - case ERTS_ACTIVITY_WAIT: - /* You are not allowed to leave activity waiting - * without supplying the possibility to block - * unlocked. - */ - erts_set_activity_error(ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED, - __FILE__, __LINE__); - do_block = 0; - break; - default: - erts_set_activity_error(ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY, - __FILE__, __LINE__); - do_block = 0; - break; - } - } - - if (do_block) { - /* ... then check if it is necessary to block... */ - - switch (new_activity) { - case ERTS_ACTIVITY_UNDEFINED: - do_block = 1; - break; - case ERTS_ACTIVITY_GC: - do_block = !(system_block_state.allowed_activities - & ERTS_BS_FLG_ALLOW_GC); - break; - case ERTS_ACTIVITY_IO: - do_block = !(system_block_state.allowed_activities - & ERTS_BS_FLG_ALLOW_IO); - break; - case ERTS_ACTIVITY_WAIT: - /* No need to block if we are going to wait */ - do_block = 0; - break; - default: - erts_set_activity_error(ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY, - __FILE__, __LINE__); - break; - } - } - - if (do_block) { - -#ifdef ERTS_ENABLE_LOCK_CHECK - if (!locked) { - /* Only system_block_state.mtx should be held */ - erts_lc_check_exact(&system_block_state.mtx.lc, 1); - } -#endif - - block_me(NULL, NULL, NULL, 1, 0, 1, &psmq); - - } - - erts_smp_mtx_unlock(&system_block_state.mtx); - - if (erts_system_profile_flags.scheduler && psmq.n > 0) - dispatch_profile_msg_q(&psmq); - - if (!locked && resume) - (*resume)(arg); -} - - - -void -erts_set_activity_error(erts_activity_error_t error, char *file, int line) -{ - switch (error) { - case ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED: - erl_exit(1, "%s:%d: Fatal error: Leaving activity waiting without " - "supplying the possibility to block unlocked.", - file, line); - break; - case ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY: - erl_exit(1, "%s:%d: Fatal error: Leaving unknown activity.", - file, line); - break; - case ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY: - erl_exit(1, "%s:%d: Fatal error: Leaving unknown activity.", - file, line); - break; - default: - erl_exit(1, "%s:%d: Internal error in erts_smp_set_activity()", - file, line); - break; - } - -} - - -static ERTS_INLINE erts_aint32_t -threads_not_under_control(void) -{ - erts_aint32_t res = system_block_state.threads_to_block; - - ERTS_THR_MEMORY_BARRIER; - - /* Waiting is always an allowed activity... */ - res -= erts_smp_atomic32_read_nob(&erts_system_block_state.in_activity.wait); - - if (system_block_state.allowed_activities & ERTS_BS_FLG_ALLOW_GC) - res -= erts_smp_atomic32_read_nob(&erts_system_block_state.in_activity.gc); - - if (system_block_state.allowed_activities & ERTS_BS_FLG_ALLOW_IO) - res -= erts_smp_atomic32_read_nob(&erts_system_block_state.in_activity.io); - - if (res < 0) { - ASSERT(0); - return 0; - } - return res; -} - -/* - * erts_block_system() blocks all threads registered as blockable. - * It doesn't return until either all threads have blocked (0 is returned) - * or it has timed out (ETIMEDOUT) is returned. - * - * If allowed activities == 0, blocked threads will release all locks - * before blocking. - * - * If allowed_activities is != 0, erts_block_system() will allow blockable - * threads to continue executing as long as they are doing an allowed - * activity. When they are done with the allowed activity they will block, - * *but* they will block holding locks. Therefore, the thread calling - * erts_block_system() must *not* try to aquire any locks that might be - * held by blocked threads holding locks from allowed activities. - * - * Currently allowed_activities are: - * * ERTS_BS_FLG_ALLOW_GC Thread continues with garbage - * collection and blocks with - * main process lock on current - * process locked. - * * ERTS_BS_FLG_ALLOW_IO Thread continues with I/O - */ - -void -erts_block_system(Uint32 allowed_activities) -{ - int do_block; - profile_sched_msg_q psmq; - - psmq.n = 0; -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_check_exact(NULL, 0); /* No locks should be locked */ -#endif - - erts_smp_mtx_lock(&system_block_state.mtx); - - do_block = erts_smp_pending_system_block(); - if (do_block - && system_block_state.have_blocker - && erts_smp_equal_tids(system_block_state.blocker_tid, - erts_smp_thr_self())) { - ASSERT(system_block_state.recursive_block >= 0); - system_block_state.recursive_block++; - - /* You are not allowed to restrict allowed activites - in a recursive block! */ - ERTS_SMP_LC_ASSERT((system_block_state.allowed_activities - & ~allowed_activities) == 0); - } - else { - - erts_smp_atomic32_inc_nob(&erts_system_block_state.do_block); - - /* Someone else might be waiting for us to block... */ - if (do_block) { - do_block_me: - block_me(NULL, NULL, NULL, 1, 1, 0, &psmq); - } - - ASSERT(!system_block_state.have_blocker); - system_block_state.have_blocker = 1; - system_block_state.blocker_tid = erts_smp_thr_self(); - system_block_state.allowed_activities = allowed_activities; - - if (is_blockable_thread()) - system_block_state.threads_to_block--; - - while (threads_not_under_control() && !system_block_state.emergency) - erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); - - if (system_block_state.emergency) { - system_block_state.have_blocker = 0; - goto do_block_me; - } - } - - erts_smp_mtx_unlock(&system_block_state.mtx); - - if (erts_system_profile_flags.scheduler && psmq.n > 0 ) - dispatch_profile_msg_q(&psmq); -} - -/* - * erts_emergency_block_system() should only be called when we are - * about to write a crash dump... - */ - -int -erts_emergency_block_system(long timeout, Uint32 allowed_activities) -{ - int res = 0; - long another_blocker; - - erts_smp_mtx_lock(&system_block_state.mtx); - - if (system_block_state.emergency) { - /* Argh... */ - res = EINVAL; - goto done; - } - - another_blocker = erts_smp_pending_system_block(); - system_block_state.emergency = 1; - erts_smp_atomic32_inc_nob(&erts_system_block_state.do_block); - - if (another_blocker) { - if (is_blocker()) { - erts_smp_atomic32_dec_nob(&erts_system_block_state.do_block); - res = 0; - goto done; - } - /* kick the other blocker */ - erts_smp_cnd_broadcast(&system_block_state.cnd); - while (system_block_state.have_blocker) - erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); - } - - ASSERT(!system_block_state.have_blocker); - system_block_state.have_blocker = 1; - system_block_state.blocker_tid = erts_smp_thr_self(); - system_block_state.allowed_activities = allowed_activities; - - if (is_blockable_thread()) - system_block_state.threads_to_block--; - - if (timeout < 0) { - while (threads_not_under_control()) - erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); - } - else { - system_block_state.emergency_timeout = timeout; - erts_smp_cnd_signal(&system_block_state.watchdog_cnd); - - while (system_block_state.emergency_timeout >= 0 - && threads_not_under_control()) { - erts_smp_cnd_wait(&system_block_state.cnd, - &system_block_state.mtx); - } - } - done: - erts_smp_mtx_unlock(&system_block_state.mtx); - return res; -} - -void -erts_release_system(void) -{ - long do_block; - profile_sched_msg_q psmq; - - psmq.n = 0; - -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_check_exact(NULL, 0); /* No locks should be locked */ -#endif - - erts_smp_mtx_lock(&system_block_state.mtx); - ASSERT(is_blocker()); - - ASSERT(system_block_state.recursive_block >= 0); - - if (system_block_state.recursive_block) - system_block_state.recursive_block--; - else { - do_block = erts_smp_atomic32_dec_read_nob(&erts_system_block_state.do_block); - system_block_state.have_blocker = 0; - if (is_blockable_thread()) - system_block_state.threads_to_block++; - else - do_block = 0; - - /* Someone else might be waiting for us to block... */ - if (do_block) - block_me(NULL, NULL, NULL, 1, 0, 0, &psmq); - else - erts_smp_cnd_broadcast(&system_block_state.cnd); - } - - erts_smp_mtx_unlock(&system_block_state.mtx); - - if (erts_system_profile_flags.scheduler && psmq.n > 0) - dispatch_profile_msg_q(&psmq); -} - -#ifdef ERTS_ENABLE_LOCK_CHECK - -void -erts_lc_activity_change_begin(void) -{ - erts_smp_mtx_lock(&system_block_state.mtx); - system_block_state.activity_changing++; - erts_smp_mtx_unlock(&system_block_state.mtx); -} - -void -erts_lc_activity_change_end(void) -{ - erts_smp_mtx_lock(&system_block_state.mtx); - system_block_state.activity_changing--; - if (system_block_state.checking && !system_block_state.activity_changing) - erts_smp_cnd_broadcast(&system_block_state.cnd); - erts_smp_mtx_unlock(&system_block_state.mtx); -} - -#endif - -int -erts_is_system_blocked(erts_activity_t allowed_activities) -{ - int blkd; - - erts_smp_mtx_lock(&system_block_state.mtx); - blkd = (erts_smp_pending_system_block() - && system_block_state.have_blocker - && erts_smp_equal_tids(system_block_state.blocker_tid, - erts_smp_thr_self()) - && !(system_block_state.allowed_activities & ~allowed_activities)); -#ifdef ERTS_ENABLE_LOCK_CHECK - if (blkd) { - system_block_state.checking = 1; - while (system_block_state.activity_changing) - erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); - system_block_state.checking = 0; - blkd = !threads_not_under_control(); - } -#endif - erts_smp_mtx_unlock(&system_block_state.mtx); - return blkd; -} - -static void * -emergency_watchdog(void *unused) -{ - erts_smp_mtx_lock(&system_block_state.mtx); - while (1) { - long timeout; - while (system_block_state.emergency_timeout < 0) - erts_smp_cnd_wait(&system_block_state.watchdog_cnd, &system_block_state.mtx); - timeout = system_block_state.emergency_timeout; - erts_smp_mtx_unlock(&system_block_state.mtx); - - if (erts_disable_tolerant_timeofday) - erts_milli_sleep(timeout); - else { - SysTimeval to; - erts_get_timeval(&to); - to.tv_sec += timeout / 1000; - to.tv_usec += timeout % 1000; - - while (1) { - SysTimeval curr; - erts_milli_sleep(timeout); - erts_get_timeval(&curr); - if (curr.tv_sec > to.tv_sec - || (curr.tv_sec == to.tv_sec && curr.tv_usec >= to.tv_usec)) { - break; - } - timeout = (to.tv_sec - curr.tv_sec)*1000; - timeout += (to.tv_usec - curr.tv_usec)/1000; - } - } - - erts_smp_mtx_lock(&system_block_state.mtx); - system_block_state.emergency_timeout = -1; - erts_smp_cnd_broadcast(&system_block_state.cnd); - } - erts_smp_mtx_unlock(&system_block_state.mtx); - return NULL; -} - -void -erts_system_block_init(void) -{ - erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER; - /* Local state... */ - system_block_state.emergency = 0; - system_block_state.emergency_timeout = -1; - erts_smp_cnd_init(&system_block_state.watchdog_cnd); - system_block_state.threads_to_block = 0; - system_block_state.have_blocker = 0; - /* system_block_state.block_tid */ - system_block_state.recursive_block = 0; - system_block_state.allowed_activities = 0; - erts_smp_tsd_key_create(&system_block_state.blockable_key); - erts_smp_mtx_init(&system_block_state.mtx, "system_block"); - erts_smp_cnd_init(&system_block_state.cnd); -#ifdef ERTS_ENABLE_LOCK_CHECK - system_block_state.activity_changing = 0; - system_block_state.checking = 0; -#endif - - thr_opts.suggested_stack_size = 8; - erts_smp_thr_create(&system_block_state.watchdog_tid, - emergency_watchdog, - NULL, - &thr_opts); - - /* Global state... */ - - erts_smp_atomic32_init_nob(&erts_system_block_state.do_block, 0); - erts_smp_atomic32_init_nob(&erts_system_block_state.in_activity.wait, 0); - erts_smp_atomic32_init_nob(&erts_system_block_state.in_activity.gc, 0); - erts_smp_atomic32_init_nob(&erts_system_block_state.in_activity.io, 0); - - /* Make sure blockable threads unregister when exiting... */ - erts_smp_install_exit_handler(erts_unregister_blockable_thread); -} - - -#endif /* #ifdef ERTS_SMP */ - char * erts_read_env(char *key) { diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 68987b3493..52f1b5312b 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -2493,13 +2493,20 @@ file_flush(ErlDrvData e) { static int file_control(ErlDrvData e, unsigned int command, char* buf, int len, char **rbuf, int rlen) { + /* + * warning: variable ‘desc’ set but not used + * [-Wunused-but-set-variable] + * ... no kidding ... + * + * file_descriptor *desc = (file_descriptor *)e; switch (command) { default: return 0; - } /* switch (command) */ + } ASSERT(0); - desc = NULL; /* XXX Avoid warning while empty switch */ + desc = NULL; + */ return 0; } diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index d782b044a9..45d39a559f 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -242,7 +242,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) #ifndef HAVE_TERMCAP return ERL_DRV_ERROR_GENERAL; #else - char *s, *t, c, *l; + char *s, *t, *l; int canon, echo, sig; /* Terminal characteristics */ int flag; extern int using_oldshell; /* set this to let the rest of erts know */ @@ -262,7 +262,6 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) s++; /* Find end of this argument (start of next) and insert NUL. */ if ((t = strchr(s, ' '))) { - c = *t; *t = '\0'; } if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) { diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index 931bb196f1..931bb196f1 100755..100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c diff --git a/erts/emulator/hipe/hipe_abi.txt b/erts/emulator/hipe/hipe_abi.txt index d0ec162342..9d4726de9d 100644 --- a/erts/emulator/hipe/hipe_abi.txt +++ b/erts/emulator/hipe/hipe_abi.txt @@ -62,7 +62,7 @@ exceptional condition, it puts an error code in p->freason and returns THE_NON_VALUE (zero, except in debug mode). If p->freason == TRAP, then the BIF redirects its call to some -other function, given by p->def_arg_reg[]. +other function, given by p->i The BIF and the new callee may have different arities. The "hipe_${ARCH}_bifs.m4" macro files take care of these issues diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index 0ba763cbea..97a8267647 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -20,24 +20,37 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_amd64_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" + `#if THE_NON_VALUE == 0 #define TEST_GOT_EXN testq %rax, %rax #else #define TEST_GOT_EXN cmpq $THE_NON_VALUE, %rax #endif' -`#define TEST_GOT_MBUF movq P_MBUF(P), %rdx; testq %rdx, %rdx; jnz 3f; 2: -#define JOIN3(A,B,C) A##B##C -#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); jmp 2b' +define(TEST_GOT_MBUF,`movq P_MBUF(P), %rdx # `TEST_GOT_MBUF' + testq %rdx, %rdx + jnz 3f +2:') +define(HANDLE_GOT_MBUF,` +3: call nbif_$1_gc_after_bif # `HANDLE_GOT_MBUF' + jmp 2b') + +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) movq $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) +#else +# define CALL_BIF(F) call CSYM(F) +#endif' /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-3 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -54,7 +67,11 @@ ASYM($1): /* make the call on the C stack */ SWITCH_ERLANG_TO_C - call CSYM($2) + pushq %rsi + movq %rsp, %rsi /* Eterm* BIF__ARGS */ + sub $(8), %rsp /* stack frame 16-byte alignment */ + CALL_BIF($2) + add $(1*8 + 8), %rsp TEST_GOT_MBUF SWITCH_C_TO_ERLANG @@ -82,7 +99,11 @@ ASYM($1): /* make the call on the C stack */ SWITCH_ERLANG_TO_C - call CSYM($2) + pushq %rdx + pushq %rsi + movq %rsp, %rsi /* Eterm* BIF__ARGS */ + CALL_BIF($2) + add $(2*8), %rsp TEST_GOT_MBUF SWITCH_C_TO_ERLANG @@ -111,7 +132,13 @@ ASYM($1): /* make the call on the C stack */ SWITCH_ERLANG_TO_C - call CSYM($2) + pushq %rcx + pushq %rdx + pushq %rsi + movq %rsp, %rsi /* Eterm* BIF__ARGS */ + sub $(8), %rsp /* stack frame 16-byte alignment */ + CALL_BIF($2) + add $(3*8 + 8), %rsp TEST_GOT_MBUF SWITCH_C_TO_ERLANG @@ -124,13 +151,7 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -143,7 +164,7 @@ ASYM($1): /* make the call on the C stack */ SWITCH_ERLANG_TO_C - call CSYM($2) + CALL_BIF($2) TEST_GOT_MBUF SWITCH_C_TO_ERLANG diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index 3664fb6502..e0c6f09796 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -20,18 +20,27 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_arm_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" .text .p2align 2 -`#define JOIN3(A,B,C) A##B##C -#define TEST_GOT_MBUF(ARITY) ldr r1, [P, #P_MBUF]; cmp r1, #0; blne JOIN3(nbif_,ARITY,_gc_after_bif)' +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) mov r14, #F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper +#else +# define CALL_BIF(F) bl F +#endif' + +define(TEST_GOT_MBUF,`ldr r1, [P, #P_MBUF] /* `TEST_GOT_MBUF' */ + cmp r1, #0 + blne nbif_$1_gc_after_bif') /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * * Generate native interface for a BIF with 1-3 parameters and * standard failure mode. @@ -48,7 +57,9 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl $2 + str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */ + add r1, r0, #P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF(1) /* Restore registers. Check for exception. */ @@ -73,7 +84,10 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl $2 + str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */ + str r2, [r0, #P_ARG1] + add r1, r0, #P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF(2) /* Restore registers. Check for exception. */ @@ -99,7 +113,11 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl $2 + str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */ + str r2, [r0, #P_ARG1] + str r3, [r0, #P_ARG2] + add r1, r0, #P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF(3) /* Restore registers. Check for exception. */ @@ -111,13 +129,7 @@ $1: .type $1, %function #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -128,7 +140,8 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl $2 + /* ignore empty BIF__ARGS */ + CALL_BIF($2) TEST_GOT_MBUF(0) /* Restore registers. Check for exception. */ diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h index f02e8862dc..c512d66f9d 100644 --- a/erts/emulator/hipe/hipe_bif0.h +++ b/erts/emulator/hipe/hipe_bif0.h @@ -29,7 +29,7 @@ extern Uint *hipe_bifs_find_pc_from_mfa(Eterm mfa); extern void hipe_mfa_info_table_init(void); extern void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a); -extern Eterm hipe_find_na_or_make_stub(Process*, Eterm, Eterm, Eterm); +extern BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3); extern int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a); #if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) extern void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int a); diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index 2660f74a82..ee97541e15 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -166,3 +166,26 @@ BIF_RETTYPE hipe_bifs_show_message_area_0(BIF_ALIST_0) BIF_RET(am_false); #endif } + +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + +BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1); + +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) + +BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1) +{ + typedef BIF_RETTYPE Bif(BIF_ALIST_1); + Bif* fp = (Bif*) (BIF_P->hipe.bif_callee); + BIF_RETTYPE res; + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(BIF_P); + res = (*fp)(BIF_P, BIF__ARGS); + ERTS_SMP_REQ_PROC_MAIN_LOCK(BIF_P); + return res; +} + +#endif /* ERTS_ENABLE_LOCK_CHECK && ERTS_SMP */ + diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 083788997b..48c7c1bc9b 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -70,24 +70,18 @@ ****************************************************************/ /* + * standard_bif_interface_0(nbif_name, cbif_name) * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) * - * A BIF with implicit P parameter, 1-3 ordinary parameters, + * A BIF with implicit P parameter, 0-3 ordinary parameters, * which may fail. * HP and FCALLS may be read and updated. * HP_LIMIT, NSP, NSP_LIMIT, and NRA may not be accessed. */ /* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * A zero-arity BIF which may fail, otherwise - * identical to standard_bif_interface_N. - */ - -/* * nofail_primop_interface_0(nbif_name, cbif_name) * nofail_primop_interface_1(nbif_name, cbif_name) * nofail_primop_interface_2(nbif_name, cbif_name) @@ -150,8 +144,7 @@ /* * Zero-arity BIFs that can fail. */ -fail_bif_interface_0(nbif_memory_0, memory_0) -fail_bif_interface_0(nbif_processes_0, processes_0) +standard_bif_interface_0(nbif_processes_0, processes_0) /* * BIFs and primops that may do a GC (change heap limit and walk the native stack). @@ -176,10 +169,10 @@ gc_bif_interface_0(nbif_hipe_bifs_nstack_used_size_0, hipe_bifs_nstack_used_size /* * Arithmetic operators called indirectly by the HiPE compiler. */ -standard_bif_interface_2(nbif_add_2, erts_mixed_plus) -standard_bif_interface_2(nbif_sub_2, erts_mixed_minus) -standard_bif_interface_2(nbif_mul_2, erts_mixed_times) -standard_bif_interface_2(nbif_div_2, erts_mixed_div) +standard_bif_interface_2(nbif_add_2, splus_2) +standard_bif_interface_2(nbif_sub_2, sminus_2) +standard_bif_interface_2(nbif_mul_2, stimes_2) +standard_bif_interface_2(nbif_div_2, div_2) standard_bif_interface_2(nbif_intdiv_2, intdiv_2) standard_bif_interface_2(nbif_rem_2, rem_2) standard_bif_interface_2(nbif_bsl_2, bsl_2) @@ -261,11 +254,6 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc) ',)dnl /* - * Implement standard_bif_interface_0 as nofail_primop_interface_0. - */ -define(standard_bif_interface_0,`nofail_primop_interface_0($1, $2)') - -/* * Standard BIFs. * BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index) */ diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index bced90785d..61e15f1d58 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -1,9 +1,8 @@ /* * %CopyrightBegin% - - * + * * Copyright Ericsson AB 2001-2011. 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 @@ -212,6 +211,11 @@ static const unsigned int CRCTABLE[256] = { 0xB40BBE37, 0xC30C8EA1, 0x5A05DF1B, 0x2D02EF8D, }; +/* For hipe cross compiler. Hard code all values. + No calls by hipe compiler to query the running emulator. +*/ +static int is_xcomp = 0; + /* * The algorithm for calculating the 32 bit CRC checksum is based upon * documentation and algorithms provided by Dr. Ross N. Williams in the @@ -243,7 +247,7 @@ crc_update_buf(unsigned int crc_value, } static unsigned int -crc_update_int(unsigned int crc_value, const unsigned int *p) +crc_update_int(unsigned int crc_value, const int *p) { return crc_update_buf(crc_value, p, sizeof *p); } @@ -256,7 +260,7 @@ crc_update_int(unsigned int crc_value, const unsigned int *p) */ static const struct literal { const char *name; - unsigned int value; + int value; } literals[] = { /* Field offsets in a process struct */ { "P_HP", offsetof(struct process, htop) }, @@ -289,6 +293,9 @@ static const struct literal { { "P_NRA", offsetof(struct process, hipe.nra) }, #endif { "P_NARITY", offsetof(struct process, hipe.narity) }, +# if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + { "P_BIF_CALLEE", offsetof(struct process, hipe.bif_callee) }, +# endif #endif /* HIPE */ /* process flags bits */ @@ -298,7 +305,7 @@ static const struct literal { { "FREASON_TRAP", TRAP }, /* special Erlang constants */ - { "THE_NON_VALUE", THE_NON_VALUE }, + { "THE_NON_VALUE", (int)THE_NON_VALUE }, /* funs */ #ifdef HIPE @@ -452,7 +459,7 @@ static const struct rts_param { unsigned int nr; const char *name; unsigned int is_defined; - unsigned int value; + int value; } rts_params[] = { { 1, "P_OFF_HEAP_FUNS", #if !defined(HYBRID) @@ -528,12 +535,12 @@ static void compute_crc(void) static void c_define_literal(FILE *fp, const struct literal *literal) { - fprintf(fp, "#define %s %u\n", literal->name, literal->value); + fprintf(fp, "#define %s %d\n", literal->name, literal->value); } static void e_define_literal(FILE *fp, const struct literal *literal) { - fprintf(fp, "-define(%s, %u).\n", literal->name, literal->value); + fprintf(fp, "-define(%s, %d).\n", literal->name, literal->value); } static void print_literals(FILE *fp, void (*print_literal)(FILE*, const struct literal*)) @@ -560,7 +567,7 @@ static void print_atom_literals(FILE *fp, void (*print_atom_literal)(FILE*, cons static void c_define_param(FILE *fp, const struct rts_param *param) { if (param->is_defined) - fprintf(fp, "#define %s %u\n", param->name, param->value); + fprintf(fp, "#define %s %d\n", param->name, param->value); } static void c_case_param(FILE *fp, const struct rts_param *param) @@ -568,7 +575,7 @@ static void c_case_param(FILE *fp, const struct rts_param *param) fprintf(fp, " \\\n"); fprintf(fp, "\tcase %u: ", param->nr); if (param->is_defined) - fprintf(fp, "value = %u", param->value); + fprintf(fp, "value = %d", param->value); else fprintf(fp, "is_defined = 0"); fprintf(fp, "; break;"); @@ -576,7 +583,15 @@ static void c_case_param(FILE *fp, const struct rts_param *param) static void e_define_param(FILE *fp, const struct rts_param *param) { - fprintf(fp, "-define(%s, hipe_bifs:get_rts_param(%u)).\n", param->name, param->nr); + if (is_xcomp) { + if (param->is_defined) + fprintf(fp, "-define(%s, %d).\n", param->name, param->value); + else + fprintf(fp, "-define(%s, []).\n", param->name); + } + else { + fprintf(fp, "-define(%s, hipe_bifs:get_rts_param(%u)).\n", param->name, param->nr); + } } static void print_params(FILE *fp, void (*print_param)(FILE*,const struct rts_param*)) @@ -613,19 +628,40 @@ static int do_e(FILE *fp, const char* this_exe) fprintf(fp, "\n"); print_params(fp, e_define_param); fprintf(fp, "\n"); - fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n", literals_crc); + if (is_xcomp) { + fprintf(fp, "-define(HIPE_SYSTEM_CRC, %u).\n", system_crc); + } + else { + fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n", + literals_crc); + } return 0; } int main(int argc, const char **argv) { + int i; + int (*do_func_ptr)(FILE *, const char*) = NULL; + compute_crc(); - if (argc == 2) { - if (strcmp(argv[1], "-c") == 0) - return do_c(stdout, argv[0]); - if (strcmp(argv[1], "-e") == 0) - return do_e(stdout, argv[0]); + for (i = 1; i < argc; i++) { + if (strcmp(argv[i], "-c") == 0) + do_func_ptr = &do_c; + else if (strcmp(argv[i], "-e") == 0) + do_func_ptr = &do_e; + else if (strcmp(argv[i], "-x") == 0) + is_xcomp = 1; + else + goto error; + } + if (do_func_ptr) { + return do_func_ptr(stdout, argv[0]); } - fprintf(stderr, "usage: %s [-c | -e] > output-file\n", argv[0]); +error: + fprintf(stderr, "usage: %s [-x] [-c | -e] > output-file\n" + "\t-c\tC header file\n" + "\t-e\tErlang header file\n" + "\t-x\tCross compile. No dependencies to compiling emulator\n", + argv[0]); return 1; } diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index e5b8cf8a19..4d75883fc5 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -35,6 +35,17 @@ #include "hipe_stack.h" #include "hipe_bif0.h" /* hipe_mfa_info_table_init() */ +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) +#else +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) +#endif + + /* * Internal debug support. * #define HIPE_DEBUG to the desired debug level: @@ -318,8 +329,8 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) * Native code called a BIF, which "failed" with a TRAP to BEAM. * Prior to returning, the BIF stored (see BIF_TRAP<N>): - * the callee's address in p->def_arg_reg[3] - * the callee's parameters in p->def_arg_reg[0..2] + * the callee's address in p->i + * the callee's parameters in reg[0..2] * the callee's arity in p->arity (for BEAM gc purposes) * * We need to remove the BIF's parameters from the native @@ -331,19 +342,8 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) */ unsigned int i, is_recursive = 0; - /* Save p->arity, then update it with the original BIF's arity. - Get rid of any stacked parameters in that call. */ - /* XXX: hipe_call_from_native_is_recursive() copies data to - reg[], which is useless in the TRAP case. Maybe write a - specialised hipe_trap_from_native_is_recursive() later. */ if (p->hipe.nsp != NULL) { - unsigned int callee_arity; - callee_arity = p->arity; - p->arity = p->hipe.narity; /* caller's arity */ - is_recursive = hipe_call_from_native_is_recursive(p, reg); - - p->i = (Eterm *)(p->def_arg_reg[3]); - p->arity = callee_arity; + is_recursive = hipe_trap_from_native_is_recursive(p); } /* Schedule next process if current process was hibernated or is waiting @@ -353,15 +353,14 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) goto do_schedule; } if (p->status == P_WAITING) { + for (i = 0; i < p->arity; ++i) + p->arg_reg[i] = reg[i]; goto do_schedule; } - for (i = 0; i < p->arity; ++i) - reg[i] = p->def_arg_reg[i]; - if (is_recursive) hipe_push_beam_trap_frame(p, reg, p->arity); - + result = HIPE_MODE_SWITCH_RES_CALL; break; } @@ -470,7 +469,9 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) #if !(NR_ARG_REGS > 5) int reds_in = p->def_arg_reg[5]; #endif + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(p); p = schedule(p, reds_in - p->fcalls); + ERTS_SMP_REQ_PROC_MAIN_LOCK(p); #ifdef ERTS_SMP p->hipe_smp.have_receive_locks = 0; reg = p->scheduler_data->x_reg_array; diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index dfb4ca794a..77dee6f9e9 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -41,9 +41,9 @@ */ /* for -Wmissing-prototypes :-( */ -extern Eterm hipe_check_process_code_2(Process*, Eterm, Eterm); -extern Eterm hipe_garbage_collect_1(Process*, Eterm); -extern Eterm hipe_show_nstack_1(Process*, Eterm); +extern Eterm hipe_check_process_code_2(BIF_ALIST_2); +extern Eterm hipe_garbage_collect_1(BIF_ALIST_1); +extern Eterm hipe_show_nstack_1(BIF_ALIST_1); /* Used when a BIF can trigger a stack walk. */ static __inline__ void hipe_set_narity(Process *p, unsigned int arity) @@ -56,7 +56,7 @@ Eterm hipe_check_process_code_2(BIF_ALIST_2) Eterm ret; hipe_set_narity(BIF_P, 2); - ret = check_process_code_2(BIF_P, BIF_ARG_1, BIF_ARG_2); + ret = check_process_code_2(BIF_P, BIF__ARGS); hipe_set_narity(BIF_P, 0); return ret; } @@ -66,7 +66,7 @@ Eterm hipe_garbage_collect_1(BIF_ALIST_1) Eterm ret; hipe_set_narity(BIF_P, 1); - ret = garbage_collect_1(BIF_P, BIF_ARG_1); + ret = garbage_collect_1(BIF_P, BIF__ARGS); hipe_set_narity(BIF_P, 0); return ret; } @@ -76,7 +76,7 @@ Eterm hipe_show_nstack_1(BIF_ALIST_1) Eterm ret; hipe_set_narity(BIF_P, 1); - ret = hipe_bifs_show_nstack_1(BIF_P, BIF_ARG_1); + ret = hipe_bifs_show_nstack_1(BIF_P, BIF__ARGS); hipe_set_narity(BIF_P, 0); return ret; } @@ -99,8 +99,10 @@ void hipe_gc(Process *p, Eterm need) * has begun. * XXX: BUG: native code should check return status */ -Eterm hipe_set_timeout(Process *p, Eterm timeout_value) +BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm timeout_value = BIF_ARG_1; #if !defined(ARCH_64) Uint time_val; #endif @@ -286,8 +288,13 @@ static struct StackTrace *get_trace_from_exc(Eterm exc) * This does what the (misnamed) Beam instruction 'raise_ss' does, * namely, a proper re-throw of an exception that was caught by 'try'. */ -Eterm hipe_rethrow(Process *c_p, Eterm exc, Eterm value) + +BIF_RETTYPE hipe_rethrow(BIF_ALIST_2) { + Process* c_p = BIF_P; + Eterm exc = BIF_ARG_1; + Eterm value = BIF_ARG_2; + c_p->fvalue = value; if (c_p->freason == EXC_NULL) { /* a safety check for the R10-0 case; should not happen */ @@ -411,8 +418,12 @@ Eterm hipe_bs_utf8_size(Eterm arg) return make_small(4); } -Eterm hipe_bs_put_utf8(Process *p, Eterm arg, byte *base, unsigned int offset) +BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3) { + Process* p = BIF_P; + Eterm arg = BIF_ARG_1; + byte* base = (byte*) BIF_ARG_2; + Uint offset = (Uint) BIF_ARG_3; byte *save_bin_buf; Uint save_bin_offset; int res; @@ -468,13 +479,21 @@ Eterm hipe_bs_put_utf16(Process *p, Eterm arg, byte *base, unsigned int offset, return new_offset; } -Eterm hipe_bs_put_utf16be(Process *p, Eterm arg, byte *base, unsigned int offset) +BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3) { + Process *p = BIF_P; + Eterm arg = BIF_ARG_1; + byte *base = (byte*) BIF_ARG_2; + Uint offset = (Uint) BIF_ARG_3; return hipe_bs_put_utf16(p, arg, base, offset, 0); } -Eterm hipe_bs_put_utf16le(Process *p, Eterm arg, byte *base, unsigned int offset) +BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3) { + Process *p = BIF_P; + Eterm arg = BIF_ARG_1; + byte *base = (byte*) BIF_ARG_2; + Uint offset = (Uint) BIF_ARG_3; return hipe_bs_put_utf16(p, arg, base, offset, BSF_LITTLE); } @@ -489,8 +508,10 @@ static int validate_unicode(Eterm arg) return 1; } -Eterm hipe_bs_validate_unicode(Process *p, Eterm arg) +BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1) { + Process *p = BIF_P; + Eterm arg = BIF_ARG_1; if (!validate_unicode(arg)) BIF_ERROR(p, BADARG); return NIL; diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index 13a02b84a2..8c9dec180e 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -23,6 +23,7 @@ #ifndef HIPE_NATIVE_BIF_H #define HIPE_NATIVE_BIF_H +#include "bif.h" #include "hipe_arch.h" /* @@ -71,24 +72,24 @@ AEXTERN(void,nbif_select_msg,(Process*)); AEXTERN(Eterm,nbif_cmp_2,(void)); AEXTERN(Eterm,nbif_eq_2,(void)); -Eterm hipe_nonclosure_address(Process*, Eterm, Uint); -Eterm hipe_conv_big_to_float(Process*, Eterm); +BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2); +BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1); void hipe_fclearerror_error(Process*); void hipe_select_msg(Process*); void hipe_gc(Process*, Eterm); -Eterm hipe_set_timeout(Process*, Eterm); +BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1); void hipe_handle_exception(Process*); -Eterm hipe_rethrow(Process *c_p, Eterm exc, Eterm value); +BIF_RETTYPE hipe_rethrow(BIF_ALIST_2); char *hipe_bs_allocate(int); Binary *hipe_bs_reallocate(Binary*, int); int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned); void hipe_bs_put_bits(Eterm, Uint, byte*, unsigned, unsigned); Eterm hipe_bs_utf8_size(Eterm); -Eterm hipe_bs_put_utf8(Process*, Eterm, byte*, unsigned int); +BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3); Eterm hipe_bs_utf16_size(Eterm); -Eterm hipe_bs_put_utf16be(Process*, Eterm, byte*, unsigned int); -Eterm hipe_bs_put_utf16le(Process*, Eterm, byte*, unsigned int); -Eterm hipe_bs_validate_unicode(Process*, Eterm); +BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3); +BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3); +BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1); struct erl_bin_match_buffer; int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm); diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4 index 0eb5c441e6..343402f9f0 100644 --- a/erts/emulator/hipe/hipe_ppc_asm.m4 +++ b/erts/emulator/hipe/hipe_ppc_asm.m4 @@ -31,12 +31,23 @@ define(LOAD,ld)dnl define(STORE,std)dnl define(CMPI,cmpdi)dnl define(WSIZE,8)dnl +`#define STORE_IA(ADDR, DST, TMP) \ + addis TMP, 0, ADDR@highest SEMI\ + ori TMP, TMP, ADDR@higher SEMI\ + rldicr TMP, TMP, 32, 31 SEMI\ + oris TMP, TMP, ADDR@h SEMI\ + ori TMP, TMP, ADDR@l SEMI\ + std TMP, DST' ',` /* 32-bit PowerPC */ define(LOAD,lwz)dnl define(STORE,stw)dnl define(CMPI,cmpwi)dnl define(WSIZE,4)dnl +`#define STORE_IA(ADDR, DST, TMP) \ + lis TMP, ADDR@ha SEMI\ + addi TMP, TMP, ADDR@l SEMI\ + stw TMP, DST' ')dnl `#define LOAD 'LOAD `#define STORE 'STORE diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index 203fefe1a1..d09551d10d 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -20,21 +20,34 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_ppc_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) STORE_IA(CSYM(F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper) +#else +# define CALL_BIF(F) bl CSYM(F) +#endif' + .text .p2align 2 -`#define TEST_GOT_MBUF LOAD r4, P_MBUF(P) SEMI CMPI r4, 0 SEMI bne- 3f SEMI 2: -#define JOIN3(A,B,C) A##B##C -#define HANDLE_GOT_MBUF(ARITY) 3: bl CSYM(JOIN3(nbif_,ARITY,_gc_after_bif)) SEMI b 2b' +define(TEST_GOT_MBUF,`LOAD r4, P_MBUF(P) # `TEST_GOT_MBUF' + CMPI r4, 0 + bne- 3f +2:') +define(HANDLE_GOT_MBUF,` +3: bl CSYM(nbif_$1_gc_after_bif) # `HANDLE_GOT_MBUF' + b 2b') + /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-3 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -49,7 +62,9 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -77,7 +92,10 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + STORE r5, P_ARG1(r3) + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -106,7 +124,11 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + STORE r5, P_ARG1(r3) + STORE r6, P_ARG2(r3) + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -121,13 +143,7 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -138,7 +154,8 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - bl CSYM($2) + /* ignore empty BIF__ARGS */ + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -173,7 +190,8 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - bl CSYM($2) + /* ignore empty BIF__ARGS */ + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. */ @@ -196,7 +214,9 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ @@ -224,7 +244,10 @@ ASYM($1): /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - bl CSYM($2) + STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[] + STORE r5, P_ARG1(r3) + addi r4, r3, P_ARG0 + CALL_BIF($2) TEST_GOT_MBUF /* Restore registers. Check for exception. */ diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h index 5effacb398..43f47d1a28 100644 --- a/erts/emulator/hipe/hipe_process.h +++ b/erts/emulator/hipe/hipe_process.h @@ -42,6 +42,9 @@ struct hipe_process_state { void (*nra)(void); /* Native code return address. */ #endif unsigned int narity; /* Arity of BIF call, for stack walks. */ +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + void (*bif_callee)(void); /* When calling BIF's via debug wrapper */ +#endif }; extern void hipe_arch_print_pcb(struct hipe_process_state *p); diff --git a/erts/emulator/hipe/hipe_risc_glue.h b/erts/emulator/hipe/hipe_risc_glue.h index e74023e3e9..cc2671c016 100644 --- a/erts/emulator/hipe/hipe_risc_glue.h +++ b/erts/emulator/hipe/hipe_risc_glue.h @@ -199,6 +199,22 @@ hipe_call_from_native_is_recursive(Process *p, Eterm reg[]) return 0; } +/* BEAM called native, which called BIF that returned trap + * Discard bif parameters. + * If tailcall, also clean up native stub continuation. */ +static __inline__ int +hipe_trap_from_native_is_recursive(Process *p) +{ + if (p->hipe.narity > NR_ARG_REGS) { + p->hipe.nsp += (p->hipe.narity - NR_ARG_REGS); + } + if (p->hipe.nra != (void(*)(void))&nbif_return) + return 1; + hipe_pop_risc_nra_frame(p); + return 0; +} + + /* Native makes a call which needs to unload the parameters. This differs from hipe_call_from_native_is_recursive() in that it doesn't check for or pop the BEAM-calls-native frame. diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index 03db7f3413..ca5af45d58 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -20,27 +20,42 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_sparc_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" .section ".text" .align 4 +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) set F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper +#else +# define CALL_BIF(F) call F +#endif' + /* * Test for exception. This macro executes its delay slot. */ -`#define __TEST_GOT_EXN(LABEL) cmp %o0, THE_NON_VALUE; bz,pn %icc, LABEL -#define TEST_GOT_EXN(ARITY) __TEST_GOT_EXN(JOIN3(nbif_,ARITY,_simple_exception))' +define(TEST_GOT_EXN,`cmp %o0, THE_NON_VALUE ! `TEST_GOT_EXN' + bz,pn %icc, nbif_$1_simple_exception') -`#define TEST_GOT_MBUF ld [P+P_MBUF], %o1; cmp %o1, 0; bne 3f; nop; 2: -#define JOIN3(A,B,C) A##B##C -#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); nop; b 2b; nop' +define(TEST_GOT_MBUF,`ld [P+P_MBUF], %o1 ! `TEST_GOT_MBUF' + cmp %o1, 0 + bne 3f + nop +2:') +define(HANDLE_GOT_MBUF,` +3: call nbif_$1_gc_after_bif ! `HANDLE_GOT_MBUF' + nop + b 2b + nop') /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-3 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -55,7 +70,9 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF @@ -81,7 +98,10 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + st %o2, [%o0+P_ARG1] + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF @@ -108,7 +128,11 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + st %o2, [%o0+P_ARG1] + st %o3, [%o0+P_ARG2] + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF @@ -121,13 +145,7 @@ $1: .type $1, #function #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -138,7 +156,8 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_BIF - call $2 + /* ignore empty BIF__ARGS */ + CALL_BIF($2) nop TEST_GOT_MBUF @@ -171,7 +190,8 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - call $2 + /* ignore empty BIF__ARGS */ + CALL_BIF($2) nop TEST_GOT_MBUF @@ -195,7 +215,9 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF @@ -221,7 +243,10 @@ $1: /* Save caller-save registers and call the C function. */ SAVE_CONTEXT_GC - call $2 + st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg + st %o2, [%o0+P_ARG1] + add %o0, P_ARG0, %o1 + CALL_BIF($2) nop TEST_GOT_MBUF diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index 1bb6488b00..2ea69bde3c 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -20,6 +20,7 @@ changecom(`/*', `*/')dnl include(`hipe/hipe_x86_asm.m4') +#`include' "config.h" #`include' "hipe_literals.h" `#if THE_NON_VALUE == 0 @@ -28,16 +29,27 @@ include(`hipe/hipe_x86_asm.m4') #define TEST_GOT_EXN cmpl $THE_NON_VALUE,%eax #endif' -`#define TEST_GOT_MBUF movl P_MBUF(P), %edx; testl %edx, %edx; jnz 3f; 2: -#define JOIN3(A,B,C) A##B##C -#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); jmp 2b' +`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) +# define CALL_BIF(F) movl $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) +#else +# define CALL_BIF(F) call CSYM(F) +#endif' + +define(TEST_GOT_MBUF,`movl P_MBUF(P), %edx # `TEST_GOT_MBUF' + testl %edx, %edx + jnz 3f +2:') +define(HANDLE_GOT_MBUF,` +3: call nbif_$1_gc_after_bif # `HANDLE_GOT_MBUF' + jmp 2b') /* * standard_bif_interface_1(nbif_name, cbif_name) * standard_bif_interface_2(nbif_name, cbif_name) * standard_bif_interface_3(nbif_name, cbif_name) + * standard_bif_interface_0(nbif_name, cbif_name) * - * Generate native interface for a BIF with 1-3 parameters and + * Generate native interface for a BIF with 0-3 parameters and * standard failure mode. */ define(standard_bif_interface_1, @@ -56,8 +68,10 @@ ASYM($1): /* make the call on the C stack */ NBIF_ARG_REG(0,P) - NBIF_ARG(1,1,0) - call CSYM($2) + NBIF_ARG(2,1,0) + lea 8(%esp), %eax + NBIF_ARG_REG(1,%eax) # BIF__ARGS + CALL_BIF($2) TEST_GOT_MBUF /* switch to native stack */ @@ -88,9 +102,11 @@ ASYM($1): /* make the call on the C stack */ NBIF_ARG_REG(0,P) - NBIF_ARG(1,2,0) - NBIF_ARG(2,2,1) - call CSYM($2) + NBIF_ARG(2,2,0) + NBIF_ARG(3,2,1) + lea 8(%esp), %eax + NBIF_ARG_REG(1,%eax) # BIF__ARGS + CALL_BIF($2) TEST_GOT_MBUF /* switch to native stack */ @@ -121,10 +137,12 @@ ASYM($1): /* make the call on the C stack */ NBIF_ARG_REG(0,P) - NBIF_ARG(1,3,0) - NBIF_ARG(2,3,1) - NBIF_ARG(3,3,2) - call CSYM($2) + NBIF_ARG(2,3,0) + NBIF_ARG(3,3,1) + NBIF_ARG(4,3,2) + lea 8(%esp), %eax + NBIF_ARG_REG(1,%eax) # BIF__ARGS + CALL_BIF($2) TEST_GOT_MBUF /* switch to native stack */ @@ -139,13 +157,7 @@ ASYM($1): TYPE_FUNCTION(ASYM($1)) #endif') -/* - * fail_bif_interface_0(nbif_name, cbif_name) - * - * Generate native interface for a BIF with 0 parameters and - * standard failure mode. - */ -define(fail_bif_interface_0, +define(standard_bif_interface_0, ` #ifndef HAVE_$1 #`define' HAVE_$1 @@ -158,7 +170,8 @@ ASYM($1): /* make the call on the C stack */ NBIF_ARG_REG(0,P) - call CSYM($2) + /* skip BIF__ARGS */ + CALL_BIF($2) TEST_GOT_MBUF /* switch to native stack */ diff --git a/erts/emulator/hipe/hipe_x86_glue.h b/erts/emulator/hipe/hipe_x86_glue.h index a7b0f164be..b0db93267c 100644 --- a/erts/emulator/hipe/hipe_x86_glue.h +++ b/erts/emulator/hipe/hipe_x86_glue.h @@ -186,6 +186,25 @@ hipe_call_from_native_is_recursive(Process *p, Eterm reg[]) return 0; } +/* BEAM called native, which called BIF that returned trap + * Discard bif parameters. + * If tailcall, also clean up native stub continuation. */ +static __inline__ int +hipe_trap_from_native_is_recursive(Process *p) +{ + Eterm nra = *(p->hipe.nsp++); + + if (p->hipe.narity > NR_ARG_REGS) { + p->hipe.nsp += (p->hipe.narity - NR_ARG_REGS); + } + if (nra != (Eterm)nbif_return) { + *--(p->hipe.nsp) = nra; + return 1; + } + return 0; +} + + /* Native makes a call which needs to unload the parameters. This differs from hipe_call_from_native_is_recursive() in that it doesn't check for or pop the BEAM-calls-native frame. diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 57321259f9..ba88fd1d39 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -35,6 +35,7 @@ #include "sys.h" #include "global.h" #include "erl_check_io.h" +#include "erl_thr_progress.h" #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS # define ERTS_DRV_EV_STATE_EXTRA_SIZE 128 @@ -66,6 +67,9 @@ typedef char EventStateFlags; #define ERTS_CIO_POLL_CTL ERTS_POLL_EXPORT(erts_poll_control) #define ERTS_CIO_POLL_WAIT ERTS_POLL_EXPORT(erts_poll_wait) +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +#define ERTS_CIO_POLL_AS_INTR ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt) +#endif #define ERTS_CIO_POLL_INTR ERTS_POLL_EXPORT(erts_poll_interrupt) #define ERTS_CIO_POLL_INTR_TMD ERTS_POLL_EXPORT(erts_poll_interrupt_timed) #define ERTS_CIO_NEW_POLLSET ERTS_POLL_EXPORT(erts_poll_create_pollset) @@ -1115,6 +1119,14 @@ eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data) static void bad_fd_in_pollset( ErtsDrvEventState *, Eterm, Eterm, ErtsPollEvents); +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +void +ERTS_CIO_EXPORT(erts_check_io_async_sig_interrupt)(void) +{ + ERTS_CIO_POLL_AS_INTR(pollset.ps); +} +#endif + void ERTS_CIO_EXPORT(erts_check_io_interrupt)(int set) { @@ -1153,7 +1165,6 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_check_exact(NULL, 0); /* No locks should be locked */ #endif - erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); pollres_len = sizeof(pollres)/sizeof(ErtsPollResFd); erts_smp_atomic_set_nob(&pollset.in_poll_wait, 1); @@ -1163,7 +1174,6 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_check_exact(NULL, 0); /* No locks should be locked */ #endif - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); erts_deliver_time(); /* sync the machine's idea of time */ @@ -1870,13 +1880,12 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void) erts_printf("--- fds in pollset --------------------------------------\n"); -#ifdef ERTS_SMP -# ifdef ERTS_ENABLE_LOCK_CHECK +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) erts_lc_check_exact(NULL, 0); /* No locks should be locked */ -# endif - erts_block_system(0); /* stop the world to avoid messy locking */ #endif + erts_smp_thr_progress_block(); /* stop the world to avoid messy locking */ + #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS counters.epep = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsPollEvents)*max_fds); ERTS_POLL_EXPORT(erts_poll_get_selected_events)(pollset.ps, counters.epep, max_fds); @@ -1898,9 +1907,7 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void) safe_hash_for_each(&drv_ev_state_tab, &doit_erts_check_io_debug, (void *) &counters); #endif -#ifdef ERTS_SMP - erts_release_system(); -#endif + erts_smp_thr_progress_unblock(); erts_printf("\n"); erts_printf("used fds=%d\n", counters.used_fds); diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h index 9b45a63913..7cc1658062 100644 --- a/erts/emulator/sys/common/erl_check_io.h +++ b/erts/emulator/sys/common/erl_check_io.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2011. 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 @@ -40,6 +40,10 @@ Eterm erts_check_io_info_kp(void *); Eterm erts_check_io_info_nkp(void *); int erts_check_io_max_files_kp(void); int erts_check_io_max_files_nkp(void); +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +void erts_check_io_async_sig_interrupt_kp(void); +void erts_check_io_async_sig_interrupt_nkp(void); +#endif void erts_check_io_interrupt_kp(int); void erts_check_io_interrupt_nkp(int); void erts_check_io_interrupt_timed_kp(int, long); @@ -56,6 +60,9 @@ int erts_check_io_debug_nkp(void); Uint erts_check_io_size(void); Eterm erts_check_io_info(void *); int erts_check_io_max_files(void); +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +void erts_check_io_async_sig_interrupt(void); +#endif void erts_check_io_interrupt(int); void erts_check_io_interrupt_timed(int, long); void erts_check_io(int); diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index eaef6680dd..49750ff6ce 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -36,14 +36,12 @@ #include "erl_threads.h" #include "erl_mtrace.h" #include "erl_time.h" +#include "erl_alloc.h" #include "big.h" +#include "erl_thr_progress.h" #if HAVE_ERTS_MSEG -#if defined(USE_THREADS) && !defined(ERTS_SMP) -# define ERTS_THREADS_NO_SMP -#endif - #define SEGTYPE ERTS_MTRACE_SEGMENT_ID #ifndef HAVE_GETPAGESIZE @@ -75,16 +73,9 @@ static int atoms_initialized; -static Uint cache_check_interval; - typedef struct mem_kind_t MemKind; -static void check_cache(void *unused); static void mseg_clear_cache(MemKind*); -static int is_cache_check_scheduled; -#ifdef ERTS_THREADS_NO_SMP -static int is_cache_check_requested; -#endif #if HALFWORD_HEAP static int initialize_pmmap(void); @@ -138,7 +129,8 @@ const ErtsMsegOpt_t erts_mseg_default_opt = { 1, /* Use cache */ 1, /* Preserv data */ 0, /* Absolute shrink threshold */ - 0 /* Relative shrink threshold */ + 0, /* Relative shrink threshold */ + 0 /* Scheduler specific */ #if HALFWORD_HEAP ,0 /* need low memory */ #endif @@ -157,11 +149,10 @@ typedef struct { Uint32 no; } CallCounter; -static int is_init_done; static Uint page_size; static Uint page_shift; -static struct { +typedef struct { CallCounter alloc; CallCounter dealloc; CallCounter realloc; @@ -172,7 +163,9 @@ static struct { #endif CallCounter clear_cache; CallCounter check_cache; -} calls; +} ErtsMsegCalls; + +typedef struct ErtsMsegAllctr_t_ ErtsMsegAllctr_t; struct mem_kind_t { cache_desc_t cache_descs[MAX_CACHE_SIZE]; @@ -201,25 +194,84 @@ struct mem_kind_t { } max_ever; } segments; + ErtsMsegAllctr_t *ma; const char* name; MemKind* next; };/*MemKind*/ +struct ErtsMsegAllctr_t_ { + int ix; + + int is_init_done; + int is_thread_safe; + erts_mtx_t mtx; + + int is_cache_check_scheduled; + + MemKind* mk_list; + #if HALFWORD_HEAP -static MemKind low_mem, hi_mem; + MemKind low_mem; + MemKind hi_mem; #else -static MemKind the_mem; + MemKind the_mem; #endif -static MemKind* mk_list = NULL; -static Uint max_cache_size; -static Uint abs_max_cache_bad_fit; -static Uint rel_max_cache_bad_fit; + Uint max_cache_size; + Uint abs_max_cache_bad_fit; + Uint rel_max_cache_bad_fit; + + ErtsMsegCalls calls; #if CAN_PARTLY_DESTROY -static Uint min_seg_size; + Uint min_seg_size; +#endif + +}; + +typedef union { + ErtsMsegAllctr_t mseg_alloc; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsMsegAllctr_t))]; +} ErtsAlgndMsegAllctr_t; + +static int no_mseg_allocators; +static ErtsAlgndMsegAllctr_t *aligned_mseg_allctr; + +#ifdef ERTS_SMP + +#define ERTS_MSEG_ALLCTR_IX(IX) \ + (&aligned_mseg_allctr[(IX)].mseg_alloc) + +#define ERTS_MSEG_ALLCTR_SS() \ + ERTS_MSEG_ALLCTR_IX((int) erts_get_scheduler_id()) + +#define ERTS_MSEG_ALLCTR_OPT(OPT) \ + ((OPT)->sched_spec ? ERTS_MSEG_ALLCTR_SS() : ERTS_MSEG_ALLCTR_IX(0)) + +#else + +#define ERTS_MSEG_ALLCTR_IX(IX) \ + (&aligned_mseg_allctr[0].mseg_alloc) + +#define ERTS_MSEG_ALLCTR_SS() \ + (&aligned_mseg_allctr[0].mseg_alloc) + +#define ERTS_MSEG_ALLCTR_OPT(OPT) \ + (&aligned_mseg_allctr[0].mseg_alloc) + #endif +#define ERTS_MSEG_LOCK(MA) \ +do { \ + if ((MA)->is_thread_safe) \ + erts_mtx_lock(&(MA)->mtx); \ +} while (0) + +#define ERTS_MSEG_UNLOCK(MA) \ +do { \ + if ((MA)->is_thread_safe) \ + erts_mtx_unlock(&(MA)->mtx); \ +} while (0) #define ERTS_MSEG_ALLOC_STAT(C,SZ) \ do { \ @@ -250,104 +302,44 @@ do { \ #define ONE_GIGA (1000000000) -#define ZERO_CC(CC) (calls.CC.no = 0, calls.CC.giga_no = 0) +#define ZERO_CC(MA, CC) ((MA)->calls.CC.no = 0, \ + (MA)->calls.CC.giga_no = 0) -#define INC_CC(CC) (calls.CC.no == ONE_GIGA - 1 \ - ? (calls.CC.giga_no++, calls.CC.no = 0) \ - : calls.CC.no++) +#define INC_CC(MA, CC) ((MA)->calls.CC.no == ONE_GIGA - 1 \ + ? ((MA)->calls.CC.giga_no++, \ + (MA)->calls.CC.no = 0) \ + : (MA)->calls.CC.no++) -#define DEC_CC(CC) (calls.CC.no == 0 \ - ? (calls.CC.giga_no--, \ - calls.CC.no = ONE_GIGA - 1) \ - : calls.CC.no--) +#define DEC_CC(MA, CC) ((MA)->calls.CC.no == 0 \ + ? ((MA)->calls.CC.giga_no--, \ + (MA)->calls.CC.no = ONE_GIGA - 1) \ + : (MA)->calls.CC.no--) -static erts_mtx_t mseg_mutex; /* Also needed when !USE_THREADS */ static erts_mtx_t init_atoms_mutex; /* Also needed when !USE_THREADS */ -#ifdef USE_THREADS -#ifdef ERTS_THREADS_NO_SMP -static erts_tid_t main_tid; -static int async_handle = -1; -#endif - -static void thread_safe_init(void) -{ - erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms"); - erts_mtx_init(&mseg_mutex, "mseg"); - -#ifdef ERTS_THREADS_NO_SMP - main_tid = erts_thr_self(); -#endif -} - -#endif - -static ErlTimer cache_check_timer; static ERTS_INLINE void -schedule_cache_check(void) -{ - if (!is_cache_check_scheduled && is_init_done) { -#ifdef ERTS_THREADS_NO_SMP - if (!erts_equal_tids(erts_thr_self(), main_tid)) { - if (!is_cache_check_requested) { - is_cache_check_requested = 1; - sys_async_ready(async_handle); - } - } - else -#endif - { - cache_check_timer.active = 0; - erts_set_timer(&cache_check_timer, - check_cache, - NULL, - NULL, - cache_check_interval); - is_cache_check_scheduled = 1; -#ifdef ERTS_THREADS_NO_SMP - is_cache_check_requested = 0; -#endif - } - } -} - -#ifdef ERTS_THREADS_NO_SMP - -static void -check_schedule_cache_check(void) +schedule_cache_check(ErtsMsegAllctr_t *ma) { - erts_mtx_lock(&mseg_mutex); - if (is_cache_check_requested - && !is_cache_check_scheduled) { - schedule_cache_check(); - } - erts_mtx_unlock(&mseg_mutex); -} - -#endif -static void -mseg_shutdown(void) -{ - MemKind* mk; - erts_mtx_lock(&mseg_mutex); - for (mk=mk_list; mk; mk=mk->next) { - mseg_clear_cache(mk); + if (!ma->is_cache_check_scheduled && ma->is_init_done) { + erts_set_aux_work_timeout(ma->ix, + ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK, + 1); + ma->is_cache_check_scheduled = 1; } - erts_mtx_unlock(&mseg_mutex); } static ERTS_INLINE void * -mseg_create(MemKind* mk, Uint size) +mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size) { void *seg; ASSERT(size % page_size == 0); #if HALFWORD_HEAP - if (mk == &low_mem) { + if (mk == &ma->low_mem) { seg = pmmap(size); if ((unsigned long) seg & CHECK_POINTER_MASK) { erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg); @@ -371,18 +363,18 @@ mseg_create(MemKind* mk, Uint size) #endif } - INC_CC(create); + INC_CC(ma, create); return seg; } static ERTS_INLINE void -mseg_destroy(MemKind* mk, void *seg, Uint size) +mseg_destroy(ErtsMsegAllctr_t *ma, MemKind* mk, void *seg, Uint size) { int res; #if HALFWORD_HEAP - if (mk == &low_mem) { + if (mk == &ma->low_mem) { res = pmunmap((void *) seg, size); } else @@ -401,14 +393,14 @@ mseg_destroy(MemKind* mk, void *seg, Uint size) ASSERT(size % page_size == 0); ASSERT(res == 0); - INC_CC(destroy); + INC_CC(ma, destroy); } #if HAVE_MSEG_RECREATE static ERTS_INLINE void * -mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size) +mseg_recreate(ErtsMsegAllctr_t *ma, MemKind* mk, void *old_seg, Uint old_size, Uint new_size) { void *new_seg; @@ -416,7 +408,7 @@ mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size) ASSERT(new_size % page_size == 0); #if HALFWORD_HEAP - if (mk == &low_mem) { + if (mk == &ma->low_mem) { new_seg = (void *) pmremap((void *) old_seg, (size_t) old_size, (size_t) new_size); @@ -447,19 +439,37 @@ mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size) #endif } - INC_CC(recreate); + INC_CC(ma, recreate); return new_seg; } #endif /* #if HAVE_MSEG_RECREATE */ +#ifdef DEBUG +#define ERTS_DBG_MA_CHK_THR_ACCESS(MA) \ +do { \ + if ((MA)->is_thread_safe) \ + ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&(MA)->mtx) \ + || erts_smp_thr_progress_is_blocking() \ + || ERTS_IS_CRASH_DUMPING); \ + else \ + ERTS_LC_ASSERT((MA)->ix == (int) erts_get_scheduler_id() \ + || erts_smp_thr_progress_is_blocking() \ + || ERTS_IS_CRASH_DUMPING); \ +} while (0) +#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) \ + ERTS_DBG_MA_CHK_THR_ACCESS((MK)->ma) +#else +#define ERTS_DBG_MA_CHK_THR_ACCESS(MA) +#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) +#endif static ERTS_INLINE cache_desc_t * alloc_cd(MemKind* mk) { cache_desc_t *cd = mk->free_cache_descs; - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); + ERTS_DBG_MK_CHK_THR_ACCESS(mk); if (cd) mk->free_cache_descs = cd->next; return cd; @@ -468,7 +478,7 @@ alloc_cd(MemKind* mk) static ERTS_INLINE void free_cd(MemKind* mk, cache_desc_t *cd) { - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); + ERTS_DBG_MK_CHK_THR_ACCESS(mk); cd->next = mk->free_cache_descs; mk->free_cache_descs = cd; } @@ -477,7 +487,7 @@ free_cd(MemKind* mk, cache_desc_t *cd) static ERTS_INLINE void link_cd(MemKind* mk, cache_desc_t *cd) { - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); + ERTS_DBG_MK_CHK_THR_ACCESS(mk); if (mk->cache) mk->cache->prev = cd; cd->next = mk->cache; @@ -496,7 +506,7 @@ link_cd(MemKind* mk, cache_desc_t *cd) static ERTS_INLINE void end_link_cd(MemKind* mk, cache_desc_t *cd) { - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); + ERTS_DBG_MK_CHK_THR_ACCESS(mk); if (mk->cache_end) mk->cache_end->next = cd; cd->next = NULL; @@ -515,7 +525,7 @@ end_link_cd(MemKind* mk, cache_desc_t *cd) static ERTS_INLINE void unlink_cd(MemKind* mk, cache_desc_t *cd) { - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); + ERTS_DBG_MK_CHK_THR_ACCESS(mk); if (cd->next) cd->next->prev = cd->prev; else @@ -533,7 +543,7 @@ static ERTS_INLINE void check_cache_limits(MemKind* mk) { cache_desc_t *cd; - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); + ERTS_DBG_MK_CHK_THR_ACCESS(mk); mk->max_cached_seg_size = 0; mk->min_cached_seg_size = ~((Uint) 0); for (cd = mk->cache; cd; cd = cd->next) { @@ -551,7 +561,7 @@ adjust_cache_size(MemKind* mk, int force_check_limits) int check_limits = force_check_limits; Sint max_cached = ((Sint) mk->segments.current.watermark - (Sint) mk->segments.current.no); - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); + ERTS_DBG_MK_CHK_THR_ACCESS(mk); while (((Sint) mk->cache_size) > max_cached && ((Sint) mk->cache_size) > 0) { ASSERT(mk->cache_end); cd = mk->cache_end; @@ -562,7 +572,7 @@ adjust_cache_size(MemKind* mk, int force_check_limits) } if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); - mseg_destroy(mk, cd->seg, cd->size); + mseg_destroy(mk->ma, mk, cd->seg, cd->size); unlink_cd(mk,cd); free_cd(mk,cd); } @@ -571,7 +581,7 @@ adjust_cache_size(MemKind* mk, int force_check_limits) check_cache_limits(mk); } -static void +static Uint check_one_cache(MemKind* mk) { if (mk->segments.current.watermark > mk->segments.current.no) @@ -579,23 +589,37 @@ check_one_cache(MemKind* mk) adjust_cache_size(mk, 0); if (mk->cache_size) - schedule_cache_check(); + schedule_cache_check(mk->ma); + return mk->cache_size; } -static void check_cache(void* unused) +static void do_cache_check(ErtsMsegAllctr_t *ma) { + int empty_cache = 1; MemKind* mk; - erts_mtx_lock(&mseg_mutex); - is_cache_check_scheduled = 0; + ERTS_MSEG_LOCK(ma); - for (mk=mk_list; mk; mk=mk->next) { - check_one_cache(mk); + for (mk=ma->mk_list; mk; mk=mk->next) { + if (check_one_cache(mk)) + empty_cache = 0; + } + + if (empty_cache) { + ma->is_cache_check_scheduled = 0; + erts_set_aux_work_timeout(ma->ix, + ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK, + 0); } - INC_CC(check_cache); + INC_CC(ma, check_cache); - erts_mtx_unlock(&mseg_mutex); + ERTS_MSEG_UNLOCK(ma); +} + +void erts_mseg_cache_check(void) +{ + do_cache_check(ERTS_MSEG_ALLCTR_SS()); } static void @@ -611,42 +635,44 @@ mseg_clear_cache(MemKind* mk) mk->segments.current.watermark = mk->segments.current.no; - INC_CC(clear_cache); + INC_CC(mk->ma, clear_cache); } -static ERTS_INLINE MemKind* memkind(const ErtsMsegOpt_t *opt) +static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma, + const ErtsMsegOpt_t *opt) { #if HALFWORD_HEAP - return opt->low_mem ? &low_mem : &hi_mem; + return opt->low_mem ? &ma->low_mem : &ma->hi_mem; #else - return &the_mem; + return &ma->the_mem; #endif } static void * -mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) +mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, Uint *size_p, + const ErtsMsegOpt_t *opt) { Uint max, min, diff_size, size; cache_desc_t *cd, *cand_cd; void *seg; - MemKind* mk = memkind(opt); + MemKind* mk = memkind(ma, opt); - INC_CC(alloc); + INC_CC(ma, alloc); size = PAGE_CEILING(*size_p); #if CAN_PARTLY_DESTROY - if (size < min_seg_size) - min_seg_size = size; + if (size < ma->min_seg_size) + ma->min_seg_size = size; #endif if (!opt->cache) { create_seg: adjust_cache_size(mk,0); - seg = mseg_create(mk, size); + seg = mseg_create(ma, mk, size); if (!seg) { mseg_clear_cache(mk); - seg = mseg_create(mk, size); + seg = mseg_create(ma, mk, size); if (!seg) size = 0; } @@ -667,10 +693,10 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) diff_size = mk->min_cached_seg_size - size; - if (diff_size > abs_max_cache_bad_fit) + if (diff_size > ma->abs_max_cache_bad_fit) goto create_seg; - if (100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size)) + if (100*PAGES(diff_size) > ma->rel_max_cache_bad_fit*PAGES(size)) goto create_seg; } @@ -708,8 +734,8 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) diff_size = cand_cd->size - size; - if (diff_size > abs_max_cache_bad_fit - || 100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size)) { + if (diff_size > ma->abs_max_cache_bad_fit + || 100*PAGES(diff_size) > ma->rel_max_cache_bad_fit*PAGES(size)) { if (mk->max_cached_seg_size < cand_cd->size) mk->max_cached_seg_size = cand_cd->size; if (mk->min_cached_seg_size > cand_cd->size) @@ -740,18 +766,18 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) static void -mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, +mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, Uint size, const ErtsMsegOpt_t *opt) { - MemKind* mk = memkind(opt); + MemKind* mk = memkind(ma, opt); cache_desc_t *cd; ERTS_MSEG_DEALLOC_STAT(mk,size); - if (!opt->cache || max_cache_size == 0) { + if (!opt->cache || ma->max_cache_size == 0) { if (erts_mtrace_enabled) erts_mtrace_crr_free(atype, SEGTYPE, seg); - mseg_destroy(mk, seg, size); + mseg_destroy(ma, mk, seg, size); } else { int check_limits = 0; @@ -769,7 +795,7 @@ mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, } if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); - mseg_destroy(mk, cd->seg, cd->size); + mseg_destroy(ma, mk, cd->seg, cd->size); unlink_cd(mk,cd); free_cd(mk,cd); } @@ -790,33 +816,34 @@ mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, if (check_limits) check_cache_limits(mk); - schedule_cache_check(); + schedule_cache_check(ma); } - INC_CC(dealloc); + INC_CC(ma, dealloc); } static void * -mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, - const ErtsMsegOpt_t *opt) +mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, + Uint old_size, Uint *new_size_p, const ErtsMsegOpt_t *opt) { - MemKind* mk = memkind(opt); + MemKind* mk; void *new_seg; Uint new_size; if (!seg || !old_size) { - new_seg = mseg_alloc(atype, new_size_p, opt); - DEC_CC(alloc); + new_seg = mseg_alloc(ma, atype, new_size_p, opt); + DEC_CC(ma, alloc); return new_seg; } if (!(*new_size_p)) { - mseg_dealloc(atype, seg, old_size, opt); - DEC_CC(dealloc); + mseg_dealloc(ma, atype, seg, old_size, opt); + DEC_CC(ma, dealloc); return NULL; } + mk = memkind(ma, opt); new_seg = seg; new_size = PAGE_CEILING(*new_size_p); @@ -826,8 +853,8 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, Uint shrink_sz = old_size - new_size; #if CAN_PARTLY_DESTROY - if (new_size < min_seg_size) - min_seg_size = new_size; + if (new_size < ma->min_seg_size) + ma->min_seg_size = new_size; #endif if (shrink_sz < opt->abs_shrink_th @@ -838,7 +865,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, #if CAN_PARTLY_DESTROY - if (shrink_sz > min_seg_size + if (shrink_sz > ma->min_seg_size && mk->free_cache_descs && opt->cache) { cache_desc_t *cd; @@ -857,7 +884,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, new_size); erts_mtrace_crr_alloc(cd->seg, SEGTYPE, SEGTYPE, cd->size); } - schedule_cache_check(); + schedule_cache_check(ma); } else { if (erts_mtrace_enabled) @@ -866,7 +893,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, SEGTYPE, seg, new_size); - mseg_destroy(mk, ((char *) seg) + new_size, shrink_sz); + mseg_destroy(ma, mk, ((char *) seg) + new_size, shrink_sz); } #elif HAVE_MSEG_RECREATE @@ -875,14 +902,14 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, #else - new_seg = mseg_alloc(atype, &new_size, opt); + new_seg = mseg_alloc(ma, atype, &new_size, opt); if (!new_seg) new_size = old_size; else { sys_memcpy(((char *) new_seg), ((char *) seg), MIN(new_size, old_size)); - mseg_dealloc(atype, seg, old_size, opt); + mseg_dealloc(ma, atype, seg, old_size, opt); } #endif @@ -892,34 +919,34 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, else { if (!opt->preserv) { - mseg_dealloc(atype, seg, old_size, opt); - new_seg = mseg_alloc(atype, &new_size, opt); + mseg_dealloc(ma, atype, seg, old_size, opt); + new_seg = mseg_alloc(ma, atype, &new_size, opt); } else { #if HAVE_MSEG_RECREATE #if !CAN_PARTLY_DESTROY do_recreate: #endif - new_seg = mseg_recreate(mk, (void *) seg, old_size, new_size); + new_seg = mseg_recreate(ma, mk, (void *) seg, old_size, new_size); if (erts_mtrace_enabled) erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); if (!new_seg) new_size = old_size; #else - new_seg = mseg_alloc(atype, &new_size, opt); + new_seg = mseg_alloc(ma, atype, &new_size, opt); if (!new_seg) new_size = old_size; else { sys_memcpy(((char *) new_seg), ((char *) seg), MIN(new_size, old_size)); - mseg_dealloc(atype, seg, old_size, opt); + mseg_dealloc(ma, atype, seg, old_size, opt); } #endif } } - INC_CC(realloc); + INC_CC(ma, realloc); *new_size_p = new_size; @@ -937,7 +964,6 @@ static struct { Eterm amcbf; Eterm rmcbf; Eterm mcs; - Eterm cci; Eterm memkind; Eterm name; @@ -973,13 +999,13 @@ static void ERTS_INLINE atom_init(Eterm *atom, char *name) #define AM_INIT(AM) atom_init(&am.AM, #AM) static void -init_atoms(void) +init_atoms(ErtsMsegAllctr_t *ma) { #ifdef DEBUG Eterm *atom; #endif - erts_mtx_unlock(&mseg_mutex); + ERTS_MSEG_UNLOCK(ma); erts_mtx_lock(&init_atoms_mutex); if (!atoms_initialized) { @@ -997,7 +1023,6 @@ init_atoms(void) AM_INIT(amcbf); AM_INIT(rmcbf); AM_INIT(mcs); - AM_INIT(cci); AM_INIT(status); AM_INIT(cached_segments); @@ -1025,7 +1050,7 @@ init_atoms(void) #endif } - erts_mtx_lock(&mseg_mutex); + ERTS_MSEG_LOCK(ma); atoms_initialized = 1; erts_mtx_unlock(&init_atoms_mutex); } @@ -1082,7 +1107,8 @@ add_4tup(Uint **hpp, Uint *szp, Eterm *lp, } static Eterm -info_options(char *prefix, +info_options(ErtsMsegAllctr_t *ma, + char *prefix, int *print_to_p, void *print_to_arg, Uint **hpp, @@ -1093,30 +1119,26 @@ info_options(char *prefix, if (print_to_p) { int to = *print_to_p; void *arg = print_to_arg; - erts_print(to, arg, "%samcbf: %beu\n", prefix, abs_max_cache_bad_fit); - erts_print(to, arg, "%srmcbf: %beu\n", prefix, rel_max_cache_bad_fit); - erts_print(to, arg, "%smcs: %beu\n", prefix, max_cache_size); - erts_print(to, arg, "%scci: %beu\n", prefix, cache_check_interval); + erts_print(to, arg, "%samcbf: %beu\n", prefix, ma->abs_max_cache_bad_fit); + erts_print(to, arg, "%srmcbf: %beu\n", prefix, ma->rel_max_cache_bad_fit); + erts_print(to, arg, "%smcs: %beu\n", prefix, ma->max_cache_size); } if (hpp || szp) { if (!atoms_initialized) - init_atoms(); + init_atoms(ma); res = NIL; add_2tup(hpp, szp, &res, - am.cci, - bld_uint(hpp, szp, cache_check_interval)); - add_2tup(hpp, szp, &res, am.mcs, - bld_uint(hpp, szp, max_cache_size)); + bld_uint(hpp, szp, ma->max_cache_size)); add_2tup(hpp, szp, &res, am.rmcbf, - bld_uint(hpp, szp, rel_max_cache_bad_fit)); + bld_uint(hpp, szp, ma->rel_max_cache_bad_fit)); add_2tup(hpp, szp, &res, am.amcbf, - bld_uint(hpp, szp, abs_max_cache_bad_fit)); + bld_uint(hpp, szp, ma->abs_max_cache_bad_fit)); } @@ -1124,18 +1146,18 @@ info_options(char *prefix, } static Eterm -info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) +info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; if (print_to_p) { -#define PRINT_CC(TO, TOA, CC) \ - if (calls.CC.giga_no == 0) \ - erts_print(TO, TOA, "mseg_%s calls: %b32u\n", #CC, calls.CC.no); \ - else \ +#define PRINT_CC(TO, TOA, CC) \ + if (ma->calls.CC.giga_no == 0) \ + erts_print(TO, TOA, "mseg_%s calls: %b32u\n", #CC, ma->calls.CC.no); \ + else \ erts_print(TO, TOA, "mseg_%s calls: %b32u%09b32u\n", #CC, \ - calls.CC.giga_no, calls.CC.no) + ma->calls.CC.giga_no, ma->calls.CC.no) int to = *print_to_p; void *arg = print_to_arg; @@ -1161,48 +1183,48 @@ info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) add_3tup(hpp, szp, &res, am.mseg_check_cache, - bld_unstable_uint(hpp, szp, calls.check_cache.giga_no), - bld_unstable_uint(hpp, szp, calls.check_cache.no)); + bld_unstable_uint(hpp, szp, ma->calls.check_cache.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.check_cache.no)); add_3tup(hpp, szp, &res, am.mseg_clear_cache, - bld_unstable_uint(hpp, szp, calls.clear_cache.giga_no), - bld_unstable_uint(hpp, szp, calls.clear_cache.no)); + bld_unstable_uint(hpp, szp, ma->calls.clear_cache.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.clear_cache.no)); #if HAVE_MSEG_RECREATE add_3tup(hpp, szp, &res, am.mseg_recreate, - bld_unstable_uint(hpp, szp, calls.recreate.giga_no), - bld_unstable_uint(hpp, szp, calls.recreate.no)); + bld_unstable_uint(hpp, szp, ma->calls.recreate.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.recreate.no)); #endif add_3tup(hpp, szp, &res, am.mseg_destroy, - bld_unstable_uint(hpp, szp, calls.destroy.giga_no), - bld_unstable_uint(hpp, szp, calls.destroy.no)); + bld_unstable_uint(hpp, szp, ma->calls.destroy.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.destroy.no)); add_3tup(hpp, szp, &res, am.mseg_create, - bld_unstable_uint(hpp, szp, calls.create.giga_no), - bld_unstable_uint(hpp, szp, calls.create.no)); + bld_unstable_uint(hpp, szp, ma->calls.create.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.create.no)); add_3tup(hpp, szp, &res, am.mseg_realloc, - bld_unstable_uint(hpp, szp, calls.realloc.giga_no), - bld_unstable_uint(hpp, szp, calls.realloc.no)); + bld_unstable_uint(hpp, szp, ma->calls.realloc.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.realloc.no)); add_3tup(hpp, szp, &res, am.mseg_dealloc, - bld_unstable_uint(hpp, szp, calls.dealloc.giga_no), - bld_unstable_uint(hpp, szp, calls.dealloc.no)); + bld_unstable_uint(hpp, szp, ma->calls.dealloc.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.dealloc.no)); add_3tup(hpp, szp, &res, am.mseg_alloc, - bld_unstable_uint(hpp, szp, calls.alloc.giga_no), - bld_unstable_uint(hpp, szp, calls.alloc.no)); + bld_unstable_uint(hpp, szp, ma->calls.alloc.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.alloc.no)); } return res; } static Eterm -info_status(MemKind* mk, int *print_to_p, void *print_to_arg, +info_status(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg, int begin_new_max_period, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; @@ -1258,7 +1280,7 @@ info_status(MemKind* mk, int *print_to_p, void *print_to_arg, return res; } -static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg, +static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg, int begin_max_per, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; @@ -1274,8 +1296,8 @@ static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg, atoms[2] = am.calls; values[0] = erts_bld_string(hpp, szp, mk->name); } - values[1] = info_status(mk, print_to_p, print_to_arg, begin_max_per, hpp, szp); - values[2] = info_calls(print_to_p, print_to_arg, hpp, szp); + values[1] = info_status(ma, mk, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[2] = info_calls(ma, print_to_p, print_to_arg, hpp, szp); if (hpp || szp) res = bld_2tup_list(hpp, szp, 3, atoms, values); @@ -1285,7 +1307,7 @@ static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg, static Eterm -info_version(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) +info_version(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; @@ -1306,56 +1328,64 @@ info_version(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) \* */ Eterm -erts_mseg_info_options(int *print_to_p, void *print_to_arg, +erts_mseg_info_options(int ix, + int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(ix); Eterm res; - erts_mtx_lock(&mseg_mutex); + ERTS_MSEG_LOCK(ma); - res = info_options("option ", print_to_p, print_to_arg, hpp, szp); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); - erts_mtx_unlock(&mseg_mutex); + res = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp); + + ERTS_MSEG_UNLOCK(ma); return res; } Eterm -erts_mseg_info(int *print_to_p, +erts_mseg_info(int ix, + int *print_to_p, void *print_to_arg, int begin_max_per, Uint **hpp, Uint *szp) { + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(ix); Eterm res = THE_NON_VALUE; Eterm atoms[4]; Eterm values[4]; Uint n = 0; - erts_mtx_lock(&mseg_mutex); + ERTS_MSEG_LOCK(ma); + + ERTS_DBG_MA_CHK_THR_ACCESS(ma); if (hpp || szp) { if (!atoms_initialized) - init_atoms(); + init_atoms(ma); atoms[0] = am.version; atoms[1] = am.options; atoms[2] = am.memkind; atoms[3] = am.memkind; } - values[n++] = info_version(print_to_p, print_to_arg, hpp, szp); - values[n++] = info_options("option ", print_to_p, print_to_arg, hpp, szp); + values[n++] = info_version(ma, print_to_p, print_to_arg, hpp, szp); + values[n++] = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp); #if HALFWORD_HEAP - values[n++] = info_memkind(&low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); - values[n++] = info_memkind(&hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[n++] = info_memkind(ma, &ma->low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[n++] = info_memkind(ma, &ma->hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); #else - values[n++] = info_memkind(&the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[n++] = info_memkind(ma, &ma->the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); #endif if (hpp || szp) res = bld_2tup_list(hpp, szp, n, atoms, values); - erts_mtx_unlock(&mseg_mutex); + ERTS_MSEG_UNLOCK(ma); return res; } @@ -1363,10 +1393,12 @@ erts_mseg_info(int *print_to_p, void * erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) { + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); void *seg; - erts_mtx_lock(&mseg_mutex); - seg = mseg_alloc(atype, size_p, opt); - erts_mtx_unlock(&mseg_mutex); + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + seg = mseg_alloc(ma, atype, size_p, opt); + ERTS_MSEG_UNLOCK(ma); return seg; } @@ -1377,12 +1409,14 @@ erts_mseg_alloc(ErtsAlcType_t atype, Uint *size_p) } void -erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg, Uint size, - const ErtsMsegOpt_t *opt) +erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg, + Uint size, const ErtsMsegOpt_t *opt) { - erts_mtx_lock(&mseg_mutex); - mseg_dealloc(atype, seg, size, opt); - erts_mtx_unlock(&mseg_mutex); + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + mseg_dealloc(ma, atype, seg, size, opt); + ERTS_MSEG_UNLOCK(ma); } void @@ -1392,44 +1426,60 @@ erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size) } void * -erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg, Uint old_size, - Uint *new_size_p, const ErtsMsegOpt_t *opt) +erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg, + Uint old_size, Uint *new_size_p, + const ErtsMsegOpt_t *opt) { + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); void *new_seg; - erts_mtx_lock(&mseg_mutex); - new_seg = mseg_realloc(atype, seg, old_size, new_size_p, opt); - erts_mtx_unlock(&mseg_mutex); + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + new_seg = mseg_realloc(ma, atype, seg, old_size, new_size_p, opt); + ERTS_MSEG_UNLOCK(ma); return new_seg; } void * -erts_mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, - Uint *new_size_p) +erts_mseg_realloc(ErtsAlcType_t atype, void *seg, + Uint old_size, Uint *new_size_p) { - return erts_mseg_realloc_opt(atype, seg, old_size, new_size_p, &erts_mseg_default_opt); + return erts_mseg_realloc_opt(atype, seg, old_size, new_size_p, + &erts_mseg_default_opt); } void erts_mseg_clear_cache(void) { + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_SS(); MemKind* mk; - erts_mtx_lock(&mseg_mutex); - for (mk=mk_list; mk; mk=mk->next) { + +start: + + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + for (mk=ma->mk_list; mk; mk=mk->next) { mseg_clear_cache(mk); } - erts_mtx_unlock(&mseg_mutex); + ERTS_MSEG_UNLOCK(ma); + + if (ma->ix != 0) { + ma = ERTS_MSEG_ALLCTR_IX(0); + goto start; + } } Uint -erts_mseg_no(void) +erts_mseg_no(const ErtsMsegOpt_t *opt) { + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); MemKind* mk; Uint n = 0; - erts_mtx_lock(&mseg_mutex); - for (mk=mk_list; mk; mk=mk->next) { + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + for (mk=ma->mk_list; mk; mk=mk->next) { n += mk->segments.current.no; } - erts_mtx_unlock(&mseg_mutex); + ERTS_MSEG_UNLOCK(ma); return n; } @@ -1439,7 +1489,7 @@ erts_mseg_unit_size(void) return page_size; } -static void mem_kind_init(MemKind* mk, const char* name) +static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name) { unsigned i; @@ -1450,10 +1500,10 @@ static void mem_kind_init(MemKind* mk, const char* name) mk->cache_size = 0; mk->cache_hits = 0; - if (max_cache_size > 0) { - for (i = 0; i < max_cache_size - 1; i++) + if (ma->max_cache_size > 0) { + for (i = 0; i < ma->max_cache_size - 1; i++) mk->cache_descs[i].next = &mk->cache_descs[i + 1]; - mk->cache_descs[max_cache_size - 1].next = NULL; + mk->cache_descs[ma->max_cache_size - 1].next = NULL; mk->free_cache_descs = &mk->cache_descs[0]; } else @@ -1467,30 +1517,38 @@ static void mem_kind_init(MemKind* mk, const char* name) mk->segments.max_ever.no = 0; mk->segments.max_ever.sz = 0; + mk->ma = ma; mk->name = name; - mk->next = mk_list; - mk_list = mk; + mk->next = ma->mk_list; + ma->mk_list = mk; } + + void erts_mseg_init(ErtsMsegInit_t *init) { - atoms_initialized = 0; - is_init_done = 0; + int i; + UWord x; - /* Options ... */ +#ifdef ERTS_SMP + no_mseg_allocators = init->nos + 1; +#else + no_mseg_allocators = 1; +#endif - abs_max_cache_bad_fit = init->amcbf; - rel_max_cache_bad_fit = init->rmcbf; - max_cache_size = init->mcs; - cache_check_interval = init->cci; + x = (UWord) malloc(sizeof(ErtsAlgndMsegAllctr_t) + *no_mseg_allocators + + (ERTS_CACHE_LINE_SIZE-1)); + if (x & ERTS_CACHE_LINE_MASK) + x = (x & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE; + ASSERT((x & ERTS_CACHE_LINE_MASK) == 0); + aligned_mseg_allctr = (ErtsAlgndMsegAllctr_t *) x; - /* */ + atoms_initialized = 0; -#ifdef USE_THREADS - thread_safe_init(); -#endif + erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms"); #if HAVE_MMAP && !defined(MAP_ANON) mmap_fd = open("/dev/zero", O_RDWR); @@ -1512,34 +1570,55 @@ erts_mseg_init(ErtsMsegInit_t *init) page_shift++; } - sys_memzero((void *) &calls, sizeof(calls)); + for (i = 0; i < no_mseg_allocators; i++) { + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(i); -#if CAN_PARTLY_DESTROY - min_seg_size = ~((Uint) 0); -#endif + ma->ix = i; + + ma->is_init_done = 0; + + if (i != 0) + ma->is_thread_safe = 0; + else { + ma->is_thread_safe = 1; + erts_mtx_init(&ma->mtx, "mseg"); + } + + ma->is_cache_check_scheduled = 0; + + /* Options ... */ + + ma->abs_max_cache_bad_fit = init->amcbf; + ma->rel_max_cache_bad_fit = init->rmcbf; + ma->max_cache_size = init->mcs; - if (max_cache_size > MAX_CACHE_SIZE) - max_cache_size = MAX_CACHE_SIZE; + if (ma->max_cache_size > MAX_CACHE_SIZE) + ma->max_cache_size = MAX_CACHE_SIZE; + + ma->mk_list = NULL; #if HALFWORD_HEAP - mem_kind_init(&low_mem, "low memory"); - mem_kind_init(&hi_mem, "high memory"); + mem_kind_init(ma, &ma->low_mem, "low memory"); + mem_kind_init(ma, &ma->hi_mem, "high memory"); #else - mem_kind_init(&the_mem, "all memory"); + mem_kind_init(ma, &ma->the_mem, "all memory"); #endif - is_cache_check_scheduled = 0; -#ifdef ERTS_THREADS_NO_SMP - is_cache_check_requested = 0; + sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls)); + +#if CAN_PARTLY_DESTROY + ma->min_seg_size = ~((Uint) 0); #endif + } } -static ERTS_INLINE Uint tot_cache_size(void) +static ERTS_INLINE Uint tot_cache_size(ErtsMsegAllctr_t *ma) { MemKind* mk; Uint sz = 0; - for (mk=mk_list; mk; mk=mk->next) { + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + for (mk=ma->mk_list; mk; mk=mk->next) { sz += mk->cache_size; } return sz; @@ -1552,25 +1631,13 @@ static ERTS_INLINE Uint tot_cache_size(void) void erts_mseg_late_init(void) { -#ifdef ERTS_THREADS_NO_SMP - int handle = - erts_register_async_ready_callback( - check_schedule_cache_check); -#endif - erts_mtx_lock(&mseg_mutex); - is_init_done = 1; -#ifdef ERTS_THREADS_NO_SMP - async_handle = handle; -#endif - if (tot_cache_size()) - schedule_cache_check(); - erts_mtx_unlock(&mseg_mutex); -} - -void -erts_mseg_exit(void) -{ - mseg_shutdown(); + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_SS(); + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + ma->is_init_done = 1; + if (tot_cache_size(ma)) + schedule_cache_check(ma); + ERTS_MSEG_UNLOCK(ma); } #endif /* #if HAVE_ERTS_MSEG */ @@ -1599,12 +1666,13 @@ erts_mseg_test(unsigned long op, erts_mseg_clear_cache(); return (unsigned long) 0; case 0x405: - return (unsigned long) erts_mseg_no(); + return (unsigned long) erts_mseg_no(&erts_mseg_default_opt); case 0x406: { + ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(0); unsigned long res; - erts_mtx_lock(&mseg_mutex); - res = (unsigned long) tot_cache_size(); - erts_mtx_unlock(&mseg_mutex); + ERTS_MSEG_LOCK(ma); + res = (unsigned long) tot_cache_size(ma); + ERTS_MSEG_UNLOCK(ma); return res; } #else /* #if HAVE_ERTS_MSEG */ diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index 8f116030a8..741080fb78 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -44,7 +44,7 @@ typedef struct { Uint amcbf; Uint rmcbf; Uint mcs; - Uint cci; + Uint nos; } ErtsMsegInit_t; #define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \ @@ -60,6 +60,7 @@ typedef struct { int preserv; UWord abs_shrink_th; UWord rel_shrink_th; + int sched_spec; #if HALFWORD_HEAP int low_mem; #endif @@ -75,14 +76,14 @@ void *erts_mseg_realloc(ErtsAlcType_t, void *, Uint, Uint *); void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, Uint, Uint *, const ErtsMsegOpt_t *); void erts_mseg_clear_cache(void); -Uint erts_mseg_no(void); +void erts_mseg_cache_check(void); +Uint erts_mseg_no( const ErtsMsegOpt_t *); Uint erts_mseg_unit_size(void); void erts_mseg_init(ErtsMsegInit_t *init); void erts_mseg_late_init(void); /* Have to be called after all allocators, threads and timers have been initialized. */ -void erts_mseg_exit(void); -Eterm erts_mseg_info_options(int *, void*, Uint **, Uint *); -Eterm erts_mseg_info(int *, void*, int, Uint **, Uint *); +Eterm erts_mseg_info_options(int, int *, void*, Uint **, Uint *); +Eterm erts_mseg_info(int, int *, void*, int, Uint **, Uint *); #endif /* #if HAVE_ERTS_MSEG */ diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 9bd64f5908..80db2055a2 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -68,6 +68,7 @@ # endif # endif #endif +#include "erl_thr_progress.h" #include "erl_driver.h" #include "erl_alloc.h" @@ -114,7 +115,7 @@ #endif #define ERTS_POLL_USE_WAKEUP_PIPE \ - (ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP)) + (ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(USE_THREADS)) #ifdef ERTS_SMP @@ -261,7 +262,6 @@ struct ErtsPollSet_ { #ifdef ERTS_SMP erts_atomic32_t polled; erts_smp_mtx_t mtx; -#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT #endif #if ERTS_POLL_USE_WAKEUP_PIPE int wake_fds[2]; @@ -269,10 +269,8 @@ struct ErtsPollSet_ { #if ERTS_POLL_USE_FALLBACK int fallback_used; #endif -#ifdef ERTS_SMP +#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT erts_atomic32_t wakeup_state; -#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - volatile int wakeup_state; #endif erts_smp_atomic32_t timeout; #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS @@ -345,21 +343,16 @@ static void print_misc_debug_info(void); static ERTS_INLINE void reset_wakeup_state(ErtsPollSet ps) { -#ifdef ERTS_SMP - erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); - ERTS_THR_MEMORY_BARRIER; -#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - ps->wakeup_state = 0; +#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + erts_atomic32_set_mb(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); #endif } static ERTS_INLINE int is_woken(ErtsPollSet ps) { -#ifdef ERTS_SMP +#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT return erts_atomic32_read_acqb(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN; -#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - return ps->wakeup_state != ERTS_POLL_NOT_WOKEN; #else return 0; #endif @@ -368,13 +361,9 @@ is_woken(ErtsPollSet ps) static ERTS_INLINE int is_interrupted_reset(ErtsPollSet ps) { -#ifdef ERTS_SMP +#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT return (erts_atomic32_xchg_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN) == ERTS_POLL_WOKEN_INTR); -#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - int res = ps->wakeup_state == ERTS_POLL_WOKEN_INTR; - ps->wakeup_state = ERTS_POLL_NOT_WOKEN; - return res; #else return 0; #endif @@ -383,16 +372,13 @@ is_interrupted_reset(ErtsPollSet ps) static ERTS_INLINE void woke_up(ErtsPollSet ps) { -#ifdef ERTS_SMP +#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); if (wakeup_state == ERTS_POLL_NOT_WOKEN) (void) erts_atomic32_cmpxchg_nob(&ps->wakeup_state, ERTS_POLL_WOKEN, ERTS_POLL_NOT_WOKEN); ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN); -#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - if (ps->wakeup_state == ERTS_POLL_NOT_WOKEN) - ps->wakeup_state = ERTS_POLL_WOKEN; #endif } @@ -403,28 +389,27 @@ woke_up(ErtsPollSet ps) #if ERTS_POLL_USE_WAKEUP_PIPE static ERTS_INLINE void -wake_poller(ErtsPollSet ps, int interrupted) +wake_poller(ErtsPollSet ps, int interrupted, int async_signal_safe) { - int wake = 0; -#ifdef ERTS_SMP - erts_aint32_t wakeup_state; - if (!interrupted) - wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state, - ERTS_POLL_WOKEN, - ERTS_POLL_NOT_WOKEN); + int wake; + if (async_signal_safe) + wake = 1; else { - /* - * We might unnecessarily write to the pipe, however, - * that isn't problematic. - */ - wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); - erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR); + erts_aint32_t wakeup_state; + if (!interrupted) + wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state, + ERTS_POLL_WOKEN, + ERTS_POLL_NOT_WOKEN); + else { + /* + * We might unnecessarily write to the pipe, however, + * that isn't problematic. + */ + wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); + erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR); + } + wake = wakeup_state == ERTS_POLL_NOT_WOKEN; } - wake = wakeup_state == ERTS_POLL_NOT_WOKEN; -#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - wake = ps->wakeup_state == ERTS_POLL_NOT_WOKEN; - ps->wakeup_state = interrupted ? ERTS_POLL_WOKEN_INTR : ERTS_POLL_NOT_WOKEN; -#endif /* * NOTE: This function might be called from signal handlers in the * non-smp case; therefore, it has to be async-signal safe in @@ -439,9 +424,17 @@ wake_poller(ErtsPollSet ps, int interrupted) res = write(ps->wake_fds[1], "!", 1); } while (res < 0 && errno == EINTR); if (res <= 0 && errno != ERRNO_BLOCK) { - fatal_error_async_signal_safe(__FILE__ - ":XXX:wake_poller(): " - "Failed to write on wakeup pipe\n"); + if (async_signal_safe) + fatal_error_async_signal_safe(__FILE__ + ":XXX:wake_poller(): " + "Failed to write on wakeup pipe\n"); + else + fatal_error("%s:%d:wake_poller(): " + "Failed to write to wakeup pipe fd=%d: " + "%s (%d)\n", + __FILE__, __LINE__, + ps->wake_fds[1], + erl_errno_id(errno), errno); } } } @@ -449,11 +442,18 @@ wake_poller(ErtsPollSet ps, int interrupted) static ERTS_INLINE void cleanup_wakeup_pipe(ErtsPollSet ps) { +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + int intr = 0; +#endif int fd = ps->wake_fds[0]; int res; do { char buf[32]; res = read(fd, buf, sizeof(buf)); +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + if (res > 0) + intr = 1; +#endif } while (res > 0 || (res < 0 && errno == EINTR)); if (res < 0 && errno != ERRNO_BLOCK) { fatal_error("%s:%d:cleanup_wakeup_pipe(): " @@ -463,6 +463,10 @@ cleanup_wakeup_pipe(ErtsPollSet ps) fd, erl_errno_id(errno), errno); } +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + if (intr) + erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR); +#endif } static void @@ -1497,7 +1501,7 @@ ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet ps, #ifdef ERTS_SMP if (final_do_wake) - wake_poller(ps, 0); + wake_poller(ps, 0, 0); #endif /* ERTS_SMP */ } @@ -1520,7 +1524,7 @@ ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet ps, #ifdef ERTS_SMP if (*do_wake) { - wake_poller(ps, 0); + wake_poller(ps, 0, 0); } #endif /* ERTS_SMP */ @@ -1893,9 +1897,9 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, } static ERTS_INLINE int -check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked) +check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res) { - ASSERT(!*ps_locked); + int res; if (erts_smp_atomic_read_nob(&ps->no_of_user_fds) == 0 && tv->tv_usec == 0 && tv->tv_sec == 0) { /* Nothing to poll and zero timeout; done... */ @@ -1915,16 +1919,23 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked) timeout = INT_MAX; if (max_res > ps->res_events_len) grow_res_events(ps, max_res); - return epoll_wait(ps->kp_fd, ps->res_events, max_res, (int)timeout); +#ifdef ERTS_SMP + if (timeout) + erts_thr_progress_prepare_wait(NULL); +#endif + res = epoll_wait(ps->kp_fd, ps->res_events, max_res, (int)timeout); #elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ struct timespec ts; - ts.tv_sec = tv->tv_sec; - ts.tv_nsec = tv->tv_usec*1000; if (max_res > ps->res_events_len) grow_res_events(ps, max_res); - return kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts); +#ifdef ERTS_SMP + if (timeout) + erts_thr_progress_prepare_wait(NULL); +#endif + ts.tv_sec = tv->tv_sec; + ts.tv_nsec = tv->tv_usec*1000; + res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts); #endif /* ----------------------------------------- */ - } else /* use fallback (i.e. poll() or select()) */ #endif /* ERTS_POLL_USE_FALLBACK */ @@ -1947,22 +1958,38 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked) if (poll_res.dp_nfds > ps->res_events_len) grow_res_events(ps, poll_res.dp_nfds); poll_res.dp_fds = ps->res_events; +#ifdef ERTS_SMP + if (timeout) + erts_thr_progress_prepare_wait(NULL); +#endif poll_res.dp_timeout = (int) timeout; - return ioctl(ps->kp_fd, DP_POLL, &poll_res); + res = ioctl(ps->kp_fd, DP_POLL, &poll_res); #elif ERTS_POLL_USE_POLL /* --- poll -------------------------------- */ if (timeout > INT_MAX) timeout = INT_MAX; - return poll(ps->poll_fds, ps->no_poll_fds, (int) timeout); +#ifdef ERTS_SMP + if (timeout) + erts_thr_progress_prepare_wait(NULL); +#endif + res = poll(ps->poll_fds, ps->no_poll_fds, (int) timeout); #elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ - int res; + SysTimeval to = *tv; + ps->res_input_fds = ps->input_fds; ps->res_output_fds = ps->output_fds; + +#ifdef ERTS_SMP + if (to.tv_sec || to.tv_usec) + erts_thr_progress_prepare_wait(NULL); +#endif res = select(ps->max_fd + 1, &ps->res_input_fds, &ps->res_output_fds, NULL, - tv); + &to); #ifdef ERTS_SMP + if (to.tv_sec || to.tv_usec) + erts_thr_progress_finalize_wait(NULL); if (res < 0 && errno == EBADF && ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) { @@ -1978,15 +2005,16 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked) * have triggered, we fake an EAGAIN error and let the caller * restart us. */ - SysTimeval zero_tv = {0, 0}; - *ps_locked = 1; + to.tv_sec = 0; + to.tv_usec = 0; ERTS_POLLSET_LOCK(ps); handle_update_requests(ps); + ERTS_POLLSET_UNLOCK(ps); res = select(ps->max_fd + 1, &ps->res_input_fds, &ps->res_output_fds, NULL, - &zero_tv); + &to); if (res == 0) { errno = EAGAIN; res = -1; @@ -1996,6 +2024,11 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked) return res; #endif /* ----------------------------------------- */ } +#ifdef ERTS_SMP + if (timeout) + erts_thr_progress_finalize_wait(NULL); +#endif + return res; } } @@ -2007,7 +2040,9 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, { int res, no_fds; int ebadf = 0; - int ps_locked; +#ifdef ERTS_SMP + int ps_locked = 0; +#endif SysTimeval *tvp; SysTimeval itv; @@ -2049,8 +2084,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, } #endif - ps_locked = 0; - res = check_fd_events(ps, tvp, no_fds, &ps_locked); + res = check_fd_events(ps, tvp, no_fds); woke_up(ps); @@ -2072,10 +2106,8 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, #endif #ifdef ERTS_SMP - if (!ps_locked) { - ps_locked = 1; - ERTS_POLLSET_LOCK(ps); - } + ps_locked = 1; + ERTS_POLLSET_LOCK(ps); #endif no_fds = save_poll_result(ps, pr, no_fds, res, ebadf); @@ -2111,19 +2143,26 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet ps, int set) { -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) - /* - * NOTE: This function might be called from signal handlers in the - * non-smp case; therefore, it has to be async-signal safe in - * the non-smp case. - */ +#if defined(USE_THREADS) if (!set) reset_wakeup_state(ps); else - wake_poller(ps, 1); + wake_poller(ps, 1, 0); #endif } +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT +void +ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet ps) +{ + /* + * NOTE: This function is called from signal handlers, it, + * therefore, it has to be async-signal safe. + */ + wake_poller(ps, 1, 1); +} +#endif + /* * erts_poll_interrupt_timed(): * If 'set' != 0, interrupt thread blocked in erts_poll_wait() if it @@ -2139,7 +2178,7 @@ ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps, reset_wakeup_state(ps); else { if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) - wake_poller(ps, 1); + wake_poller(ps, 1, 0); #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS else { if (ERTS_POLLSET_IS_POLLED(ps)) @@ -2266,10 +2305,8 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) erts_atomic32_init_nob(&ps->polled, 0); erts_smp_mtx_init(&ps->mtx, "pollset"); #endif -#ifdef ERTS_SMP +#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT erts_atomic32_init_nob(&ps->wakeup_state, (erts_aint32_t) 0); -#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - ps->wakeup_state = 0; #endif #if ERTS_POLL_USE_WAKEUP_PIPE create_wakeup_pipe(ps); diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index 725a77a152..e0296c6a33 100644 --- a/erts/emulator/sys/common/erl_poll.h +++ b/erts/emulator/sys/common/erl_poll.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2011. 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 @@ -216,6 +216,9 @@ typedef struct { #endif } ErtsPollInfo; +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +void ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet); +#endif void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet, int); void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet, diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index d8d51b192c..9a5ed9f5bc 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -129,10 +129,12 @@ #define HAVE_ERTS_CHECK_IO_DEBUG int erts_check_io_debug(void); - -#ifndef ENABLE_CHILD_WAITER_THREAD +#ifndef ERTS_SMP # undef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT # define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +#endif + +#ifndef ENABLE_CHILD_WAITER_THREAD # ifdef ERTS_SMP # define ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN void erts_check_children(void); diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 82d2c64d81..c6b63350e5 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -52,6 +52,7 @@ #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" #if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) #define __DARWIN__ 1 @@ -127,7 +128,6 @@ static ErtsSysReportExit *report_exit_list; static ErtsSysReportExit *report_exit_transit_list; #endif -extern int check_async_ready(void); extern int driver_interrupt(int, int); extern void do_break(void); @@ -263,6 +263,7 @@ int erts_use_kernel_poll = 0; struct { int (*select)(ErlDrvPort, ErlDrvEvent, int, int); int (*event)(ErlDrvPort, ErlDrvEvent, ErlDrvEventData); + void (*check_io_as_interrupt)(void); void (*check_io_interrupt)(int); void (*check_io_interrupt_tmd)(int, long); void (*check_io)(int); @@ -302,6 +303,9 @@ init_check_io(void) if (erts_use_kernel_poll) { io_func.select = driver_select_kp; io_func.event = driver_event_kp; +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT + io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_kp; +#endif io_func.check_io_interrupt = erts_check_io_interrupt_kp; io_func.check_io_interrupt_tmd = erts_check_io_interrupt_timed_kp; io_func.check_io = erts_check_io_kp; @@ -314,6 +318,9 @@ init_check_io(void) else { io_func.select = driver_select_nkp; io_func.event = driver_event_nkp; +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT + io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_nkp; +#endif io_func.check_io_interrupt = erts_check_io_interrupt_nkp; io_func.check_io_interrupt_tmd = erts_check_io_interrupt_timed_nkp; io_func.check_io = erts_check_io_nkp; @@ -325,6 +332,11 @@ init_check_io(void) } } +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +#define ERTS_CHK_IO_AS_INTR() (*io_func.check_io_as_interrupt)() +#else +#define ERTS_CHK_IO_AS_INTR() (*io_func.check_io_interrupt)(1) +#endif #define ERTS_CHK_IO_INTR (*io_func.check_io_interrupt) #define ERTS_CHK_IO_INTR_TMD (*io_func.check_io_interrupt_tmd) #define ERTS_CHK_IO (*io_func.check_io) @@ -339,6 +351,11 @@ init_check_io(void) max_files = erts_check_io_max_files(); } +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +#define ERTS_CHK_IO_AS_INTR() erts_check_io_async_sig_interrupt() +#else +#define ERTS_CHK_IO_AS_INTR() erts_check_io_interrupt(1) +#endif #define ERTS_CHK_IO_INTR erts_check_io_interrupt #define ERTS_CHK_IO_INTR_TMD erts_check_io_interrupt_timed #define ERTS_CHK_IO erts_check_io @@ -346,13 +363,13 @@ init_check_io(void) #endif -#ifdef ERTS_SMP void erts_sys_schedule_interrupt(int set) { ERTS_CHK_IO_INTR(set); } +#ifdef ERTS_SMP void erts_sys_schedule_interrupt_timed(int set, long msec) { @@ -731,7 +748,7 @@ break_requested(void) erl_exit(ERTS_INTR_EXIT, ""); ERTS_SET_BREAK_REQUESTED; - ERTS_CHK_IO_INTR(1); /* Make sure we don't sleep in poll */ + ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ } /* set up signal handlers for break and quit */ @@ -931,18 +948,13 @@ void os_flavor(char* namebuf, /* Where to return the name. */ unsigned size) /* Size of name buffer. */ { - static int called = 0; - static struct utsname uts; /* Information about the system. */ - - if (!called) { - char* s; + struct utsname uts; /* Information about the system. */ + char* s; - (void) uname(&uts); - called = 1; - for (s = uts.sysname; *s; s++) { - if (isupper((int) *s)) { - *s = tolower((int) *s); - } + (void) uname(&uts); + for (s = uts.sysname; *s; s++) { + if (isupper((int) *s)) { + *s = tolower((int) *s); } } strcpy(namebuf, uts.sysname); @@ -1107,31 +1119,6 @@ struct erl_drv_entry vanilla_driver_entry = { stop_select }; -#if defined(USE_THREADS) && !defined(ERTS_SMP) -static int async_drv_init(void); -static ErlDrvData async_drv_start(ErlDrvPort, char*, SysDriverOpts*); -static void async_drv_stop(ErlDrvData); -static void async_drv_input(ErlDrvData, ErlDrvEvent); - -/* INTERNAL use only */ - -struct erl_drv_entry async_driver_entry = { - async_drv_init, - async_drv_start, - async_drv_stop, - NULL, - async_drv_input, - NULL, - "async", - NULL, - NULL, - NULL, - NULL, - NULL, - NULL -}; -#endif - /* Handle SIGCHLD signals. */ #if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) static RETSIGTYPE onchld(void) @@ -1145,7 +1132,7 @@ static RETSIGTYPE onchld(int signum) smp_sig_notify('C'); #else children_died = 1; - ERTS_CHK_IO_INTR(1); /* Make sure we don't sleep in poll */ + ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ #endif } @@ -2316,87 +2303,6 @@ static void stop_select(ErlDrvEvent fd, void* _) close((int)fd); } -/* -** Async opertation support -*/ -#if defined(USE_THREADS) && !defined(ERTS_SMP) -static void -sys_async_ready_failed(int fd, int r, int err) -{ - char buf[120]; - sprintf(buf, "sys_async_ready(): Fatal error: fd=%d, r=%d, errno=%d\n", - fd, r, err); - erts_silence_warn_unused_result(write(2, buf, strlen(buf))); - abort(); -} - -/* called from threads !! */ -void sys_async_ready(int fd) -{ - int r; - while (1) { - r = write(fd, "0", 1); /* signal main thread fd MUST be async_fd[1] */ - if (r == 1) { - DEBUGF(("sys_async_ready(): r = 1\r\n")); - break; - } - if (r < 0 && errno == EINTR) { - DEBUGF(("sys_async_ready(): r = %d\r\n", r)); - continue; - } - sys_async_ready_failed(fd, r, errno); - } -} - -static int async_drv_init(void) -{ - async_fd[0] = -1; - async_fd[1] = -1; - return 0; -} - -static ErlDrvData async_drv_start(ErlDrvPort port_num, - char* name, SysDriverOpts* opts) -{ - if (async_fd[0] != -1) - return ERL_DRV_ERROR_GENERAL; - if (pipe(async_fd) < 0) - return ERL_DRV_ERROR_GENERAL; - - DEBUGF(("async_drv_start: %d\r\n", port_num)); - - SET_NONBLOCKING(async_fd[0]); - driver_select(port_num, async_fd[0], ERL_DRV_READ, 1); - - if (init_async(async_fd[1]) < 0) - return ERL_DRV_ERROR_GENERAL; - return (ErlDrvData)port_num; -} - -static void async_drv_stop(ErlDrvData e) -{ - int port_num = (int)(long)e; - - DEBUGF(("async_drv_stop: %d\r\n", port_num)); - - exit_async(); - - driver_select(port_num, async_fd[0], ERL_DRV_READ, 0); - - close(async_fd[0]); - close(async_fd[1]); - async_fd[0] = async_fd[1] = -1; -} - - -static void async_drv_input(ErlDrvData e, ErlDrvEvent fd) -{ - char *buf[32]; - DEBUGF(("async_drv_input\r\n")); - while (read((int) fd, (void *) buf, 32) > 0); /* fd MUST be async_fd[0] */ - check_async_ready(); /* invoke all async_ready */ -} -#endif void erts_do_break_handling(void) { @@ -2408,11 +2314,7 @@ void erts_do_break_handling(void) * therefore, make sure that all threads but this one are blocked before * proceeding! */ - erts_smp_block_system(0); - /* - * NOTE: since we allow gc we are not allowed to lock - * (any) process main locks while blocking system... - */ + erts_smp_thr_progress_block(); /* during break we revert to initial settings */ /* this is done differently for oldshell */ @@ -2440,7 +2342,7 @@ void erts_do_break_handling(void) tcsetattr(0,TCSANOW,&temp_mode); } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); } /* Fills in the systems representation of the jam/beam process identifier. @@ -2474,12 +2376,10 @@ erts_sys_putenv(char *buffer, int sep_ix) } int -erts_sys_getenv(char *key, char *value, size_t *size) +erts_sys_getenv__(char *key, char *value, size_t *size) { - char *orig_value; int res; - erts_smp_rwmtx_rlock(&environ_rwmtx); - orig_value = getenv(key); + char *orig_value = getenv(key); if (!orig_value) res = -1; else { @@ -2494,6 +2394,15 @@ erts_sys_getenv(char *key, char *value, size_t *size) res = 0; } } + return res; +} + +int +erts_sys_getenv(char *key, char *value, size_t *size) +{ + int res; + erts_smp_rwmtx_rlock(&environ_rwmtx); + res = erts_sys_getenv__(key, value, size); erts_smp_rwmtx_runlock(&environ_rwmtx); return res; } @@ -2505,31 +2414,6 @@ sys_init_io(void) erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data)); erts_smp_atomic_add_nob(&sys_misc_mem_sz, max_files * sizeof(struct fd_data)); - -#ifdef USE_THREADS -#ifdef ERTS_SMP - if (init_async(-1) < 0) - erl_exit(1, "Failed to initialize async-threads\n"); -#else - { - /* This is speical stuff, starting a driver from the - * system routines, but is a nice way of handling stuff - * the erlang way - */ - SysDriverOpts dopts; - int ret; - - sys_memset((void*)&dopts, 0, sizeof(SysDriverOpts)); - add_driver_entry(&async_driver_entry); - ret = erts_open_driver(NULL, NIL, "async", &dopts, NULL); - DEBUGF(("open_driver = %d\n", ret)); - if (ret < 0) - erl_exit(1, "Failed to open async driver\n"); - erts_port[ret].status |= ERTS_PORT_SFLG_IMMORTAL; - } -#endif -#endif - } #if (0) /* unused? */ @@ -2756,15 +2640,7 @@ initiate_report_exit_status(ErtsSysReportExit *rep, int status) rep->next = report_exit_transit_list; rep->status = status; report_exit_transit_list = rep; - /* - * We need the scheduler thread to call check_children(). - * If the scheduler thread is sleeping in a poll with a - * timeout, we need to wake the scheduler thread. We use the - * functionality of the async driver to do this, instead of - * implementing yet another driver doing the same thing. A - * little bit ugly, but it works... - */ - sys_async_ready(async_fd[1]); + erts_sys_schedule_interrupt(1); } static int check_children(void) @@ -2851,20 +2727,11 @@ erl_sys_schedule(int runnable) { #ifdef ERTS_SMP ERTS_CHK_IO(!runnable); - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); #else - ERTS_CHK_IO_INTR(0); - if (runnable) { - ERTS_CHK_IO(0); /* Poll for I/O */ - check_async_ready(); /* Check async completions */ - } else { - int wait_for_io = !check_async_ready(); - if (wait_for_io) - wait_for_io = !check_children(); - ERTS_CHK_IO(wait_for_io); - } - (void) check_children(); + ERTS_CHK_IO(runnable ? 0 : !check_children()); #endif + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); + (void) check_children(); } @@ -2892,8 +2759,8 @@ smp_sig_notify(char c) static void * signal_dispatcher_thread_func(void *unused) { - int initialized = 0; #if !CHLDWTHR + int initialized = 0; int notify_check_children = 0; #endif #ifdef ERTS_ENABLE_LOCK_CHECK @@ -2921,20 +2788,20 @@ signal_dispatcher_thread_func(void *unused) * to other threads. * * NOTE 2: The signal dispatcher thread is not a blockable - * thread (i.e., it hasn't called - * erts_register_blockable_thread()). 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). + * 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 */ - initialized = 1; #if !CHLDWTHR + initialized = 1; if (!notify_check_children) #endif break; @@ -2969,7 +2836,7 @@ signal_dispatcher_thread_func(void *unused) buf[i]); } } - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); } return NULL; } diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c index a59e4ec26a..d6d1fe64e0 100644 --- a/erts/emulator/sys/vxworks/sys.c +++ b/erts/emulator/sys/vxworks/sys.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2010. All Rights Reserved. + * Copyright Ericsson AB 1997-2011. 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 @@ -238,6 +238,12 @@ erl_sys_args(int* argc, char** argv) ASSERT(max_files <= erts_vxworks_max_files); } +void +erts_sys_schedule_interrupt(int set) +{ + erts_check_io_interrupt(set); +} + /* * Called from schedule() when it runs out of runnable processes, * or when Erlang code has performed INPUT_REDUCTIONS reduction @@ -246,7 +252,6 @@ erl_sys_args(int* argc, char** argv) void erl_sys_schedule(int runnable) { - erts_check_io_interrupt(0); erts_check_io(!runnable); } @@ -309,7 +314,7 @@ static void request_break(void) fprintf(stderr,"break!\n"); #endif erts_break_requested = 1; - erts_check_io_interrupt(1); /* Make sure we don't sleep in erts_poll_wait */ + erts_check_io_async_sig_interrupt(1); /* Make sure we don't sleep in erts_poll_wait */ } static void do_quit(void) @@ -1515,6 +1520,12 @@ erts_sys_getenv(char *key, char *value, size_t *size) return res; } +int +erts_sys_getenv__(char *key, char *value, size_t *size) +{ + return erts_sys_getenv(key, value, size); +} + void sys_init_io(void) { diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index 735c420d8e..ab4ef05118 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -1159,7 +1159,13 @@ int erts_poll_wait(ErtsPollSet ps, HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout)); ERTS_POLLSET_UNLOCK(ps); +#ifdef ERTS_SMP + erts_thr_progress_prepare_wait(NULL); +#endif WaitForMultipleObjects(num_h, harr, FALSE, timeout); +#ifdef ERTS_SMP + erts_thr_progress_finalize_wait(NULL); +#endif ERTS_POLLSET_LOCK(ps); HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout)); woke_up(ps); diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 3e151c26d5..6f33ef7ad6 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -216,6 +216,9 @@ void sys_tty_reset(int exit_code) void erl_sys_args(int* argc, char** argv) { char *event_name; + + erts_sys_env_init(); + nohup = get_and_remove_option(argc, argv, "-nohup"); #ifdef DEBUG @@ -566,51 +569,6 @@ struct erl_drv_entry vanilla_driver_entry = { stop_select }; -#if defined(USE_THREADS) && !defined(ERTS_SMP) - -static int async_drv_init(void); -static ErlDrvData async_drv_start(ErlDrvPort, char*, SysDriverOpts*); -static void async_drv_stop(ErlDrvData); -static void async_drv_input(ErlDrvData, ErlDrvEvent); - -/* INTERNAL use only */ - -void null_output(ErlDrvData drv_data, char* buf, int len) -{ -} - -void null_ready_output(ErlDrvData drv_data, ErlDrvEvent event) -{ -} - -struct erl_drv_entry async_driver_entry = { - async_drv_init, - async_drv_start, - async_drv_stop, - null_output, - async_drv_input, - null_ready_output, - "async", - NULL, /* finish */ - NULL, /* handle */ - NULL, /* control */ - NULL, /* timeout */ - NULL, /* outputv */ - NULL, /* ready_async */ - NULL, /* flush */ - NULL, /* call */ - NULL, /* event */ - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - 0, /* ERL_DRV_FLAGs */ - NULL, - NULL, /* process_exit */ - stop_select -}; - -#endif - /* * Initialises a DriverData structure. * @@ -2825,30 +2783,6 @@ sys_init_io(void) We estimate the number to twice the amount of ports. We really dont know on windows, do we? */ max_files = 2*erts_max_ports; - -#ifdef USE_THREADS -#ifdef ERTS_SMP - if (init_async(-1) < 0) - erl_exit(1, "Failed to initialize async-threads\n"); -#else - { - /* This is special stuff, starting a driver from the - * system routines, but is a nice way of handling stuff - * the erlang way - */ - SysDriverOpts dopts; - int ret; - - sys_memset((void*)&dopts, 0, sizeof(SysDriverOpts)); - add_driver_entry(&async_driver_entry); - ret = erts_open_driver(NULL, NIL, "async", &dopts, NULL); - DEBUGF(("open_driver = %d\n", ret)); - if (ret < 0) - erl_exit(1, "Failed to open async driver\n"); - erts_port[ret].status |= ERTS_PORT_SFLG_IMMORTAL; - } -#endif -#endif } #ifdef ERTS_SMP @@ -3283,7 +3217,6 @@ erts_sys_pre_init(void) } #endif erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0); - erts_sys_env_init(); } void noinherit_std_handle(DWORD type) @@ -3360,13 +3293,13 @@ void erl_sys_init(void) SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX); } -#ifdef ERTS_SMP void erts_sys_schedule_interrupt(int set) { erts_check_io_interrupt(set); } +#ifdef ERTS_SMP void erts_sys_schedule_interrupt_timed(int set, long msec) { @@ -3382,76 +3315,7 @@ erts_sys_schedule_interrupt_timed(int set, long msec) void erl_sys_schedule(int runnable) { -#ifdef ERTS_SMP erts_check_io(!runnable); - ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); -#else - erts_check_io_interrupt(0); - if (runnable) { - erts_check_io(0); /* Poll for I/O */ - check_async_ready(); /* Check async completions */ - } else { - erts_check_io(check_async_ready() ? 0 : 1); - } -#endif -} - -#if defined(USE_THREADS) && !defined(ERTS_SMP) -/* - * Async operation support. - */ - -static ErlDrvEvent async_drv_event; - -void -sys_async_ready(int fd) -{ - SetEvent((HANDLE)async_drv_event); -} - -static int -async_drv_init(void) -{ - async_drv_event = (ErlDrvEvent) NULL; - return 0; -} - -static ErlDrvData -async_drv_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) -{ - if (async_drv_event != (ErlDrvEvent) NULL) { - return ERL_DRV_ERROR_GENERAL; - } - if ((async_drv_event = (ErlDrvEvent)CreateAutoEvent(FALSE)) == (ErlDrvEvent) NULL) { - return ERL_DRV_ERROR_GENERAL; - } - - driver_select(port_num, async_drv_event, ERL_DRV_READ|ERL_DRV_USE, 1); - if (init_async(async_drv_event) < 0) { - return ERL_DRV_ERROR_GENERAL; - } - return (ErlDrvData)port_num; -} - -static void -async_drv_stop(ErlDrvData port_num) -{ - exit_async(); - driver_select((ErlDrvPort)port_num, async_drv_event, ERL_DRV_READ|ERL_DRV_USE, 0); - /*CloseHandle((HANDLE)async_drv_event);*/ - async_drv_event = (ErlDrvEvent) NULL; + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); } - -static void -async_drv_input(ErlDrvData port_num, ErlDrvEvent e) -{ - check_async_ready(); - - /* - * Our event is auto-resetting. - */ -} - -#endif - diff --git a/erts/emulator/sys/win32/sys_env.c b/erts/emulator/sys/win32/sys_env.c index 02c8433a10..7acc7f07ee 100644 --- a/erts/emulator/sys/win32/sys_env.c +++ b/erts/emulator/sys/win32/sys_env.c @@ -55,19 +55,17 @@ erts_sys_putenv(char *key_value, int sep_ix) } int -erts_sys_getenv(char *key, char *value, size_t *size) +erts_sys_getenv__(char *key, char *value, size_t *size) { size_t req_size = 0; int res = 0; DWORD new_size; - erts_smp_rwmtx_rlock(&environ_rwmtx); SetLastError(0); new_size = GetEnvironmentVariable((LPCTSTR) key, (LPTSTR) value, (DWORD) *size); res = !new_size && GetLastError() == ERROR_ENVVAR_NOT_FOUND ? -1 : 0; - erts_smp_rwmtx_runlock(&environ_rwmtx); if (res < 0) return res; res = new_size > *size ? 1 : 0; @@ -75,6 +73,16 @@ erts_sys_getenv(char *key, char *value, size_t *size) return res; } +int +erts_sys_getenv(char *key, char *value, size_t *size) +{ + int res; + erts_smp_rwmtx_rlock(&environ_rwmtx); + res = erts_sys_getenv__(key, value, size); + erts_smp_rwmtx_runlock(&environ_rwmtx); + return res; +} + struct win32_getenv_state { char *env; char *next; diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c index 1d73edd30b..93aaa23f97 100644 --- a/erts/emulator/sys/win32/sys_interrupt.c +++ b/erts/emulator/sys/win32/sys_interrupt.c @@ -21,6 +21,7 @@ */ #include "sys.h" #include "erl_alloc.h" +#include "erl_thr_progress.h" #include "erl_driver.h" #include "../../drivers/win32/win_con.h" @@ -52,14 +53,14 @@ void erts_do_break_handling(void) * therefore, make sure that all threads but this one are blocked before * proceeding! */ - erts_smp_block_system(0); + erts_smp_thr_progress_block(); /* call the break handling function, reset the flag */ do_break(); ResetEvent(erts_sys_break_event); ERTS_UNSET_BREAK_REQUESTED; - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); } diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 29cbdedd17..61eeec5ffd 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -25,7 +25,7 @@ t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, make_stub_many_funs/1,constant_pools/1, - false_dependency/1,coverage/1]). + false_dependency/1,coverage/1,fun_confusion/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,7 @@ all() -> [new_binary_types, t_check_process_code, t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, - constant_pools, false_dependency, coverage]. + constant_pools, false_dependency, coverage, fun_confusion]. groups() -> []. @@ -278,7 +278,8 @@ t_check_old_code(Config) when is_list(Config) -> external_fun(Config) when is_list(Config) -> ?line false = erlang:function_exported(another_code_test, x, 1), - ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1), + AnotherCodeTest = id(another_code_test), + ExtFun = fun AnotherCodeTest:x/1, ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), ?line false = erlang:function_exported(another_code_test, x, 1), ?line false = lists:member(another_code_test, erlang:loaded()), @@ -555,6 +556,30 @@ coverage(Config) when is_list(Config) -> ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), ok. +fun_confusion(Config) when is_list(Config) -> + Data = ?config(data_dir, Config), + Src = filename:join(Data, "fun_confusion"), + Mod = fun_confusion, + + %% Load first version of module. + compile_load(Mod, Src, 1), + F1 = Mod:f(), + 1 = F1(), + + %% Load second version of module. + compile_load(Mod, Src, 2), + F2 = Mod:f(), + + %% F1 should refer to the old code, not the newly loaded code. + 1 = F1(), + 2 = F2(), + ok. + +compile_load(Mod, Src, Ver) -> + {ok,Mod,Code1} = compile:file(Src, [binary,{d,version,Ver}]), + {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), + ok. + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl new file mode 100644 index 0000000000..16000861df --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl @@ -0,0 +1,31 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. 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(fun_confusion). + +-export([f/0]). + +f() -> + fun() -> version() end. + +version() -> + %% Changing the value returned here should change + %% the identity of the fun in f/0. + ?version. + diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index a77ea4f3be..c07dbc5871 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -75,7 +75,9 @@ smp_select/1, driver_select_use/1, thread_mseg_alloc_cache_clean/1, - otp_9302/1]). + otp_9302/1, + thr_free_drv/1, + async_blast/1]). -export([bin_prefix/2]). @@ -143,7 +145,9 @@ all() -> otp_6879, caller, many_events, missing_callbacks, smp_select, driver_select_use, thread_mseg_alloc_cache_clean, - otp_9302]. + otp_9302, + thr_free_drv, + async_blast]. groups() -> [{timer, [], @@ -1792,7 +1796,7 @@ driver_select_use0(Config) -> thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> case {erlang:system_info(threads), - erlang:system_info({allocator,mseg_alloc}), + mseg_inst_info(0), driver_alloc_sbct()} of {_, false, _} -> ?line {skipped, "No mseg_alloc"}; @@ -1804,13 +1808,13 @@ thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> ?line {skipped, "driver_alloc() using too large single block threshold"}; {_, _, 0} -> ?line {skipped, "driver_alloc() using too low single block threshold"}; - {true, MsegAllocInfo, SBCT} -> + {true, _MsegAllocInfo, SBCT} -> ?line DrvName = 'thr_alloc_drv', ?line Path = ?config(data_dir, Config), ?line erl_ddll:start(), ?line ok = load_driver(Path, DrvName), ?line Port = open_port({spawn, DrvName}, []), - ?line CCI = mseg_alloc_cci(MsegAllocInfo), + ?line CCI = 1000, ?line ?t:format("CCI = ~p~n", [CCI]), ?line CCC = mseg_alloc_ccc(), ?line ?t:format("CCC = ~p~n", [CCC]), @@ -1831,7 +1835,7 @@ mseg_alloc_cci(MsegAllocInfo) -> ?line CCI. mseg_alloc_ccc() -> - mseg_alloc_ccc(erlang:system_info({allocator,mseg_alloc})). + mseg_alloc_ccc(mseg_inst_info(0)). mseg_alloc_ccc(MsegAllocInfo) -> ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo), @@ -1841,7 +1845,7 @@ mseg_alloc_ccc(MsegAllocInfo) -> ?line GigaCCC*1000000000 + CCC. mseg_alloc_cached_segments() -> - mseg_alloc_cached_segments(erlang:system_info({allocator,mseg_alloc})). + mseg_alloc_cached_segments(mseg_inst_info(0)). mseg_alloc_cached_segments(MsegAllocInfo) -> MemName = case is_halfword_vm() of @@ -1859,6 +1863,13 @@ mseg_alloc_cached_segments(MsegAllocInfo) -> = lists:keysearch(cached_segments, 1, SL), ?line CS. +mseg_inst_info(I) -> + {value, {instance, I, Value}} + = lists:keysearch(I, + 2, + erlang:system_info({allocator,mseg_alloc})), + Value. + is_halfword_vm() -> case {erlang:system_info({wordsize, internal}), erlang:system_info({wordsize, external})} of @@ -1902,18 +1913,105 @@ otp_9302(Config) when is_list(Config) -> ?line port_command(Port, ""), ?line {msg, block} = get_port_msg(Port, infinity), ?line {msg, job} = get_port_msg(Port, infinity), - ?line case erlang:system_info(thread_pool_size) of - 0 -> - {msg, cancel} = get_port_msg(Port, infinity); - _ -> - ok - end, - ?line {msg, job} = get_port_msg(Port, infinity), + ?line C = case erlang:system_info(thread_pool_size) of + 0 -> + ?line {msg, cancel} = get_port_msg(Port, infinity), + ?line {msg, job} = get_port_msg(Port, infinity), + ?line false; + _ -> + case get_port_msg(Port, infinity) of + {msg, cancel} -> %% Cancel always fail in Rel >= 15 + ?line {msg, job} = get_port_msg(Port, infinity), + ?line false; + {msg, job} -> + ?line ok, + ?line true + end + end, ?line {msg, end_of_jobs} = get_port_msg(Port, infinity), ?line no_msg = get_port_msg(Port, 2000), ?line port_close(Port), + ?line case C of + true -> + ?line {comment, "Async job cancelled"}; + false -> + ?line {comment, "Async job not cancelled"} + end. + +thr_free_drv(Config) when is_list(Config) -> + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:start(), + ?line ok = load_driver(Path, thr_free_drv), + ?line MemBefore = driver_alloc_size(), +% io:format("SID=~p", [erlang:system_info(scheduler_id)]), + ?line Port = open_port({spawn, thr_free_drv}, []), + ?line MemPeek = driver_alloc_size(), + ?line true = is_port(Port), + ?line ok = thr_free_drv_control(Port, 0), + ?line port_close(Port), + ?line MemAfter = driver_alloc_size(), + ?line io:format("MemPeek=~p~n", [MemPeek]), + ?line io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]), + ?line MemBefore = MemAfter, + ?line case MemPeek of + undefined -> ok; + _ -> + ?line true = MemPeek > MemBefore + end, ?line ok. +thr_free_drv_control(Port, N) -> + case erlang:port_control(Port, 0, "") of + "done" -> + ok; + "more" -> + erlang:yield(), +% io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]), + thr_free_drv_control(Port, N+1) + end. + +async_blast(Config) when is_list(Config) -> + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:start(), + ?line ok = load_driver(Path, async_blast_drv), + ?line SchedOnln = erlang:system_info(schedulers_online), + ?line MemBefore = driver_alloc_size(), + ?line Start = os:timestamp(), + ?line Blast = fun () -> + Port = open_port({spawn, async_blast_drv}, []), + true = is_port(Port), + port_command(Port, ""), + receive + {Port, done} -> + ok + end, + port_close(Port) + end, + ?line Ps = lists:map(fun (N) -> + spawn_opt(Blast, + [{scheduler, + (N rem SchedOnln)+ 1}, + monitor]) + end, + lists:seq(1, 100)), + ?line MemMid = driver_alloc_size(), + ?line lists:foreach(fun ({Pid, Mon}) -> + receive + {'DOWN',Mon,process,Pid,_} -> ok + end + end, Ps), + ?line End = os:timestamp(), + ?line MemAfter = driver_alloc_size(), + ?line io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n", + [MemBefore, MemMid, MemAfter]), + ?line AsyncBlastTime = timer:now_diff(End,Start)/1000000, + ?line io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]), + ?line MemBefore = MemAfter, + ?line erlang:display({async_blast_time, AsyncBlastTime}), + ?line ok. + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utilities %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2077,3 +2175,33 @@ start_node(Config) when is_list(Config) -> stop_node(Node) -> ?t:stop_node(Node). + +wait_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_deallocations() + end. + +driver_alloc_size() -> + wait_deallocations(), + case erlang:system_info({allocator_sizes, driver_alloc}) of + false -> + undefined; + MemInfo -> + CS = lists:foldl( + fun ({instance, _, L}, Acc) -> + {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L), + {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), + {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), + [SBMBCS,MBCS,SBCS | Acc] + end, + [], + MemInfo), + lists:foldl( + fun(L, Sz0) -> + {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L), + Sz0+Sz + end, 0, CS) + end. diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src index 5b3ba1557e..dd48f6a0f7 100644 --- a/erts/emulator/test/driver_SUITE_data/Makefile.src +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -12,7 +12,9 @@ MISC_DRVS = outputv_drv@dll@ \ many_events_drv@dll@ \ missing_callback_drv@dll@ \ thr_alloc_drv@dll@ \ - otp_9302_drv@dll@ + otp_9302_drv@dll@ \ + thr_free_drv@dll@ \ + async_blast_drv@dll@ SYS_INFO_DRVS = sys_info_1_0_drv@dll@ \ sys_info_1_1_drv@dll@ \ diff --git a/erts/emulator/test/driver_SUITE_data/async_blast_drv.c b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c new file mode 100644 index 0000000000..3821f7e3dc --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c @@ -0,0 +1,124 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ + +#include "erl_driver.h" + +#define NO_ASYNC_JOBS 10000 + +static void stop(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, + char *command); +static void output(ErlDrvData drv_data, + char *buf, int len); +static void ready_async(ErlDrvData drv_data, + ErlDrvThreadData thread_data); + +static ErlDrvEntry async_blast_drv_entry = { + NULL /* init */, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "async_blast_drv", + NULL /* finish */, + NULL /* handle */, + NULL /* control */, + NULL /* timeout */, + NULL /* outputv */, + ready_async, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +typedef struct { + ErlDrvPort port; + ErlDrvTermData caller; + int counter; +} async_blast_data_t; + + +DRIVER_INIT(async_blast_drv) +{ + return &async_blast_drv_entry; +} + +static void stop(ErlDrvData drv_data) +{ + driver_free((void *) drv_data); +} + +static ErlDrvData start(ErlDrvPort port, + char *command) +{ + async_blast_data_t *abd; + + abd = driver_alloc(sizeof(async_blast_data_t)); + if (!abd) + return ERL_DRV_ERROR_GENERAL; + + abd->port = port; + abd->counter = 0; + return (ErlDrvData) abd; +} + +static void async_invoke(void *data) +{ + +} +#include <stdio.h> + +static void ready_async(ErlDrvData drv_data, + ErlDrvThreadData thread_data) +{ + async_blast_data_t *abd = (async_blast_data_t *) drv_data; + if (--abd->counter == 0) { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(abd->port), + ERL_DRV_ATOM, driver_mk_atom("done"), + ERL_DRV_TUPLE, 2 + }; + driver_send_term(abd->port, abd->caller, + spec, sizeof(spec)/sizeof(spec[0])); + } +} + +static void output(ErlDrvData drv_data, + char *buf, int len) +{ + async_blast_data_t *abd = (async_blast_data_t *) drv_data; + if (abd->counter == 0) { + int i; + abd->caller = driver_caller(abd->port); + abd->counter = NO_ASYNC_JOBS; + for (i = 0; i < NO_ASYNC_JOBS; i++) { + if (0 > driver_async(abd->port, NULL, async_invoke, NULL, NULL)) { + driver_failure_atom(abd->port, "driver_async_failed"); + break; + } + } + } +} diff --git a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c new file mode 100644 index 0000000000..622a62ebea --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c @@ -0,0 +1,241 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2011. 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% + */ +#include <stdlib.h> +#include <errno.h> +#include <string.h> +#include "erl_driver.h" + +#define BLOCKS_PER_THREAD 100000 +#define NO_THREADS 10 +#define BLOCKS_PER_CTRL 1000 + +typedef struct { + ErlDrvMutex *mtx; + ErlDrvCond *cnd; + int b; + int *go; + int *skip; + void *blocks[BLOCKS_PER_THREAD]; +} test_thread_data; + +typedef struct { + ErlDrvPort port; + int b; + int go; + int skip; + test_thread_data ttd[NO_THREADS+1]; + ErlDrvTid tids[NO_THREADS+1]; +} test_data; + +static ErlDrvData start(ErlDrvPort port, char *command); +static void stop(ErlDrvData data); +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); + +static ErlDrvEntry thr_free_drv_entry = { + NULL /* init */, + start, + stop, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "thr_free_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(thr_free_drv) +{ + return &thr_free_drv_entry; +} + +void * +test_thread(void *vttd) +{ + test_thread_data *ttd = (test_thread_data *) vttd; + int i, skip; + + erl_drv_mutex_lock(ttd->mtx); + + while (!*ttd->go) + erl_drv_cond_wait(ttd->cnd, ttd->mtx); + skip = *ttd->skip; + erl_drv_mutex_unlock(ttd->mtx); + + if (!skip) { + for (i = 0; i < BLOCKS_PER_THREAD; i++) + driver_free(ttd->blocks[i]); + } + return NULL; +} + +ErlDrvData start(ErlDrvPort port, char *command) +{ + int join = 0, t, b, res; + test_thread_data *ttd; + test_data *td = driver_alloc(sizeof(test_data)); + if (!td) + return ERL_DRV_ERROR_GENERAL; + ttd = td->ttd; + for (b = 0; b < BLOCKS_PER_THREAD; b++) + for (t = 0; t <= NO_THREADS; t++) + ttd[t].blocks[b] = NULL; + ttd[0].mtx = NULL; + ttd[0].cnd = NULL; + + for (b = 0; b < BLOCKS_PER_THREAD; b++) { + for (t = 0; t <= NO_THREADS; t++) { + ttd[t].blocks[b] = driver_alloc(1); + if (ttd[t].blocks[b] == NULL) + goto fail; + } + } + + td->b = -1; + td->go = 0; + td->skip = 0; + + ttd[0].mtx = erl_drv_mutex_create("test_mutex"); + if (!ttd[0].mtx) + goto fail; + ttd[0].cnd = erl_drv_cond_create("test_cnd"); + if (!ttd[0].cnd) + goto fail; + ttd[0].go = &td->go; + ttd[0].skip = &td->skip; + + for (t = 1; t <= NO_THREADS; t++) { + ttd[t].mtx = ttd[0].mtx; + ttd[t].cnd = ttd[0].cnd; + ttd[t].go = ttd[0].go; + ttd[t].skip = ttd[0].skip; + res = erl_drv_thread_create("test_thread", + &td->tids[t], + test_thread, + &ttd[t], + NULL); + if (res != 0) + goto fail; + join = t; + } + + td->port = port; + + return (ErlDrvData) td; + +fail: + + if (join) { + erl_drv_mutex_lock(ttd[0].mtx); + td->go = 1; + td->skip = 1; + erl_drv_cond_broadcast(ttd[0].cnd); + erl_drv_mutex_unlock(ttd[0].mtx); + for (t = 1; t <= join; t++) + erl_drv_thread_join(td->tids[t], NULL); + } + + if (ttd[0].mtx) + erl_drv_mutex_destroy(ttd[0].mtx); + if (ttd[0].cnd) + erl_drv_cond_destroy(ttd[0].cnd); + + for (b = 0; b < BLOCKS_PER_THREAD; b++) { + for (t = 0; t <= NO_THREADS; t++) { + if (ttd[t].blocks[b] != NULL) + driver_free(ttd[t].blocks[b]); + } + } + + return ERL_DRV_ERROR_GENERAL; +} + +static void stop(ErlDrvData drv_data) +{ + test_data *td = (test_data *) drv_data; + int t, b; + for (t = 1; t <= NO_THREADS; t++) + erl_drv_thread_join(td->tids[t], NULL); + for (b = 0; b < BLOCKS_PER_THREAD; b++) { + if (td->ttd[0].blocks[b]) + driver_free(td->ttd[0].blocks[b]); + } + erl_drv_mutex_destroy(td->ttd[0].mtx); + erl_drv_cond_destroy(td->ttd[0].cnd); + driver_free(td); +} + +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + test_data *td = (test_data *) drv_data; + char *result = "failure"; + int i, b; + int res; + int result_len; + + if (td->b == -1) { + erl_drv_mutex_lock(td->ttd[0].mtx); + td->go = 1; + erl_drv_cond_broadcast(td->ttd[0].cnd); + erl_drv_mutex_unlock(td->ttd[0].mtx); + td->b = 0; + } + + for (i = 0, b = td->b; i < BLOCKS_PER_CTRL && b < BLOCKS_PER_THREAD; i++, b++) { + driver_free(td->ttd[0].blocks[b]); + td->ttd[0].blocks[b] = NULL; + } + + td->b = b; + if (b >= BLOCKS_PER_THREAD) + result = "done"; + else + result = "more"; + + result_len = strlen(result); + if (result_len <= rlen) { + memcpy(*rbuf, result, result_len); + return result_len; + } + else { + *rbuf = driver_alloc(result_len); + if (!*rbuf) { + driver_failure_posix(td->port, ENOMEM); + return 0; + } + else { + memcpy(*rbuf, result, result_len); + return result_len; + } + } +} diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl index e0a7878bd8..879d2f61dd 100644 --- a/erts/emulator/test/mtx_SUITE.erl +++ b/erts/emulator/test/mtx_SUITE.erl @@ -62,16 +62,29 @@ init_per_suite(Config) when is_list(Config) -> Config. end_per_suite(Config) when is_list(Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), Config. init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?t:minutes(15)), + %% Wait for deallocations to complete since we measure + %% runtime in test cases. + wait_deallocations(), [{watchdog, Dog}|Config]. end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog). +wait_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_deallocations() + end. + suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 5c82a01bd1..370363bf9e 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -35,7 +35,9 @@ resource_takeover/1, threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1, - get_length/1, make_atom/1, make_string/1, reverse_list_test/1]). + get_length/1, make_atom/1, make_string/1, reverse_list_test/1, + otp_9668/1 + ]). -export([many_args_100/100]). @@ -60,7 +62,9 @@ all() -> iolist_as_binary, resource, resource_binary, resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, - make_string,reverse_list_test]. + make_string,reverse_list_test, + otp_9668 + ]. groups() -> []. @@ -1236,6 +1240,20 @@ reverse_list_test(Config) -> ?line RevList = reverse_list(List), ?line badarg = reverse_list(foo). +otp_9668(doc) -> ["Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment"]; +otp_9668(Config) -> + ensure_lib_loaded(Config, 1), + TmpMem = tmpmem(), + IOList = ["This",' ',<<"is">>,' ',[<<"an iolist">>,'.']], + otp_9668_nif(IOList), + + <<_:5/bitstring,UnalignedBin:10/binary,_/bitstring>> = <<"Abuse me as unaligned">>, + otp_9668_nif(UnalignedBin), + + ?line verify_tmpmem(TmpMem), + ok. + + tmpmem() -> case erlang:system_info({allocator,temp_alloc}) of false -> undefined; @@ -1345,6 +1363,7 @@ send_term(_,_) -> ?nif_stub. reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. +otp_9668_nif(_) -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 35f54d62c5..7d7903af25 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1431,6 +1431,26 @@ static ERL_NIF_TERM reverse_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return rev_list; } +static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /* Inspect in process independent env */ + ErlNifEnv* myenv = enif_alloc_env(); + ERL_NIF_TERM mycopy = enif_make_copy(myenv, argv[0]); + ErlNifBinary obin, cbin; + + if ((enif_inspect_binary(env, argv[0], &obin) + && enif_inspect_binary(myenv, mycopy, &cbin)) + || + (enif_inspect_iolist_as_binary(env, argv[0], &obin) + && enif_inspect_iolist_as_binary(myenv, mycopy, &cbin))) + { + assert(obin.size == cbin.size); + assert(memcmp(obin.data, cbin.data, obin.size) == 0); + } + enif_free_env(myenv); + return atom_ok; +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1478,7 +1498,8 @@ static ErlNifFunc nif_funcs[] = {"send_term", 2, send_term}, {"reverse_list",1, reverse_list}, {"echo_int", 1, echo_int}, - {"type_sizes", 0, type_sizes} + {"type_sizes", 0, type_sizes}, + {"otp_9668_nif", 1, otp_9668_nif} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 9b782b35a2..0350eb671d 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -37,7 +37,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2]). --export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1]). +-export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(2)). @@ -45,7 +45,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [process_count, system_version, misc_smoke_tests, - heap_size, wordsize]. + heap_size, wordsize, memory]. groups() -> []. @@ -187,3 +187,312 @@ wordsize(Config) when is_list(Config) -> Other -> exit({unexpected_wordsizes,Other}) end. + +memory(doc) -> ["Verify that erlang:memory/0 and memory results in crashdump produce are similar"]; +memory(Config) when is_list(Config) -> + %% + %% Verify that erlang:memory/0 and memory results in + %% crashdump produce are similar. + %% + %% erlang:memory/0 requests information from each scheduler + %% thread and puts the information together in erlang code + %% (erlang.erl). + %% + %% When a crash dump is written we cannot use the + %% erlang:memory/0 implementation. The crashdump implementation + %% is a pure C implementation inspecting all allocator instances + %% after the system has been blocked (erts_memory() in erl_alloc.c). + %% + %% Since we got two implementations, modifications can easily + %% cause them to produce different results. + %% + %% erts_debug:get_internal_state(memory) blocks the system and + %% execute the same code as the crash dump writing uses. + %% + + erts_debug:set_internal_state(available_internal_state, true), + %% Use a large heap size on the controling process in + %% order to avoid changes in its heap size during + %% comparisons. + MinHeapSize = process_flag(min_heap_size, 1024*1024), + Prio = process_flag(priority, max), + try + erlang:memory(), %% first call will init stat atoms + garbage_collect(), %% blow up heap + memory_test(Config) + catch + error:notsup -> {skipped, "erlang:memory() not supported"} + after + process_flag(min_heap_size, MinHeapSize), + process_flag(priority, Prio), + catch erts_debug:set_internal_state(available_internal_state, false) + end. + +memory_test(_Config) -> + + MWs = spawn_mem_workers(), + + DPs = mem_workers_call(MWs, + fun () -> + mapn(fun (_) -> + spawn(fun () -> + receive + after infinity -> + ok + end + end) + end, + 1000 div erlang:system_info(schedulers_online)) + end, + []), + cmp_memory(MWs, "spawn procs"), + + Ps = lists:flatten(DPs), + + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (P) -> link(P) end, Ps) + end, + []), + cmp_memory(MWs, "link procs"), + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (P) -> unlink(P) end, Ps) + end, + []), + cmp_memory(MWs, "unlink procs"), + + DMs = mem_workers_call(MWs, + fun () -> + lists:map(fun (P) -> + monitor(process, P) + end, Ps) + end, + []), + cmp_memory(MWs, "monitor procs"), + Ms = lists:flatten(DMs), + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (M) -> + demonitor(M) + end, Ms) + end, + []), + cmp_memory(MWs, "demonitor procs"), + + mem_workers_call(MWs, + fun () -> + lists:foreach(fun (P) -> + P ! {a, "message", make_ref()} + end, Ps) + end, + []), + cmp_memory(MWs, "message procs"), + + mem_workers_call(MWs, + fun () -> + Mons = lists:map(fun (P) -> + exit(P, kill), + monitor(process, P) + end, + Ps), + lists:foreach(fun (Mon) -> + receive + {'DOWN', Mon, _, _, _} -> ok + end + end, + Mons) + end, []), + cmp_memory(MWs, "kill procs"), + + mem_workers_call(MWs, + fun () -> + put(binary_data, + mapn(fun (_) -> list_to_binary(lists:duplicate(256,$?)) end, 100)) + end, + []), + + cmp_memory(MWs, "store binary data"), + + mem_workers_call(MWs, + fun () -> + put(binary_data, false), + garbage_collect() + end, + []), + cmp_memory(MWs, "release binary data"), + + mem_workers_call(MWs, + fun () -> + list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), + list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) + end, + []), + cmp_memory(MWs, "new atoms"), + + + mem_workers_call(MWs, + fun () -> + T = ets:new(?MODULE, []), + ets:insert(T, {gurka, lists:seq(1,10000)}), + ets:insert(T, {banan, lists:seq(1,1024)}), + ets:insert(T, {appelsin, make_ref()}), + put(ets_id, T) + end, + []), + cmp_memory(MWs, "store ets data"), + + mem_workers_call(MWs, + fun () -> + ets:delete(get(ets_id)), + put(ets_id, false) + end, + []), + cmp_memory(MWs, "remove ets data"), + + lists:foreach(fun (MW) -> + unlink(MW), + Mon = monitor(process, MW), + exit(MW, kill), + receive + {'DOWN', Mon, _, _, _} -> ok + end + end, + MWs), + ok. + +mem_worker() -> + receive + {call, From, Fun, Args} -> + From ! {reply, self(), apply(Fun, Args)}, + mem_worker(); + {cast, _From, Fun, Args} -> + apply(Fun, Args), + mem_worker() + end. + +mem_workers_call(MWs, Fun, Args) -> + lists:foreach(fun (MW) -> + MW ! {call, self(), Fun, Args} + end, + MWs), + lists:map(fun (MW) -> + receive + {reply, MW, Res} -> + Res + end + end, + MWs). + +mem_workers_cast(MWs, Fun, Args) -> + lists:foreach(fun (MW) -> + MW ! {cast, self(), Fun, Args} + end, + MWs). + +spawn_mem_workers() -> + spawn_mem_workers(erlang:system_info(schedulers_online)). + +spawn_mem_workers(0) -> + []; +spawn_mem_workers(N) -> + [spawn_opt(fun () -> mem_worker() end, + [{scheduler, N rem erlang:system_info(schedulers_online) + 1}, + link]) | spawn_mem_workers(N-1)]. + + + +mem_get(X, Mem) -> + case lists:keyfind(X, 1, Mem) of + {X, Val} -> Val; + false -> false + end. + +cmp_memory(What, Mem1, Mem2, 1) -> + R1 = mem_get(What, Mem1), + R2 = mem_get(What, Mem2), + true = R1 == R2; +cmp_memory(What, Mem1, Mem2, RelDiff) -> + %% We allow RealDiff diff + R1 = mem_get(What, Mem1), + R2 = mem_get(What, Mem2), + case R1 == R2 of + true -> + ok; + false -> + case R1 > R2 of + true -> + true = R2*RelDiff > R1; + false -> + true = R1*RelDiff > R2 + end + end. + +pos_int(Val) when Val >= 0 -> + Val; +pos_int(Val) -> + exit({not_pos_int, Val}). + +check_sane_memory(Mem) -> + Tot = pos_int(mem_get(total, Mem)), + Proc = pos_int(mem_get(processes, Mem)), + ProcUsed = pos_int(mem_get(processes_used, Mem)), + Sys = pos_int(mem_get(system, Mem)), + Atom = pos_int(mem_get(atom, Mem)), + AtomUsed = pos_int(mem_get(atom_used, Mem)), + Bin = pos_int(mem_get(binary, Mem)), + Code = pos_int(mem_get(code, Mem)), + Ets = pos_int(mem_get(ets, Mem)), + + Tot = Proc + Sys, + true = Sys > Atom + Bin + Code + Ets, + true = Proc >= ProcUsed, + true = Atom >= AtomUsed, + + case mem_get(maximum, Mem) of + false -> ok; + Max -> true = pos_int(Max) >= Tot + end, + ok. + +cmp_memory(MWs, Str) -> + erlang:display(Str), + lists:foreach(fun (MW) -> garbage_collect(MW) end, MWs), + garbage_collect(), + erts_debug:set_internal_state(wait, deallocations), + + EDM = erts_debug:get_internal_state(memory), + EM = erlang:memory(), + + io:format("~s:~n" + "erlang:memory() = ~p~n" + "crash dump memory = ~p~n", + [Str, EM, EDM]), + + ?line check_sane_memory(EM), + ?line check_sane_memory(EDM), + + %% We expect these to always give us exactly the same result + + ?line cmp_memory(atom, EM, EDM, 1), + ?line cmp_memory(atom_used, EM, EDM, 1), + ?line cmp_memory(binary, EM, EDM, 1), + ?line cmp_memory(code, EM, EDM, 1), + ?line cmp_memory(ets, EM, EDM, 1), + + %% Total, processes, processes_used, and system will seldom + %% give us exactly the same result since the two readings + %% aren't taken atomically. + + ?line cmp_memory(total, EM, EDM, 1.05), + ?line cmp_memory(processes, EM, EDM, 1.05), + ?line cmp_memory(processes_used, EM, EDM, 1.05), + ?line cmp_memory(system, EM, EDM, 1.05), + + ok. + +mapn(_Fun, 0) -> + []; +mapn(Fun, N) -> + [Fun(N) | mapn(Fun, N-1)]. diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables index 918ef62094..91efb4c023 100755 --- a/erts/emulator/utils/make_tables +++ b/erts/emulator/utils/make_tables @@ -181,8 +181,7 @@ for ($i = 0; $i < @bif; $i++) { print "\n"; for ($i = 0; $i < @bif; $i++) { - my $arity = $bif[$i]->[2]; - my $args = join(', ', 'Process*', ('Eterm') x $arity); + my $args = join(', ', 'Process*', 'Eterm*'); print "Eterm $bif[$i]->[3]($args);\n"; print "Eterm wrap_$bif[$i]->[3]($args, UWord *I);\n"; } @@ -219,28 +218,10 @@ for ($i = 0; $i < @bif; $i++) { next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs my $arity = $bif[$i]->[2]; my $func = $bif[$i]->[3]; - my $arg; print "Eterm\n"; - print "wrap_$func(Process* p"; - for ($arg = 1; $arg <= $arity; $arg++) { - print ", Eterm arg$arg"; - } - print ", UWord *I)\n"; + print "wrap_$func(Process* p, Eterm* args, UWord* I)\n"; print "{\n"; - print " return erts_bif_trace($i, p"; - for ($arg = 1; $arg <= 3; $arg++) { - if ($arg <= $arity) { - print ", arg$arg"; - #} elsif ($arg == ($arity + 1)) { - # # Place I in correct position - # print ", (Eterm) I"; - } else { - print ", 0"; - } - } - # I is always last, as well as in the correct position - # Note that "last" and "correct position" may be the same... - print ", I);\n"; + print " return erts_bif_trace($i, p, args, I);\n"; print "}\n\n"; } @@ -261,19 +242,9 @@ for ($i = 0; $i < @bif; $i++) { my $orig_func = $1; $orig_func = $implementation[$i] if $implementation[$i]; print "Eterm\n"; - print "$func(Process* p"; - for ($arg = 1; $arg <= $arity; $arg++) { - print ", Eterm arg$arg"; - } - print ")\n"; + print "$func(Process* p, Eterm* BIF__ARGS)\n"; print "{\n"; - print " return $orig_func(p"; - for ($arg = 1; $arg <= 3; $arg++) { - if ($arg <= $arity) { - print ", arg$arg"; - } - } - print ");\n"; + print " return $orig_func(p, BIF__ARGS);\n"; print "}\n\n"; } diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c index 35c360a99d..23f009ff4d 100644 --- a/erts/etc/common/erlc.c +++ b/erts/etc/common/erlc.c @@ -185,6 +185,7 @@ main(int argc, char** argv) * Push initial arguments. */ + PUSH("+sbtu"); PUSH("-noinput"); PUSH2("-mode", "minimal"); PUSH2("-boot", "start_clean"); diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 2bd576d8e8..8d119984df 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -67,6 +67,7 @@ static const char plusM_au_allocs[]= { 'C', /* sbmbc_alloc */ 'D', /* std_alloc */ 'E', /* ets_alloc */ + 'F', /* fix_alloc */ 'H', /* eheap_alloc */ 'L', /* ll_alloc */ 'R', /* driver_alloc */ @@ -110,8 +111,6 @@ static char *plusM_other_switches[] = { "Mamcbf", "Mrmcbf", "Mmcs", - "Mcci", - "Fe", "Ye", "Ym", "Ytp", diff --git a/erts/etc/win32/nsis/erlang_uninst.ico b/erts/etc/win32/nsis/erlang_uninst.ico Binary files differindex edbd8a6f2c..edbd8a6f2c 100755..100644 --- a/erts/etc/win32/nsis/erlang_uninst.ico +++ b/erts/etc/win32/nsis/erlang_uninst.ico diff --git a/erts/include/internal/ethr_mutex.h b/erts/include/internal/ethr_mutex.h index a0685ea3c0..86a1e9fbdf 100644 --- a/erts/include/internal/ethr_mutex.h +++ b/erts/include/internal/ethr_mutex.h @@ -22,6 +22,23 @@ * Author: Rickard Green */ +/* + * IMPORTANT note about ethr_cond_signal() and ethr_cond_broadcast() + * + * POSIX allow a call to `pthread_cond_signal' or `pthread_cond_broadcast' + * even though the associated mutex/mutexes isn't/aren't locked by the + * caller. We do not allow that by default in order to avoid a performance + * penalty on some platforms. + * + * Mutexes and condition variables can, however, be initialized as POSIX + * compliant. When initialized as such ethr_cond_signal(), and + * ethr_cond_broadcast() are allowed to be called even though the associated + * mutexes aren't locked. This will, however, incur a performance penalty on + * some platforms. + * + * POSIX compliant mutexes and condition variables *need* to be used together. + */ + #ifndef ETHR_MUTEX_H__ #define ETHR_MUTEX_H__ @@ -40,6 +57,14 @@ #endif #endif +/* #define ETHR_DBG_WIN_MTX_WITH_PTHREADS */ +#ifdef ETHR_DBG_WIN_MTX_WITH_PTHREADS +typedef pthread_mutex_t CRITICAL_SECTION; +int TryEnterCriticalSection(CRITICAL_SECTION *); +void EnterCriticalSection(CRITICAL_SECTION *); +void LeaveCriticalSection(CRITICAL_SECTION *); +#endif + #ifdef ETHR_MTX_HARD_DEBUG # ifdef __GNUC__ # warning ETHR_MTX_HARD_DEBUG @@ -140,13 +165,19 @@ struct ethr_mutex_base_ { typedef struct { int main_spincount; int aux_spincount; + int posix_compliant; } ethr_mutex_opt; +#define ETHR_MUTEX_OPT_DEFAULT_INITER {-1, -1, 0} + typedef struct { int main_spincount; int aux_spincount; + int posix_compliant; } ethr_cond_opt; +#define ETHR_COND_OPT_DEFAULT_INITER {-1, -1, 0} + #ifdef ETHR_USE_OWN_MTX_IMPL__ typedef struct ethr_mutex_ ethr_mutex; @@ -179,7 +210,7 @@ struct ethr_cond_ { #endif }; -#else /* pthread */ +#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) typedef struct ethr_mutex_ ethr_mutex; struct ethr_mutex_ { @@ -197,7 +228,36 @@ struct ethr_cond_ { #endif }; -#endif /* pthread */ +#elif defined(ETHR_WIN32_THREADS) || defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +# define ETHR_WIN_MUTEX__ + +typedef struct ethr_mutex_ ethr_mutex; +struct ethr_mutex_ { + int posix_compliant; + CRITICAL_SECTION cs; + ethr_ts_event *wakeups; + ethr_atomic32_t have_wakeups; /* only when posix compliant */ + ethr_atomic32_t locked; /* only when posix compliant */ + ethr_spinlock_t lock; /* only when posix compliant */ +#if ETHR_XCHK + int initialized; +#endif +}; + +typedef struct ethr_cond_ ethr_cond; +struct ethr_cond_ { + int posix_compliant; + CRITICAL_SECTION cs; + ethr_ts_event *waiters; + int spincount; +#if ETHR_XCHK + int initialized; +#endif +}; + +#else +# error "no mutex implementation" +#endif int ethr_mutex_init_opt(ethr_mutex *, ethr_mutex_opt *); int ethr_mutex_init(ethr_mutex *); @@ -573,7 +633,7 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx) #endif /* ETHR_TRY_INLINE_FUNCS */ -#else /* pthread_mutex */ +#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) #if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_MUTEX_IMPL__) @@ -605,7 +665,54 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx) #endif /* ETHR_TRY_INLINE_FUNCS */ -#endif /* pthread_mutex */ +#elif defined(ETHR_WIN32_THREADS) || defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) + +#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_MUTEX_IMPL__) + +static ETHR_INLINE int +ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_trylock)(ethr_mutex *mtx) +{ + if (!TryEnterCriticalSection(&mtx->cs)) + return EBUSY; + if (mtx->posix_compliant) + ethr_atomic32_set(&mtx->locked, 1); + return 0; +} + +static ETHR_INLINE void +ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_lock)(ethr_mutex *mtx) +{ + EnterCriticalSection(&mtx->cs); + if (mtx->posix_compliant) + ethr_atomic32_set(&mtx->locked, 1); +} + +void ethr_mutex_cond_wakeup__(ethr_mutex *mtx); + +static ETHR_INLINE void +ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx) +{ + if (mtx->posix_compliant) { + ethr_atomic32_set_mb(&mtx->locked, 0); + if (ethr_atomic32_read_acqb(&mtx->have_wakeups)) + goto cond_wakeup; + else + goto leave_cs; + } + + if (mtx->wakeups) { + cond_wakeup: + ethr_mutex_cond_wakeup__(mtx); + } + else { + leave_cs: + LeaveCriticalSection(&mtx->cs); + } +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif #ifdef ETHR_USE_OWN_RWMTX_IMPL__ diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 8ad0ded144..142c26c0ca 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -191,7 +191,6 @@ typedef DWORD ethr_tsd_key; #undef ETHR_HAVE_ETHR_SIG_FUNCS #define ETHR_USE_OWN_RWMTX_IMPL__ -#define ETHR_USE_OWN_MTX_IMPL__ #define ETHR_YIELD() (Sleep(0), 0) diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c index 81fd6af80a..e363279f2e 100644 --- a/erts/lib_src/common/ethr_mutex.c +++ b/erts/lib_src/common/ethr_mutex.c @@ -223,9 +223,59 @@ rwmutex_try_complete_runlock(ethr_rwmutex *rwmtx, int try_write_lock); #endif +/* -- Utilities used by multiple implementations -- */ + +#if defined(ETHR_USE_OWN_RWMTX_IMPL__) || defined(ETHR_USE_OWN_MTX_IMPL__) \ + || defined(ETHR_WIN32_THREADS) + +static ETHR_INLINE void +enqueue(ethr_ts_event **queue, + ethr_ts_event *tse_start, + ethr_ts_event *tse_end) +{ + if (!*queue) { + *queue = tse_start; + tse_start->prev = tse_end; + tse_end->next = tse_start; + } + else { + tse_end->next = *queue; + tse_start->prev = (*queue)->prev; + (*queue)->prev->next = tse_start; + (*queue)->prev = tse_end; + } +} + + +static ETHR_INLINE void +dequeue(ethr_ts_event **queue, + ethr_ts_event *tse_start, + ethr_ts_event *tse_end) +{ + if (tse_start->prev == tse_end) { + ETHR_ASSERT(*queue == tse_start && tse_end->next == tse_start); + *queue = NULL; + } + else { + if (*queue == tse_start) + *queue = tse_end->next; + tse_end->next->prev = tse_start->prev; + tse_start->prev->next = tse_end->next; + } +} + +#endif + #if defined(ETHR_USE_OWN_RWMTX_IMPL__) || defined(ETHR_USE_OWN_MTX_IMPL__) -/* -- Utilities operating both on ordinary mutexes and read write mutexes -- */ +static ETHR_INLINE void +insert(ethr_ts_event *tse_pred, ethr_ts_event *tse) +{ + tse->next = tse_pred->next; + tse->prev = tse_pred; + tse_pred->next->prev = tse; + tse_pred->next = tse; +} static ETHR_INLINE void rwmutex_freqread_wtng_rdrs_inc(ethr_rwmutex *rwmtx, ethr_ts_event *tse) @@ -355,51 +405,6 @@ rwmutex_freqread_rdrs_read(ethr_rwmutex *rwmtx, int ix) return res; } - -static ETHR_INLINE void -enqueue(ethr_ts_event **queue, - ethr_ts_event *tse_start, - ethr_ts_event *tse_end) -{ - if (!*queue) { - *queue = tse_start; - tse_start->prev = tse_end; - tse_end->next = tse_start; - } - else { - tse_end->next = *queue; - tse_start->prev = (*queue)->prev; - (*queue)->prev->next = tse_start; - (*queue)->prev = tse_end; - } -} - -static ETHR_INLINE void -insert(ethr_ts_event *tse_pred, ethr_ts_event *tse) -{ - tse->next = tse_pred->next; - tse->prev = tse_pred; - tse_pred->next->prev = tse; - tse_pred->next = tse; -} - -static ETHR_INLINE void -dequeue(ethr_ts_event **queue, - ethr_ts_event *tse_start, - ethr_ts_event *tse_end) -{ - if (tse_start->prev == tse_end) { - ETHR_ASSERT(*queue == tse_start && tse_end->next == tse_start); - *queue = NULL; - } - else { - if (*queue == tse_start) - *queue = tse_end->next; - tse_end->next->prev = tse_start->prev; - tse_start->prev->next = tse_end->next; - } -} - static void event_wait(struct ethr_mutex_base_ *mtxb, ethr_ts_event *tse, @@ -1244,7 +1249,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) return 0; } -#else +#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) /* -- pthread mutex and condition variables -------------------------------- */ int @@ -1261,6 +1266,12 @@ ethr_mutex_init(ethr_mutex *mtx) } int +ethr_mutex_init_opt(ethr_mutex *mtx, ethr_mutex_opt *opt) +{ + return ethr_mutex_init(mtx); +} + +int ethr_mutex_destroy(ethr_mutex *mtx) { #if ETHR_XCHK @@ -1293,6 +1304,12 @@ ethr_cond_init(ethr_cond *cnd) } int +ethr_cond_init_opt(ethr_cond *cnd, ethr_cond_opt *opt) +{ + return ethr_cond_init(cnd); +} + +int ethr_cond_destroy(ethr_cond *cnd) { #if ETHR_XCHK @@ -1354,7 +1371,388 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) return res; } -#endif /* pthread_mutex */ +#elif defined(ETHR_WIN32_THREADS) || defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) + +/* + * As of Vista/Server, 2008 Windows has condition variables that can be + * used with critical sections. However, we need to be able to run on + * older Windows versions too, so we need to implement condition variables + * ourselves. + */ + +#ifdef ETHR_DBG_WIN_MTX_WITH_PTHREADS +/* + * For debugging of this implementation on POSIX platforms... + */ + +#define ethr_win_get_errno__() EINVAL +#if defined(__GNUC__) +#define __forceinline __inline__ +#else +#define __forceinline +#endif + +static int +InitializeCriticalSectionAndSpinCount(CRITICAL_SECTION *cs, int sc) +{ + return 0 == pthread_mutex_init((pthread_mutex_t *) cs, NULL); +} + +static void DeleteCriticalSection(CRITICAL_SECTION *cs) +{ + int res = pthread_mutex_destroy((pthread_mutex_t *) cs); + if (res != 0) + ETHR_FATAL_ERROR__(res); +} + +int TryEnterCriticalSection(CRITICAL_SECTION *cs) +{ + int res; + res = pthread_mutex_trylock((pthread_mutex_t *) cs); + if (res != 0 && res != EBUSY) + ETHR_FATAL_ERROR__(res); + return res == 0; +} + +void EnterCriticalSection(CRITICAL_SECTION *cs) +{ + int res = pthread_mutex_lock((pthread_mutex_t *) cs); + if (res != 0) + ETHR_FATAL_ERROR__(res); +} + +void LeaveCriticalSection(CRITICAL_SECTION *cs) +{ + int res = pthread_mutex_unlock((pthread_mutex_t *) cs); + if (res != 0) + ETHR_FATAL_ERROR__(res); +} + +#endif + +#define ETHR_CND_WAIT__ ((ethr_sint32_t) 0x11dead11) +#define ETHR_CND_WAKEUP__ ((ethr_sint32_t) 0x11beef11) + +static __forceinline void +cond_wakeup(ethr_ts_event *tse) +{ + ETHR_ASSERT(ethr_atomic32_read(&tse->uaflgs) == ETHR_CND_WAIT__); + + ethr_atomic32_set_relb(&tse->uaflgs, ETHR_CND_WAKEUP__); + ethr_event_set(&tse->event); +} + +void +ethr_mutex_cond_wakeup__(ethr_mutex *mtx) +{ + /* + * Called by ethr_mutex_unlock() when we have + * cond signal/broadcast wakeups waiting to + * be completed. + */ + ethr_ts_event *tse; + + if (!mtx->posix_compliant) { + tse = mtx->wakeups; + dequeue(&mtx->wakeups, tse, tse); + } + else { + ethr_spin_lock(&mtx->lock); + tse = mtx->wakeups; + if (tse) + dequeue(&mtx->wakeups, tse, tse); + if (!mtx->wakeups) + ethr_atomic32_set_relb(&mtx->have_wakeups, 0); + ethr_spin_unlock(&mtx->lock); + } + + LeaveCriticalSection(&mtx->cs); + + ETHR_ASSERT(tse || mtx->posix_compliant); + + /* + * We delay actual condition variable wakeup until + * this point when we have left the critical section. + * This in order to avoid that the other thread is + * woken and then right away have to go to sleep + * waiting for the critical section that we are in. + * + * We also only wake one thread at a time even if + * there are multiple threads waiting to be woken. + * Otherwise all but one will be woken and then right + * away have to go to sleep on the critical section. + * Since each wakeup is guaranteed to generate at + * least one lock/unlock sequence on this mutex, all + * threads will eventually be woken. + */ + + if (tse) + cond_wakeup(tse); +} + +int +ethr_mutex_init_opt(ethr_mutex *mtx, ethr_mutex_opt *opt) +{ + int spincount; +#if ETHR_XCHK + if (!mtx) { + ETHR_ASSERT(0); + return EINVAL; + } + mtx->initialized = ETHR_MUTEX_INITIALIZED; +#endif + + spincount = opt ? opt->aux_spincount : 0; + if (spincount < 0) + spincount = 0; + + if (!InitializeCriticalSectionAndSpinCount(&mtx->cs, spincount)) { +#if ETHR_XCHK + mtx->initialized = 0; +#endif + return ethr_win_get_errno__(); + } + + mtx->posix_compliant = opt ? opt->posix_compliant : 0; + mtx->wakeups = NULL; + if (mtx->posix_compliant) { + ethr_atomic32_init(&mtx->locked, 0); + ethr_atomic32_init(&mtx->have_wakeups, 0); + ethr_spinlock_init(&mtx->lock); + } + return 0; +} + +int +ethr_mutex_init(ethr_mutex *mtx) +{ + return ethr_mutex_init_opt(mtx, NULL); +} + +int +ethr_mutex_destroy(ethr_mutex *mtx) +{ + DeleteCriticalSection(&mtx->cs); + if (mtx->posix_compliant) + return ethr_spinlock_destroy(&mtx->lock); + else + return 0; +} + +int +ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) +{ + void *udata; + ethr_ts_event *tse = ethr_get_ts_event(); + int spincount; + + udata = tse->udata; + tse->udata = (void *) mtx; + ethr_atomic32_set_relb(&tse->uaflgs, ETHR_CND_WAIT__); + + EnterCriticalSection(&cnd->cs); + enqueue(&cnd->waiters, tse, tse); + LeaveCriticalSection(&cnd->cs); + + ethr_mutex_unlock(mtx); + + spincount = cnd->spincount; + + while (ethr_atomic32_read_acqb(&tse->uaflgs) != ETHR_CND_WAKEUP__) { + ethr_event_reset(&tse->event); + if (ethr_atomic32_read_acqb(&tse->uaflgs) == ETHR_CND_WAKEUP__) + break; + ethr_event_swait(&tse->event, spincount); + spincount = 0; + } + + tse->udata = udata; + ethr_leave_ts_event(tse); + + ethr_mutex_lock(mtx); + + return 0; +} + +static __forceinline void +posix_compliant_mtx_enqueue(ethr_mutex *mtx, + ethr_ts_event *tse_start, + ethr_ts_event *tse_end) +{ + ethr_ts_event *tse_wakeup = NULL; /* Avoid erroneous compiler warning... */ + /* + * The associated mutex might not be locked, so we need to + * check if it is. If locked, enqueue for wakeup at unlock; + * otherwise, wakeup the first one now and enqueue the rest. + */ + if (tse_start == tse_end && !ethr_atomic32_read(&mtx->locked)) { + tse_wakeup = tse_start; + wakeup: + cond_wakeup(tse_wakeup); + } + else { + int need_wakeup; + ethr_spin_lock(&mtx->lock); + if (!mtx->wakeups) + ethr_atomic32_set_mb(&mtx->have_wakeups, 1); + need_wakeup = !ethr_atomic32_read(&mtx->locked); + if (need_wakeup) { + if (tse_start == tse_end) { + if (!mtx->wakeups) + ethr_atomic32_set_relb(&mtx->have_wakeups, 0); + ethr_spin_unlock(&mtx->lock); + tse_wakeup = tse_start; + goto wakeup; + } + tse_wakeup = tse_start; + tse_start = tse_start->next; + } + enqueue(&mtx->wakeups, tse_start, tse_end); + ethr_spin_unlock(&mtx->lock); + if (need_wakeup) + goto wakeup; + } +} + +static __forceinline void +enqueue_cond_wakeups(ethr_ts_event *queue, int posix_compliant) +{ + if (queue) { + int more; + ethr_ts_event *q = queue; + + /* + * Waiters may be using different mutexes... + */ + + do { + ethr_mutex *mtx; + ethr_ts_event *tse, *tse_start, *tse_end; + + more = 0; + tse_start = q; + mtx = (ethr_mutex *) tse_start->udata; + + ETHR_ASSERT(posix_compliant + ? mtx->posix_compliant + : !mtx->posix_compliant); + + ETHR_ASSERT(ethr_atomic32_read(&tse_start->uaflgs) + == ETHR_CND_WAIT__); + ETHR_ASSERT(mtx->initialized == ETHR_MUTEX_INITIALIZED); + + tse_end = tse_start->prev; + + for (tse = tse_start->next; tse != tse_start; tse = tse->next) { + + ETHR_ASSERT(ethr_atomic32_read(&tse->uaflgs) + == ETHR_CND_WAIT__); + + if (mtx != (ethr_mutex *) tse->udata) { + tse_end = tse->prev; + dequeue(&q, tse_start, tse_end); + more = 1; + break; + } + } + + if (posix_compliant) + posix_compliant_mtx_enqueue(mtx, tse_start, tse_end); + else + enqueue(&mtx->wakeups, tse_start, tse_end); + + } while (more); + } +} + +void +ethr_cond_broadcast(ethr_cond *cnd) +{ + ethr_ts_event *waiters; + + EnterCriticalSection(&cnd->cs); + waiters = cnd->waiters; + cnd->waiters = NULL; + LeaveCriticalSection(&cnd->cs); + + if (cnd->posix_compliant) + enqueue_cond_wakeups(waiters, 1); + else + enqueue_cond_wakeups(waiters, 0); +} + +void +ethr_cond_signal(ethr_cond *cnd) +{ + ethr_mutex *mtx; + ethr_ts_event *tse; + + EnterCriticalSection(&cnd->cs); + tse = cnd->waiters; + if (tse) + dequeue(&cnd->waiters, tse, tse); + LeaveCriticalSection(&cnd->cs); + + if (tse) { + mtx = (ethr_mutex *) tse->udata; + + ETHR_ASSERT(ethr_atomic32_read(&tse->uaflgs) == ETHR_CND_WAIT__); + ETHR_ASSERT(mtx->initialized == ETHR_MUTEX_INITIALIZED); + ETHR_ASSERT(cnd->posix_compliant + ? mtx->posix_compliant + : !mtx->posix_compliant); + + if (cnd->posix_compliant) + posix_compliant_mtx_enqueue(mtx, tse, tse); + else + enqueue(&mtx->wakeups, tse, tse); + } +} + +int +ethr_cond_init_opt(ethr_cond *cnd, ethr_cond_opt *opt) +{ + int spincount; + +#if ETHR_XCHK + if (!cnd) { + ETHR_ASSERT(0); + return EINVAL; + } + cnd->initialized = ETHR_COND_INITIALIZED; +#endif + + spincount = opt ? opt->aux_spincount : 0; + if (spincount < 0) + spincount = 0; + + if (!InitializeCriticalSectionAndSpinCount(&cnd->cs, spincount)) { +#if ETHR_XCHK + cnd->initialized = 0; +#endif + return ethr_win_get_errno__(); + } + + cnd->posix_compliant = opt ? opt->posix_compliant : 0; + cnd->waiters = NULL; + cnd->spincount = spincount; + return 0; +} + +int +ethr_cond_init(ethr_cond *cnd) +{ + return ethr_cond_init_opt(cnd, NULL); +} + +int +ethr_cond_destroy(ethr_cond *cnd) +{ + DeleteCriticalSection(&cnd->cs); + return 0; +} + +#endif /* -- Exported symbols of inline functions --------------------------------- */ @@ -1969,7 +2367,7 @@ dbg_unlock_wake(ethr_rwmutex *rwmtx, exp = have_w ? ETHR_RWMTX_W_FLG__ : 0; if (rwmtx->type != ETHR_RWMUTEX_TYPE_NORMAL) - imask = ETHR_RWMTX_R_PEND_UNLCK_MASK__; + imask = ETHR_RWMTX_R_PEND_UNLCK_MASK__|ETHR_RWMTX_R_ABRT_UNLCK_FLG__; else { #ifdef ETHR_RLOCK_WITH_INC_DEC imask = ETHR_RWMTX_RS_MASK__; diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex c7daf923c5..ffee1f489f 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex f704135ce8..dda24d4405 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 4adb3dedf2..37fd8bb832 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 09216fd9d8..e255cc803f 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 7ac18352c4..6227b562a1 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 78481e2b00..22c51c79c0 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex cad777b272..7e1a5d1fdb 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 44dd264346..ebf9f8e6d6 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index ff3633a3cc..e9a59a7aaf 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -40,6 +40,8 @@ -export([flush_monitor_message/2]). -export([set_cpu_topology/1, format_cpu_topology/1]). -export([await_proc_exit/3]). +-export([memory/0, memory/1]). +-export([alloc_info/1, alloc_sizes/1]). -deprecated([hash/2]). @@ -800,3 +802,405 @@ min(A, _) -> A. Maximum :: term(). max(A, B) when A < B -> B; max(A, _) -> A. + + +%% +%% erlang:memory/[0,1] +%% +%% NOTE! When updating these functions, make sure to also update +%% erts_memory() in $ERL_TOP/erts/emulator/beam/erl_alloc.c +%% + +-type memory_type() :: 'total' | 'processes' | 'processes_used' | 'system' | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets' | 'low' | 'maximum'. + +-define(CARRIER_ALLOCS, [mseg_alloc, sbmbc_alloc, sbmbc_low_alloc]). +-define(LOW_ALLOCS, [sbmbc_low_alloc, ll_low_alloc, std_low_alloc]). +-define(ALL_NEEDED_ALLOCS, (erlang:system_info(alloc_util_allocators) + -- ?CARRIER_ALLOCS)). + +-record(memory, {total = 0, + processes = 0, + processes_used = 0, + system = 0, + atom = 0, + atom_used = 0, + binary = 0, + code = 0, + ets = 0, + low = 0, + maximum = 0}). + +-spec memory() -> [{memory_type(), non_neg_integer()}]. +memory() -> + case aa_mem_data(au_mem_data(?ALL_NEEDED_ALLOCS)) of + notsup -> + erlang:error(notsup); + Mem -> + InstrTail = case Mem#memory.maximum of + 0 -> []; + _ -> [{maximum, Mem#memory.maximum}] + end, + Tail = case Mem#memory.low of + 0 -> InstrTail; + _ -> [{low, Mem#memory.low} | InstrTail] + end, + [{total, Mem#memory.total}, + {processes, Mem#memory.processes}, + {processes_used, Mem#memory.processes_used}, + {system, Mem#memory.system}, + {atom, Mem#memory.atom}, + {atom_used, Mem#memory.atom_used}, + {binary, Mem#memory.binary}, + {code, Mem#memory.code}, + {ets, Mem#memory.ets} | Tail] + end. + +-spec memory(memory_type()|[memory_type()]) -> non_neg_integer() | [{memory_type(), non_neg_integer()}]. +memory(Type) when is_atom(Type) -> + {AA, ALCU, ChkSup, BadArgZero} = need_mem_info(Type), + case get_mem_data(ChkSup, ALCU, AA) of + notsup -> + erlang:error(notsup, [Type]); + Mem -> + Value = get_memval(Type, Mem), + case {BadArgZero, Value} of + {true, 0} -> erlang:error(badarg, [Type]); + _ -> Value + end + end; +memory(Types) when is_list(Types) -> + {AA, ALCU, ChkSup, BadArgZeroList} = need_mem_info_list(Types), + case get_mem_data(ChkSup, ALCU, AA) of + notsup -> + erlang:error(notsup, [Types]); + Mem -> + case memory_result_list(Types, BadArgZeroList, Mem) of + badarg -> erlang:error(badarg, [Types]); + Result -> Result + end + end. + +memory_result_list([], [], _Mem) -> + []; +memory_result_list([T|Ts], [BAZ|BAZs], Mem) -> + case memory_result_list(Ts, BAZs, Mem) of + badarg -> badarg; + TVs -> + V = get_memval(T, Mem), + case {BAZ, V} of + {true, 0} -> badarg; + _ -> [{T, V}| TVs] + end + end. + +get_mem_data(true, AlcUAllocs, NeedAllocatedAreas) -> + case memory_is_supported() of + false -> notsup; + true -> get_mem_data(false, AlcUAllocs, NeedAllocatedAreas) + end; +get_mem_data(false, AlcUAllocs, NeedAllocatedAreas) -> + AlcUMem = case AlcUAllocs of + [] -> #memory{}; + _ -> + au_mem_data(AlcUAllocs) + end, + case NeedAllocatedAreas of + true -> aa_mem_data(AlcUMem); + false -> AlcUMem + end. + +need_mem_info_list([]) -> + {false, [], false, []}; +need_mem_info_list([T|Ts]) -> + {MAA, MALCU, MChkSup, MBadArgZero} = need_mem_info_list(Ts), + {AA, ALCU, ChkSup, BadArgZero} = need_mem_info(T), + {case AA of + true -> true; + _ -> MAA + end, + ALCU ++ (MALCU -- ALCU), + case ChkSup of + true -> true; + _ -> MChkSup + end, + [BadArgZero|MBadArgZero]}. + +need_mem_info(Type) when Type == total; + Type == system -> + {true, ?ALL_NEEDED_ALLOCS, false, false}; +need_mem_info(Type) when Type == processes; + Type == processes_used -> + {true, [eheap_alloc, fix_alloc], true, false}; +need_mem_info(Type) when Type == atom; + Type == atom_used; + Type == code -> + {true, [], true, false}; +need_mem_info(binary) -> + {false, [binary_alloc], true, false}; +need_mem_info(ets) -> + {true, [ets_alloc], true, false}; +need_mem_info(low) -> + LowAllocs = ?LOW_ALLOCS -- ?CARRIER_ALLOCS, + {_, _, FeatureList, _} = erlang:system_info(allocator), + AlcUAllocs = case LowAllocs -- FeatureList of + [] -> LowAllocs; + _ -> [] + end, + {false, AlcUAllocs, true, true}; +need_mem_info(maximum) -> + {true, [], true, true}; +need_mem_info(_) -> + {false, [], false, true}. + +get_memval(total, #memory{total = V}) -> V; +get_memval(processes, #memory{processes = V}) -> V; +get_memval(processes_used, #memory{processes_used = V}) -> V; +get_memval(system, #memory{system = V}) -> V; +get_memval(atom, #memory{atom = V}) -> V; +get_memval(atom_used, #memory{atom_used = V}) -> V; +get_memval(binary, #memory{binary = V}) -> V; +get_memval(code, #memory{code = V}) -> V; +get_memval(ets, #memory{ets = V}) -> V; +get_memval(low, #memory{low = V}) -> V; +get_memval(maximum, #memory{maximum = V}) -> V; +get_memval(_, #memory{}) -> 0. + +memory_is_supported() -> + {_, _, FeatureList, _} = erlang:system_info(allocator), + case ((erlang:system_info(alloc_util_allocators) + -- ?CARRIER_ALLOCS) + -- FeatureList) of + [] -> true; + _ -> false + end. + +get_blocks_size([{blocks_size, Sz, _, _} | Rest], Acc) -> + get_blocks_size(Rest, Acc+Sz); +get_blocks_size([{_, _, _, _} | Rest], Acc) -> + get_blocks_size(Rest, Acc); +get_blocks_size([], Acc) -> + Acc. + +blocks_size([{Carriers, SizeList} | Rest], Acc) when Carriers == mbcs; + Carriers == sbcs; + Carriers == sbmbcs -> + blocks_size(Rest, get_blocks_size(SizeList, Acc)); +blocks_size([_ | Rest], Acc) -> + blocks_size(Rest, Acc); +blocks_size([], Acc) -> + Acc. + +get_fix_proc([{ProcType, A1, U1}| Rest], {A0, U0}) when ProcType == proc; + ProcType == monitor_sh; + ProcType == nlink_sh; + ProcType == msg_ref -> + get_fix_proc(Rest, {A0+A1, U0+U1}); +get_fix_proc([_|Rest], Acc) -> + get_fix_proc(Rest, Acc); +get_fix_proc([], Acc) -> + Acc. + +fix_proc([{fix_types, SizeList} | _Rest], Acc) -> + get_fix_proc(SizeList, Acc); +fix_proc([_ | Rest], Acc) -> + fix_proc(Rest, Acc); +fix_proc([], Acc) -> + Acc. + +is_low_alloc(_A, []) -> + false; +is_low_alloc(A, [A|_As]) -> + true; +is_low_alloc(A, [_A|As]) -> + is_low_alloc(A, As). + +is_low_alloc(A) -> + is_low_alloc(A, ?LOW_ALLOCS). + +au_mem_data(notsup, _) -> + notsup; +au_mem_data(_, [{_, false} | _]) -> + notsup; +au_mem_data(#memory{total = Tot, + processes = Proc, + processes_used = ProcU} = Mem, + [{eheap_alloc, _, Data} | Rest]) -> + Sz = blocks_size(Data, 0), + au_mem_data(Mem#memory{total = Tot+Sz, + processes = Proc+Sz, + processes_used = ProcU+Sz}, + Rest); +au_mem_data(#memory{total = Tot, + system = Sys, + ets = Ets} = Mem, + [{ets_alloc, _, Data} | Rest]) -> + Sz = blocks_size(Data, 0), + au_mem_data(Mem#memory{total = Tot+Sz, + system = Sys+Sz, + ets = Ets+Sz}, + Rest); +au_mem_data(#memory{total = Tot, + system = Sys, + binary = Bin} = Mem, + [{binary_alloc, _, Data} | Rest]) -> + Sz = blocks_size(Data, 0), + au_mem_data(Mem#memory{total = Tot+Sz, + system = Sys+Sz, + binary = Bin+Sz}, + Rest); +au_mem_data(#memory{total = Tot, + processes = Proc, + processes_used = ProcU, + system = Sys} = Mem, + [{fix_alloc, _, Data} | Rest]) -> + {A, U} = fix_proc(Data, {0, 0}), + Sz = blocks_size(Data, 0), + au_mem_data(Mem#memory{total = Tot+Sz, + processes = Proc+A, + processes_used = ProcU+U, + system = Sys+Sz-A}, + Rest); +au_mem_data(#memory{total = Tot, + system = Sys, + low = Low} = Mem, + [{A, _, Data} | Rest]) -> + Sz = blocks_size(Data, 0), + au_mem_data(Mem#memory{total = Tot+Sz, + system = Sys+Sz, + low = case is_low_alloc(A) of + true -> Low+Sz; + false -> Low + end}, + Rest); +au_mem_data(EMD, []) -> + EMD. + +au_mem_data(Allocs) -> + Ref = make_ref(), + erlang:system_info({allocator_sizes, Ref, Allocs}), + receive_emd(Ref). + +receive_emd(_Ref, EMD, 0) -> + EMD; +receive_emd(Ref, EMD, N) -> + receive + {Ref, _, Data} -> + receive_emd(Ref, au_mem_data(EMD, Data), N-1) + end. + +receive_emd(Ref) -> + receive_emd(Ref, #memory{}, erlang:system_info(schedulers)). + +aa_mem_data(notsup, _) -> + notsup; +aa_mem_data(#memory{} = Mem, + [{maximum, Max} | Rest]) -> + aa_mem_data(Mem#memory{maximum = Max}, + Rest); +aa_mem_data(#memory{} = Mem, + [{total, Tot} | Rest]) -> + aa_mem_data(Mem#memory{total = Tot, + system = 0}, % system will be adjusted later + Rest); +aa_mem_data(#memory{atom = Atom, + atom_used = AtomU} = Mem, + [{atom_space, Alloced, Used} | Rest]) -> + aa_mem_data(Mem#memory{atom = Atom+Alloced, + atom_used = AtomU+Used}, + Rest); +aa_mem_data(#memory{atom = Atom, + atom_used = AtomU} = Mem, + [{atom_table, Sz} | Rest]) -> + aa_mem_data(Mem#memory{atom = Atom+Sz, + atom_used = AtomU+Sz}, + Rest); +aa_mem_data(#memory{ets = Ets} = Mem, + [{ets_misc, Sz} | Rest]) -> + aa_mem_data(Mem#memory{ets = Ets+Sz}, + Rest); +aa_mem_data(#memory{processes = Proc, + processes_used = ProcU, + system = Sys} = Mem, + [{ProcData, Sz} | Rest]) when ProcData == bif_timer; + ProcData == link_lh; + ProcData == process_table -> + aa_mem_data(Mem#memory{processes = Proc+Sz, + processes_used = ProcU+Sz, + system = Sys-Sz}, + Rest); +aa_mem_data(#memory{code = Code} = Mem, + [{CodeData, Sz} | Rest]) when CodeData == module_table; + CodeData == export_table; + CodeData == export_list; + CodeData == fun_table; + CodeData == module_refs; + CodeData == loaded_code -> + aa_mem_data(Mem#memory{code = Code+Sz}, + Rest); +aa_mem_data(EMD, [{_, _} | Rest]) -> + aa_mem_data(EMD, Rest); +aa_mem_data(#memory{total = Tot, + processes = Proc, + system = Sys} = Mem, + []) when Sys =< 0 -> + %% Instrumented runtime system -> Sys = Tot - Proc + Mem#memory{system = Tot - Proc}; +aa_mem_data(EMD, []) -> + EMD. + +aa_mem_data(notsup) -> + notsup; +aa_mem_data(EMD) -> + aa_mem_data(EMD, erlang:system_info(allocated_areas)). + +%% +%% alloc_info/1 and alloc_sizes/1 are for internal use only (used by +%% erlang:system_info({allocator|allocator_sizes, _})). +%% + +alloc_info(Allocs) -> + get_alloc_info(allocator, Allocs). + +alloc_sizes(Allocs) -> + get_alloc_info(allocator_sizes, Allocs). + +get_alloc_info(Type, AAtom) when is_atom(AAtom) -> + [{AAtom, Result}] = get_alloc_info(Type, [AAtom]), + Result; +get_alloc_info(Type, AList) when is_list(AList) -> + Ref = make_ref(), + erlang:system_info({Type, Ref, AList}), + receive_allocator(Ref, + erlang:system_info(schedulers), + mk_res_list(AList)). + +mk_res_list([]) -> + []; +mk_res_list([Alloc | Rest]) -> + [{Alloc, []} | mk_res_list(Rest)]. + +insert_instance(I, N, []) -> + [{instance, N, I}]; +insert_instance(I, N, [{instance, M, _}|_] = Rest) when N < M -> + [{instance, N, I} | Rest]; +insert_instance(I, N, [Prev|Rest]) -> + [Prev | insert_instance(I, N, Rest)]. + +insert_info([], Ys) -> + Ys; +insert_info([{A, false}|Xs], [{A, _IList}|Ys]) -> + insert_info(Xs, [{A, false}|Ys]); +insert_info([{A, N, I}|Xs], [{A, IList}|Ys]) -> + insert_info(Xs, [{A, insert_instance(I, N, IList)}|Ys]); +insert_info([{A1, _}|_] = Xs, [{A2, _} = Y | Ys]) when A1 /= A2 -> + [Y | insert_info(Xs, Ys)]; +insert_info([{A1, _, _}|_] = Xs, [{A2, _} = Y | Ys]) when A1 /= A2 -> + [Y | insert_info(Xs, Ys)]. + +receive_allocator(_Ref, 0, Acc) -> + Acc; +receive_allocator(Ref, N, Acc) -> + receive + {Ref, _, InfoList} -> + receive_allocator(Ref, N-1, insert_info(InfoList, Acc)) + end. diff --git a/lib/asn1/test/asn1_SUITE_data/DirectoryAbstractService.asn b/lib/asn1/test/asn1_SUITE_data/DirectoryAbstractService.asn index 5a5d310729..5a5d310729 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/DirectoryAbstractService.asn +++ b/lib/asn1/test/asn1_SUITE_data/DirectoryAbstractService.asn diff --git a/lib/asn1/test/asn1_SUITE_data/InformationFramework.asn b/lib/asn1/test/asn1_SUITE_data/InformationFramework.asn index ef236e98a9..ef236e98a9 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/InformationFramework.asn +++ b/lib/asn1/test/asn1_SUITE_data/InformationFramework.asn diff --git a/lib/asn1/test/asn1_SUITE_data/LDAP.asn1 b/lib/asn1/test/asn1_SUITE_data/LDAP.asn1 index 4d845942e1..4d845942e1 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/LDAP.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/LDAP.asn1 diff --git a/lib/asn1/test/asn1_SUITE_data/Nortel.asn b/lib/asn1/test/asn1_SUITE_data/Nortel.asn index a27c78a0b5..a27c78a0b5 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/Nortel.asn +++ b/lib/asn1/test/asn1_SUITE_data/Nortel.asn diff --git a/lib/asn1/test/asn1_SUITE_data/UpperBounds.asn b/lib/asn1/test/asn1_SUITE_data/UpperBounds.asn index 247260495b..247260495b 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/UpperBounds.asn +++ b/lib/asn1/test/asn1_SUITE_data/UpperBounds.asn diff --git a/lib/asn1/test/asn1_SUITE_data/UsefulDefinitions.asn b/lib/asn1/test/asn1_SUITE_data/UsefulDefinitions.asn index d9601bb7d0..d9601bb7d0 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/UsefulDefinitions.asn +++ b/lib/asn1/test/asn1_SUITE_data/UsefulDefinitions.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-CommonDataTypes.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-CommonDataTypes.asn index e3f6e83d6b..e3f6e83d6b 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-CommonDataTypes.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-CommonDataTypes.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Constants.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Constants.asn index 1411d455b7..1411d455b7 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Constants.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Constants.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Containers.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Containers.asn index fb08451103..fb08451103 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Containers.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-Containers.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-IEs.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-IEs.asn index 848d8f6099..848d8f6099 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-IEs.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-IEs.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Contents.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Contents.asn index 9ecfa688a2..9ecfa688a2 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Contents.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Contents.asn diff --git a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn index b9be9934e4..b9be9934e4 100755..100644 --- a/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn +++ b/lib/asn1/test/asn1_SUITE_data/nbapsystem/NBAP-PDU-Discriptions.asn diff --git a/lib/common_test/doc/src/filestruct.gif b/lib/common_test/doc/src/filestruct.gif Binary files differindex 2b06833d0b..2b06833d0b 100755..100644 --- a/lib/common_test/doc/src/filestruct.gif +++ b/lib/common_test/doc/src/filestruct.gif diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 6e63c4d0f2..4a9c12dfea 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -146,8 +146,10 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> Essentials0 = [AtomChunk,CodeChunk,StringChunk,ImportChunk, ExpChunk,LambdaChunk,LiteralChunk], - Essentials = [iolist_to_binary(C) || C <- Essentials0], - {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, Essentials), + Essentials1 = [iolist_to_binary(C) || C <- Essentials0], + MD5 = module_md5(Essentials1), + Essentials = finalize_fun_table(Essentials1, MD5), + {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, MD5), AttrChunk = chunk(<<"Attr">>, Attributes), CompileChunk = chunk(<<"CInf">>, Compile), @@ -166,6 +168,24 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> end, build_form(<<"BEAM">>, Chunks). +%% 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 +%% unique value. + +finalize_fun_table(Essentials, MD5) -> + [finalize_fun_table_1(E, MD5) || E <- Essentials]. + +finalize_fun_table_1(<<"FunT",Keep:8/binary,Table0/binary>>, MD5) -> + <<Uniq:27,_:101/bits>> = MD5, + Table = finalize_fun_table_2(Table0, Uniq, <<>>), + <<"FunT",Keep/binary,Table/binary>>; +finalize_fun_table_1(Chunk, _) -> Chunk. + +finalize_fun_table_2(<<Keep:20/binary,0:32,T/binary>>, Uniq, Acc) -> + finalize_fun_table_2(T, Uniq, <<Acc/binary,Keep/binary,Uniq:32>>); +finalize_fun_table_2(<<>>, _, Acc) -> Acc. + %% Build an IFF form. build_form(Id, Chunks0) when byte_size(Id) =:= 4, is_list(Chunks0) -> @@ -202,7 +222,7 @@ flatten_exports(Exps) -> flatten_imports(Imps) -> list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)). -build_attributes(Opts, SourceFile, Attr, Essentials) -> +build_attributes(Opts, SourceFile, Attr, MD5) -> Misc = case member(slim, Opts) of false -> {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), @@ -210,7 +230,7 @@ build_attributes(Opts, SourceFile, Attr, Essentials) -> true -> [] end, Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], - {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}. + {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}. build_line_table(Dict) -> {NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} = @@ -243,32 +263,30 @@ encode_line_items([], _) -> []. %% We'll not change an existing 'vsn' attribute. %% -calc_vsn(Attr, Essentials0) -> +set_vsn_attribute(Attr, MD5) -> case keymember(vsn, 1, Attr) of true -> Attr; false -> - Essentials = filter_essentials(Essentials0), - <<Number:128>> = erlang:md5(Essentials), + <<Number:128>> = MD5, [{vsn,[Number]}|Attr] end. +module_md5(Essentials0) -> + Essentials = filter_essentials(Essentials0), + erlang:md5(Essentials). + %% filter_essentials([Chunk]) -> [Chunk'] %% Filter essentials so that we obtain the same MD5 as code:module_md5/1 and -%% beam_lib:md5/1 would calculate for this module. +%% beam_lib:md5/1 would calculate for this module. Note that at this +%% point, the 'old_uniq' entry for each fun in the 'FunT' chunk is zeroed, +%% so there is no need to go through the 'FunT' chunk. -filter_essentials([<<"FunT",_Sz:4/binary,Entries:4/binary,Table0/binary>>|T]) -> - Table = filter_funtab(Table0, <<0:32>>), - [Entries,Table|filter_essentials(T)]; filter_essentials([<<_Tag:4/binary,Sz:32,Data:Sz/binary,_Padding/binary>>|T]) -> [Data|filter_essentials(T)]; filter_essentials([<<>>|T]) -> filter_essentials(T); filter_essentials([]) -> []. -filter_funtab(<<Important:20/binary,_OldUniq:4/binary,T/binary>>, Zero) -> - [Important,Zero|filter_funtab(T, Zero)]; -filter_funtab(<<>>, _) -> []. - bif_type(fnegate, 1) -> {op,fnegate}; bif_type(fadd, 2) -> {op,fadd}; bif_type(fsub, 2) -> {op,fsub}; @@ -310,8 +328,8 @@ make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail|Ops], Dict); make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail,Op,Live|Ops++[Dst]], Dict); -make_op({make_fun2,{f,Lbl},Index,OldUniq,NumFree}, Dict0) -> - {Fun,Dict} = beam_dict:lambda(Lbl, Index, OldUniq, NumFree, Dict0), +make_op({make_fun2,{f,Lbl},_Index,_OldUniq,NumFree}, Dict0) -> + {Fun,Dict} = beam_dict:lambda(Lbl, NumFree, Dict0), make_op({make_fun2,Fun}, Dict); make_op({kill,Y}, Dict) -> make_op({init,Y}, Dict); diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index ee76623976..531968b3c8 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -22,7 +22,7 @@ -export([new/0,opcode/2,highest_opcode/1, atom/2,local/4,export/4,import/4, - string/2,lambda/5,literal/2,line/2,fname/2, + string/2,lambda/3,literal/2,line/2,fname/2, atom_table/1,local_table/1,export_table/1,import_table/1, string_table/1,lambda_table/1,literal_table/1, line_table/1]). @@ -133,13 +133,18 @@ string(Str, Dict) when is_list(Str) -> {NextOffset-Offset,Dict} end. -%% Returns the index for a funentry (adding it to the table if necessary). -%% lambda(Lbl, Index, Uniq, NumFree, Dict) -> {Index,Dict'} --spec lambda(label(), non_neg_integer(), integer(), non_neg_integer(), bdict()) -> +%% Returns the index for a fun entry. +%% lambda(Lbl, NumFree, Dict) -> {Index,Dict'} +-spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, Index, OldUniq, NumFree, #asm{lambdas=Lambdas0}=Dict) -> +lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) -> OldIndex = length(Lambdas0), + %% Set Index the same as OldIndex. + Index = OldIndex, + %% Initialize OldUniq to 0. It will be set to an unique value + %% based on the MD5 checksum of the BEAM code for the module. + OldUniq = 0, Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], {OldIndex,Dict#asm{lambdas=Lambdas}}. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 7fdb8d072a..0c51251f1b 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -168,6 +168,8 @@ simplify_float_1([{set,[D0],[A,B],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Ts0, simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> Acc = flush_all(Rs0, Is0, Acc0), simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); +simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, [I|Acc]); simplify_float_1([I|Is]=Is0, Ts0, Rs0, Acc0) -> Ts = update(I, Ts0), {Rs,Acc} = flush(Rs0, Is0, Acc0), diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 0fa1fea09f..ba9cde1de0 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -31,8 +31,6 @@ -import(ordsets, [from_list/1,add_element/2,union/2]). -import(lists, [member/2,foldl/3,foldr/3]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). - -include("../include/erl_bits.hrl"). -record(expand, {module=[], %Module name @@ -49,7 +47,6 @@ func=[], %Current function arity=[], %Arity for current function fcount=0, %Local fun count - fun_index=0, %Global index for funs bitdefault, bittypes }). @@ -538,32 +535,34 @@ lc_tq(_Line, [], St0) -> %% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an %% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the %% name of a BIF (erl_lint has checked that it is not an import). -%% Process the body sequence directly to get the new and used variables. %% "Implicit" funs {'fun', Line, {function, F, A}} are not changed. fun_tq(Lf, {function,F,A}=Function, St0) -> - {As,St1} = new_vars(A, Lf, St0), - Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], case erl_internal:bif(F, A) of true -> + {As,St1} = new_vars(A, Lf, St0), + Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], fun_tq(Lf, {clauses,Cs}, St1); false -> - Index = St0#expand.fun_index, - Uniq = erlang:hash(Cs, (1 bsl 27)-1), - {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,Function,{Index,Uniq,Fname}}, - St2#expand{fun_index=Index+1}} + {Fname,St1} = new_fun_name(St0), + Index = Uniq = 0, + {{'fun',Lf,Function,{Index,Uniq,Fname}},St1} end; -fun_tq(L, {function,M,F,A}, St) -> - {{call,L,{remote,L,{atom,L,erlang},{atom,L,make_fun}}, - [{atom,L,M},{atom,L,F},{integer,L,A}]},St}; +fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) -> + %% This is the old format for external funs, generated by a pre-R15 + %% compiler. That means that a tool, such as the debugger or xref, + %% directly invoked this module with the abstract code from a + %% pre-R15 BEAM file. Be helpful, and translate it to the new format. + fun_tq(L, {function,{atom,L,M},{atom,L,F},{integer,L,A}}, St); +fun_tq(Lf, {function,_,_,_}=ExtFun, St) -> + {{'fun',Lf,ExtFun},St}; fun_tq(Lf, {clauses,Cs0}, St0) -> - Uniq = erlang:hash(Cs0, (1 bsl 27)-1), {Cs1,St1} = fun_clauses(Cs0, St0), - Index = St1#expand.fun_index, {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}}, - St2#expand{fun_index=Index+1}}. + %% Set dummy values for Index and Uniq -- the real values will + %% be assigned by beam_asm. + Index = Uniq = 0, + {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> {H,St1} = head(H0, St0), diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 6f3590b156..6885405ae0 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -573,6 +573,13 @@ expr({'catch',L,E0}, St0) -> expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> Lanno = lineno_anno(L, St), {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St}; +expr({'fun',L,{function,M,F,A}}, St0) -> + {As,Aps,St1} = safe_list([M,F,A], St0), + Lanno = lineno_anno(L, St1), + {#icall{anno=#a{anno=Lanno}, + module=#c_literal{val=erlang}, + name=#c_literal{val=make_fun}, + args=As},Aps,St1}; expr({'fun',L,{clauses,Cs},Id}, St) -> fun_tq(Id, Cs, L, St); expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 4e06b464a4..47e5e49a76 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -84,8 +84,6 @@ keymember/3,keyfind/3]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). - -include("core_parse.hrl"). -include("v3_kernel.hrl"). @@ -1658,31 +1656,31 @@ uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> {Ns,St3} = new_vars(1 - length(Rs0), St2), Rs1 = Rs0 ++ Ns, {#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3}; -uexpr(#ifun{anno=A,vars=Vs,body=B0}=IFun, {break,Rs}, St0) -> +uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> {B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function Ns = lit_list_vars(Vs), Free = subtract(Bu, Ns), %Free variables in fun Fvs = make_vars(Free), Arity = length(Vs) + length(Free), - {{Index,Uniq,Fname}, St3} = + {Fname,St} = case lists:keyfind(id, 1, A) of - {id,Id} -> - {Id, St1}; + {id,{_,_,Fname0}} -> + {Fname0,St1}; false -> - %% No id annotation. Must invent one. - I = St1#kern.fcount, - U = erlang:hash(IFun, (1 bsl 27)-1), - {N, St2} = new_fun_name(St1), - {{I,U,N}, St2} + %% No id annotation. Must invent a fun name. + new_fun_name(St1) end, Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, vars=Vs ++ Fvs,body=B1}, + %% Set dummy values for Index and Uniq -- the real values will + %% be assigned by beam_asm. + Index = Uniq = 0, {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, op=#k_internal{name=make_fun,arity=length(Free)+3}, args=[#k_atom{val=Fname},#k_int{val=Arity}, #k_int{val=Index},#k_int{val=Uniq}|Fvs], ret=Rs}, - Free,add_local_function(Fun, St3)}; + Free,add_local_function(Fun, St)}; uexpr(Lit, {break,Rs}, St) -> %% Transform literals to puts here. %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 368a5815bf..6067ee8e06 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -20,7 +20,11 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1]). + test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1, + external/1]). + +%% Internal export. +-export([call_me/1]). -include_lib("test_server/include/test_server.hrl"). @@ -28,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [test1, overwritten_fun, otp_7202, bif_fun]. + [test1,overwritten_fun,otp_7202,bif_fun,external]. groups() -> []. @@ -45,7 +49,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - %%% The help functions below are copied from emulator:bs_construct_SUITE. -define(T(B, L), {B, ??B, L}). @@ -152,4 +155,47 @@ bif_fun(Config) when is_list(Config) -> ?line F = fun abs/1, ?line 5 = F(-5), ok. + +-define(APPLY(M, F, A), (fun(Fun) -> {ok,{a,b}} = Fun({a,b}) end)(fun M:F/A)). +-define(APPLY2(M, F, A), + (fun(Map) -> + Id = fun(I) -> I end, + List = [x,y], + List = Map(Id, List), + {type,external} = erlang:fun_info(Map, type) + end)(fun M:F/A)). +external(Config) when is_list(Config) -> + Mod = id(?MODULE), + Func = id(call_me), + Arity = id(1), + + ?APPLY(?MODULE, call_me, 1), + ?APPLY(?MODULE, call_me, Arity), + ?APPLY(?MODULE, Func, 1), + ?APPLY(?MODULE, Func, Arity), + ?APPLY(Mod, call_me, 1), + ?APPLY(Mod, call_me, Arity), + ?APPLY(Mod, Func, 1), + ?APPLY(Mod, Func, Arity), + + ListsMod = id(lists), + ListsMap = id(map), + ListsArity = id(2), + + ?APPLY2(lists, map, 2), + ?APPLY2(lists, map, ListsArity), + ?APPLY2(lists, ListsMap, 2), + ?APPLY2(lists, ListsMap, ListsArity), + ?APPLY2(ListsMod, map, 2), + ?APPLY2(ListsMod, map, ListsArity), + ?APPLY2(ListsMod, ListsMap, 2), + ?APPLY2(ListsMod, ListsMap, ListsArity), + + ok. + +call_me(I) -> + {ok,I}. + +id(I) -> + I. diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl index 9a317b5762..3d02adaf52 100644 --- a/lib/compiler/test/pmod_SUITE.erl +++ b/lib/compiler/test/pmod_SUITE.erl @@ -96,6 +96,10 @@ basic_1(Config, Opts) -> ?line error = Prop4:bar_bar({s,a,b}), ?line error = Prop4:bar_bar([]), + %% Call from a fun. + Fun = fun(Arg) -> Prop4:bar(Arg) end, + ?line ok = Fun({s,0}), + ok. otp_8447(Config) when is_list(Config) -> diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index df725ed9e5..2e88c35741 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -768,6 +768,21 @@ expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> end, {value,Fun,Bs}; +%% Construct an external fun. +expr({make_ext_fun,Line,MFA0}, Bs0, Ieval0) -> + {[M,F,A],Bs} = eval_list(MFA0, Bs0, Ieval0), + try erlang:make_fun(M, F, A) of + Value -> + {value,Value,Bs} + catch + error:badarg -> + Ieval1 = Ieval0#ieval{line=Line}, + Ieval2 = dbg_istk:push(Bs0, Ieval1, false), + Ieval = Ieval2#ieval{module=erlang,function=make_fun, + arguments=[M,F,A],line=-1}, + exception(error, badarg, Bs, Ieval, true) + end; + %% Common test adaptation expr({call_remote,0,ct_line,line,As0,Lc}, Bs0, Ieval0) -> {As,_Bs} = eval_list(As0, Bs0, Ieval0), diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index ce5631e45f..3c95ef8068 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -369,6 +369,14 @@ expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> As = new_vars(A, Line), Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], {make_fun,Line,Name,Cs}; +expr({'fun',Line,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) + when 0 =< A, A =< 255 -> + %% New format in R15 for fun M:F/A (literal values). + {value,Line,erlang:make_fun(M, F, A)}; +expr({'fun',Line,{function,M,F,A}}, _Lc) -> + %% New format in R15 for fun M:F/A (one or more variables). + MFA = expr_list([M,F,A]), + {make_ext_fun,Line,MFA}; expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> {dbg,Line,self,[]}; expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> diff --git a/lib/debugger/src/dbg_ui_break_win.erl b/lib/debugger/src/dbg_ui_break_win.erl index 4039bf785f..abbec158b0 100644 --- a/lib/debugger/src/dbg_ui_break_win.erl +++ b/lib/debugger/src/dbg_ui_break_win.erl @@ -81,12 +81,12 @@ create_win(GS, {X, Y}, function, Mod, _Line) -> {pack_x, 2}, {pack_y, 3}, {selectmode, multiple}]), - %% Add Ok and Cancel buttons - {Wbtn, Hbtn} = dbg_ui_win:min_size(["Ok","Cancel"], 70, 30), + %% Add OK and Cancel buttons + {Wbtn, Hbtn} = dbg_ui_win:min_size(["OK","Cancel"], 70, 30), Bot = gs:frame(Frm, [{pack_x, {1, 3}}, {pack_y, 4}]), - Ok = gs:button(Bot, [{x, Pad}, {y, Pad}, + OK = gs:button(Bot, [{x, Pad}, {y, Pad}, {width, Wbtn}, {height, Hbtn}, - {label, {text,"Ok"}}, {font, Font}]), + {label, {text,"OK"}}, {font, Font}]), Cancel = gs:button(Bot, [{x, W-Pad-Wbtn}, {y, Pad}, {width, Wbtn}, {height, Hbtn}, {label, {text,"Cancel"}}, {font, Font}]), @@ -95,7 +95,7 @@ create_win(GS, {X, Y}, function, Mod, _Line) -> gs:config(Win, [{width, Wfrm}, {height, Hfrm}, {map, true}]), #winInfo{type=function, win=Win, packer=Frm, entries=Entries, trigger=enable, - ok=Ok, cancel=Cancel, listbox=Lb, funcs=[]}; + ok=OK, cancel=Cancel, listbox=Lb, funcs=[]}; create_win(GS, {X, Y}, Type, Mod, Line) -> Pad = 8, W = 230, @@ -161,12 +161,12 @@ create_win(GS, {X, Y}, Type, Mod, Line) -> {align, w}, {group, Grp}, {data, {trigger, delete}}]), - %% Add Ok and Cancel buttons - {Wbtn, Hbtn} = dbg_ui_win:min_size(["Ok","Cancel"], 70, 30), + %% Add OK and Cancel buttons + {Wbtn, Hbtn} = dbg_ui_win:min_size(["OK","Cancel"], 70, 30), Ybtn = Yacc + Pad + Hfrm + Pad, - Ok = gs:button(Win, [{x, Pad}, {y, Ybtn}, + OK = gs:button(Win, [{x, Pad}, {y, Ybtn}, {width, Wbtn}, {height, Hbtn}, - {label, {text,"Ok"}}, {font, Font}]), + {label, {text,"OK"}}, {font, Font}]), gs:button(Win, [{x, W-Pad-Wbtn}, {y, Ybtn}, {width, Wbtn}, {height, Hbtn}, {label, {text,"Cancel"}}, {font, Font}]), @@ -175,7 +175,7 @@ create_win(GS, {X, Y}, Type, Mod, Line) -> gs:config(Win, [{width, W}, {height, Hwin}, {map, true}]), #winInfo{type=Type, win=Win, - entries=Entries, trigger=enable, ok=Ok}. + entries=Entries, trigger=enable, ok=OK}. %%-------------------------------------------------------------------- %% update_functions(WinInfo, Funcs) -> WinInfo @@ -229,7 +229,7 @@ handle_event({gs, LB, keypress, window, [Key|_]}, WinInfo) -> Key/='Tab', Key/='Return' -> ignore; true -> - handle_event({gs, LB, click, listbox, ["Ok"]}, WinInfo) + handle_event({gs, LB, click, listbox, ["OK"]}, WinInfo) end; handle_event({gs, Ent, keypress, Data, [Key|_]}, WinInfo) -> case WinInfo#winInfo.type of @@ -249,14 +249,14 @@ handle_event({gs, Ent, keypress, Data, [Key|_]}, WinInfo) -> case next_entry(Ent, WinInfo#winInfo.entries) of last -> gs:config(WinInfo#winInfo.ok, flash), - handle_event({gs, Ent, click, Data, ["Ok"]}, WinInfo); + handle_event({gs, Ent, click, Data, ["OK"]}, WinInfo); Next -> gs:config(Next, {setfocus, true}), ignore end; _Type -> ignore end; -handle_event({gs, _Id, click, _Data, ["Ok"|_]}, WinInfo) -> +handle_event({gs, _Id, click, _Data, ["OK"|_]}, WinInfo) -> case check_input(WinInfo#winInfo.entries) of error -> ignore; Data when WinInfo#winInfo.type/=function -> diff --git a/lib/debugger/src/dbg_ui_edit_win.erl b/lib/debugger/src/dbg_ui_edit_win.erl index badaf4bef4..82f784aa83 100644 --- a/lib/debugger/src/dbg_ui_edit_win.erl +++ b/lib/debugger/src/dbg_ui_edit_win.erl @@ -64,13 +64,13 @@ create_win(GS, {X, Y}, Title, Prompt, {Type, Value}) -> {text, Value}, {keypress, true}]), - %% Ok and Cancel buttons + %% OK and Cancel buttons W = Pad + Wlbl + Went + Pad, {Wbtn, Hbtn} = dbg_ui_win:min_size(["Cancel"], 70, 30), Ybtn = Pad + Hlbl + Pad, Btn = gs:button(Win, [{x, Pad}, {y, Ybtn}, {width, Wbtn}, {height, Hbtn}, - {label, {text,"Ok"}}, {font, Font}]), + {label, {text,"OK"}}, {font, Font}]), gs:button(Win, [{x, W-Pad-Wbtn}, {y, Ybtn}, {width, Wbtn}, {height, Hbtn}, {label, {text,"Cancel"}}, {font, Font}]), @@ -100,8 +100,8 @@ handle_event({gs, _Id, destroy, _Data, _Arg}, _WinInfo) -> stopped; handle_event({gs, Id, keypress, Data, ['Return'|_]}, WinInfo) -> gs:config(WinInfo#winInfo.button, flash), - handle_event({gs, Id, click, Data, ["Ok"]}, WinInfo); -handle_event({gs, _Id, click, _Data, ["Ok"|_]}, WinInfo) -> + handle_event({gs, Id, click, Data, ["OK"]}, WinInfo); +handle_event({gs, _Id, click, _Data, ["OK"|_]}, WinInfo) -> Ent = WinInfo#winInfo.entry, Str = gs:read(Ent, text), Type = WinInfo#winInfo.type, diff --git a/lib/debugger/src/dbg_ui_filedialog_win.erl b/lib/debugger/src/dbg_ui_filedialog_win.erl index 3203991c1f..1eced1104d 100644 --- a/lib/debugger/src/dbg_ui_filedialog_win.erl +++ b/lib/debugger/src/dbg_ui_filedialog_win.erl @@ -100,7 +100,7 @@ create_win(GS, Title, {X,Y}, Mode, Filter, Extra, FileName) -> Opts = [{y, Y4}, {width, Wbtn}, {height, Hbtn}, {font, Font}], case Mode of normal -> - gs:button(Win, [{label, {text,"Ok"}}, {x, Pad}, + gs:button(Win, [{label, {text,"OK"}}, {x, Pad}, {data, select} | Opts]), gs:button(Win, [{label, {text,"Filter"}}, {x, Wlb/2-Wbtn/2}, {data, filter} | Opts]), diff --git a/lib/debugger/src/dbg_ui_interpret.erl b/lib/debugger/src/dbg_ui_interpret.erl index 952e73b537..079eaeb634 100644 --- a/lib/debugger/src/dbg_ui_interpret.erl +++ b/lib/debugger/src/dbg_ui_interpret.erl @@ -145,7 +145,7 @@ interpret_all(State, Dir, [File0|Files]) -> Window = dbg_ui_filedialog_win:get_window(State#state.win), Error = format_error(int:interpretable(File)), Msg = ["Error when interpreting:", File, Error, - "Ok to continue?"], + "OK to continue?"], case tool_utils:confirm(Window, Msg) of ok -> interpret_all(State, Dir, Files); cancel -> true diff --git a/lib/debugger/src/dbg_ui_settings.erl b/lib/debugger/src/dbg_ui_settings.erl index 146aa7e239..38b2ec424f 100644 --- a/lib/debugger/src/dbg_ui_settings.erl +++ b/lib/debugger/src/dbg_ui_settings.erl @@ -136,8 +136,8 @@ default_settings_dir(GS) -> {ok, CWD} = file:get_cwd(), Msg = ["Default directory", DefDir, "does not exist.", - "Click Ok to create it or", - "Cancel to use other directory!"], + "Click OK to create it or", + "Cancel to use other directory."], case tool_utils:confirm(GS, Msg) of ok -> ToolsDir = filename:dirname(DefDir), diff --git a/lib/debugger/src/dbg_wx_break_win.erl b/lib/debugger/src/dbg_wx_break_win.erl index 7ac82c8fb4..062da3937a 100644 --- a/lib/debugger/src/dbg_wx_break_win.erl +++ b/lib/debugger/src/dbg_wx_break_win.erl @@ -82,8 +82,8 @@ create_win(Parent, Pos, function, Mod, _Line) -> wxComboBox:connect(Text, command_text_updated), wxListBox:connect(LB, command_listbox_selected), wxListBox:connect(LB, command_listbox_doubleclicked), - OkId = wxDialog:getAffirmativeId(Win), - OKButt = wxWindow:findWindowById(OkId, [{parent, Win}]), + OKId = wxDialog:getAffirmativeId(Win), + OKButt = wxWindow:findWindowById(OKId, [{parent, Win}]), wxWindow:disable(OKButt), wxDialog:centreOnParent(Win), wxDialog:show(Win), @@ -141,8 +141,8 @@ create_win(Parent, Pos, Type, Mod, Line) -> wxComboBox:setFocus(ModT), wxDialog:connect(Win, command_button_clicked), wxDialog:connect(Win, command_text_updated), - OkId = wxDialog:getAffirmativeId(Win), - OKButt = wxWindow:findWindowById(OkId), + OKId = wxDialog:getAffirmativeId(Win), + OKButt = wxWindow:findWindowById(OKId), wxWindow:disable(OKButt), wxDialog:centreOnParent(Win), wxDialog:show(Win), @@ -180,30 +180,30 @@ handle_event(#wx{id=?wxID_CANCEL}, #winInfo{win=Win}) -> wxDialog:destroy(Win), stopped; handle_event(#wx{event=#wxCommand{type=command_text_updated}}, - #winInfo{type=function, text=Text, ok=Ok}) -> + #winInfo{type=function, text=Text, ok=OK}) -> Module = wxComboBox:getValue(Text), - wxWindow:disable(Ok), + wxWindow:disable(OK), {module, list_to_atom(Module)}; handle_event(#wx{event=#wxCommand{type=command_text_updated}}, - #winInfo{text=Text, ok=Ok, entries=Es}) -> + #winInfo{text=Text, ok=OK, entries=Es}) -> Module = wxComboBox:getValue(Text), case check_input(Es) of - error -> wxWindow:disable(Ok); - _Data when Module =/= "" -> wxWindow:enable(Ok); - _ -> wxWindow:disable(Ok) + error -> wxWindow:disable(OK); + _Data when Module =/= "" -> wxWindow:enable(OK); + _ -> wxWindow:disable(OK) end, ignore; handle_event(#wx{event=#wxCommand{type=command_listbox_selected}}, - #winInfo{type=function, listbox=LB, ok=Ok}) -> + #winInfo{type=function, listbox=LB, ok=OK}) -> case wxListBox:getSelections(LB) of - {N,_} when N > 0 -> wxWindow:enable(Ok); - _ -> wxWindow:disable(Ok) + {N,_} when N > 0 -> wxWindow:enable(OK); + _ -> wxWindow:disable(OK) end, ignore; -handle_event(#wx{id=OKorListBox, event=#wxCommand{type=OkorDoubleClick}}, +handle_event(#wx{id=OKorListBox, event=#wxCommand{type=OKorDoubleClick}}, #winInfo{type=function,win=Win,listbox=LB,funcs=Funcs,text=Text}) when OKorListBox =:= ?wxID_OK; - OkorDoubleClick =:= command_listbox_doubleclicked -> + OKorDoubleClick =:= command_listbox_doubleclicked -> Mod = wxComboBox:getValue(Text), {_, IndexL} = wxListBox:getSelections(LB), Breaks = [[list_to_atom(Mod)|lists:nth(Index+1, Funcs)] || Index <- IndexL], diff --git a/lib/debugger/src/dbg_wx_filedialog_win.erl b/lib/debugger/src/dbg_wx_filedialog_win.erl index 9687efa981..9f45ad0c47 100644 --- a/lib/debugger/src/dbg_wx_filedialog_win.erl +++ b/lib/debugger/src/dbg_wx_filedialog_win.erl @@ -151,7 +151,7 @@ init([Parent, Id, Options0]) -> Bott = wxDialog:createButtonSizer(Dlg, ?wxCANCEL bor ?wxOK), wxDialog:connect(Dlg, command_button_clicked), - %% Ok done + %% OK done Box = wxBoxSizer:new(?wxVERTICAL), wxSizer:add(Box, Top, [{border, 2}, {flag,?wxALL bor ?wxEXPAND}]), wxSizer:add(Box, Dir, [{border, 2}, {flag,?wxALL bor ?wxEXPAND}]), diff --git a/lib/debugger/src/dbg_wx_settings.erl b/lib/debugger/src/dbg_wx_settings.erl index 8f87815949..bc88bdf7da 100644 --- a/lib/debugger/src/dbg_wx_settings.erl +++ b/lib/debugger/src/dbg_wx_settings.erl @@ -83,9 +83,9 @@ default_settings_dir(Win) -> false -> {ok, CWD} = file:get_cwd(), - Msg = ["Default directory", DefDir, "does not exist.", - "Click Ok to create it or", - "Cancel to use other directory!"], + Msg = ["Default directory ", DefDir, " does not exist. ", + "Click OK to create it or ", + "Cancel to use other directory."], case dbg_wx_win:confirm(Win, Msg) of ok -> ToolsDir = filename:dirname(DefDir), diff --git a/lib/debugger/src/dbg_wx_trace_win.erl b/lib/debugger/src/dbg_wx_trace_win.erl index 720b913024..720b913024 100755..100644 --- a/lib/debugger/src/dbg_wx_trace_win.erl +++ b/lib/debugger/src/dbg_wx_trace_win.erl diff --git a/lib/debugger/src/dbg_wx_winman.erl b/lib/debugger/src/dbg_wx_winman.erl index 79dcc47f6f..79dcc47f6f 100755..100644 --- a/lib/debugger/src/dbg_wx_winman.erl +++ b/lib/debugger/src/dbg_wx_winman.erl diff --git a/lib/debugger/test/fun_SUITE.erl b/lib/debugger/test/fun_SUITE.erl index 8103d9c692..a06cdc7165 100644 --- a/lib/debugger/test/fun_SUITE.erl +++ b/lib/debugger/test/fun_SUITE.erl @@ -24,8 +24,10 @@ init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, good_call/1,bad_apply/1,bad_fun_call/1,badarity/1, - ext_badarity/1,otp_6061/1]). --export([nothing/0]). + ext_badarity/1,otp_6061/1,external/1]). + +%% Internal exports. +-export([nothing/0,call_me/1]). -include_lib("test_server/include/test_server.hrl"). @@ -46,7 +48,7 @@ end_per_group(_GroupName, Config) -> cases() -> [good_call, bad_apply, bad_fun_call, badarity, - ext_badarity, otp_6061]. + ext_badarity, otp_6061, external]. init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), @@ -244,3 +246,47 @@ test_otp_6061(Starter) -> fun() -> Starter ! working end, fun() -> Starter ! not_working end], lists:foreach(fun(P)->(lists:nth(P,PassesF))() end,Passes). + +-define(APPLY(M, F, A), (fun(Fun) -> {ok,{a,b}} = Fun({a,b}) end)(fun M:F/A)). +-define(APPLY2(M, F, A), + (fun(Map) -> + Id = fun(I) -> I end, + List = [x,y], + List = Map(Id, List), + {type,external} = erlang:fun_info(Map, type) + end)(fun M:F/A)). + +external(Config) when is_list(Config) -> + Mod = id(?MODULE), + Func = id(call_me), + Arity = id(1), + + ?APPLY(?MODULE, call_me, 1), + ?APPLY(?MODULE, call_me, Arity), + ?APPLY(?MODULE, Func, 1), + ?APPLY(?MODULE, Func, Arity), + ?APPLY(Mod, call_me, 1), + ?APPLY(Mod, call_me, Arity), + ?APPLY(Mod, Func, 1), + ?APPLY(Mod, Func, Arity), + + ListsMod = id(lists), + ListsMap = id(map), + ListsArity = id(2), + + ?APPLY2(lists, map, 2), + ?APPLY2(lists, map, ListsArity), + ?APPLY2(lists, ListsMap, 2), + ?APPLY2(lists, ListsMap, ListsArity), + ?APPLY2(ListsMod, map, 2), + ?APPLY2(ListsMod, map, ListsArity), + ?APPLY2(ListsMod, ListsMap, 2), + ?APPLY2(ListsMod, ListsMap, ListsArity), + + ok. + +call_me(I) -> + {ok,I}. + +id(I) -> + I. diff --git a/lib/dialyzer/doc/src/Makefile b/lib/dialyzer/doc/src/Makefile index 45b0ffa5ff..45b0ffa5ff 100755..100644 --- a/lib/dialyzer/doc/src/Makefile +++ b/lib/dialyzer/doc/src/Makefile diff --git a/lib/dialyzer/doc/src/book.xml b/lib/dialyzer/doc/src/book.xml index 0b4e1cb617..0b4e1cb617 100755..100644 --- a/lib/dialyzer/doc/src/book.xml +++ b/lib/dialyzer/doc/src/book.xml diff --git a/lib/dialyzer/doc/src/fascicules.xml b/lib/dialyzer/doc/src/fascicules.xml index 0678195e07..0678195e07 100755..100644 --- a/lib/dialyzer/doc/src/fascicules.xml +++ b/lib/dialyzer/doc/src/fascicules.xml diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml index 17291b24f7..17291b24f7 100755..100644 --- a/lib/dialyzer/doc/src/notes.xml +++ b/lib/dialyzer/doc/src/notes.xml diff --git a/lib/dialyzer/doc/src/part.xml b/lib/dialyzer/doc/src/part.xml index 4410840660..4410840660 100755..100644 --- a/lib/dialyzer/doc/src/part.xml +++ b/lib/dialyzer/doc/src/part.xml diff --git a/lib/dialyzer/doc/src/part_notes.xml b/lib/dialyzer/doc/src/part_notes.xml index cb048d55dd..cb048d55dd 100755..100644 --- a/lib/dialyzer/doc/src/part_notes.xml +++ b/lib/dialyzer/doc/src/part_notes.xml diff --git a/lib/dialyzer/doc/src/ref_man.xml b/lib/dialyzer/doc/src/ref_man.xml index ca5410f6b8..ca5410f6b8 100755..100644 --- a/lib/dialyzer/doc/src/ref_man.xml +++ b/lib/dialyzer/doc/src/ref_man.xml diff --git a/lib/dialyzer/info b/lib/dialyzer/info index 9fba4b54ad..9fba4b54ad 100755..100644 --- a/lib/dialyzer/info +++ b/lib/dialyzer/info diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index bcdcf2685d..84b926a17a 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -480,7 +480,7 @@ invalid_contract_warning({M, F, A}, FileLine, SuccType, RecDict) -> extra_range_warning({M, F, A}, FileLine, ExtraRanges, STRange) -> ERangesStr = erl_types:t_to_string(ExtraRanges), STRangeStr = erl_types:t_to_string(STRange), - {?WARN_CONTRACT_TYPES, FileLine, + {?WARN_CONTRACT_SUPERTYPE, FileLine, {extra_range, [M, F, A, ERangesStr, STRangeStr]}}. picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 30aec59d22..92868b6878 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2161,13 +2161,21 @@ get_apply_constr(FunLabels, Dst, ArgTypes, #state{callgraph = CG} = State) -> case lists:member(error, MFAs) of true -> error; false -> - Constrs = [begin - State1 = state__new_constraint_context(State), - State2 = get_plt_constr(MFA, Dst, ArgTypes, State1), - state__cs(State2) - end || {ok, MFA} <- MFAs], - ApplyConstr = mk_disj_constraint_list(Constrs), - {ok, state__store_conj(ApplyConstr, State)} + Constrs0 = + [begin + State1 = state__new_constraint_context(State), + try get_plt_constr(MFA, Dst, ArgTypes, State1) of + State2 -> state__cs(State2) + catch + throw:error -> error + end + end || {ok, MFA} <- MFAs], + case [C || C <- Constrs0, C =/= error] of + [] -> throw(error); + Constrs -> + ApplyConstr = mk_disj_constraint_list(Constrs), + {ok, state__store_conj(ApplyConstr, State)} + end end. state__scc(#state{scc = SCC}) -> diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash index 6bdd934169..1ddae5149f 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/crash +++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash @@ -1,5 +1,4 @@ -crash_1.erl:42: The specification for crash_1:empty/0 states that the function might also return crash_1:targetlist() but the inferred return is none() crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::'undefined' | crash_1:target() crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) contains an opaque term as 2nd argument when terms of different types are expected in these positions crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> diff --git a/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy new file mode 100644 index 0000000000..7ce440a60d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy @@ -0,0 +1,4 @@ + +higher_order_discrepancy.erl:11: The call higher_order_discrepancy:g('foo') will never return since it differs in the 1st argument from the success typing arguments: ('bar') +higher_order_discrepancy.erl:14: Function g/1 has no local return +higher_order_discrepancy.erl:14: The pattern 'bar' can never match the type 'foo' diff --git a/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2 b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2 new file mode 100644 index 0000000000..c1c7dbbfcc --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2 @@ -0,0 +1,8 @@ + +higher_order_discrepancy_2.erl:11: The call higher_order_discrepancy_2:f('foo') will never return since it differs in the 1st argument from the success typing arguments: ('bar') +higher_order_discrepancy_2.erl:11: The call higher_order_discrepancy_2:g('foo') will never return since it differs in the 1st argument from the success typing arguments: ('baz') +higher_order_discrepancy_2.erl:13: Function f/1 has no local return +higher_order_discrepancy_2.erl:13: The pattern 'bar' can never match the type 'foo' +higher_order_discrepancy_2.erl:14: Function g/1 has no local return +higher_order_discrepancy_2.erl:14: The pattern 'baz' can never match the type 'foo' +higher_order_discrepancy_2.erl:5: Function test/1 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash index 191d3d4173..8c9df56a4b 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash +++ b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash @@ -12,4 +12,3 @@ tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary-unit:8>> can never match the type <<_:8>> tuple_set_crash.erl:62: The pattern {'play_list', _Playlist} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]} tuple_set_crash.erl:64: The pattern {'error', 17} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]} -tuple_set_crash.erl:83: The specification for tuple_set_crash:parse_message/1 states that the function might also return {'media_item_url_reply',integer(),binary()} but the inferred return is 'ok' | {'audio_device_info' | 'audio_output_info' | 'audio_target_info' | 'device_properties' | 'error' | 'video_device_info' | 'video_output_info' | 'video_target_info',[{'address' | 'audio_volume' | 'controller_description' | 'controller_name' | 'controller_status' | 'device_id' | 'display_type' | 'fw_version' | 'master_volume' | 'model' | 'output_id' | 'status' | 'target_id',binary() | non_neg_integer()}] | 1..255} diff --git a/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl new file mode 100644 index 0000000000..ff5ee6bac4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl @@ -0,0 +1,14 @@ +-module(higher_order_discrepancy). + +-export([test/1]). + +test(X) -> + F = + case X of + 1 -> fun f/1; + 2 -> fun g/1 + end, + F(foo). + +f(foo) -> ok. +g(bar) -> ok. diff --git a/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl new file mode 100644 index 0000000000..4b0d4f6b45 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl @@ -0,0 +1,14 @@ +-module(higher_order_discrepancy_2). + +-export([test/1]). + +test(X) -> + F = + case X of + 1 -> fun f/1; + 2 -> fun g/1 + end, + F(foo). + +f(bar) -> ok. +g(baz) -> ok. diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 43c497f50a..2d8edb1301 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -431,7 +431,7 @@ eval(F) -> </code> <p> -Evaluating an evaluable() <c>E</c> on an argument list <c>A</c> +Applying an evaluable() <c>E</c> to an argument list <c>A</c> is meant in the sense of <c>eval([E|A])</c>.</p> <p> @@ -565,7 +565,7 @@ Pkt = #diameter_packet{} </code> <p> -Reports that the RFC 3539 watchdog state machine has +The RFC 3539 watchdog state machine has transitioned into (<c>up</c>) or out of (<c>down</c>) the open state. If a <c>diameter_packet</c> record is present in an <c>up</c> tuple @@ -576,9 +576,9 @@ connectivity.</p> <p> Note that a single up/down event for a given peer corresponds to -as many peer_up/down callbacks as there are Diameter -applications shared by the peer, as determined during capablilities -exchange. +as many <seealso marker="diameter_app#peer_up">peer_up/peer_down</seealso> +callbacks as there are Diameter applications shared by the peer, +as determined during capablilities exchange. That is, the event communicates connectivity with the peer as a whole while the callbacks communicate connectivity with respect to individual Diameter applications.</p> @@ -597,12 +597,96 @@ transport connection with a peer following <c>reconnect_timer</c> or <c>watchdog_timer</c> expiry.</p> </item> +<tag><c>{closed, Ref, Reason, Config}</c></tag> +<item> +<code> +Ref = transport_ref() +Config = {connect|listen, [transport_opt()]} +</code> + +<p> +Capabilities exchange has failed. <c>Reason</c> can be one of +the following.</p> + +<taglist> + +<tag><c>{'CER', Result, Caps, Pkt}</c></tag> +<item> +<code> +Result = ResultCode | {capabilities_cb, CB, ResultCode|discard} +Caps = #diameter_caps{} +Pkt = #diameter_packet{} +ResultCode = integer() +CB = evaluable() +</code> + +<p> +An incoming CER has been answered with the indicated result code or +discarded. +The capabilities record contains pairs of values for the the local +node and remote peer. +The packet record contains the CER in question. +In the case of rejection by a capabilities callback, the tuple +indicates the rejecting callback.</p> +</item> + +<tag><c>{'CER', Caps, {ResultCode, Pkt}}</c></tag> +<item> +<code> +ResultCode = integer() +Caps = #diameter_caps{} +Pkt = #diameter_packet{} +</code> + +<p> +An incoming CER contained errors and has been answered with the +indicated result code. +The capabilities record contains only values for the the local +node. +The packet record contains the CER in question.</p> +</item> + +<tag><c>{'CEA', Result, Caps, Pkt}</c></tag> +<item> +<code> +Result = integer() | atom() | {capabilities_cb, CB, ResultCode|discard} +Caps = #diameter_caps{} +Pkt = #diameter_packet{} +ResultCode = integer() +</code> + +<p> +An incoming CEA has been rejected for the indicated reason. +An integer-valued <c>Result</c> indicates the result code sent +by the peer. +The capabilities record contains pairs of values for the the local +node and remote peer. +The packet record contains the CEA in question. +In the case of rejection by a capabilities callback, the tuple +indicates the rejecting callback.</p> +</item> + +<tag><c>{'CEA', Caps, Pkt}</c></tag> +<item> +<code> +Caps = #diameter_caps{} +Pkt = #diameter_packet{} +</code> + +<p> +An incoming CER contained errors and has been rejected. +The capabilities record contains only values for the the local node. +The packet record contains the CEA in question.</p> +</item> + +</taglist> +</item> + </taglist> <p> For forward compatibility, a subscriber should be prepared to receive -<c>diameter_event.info</c> of forms other than those documented -above.</p> +info fields of forms other than the above.</p> <marker id="service_name"/> </item> @@ -706,6 +790,31 @@ not over SCTP as implemented by <seealso marker="diameter_sctp">diameter_sctp(3)</seealso>.</p> </item> +<tag><c>{capabilities_cb, evaluable()}</c></tag> +<item> +<p> +A callback invoked upon reception of CER/CEA during capabilities +exchange in order to ask whether or not the connection should +be accepted. +Applied to the transport reference (as returned by <seealso +marker="#add_transport">add_transport/2</seealso>) and +<c>diameter_caps</c> record of the connection. +Returning <c>ok</c> accepts the connection. +Returning <c>integer()</c> causes an incoming +CER to be answered with the specified Result-Code. +Returning <c>discard</c> causes an incoming CER to +be discarded. +Returning <c>unknown</c> is equivalent to returning <c>3010</c>, +DIAMETER_UNKNOWN_PEER. +Returning anything but <c>ok</c> or a 2xxx series result +code causes the transport connection to be broken.</p> + +<p> +Multiple <c>capabilities_cb</c> options can be specified, in which +case the corresponding callbacks are applied until either all return +<c>ok</c> or one does not.</p> +</item> + <tag><c>{watchdog_timer, TwInit}</c></tag> <item> <code> diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index d037e1044a..13a6c462af 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -40,14 +40,14 @@ encode_avps(Name, Rec) -> list_to_binary(encode(Name, Rec)) catch throw: {?MODULE, Reason} -> - diameter_dbg:log({encode, error}, + diameter_lib:log({encode, error}, ?MODULE, ?LINE, {Reason, Name, Rec}), erlang:error(list_to_tuple(Reason ++ [Name])); error: Reason -> Stack = erlang:get_stacktrace(), - diameter_dbg:log({encode, failure}, + diameter_lib:log({encode, failure}, ?MODULE, ?LINE, {Reason, Name, Rec, Stack}), @@ -159,7 +159,7 @@ d_rc(Name, {Avps, {Rec, [] = Failed}}) -> {Rec, Avps, Failed} catch throw: {?MODULE, {AvpName, Reason}} -> - diameter_dbg:log({decode, error}, + diameter_lib:log({decode, error}, ?MODULE, ?LINE, {AvpName, Reason, Rec}), @@ -260,7 +260,7 @@ d(Name, Avp, {Avps, Acc}) -> %% respond sensibly to. Log the occurence for traceability, %% but the peer will also receive info in the resulting %% answer-message. - diameter_dbg:log({decode, failure}, + diameter_lib:log({decode, failure}, ?MODULE, ?LINE, {Reason, Avp, erlang:get_stacktrace()}), diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index a057632d15..eea2aa894d 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -177,7 +177,7 @@ else include $(ERL_TOP)/make/otp_release_targets.mk endif -# Can't $(INSTALL_DIR) more than on directory at a time on Solaris. +# Can't $(INSTALL_DIR) more than one directory at a time on Solaris. release_spec: opt for d in bin ebin examples include src/dict $(TARGET_DIRS:%/=src/%); do \ @@ -209,7 +209,7 @@ gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.hrl: \ gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl: \ $(COMPILER_MODULES:compiler/%=$(EBIN)/%.$(EMULATOR)) -$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): \ +$(DICT_MODULES:gen/%=$(EBIN)/%.$(EMULATOR)): \ $(INCDIR)/diameter.hrl \ $(INCDIR)/diameter_gen.hrl diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index 138e76411e..842a9e6103 100644 --- a/lib/diameter/src/base/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -57,9 +57,9 @@ -include("diameter_types.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). --define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION'). --define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). +-define(SUCCESS, 2001). %% DIAMETER_SUCCESS +-define(NOAPP, 5010). %% DIAMETER_NO_COMMON_APPLICATION +-define(NOSECURITY, 5017). %% DIAMETER_NO_COMMON_SECURITY -define(NO_INBAND_SECURITY, 0). -define(TLS, 1). @@ -96,7 +96,7 @@ try_it([Fun | Args]) -> try apply(Fun, Args) of T -> {ok, T} catch - throw: ?FAILURE(Reason) -> {error, {Reason, Args}} + throw: ?FAILURE(Reason) -> {error, Reason} end. %% mk_caps/2 @@ -224,10 +224,6 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> RCaps, CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. -%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION -%% in the CEA and SHOULD disconnect the transport. However, we have -%% no way to guarantee the send before disconnecting. - build_CEA([], _, _, CEA) -> CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; @@ -292,25 +288,12 @@ to_cea(CER, Field, CEA) -> %% rCEA/2 -rCEA(#diameter_base_CEA{'Result-Code' = RC} - = CEA, - #diameter_service{capabilities = LCaps} - = Svc) -> - RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), - +rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) -> RCaps = capx_to_caps(CEA), SApps = common_applications(LCaps, RCaps, Svc), - - [] == SApps andalso ?THROW(no_common_applications), - IS = common_security(LCaps, RCaps), - [] == IS andalso ?THROW(no_common_security), - - {SApps, IS, RCaps}; - -rCEA(CEA, _Svc) -> - ?THROW({invalid, CEA}). + {SApps, IS, RCaps}. %% capx_to_caps/1 diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index d88f42fb7c..fe1212b7e0 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -190,26 +190,13 @@ encode_avps(Avps) -> %% msg_header/3 -msg_header(Mod, MsgName, Header) -> - {Code, Flags, ApplId} = h(Mod, MsgName, Header), - {Code, p(Flags, Header), ApplId}. - -%% 6.2 of 3588 requires the same 'P' bit on an answer as on the -%% request. - -p(Flags, #diameter_header{is_request = true, - is_proxiable = P}) -> - Flags band (2#10110000 bor choose(P, 2#01000000, 0)); -p(Flags, _) -> - Flags. - -h(Mod, 'answer-message' = MsgName, Header) -> +msg_header(Mod, 'answer-message' = MsgName, Header) -> ?BASE = Mod, #diameter_header{cmd_code = Code} = Header, {_, Flags, ApplId} = ?BASE:msg_header(MsgName), {Code, Flags, ApplId}; -h(Mod, MsgName, _) -> +msg_header(Mod, MsgName, _) -> Mod:msg_header(MsgName). %% rec2msg/2 @@ -554,8 +541,3 @@ pack_avp(Code, Flags, Vid, Sz, Bin) -> pack_avp(Code, Flags, Sz, Bin) -> Length = Sz + 8, <<Code:32, Flags:8, Length:24, Bin/binary>>. - -%% =========================================================================== - -choose(true, X, _) -> X; -choose(false, _, X) -> X. diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 282fa2742f..fae5d763dc 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -55,7 +55,8 @@ -define(NO_INBAND_SECURITY, 0). -define(TLS, 1). --define(LOOP_TIMEOUT, 2000). +%% A 2xxx series Result-Code. Not necessarily 2001. +-define(IS_SUCCESS(N), 2 == (N) div 1000). %% RFC 3588: %% @@ -142,9 +143,12 @@ init(T) -> proc_lib:init_ack({ok, self()}), gen_server:enter_loop(?MODULE, [], i(T)). -i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> +i({WPid, T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> putr(dwa, dwa(Caps)), - {ok, TPid, Svc} = start_transport(T, Opts, Svc0), + {M, Ref} = T, + {[Ts], Rest} = proplists:split(Opts, [capabilities_cb]), + putr(capabilities_cb, {Ref, [F || {_,F} <- Ts]}), + {ok, TPid, Svc} = start_transport(T, Rest, Svc0), erlang:monitor(process, TPid), erlang:monitor(process, WPid), #state{parent = WPid, @@ -198,10 +202,13 @@ handle_info(T, #state{} = State) -> ?LOG(stop, T), x(T, State) catch - throw: {?MODULE, Tag, Reason} -> + {?MODULE, Tag, Reason} -> ?LOG(Tag, {Reason, T}), {stop, {shutdown, Reason}, State} end. +%% The form of the exception caught here is historical. It's +%% significant that it's not a 2-tuple, as in ?FAILURE(Reason), +%% since these are caught elsewhere. x(Reason, #state{} = S) -> close_wd(Reason, S), @@ -226,6 +233,9 @@ putr(Key, Val) -> getr(Key) -> get({?MODULE, Key}). +eraser(Key) -> + erase({?MODULE, Key}). + %% transition/2 %% Connection to peer. @@ -316,9 +326,10 @@ send_CER(#state{mode = {connect, Remote}, service = #diameter_service{capabilities = Caps}, transport = TPid} = S) -> - req_send_CER(Caps#diameter_caps.origin_host, Remote) + OH = Caps#diameter_caps.origin_host, + req_send_CER(OH, Remote) orelse - close(connected, S), + close({already_connected, Remote, Caps}, S), CER = build_CER(S), ?LOG(send, 'CER'), send(TPid, encode(CER)), @@ -460,20 +471,20 @@ handle_request(Type, #diameter_packet{} = Pkt, S) -> %% send_answer/3 send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> - #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, + #diameter_packet{header = H, transport_data = TD} = ReqPkt, - {Answer, PostF} = build_answer(Type, V, ReqPkt, S), + {Msg, PostF} = build_answer(Type, ReqPkt, S), - Pkt = #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, - msg = Answer, + %% An answer message clears the R and T flags and retains the P + %% flag. The E flag is set at encode. + Pkt = #diameter_packet{header + = H#diameter_header{version = ?DIAMETER_VERSION, + is_request = false, + is_error = undefined, + is_retransmitted = false}, + msg = Msg, transport_data = TD}, send(TPid, diameter_codec:encode(?BASE, Pkt)), @@ -484,56 +495,104 @@ eval([F|A], S) -> eval(ok, S) -> S. -%% build_answer/4 +%% build_answer/3 build_answer('CER', - ?DIAMETER_VERSION, #diameter_packet{msg = CER, - header = #diameter_header{is_error = false}, + header = #diameter_header{version + = ?DIAMETER_VERSION, + is_error = false}, errors = []} = Pkt, - #state{service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH}} - = Svc, - - {SupportedApps, - #diameter_caps{origin_host = DH} = RCaps, - #diameter_base_CEA{'Result-Code' = RC} - = CEA} + S) -> + {SupportedApps, RCaps, #diameter_base_CEA{'Result-Code' = RC, + 'Inband-Security-Id' = IS} + = CEA} = recv_CER(CER, S), + #diameter_caps{origin_host = {OH, DH}} + = Caps + = capz(caps(S), RCaps), + try 2001 == RC %% DIAMETER_SUCCESS - orelse ?THROW({sent_CEA, RC}), + orelse ?THROW(RC), register_everywhere({?MODULE, connection, OH, DH}) - orelse ?THROW({election_lost, 4003}), - #diameter_base_CEA{'Inband-Security-Id' = [IS]} - = CEA, - {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]} + orelse ?THROW(4003), %% DIAMETER_ELECTION_LOST + caps_cb(Caps) + of + N -> {cea(CEA, N), [fun open/5, Pkt, + SupportedApps, + Caps, + {accept, hd([_] = IS)}]} catch - ?FAILURE({Reason, RC}) -> - {answer('CER', S) ++ [{'Result-Code', RC}], - [fun close/2, {'CER', Reason, DH}]} + ?FAILURE(Reason) -> + rejected(Reason, {'CER', Reason, Caps, Pkt}, S) end; %% The error checks below are similar to those in diameter_service for %% other messages. Should factor out the commonality. -build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) -> - FailedAvp = failed_avp([A || {_,A} <- Es]), - Ans = answer(answer(Type, S), V, H, Es), - {set(Ans, FailedAvp), if 'CER' == Type -> - [fun close/2, {Type, V, Pkt}]; - true -> - ok - end}. +build_answer(Type, + #diameter_packet{header = H, + errors = Es} + = Pkt, + S) -> + RC = rc(H, Es), + {answer(Type, RC, Es, S), post(Type, RC, Pkt, S)}. + +cea(CEA, ok) -> + CEA; +cea(CEA, 2001) -> + CEA; +cea(CEA, RC) -> + CEA#diameter_base_CEA{'Result-Code' = RC}. + +post('CER' = T, RC, Pkt, S) -> + [fun close/2, {T, caps(S), {RC, Pkt}}]; +post(_, _, _, _) -> + ok. + +rejected({capabilities_cb, _F, Reason}, T, S) -> + rejected(Reason, T, S); + +rejected(discard, T, S) -> + close(T, S); +rejected({N, Es}, T, S) -> + {answer('CER', N, Es, S), [fun close/2, T]}; +rejected(N, T, S) -> + rejected({N, []}, T, S). + +answer(Type, RC, Es, S) -> + set(answer(Type, RC, S), failed_avp([A || {_,A} <- Es])). + +answer(Type, RC, S) -> + answer_message(answer(Type, S), RC). +%% answer_message/2 + +answer_message([_ | Avps], RC) + when 3000 =< RC, RC < 4000 -> + ['answer-message', {'Result-Code', RC} + | lists:filter(fun is_origin/1, Avps)]; + +answer_message(Msg, RC) -> + Msg ++ [{'Result-Code', RC}]. + +is_origin({N, _}) -> + N == 'Origin-Host' + orelse N == 'Origin-Realm' + orelse N == 'Origin-State-Id'. + +%% failed_avp/1 + failed_avp([] = No) -> No; failed_avp(Avps) -> [{'Failed-AVP', [[{'AVP', Avps}]]}]. +%% set/2 + set(Ans, []) -> Ans; set(['answer-message' | _] = Ans, FailedAvp) -> @@ -541,18 +600,22 @@ set(['answer-message' | _] = Ans, FailedAvp) -> set([_|_] = Ans, FailedAvp) -> Ans ++ FailedAvp. -answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) -> - ['answer-message', OH, OR, {'Result-Code', 3008}]; +%% rc/2 + +rc(#diameter_header{is_error = true}, _) -> + 3008; %% DIAMETER_INVALID_HDR_BITS -answer([_, OH, OR | _], _, _, [Bs|_]) +rc(_, [Bs|_]) when is_bitstring(Bs) -> - ['answer-message', OH, OR, {'Result-Code', 3009}]; + 3009; %% DIAMETER_INVALID_HDR_BITS -answer(Ans, ?DIAMETER_VERSION, _, Es) -> - Ans ++ [{'Result-Code', rc(Es)}]; +rc(#diameter_header{version = ?DIAMETER_VERSION}, Es) -> + rc(Es); -answer(Ans, _, _, _) -> - Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION +rc(_, _) -> + 5011. %% DIAMETER_UNSUPPORTED_VERSION + +%% rc/1 rc([]) -> 2001; %% DIAMETER_SUCCESS @@ -595,12 +658,14 @@ a('CER', #diameter_caps{vendor_id = Vid, origin_host = Host, origin_realm = Realm, host_ip_address = Addrs, - product_name = Name}) -> + product_name = Name, + origin_state_id = OSI}) -> ['CEA', {'Origin-Host', Host}, {'Origin-Realm', Realm}, {'Host-IP-Address', Addrs}, {'Vendor-Id', Vid}, - {'Product-Name', Name}]; + {'Product-Name', Name}, + {'Origin-State-Id', OSI}]; a('DPR', #diameter_caps{origin_host = Host, origin_realm = Realm}) -> @@ -615,27 +680,25 @@ recv_CER(CER, #state{service = Svc}) -> %% handle_CEA/1 -handle_CEA(#diameter_packet{header = #diameter_header{version = V}, - bin = Bin} +handle_CEA(#diameter_packet{bin = Bin} = Pkt, #state{service = #diameter_service{capabilities = LCaps}} = S) when is_binary(Bin) -> ?LOG(recv, 'CEA'), - ?DIAMETER_VERSION == V orelse close({version, V}, S), - - #diameter_packet{msg = CEA, errors = Errors} + #diameter_packet{msg = CEA} = DPkt = diameter_codec:decode(?BASE, Pkt), - [] == Errors orelse close({errors, Errors}, S), + {SApps, IS, RCaps} = recv_CEA(DPkt, S), - {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps} - = recv_CEA(CEA, S), + #diameter_caps{origin_host = {OH, DH}} + = Caps + = capz(LCaps, RCaps), - #diameter_caps{origin_host = OH} - = LCaps, + #diameter_base_CEA{'Result-Code' = RC} + = CEA, %% Ensure that we don't already have a connection to the peer in %% question. This isn't the peer election of 3588 except in the @@ -643,60 +706,101 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V}, %% receive a CER/CEA, the first that arrives wins the right to a %% connection with the peer. - register_everywhere({?MODULE, connection, OH, DH}) - orelse close({'CEA', DH}, S), - - open(DPkt, SApps, RCaps, {connect, IS}, S). + try + ?IS_SUCCESS(RC) + orelse ?THROW(RC), + [] == SApps + andalso ?THROW(no_common_application), + [] == IS + andalso ?THROW(no_common_security), + register_everywhere({?MODULE, connection, OH, DH}) + orelse ?THROW(election_lost), + caps_cb(Caps) + of + _ -> open(DPkt, SApps, Caps, {connect, hd([_] = IS)}, S) + catch + ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DPkt}, S) + end. +%% Check more than the result code since the peer could send success +%% regardless. If not 2001 then a peer_up callback could do anything +%% required. It's not unimaginable that a peer agreeing to TLS after +%% capabilities exchange could send DIAMETER_LIMITED_SUCCESS = 2002, +%% even if this isn't required by RFC 3588. %% recv_CEA/2 -recv_CEA(CEA, #state{service = Svc} = S) -> - case diameter_capx:recv_CEA(CEA, Svc) of - {ok, {_,_}} -> %% return from old code - close({'CEA', update}, S); - {ok, {[], _, _}} -> - close({'CEA', no_common_application}, S); - {ok, {_, [], _}} -> - close({'CEA', no_common_security}, S); - {ok, {_,_,_} = T} -> - T; - {error, Reason} -> - close({'CEA', Reason}, S) +recv_CEA(#diameter_packet{header = #diameter_header{version + = ?DIAMETER_VERSION, + is_error = false}, + msg = CEA, + errors = []}, + #state{service = Svc}) -> + {ok, T} = diameter_capx:recv_CEA(CEA, Svc), + T; + +recv_CEA(Pkt, S) -> + close({'CEA', caps(S), Pkt}, S). + +caps(#diameter_service{capabilities = Caps}) -> + Caps; +caps(#state{service = Svc}) -> + caps(Svc). + +%% caps_cb/1 + +caps_cb(Caps) -> + {Ref, Ts} = eraser(capabilities_cb), + ccb(Ts, [Ref, Caps]). + +ccb([], _) -> + ok; +ccb([F | Rest], T) -> + case diameter_lib:eval([F|T]) of + ok -> + ccb(Rest, T); + N when ?IS_SUCCESS(N) -> %% 2xxx result code: accept immediately + N; + Res -> + ?THROW({capabilities_cb, F, rejected(Res)}) end. +%% Note that returning 2xxx causes the capabilities exchange to be +%% accepted directly, without further callbacks. + +rejected(discard = T) -> + T; +rejected(unknown) -> + 3010; %% DIAMETER_UNKNOWN_PEER +rejected(N) + when is_integer(N) -> + N. %% open/5 -open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid, - service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH, - inband_security_id = LS} - = LCaps} - = Svc, - #diameter_caps{origin_host = DH} - = RCaps, +open(Pkt, SupportedApps, Caps, {Type, IS}, #state{parent = Pid} = S) -> + #diameter_caps{origin_host = {_,_} = H, + inband_security_id = {LS,_}} + = Caps, - tls_ack(lists:member(?TLS, LS), Type, IS, S), - Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, + tls_ack(lists:member(?TLS, LS), Caps, Type, IS, S), + Pid ! {open, self(), H, {Caps, SupportedApps, Pkt}}, S#state{state = 'Open'}. %% We've advertised TLS support: tell the transport the result %% and expect a reply when the handshake is complete. -tls_ack(true, Type, IS, #state{transport = TPid} = S) -> +tls_ack(true, Caps, Type, IS, #state{transport = TPid} = S) -> Ref = make_ref(), - MRef = erlang:monitor(process, TPid), TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, receive {diameter, {tls, Ref}} -> - erlang:demonitor(MRef, [flush]); - {'DOWN', MRef, process, _, _} = T -> - close({tls_ack, T}, S) + ok; + {'DOWN', _, process, TPid, Reason} -> + close({tls_ack, Reason, Caps}, S) end; %% Or not. Don't send anything to the transport so that transports %% not supporting TLS work as before without modification. -tls_ack(false, _, _, _) -> +tls_ack(false, _, _, _, _) -> ok. capz(#diameter_caps{} = L, #diameter_caps{} = R) -> diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 421e36ccf5..7adcf1c265 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -983,7 +983,8 @@ peer_cb(MFA, Alias) -> connection_down(Pid, #state{peerT = PeerT, connT = ConnT} = S) -> - #peer{conn = TPid} + #peer{op_state = ?STATE_UP, %% assert + conn = TPid} = P = fetch(PeerT, Pid), @@ -993,6 +994,9 @@ connection_down(Pid, #state{peerT = PeerT, %% connection_down/3 +connection_down(#peer{op_state = ?STATE_DOWN}, _, S) -> + S; + connection_down(#peer{conn = TPid, op_state = ?STATE_UP} = P, @@ -1034,13 +1038,23 @@ down_conn(Id, Alias, TC, {SvcName, Apps}) -> %% Peer process has died. -peer_down(Pid, _Reason, #state{peerT = PeerT} = S) -> +peer_down(Pid, Reason, #state{peerT = PeerT} = S) -> P = fetch(PeerT, Pid), ets:delete_object(PeerT, P), + closed(Reason, P, S), restart(P,S), peer_down(P,S). -%% peer_down/2 +%% Send an event at connection establishment failure. +closed({shutdown, {close, _TPid, Reason}}, + #peer{op_state = ?STATE_DOWN, + ref = Ref, + type = Type, + options = Opts}, + #state{service_name = SvcName}) -> + send_event(SvcName, {closed, Ref, Reason, {type(Type), Opts}}); +closed(_, _, _) -> + ok. %% The peer has never come up ... peer_down(#peer{conn = B}, S) @@ -1048,27 +1062,9 @@ peer_down(#peer{conn = B}, S) S; %% ... or it has. -peer_down(#peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts} - = P, - #state{service_name = SvcName, - connT = ConnT} - = S) -> - #conn{caps = Caps} - = C - = fetch(ConnT, TPid), +peer_down(#peer{conn = TPid} = P, #state{connT = ConnT} = S) -> + #conn{} = C = fetch(ConnT, TPid), ets:delete_object(ConnT, C), - try - pd(P,C,S) - after - send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}}) - end. - -pd(#peer{op_state = ?STATE_DOWN}, _, S) -> - S; -pd(#peer{op_state = ?STATE_UP} = P, C, S) -> connection_down(P,C,S). %% restart/2 @@ -1259,11 +1255,11 @@ send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> #diameter_app{module = ModX} = App, - Pkt = make_packet(Msg), + Pkt = make_request_packet(Msg), case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of {send, P} -> - send_request(make_packet(P, Pkt), + send_request(make_request_packet(P, Pkt), TPid, Caps, App, @@ -1278,70 +1274,73 @@ send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> ?ERROR({invalid_return, prepare_request, App, T}) end. -%% make_packet/1 +%% make_request_packet/1 %% %% Turn an outgoing request as passed to call/4 into a diameter_packet %% record in preparation for a prepare_request callback. -make_packet(Bin) +make_request_packet(Bin) when is_binary(Bin) -> #diameter_packet{header = diameter_codec:decode_header(Bin), bin = Bin}; -make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) -> - Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]}; +make_request_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} + = Pkt) -> + Pkt#diameter_packet{msg = [make_request_header(Hdr) | Avps]}; -make_packet(#diameter_packet{header = Hdr} = Pkt) -> - Pkt#diameter_packet{header = make_header(Hdr)}; +make_request_packet(#diameter_packet{header = Hdr} = Pkt) -> + Pkt#diameter_packet{header = make_request_header(Hdr)}; -make_packet(Msg) -> - make_packet(#diameter_packet{msg = Msg}). +make_request_packet(Msg) -> + make_request_packet(#diameter_packet{msg = Msg}). -%% make_header/1 +%% make_request_header/1 -make_header(undefined) -> +make_request_header(undefined) -> Seq = diameter_session:sequence(), - make_header(#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); + make_request_header(#diameter_header{end_to_end_id = Seq, + hop_by_hop_id = Seq}); -make_header(#diameter_header{version = undefined} = Hdr) -> - make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); +make_request_header(#diameter_header{version = undefined} = Hdr) -> + make_request_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); -make_header(#diameter_header{end_to_end_id = undefined} = H) -> +make_request_header(#diameter_header{end_to_end_id = undefined} = H) -> Seq = diameter_session:sequence(), - make_header(H#diameter_header{end_to_end_id = Seq}); + make_request_header(H#diameter_header{end_to_end_id = Seq}); -make_header(#diameter_header{hop_by_hop_id = undefined} = H) -> +make_request_header(#diameter_header{hop_by_hop_id = undefined} = H) -> Seq = diameter_session:sequence(), - make_header(H#diameter_header{hop_by_hop_id = Seq}); + make_request_header(H#diameter_header{hop_by_hop_id = Seq}); -make_header(#diameter_header{} = Hdr) -> +make_request_header(#diameter_header{} = Hdr) -> Hdr; -make_header(T) -> +make_request_header(T) -> ?ERROR({invalid_header, T}). -%% make_packet/2 +%% make_request_packet/2 %% %% Reconstruct a diameter_packet from the return value of %% prepare_request or prepare_retransmit callback. -make_packet(Bin, _) +make_request_packet(Bin, _) when is_binary(Bin) -> - make_packet(Bin); + make_request_packet(Bin); -make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> +make_request_packet(#diameter_packet{msg = [#diameter_header{} | _]} + = Pkt, + _) -> Pkt; %% Returning a diameter_packet with no header from a prepare_request %% or prepare_retransmit callback retains the header passed into it. %% This is primarily so that the end to end and hop by hop identifiers %% are retained. -make_packet(#diameter_packet{header = Hdr} = Pkt, +make_request_packet(#diameter_packet{header = Hdr} = Pkt, #diameter_packet{header = Hdr0}) -> Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; -make_packet(Msg, Pkt) -> +make_request_packet(Msg, Pkt) -> Pkt#diameter_packet{msg = Msg}. %% fold_record/2 @@ -1533,7 +1532,7 @@ retransmit({TPid, Caps, #diameter_app{alias = Alias} = App}, case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of {send, P} -> - retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout); + retransmit(make_request_packet(P, Pkt), TPid, Caps, Req, Timeout); {discard, Reason} -> ?THROW(Reason); discard -> @@ -1946,7 +1945,7 @@ reply(Msg, Dict, TPid, #diameter_packet{errors = Es, = ReqPkt) when [] == Es; is_record(hd(Msg), diameter_header) -> - Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)), + Pkt = diameter_codec:encode(Dict, make_answer_packet(Msg, ReqPkt)), incr(send, Pkt, Dict, TPid), %% count result codes in sent answers send(TPid, Pkt#diameter_packet{transport_data = TD}); @@ -1957,18 +1956,19 @@ reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) -> TPid, Pkt#diameter_packet{errors = []}). -%% make_reply_packet/2 +%% make_answer_packet/2 %% Binaries and header/avp lists are sent as-is. -make_reply_packet(Bin, _) +make_answer_packet(Bin, _) when is_binary(Bin) -> #diameter_packet{bin = Bin}; -make_reply_packet([#diameter_header{} | _] = Msg, _) -> +make_answer_packet([#diameter_header{} | _] = Msg, _) -> #diameter_packet{msg = Msg}; %% Otherwise a reply message clears the R and T flags and retains the -%% P flag. The E flag will be set at encode. -make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) -> +%% P flag. The E flag will be set at encode. 6.2 of 3588 requires the +%% same P flag on an answer as on the request. +make_answer_packet(Msg, #diameter_packet{header = ReqHdr}) -> Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, is_request = false, is_error = undefined, diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index b7c1491f4b..6dc53d9f31 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -179,11 +179,11 @@ transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> %% state okay as the result of the Peer State Machine reaching the %% Open state. %% -%% If we're an acceptor then we may be resuming a connection that went -%% down in another acceptor process, in which case this is the -%% transition below, from down into reopen. That is, it's not until -%% we know the identity of the peer (ie. now) that we know that we're -%% in state down rather than initial. +%% If we're accepting then we may be resuming a connection that went +%% down in another watchdog process, in which case this is the +%% transition below, from down to reopen. That is, it's not until we +%% know the identity of the peer (ie. now) that we know that we're in +%% state down rather than initial. transition({open, TPid, Hosts, T} = Open, #watchdog{transport = TPid, diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index 69bcabbfbb..97d9069f4a 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -58,16 +58,18 @@ SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) # target like 'all' below. Target release_tests only installs source. ERL_COMPILE_FLAGS += +warn_export_vars \ +warn_unused_vars \ - -DDIAMETER_CT=true \ + -I ../include \ -I ../src/gen # ---------------------------------------------------- # Targets # ---------------------------------------------------- -all: $(SUITES) +all: opt -beam tests debug opt: $(TARGET_FILES) +run: $(SUITES) + +debug opt: $(TARGET_FILES) clean: rm -f $(TARGET_FILES) @@ -94,22 +96,22 @@ help: @echo "Useful targets:" @echo @echo " all:" + @echo " Compile all test suites." + @echo + @echo " run:" @echo " Compile and run all test suites." @echo @echo " $(SUITES):" @echo " Compile and run a specific test suite." @echo - @echo " beam:" - @echo " Compile all test-code." - @echo @echo " clean | realclean:" @echo " Remove generated files." @echo @echo " info:" - @echo " Echo some interesting variables." + @echo " Echo some relevant variables." @echo ======================================== -.PHONY: all beam clean debug docs help info opt realclean tests +.PHONY: all run clean debug docs help info opt realclean # ---------------------------------------------------- # Special Targets @@ -118,12 +120,12 @@ help: # Exit with a non-zero status if the output looks to indicate failure. # diameter_ct:run/1 itself can't tell (it seems). The absolute -pa is # because ct will change directories. -$(SUITES): log tests +$(SUITES): log opt $(ERL) -noshell \ - -pa $(realpath ../ebin) \ - -sname diameter_test_$@ \ - -s diameter_ct run diameter_$@_SUITE \ - -s init stop \ + -pa $(realpath ../ebin) \ + -sname diameter_test_$@ \ + -s diameter_ct run diameter_$@_SUITE \ + -s init stop \ | awk '1{rc=0} {print} / FAILED /{rc=1} END{exit rc}' # Shorter in sed but requires a GNU extension (ie. Q). @@ -136,6 +138,9 @@ log: # Release Targets # ---------------------------------------------------- +/%: % force + sed -f release.sed $< > $(RELSYSDIR)$@ + ifeq ($(ERL_TOP),) include $(DIAMETER_TOP)/make/release_targets.mk else @@ -151,10 +156,16 @@ release_tests_spec: $(INSTALL_DATA) $(TEST_SPEC_FILE) \ $(COVER_SPEC_FILE) \ $(HRL_FILES) \ - $(ERL_FILES) \ $(RELSYSDIR) + $(MAKE) $(ERL_FILES:%=/%) + +force: .PHONY: release_spec release_docs_spec release_test_specs +.PHONY: force + +# Can't just make $(ERL_FILES:%=/%) phony since then implicit rule +# searching is skipped. # ---------------------------------------------------- @@ -163,7 +174,7 @@ depend: depend.mk # Generate dependencies makefile. depend.mk: depend.sed $(MODULES:%=%.erl) Makefile (for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ + (echo $$f; cat $$f.erl) | sed -f $<; \ done) \ > $@ diff --git a/lib/diameter/test/depend.sed b/lib/diameter/test/depend.sed index a399eb45f0..95dca44984 100644 --- a/lib/diameter/test/depend.sed +++ b/lib/diameter/test/depend.sed @@ -18,14 +18,24 @@ # # -# Extract local include dependencies from .erl files. The output is massaged -# further in Makefile. +# Extract local include dependencies from an .erl file. The first +# input line is the module name. # -/^-include/!d +# Store the module name in the hold space. +1{ + h + d +} + +# Throw away everything but local includes. /^-include_lib/d +/^-include/!d /diameter_gen/d +/diameter\./d +# Output a dependency of the beam on the included file. s@^-include("@@ s@".*@@ -s@^@$(EBIN)/.$(EMULATOR): @ +G +s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@ diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl new file mode 100644 index 0000000000..e6b1558bf6 --- /dev/null +++ b/lib/diameter/test/diameter_capx_SUITE.erl @@ -0,0 +1,432 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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% +%% + +%% +%% Tests of capabilities exchange between Diameter nodes. In +%% particular, of error and event handling. +%% + +-module(diameter_capx_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_group/2, + end_per_group/2, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([start/1, + start_services/1, + add_listeners/1, + s_no_common_application/1, + c_no_common_application/1, + s_no_common_security/1, + c_no_common_security/1, + s_unknown_peer/1, + c_unknown_peer/1, + s_unable/1, + c_unable/1, + s_client_reject/1, + c_client_reject/1, + remove_listeners/1, + stop_services/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/4, + peer_down/4]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(CLIENT, client). +-define(SERVER, server). + +-define(ADDR, {127,0,0,1}). + +-define(REALM, "erlang.org"). +-define(HOST(Name), Name ++ "." ++ ?REALM). + +%% Config for diameter:start_service/2. +-define(SERVICE(Name), + [{'Origin-Realm', ?REALM}, + {'Host-IP-Address', [?ADDR]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]}, + {'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]} + | [{application, [{alias, A}, + {dictionary, D}, + {module, [?MODULE, A]}]} + || {A,D} <- [{common, ?DIAMETER_DICT_COMMON}, + {accounting, ?DIAMETER_DICT_ACCOUNTING}]]]). + +-define(A, list_to_atom). +-define(L, atom_to_list). + +-define(event, #diameter_event). +-define(caps, #diameter_caps). +-define(packet, #diameter_packet). + +-define(cea, #diameter_base_CEA). +-define(answer_message, #'diameter_base_answer-message'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [start, start_services, add_listeners + | [{group, N} || {N, _, _} <- groups()]] + ++ [remove_listeners, stop_services, stop]. + +groups() -> + Ts = testcases(), + [{grp(P), P, Ts} || P <- [[], [parallel]]]. + +grp([]) -> + sequential; +grp([parallel = P]) -> + P. + +init_per_group(_Name, Config) -> + Config. + +end_per_group(_, _) -> + ok. + +%% Generate a unique hostname for each testcase so that watchdogs +%% don't prevent a connection from being brought up immediately. +init_per_testcase(Name, Config) -> + Uniq = ["." ++ integer_to_list(N) || N <- tuple_to_list(now())], + [{host, lists:flatten([?L(Name) | Uniq])} | Config]. + +end_per_testcase(N, _) + when N == start; + N == start_services; + N == add_listeners; + N == remove_listeners; + N == stop_services; + N == stop -> + ok; +end_per_testcase(Name, Config) -> + CRef = ?util:read_priv(Config, Name), + ok = diameter:remove_transport(?CLIENT, CRef). + +%% Testcases all come in two flavours, client and server. +testcases() -> + lists:flatmap(fun tc/1, tc()). + +tc(Name) -> + [?A([C,$_|?L(Name)]) || C <- "cs"]. + +tc() -> + [no_common_application, + no_common_security, + unknown_peer, + unable, + client_reject]. + +%% =========================================================================== +%% start/stop testcases + +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). + +%% One server that responds only to base accounting, one that responds +%% to both this and the common application. Share a common service just +%% to simplify config, and because we can. +add_listeners(Config) -> + Acct = listen(?SERVER, + [{capabilities, [{'Origin-Host', ?HOST("acct-srv")}, + {'Auth-Application-Id', []}]}, + {applications, [accounting]}, + {capabilities_cb, [fun server_capx/3, acct]}]), + Base = listen(?SERVER, + [{capabilities, [{'Origin-Host', ?HOST("base-srv")}]}, + {capabilities_cb, [fun server_capx/3, base]}]), + ?util:write_priv(Config, ?MODULE, {Base, Acct}). %% lref/2 reads + +remove_listeners(_Config) -> + ok = diameter:remove_transport(?SERVER, true). + +stop_services(_Config) -> + ok = diameter:stop_service(?CLIENT), + ok = diameter:stop_service(?SERVER). + +stop(_Config) -> + ok = diameter:stop(). + +%% =========================================================================== +%% All the testcases come in pairs, one for receiving an event on the +%% client side, one on the server side. Note that testcases will +%% receive events resulting from other testcases when running in +%% parallel since the events are per service. The unique client +%% Origin-Host for each testcase plus transport references are used to +%% ensure that only the relevant event is extracted from the mailbox. +%% Don't bother extracting events that aren't relevant. + +%% ==================== +%% Ask the accounting server to speak the common application and expect +%% DIAMETER_NO_COMMON_APPLICATION = 5010. + +s_no_common_application(Config) -> + server_closed(Config, fun no_common_application/1, 5010). + +c_no_common_application(Config) -> + client_closed(Config, "acct-srv", fun no_common_application/1, 5010). + +no_common_application(Config) -> + connect(Config, acct, [{capabilities, [{'Acct-Application-Id', []}]}, + {applications, [common]}]). + +%% ==================== +%% Ask the base server to speak accounting with an unknown security +%% method and expect DIAMETER_NO_COMMON_SECURITY = 5017. + +s_no_common_security(Config) -> + server_closed(Config, fun no_common_security/1, 5017). + +c_no_common_security(Config) -> + client_closed(Config, "base-srv", fun no_common_security/1, 5017). + +no_common_security(Config) -> + connect(Config, base, [{capabilities, [{'Acct-Application-Id', []}, + {'Inband-Security-Id', [17, 18]}]}, + {applications, [common]}]). + +%% ==================== +%% Have the base server reject a decent CER with the protocol error +%% DIAMETER_UNKNOWN_PEER = 3010. + +s_unknown_peer(Config) -> + server_reject(Config, fun base/1, 3010). + +c_unknown_peer(Config) -> + true = diameter:subscribe(?CLIENT), + OH = ?HOST("base-srv"), + + {CRef, _} = base(Config), + + {'CEA', ?caps{}, + ?packet{msg = ?answer_message{'Origin-Host' = OH, + 'Result-Code' = 3010}}} + = client_recv(CRef). + +base(Config) -> + connect(Config, base, []). + +%% ==================== +%% Have the base server reject a decent CER with the non-protocol +%% error DIAMETER_UNABLE_TO_COMPLY = 5012. + +s_unable(Config) -> + server_reject(Config, fun base/1, 5012). + +c_unable(Config) -> + client_closed(Config, "base-srv", fun base/1, 5012). + +%% ==================== +%% Have the client reject a decent CEA. + +s_client_reject(Config) -> + true = diameter:subscribe(?SERVER), + OH = host(Config), + + {_, LRef} = client_reject(Config), + + receive + ?event{service = ?SERVER, + info = {up, LRef, + {_, ?caps{origin_host = {_, OH}}}, + {listen, _}, + ?packet{}}} + = Info -> + Info + after 2000 -> + fail({LRef, OH}) + end. + +c_client_reject(Config) -> + true = diameter:subscribe(?CLIENT), + OH = ?HOST("acct-srv"), + + {CRef, _} = client_reject(Config), + + {'CEA', {capabilities_cb, _, discard}, + ?caps{origin_host = {_, OH}}, + ?packet{msg = ?cea{'Result-Code' = 2001}}} + = client_recv(CRef). + +client_reject(Config) -> + connect(Config, acct, [{capabilities_cb, fun client_capx/2}]). + +%% =========================================================================== + +%% server_closed/3 + +server_closed(Config, F, RC) -> + true = diameter:subscribe(?SERVER), + OH = host(Config), + + {_, LRef} = F(Config), + + receive + ?event{service = ?SERVER, + info = {closed, LRef, + {'CER', RC, + ?caps{origin_host = {_, OH}}, + ?packet{}} + = Reason, + {listen, _}}} -> + Reason + after 2000 -> + fail({LRef, OH}) + end. + +%% server_reject/3 + +server_reject(Config, F, RC) -> + true = diameter:subscribe(?SERVER), + OH = host(Config), + + {_, LRef} = F(Config), + + receive + ?event{service = ?SERVER, + info = {closed, LRef, + {'CER', {capabilities_cb, _, RC}, + ?caps{origin_host = {_, OH}}, + ?packet{}} + = Reason, + {listen, _}}} -> + Reason + after 2000 -> + fail({LRef, OH}) + end. + +%% cliient_closed/4 + +client_closed(Config, Host, F, RC) -> + true = diameter:subscribe(?CLIENT), + OH = ?HOST(Host), + + {CRef, _} = F(Config), + + {'CEA', RC, ?caps{origin_host = {_, OH}}, ?packet{}} + = client_recv(CRef). + +%% client_recv/1 + +client_recv(CRef) -> + receive + ?event{service = ?CLIENT, + info = {closed, CRef, Reason, {connect, _}}} -> + Reason + after 2000 -> + fail(CRef) + end. + +%% server_capx/3 + +server_capx(_, ?caps{origin_host = {_, [_,$_|"unknown_peer." ++ _]}}, _) -> + unknown; + +server_capx(_, ?caps{origin_host = {_, [_,$_|"unable." ++ _]}}, _) -> + 5012; %% DIAMETER_UNABLE_TO_COMPLY + +server_capx(_, ?caps{origin_host = {OH,DH}}, _) -> + io:format("connection: ~p -> ~p~n", [DH,OH]), + ok. + +%% client_capx/2 + +client_capx(_, ?caps{origin_host = {[_,$_|"client_reject." ++ _], _}}) -> + discard. + +%% =========================================================================== + +fail(T) -> + erlang:error({T, process_info(self(), messages)}). + +host(Config) -> + {_, H} = lists:keyfind(host, 1, Config), + ?HOST(H). + +listen(Name, Opts) -> + ?util:listen(Name, tcp, Opts). + +connect(Config, T, Opts) -> + {_, H} = lists:keyfind(host, 1, Config), + LRef = lref(Config, T), + CRef = connect(LRef, [{capabilities, [{'Origin-Host', ?HOST(H)}]} + | Opts]), + Name = lists:takewhile(fun(C) -> C /= $. end, H), + ?util:write_priv(Config, Name, CRef), %% end_per_testcase reads + {CRef, LRef}. + +connect(LRef, Opts) -> + [PortNr] = ?util:lport(tcp, LRef, 20), + {ok, CRef} = diameter:add_transport(?CLIENT, + {connect, opts(PortNr, Opts)}), + CRef. + +opts(PortNr, Opts) -> + [{transport_module, diameter_tcp}, + {transport_config, [{raddr, ?ADDR}, + {rport, PortNr}, + {ip, ?ADDR}, + {port, 0}]} + | Opts]. + +lref(Config, T) -> + case ?util:read_priv(Config, ?MODULE) of + {LRef, _} when T == base -> + LRef; + {_, LRef} when T == acct -> + LRef + end. + +%% =========================================================================== +%% diameter callbacks + +peer_up(?SERVER, + {_, ?caps{origin_host = {"acct-srv." ++ _, + [_,$_|"client_reject." ++ _]}}}, + State, + _) -> + State. + +peer_down(?SERVER, + {_, ?caps{origin_host = {"acct-srv." ++ _, + [_,$_|"client_reject." ++ _]}}}, + State, + _) -> + State. diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index aab7ab35cc..8046ca4c04 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -25,7 +25,7 @@ %% Test encode/decode of dictionary-related modules. %% --include_lib("diameter/include/diameter.hrl"). +-include("diameter.hrl"). -define(BASE, diameter_gen_base_rfc3588). -define(BOOL, [true, false]). diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index c25e9682f0..f4d62f94c6 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -57,13 +57,8 @@ handle_error/4, handle_request/3]). --ifdef(DIAMETER_CT). +-include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --else. --include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). --endif. - --include_lib("diameter/include/diameter.hrl"). -include("diameter_ct.hrl"). %% =========================================================================== diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index 03f1115496..40cbdf805a 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -64,13 +64,8 @@ handle_error/4, handle_request/3]). --ifdef(DIAMETER_CT). +-include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --else. --include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). --endif. - --include_lib("diameter/include/diameter.hrl"). -include("diameter_ct.hrl"). %% =========================================================================== diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 99f92ca0e0..127e3435dc 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -67,13 +67,8 @@ handle_error/4, handle_request/3]). --ifdef(DIAMETER_CT). +-include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --else. --include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). --endif. - --include_lib("diameter/include/diameter.hrl"). -include("diameter_ct.hrl"). %% =========================================================================== diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 6704f24532..55c5fc7c54 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -87,13 +87,8 @@ handle_error/5, handle_request/3]). --ifdef(DIAMETER_CT). +-include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --else. --include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). --endif. - --include_lib("diameter/include/diameter.hrl"). -include("diameter_ct.hrl"). %% =========================================================================== @@ -251,7 +246,7 @@ start_services(_Config) -> ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). add_transports(Config) -> - LRef = ?util:listen(?SERVER, tcp), + LRef = ?util:listen(?SERVER, tcp, [{capabilities_cb, fun capx/2}]), CRef = ?util:connect(?CLIENT, tcp, LRef), ?util:write_priv(Config, "transport", {LRef, CRef}). @@ -266,6 +261,10 @@ stop_services(_Config) -> stop(_Config) -> ok = diameter:stop(). +capx(_, #diameter_caps{origin_host = {OH,DH}}) -> + io:format("connection: ~p -> ~p~n", [DH,OH]), + ok. + %% =========================================================================== %% Ensure that result codes have the expected values. diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index a9520ef5bd..c22adc3334 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -45,7 +45,7 @@ init/2]). -include_lib("kernel/include/inet_sctp.hrl"). --include_lib("diameter/include/diameter.hrl"). +-include("diameter.hrl"). -include("diameter_ct.hrl"). -define(util, diameter_util). diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 3fe8ea5363..6b1dc1f0c9 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -33,8 +33,8 @@ %% diameter-specific -export([lport/2, lport/3, - listen/2, - connect/3, + listen/2, listen/3, + connect/3, connect/4, disconnect/4]). %% common_test-specific @@ -254,22 +254,28 @@ lp(M, Ref, T) -> end. %% --------------------------------------------------------------------------- -%% listen/2 +%% listen/2-3 %% %% Add a listening transport on the loopback address and a free port. listen(SvcName, Prot) -> - add_transport(SvcName, {listen, opts(Prot, listen)}). + listen(SvcName, Prot, []). + +listen(SvcName, Prot, Opts) -> + add_transport(SvcName, {listen, opts(Prot, listen) ++ Opts}). %% --------------------------------------------------------------------------- -%% connect/3 +%% connect/2-3 %% %% Add a connecting transport on and connect to a listening transport %% with the specified reference. connect(Client, Prot, LRef) -> + connect(Client, Prot, LRef, []). + +connect(Client, Prot, LRef, Opts) -> [PortNr] = lport(Prot, LRef, 20), - Ref = add_transport(Client, {connect, opts(Prot, PortNr)}), + Ref = add_transport(Client, {connect, opts(Prot, PortNr) ++ Opts}), true = diameter:subscribe(Client), ok = receive {diameter_event, Client, {up, Ref, _, _, _}} -> ok diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl index dec307529a..b40d7c104d 100644 --- a/lib/diameter/test/diameter_watchdog_SUITE.erl +++ b/lib/diameter/test/diameter_watchdog_SUITE.erl @@ -36,7 +36,7 @@ id/1, %% jitter callback run/1]). --include_lib("diameter/include/diameter.hrl"). +-include("diameter.hrl"). -include("diameter_ct.hrl"). %% =========================================================================== diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index 75fdd0bd1d..f88258c232 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -33,6 +33,7 @@ MODULES = \ diameter_stats_SUITE \ diameter_watchdog_SUITE \ diameter_transport_SUITE \ + diameter_capx_SUITE \ diameter_traffic_SUITE \ diameter_relay_SUITE \ diameter_tls_SUITE \ diff --git a/lib/diameter/test/release.sed b/lib/diameter/test/release.sed new file mode 100644 index 0000000000..2720b778f2 --- /dev/null +++ b/lib/diameter/test/release.sed @@ -0,0 +1,35 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010-2011. 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% +# + +# +# This bit of gymnastics is to replace the include of diameter's +# public hrls by include_lib when releasing testsuites, so that they +# compile both in the development filesystem (where generated hrls +# aren't in diameter/include) and with common_test's autocompilation +# on an installed release. Solving the problem by installing generated +# hrls to ../include is anathema: that directory is for handwritten +# source.) +# + +/^-include("/!b +/"diameter_gen_/b s +/"diameter\./!b + +:s +s@("@_lib&diameter/include/@ diff --git a/lib/docbuilder/test/docb_SUITE_data/cdata_problem.xml b/lib/docbuilder/test/docb_SUITE_data/cdata_problem.xml index b7f6f5376e..b7f6f5376e 100755..100644 --- a/lib/docbuilder/test/docb_SUITE_data/cdata_problem.xml +++ b/lib/docbuilder/test/docb_SUITE_data/cdata_problem.xml diff --git a/lib/docbuilder/xsd/application.xsd b/lib/docbuilder/xsd/application.xsd index eb666cb6c7..eb666cb6c7 100755..100644 --- a/lib/docbuilder/xsd/application.xsd +++ b/lib/docbuilder/xsd/application.xsd diff --git a/lib/docbuilder/xsd/appref.xsd b/lib/docbuilder/xsd/appref.xsd index b63839e494..b63839e494 100755..100644 --- a/lib/docbuilder/xsd/appref.xsd +++ b/lib/docbuilder/xsd/appref.xsd diff --git a/lib/docbuilder/xsd/book.xsd b/lib/docbuilder/xsd/book.xsd index b47962263a..b47962263a 100755..100644 --- a/lib/docbuilder/xsd/book.xsd +++ b/lib/docbuilder/xsd/book.xsd diff --git a/lib/docbuilder/xsd/chapter.xsd b/lib/docbuilder/xsd/chapter.xsd index 4d89baa988..4d89baa988 100755..100644 --- a/lib/docbuilder/xsd/chapter.xsd +++ b/lib/docbuilder/xsd/chapter.xsd diff --git a/lib/docbuilder/xsd/common.entities.xsd b/lib/docbuilder/xsd/common.entities.xsd index 52a5d35179..52a5d35179 100755..100644 --- a/lib/docbuilder/xsd/common.entities.xsd +++ b/lib/docbuilder/xsd/common.entities.xsd diff --git a/lib/docbuilder/xsd/common.header.xsd b/lib/docbuilder/xsd/common.header.xsd index bfee4b8bb4..bfee4b8bb4 100755..100644 --- a/lib/docbuilder/xsd/common.header.xsd +++ b/lib/docbuilder/xsd/common.header.xsd diff --git a/lib/docbuilder/xsd/common.image.xsd b/lib/docbuilder/xsd/common.image.xsd index 17054eb23c..17054eb23c 100755..100644 --- a/lib/docbuilder/xsd/common.image.xsd +++ b/lib/docbuilder/xsd/common.image.xsd diff --git a/lib/docbuilder/xsd/common.refs.xsd b/lib/docbuilder/xsd/common.refs.xsd index 58b450669d..58b450669d 100755..100644 --- a/lib/docbuilder/xsd/common.refs.xsd +++ b/lib/docbuilder/xsd/common.refs.xsd diff --git a/lib/docbuilder/xsd/common.table.xsd b/lib/docbuilder/xsd/common.table.xsd index cf63df4317..cf63df4317 100755..100644 --- a/lib/docbuilder/xsd/common.table.xsd +++ b/lib/docbuilder/xsd/common.table.xsd diff --git a/lib/docbuilder/xsd/common.xsd b/lib/docbuilder/xsd/common.xsd index 3d43390bd8..3d43390bd8 100755..100644 --- a/lib/docbuilder/xsd/common.xsd +++ b/lib/docbuilder/xsd/common.xsd diff --git a/lib/docbuilder/xsd/comref.xsd b/lib/docbuilder/xsd/comref.xsd index 61df4dd848..61df4dd848 100755..100644 --- a/lib/docbuilder/xsd/comref.xsd +++ b/lib/docbuilder/xsd/comref.xsd diff --git a/lib/docbuilder/xsd/cref.xsd b/lib/docbuilder/xsd/cref.xsd index f1cbeddfff..f1cbeddfff 100755..100644 --- a/lib/docbuilder/xsd/cref.xsd +++ b/lib/docbuilder/xsd/cref.xsd diff --git a/lib/docbuilder/xsd/erlref.xsd b/lib/docbuilder/xsd/erlref.xsd index f6011b7bea..f6011b7bea 100755..100644 --- a/lib/docbuilder/xsd/erlref.xsd +++ b/lib/docbuilder/xsd/erlref.xsd diff --git a/lib/docbuilder/xsd/fascicules.xsd b/lib/docbuilder/xsd/fascicules.xsd index bfdb5bd604..bfdb5bd604 100755..100644 --- a/lib/docbuilder/xsd/fascicules.xsd +++ b/lib/docbuilder/xsd/fascicules.xsd diff --git a/lib/docbuilder/xsd/fileref.xsd b/lib/docbuilder/xsd/fileref.xsd index 8038f2115f..8038f2115f 100755..100644 --- a/lib/docbuilder/xsd/fileref.xsd +++ b/lib/docbuilder/xsd/fileref.xsd diff --git a/lib/docbuilder/xsd/part.xsd b/lib/docbuilder/xsd/part.xsd index 30d6ec0120..30d6ec0120 100755..100644 --- a/lib/docbuilder/xsd/part.xsd +++ b/lib/docbuilder/xsd/part.xsd diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl index 575bbfe43d..575bbfe43d 100755..100644 --- a/lib/hipe/icode/hipe_icode_pp.erl +++ b/lib/hipe/icode/hipe_icode_pp.erl diff --git a/lib/hipe/icode/hipe_icode_ssa.erl b/lib/hipe/icode/hipe_icode_ssa.erl index 719d5d8f45..719d5d8f45 100755..100644 --- a/lib/hipe/icode/hipe_icode_ssa.erl +++ b/lib/hipe/icode/hipe_icode_ssa.erl diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile index 55d20af8af..690045b978 100644 --- a/lib/hipe/rtl/Makefile +++ b/lib/hipe/rtl/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2010. All Rights Reserved. +# Copyright Ericsson AB 2001-2011. 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 @@ -108,10 +108,30 @@ release_spec: opt release_docs_spec: -HIPE_MKLITERALS=$(ERL_TOP)/bin/$(TARGET)/hipe_mkliterals +ifeq ($(TYPE),debug) +TYPE_STR=.debug +else +TYPE_STR= +endif + +ifeq ($(FLAVOR),smp) +FLAVOR_STR=.smp +else +FLAVOR_STR= +endif + +ifeq ($(XCOMP),yes) +MKLIT_FLAGS= -x +else +MKLIT_FLAGS= +endif + + +HIPE_MKLITERALS=$(ERL_TOP)/bin/$(TARGET)/hipe_mkliterals$(TYPE_STR)$(FLAVOR_STR) + hipe_literals.hrl: $(HIPE_MKLITERALS) - $(HIPE_MKLITERALS) -e > hipe_literals.hrl + $(HIPE_MKLITERALS) $(MKLIT_FLAGS) -e > hipe_literals.hrl # Need to generate hipe.hrl from one and only one target in one and only # one makefile; otherwise, clearmake will force rebuilds of hipe over and diff --git a/lib/hipe/util/hipe_dot.erl b/lib/hipe/util/hipe_dot.erl index d6ef801c88..d6ef801c88 100755..100644 --- a/lib/hipe/util/hipe_dot.erl +++ b/lib/hipe/util/hipe_dot.erl diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index e2dbcbe63d..26d1e27822 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -42,7 +42,7 @@ system.</p> <p>An Erlang runtime system to be monitored by a heart program, should be started with the command line flag <c>-heart</c> (see - also <seealso marker="erts:erl">erl(1)</seealso>. The <c>heart</c> + also <seealso marker="erts:erl">erl(1)</seealso>). The <c>heart</c> process is then started automatically:</p> <pre> % <input>erl -heart ...</input></pre> diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index c34f2ddeb0..e33b4830ab 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -117,8 +117,9 @@ server1(Iport, Oport, Shell) -> {Curr,Shell1} = case init:get_argument(remsh) of {ok,[[Node]]} -> - RShell = {list_to_atom(Node),shell,start,[]}, - RGr = group:start(self(), RShell), + ANode = list_to_atom(Node), + RShell = {ANode,shell,start,[]}, + RGr = group:start(self(), RShell, rem_sh_opts(ANode)), {RGr,RShell}; E when E =:= error ; E =:= {ok,[[]]} -> {group:start(self(), Shell),Shell} @@ -134,6 +135,9 @@ server1(Iport, Oport, Shell) -> %% Enter the server loop. server_loop(Iport, Oport, Curr, User, Gr). +rem_sh_opts(Node) -> + [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. + %% start_user() %% Start a group leader process and register it as 'user', unless, %% of course, a 'user' already exists. diff --git a/lib/kernel/test/pg2_SUITE.erl b/lib/kernel/test/pg2_SUITE.erl index 0ac34e735c..520b53b4e4 100644 --- a/lib/kernel/test/pg2_SUITE.erl +++ b/lib/kernel/test/pg2_SUITE.erl @@ -47,6 +47,7 @@ init_per_testcase(Case, Config) -> [{?TESTCASE, Case}, {watchdog, Dog} | Config]. end_per_testcase(_Case, _Config) -> + test_server_ctrl:kill_slavenodes(), Dog = ?config(watchdog, _Config), test_server:timetrap_cancel(Dog), ok. diff --git a/lib/megaco/.gitignore b/lib/megaco/.gitignore new file mode 100644 index 0000000000..1c5979cd62 --- /dev/null +++ b/lib/megaco/.gitignore @@ -0,0 +1,3 @@ +examples/meas/Makefile +examples/meas/meas.sh.skel +examples/meas/mstone1.sh.skel diff --git a/lib/megaco/configure.in b/lib/megaco/configure.in index 8f94a4efcf..b88e17ec85 100644 --- a/lib/megaco/configure.in +++ b/lib/megaco/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. -*-m4-*- dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 2001-2010. All Rights Reserved. +dnl Copyright Ericsson AB 2001-2011. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -273,5 +273,6 @@ if test "$PERL" = no_perl; then AC_MSG_ERROR([Perl is required to build the flex scanner!]) fi +AC_OUTPUT(examples/meas/Makefile:examples/meas/Makefile.in) AC_OUTPUT(src/flex/$host/Makefile:src/flex/Makefile.in) diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index 2aba8db71b..baf8c6a201 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,6 +36,61 @@ section is the version number of Megaco.</p> + <section><title>Megaco 3.15.1.2</title> + + <p>Version 3.15.1.2 supports code replacement in runtime from/to + version 3.15.1.1, 3.15.1 and 3.15.</p> + + <section> + <title>Improvements and new features</title> + +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>Minor improvemnts to the emasurement tool mstone1. </p> + <p>Own Id: OTP-9604</p> + </item> + + <item> + <p>ASN.1 no longer makes use of a driver to accelerate encode/decode, + instead it uses NIFs. The encoding config option is <em>still</em> + the same, i.e. <c>driver</c>. </p> + <p>Own Id: OTP-9672</p> + </item> + + <item> + <p>The profiling test tool has been rewritten. </p> + <p>Håkan Mattsson</p> + <p>Own Id: OTP-9679</p> + </item> + + </list> + + </section> + + <section> + <title>Fixed bugs and malfunctions</title> + + <p>-</p> + + <!-- + <list type="bulleted"> + <item> + <p>Fixing miscellaneous things detected by dialyzer. </p> + <p>Own Id: OTP-9075</p> + </item> + + </list> + --> + + </section> + + </section> <!-- 3.15.1.2 --> + + <section><title>Megaco 3.15.1.1</title> <p>Version 3.15.1.1 supports code replacement in runtime from/to diff --git a/lib/megaco/examples/meas/Makefile b/lib/megaco/examples/meas/Makefile.in index 0a6cbb44a6..6af7ef6c65 100644 --- a/lib/megaco/examples/meas/Makefile +++ b/lib/megaco/examples/meas/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2011. 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 @@ -35,12 +35,19 @@ VSN=$(MEGACO_VSN) # ---------------------------------------------------- +# Configured variables +# ---------------------------------------------------- +PERL = @PERL@ + + +# ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/megaco-$(VSN) EXAMPLE_RELSYSDIR = $(RELSYSDIR)/examples MEAS_RELSYSDIR = $(EXAMPLE_RELSYSDIR)/meas + # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- @@ -49,9 +56,13 @@ include modules.mk ERL_FILES = $(MODULES:%=%.erl) -TARGET_FILES = \ +SCRIPT_SKELETONS = $(SCRIPT_SKELETON_SRC:%.src=%) + +ERL_TARGETS = \ $(ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) +TARGET_FILES = $(SCRIPT_SKELETONS) $(ERL_TARGETS) + # ---------------------------------------------------- # FLAGS @@ -91,12 +102,27 @@ debug: opt: $(TARGET_FILES) +script_skeletons: $(SCRIPT_SKELETONS) + +info: + @echo "MODULES = $(MODULES)" + @echo "ERL_FILED = $(ERL_FILES)" + @echo "" + @echo "SCRIPT_SKELETON_SRC = $(SCRIPT_SKELETON_SRC)" + @echo "SCRIPT_SKELETONS = $(SCRIPT_SKELETONS)" + @echo "" + @echo "TARGET_FILES = $(TARGET_FILES)" + @echo "" + clean: rm -f $(TARGET_FILES) rm -f errs core *~ docs: +conf: + cd ../..; $(MAKE) conf + # ---------------------------------------------------- # Release Target @@ -120,6 +146,14 @@ release_docs_spec: # Include dependencies # ---------------------------------------------------- +meas.sh.skel: meas.sh.skel.src + @echo "transforming $< to $@" + $(PERL) -p -e 's?%VSN%?$(VSN)? ' < $< > $@ + +mstone1.sh.skel: mstone1.sh.skel.src + @echo "transforming $< to $@" + $(PERL) -p -e 's?%VSN%?$(VSN)? ' < $< > $@ + megaco_codec_transform.$(EMULATOR): megaco_codec_transform.erl megaco_codec_meas.$(EMULATOR): megaco_codec_meas.erl diff --git a/lib/megaco/examples/meas/meas.sh.skel b/lib/megaco/examples/meas/meas.sh.skel.src index 76745ed8f4..c7bd6cdd2a 100644 --- a/lib/megaco/examples/meas/meas.sh.skel +++ b/lib/megaco/examples/meas/meas.sh.skel.src @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2010. All Rights Reserved. +# Copyright Ericsson AB 2007-2011. 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 @@ -22,7 +22,7 @@ # ERL_HOME=<path to otp top dir> -MEGACO_HOME=$ERL_HOME/lib/erlang/lib/<megaco dir> +MEGACO_HOME=$ERL_HOME/lib/erlang/lib/megaco-%VSN% MEAS_HOME=$MEGACO_HOME/examples/meas PATH=$ERL_HOME/bin:$PATH diff --git a/lib/megaco/examples/meas/modules.mk b/lib/megaco/examples/meas/modules.mk index 8f1b45c8a6..26979933d7 100644 --- a/lib/megaco/examples/meas/modules.mk +++ b/lib/megaco/examples/meas/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2011. 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 @@ -17,9 +17,9 @@ # # %CopyrightEnd% -SCRIPT_SKELETONS = \ - meas.sh.skel \ - mstone1.sh.skel +SCRIPT_SKELETON_SRC = \ + meas.sh.skel.src \ + mstone1.sh.skel.src MESSAGE_PACKAGES = \ time_test.msgs diff --git a/lib/megaco/examples/meas/mstone1.sh.skel b/lib/megaco/examples/meas/mstone1.sh.skel.src index b7c7e41007..54a6c61a58 100644 --- a/lib/megaco/examples/meas/mstone1.sh.skel +++ b/lib/megaco/examples/meas/mstone1.sh.skel.src @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2009. All Rights Reserved. +# Copyright Ericsson AB 2007-2011. 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 @@ -59,7 +59,7 @@ Options: " ERL_HOME=<path to otp top dir> -MEGACO_HOME=$ERL_HOME/lib/erlang/lib/<megaco dir> +MEGACO_HOME=$ERL_HOME/lib/erlang/lib/megaco-%VSN% MEAS_HOME=$MEGACO_HOME/examples/meas PATH=$ERL_HOME/bin:$PATH diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 7107178d1a..7f6fe0c733 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -139,10 +139,17 @@ %% | %% v %% 3.15.1.1 +%% | +%% v +%% 3.15.1.2 %% %% {"%VSN%", [ + {"3.15.1.1", + [ + ] + }, {"3.15.1", [ ] @@ -160,6 +167,10 @@ } ], [ + {"3.15.1.1", + [ + ] + }, {"3.15.1", [ ] diff --git a/lib/megaco/test/megaco_codec_v1_test.erl b/lib/megaco/test/megaco_codec_v1_test.erl index 3a548c4d9e..e9c19605dd 100644 --- a/lib/megaco/test/megaco_codec_v1_test.erl +++ b/lib/megaco/test/megaco_codec_v1_test.erl @@ -371,9 +371,9 @@ profile_decode_text_messages(Slogan, Codec, Config, Msgs0) -> decode_text_messages(Codec, Config, Bins, []) end, %% Make a dry run, just to make sure all modules are loaded: - io:format("make a dry run..~n", []), + io:format("make a dry run...~n", []), (catch Fun()), - io:format("make the run..~n", []), + io:format("make the run...~n", []), megaco_profile:profile(Slogan, Fun). %% (catch megaco_codec_v1_test:profile_encode_compact_text_messages()). diff --git a/lib/megaco/test/megaco_codec_v2_test.erl b/lib/megaco/test/megaco_codec_v2_test.erl index c3a80febba..1d3fcb36e9 100644 --- a/lib/megaco/test/megaco_codec_v2_test.erl +++ b/lib/megaco/test/megaco_codec_v2_test.erl @@ -346,9 +346,9 @@ profile_decode_text_messages(Slogan, Codec, Config, Msgs0) -> decode_text_messages(Codec, Config, Bins, []) end, %% Make a dry run, just to make sure all modules are loaded: - io:format("make a dry run..~n", []), + io:format("make a dry run...~n", []), (catch Fun()), - io:format("make the run..~n", []), + io:format("make the run...~n", []), megaco_profile:profile(Slogan, Fun). %% (catch megaco_codec_v2_test:profile_encode_compact_text_messages()). diff --git a/lib/megaco/test/megaco_mess_test.erl b/lib/megaco/test/megaco_mess_test.erl index ded1506271..383e3df774 100644 --- a/lib/megaco/test/megaco_mess_test.erl +++ b/lib/megaco/test/megaco_mess_test.erl @@ -34,12 +34,12 @@ %% -compile(export_all). -export([ - all/0,groups/0,init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, + all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + init_per_testcase/2, end_per_testcase/2, connect/1, - request_and_reply_plain/1, request_and_no_reply/1, @@ -347,39 +347,83 @@ end_per_testcase(Case, Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% all() -> - [connect, {group, request_and_reply}, - {group, pending_ack}, dist, {group, tickets}]. + [ + connect, + {group, request_and_reply}, + {group, pending_ack}, + dist, + {group, tickets} + ]. groups() -> - [{request_and_reply, [], - [request_and_reply_plain, request_and_no_reply, + [ + {request_and_reply, [], + [request_and_reply_plain, + request_and_no_reply, request_and_reply_pending_ack_no_pending, request_and_reply_pending_ack_one_pending, single_trans_req_and_reply, single_trans_req_and_reply_sendopts, - request_and_reply_and_ack, request_and_reply_and_no_ack, + request_and_reply_and_ack, + request_and_reply_and_no_ack, request_and_reply_and_late_ack, trans_req_and_reply_and_req]}, {pending_ack, [], [pending_ack_plain, request_and_pending_and_late_reply]}, {tickets, [], - [otp_4359, otp_4836, otp_5805, otp_5881, otp_5887, - otp_6253, otp_6275, otp_6276, {group, otp_6442}, - {group, otp_6865}, otp_7189, otp_7259, otp_7713, - {group, otp_8183}, otp_8212]}, + [otp_4359, + otp_4836, + otp_5805, + otp_5881, + otp_5887, + otp_6253, + otp_6275, + otp_6276, + {group, otp_6442}, + {group, otp_6865}, + otp_7189, + otp_7259, + otp_7713, + {group, otp_8183}, + otp_8212]}, {otp_6442, [], - [otp_6442_resend_request1, otp_6442_resend_request2, - otp_6442_resend_reply1, otp_6442_resend_reply2]}, + [otp_6442_resend_request1, + otp_6442_resend_request2, + otp_6442_resend_reply1, + otp_6442_resend_reply2]}, {otp_6865, [], [otp_6865_request_and_reply_plain_extra1, otp_6865_request_and_reply_plain_extra2]}, - {otp_8183, [], [otp_8183_request1]}]. + {otp_8183, [], [otp_8183_request1]} + ]. + + +init_per_suite(Config) -> + io:format("~w:init_per_suite -> entry with" + "~n Config: ~p" + "~n", [?MODULE, Config]), + Config. + +end_per_suite(_Config) -> + io:format("~w:end_per_suite -> entry with" + "~n _Config: ~p" + "~n", [?MODULE, _Config]), + ok. + init_per_group(_GroupName, Config) -> + io:format("~w:init_per_group -> entry with" + "~n _GroupName: ~p" + "~n Config: ~p" + "~n", [?MODULE, _GroupName, Config]), Config. end_per_group(_GroupName, Config) -> + io:format("~w:end_per_group -> entry with" + "~n _GroupName: ~p" + "~n Config: ~p" + "~n", [?MODULE, _GroupName, Config]), Config. @@ -394,12 +438,16 @@ connect(Config) when is_list(Config) -> PrelMid = preliminary_mid, MgMid = ipv4_mid(4711), + d("connect -> start megaco app",[]), ?VERIFY(ok, application:start(megaco)), + d("connect -> start (MG) user ~p",[MgMid]), ?VERIFY(ok, megaco:start_user(MgMid, [{send_mod, bad_send_mod}, {request_timer, infinity}, {reply_timer, infinity}])), + d("connect -> get receive info for ~p",[MgMid]), MgRH = user_info(MgMid, receive_handle), + d("connect -> (MG) try connect to MGC",[]), {ok, PrelCH} = ?VERIFY({ok, _}, megaco:connect(MgRH, PrelMid, sh, self())), connections([PrelCH]), @@ -6776,16 +6824,12 @@ rapalr_mg_notify_request_ar(Rid, Tid, Cid) -> - - - - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% dist(suite) -> []; dist(Config) when is_list(Config) -> + ?SKIP("Needs a re-write..."), [_Local, Dist] = ?ACQUIRE_NODES(2, Config), d("dist -> start proxy",[]), megaco_mess_user_test:start_proxy(), @@ -6897,7 +6941,11 @@ dist(Config) when is_list(Config) -> ?VERIFY(ok, application:stop(megaco)), ?RECEIVE([]), - d("dist -> done",[]), + + d("dist -> stop proxy",[]), + megaco_mess_user_test:stop_proxy(), + + d("dist -> done", []), ok. diff --git a/lib/megaco/test/megaco_profile.erl b/lib/megaco/test/megaco_profile.erl index d0b62610e1..344c551970 100644 --- a/lib/megaco/test/megaco_profile.erl +++ b/lib/megaco/test/megaco_profile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2009. 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 @@ -24,50 +24,102 @@ -module(megaco_profile). --export([profile/2]). - +-export([profile/2, prepare/2, analyse/1, + fprof_to_calltree/1, fprof_to_calltree/2, fprof_to_calltree/3]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Execute Fun and profile it with fprof. -profile(Slogan, Fun) when is_function(Fun) -> +profile(Slogan, Fun) when is_function(Fun, 0) -> Pids = [self()], - profile(Slogan, Fun, Pids). + {ok, TraceFile} = prepare(Slogan, Pids), + Res = (catch Fun()), + {ok, _DestFile} = analyse(Slogan), + ok = file:delete(TraceFile), + {ok, _TreeFile} = fprof_to_calltree(Slogan), + Res. -profile(Slogan, Fun, Pids) -> +%% Prepare for tracing +prepare(Slogan, Pids) -> TraceFile = lists:concat(["profile_", Slogan, "-fprof.trace"]), - DestFile = lists:concat(["profile_", Slogan, ".fprof"]), - TreeFile = lists:concat(["profile_", Slogan, ".calltree"]), - erlang:garbage_collect(), {ok, _Pid} = fprof:start(), + erlang:garbage_collect(), TraceOpts = [start, - {cpu_time, false}, - {procs, Pids}, - {file, TraceFile} + {cpu_time, false}, + {procs, Pids}, + {file, TraceFile} ], - ok = fprof:trace(TraceOpts), - Res = (catch Fun()), - ok = fprof:trace(stop), - ok = fprof:profile([{file, TraceFile}]), - ok = fprof:analyse([{dest, DestFile}]), - ok = fprof:stop(), - ok = file:delete(TraceFile), - reformat_total(DestFile, TreeFile), - Res. + ok = fprof:trace(TraceOpts), + {ok, TraceFile}. -reformat_total(FromFile, ToFile) -> - {ok, ConsultedFromFile} = file:consult(FromFile), - [_AnalysisOpts, [Totals] | Terms] = ConsultedFromFile, - {totals, _, TotalAcc, _} = Totals, +%% Stop tracing and analyse it +analyse(Slogan) -> + fprof:trace(stop), + TraceFile = lists:concat(["profile_", Slogan, "-fprof.trace"]), + DestFile = lists:concat(["profile_", Slogan, ".fprof"]), + try + case fprof:profile([{file, TraceFile}]) of + ok -> + ok = fprof:analyse([{dest, DestFile}, {totals, false}]), + {ok, DestFile}; + {error, Reason} -> + {error, Reason} + end + after + fprof:stop() + end. + +fprof_to_calltree(Slogan) -> + fprof_to_calltree(Slogan, 0). + +fprof_to_calltree(Slogan, MinPercent) -> + DestFile = lists:concat(["profile_", Slogan, ".fprof"]), + TreeFile = lists:concat(["profile_", Slogan, ".calltree"]), + fprof_to_calltree(DestFile, TreeFile, MinPercent). + +%% Create a calltree from an fprof file +fprof_to_calltree(FromFile, ToFile, MinPercent) -> + ReplyTo = self(), + Ref = make_ref(), + spawn_link(fun() -> + ReplyTo ! {Ref, do_fprof_to_calltree(FromFile, ToFile, MinPercent)} + end), + wait_for_reply(Ref). + +wait_for_reply(Ref) -> + receive + {Ref, Res} -> + Res; + {'EXIT', normal} -> + wait_for_reply(Ref); + {'EXIT', Reason} -> + exit(Reason) + end. + +do_fprof_to_calltree(FromFile, ToFile, MinPercent) -> {ok, Fd} = file:open(ToFile, [write, raw]), - Indent = "", - log(Fd, Indent, TotalAcc, Totals), - Processes = split_processes(Terms, [], []), - Reformat = fun(P) -> reformat_process(Fd, " " ++ Indent, TotalAcc, P) end, - lists:foreach(Reformat, Processes), - file:close(Fd). + {ok, ConsultedFromFile} = file:consult(FromFile), + [_AnalysisOpts, [_Totals] | Terms] = ConsultedFromFile, + Processes = split_processes(Terms, [], []), + Indent = "", + Summary = collapse_processes(Processes), + {_Label, _Cnt, Acc, _Own, _Roots, Details} = Summary, + %% log(Fd, Label, Indent, Acc, {Label, Cnt, Acc, Own}, [], 0), + gen_calltree(Fd, Indent, Acc, Summary, MinPercent), + Delim = io_lib:format("\n~80..=c\n\n", [$=]), + Write = + fun(P) -> + file:write(Fd, Delim), + gen_calltree(Fd, Indent, Acc, P, MinPercent) + end, + lists:foreach(Write, Processes), + file:write(Fd, Delim), + gen_details(Fd, Acc, Details), + file:close(Fd), + {ok, ToFile}. +%% Split all fprof terms into a list of processes split_processes([H | T], ProcAcc, TotalAcc) -> if is_tuple(H) -> @@ -75,64 +127,185 @@ split_processes([H | T], ProcAcc, TotalAcc) -> is_list(H), ProcAcc =:= [] -> split_processes(T, [H], TotalAcc); is_list(H) -> - split_processes(T, [H], [lists:reverse(ProcAcc) | TotalAcc]) + ProcAcc2 = rearrange_process(lists:reverse(ProcAcc)), + split_processes(T, [H], [ProcAcc2 | TotalAcc]) end; split_processes([], [], TotalAcc) -> - lists:reverse(TotalAcc); + lists:reverse(lists:keysort(3, TotalAcc)); split_processes([], ProcAcc, TotalAcc) -> - lists:reverse([lists:reverse(ProcAcc) | TotalAcc]). - -reformat_process(Fd, Indent, TotalAcc, Terms) -> - case Terms of - [[{ProcLabel, _, _, _}] | All] -> ok; - [[{ProcLabel,_,_,_} | _] | All] -> ok - end, - [{_, {TopKey, TopCnt, TopAcc, TopOwn}, _} | _] = All, - Process = {ProcLabel, TopCnt, TopAcc, TopOwn}, - log(Fd, Indent, TotalAcc, Process), - reformat_calls(Fd, " " ++ Indent, TotalAcc, TopKey, All, []). - -reformat_calls(Fd, Indent, TotalAcc, Key, Terms, Stack) -> - {_CalledBy, Current, Calls} = find(Key, Terms), - log(Fd, Indent, TotalAcc, Current), - case lists:member(Key, Stack) of - true -> - ok; - false -> - case Key of - {io_lib, _, _} -> - ok; - {disk_log, _, _} -> - ok; - {lists, flatten, _} -> - ok; - {lists, keysort, _} -> - ok; - _ -> - Fun = fun({NextKey, _, _, _}) -> - reformat_calls(Fd, - " " ++ Indent, - TotalAcc, - NextKey, - Terms, - [Key | Stack]) - end, - lists:foreach(Fun, Calls) - end + ProcAcc2 = rearrange_process(lists:reverse(ProcAcc)), + lists:reverse(lists:keysort(3, [ProcAcc2 | TotalAcc])). + +%% Rearrange the raw process list into a more useful format +rearrange_process([[{Label, _Cnt, _Acc, _Own} | _ ] | Details]) -> + do_rearrange_process(Details, Details, Label, [], []). + +do_rearrange_process([{CalledBy, Current, _Calls} | T], Orig, Label, Roots, Undefs) -> + case [{undefined, Cnt, safe_max(Acc, Own), Own} || + {undefined, Cnt, Acc, Own} <- CalledBy] of + [] -> + do_rearrange_process(T, Orig, Label, Roots, Undefs); + NewUndefs -> + do_rearrange_process(T, Orig, Label, [Current | Roots], NewUndefs ++ Undefs) + end; +do_rearrange_process([], Details, Label, Roots, Undefs) -> + [{undefined, Cnt, Acc, Own}] = collapse_calls(Undefs, []), + Details2 = sort_details(3, Details), + {Label, Cnt, Acc, Own, lists:reverse(lists:keysort(3, Roots)), Details2}. + +%% Compute a summary of the rearranged process info +collapse_processes(Processes) -> + Headers = lists:map(fun({_L, C, A, O, _R, _D}) -> {"SUMMARY", C, A, O} end, + Processes), + [{Label, Cnt, Acc, Own}] = collapse_calls(Headers, []), + Details = lists:flatmap(fun({_L, _C, _A, _O, _R, D}) -> D end, Processes), + Details2 = do_collapse_processes(sort_details(1, Details), []), + Roots = lists:flatmap(fun({_L, _C, _A, _O, R, _D}) -> R end, Processes), + RootMFAs = lists:usort([MFA || {MFA, _, _, _} <- Roots]), + Roots2 = [R || RootMFA <- RootMFAs, + {_, {MFA, _, _, _} = R, _} <- Details2, + MFA =:= RootMFA], + Roots3 = collapse_calls(Roots2, []), + {Label, Cnt, Acc, Own, Roots3, Details2}. + +do_collapse_processes([{CalledBy1, {MFA, Cnt1, Acc1, Own1}, Calls1} | T1], + [{CalledBy2, {MFA, Cnt2, Acc2, Own2}, Calls2} | T2]) -> + Cnt = Cnt1 + Cnt2, + Acc = Acc1 + Acc2, + Own = Own1 + Own2, + Current = {MFA, Cnt, Acc, Own}, + CalledBy0 = CalledBy1 ++ CalledBy2, + Calls0 = Calls1 ++ Calls2, + CalledBy = collapse_calls(lists:keysort(3, CalledBy0), []), + Calls = collapse_calls(lists:keysort(3, Calls0), []), + do_collapse_processes(T1, [{CalledBy, Current, Calls} | T2]); +do_collapse_processes([{CalledBy, Current, Calls} | T1], + T2) -> + do_collapse_processes(T1, [{CalledBy, Current, Calls} | T2]); +do_collapse_processes([], + T2) -> + sort_details(3, T2). + +%% Reverse sort on acc field +sort_details(Pos, Details) -> + Pivot = fun({_CalledBy1, Current1, _Calls1}, + {_CalledBy2, Current2, _Calls2}) -> + element(Pos, Current1) =< element(Pos, Current2) + end, + lists:reverse(lists:sort(Pivot, Details)). + +%% Compute a summary from a list of call tuples +collapse_calls([{MFA, Cnt1, Acc1, Own1} | T1], + [{MFA, Cnt2, Acc2, Own2} | T2]) -> + Cnt = Cnt1 + Cnt2, + Acc = safe_sum(Acc1, Acc2), + Own = Own1 + Own2, + collapse_calls(T1, [{MFA, Cnt, Acc, Own} | T2]); +collapse_calls([{MFA, Cnt, Acc, Own} | T1], + T2) -> + collapse_calls(T1, [{MFA, Cnt, Acc, Own} | T2]); +collapse_calls([], + T2) -> + lists:reverse(lists:keysort(3, T2)). + +safe_sum(Int1, Int2) -> + if + Int1 =:= undefined -> Int2; + Int2 =:= undefined -> Int1; + true -> Int1 + Int2 + end. + +safe_max(Int1, Int2) -> + if + Int1 =:= undefined -> + io:format("111\n", []), + Int2; + Int2 =:= undefined -> + io:format("222\n", []), + Int1; + Int2 > Int1 -> Int2; + true -> Int1 + end. + +%% Compute a calltree and write it to file +gen_calltree(Fd, Indent, TotalAcc, {Label, Cnt, Acc, Own, Roots, Details}, MinPercent) -> + Header = {Label, Cnt, Acc, Own}, + MetaLabel = "Process", + Diff = length(Label) - length(MetaLabel), + IoList = io_lib:format("~s~s Lvl Pct Cnt Acc Own Calls => MFA\n", + [MetaLabel, lists:duplicate(Diff, $\ )]), + file:write(Fd, IoList), + log(Fd, Label, Indent, TotalAcc, Header, Roots, MinPercent), + NewIndent = " " ++ Indent, + Fun = fun({MFA, _C, _A, _O}) -> + [put_detail(Label, D) || D <- Details], + gen_calls(Fd, Label, NewIndent, TotalAcc, MFA, MinPercent) + end, + lists:foreach(Fun, Roots). + +gen_calls(Fd, Label, Indent, TotalAcc, MFA, MinPercent) -> + case get_detail(Label, MFA) of + {read, {_CalledBy, Current, _Calls}} -> + log(Fd, Label, Indent, TotalAcc, Current, -1, MinPercent); + {unread, {_CalledBy, Current, Calls}} -> + log(Fd, Label, Indent, TotalAcc, Current, Calls, MinPercent), + NewIndent = " " ++ Indent, + Fun = fun({NextMFA, _, _, _}) -> + gen_calls(Fd, Label, NewIndent, TotalAcc, + NextMFA, MinPercent) + end, + lists:foreach(Fun, Calls) + end. + +put_detail(Label, {_, {MFA, _, _, _}, _} = Detail) -> + put({Label, MFA}, {unread, Detail}). + +get_detail(Label, MFA) -> + Val = get({Label, MFA}), + case Val of + {unread, Detail} -> + put({Label, MFA}, {read, Detail}), + Val; + {read, _Detail} -> + Val + end. + +gen_details(Fd, Total, Details) -> + IoList = io_lib:format("Pct Cnt Acc Own MFA\n", []), + file:write(Fd, IoList), + do_gen_details(Fd, Total, Details). + +do_gen_details(Fd, Total, [{_CalledBy, {MFA, Cnt, Acc, Own}, _Calls} | Details]) -> + MFAStr = io_lib:format("~p", [MFA]), + {_, Percent} = calc_percent(Acc, Own, Total), + IoList = io_lib:format("~3.. B% ~10.3B ~10.3f ~10.3f => ~s\n", + [Percent, Cnt, Acc, Own, MFAStr]), + file:write(Fd, IoList), + do_gen_details(Fd, Total, Details); +do_gen_details(_Fd, _Total, []) -> + ok. + +log(Fd, Label, Indent, Acc, Current, Calls, MinPercent) when is_list(Calls) -> + log(Fd, Label, Indent, Acc, Current, length(Calls), MinPercent); +log(Fd, Label, Indent, Total, {MFA, Cnt, Acc, Own}, N, MinPercent) -> + {Max, Percent} = calc_percent(Acc, Own, Total), + if + Percent >= MinPercent -> + do_log(Fd, Label, Indent, Percent, MFA, Cnt, Max, Own, N); + true -> + ok end. -find(Key, [{_, {Key, _, _, _}, _} = H | _]) -> - H; -find(Key, [{_, {_, _, _, _}, _} | T]) -> - find(Key, T). - -log(Fd, Indent, Total, {Label, Cnt, Acc, Own}) -> - Percent = case Acc of - undefined -> 100; - _ -> trunc((lists:max([Acc, Own]) * 100) / Total) - end, - Label2 = io_lib:format("~p", [Label]), - IoList = io_lib:format("~s~p% ~s \t~p \t~p \t~p\n", - [Indent, Percent, Label2, Cnt, trunc(Acc), trunc(Own)]), +do_log(Fd, Label, Indent, Percent, MFA, Cnt, Acc, Own, N) -> + MFAStr = io_lib:format("~p", [MFA]), + CallsStr = io_lib:format(" ~5.. s ", [lists:concat([N])]), + IoList = io_lib:format("~s ~3.. B " + "~s~3.. B% ~10.. B ~10.. B ~10.. B ~s => ~s\n", + [Label, length(Indent) div 2, + Indent, Percent, Cnt, + round(Acc), round(Own), CallsStr, MFAStr]), file:write(Fd, IoList). +calc_percent(Acc, Own, Total) -> + Max = safe_max(Acc, Own), + {Max, round((Max * 100) / Total)}. diff --git a/lib/megaco/test/megaco_test_lib.erl b/lib/megaco/test/megaco_test_lib.erl index 41f6c2c4cb..282fd91b44 100644 --- a/lib/megaco/test/megaco_test_lib.erl +++ b/lib/megaco/test/megaco_test_lib.erl @@ -21,6 +21,7 @@ %%---------------------------------------------------------------------- %% Purpose: Lightweight test server %%---------------------------------------------------------------------- +%% -module(megaco_test_lib). @@ -684,7 +685,7 @@ skip(Actual, File, Line) -> fatal_skip(Actual, File, Line) -> error(Actual, File, Line), - exit(shutdown). + exit({skipped, {fatal, Actual, File, Line}}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -749,6 +750,7 @@ proxy_loop(OwnId, Controller) -> proxy_loop(OwnId, Controller) end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test server callbacks init_per_testcase(_Case, Config) -> @@ -852,10 +854,10 @@ watchdog(Pid, Time) -> prepare_test_case(Actions, N, Config, File, Line) -> OrigNodes = lookup_config(nodes, Config), TestNodes = lookup_config(nodenames, Config), %% For testserver - This = node(), + This = node(), SomeNodes = OrigNodes ++ (TestNodes -- OrigNodes), - AllNodes = [This | (SomeNodes -- [This])], - Nodes = pick_n_nodes(N, AllNodes, File, Line), + AllNodes = [This | (SomeNodes -- [This])], + Nodes = pick_n_nodes(N, AllNodes, File, Line), start_nodes(Nodes, File, Line), do_prepare_test_case(Actions, Nodes, Config, File, Line). diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index c1476488ca..35acffcb64 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.15.1.1 +MEGACO_VSN = 3.15.1.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 8ef573a948..1bb80f8fe3 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,35 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.5</title> + <section><title>Mnesia 4.5.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix deadlock in mnesia:del_table_copy/2.</p> + <p> + Own Id: OTP-9689 Aux Id: seq11927 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Allow schema operations when using different mnesia + versions.</p> + <p> + Own Id: OTP-9657 Aux Id: seq11926 </p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.5</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia.appup.src b/lib/mnesia/src/mnesia.appup.src index fe4e5e2e7a..e0954ad206 100644 --- a/lib/mnesia/src/mnesia.appup.src +++ b/lib/mnesia/src/mnesia.appup.src @@ -1,12 +1,14 @@ %% -*- erlang -*- -{"%VSN%", +{"%VSN%", [ + {"4.5", [{restart_application, mnesia}]}, {"4.4.19", [{restart_application, mnesia}]}, {"4.4.18", [{restart_application, mnesia}]}, {"4.4.17", [{restart_application, mnesia}]}, {"4.4.16", [{restart_application, mnesia}]} ], [ + {"4.5", [{restart_application, mnesia}]}, {"4.4.19", [{restart_application, mnesia}]}, {"4.4.18", [{restart_application, mnesia}]}, {"4.4.17", [{restart_application, mnesia}]}, diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl index 47dcdad7ac..14414537b9 100644 --- a/lib/mnesia/src/mnesia_bup.erl +++ b/lib/mnesia/src/mnesia_bup.erl @@ -372,7 +372,9 @@ mk_str() -> lists:concat([node()] ++ Now ++ ".TMP"). make_initial_backup(Ns, Opaque, Mod) -> - Schema = [{schema, schema, mnesia_schema:get_initial_schema(disc_copies, Ns)}], + Orig = mnesia_schema:get_initial_schema(disc_copies, Ns), + Modded = proplists:delete(storage_properties, proplists:delete(majority, Orig)), + Schema = [{schema, schema, Modded}], O2 = do_apply(Mod, open_write, [Opaque], Opaque), O3 = do_apply(Mod, write, [O2, [mnesia_log:backup_log_header()]], O2), O4 = do_apply(Mod, write, [O3, Schema], O3), diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 1d3bd55b48..6a561394d5 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -289,40 +289,7 @@ get_remote_cstructs() -> get_cstructs() -> {cstructs, Cstructs, Running} = call(get_cstructs), Node = node(group_leader()), - {cstructs, normalize_cstructs(Cstructs, Node), Running}. - -normalize_cstructs(Cstructs, Node) -> - %% backward-compatibility hack; normalize before returning - case rpc:call(Node, mnesia_lib, val, [{schema,cstruct}]) of - {badrpc, _} -> - %% assume it's not a schema merge - Cstructs; - #cstruct{} -> - %% same format - Cstructs; - Cstruct -> - %% some other format - RemoteFields = [F || {F,_} <- rpc:call(Node, mnesia_schema, cs2list, [Cstruct])], - [convert_cs(Cs, RemoteFields) || Cs <- Cstructs] - end. - -convert_cs(Cs, Fields) -> - MyFields = record_info(fields, cstruct), - convert(tl(tuple_to_list(Cs)), MyFields, Fields, []). - -convert([H|T], [F|FsL], [F|FsR], Acc) -> - convert(T, FsL, FsR, [H|Acc]); -convert([H|T], [Fl|FsL] = L, [Fr|FsR] = R, Acc) -> - case {lists:member(Fl, FsR), lists:member(Fr, FsL)} of - {true, false} -> - convert(T, L, FsR, [H|Acc]); - {false, true} -> - %% Field Fl doesn't exist on receiver side; skip. - convert(T, FsL, R, Acc) - end; -convert([], _, _, Acc) -> - list_to_tuple([cstruct|lists:reverse(Acc)]). - + {cstructs, mnesia_schema:normalize_cs(Cstructs, Node), Running}. update(Fun) -> call({update,Fun}). diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index ec6b99ecaa..5a060a28ff 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -121,7 +121,7 @@ handle_system_event({mnesia_up, Node}, State) -> {ok, State#state{nodes = Nodes}}; handle_system_event({mnesia_down, Node}, State) -> - case mnesia:system_info(fallback_activated) of + case mnesia:system_info(fallback_activated) andalso Node =/= node() of true -> case mnesia_monitor:get_env(fallback_error_function) of {mnesia, lkill} -> @@ -129,8 +129,8 @@ handle_system_event({mnesia_down, Node}, State) -> "must be restarted. Forcing shutdown " "after mnesia_down from ~p...~n", report_fatal(Msg, [Node], nocore, State#state.dumped_core), - mnesia:lkill(), - exit(fatal); + catch exit(whereis(mnesia_monitor), fatal), + {ok, State}; {UserMod, UserFunc} -> Msg = "Warning: A fallback is installed and Mnesia got mnesia_down " "from ~p. ~n", diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl index 9e77fe0b9f..4a1616e054 100644 --- a/lib/mnesia/src/mnesia_frag.erl +++ b/lib/mnesia/src/mnesia_frag.erl @@ -758,7 +758,7 @@ make_activate(Tab, Props) -> [] -> Cs2 = Cs#cstruct{frag_properties = Props}, [Cs3] = expand_cstruct(Cs2, activate), - TabDef = mnesia_schema:cs2list(Cs3), + TabDef = mnesia_schema:vsn_cs2list(Cs3), Op = {op, change_table_frag, activate, TabDef}, [[Op]]; BadProps -> @@ -783,7 +783,7 @@ make_deactivate(Tab) -> mnesia:abort({combine_error, Tab, "Too many fragments"}); true -> Cs2 = Cs#cstruct{frag_properties = []}, - TabDef = mnesia_schema:cs2list(Cs2), + TabDef = mnesia_schema:vsn_cs2list(Cs2), Op = {op, change_table_frag, deactivate, TabDef}, [[Op]] end. @@ -850,7 +850,7 @@ make_add_frag(Tab, SortedNs) -> SplitOps = split(Tab, FH2, FromIndecies, FragNames, []), Cs2 = replace_frag_hash(Cs, FH2), - TabDef = mnesia_schema:cs2list(Cs2), + TabDef = mnesia_schema:vsn_cs2list(Cs2), BaseOp = {op, change_table_frag, {add_frag, SortedNs}, TabDef}, [BaseOp, NewOp | SplitOps]. @@ -962,7 +962,7 @@ make_del_frag(Tab) -> LastFrag = element(N, FragNames), [LastOp] = mnesia_schema:make_delete_table(LastFrag, single_frag), Cs2 = replace_frag_hash(Cs, FH2), - TabDef = mnesia_schema:cs2list(Cs2), + TabDef = mnesia_schema:vsn_cs2list(Cs2), BaseOp = {op, change_table_frag, del_frag, TabDef}, [BaseOp, LastOp | MergeOps]; _ -> @@ -1075,7 +1075,7 @@ make_add_node(Tab, Node) when is_atom(Node) -> Props = Cs#cstruct.frag_properties, Props2 = lists:keyreplace(node_pool, 1, Props, {node_pool, Pool2}), Cs2 = Cs#cstruct{frag_properties = Props2}, - TabDef = mnesia_schema:cs2list(Cs2), + TabDef = mnesia_schema:vsn_cs2list(Cs2), Op = {op, change_table_frag, {add_node, Node}, TabDef}, [Op]; true -> @@ -1104,7 +1104,7 @@ make_del_node(Tab, Node) when is_atom(Node) -> Pool2 = Pool -- [Node], Props = lists:keyreplace(node_pool, 1, Cs#cstruct.frag_properties, {node_pool, Pool2}), Cs2 = Cs#cstruct{frag_properties = Props}, - TabDef = mnesia_schema:cs2list(Cs2), + TabDef = mnesia_schema:vsn_cs2list(Cs2), Op = {op, change_table_frag, {del_node, Node}, TabDef}, [Op]; false -> diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index e110ad3241..8cb2e92c08 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -536,7 +536,11 @@ handle_info({'EXIT', Pid, R}, State) when Pid == State#state.supervisor -> handle_info({'EXIT', Pid, fatal}, State) when node(Pid) == node() -> dbg_out("~p got FATAL ERROR from: ~p~n",[?MODULE, Pid]), - exit(State#state.supervisor, shutdown), + %% This may hang supervisor if a shutdown happens at the same time as an fatal + %% is in progress + %% exit(State#state.supervisor, shutdown), + %% It is better to kill an innocent process + catch exit(whereis(mnesia_locker), kill), {noreply, State}; handle_info(Msg = {'EXIT',Pid,_}, State) -> diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 05be474aea..179e15197e 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -39,9 +39,10 @@ change_table_load_order/2, change_table_majority/2, change_table_frag/2, - clear_table/1, +%% clear_table/1, %% removed since it is not a schema op anymore create_table/1, cs2list/1, + vsn_cs2list/1, del_snmp/1, del_table_copy/2, del_table_index/2, @@ -65,6 +66,7 @@ merge_schema/0, merge_schema/1, move_table/3, + normalize_cs/2, opt_create_dir/2, prepare_commit/3, purge_dir/2, @@ -626,6 +628,17 @@ do_insert_schema_ops(Store, [Head | Tail]) -> do_insert_schema_ops(_Store, []) -> ok. +api_list2cs(List) when is_list(List) -> + Name = pick(unknown, name, List, must), + Keys = check_keys(Name, List, record_info(fields, cstruct)), + check_duplicates(Name, Keys), + list2cs(List); +api_list2cs(Other) -> + mnesia:abort({badarg, Other}). + +vsn_cs2list(Cs) -> + cs2list(need_old_cstructs(), Cs). + cs2list(Cs) when is_record(Cs, cstruct) -> Tags = record_info(fields, cstruct), rec2list(Tags, Tags, 2, Cs); @@ -648,7 +661,7 @@ cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> cs2list(false, Cs) -> cs2list(Cs); -cs2list(ver4_4_18, Cs) -> +cs2list(ver4_4_18, Cs) -> %% Or earlier Orig = record_info(fields, cstruct), Tags = [name,type,ram_copies,disc_copies,disc_only_copies, load_order,access_mode,index,snmp,local_content, @@ -671,13 +684,19 @@ rec2list([], _, _Pos, _Rec) -> rec2list(Tags, [_|Orig], Pos, Rec) -> rec2list(Tags, Orig, Pos+1, Rec). -api_list2cs(List) when is_list(List) -> - Name = pick(unknown, name, List, must), - Keys = check_keys(Name, List, record_info(fields, cstruct)), - check_duplicates(Name, Keys), - list2cs(List); -api_list2cs(Other) -> - mnesia:abort({badarg, Other}). +normalize_cs(Cstructs, Node) -> + %% backward-compatibility hack; normalize before returning + case need_old_cstructs([Node]) of + false -> + Cstructs; + Version -> + %% some other format + [convert_cs(Version, Cs) || Cs <- Cstructs] + end. + +convert_cs(Version, Cs) -> + Fields = [Value || {_, Value} <- cs2list(Version, Cs)], + list_to_tuple([cstruct|Fields]). list2cs(List) when is_list(List) -> Name = pick(unknown, name, List, must), @@ -1048,7 +1067,7 @@ unsafe_make_create_table(Cs) -> Nodes = mnesia_lib:intersect(mnesia_lib:cs_to_nodes(Cs), RunningNodes), Store = Ts#tidstore.store, mnesia_locker:wlock_no_exist(Tid, Store, Tab, Nodes), - [{op, create_table, cs2list(Cs)}]. + [{op, create_table, vsn_cs2list(Cs)}]. check_if_exists(Tab) -> TidTs = get_tid_ts_and_lock(schema, write), @@ -1133,7 +1152,7 @@ make_delete_table2(Tab) -> Cs = val({Tab, cstruct}), ensure_active(Cs), ensure_writable(Tab), - {op, delete_table, cs2list(Cs)}. + {op, delete_table, vsn_cs2list(Cs)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Change fragmentation of a table @@ -1152,10 +1171,6 @@ do_change_table_frag(Tab, _Change) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Clear a table -%% No need for a schema transaction -clear_table(Tab) -> - schema_transaction(fun() -> do_clear_table(Tab) end). - do_clear_table(schema) -> mnesia:abort({bad_type, schema}); do_clear_table(Tab) -> @@ -1166,7 +1181,7 @@ do_clear_table(Tab) -> make_clear_table(Tab) -> Cs = val({Tab, cstruct}), ensure_writable(Tab), - [{op, clear_table, cs2list(Cs)}]. + [{op, clear_table, vsn_cs2list(Cs)}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1206,7 +1221,7 @@ make_add_table_copy(Tab, Node, Storage) -> IsRunning == false -> mnesia:abort({not_active, schema, Node}) end, - [{op, add_table_copy, Storage, Node, cs2list(Cs2)}]. + [{op, add_table_copy, Storage, Node, vsn_cs2list(Cs2)}]. del_table_copy(Tab, Node) -> schema_transaction(fun() -> do_del_table_copy(Tab, Node) end). @@ -1235,11 +1250,11 @@ make_del_table_copy(Tab, Node) -> ensure_not_active(Tab, Node), verify_cstruct(Cs2), Ops = remove_node_from_tabs(val({schema, tables}), Node), - [{op, del_table_copy, ram_copies, Node, cs2list(Cs2)} | Ops]; + [{op, del_table_copy, ram_copies, Node, vsn_cs2list(Cs2)} | Ops]; _ -> ensure_active(Cs), verify_cstruct(Cs2), - [{op, del_table_copy, Storage, Node, cs2list(Cs2)}] + [{op, del_table_copy, Storage, Node, vsn_cs2list(Cs2)}] end. remove_node_from_tabs([], _Node) -> @@ -1253,7 +1268,7 @@ remove_node_from_tabs([Tab|Rest], Node) -> unknown -> case IsFragModified of true -> - [{op, change_table_frag, {del_node, Node}, cs2list(Cs)} | + [{op, change_table_frag, {del_node, Node}, vsn_cs2list(Cs)} | remove_node_from_tabs(Rest, Node)]; false -> remove_node_from_tabs(Rest, Node) @@ -1262,11 +1277,11 @@ remove_node_from_tabs([Tab|Rest], Node) -> Cs2 = new_cs(Cs, Node, Storage, del), case mnesia_lib:cs_to_nodes(Cs2) of [] -> - [{op, delete_table, cs2list(Cs)} | + [{op, delete_table, vsn_cs2list(Cs)} | remove_node_from_tabs(Rest, Node)]; _Ns -> verify_cstruct(Cs2), - [{op, del_table_copy, ram_copies, Node, cs2list(Cs2)}| + [{op, del_table_copy, ram_copies, Node, vsn_cs2list(Cs2)}| remove_node_from_tabs(Rest, Node)] end end. @@ -1318,9 +1333,9 @@ make_move_table(Tab, FromNode, ToNode) -> Cs2 = new_cs(Cs, ToNode, Storage, add), Cs3 = new_cs(Cs2, FromNode, Storage, del), verify_cstruct(Cs3), - [{op, add_table_copy, Storage, ToNode, cs2list(Cs2)}, + [{op, add_table_copy, Storage, ToNode, vsn_cs2list(Cs2)}, {op, sync_trans}, - {op, del_table_copy, Storage, FromNode, cs2list(Cs3)}]. + {op, del_table_copy, Storage, FromNode, vsn_cs2list(Cs3)}]. %% end of functions to add and delete nodes to tables %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1357,7 +1372,7 @@ make_change_table_copy_type(Tab, Node, ToS) -> Cs3 = new_cs(Cs2, Node, ToS, add), verify_cstruct(Cs3), - [{op, change_table_copy_type, Node, FromS, ToS, cs2list(Cs3)}]. + [{op, change_table_copy_type, Node, FromS, ToS, vsn_cs2list(Cs3)}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% change index functions .... @@ -1383,7 +1398,7 @@ make_add_table_index(Tab, Pos) -> Ix2 = lists:sort([Pos | Ix]), Cs2 = Cs#cstruct{index = Ix2}, verify_cstruct(Cs2), - [{op, add_index, Pos, cs2list(Cs2)}]. + [{op, add_index, Pos, vsn_cs2list(Cs2)}]. del_table_index(Tab, Pos) -> schema_transaction(fun() -> do_del_table_index(Tab, Pos) end). @@ -1404,7 +1419,7 @@ make_del_table_index(Tab, Pos) -> verify(true, lists:member(Pos, Ix), {no_exists, Tab, Pos}), Cs2 = Cs#cstruct{index = lists:delete(Pos, Ix)}, verify_cstruct(Cs2), - [{op, del_index, Pos, cs2list(Cs2)}]. + [{op, del_index, Pos, vsn_cs2list(Cs2)}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1427,7 +1442,7 @@ make_add_snmp(Tab, Ustruct) -> verify(true, mnesia_snmp_hook:check_ustruct(Ustruct), Error), Cs2 = Cs#cstruct{snmp = Ustruct}, verify_cstruct(Cs2), - [{op, add_snmp, Ustruct, cs2list(Cs2)}]. + [{op, add_snmp, Ustruct, vsn_cs2list(Cs2)}]. del_snmp(Tab) -> schema_transaction(fun() -> do_del_snmp(Tab) end). @@ -1445,7 +1460,7 @@ make_del_snmp(Tab) -> ensure_active(Cs), Cs2 = Cs#cstruct{snmp = []}, verify_cstruct(Cs2), - [{op, del_snmp, cs2list(Cs2)}]. + [{op, del_snmp, vsn_cs2list(Cs2)}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -1477,26 +1492,26 @@ make_transform(Tab, Fun, NewAttrs, NewRecName) -> [] -> Cs2 = Cs#cstruct{attributes = NewAttrs, record_name = NewRecName}, verify_cstruct(Cs2), - [{op, transform, Fun, cs2list(Cs2)}]; + [{op, transform, Fun, vsn_cs2list(Cs2)}]; PosList -> DelIdx = fun(Pos, Ncs) -> Ix = Ncs#cstruct.index, Ncs1 = Ncs#cstruct{index = lists:delete(Pos, Ix)}, - Op = {op, del_index, Pos, cs2list(Ncs1)}, + Op = {op, del_index, Pos, vsn_cs2list(Ncs1)}, {Op, Ncs1} end, AddIdx = fun(Pos, Ncs) -> Ix = Ncs#cstruct.index, Ix2 = lists:sort([Pos | Ix]), Ncs1 = Ncs#cstruct{index = Ix2}, - Op = {op, add_index, Pos, cs2list(Ncs1)}, + Op = {op, add_index, Pos, vsn_cs2list(Ncs1)}, {Op, Ncs1} end, {DelOps, Cs1} = lists:mapfoldl(DelIdx, Cs, PosList), Cs2 = Cs1#cstruct{attributes = NewAttrs, record_name = NewRecName}, {AddOps, Cs3} = lists:mapfoldl(AddIdx, Cs2, PosList), verify_cstruct(Cs3), - lists:flatten([DelOps, {op, transform, Fun, cs2list(Cs2)}, AddOps]) + lists:flatten([DelOps, {op, transform, Fun, vsn_cs2list(Cs2)}, AddOps]) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1520,7 +1535,7 @@ make_change_table_access_mode(Tab, Mode) -> verify(false, OldMode == Mode, {already_exists, Tab, Mode}), Cs2 = Cs#cstruct{access_mode = Mode}, verify_cstruct(Cs2), - [{op, change_table_access_mode, cs2list(Cs2), OldMode, Mode}]. + [{op, change_table_access_mode, vsn_cs2list(Cs2), OldMode, Mode}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1541,7 +1556,7 @@ make_change_table_load_order(Tab, LoadOrder) -> OldLoadOrder = Cs#cstruct.load_order, Cs2 = Cs#cstruct{load_order = LoadOrder}, verify_cstruct(Cs2), - [{op, change_table_load_order, cs2list(Cs2), OldLoadOrder, LoadOrder}]. + [{op, change_table_load_order, vsn_cs2list(Cs2), OldLoadOrder, LoadOrder}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1571,14 +1586,14 @@ make_change_table_majority(Tab, Majority) -> ensure_active(CsT), CsT2 = CsT#cstruct{majority = Majority}, verify_cstruct(CsT2), - {op, change_table_majority, cs2list(CsT2), + {op, change_table_majority, vsn_cs2list(CsT2), OldMajority, Majority} end, FragNames); false -> []; {_, _} -> mnesia:abort({bad_type, Tab}) end, verify_cstruct(Cs2), - [{op, change_table_majority, cs2list(Cs2), OldMajority, Majority} | FragOps]. + [{op, change_table_majority, vsn_cs2list(Cs2), OldMajority, Majority} | FragOps]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1619,7 +1634,7 @@ make_write_table_properties(Tab, [Prop | Props], Cs) -> MergedProps = lists:merge(DelProps, [Prop]), Cs2 = Cs#cstruct{user_properties = MergedProps}, verify_cstruct(Cs2), - [{op, write_property, cs2list(Cs2), Prop} | + [{op, write_property, vsn_cs2list(Cs2), Prop} | make_write_table_properties(Tab, Props, Cs2)]; make_write_table_properties(_Tab, [], _Cs) -> []. @@ -1740,7 +1755,7 @@ make_delete_table_properties(Tab, [PropKey | PropKeys], Cs) -> Props = lists:keydelete(PropKey, 1, OldProps), Cs2 = Cs#cstruct{user_properties = Props}, verify_cstruct(Cs2), - [{op, delete_property, cs2list(Cs2), PropKey} | + [{op, delete_property, vsn_cs2list(Cs2), PropKey} | make_delete_table_properties(Tab, PropKeys, Cs2)]; make_delete_table_properties(_Tab, [], _Cs) -> []. @@ -2166,12 +2181,17 @@ receive_sync(Nodes, Pids) -> {abort, Else} end. -lock_del_table(Tab, Node, Cs, Father) -> +lock_del_table(Tab, NewNode, Cs0, Father) -> Ns = val({schema, active_replicas}), process_flag(trap_exit,true), Lock = fun() -> mnesia:write_lock_table(Tab), - {Res, []} = rpc:multicall(Ns, ?MODULE, set_where_to_read, [Tab, Node, Cs]), + %% Sigh using cs record + Set = fun(Node) -> + [Cs] = normalize_cs([Cs0], Node), + rpc:call(Node, ?MODULE, set_where_to_read, [Tab, NewNode, Cs]) + end, + Res = [Set(Node) || Node <- Ns], Filter = fun(ok) -> false; ({badrpc, {'EXIT', {undef, _}}}) -> @@ -2353,11 +2373,12 @@ undo_prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}) -> undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) when Node == node() -> + WriteLocker = get(mnesia_lock), + WriteLocker =/= undefined andalso (WriteLocker ! die), Cs = list2cs(TabDef), Tab = Cs#cstruct.name, mnesia_lib:set({Tab, where_to_read}, Node); - undo_prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}) when N == node() -> Cs = list2cs(TabDef), @@ -2829,6 +2850,9 @@ fetch_cstructs(Node) -> rpc:call(Node, mnesia_controller, get_remote_cstructs, []) end. +need_old_cstructs() -> + need_old_cstructs(val({schema, where_to_write})). + need_old_cstructs(Nodes) -> Filter = fun(Node) -> not mnesia_monitor:needs_protocol_conversion(Node) end, case lists:dropwhile(Filter, Nodes) of diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl index 63f4146d98..9e0a8db1ae 100644 --- a/lib/mnesia/test/mnesia_evil_backup.erl +++ b/lib/mnesia/test/mnesia_evil_backup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. 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 @@ -244,9 +244,9 @@ restore(Config, Op) -> [rpc:call(Node, ?MODULE, check_tab, [Res31, ?LINE]) || Node <- Nodes], %% Restore all tables on it's nodes - mnesia_schema:clear_table(Tab1), - mnesia_schema:clear_table(Tab2), - mnesia_schema:clear_table(Tab3), + mnesia:clear_table(Tab1), + mnesia:clear_table(Tab2), + mnesia:clear_table(Tab3), [mnesia:dirty_write({Tab1, N, N+1}) || N <- lists:seq(1, 11)], [mnesia:dirty_write({Tab2, N, N+1}) || N <- lists:seq(1, 11)], [mnesia:dirty_write({Tab3, N, N+1}) || N <- lists:seq(1, 11)], diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl index 668eba176f..17d6c6c212 100644 --- a/lib/mnesia/test/mnesia_evil_coverage_test.erl +++ b/lib/mnesia/test/mnesia_evil_coverage_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -1795,7 +1795,7 @@ subscribe_extended(Config) when is_list(Config) -> ?match({mnesia_table_event, {delete, schema, {schema, Tab1}, [{schema, Tab1, _}],_}}, recv_event()), ?match({mnesia_table_event, {write, schema, {schema, Tab1, _}, [], _}}, recv_event()), - ?match({atomic, ok}, mnesia_schema:clear_table(Tab2)), + ?match({atomic, ok}, mnesia:clear_table(Tab2)), ?match({mnesia_table_event, {delete, schema, {schema, Tab2}, [{schema, Tab2, _}],_}}, recv_event()), ?match({mnesia_table_event, {write, schema, {schema, Tab2, _}, [], _}}, recv_event()), diff --git a/lib/mnesia/test/mnesia_install_test.erl b/lib/mnesia/test/mnesia_install_test.erl index 5d55fcac0e..3a2d44aa95 100644 --- a/lib/mnesia/test/mnesia_install_test.erl +++ b/lib/mnesia/test/mnesia_install_test.erl @@ -205,7 +205,7 @@ silly_upgrade(Config) when is_list(Config) -> ?match(ok, mnesia:install_fallback(Bup2)), file:delete(Bup2), %% Will generate intentional crash, fatal error - ?match([], mnesia_test_lib:stop_mnesia([Node2])), + ?match([], mnesia_test_lib:stop_mnesia([Node2])), wait_till_dead([Node1, Node2]), ?match([], mnesia_test_lib:start_mnesia([Node1, Node2], [Tab1, Tab2])), ?match(match, verify_state(Tab1, Tab2, CpState)), @@ -213,22 +213,29 @@ silly_upgrade(Config) when is_list(Config) -> ?match(ok, mnesia:install_fallback(Bup)), file:delete(Bup), %% Will generate intentional crash, fatal error - ?match([], mnesia_test_lib:stop_mnesia([Node1, Node2])), + ?match([], mnesia_test_lib:stop_mnesia([Node1, Node2])), wait_till_dead([Node1, Node2]), ?match([], mnesia_test_lib:start_mnesia([Node1, Node2], [Tab1, Tab2])), CpState2 = [X || X <- CpState, element(1, X) /= Tab1], ?match(match, verify_state(Tab1, Tab2, CpState2)), ?verify_mnesia(Nodes, []). -wait_till_dead([]) -> ok; -wait_till_dead([N|Ns]) -> +wait_till_dead([]) -> + ok; %% timer:sleep(5); +wait_till_dead(Repeat = [N|Ns]) -> Apps = rpc:call(N, application, which_applications, []), case lists:keymember(mnesia, 1, Apps) of - true -> + true -> timer:sleep(10), - wait_till_dead([N|Ns]); - false -> - wait_till_dead(Ns) + wait_till_dead(Repeat); + false -> + case rpc:call(N, erlang, whereis, [mnesia_monitor]) of + undefined -> + wait_till_dead(Ns); + _ -> + timer:sleep(10), + wait_till_dead(Repeat) + end end. add_some_records(Tab1, Tab2, Old) -> diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index a21ab007ef..ebf79dd2ae 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.5 +MNESIA_VSN = 4.5.1 diff --git a/lib/orber/priv/Makefile b/lib/orber/priv/Makefile index 2847727035..2847727035 100755..100644 --- a/lib/orber/priv/Makefile +++ b/lib/orber/priv/Makefile diff --git a/lib/orber/priv/blank.html b/lib/orber/priv/blank.html index 44e86908a0..44e86908a0 100755..100644 --- a/lib/orber/priv/blank.html +++ b/lib/orber/priv/blank.html diff --git a/lib/orber/priv/info_frames.html b/lib/orber/priv/info_frames.html index 75456a67a4..75456a67a4 100755..100644 --- a/lib/orber/priv/info_frames.html +++ b/lib/orber/priv/info_frames.html diff --git a/lib/orber/priv/main_frame.html b/lib/orber/priv/main_frame.html index 056a92812e..056a92812e 100755..100644 --- a/lib/orber/priv/main_frame.html +++ b/lib/orber/priv/main_frame.html diff --git a/lib/orber/priv/orber.tool b/lib/orber/priv/orber.tool index 910a7d7e45..910a7d7e45 100755..100644 --- a/lib/orber/priv/orber.tool +++ b/lib/orber/priv/orber.tool diff --git a/lib/orber/priv/orber_help.txt b/lib/orber/priv/orber_help.txt index a6580dc30a..a6580dc30a 100755..100644 --- a/lib/orber/priv/orber_help.txt +++ b/lib/orber/priv/orber_help.txt diff --git a/lib/orber/priv/start_info.html b/lib/orber/priv/start_info.html index 0ad521c90a..0ad521c90a 100755..100644 --- a/lib/orber/priv/start_info.html +++ b/lib/orber/priv/start_info.html diff --git a/lib/percept/doc/src/part_notes.xml b/lib/percept/doc/src/part_notes.xml index 4965e67640..4965e67640 100755..100644 --- a/lib/percept/doc/src/part_notes.xml +++ b/lib/percept/doc/src/part_notes.xml diff --git a/lib/percept/test/percept_SUITE_data/ipc-dist.dat b/lib/percept/test/percept_SUITE_data/ipc-dist.dat Binary files differindex 14ab6c0c5d..14ab6c0c5d 100755..100644 --- a/lib/percept/test/percept_SUITE_data/ipc-dist.dat +++ b/lib/percept/test/percept_SUITE_data/ipc-dist.dat diff --git a/lib/public_key/asn1/DSS.asn1 b/lib/public_key/asn1/DSS.asn1 index 77aca3808b..77aca3808b 100755..100644 --- a/lib/public_key/asn1/DSS.asn1 +++ b/lib/public_key/asn1/DSS.asn1 diff --git a/lib/public_key/asn1/PKCS-1.asn1 b/lib/public_key/asn1/PKCS-1.asn1 index b06f5efa9d..b06f5efa9d 100755..100644 --- a/lib/public_key/asn1/PKCS-1.asn1 +++ b/lib/public_key/asn1/PKCS-1.asn1 diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 0bcb202fd8..1a57c94443 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -1,6 +1,7 @@ +%% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2010. 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 @@ -16,6 +17,7 @@ %% The Initial Developer of the Original Code is Ericsson AB. %% %% %CopyrightEnd% +%% %%%------------------------------------------------------------------- %%% File : erts_alloc_config.erl @@ -71,6 +73,7 @@ A == binary_alloc; A == std_alloc; A == ets_alloc; + A == fix_alloc; A == eheap_alloc; A == ll_alloc; A == sl_alloc; @@ -94,6 +97,7 @@ [{binary_alloc, 131072}, {std_alloc, 131072}, {ets_alloc, 131072}, + {fix_alloc, 131072}, {eheap_alloc, 524288}, {ll_alloc, 2097152}, {sl_alloc, 131072}, @@ -104,6 +108,7 @@ [{binary_alloc, 10}, {std_alloc, 10}, {ets_alloc, 10}, + {fix_alloc, 10}, {eheap_alloc, 10}, {ll_alloc, 0}, {sl_alloc, 10}, @@ -438,9 +443,6 @@ conf_alloc(#conf{format_to = FTO} = Conf, #alloc{name = A} = Alc) -> chk_xnote(Conf, Alc). chk_xnote(#conf{format_to = FTO}, - #alloc{name = fix_alloc}) -> - fcp(FTO, "Cannot be configured."); -chk_xnote(#conf{format_to = FTO}, #alloc{name = sys_alloc}) -> fcp(FTO, "Cannot be configured. Default malloc implementation used."); chk_xnote(#conf{format_to = FTO}, diff --git a/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat b/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat index ede1ad4ff3..ede1ad4ff3 100755..100644 --- a/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat +++ b/lib/sasl/test/release_handler_SUITE_data/heart_restart.bat diff --git a/lib/snmp/test/snmp_manager_user_old.erl b/lib/snmp/test/snmp_manager_user_old.erl index edffc80dd4..edffc80dd4 100755..100644 --- a/lib/snmp/test/snmp_manager_user_old.erl +++ b/lib/snmp/test/snmp_manager_user_old.erl diff --git a/lib/ssh/src/DSS.asn1 b/lib/ssh/src/DSS.asn1 index 77aca3808b..77aca3808b 100755..100644 --- a/lib/ssh/src/DSS.asn1 +++ b/lib/ssh/src/DSS.asn1 diff --git a/lib/ssh/src/PKCS-1.asn1 b/lib/ssh/src/PKCS-1.asn1 index e7d6b18c63..e7d6b18c63 100755..100644 --- a/lib/ssh/src/PKCS-1.asn1 +++ b/lib/ssh/src/PKCS-1.asn1 diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 3f0a06575c..3f0a06575c 100755..100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 34d4ff8fc1..34d4ff8fc1 100755..100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl diff --git a/lib/ssh/src/ssh_dsa.erl b/lib/ssh/src/ssh_dsa.erl index 1b9a396f0c..1b9a396f0c 100755..100644 --- a/lib/ssh/src/ssh_dsa.erl +++ b/lib/ssh/src/ssh_dsa.erl diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 12180f56bb..12180f56bb 100755..100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl index 915fd63e4f..915fd63e4f 100755..100644 --- a/lib/ssh/src/ssh_io.erl +++ b/lib/ssh/src/ssh_io.erl diff --git a/lib/ssh/src/ssh_math.erl b/lib/ssh/src/ssh_math.erl index 510eb16aa6..510eb16aa6 100755..100644 --- a/lib/ssh/src/ssh_math.erl +++ b/lib/ssh/src/ssh_math.erl diff --git a/lib/ssh/src/ssh_rsa.erl b/lib/ssh/src/ssh_rsa.erl index 91b8285b2e..91b8285b2e 100755..100644 --- a/lib/ssh/src/ssh_rsa.erl +++ b/lib/ssh/src/ssh_rsa.erl diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index f000558100..f000558100 100755..100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl diff --git a/lib/ssh/src/ssh_userauth.hrl b/lib/ssh/src/ssh_userauth.hrl index 8eb2d46ed1..8eb2d46ed1 100755..100644 --- a/lib/ssh/src/ssh_userauth.hrl +++ b/lib/ssh/src/ssh_userauth.hrl diff --git a/lib/ssh/src/ssh_xfer.hrl b/lib/ssh/src/ssh_xfer.hrl index 4a4f1a4291..4a4f1a4291 100755..100644 --- a/lib/ssh/src/ssh_xfer.hrl +++ b/lib/ssh/src/ssh_xfer.hrl diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72f02a4362..95a5efd6d0 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -154,18 +154,23 @@ decipher(?AES, HashSz, CipherState, Fragment, Version) -> block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment, Version) -> - try Fun(Key, IV, Fragment) of - Text -> - GBC = generic_block_cipher_from_bin(Text, HashSz), - case is_correct_padding(GBC, Version) of - true -> - Content = GBC#generic_block_cipher.content, - Mac = GBC#generic_block_cipher.mac, - CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)}, - {Content, Mac, CipherState1}; - false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) - end + try + Text = Fun(Key, IV, Fragment), + GBC = generic_block_cipher_from_bin(Text, HashSz), + Content = GBC#generic_block_cipher.content, + Mac = GBC#generic_block_cipher.mac, + CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)}, + case is_correct_padding(GBC, Version) of + true -> + {Content, Mac, CipherState1}; + false -> + %% decryption failed or invalid padding, + %% intentionally break Content to make + %% sure a packet with a an invalid padding + %% but otherwise correct data will fail + %% the MAC test later + {<<16#F0, Content/binary>>, Mac, CipherState1} + end catch _:_ -> %% This is a DECRYPTION_FAILED but @@ -500,14 +505,38 @@ hash_size(md5) -> hash_size(sha) -> 20. +%% RFC 5246: 6.2.3.2. CBC Block Cipher +%% +%% Implementation note: Canvel et al. [CBCTIME] have demonstrated a +%% timing attack on CBC padding based on the time required to compute +%% the MAC. In order to defend against this attack, implementations +%% MUST ensure that record processing time is essentially the same +%% whether or not the padding is correct. In general, the best way to +%% do this is to compute the MAC even if the padding is incorrect, and +%% only then reject the packet. For instance, if the pad appears to be +%% incorrect, the implementation might assume a zero-length pad and then +%% compute the MAC. This leaves a small timing channel, since MAC +%% performance depends to some extent on the size of the data fragment, +%% but it is not believed to be large enough to be exploitable, due to +%% the large block size of existing MACs and the small size of the +%% timing signal. +%% +%% implementation note: +%% We return the original (possibly invalid) PadLength in any case. +%% A invalid PadLength will be cought by is_correct_padding/2 +%% generic_block_cipher_from_bin(T, HashSize) -> Sz1 = byte_size(T) - 1, - <<_:Sz1/binary, ?BYTE(PadLength)>> = T, + <<_:Sz1/binary, ?BYTE(PadLength0)>> = T, + PadLength = if + PadLength0 >= Sz1 -> 0; + true -> PadLength0 + end, CompressedLength = byte_size(T) - PadLength - 1 - HashSize, <<Content:CompressedLength/binary, Mac:HashSize/binary, - Padding:PadLength/binary, ?BYTE(PadLength)>> = T, + Padding:PadLength/binary, ?BYTE(PadLength0)>> = T, #generic_block_cipher{content=Content, mac=Mac, - padding=Padding, padding_length=PadLength}. + padding=Padding, padding_length=PadLength0}. generic_stream_cipher_from_bin(T, HashSz) -> Sz = byte_size(T), @@ -516,17 +545,18 @@ generic_stream_cipher_from_bin(T, HashSz) -> #generic_stream_cipher{content=Content, mac=Mac}. -is_correct_padding(_, {3, 0}) -> - true; -%% For interoperability reasons we do not check the padding in TLS 1.0 as it -%% is not strictly required and breaks interopability with for instance -%% Google. -is_correct_padding(_, {3, 1}) -> - true; +%% For interoperability reasons we do not check the padding content in +%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks +%% interopability with for instance Google. +is_correct_padding(#generic_block_cipher{padding_length = Len, + padding = Padding}, {3, N}) + when N == 0; N == 1 -> + Len == byte_size(Padding); %% Padding must be check in TLS 1.1 and after -is_correct_padding(#generic_block_cipher{padding_length = Len, padding = Padding}, _) -> - list_to_binary(lists:duplicate(Len, Len)) == Padding. - +is_correct_padding(#generic_block_cipher{padding_length = Len, + padding = Padding}, _) -> + Len == byte_size(Padding) andalso + list_to_binary(lists:duplicate(Len, Len)) == Padding. get_padding(Length, BlockSize) -> get_padding_aux(BlockSize, Length rem BlockSize). diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 23a9a23190..6b1da63d08 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -39,6 +39,7 @@ MODULES = \ ssl_basic_SUITE \ ssl_handshake_SUITE \ ssl_packet_SUITE \ + ssl_cipher_SUITE \ ssl_payload_SUITE \ ssl_to_openssl_SUITE \ ssl_session_cache_SUITE \ @@ -55,6 +56,7 @@ HRL_FILES_SRC = \ ssl_internal.hrl\ ssl_alert.hrl \ ssl_handshake.hrl \ + ssl_cipher.hrl \ ssl_record.hrl HRL_FILES_INC = diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl new file mode 100644 index 0000000000..87478e13bc --- /dev/null +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -0,0 +1,163 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssl_cipher_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-include("ssl_internal.hrl"). +-include("ssl_record.hrl"). +-include("ssl_cipher.hrl"). + +-define(TIMEOUT, 600000). + +%% Test server callback functions +%%-------------------------------------------------------------------- +%% Function: init_per_suite(Config) -> Config +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Initialization before the whole suite +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + try crypto:start() of + ok -> + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. +%%-------------------------------------------------------------------- +%% Function: end_per_suite(Config) -> _ +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after the whole suite +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + ssl:stop(), + application:stop(crypto). + +%%-------------------------------------------------------------------- +%% Function: init_per_testcase(TestCase, Config) -> Config +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Initialization before each test case +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%% Description: Initialization before each test case +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config0) -> + Config = lists:keydelete(watchdog, 1, Config0), + Dog = ssl_test_lib:timetrap(?TIMEOUT), + [{watchdog, Dog} | Config]. + +%%-------------------------------------------------------------------- +%% Function: end_per_testcase(TestCase, Config) -> _ +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after each test case +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, Config) -> + Dog = ?config(watchdog, Config), + case Dog of + undefined -> + ok; + _ -> + test_server:timetrap_cancel(Dog) + end. + +%%-------------------------------------------------------------------- +%% Function: all(Clause) -> TestCases +%% Clause - atom() - suite | doc +%% TestCases - [Case] +%% Case - atom() +%% Name of a test case. +%% Description: Returns a list of all test cases in this test suite +%%-------------------------------------------------------------------- +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [aes_decipher_good, aes_decipher_fail]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +%% Test cases starts here. +%%-------------------------------------------------------------------- +aes_decipher_good(doc) -> + ["Decipher a known cryptotext."]; + +aes_decipher_good(suite) -> + []; + +aes_decipher_good(Config) when is_list(Config) -> + HashSz = 32, + CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, + Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, + Version = {3,3}, + Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56,72,69,76,76,79,10>>, + Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, + {Content, Mac, CipherState1} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + ok. + +%%-------------------------------------------------------------------- + +aes_decipher_fail(doc) -> + ["Decipher a known cryptotext."]; + +aes_decipher_fail(suite) -> + []; + +%% same as above, last byte of key replaced +aes_decipher_fail(Config) when is_list(Config) -> + HashSz = 32, + CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, + Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, + Version = {3,3}, + {Content, Mac, CipherState1} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + 32 = byte_size(Content), + 32 = byte_size(Mac), + ok. + +%%-------------------------------------------------------------------- diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index b63acdd40a..72e41d6473 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -419,7 +419,14 @@ expr({'fun',Line,Body}) -> {'fun',Line,{clauses,Cs1}}; {function,F,A} -> {'fun',Line,{function,F,A}}; - {function,M,F,A} -> %R10B-6: fun M:F/A. + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% R10B-6: fun M:F/A. (Backward compatibility) + {'fun',Line,{function,M,F,A}}; + {function,M0,F0,A0} -> + %% R15: fun M:F/A with variables. + M = expr(M0), + F = expr(F0), + A = expr(A0), {'fun',Line,{function,M,F,A}} end; expr({call,Line,F0,As0}) -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 4f4fa16040..88a0094d57 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -256,7 +256,8 @@ expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) -> expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) -> {value,T,Bs} = expr(E, Bs0, Lf, Ef, none), receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs); -expr({'fun',_Line,{function,Mod,Name,Arity}}, Bs, _Lf, _Ef, RBs) -> +expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> + {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef), F = erlang:make_fun(Mod, Name, Arity), ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 78b996d94b..5d45260fe9 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2127,8 +2127,13 @@ expr({'fun',Line,Body}, Vt, St) -> true -> {[],St}; false -> {[],call_function(Line, F, A, St)} end; - {function,_M,_F,_A} -> - {[],St} + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% Compatibility with pre-R15 abstract format. + {[],St}; + {function,M,F,A} -> + %% New in R15. + {Bvt, St1} = expr_list([M,F,A], Vt, St), + {vtupdate(Bvt, Vt),St1} end; expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 709bd83e6f..928c10f7f2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -35,7 +35,7 @@ tuple %struct record_expr record_tuple record_field record_fields if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr -fun_expr fun_clause fun_clauses +fun_expr fun_clause fun_clauses atom_or_var integer_or_var try_expr try_catch try_clause try_clauses query_expr function_call argument_list exprs guard @@ -395,11 +395,17 @@ receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : fun_expr -> 'fun' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. -fun_expr -> 'fun' atom ':' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4'),element(3,'$6')}}. +fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : + {'fun',?line('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : build_fun(?line('$1'), '$2'). +atom_or_var -> atom : '$1'. +atom_or_var -> var : '$1'. + +integer_or_var -> integer : '$1'. +integer_or_var -> var : '$1'. + fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 7dc19f2e9b..6b5aa951cf 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -457,8 +457,16 @@ lexpr({'fun',_,{function,F,A}}, _Prec, _Hook) -> leaf(format("fun ~w/~w", [F,A])); lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Hook) -> {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))}; -lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) -> +lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) + when is_atom(M), is_atom(F), is_integer(A) -> + %% For backward compatibility with pre-R15 abstract format. leaf(format("fun ~w:~w/~w", [M,F,A])); +lexpr({'fun',_,{function,M,F,A}}, _Prec, Hook) -> + %% New format in R15. + NameItem = lexpr(M, Hook), + CallItem = lexpr(F, Hook), + ArityItem = lexpr(A, Hook), + ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Hook) -> {list,[{first,'fun',fun_clauses(Cs, Hook)},'end']}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Hook) -> diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 1cb9e4a25e..2fc9128e4e 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -147,9 +147,10 @@ basename(Name) when is_binary(Name) -> end; basename(Name0) -> - Name = flatten(Name0), + Name1 = flatten(Name0), {DirSep2, DrvSep} = separators(), - basename1(skip_prefix(Name, DrvSep), [], DirSep2). + Name = skip_prefix(Name1, DrvSep), + basename1(Name, Name, DirSep2). win_basenameb(<<Letter,$:,Rest/binary>>) when ?IS_DRIVELETTER(Letter) -> basenameb(Rest,[<<"/">>,<<"\\">>]); @@ -167,16 +168,18 @@ basenameb(Bin,Sep) -> -basename1([$/|[]], Tail, DirSep2) -> - basename1([], Tail, DirSep2); +basename1([$/], Tail0, _DirSep2) -> + %% End of filename -- must get rid of trailing directory separator. + [_|Tail] = lists:reverse(Tail0), + lists:reverse(Tail); basename1([$/|Rest], _Tail, DirSep2) -> - basename1(Rest, [], DirSep2); + basename1(Rest, Rest, DirSep2); basename1([DirSep2|Rest], Tail, DirSep2) when is_integer(DirSep2) -> basename1([$/|Rest], Tail, DirSep2); basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) -> - basename1(Rest, [Char|Tail], DirSep2); + basename1(Rest, Tail, DirSep2); basename1([], Tail, _DirSep2) -> - lists:reverse(Tail). + Tail. skip_prefix(Name, false) -> Name; @@ -369,8 +372,8 @@ extension(Name0) -> Name = flatten(Name0), extension(Name, [], major_os_type()). -extension([$.|Rest], _Result, OsType) -> - extension(Rest, [$.], OsType); +extension([$.|Rest]=Result, _Result, OsType) -> + extension(Rest, Result, OsType); extension([Char|Rest], [], OsType) when is_integer(Char) -> extension(Rest, [], OsType); extension([$/|Rest], _Result, OsType) -> @@ -378,9 +381,9 @@ extension([$/|Rest], _Result, OsType) -> extension([$\\|Rest], _Result, win32) -> extension(Rest, [], win32); extension([Char|Rest], Result, OsType) when is_integer(Char) -> - extension(Rest, [Char|Result], OsType); + extension(Rest, Result, OsType); extension([], Result, _OsType) -> - lists:reverse(Result). + Result. %% Joins a list of filenames with directory separators. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index f5e180b4bd..2b691e6abf 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1272,7 +1272,10 @@ abstr_term(Fun, Line) when is_function(Fun) -> case erlang:fun_info(Fun, type) of {type, external} -> {module, Module} = erlang:fun_info(Fun, module), - {'fun', Line, {function,Module,Name,Arity}}; + {'fun', Line, {function, + {atom,Line,Module}, + {atom,Line,Name}, + {integer,Line,Arity}}}; {type, local} -> {'fun', Line, {function,Name,Arity}} end diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index 99bcbd722e..246d535943 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -48,7 +48,7 @@ split(Subject,RE) -> Subject :: iodata() | unicode:charlist(), RE :: mp() | iodata() | unicode:charlist(), Options :: [ Option ], - Option :: anchored | global | notbol | noteol | notempty + Option :: anchored | notbol | noteol | notempty | {offset, non_neg_integer()} | {newline, nl_spec()} | bsr_anycrlf | bsr_unicode | {return, ReturnType} | {parts, NumParts} | group | trim | CompileOpt, diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index f20ea18fd0..2dd5ccce7a 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1238,15 +1238,15 @@ report_error(Error, Reason, Child, SupName) -> error_logger:error_report(supervisor_report, ErrorMsg). -extract_child(Child) when is_pid(Child#child.pid) -> - [{pid, Child#child.pid}, +extract_child(Child) when is_list(Child#child.pid) -> + [{nb_children, length(Child#child.pid)}, {name, Child#child.name}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, {child_type, Child#child.child_type}]; extract_child(Child) -> - [{nb_children, length(Child#child.pid)}, + [{pid, Child#child.pid}, {name, Child#child.name}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 784c7cb86e..369d8b224e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1036,6 +1036,12 @@ funs(Config) when is_list(Config) -> lists:usort([run_many_args(SAs) || SAs <- many_args(MaxArgs)]), ?line {'EXIT',{{argument_limit,_},_}} = (catch run_many_args(many_args1(MaxArgs+1))), + + ?line check(fun() -> M = lists, F = fun M:reverse/1, + [1,2] = F([2,1]), ok end, + "begin M = lists, F = fun M:reverse/1," + " [1,2] = F([2,1]), ok end.", + ok), ok. run_many_args({S, As}) -> diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 280c95b1aa..64853ca078 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -116,7 +116,6 @@ func(Config) when is_list(Config) -> {func_3, <<"t() -> fun t/0.">>}, {func_4, - %% Has already been expanded away in sys_pre_expand. <<"t() -> fun modul:foo/3.">>}, {func_5, % 'when' is moved down one line <<"tkjlksjflksdjflsdjlk() @@ -127,7 +126,9 @@ func(Config) when is_list(Config) -> <<"t() -> (fun() -> true - end)().">>} + end)().">>}, + {func_7, + <<"t(M, F, A) -> fun M:F/A.">>} ], ?line compile(Config, Ts), ok. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 2f4958760b..0e8849b5b3 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -74,7 +74,7 @@ -export([bad_table/1, types/1]). -export([otp_9423/1]). --export([init_per_testcase/2, end_per_testcase/2]). +-export([init_per_testcase/2]). %% Convenience for manual testing -export([random_test/0]). @@ -176,6 +176,7 @@ groups() -> meta_newdel_unnamed, meta_newdel_named]}]. init_per_suite(Config) -> + erts_debug:set_internal_state(available_internal_state, true), Config. end_per_suite(_Config) -> @@ -304,7 +305,6 @@ t_match_spec_run(Config) when is_list(Config) -> end, repeat_for_permutations(F, N_MS) end, - test_terms(Fun, skip_refc_check), ?line verify_etsmem(EtsMem). @@ -324,7 +324,7 @@ t_match_spec_run_test(List, MS, Result) -> %% Check that tracing agree Self = self(), - {Tracee, MonRef} = spawn_monitor(fun() -> ms_tracee(Self, List) end), + {Tracee, MonRef} = my_spawn_monitor(fun() -> ms_tracee(Self, List) end), receive {Tracee, ready} -> ok end, MST = lists:map(fun(Clause) -> ms_clause_ets_to_trace(Clause) end, MS), @@ -585,7 +585,6 @@ select_fail_do(Opts) -> memory(doc) -> ["Whitebox test of ets:info(X,memory)"]; memory(suite) -> []; memory(Config) when is_list(Config) -> - ?line erts_debug:set_internal_state(available_internal_state, true), ?line ok = chk_normal_tab_struct_size(), repeat_for_opts(memory_do,[compressed]), ?line catch erts_debug:set_internal_state(available_internal_state, false). @@ -1947,7 +1946,7 @@ evil_update_counter(Config) when is_list(Config) -> evil_update_counter_do(Opts) -> ?line EtsMem = etsmem(), ?line process_flag(trap_exit, true), - ?line Pids = [spawn_link(fun() -> evil_counter(I,Opts) end) || I <- lists:seq(1, 40)], + ?line Pids = [my_spawn_link(fun() -> evil_counter(I,Opts) end) || I <- lists:seq(1, 40)], ?line wait_for_all(gb_sets:from_list(Pids)), ?line verify_etsmem(EtsMem), ok. @@ -2153,24 +2152,24 @@ heir_do(Opts) -> Combos), %% No heir - {Founder1,MrefF1} = spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end), + {Founder1,MrefF1} = my_spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end), Founder1 ! {go, none}, ?line {"No heir",Founder1} = receive_any(), ?line {'DOWN', MrefF1, process, Founder1, normal} = receive_any(), ?line undefined = ets:info(foo), %% An already dead heir - {Heir2,MrefH2} = spawn_monitor(fun()->die end), + {Heir2,MrefH2} = my_spawn_monitor(fun()->die end), ?line {'DOWN', MrefH2, process, Heir2, normal} = receive_any(), - {Founder2,MrefF2} = spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end), + {Founder2,MrefF2} = my_spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end), Founder2 ! {go, Heir2}, ?line {"No heir",Founder2} = receive_any(), ?line {'DOWN', MrefF2, process, Founder2, normal} = receive_any(), ?line undefined = ets:info(foo), %% When heir dies before founder - {Founder3,MrefF3} = spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end), - {Heir3,MrefH3} = spawn_monitor(fun()->heir_heir(Founder3)end), + {Founder3,MrefF3} = my_spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end), + {Heir3,MrefH3} = my_spawn_monitor(fun()->heir_heir(Founder3)end), Founder3 ! {go, Heir3}, ?line {'DOWN', MrefH3, process, Heir3, normal} = receive_any(), Founder3 ! die_please, @@ -2178,14 +2177,12 @@ heir_do(Opts) -> ?line undefined = ets:info(foo), %% When heir dies and pid reused before founder dies - erts_debug:set_internal_state(available_internal_state,true), NextPidIx = erts_debug:get_internal_state(next_pid), - {Founder4,MrefF4} = spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end), - {Heir4,MrefH4} = spawn_monitor(fun()->heir_heir(Founder4)end), + {Founder4,MrefF4} = my_spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end), + {Heir4,MrefH4} = my_spawn_monitor(fun()->heir_heir(Founder4)end), Founder4 ! {go, Heir4}, ?line {'DOWN', MrefH4, process, Heir4, normal} = receive_any(), erts_debug:set_internal_state(next_pid, NextPidIx), - erts_debug:set_internal_state(available_internal_state,false), {Heir4,MrefH4_B} = spawn_monitor_with_pid(Heir4, fun()-> ?line die_please = receive_any() end), Founder4 ! die_please, @@ -2261,9 +2258,9 @@ heir_heir(Founder, Mode) -> heir_1(HeirData,Mode,Opts) -> io:format("test with heir_data = ~p\n", [HeirData]), Master = self(), - ?line Founder = spawn_link(fun() -> heir_founder(Master,HeirData,Opts) end), + ?line Founder = my_spawn_link(fun() -> heir_founder(Master,HeirData,Opts) end), io:format("founder spawned = ~p\n", [Founder]), - ?line {Heir,Mref} = spawn_monitor(fun() -> heir_heir(Founder,Mode) end), + ?line {Heir,Mref} = my_spawn_monitor(fun() -> heir_heir(Founder,Mode) end), io:format("heir spawned = ~p\n", [{Heir,Mref}]), ?line Founder ! {go, Heir}, ?line {'DOWN', Mref, process, Heir, normal} = receive_any(). @@ -2280,7 +2277,7 @@ give_away_do(Opts) -> Parent = self(), %% Give and then give back - ?line {Receiver,Mref} = spawn_monitor(fun()-> give_away_receiver(T,Parent) end), + ?line {Receiver,Mref} = my_spawn_monitor(fun()-> give_away_receiver(T,Parent) end), ?line give_me = receive_any(), ?line true = ets:give_away(T,Receiver,here_you_are), ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)), @@ -2291,7 +2288,7 @@ give_away_do(Opts) -> %% Give and then let receiver keep it ?line true = ets:insert(T,{key,1}), - ?line {Receiver3,Mref3} = spawn_monitor(fun()-> give_away_receiver(T,Parent) end), + ?line {Receiver3,Mref3} = my_spawn_monitor(fun()-> give_away_receiver(T,Parent) end), ?line give_me = receive_any(), ?line true = ets:give_away(T,Receiver3,here_you_are), ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)), @@ -2303,7 +2300,7 @@ give_away_do(Opts) -> ?line T2 = ets_new(foo,[private | Opts]), ?line true = ets:insert(T2,{key,1}), ?line ets:setopts(T2,{heir,self(),"Som en gummiboll..."}), - ?line {Receiver2,Mref2} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), + ?line {Receiver2,Mref2} = my_spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), ?line give_me = receive_any(), ?line true = ets:give_away(T2,Receiver2,here_you_are), ?line {'EXIT',{badarg,_}} = (catch ets:lookup(T2,key)), @@ -2318,12 +2315,12 @@ give_away_do(Opts) -> ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,"not a pid","To wrong type")), ?line true = ets:delete(T2), - ?line {ReceiverNeg,MrefNeg} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), + ?line {ReceiverNeg,MrefNeg} = my_spawn_monitor(fun()-> give_away_receiver(T2,Parent) end), ?line give_me = receive_any(), ?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,ReceiverNeg,"A deleted table")), ?line T3 = ets_new(foo,[public | Opts]), - spawn_link(fun()-> {'EXIT',{badarg,_}} = (catch ets:give_away(T3,ReceiverNeg,"From non owner")), + my_spawn_link(fun()-> {'EXIT',{badarg,_}} = (catch ets:give_away(T3,ReceiverNeg,"From non owner")), Parent ! done end), ?line done = receive_any(), @@ -2359,7 +2356,7 @@ setopts_do(Opts) -> Self = self(), ?line T = ets_new(foo,[named_table, private | Opts]), ?line none = ets:info(T,heir), - Heir = spawn_link(fun()->heir_heir(Self) end), + Heir = my_spawn_link(fun()->heir_heir(Self) end), ?line ets:setopts(T,{heir,Heir,"Data"}), ?line Heir = ets:info(T,heir), ?line ets:setopts(T,{heir,self(),"Data"}), @@ -2410,14 +2407,14 @@ bad_table(Config) when is_list(Config) -> bad_table_do(Opts, DummyFile) -> Parent = self(), - {Pid,Mref} = spawn_opt(fun()-> ets_new(priv,[private,named_table | Opts]), - Priv = ets_new(priv,[private | Opts]), - ets_new(prot,[protected,named_table | Opts]), - Prot = ets_new(prot,[protected | Opts]), - Parent ! {self(),Priv,Prot}, - die_please = receive_any() - end, - [link, monitor]), + {Pid,Mref} = my_spawn_opt(fun()-> ets_new(priv,[private,named_table | Opts]), + Priv = ets_new(priv,[private | Opts]), + ets_new(prot,[protected,named_table | Opts]), + Prot = ets_new(prot,[protected | Opts]), + Parent ! {self(),Priv,Prot}, + die_please = receive_any() + end, + [link, monitor]), {Pid,Priv,Prot} = receive_any(), MatchSpec = {{key,'_'}, [], ['$$']}, Fun = fun(X,_) -> X end, @@ -3263,7 +3260,7 @@ delete_large_named_table_1(Name, Flags, Data, Fix) -> ?line lists:foreach(fun({K,_}) -> ets:delete(Tab, K) end, Data) end, Parent = self(), - Pid = spawn_link(fun() -> + Pid = my_spawn_link(fun() -> receive {trace,Parent,call,_} -> ets_new(Name, [named_table]) @@ -3625,7 +3622,7 @@ cycle(Tab, L) -> ets:insert(Tab,list_to_tuple(L)), cycle(Tab, tl(L)++[hd(L)]). -dynamic_go() -> spawn_link(fun dynamic_init/0). +dynamic_go() -> my_spawn_link(fun dynamic_init/0). dynamic_init() -> [dyn_lookup(?MODULE) || _ <- lists:seq(1, 10)]. @@ -3852,7 +3849,7 @@ safe_fixtable_do(Opts) -> Self = self(), ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), %% Test that an unjustified 'unfix' is a no-op. - {Pid,MRef} = spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end), + {Pid,MRef} = my_spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end), {'DOWN', MRef, process, Pid, normal} = receive M -> M end, ?line true = ets:info(Tab,fixed), ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), @@ -4256,7 +4253,7 @@ do_heavy_concurrent(Opts) -> ?line ok = fill_tab2(Tab, 0, Size), ?line Procs = lists:map( fun (N) -> - spawn_link( + my_spawn_link( fun () -> do_heavy_concurrent_proc(Tab, Size, N) end) @@ -4860,12 +4857,7 @@ otp_7665_act(Tab,Min,Max,DelNr) -> %% Whitebox testing of meta name table hashing. meta_wb(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - ?line erts_debug:set_internal_state(available_internal_state, true), - try - repeat_for_opts(meta_wb_do) - after - erts_debug:set_internal_state(available_internal_state, false) - end, + repeat_for_opts(meta_wb_do), ?line verify_etsmem(EtsMem). @@ -4934,12 +4926,15 @@ colliding_names(Name) -> grow_shrink(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - grow_shrink_0(lists:seq(3071, 5000), EtsMem). + ?line grow_shrink_0(lists:seq(3071, 5000), EtsMem), + ?line verify_etsmem(EtsMem). grow_shrink_0([N|Ns], EtsMem) -> ?line grow_shrink_1(N, [set]), ?line grow_shrink_1(N, [ordered_set]), - ?line verify_etsmem(EtsMem), + %% Verifying ets-memory here takes too long time, since + %% lock-free allocators were introduced... + %% ?line verify_etsmem(EtsMem), grow_shrink_0(Ns, EtsMem); grow_shrink_0([], _) -> ok. @@ -4986,13 +4981,13 @@ grow_pseudo_deleted_do(Type) -> ?line Left = ets:info(T,size), ?line Mult = get_kept_objects(T), filltabstr(T,Mult), - spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Self ! start, - io:format("Starting to filltabstr... ~p\n",[now()]), - filltabstr(T,Mult,Mult+10000), - io:format("Done with filltabstr. ~p\n",[now()]), - Self ! done - end, [link, {scheduler,2}]), + my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), + Self ! start, + io:format("Starting to filltabstr... ~p\n",[now()]), + filltabstr(T,Mult,Mult+10000), + io:format("Done with filltabstr. ~p\n",[now()]), + Self ! done + end, [link, {scheduler,2}]), ?line start = receive_any(), io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]), ?line true = ets:safe_fixtable(T,false), @@ -5026,13 +5021,13 @@ shrink_pseudo_deleted_do(Type) -> [true]}]), ?line Half = ets:info(T,size), ?line Half = get_kept_objects(T), - spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Self ! start, - io:format("Starting to delete... ~p\n",[now()]), - del_one_by_one_set(T,1,Half+1), - io:format("Done with delete. ~p\n",[now()]), - Self ! done - end, [link, {scheduler,2}]), + my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), + Self ! start, + io:format("Starting to delete... ~p\n",[now()]), + del_one_by_one_set(T,1,Half+1), + io:format("Done with delete. ~p\n",[now()]), + Self ! done + end, [link, {scheduler,2}]), ?line start = receive_any(), io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]), ?line true = ets:safe_fixtable(T,false), @@ -5189,24 +5184,24 @@ smp_unfix_fix_do() -> ?line Deleted = get_kept_objects(T), {Child, Mref} = - spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Parent ! start, - io:format("Child waiting for table to be unfixed... now=~p mem=~p\n", - [now(),ets:info(T,memory)]), - repeat_while(fun()-> ets:info(T,fixed) end), - io:format("Table unfixed. Child Fixating! now=~p mem=~p\n", - [now(),ets:info(T,memory)]), - ?line true = ets:safe_fixtable(T,true), - repeat_while(fun(Key) when Key =< NumOfObjs -> - ets:delete(T,Key), {true,Key+1}; - (Key) -> {false,Key} - end, - Deleted), - ?line 0 = ets:info(T,size), - ?line true = get_kept_objects(T) >= Left, - ?line done = receive_any() - end, - [link, monitor, {scheduler,2}]), + my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), + Parent ! start, + io:format("Child waiting for table to be unfixed... now=~p mem=~p\n", + [now(),ets:info(T,memory)]), + repeat_while(fun()-> ets:info(T,fixed) end), + io:format("Table unfixed. Child Fixating! now=~p mem=~p\n", + [now(),ets:info(T,memory)]), + ?line true = ets:safe_fixtable(T,true), + repeat_while(fun(Key) when Key =< NumOfObjs -> + ets:delete(T,Key), {true,Key+1}; + (Key) -> {false,Key} + end, + Deleted), + ?line 0 = ets:info(T,size), + ?line true = get_kept_objects(T) >= Left, + ?line done = receive_any() + end, + [link, monitor, {scheduler,2}]), ?line start = receive_any(), ?line true = ets:info(T,fixed), @@ -5237,11 +5232,11 @@ otp_8166_do(WC) -> Deleted = NumOfObjs div 2, filltabint(T,NumOfObjs), {ReaderPid, ReaderMref} = - spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end, - [link, monitor, {scheduler,2}]), + my_spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end, + [link, monitor, {scheduler,2}]), {ZombieCrPid, ZombieCrMref} = - spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end, - [link, monitor, {scheduler,3}]), + my_spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end, + [link, monitor, {scheduler,3}]), repeat(fun() -> ZombieCrPid ! {loop, self()}, zombies_created = receive_any(), @@ -5501,7 +5496,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) -> io:format("smp starting ~p workers\n",[NumOfProcs]), Seeds = [{ProcN,random:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)], Parent = self(), - Pids = [spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end) + Pids = [my_spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end) || Seed <- Seeds], case Laps of infinite -> Pids; @@ -5550,31 +5545,30 @@ my_tab_to_list(_Ts,'$end_of_table', Acc) -> lists:reverse(Acc); my_tab_to_list(Ts,Key, Acc) -> my_tab_to_list(Ts,ets:next(Ts,Key),[ets:lookup(Ts, Key)| Acc]). -wait_for_all_schedulers_online_to_execute() -> - PMs = lists:map(fun (Sched) -> - spawn_opt(fun () -> ok end, - [monitor, {scheduler, Sched}]) - end, - lists:seq(1,erlang:system_info(schedulers_online))), - lists:foreach(fun ({P, M}) -> - receive - {'DOWN', M, process, P, _} -> ok - end - end, - PMs), - ok. + +wait_for_memory_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() + end. + etsmem() -> - %% Wait until it is guaranteed that all already scheduled - %% deallocations of DbTable structures have completed. - wait_for_all_schedulers_online_to_execute(), + wait_for_memory_deallocations(), AllTabs = lists:map(fun(T) -> {T,ets:info(T,name),ets:info(T,size), ets:info(T,memory),ets:info(T,type)} end, ets:all()), + + EtsAllocInfo = erlang:system_info({allocator,ets_alloc}), + ErlangMemoryEts = try erlang:memory(ets) catch error:notsup -> notsup end, + Mem = - {try erlang:memory(ets) catch error:notsup -> notsup end, - case erlang:system_info({allocator,ets_alloc}) of + {ErlangMemoryEts, + case EtsAllocInfo of false -> undefined; MemInfo -> CS = lists:foldl( @@ -5651,6 +5645,7 @@ spawn_logger(Procs) -> true -> exit(Proc, kill); _ -> ok end, + erlang:display(process_info(Proc)), receive {'DOWN', Mon, _, _, _} -> ok @@ -5686,7 +5681,7 @@ wait_for_test_procs(Kill) -> ets_test_spawn_logger ! {sync_test_procs, Kill, self()}, receive test_procs_synced -> ok end. -log_test_proc(Proc) -> +log_test_proc(Proc) when is_pid(Proc) -> ets_test_spawn_logger ! {new_test_proc, Proc}, Proc. @@ -5698,9 +5693,17 @@ my_spawn_link(Fun) -> log_test_proc(spawn_link(Fun)). my_spawn_link(M,F,A) -> log_test_proc(spawn_link(M,F,A)). %%my_spawn_link(N,M,F,A) -> log_test_proc(spawn_link(N,M,F,A)). -my_spawn_opt(Fun,Opts) -> log_test_proc(spawn_opt(Fun,Opts)). -%%my_spawn_opt(M,F,A,Opts) -> log_test_proc(spawn_opt(M,F,A,Opts)). -%%my_spawn_opt(N,M,F,A,Opts) -> log_test_proc(spawn_opt(N,M,F,A,Opts)). +my_spawn_opt(Fun,Opts) -> + case spawn_opt(Fun,Opts) of + Pid when is_pid(Pid) -> log_test_proc(Pid); + {Pid, _} = Res when is_pid(Pid) -> log_test_proc(Pid), Res + end. + +my_spawn_monitor(Fun) -> + Res = spawn_monitor(Fun), + {Pid, _} = Res, + log_test_proc(Pid), + Res. repeat(_Fun, 0) -> ok; @@ -5763,11 +5766,11 @@ spawn_monitor_with_pid(Pid, Fun, N, M) when N > M*10 -> spawn_monitor_with_pid(Pid, Fun, N, M*10); spawn_monitor_with_pid(Pid, Fun, N, M) -> ?line false = is_process_alive(Pid), - case spawn(fun()-> case self() of - Pid -> Fun(); - _ -> die - end - end) of + case my_spawn(fun()-> case self() of + Pid -> Fun(); + _ -> die + end + end) of Pid -> {Pid, erlang:monitor(process, Pid)}; Other -> diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 98eeaee118..8a9d8f7883 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -6632,7 +6632,7 @@ otp_7232(Config) when is_list(Config) -> {call,_, {remote,_,{atom,_,qlc},{atom,_,sort}}, [{cons,_, - {'fun',_,{function,math,sqrt,_}}, + {'fun',_,{function,{atom,_,math},{atom,_,sqrt},_}}, {cons,_, {string,_,\"<0.4.1>\"}, % could use list_to_pid.. {cons,_,{string,_,\"#Ref<\"++_},{nil,_}}}}, diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index e709cf62ba..da6996cc9f 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -120,7 +120,9 @@ end_per_group(_GroupName, Config) -> init_per_testcase(count_children_memory, Config) -> try erlang:memory() of - _ -> Config + _ -> + erts_debug:set_internal_state(available_internal_state, true), + Config catch error:notsup -> {skip, "+Meamin used during test; erlang:memory/1 not available"} end; @@ -128,6 +130,9 @@ init_per_testcase(_Case, Config) -> erlang:display(_Case), Config. +end_per_testcase(count_children_memory, _Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), + ok; end_per_testcase(_Case, _Config) -> ok. @@ -1136,25 +1141,25 @@ count_children_memory(Config) when is_list(Config) -> [supervisor:start_child(sup_test, []) || _Ignore <- lists:seq(1,1000)], garbage_collect(), - _Size1 = erlang:memory(processes_used), + _Size1 = proc_memory(), Children = supervisor:which_children(sup_test), - _Size2 = erlang:memory(processes_used), + _Size2 = proc_memory(), ChildCount = get_child_counts(sup_test), - _Size3 = erlang:memory(processes_used), + _Size3 = proc_memory(), [supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)], garbage_collect(), Children2 = supervisor:which_children(sup_test), - Size4 = erlang:memory(processes_used), + Size4 = proc_memory(), ChildCount2 = get_child_counts(sup_test), - Size5 = erlang:memory(processes_used), + Size5 = proc_memory(), garbage_collect(), Children3 = supervisor:which_children(sup_test), - Size6 = erlang:memory(processes_used), + Size6 = proc_memory(), ChildCount3 = get_child_counts(sup_test), - Size7 = erlang:memory(processes_used), + Size7 = proc_memory(), 1000 = length(Children), [1,1000,0,1000] = ChildCount, @@ -1180,6 +1185,10 @@ count_children_memory(Config) when is_list(Config) -> [terminate(SupPid, Pid, child, kill) || {undefined, Pid, worker, _Modules} <- Children3], [1,0,0,0] = get_child_counts(sup_test). +proc_memory() -> + erts_debug:set_internal_state(wait, deallocations), + erlang:memory(processes_used). + %%------------------------------------------------------------------------- do_not_save_start_parameters_for_temporary_children(doc) -> ["Temporary children shall not be restarted so they should not " diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 9df5f26454..7f58fda519 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -6093,11 +6093,16 @@ implicit_fun_name(Node) -> {'fun', Pos, {function, Atom, Arity}} -> arity_qualifier(set_pos(atom(Atom), Pos), set_pos(integer(Arity), Pos)); - {'fun', Pos, {function, Module, Atom, Arity}} -> + {'fun', Pos, {function, Module, Atom, Arity}} + when is_atom(Module), is_atom(Atom), is_integer(Arity) -> + %% Backward compatibility with pre-R15 abstract format. module_qualifier(set_pos(atom(Module), Pos), arity_qualifier( set_pos(atom(Atom), Pos), set_pos(integer(Arity), Pos))); + {'fun', Pos, {function, Module, Atom, Arity}} -> + %% New in R15: fun M:F/A. + module_qualifier(Module, arity_qualifier(Atom, Arity)); Node1 -> data(Node1) end. diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index fb9744d759..e21bd1b88c 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -522,7 +522,7 @@ call(Request) -> {?SERVER,Reply} -> Reply end, - erlang:demonitor(Ref), + erlang:demonitor(Ref, [flush]), Return end. @@ -545,7 +545,7 @@ remote_call(Node,Request) -> {?SERVER,Reply} -> Reply end, - erlang:demonitor(Ref), + erlang:demonitor(Ref, [flush]), Return end. diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl index d22f0df164..92f0c45c7b 100644 --- a/lib/tools/src/xref_reader.erl +++ b/lib/tools/src/xref_reader.erl @@ -158,15 +158,20 @@ expr({'try',_Line,Es,Scs,Ccs,As}, S) -> S2 = clauses(Scs, S1), S3 = clauses(Ccs, S2), expr(As, S3); -expr({call, Line, - {remote, _, {atom,_,erlang}, {atom,_,make_fun}}, - [{atom,_,Mod}, {atom,_,Fun}, {integer,_,Arity}]}, S) -> - %% Added in R10B-6. M:F/A. - expr({'fun', Line, {function, Mod, Fun, Arity}}, S); -expr({'fun', Line, {function, Mod, Name, Arity}}, S) -> - %% Added in R10B-6. M:F/A. +expr({'fun', Line, {function, {atom,_,Mod}, + {atom,_,Name}, + {integer,_,Arity}}}, S) -> + %% New format in R15. M:F/A (literals). As = lists:duplicate(Arity, {atom, Line, foo}), external_call(Mod, Name, As, Line, false, S); +expr({'fun', Line, {function, Mod, Name, {integer,_,Arity}}}, S) -> + %% New format in R15. M:F/A (one or more variables). + As = lists:duplicate(Arity, {atom, Line, foo}), + external_call(erlang, apply, [Mod, Name, list2term(As)], Line, true, S); +expr({'fun', Line, {function, Mod, Name, _Arity}}, S) -> + %% New format in R15. M:F/A (one or more variables). + As = {var, Line, '_'}, + external_call(erlang, apply, [Mod, Name, As], Line, true, S); expr({'fun', Line, {function, Name, Arity}, _Extra}, S) -> %% Added in R8. handle_call(local, S#xrefr.module, Name, Arity, Line, S); @@ -286,10 +291,10 @@ check_funarg(W, ArgsList, Line, S) -> expr(ArgsList, S1). funarg({'fun', _, _Clauses, _Extra}, _S) -> true; -funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars); -funarg({call,_,{remote,_,{atom,_,erlang},{atom,_,make_fun}},_MFA}, _S) -> - %% R10B-6. M:F/A. +funarg({'fun', _, {function,_,_,_}}, _S) -> + %% New abstract format for fun M:F/A in R15. true; +funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars); funarg(_, _S) -> false. fun_args(apply2, [FunArg, Args]) -> {FunArg, Args}; diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index fe7f92de78..881a3c2997 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -583,21 +583,14 @@ otp_6115_1(Config) -> %% called -- running cover compiled code when there is no cover %% server and thus no ets tables to bump counters in, makes no %% sense. - ?line Pid1 = f1:start_fail(), - - %% If f1 is cover compiled, a process P is started with a - %% reference to the fun created in start_ok/0, and - %% cover:stop() is called, then P should survive. - %% This is because (the fun held by) P always references the current - %% version of the module, and is thus not affected by the cover - %% compiled version being unloaded. - ?line Pid2 = f1:start_ok(), + Pid1 = f1:start_a(), + Pid2 = f1:start_b(), %% Now stop cover ?line cover:stop(), - %% Ensure that f1 is loaded (and not cover compiled), that Pid1 - %% is dead and Pid2 is alive, but with no reference to old code + %% Ensure that f1 is loaded (and not cover compiled), and that + %% both Pid1 and Pid2 are dead. case code:which(f1) of Beam when is_list(Beam) -> ok; @@ -608,19 +601,15 @@ otp_6115_1(Config) -> undefined -> ok; _PI1 -> - RefToOldP = erlang:check_process_code(Pid1, f1), - ?line ?t:fail({"Pid1 still alive", RefToOldP}) + RefToOldP1 = erlang:check_process_code(Pid1, f1), + ?t:fail({"Pid1 still alive", RefToOldP1}) end, case process_info(Pid2) of - PI2 when is_list(PI2) -> - case erlang:check_process_code(Pid2, f2) of - false -> - ok; - true -> - ?line ?t:fail("Pid2 has ref to old code") - end; undefined -> - ?line ?t:fail("Pid2 has died") + ok; + _PI2 -> + RefToOldP2 = erlang:check_process_code(Pid1, f2), + ?t:fail({"Pid2 still alive", RefToOldP2}) end, ?line file:set_cwd(CWD), diff --git a/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl b/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl index b659e5d818..5399b33f19 100644 --- a/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl +++ b/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl @@ -1,12 +1,13 @@ -module(f1). --export([start_fail/0, start_ok/0]). +-export([start_a/0, start_b/0]). -start_fail() -> +start_a() -> f2:start(fun() -> - io:format("this does not work\n",[]) + ok end). -start_ok() -> +start_b() -> f2:start(fun fun1/0). + fun1() -> - io:format("this works\n",[]). + ok. diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index 2f83ab4995..e0876381ca 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -46,7 +46,8 @@ -export([ add/1, default/1, info/1, lib/1, read/1, read2/1, remove/1, replace/1, update/1, deprecated/1, trycatch/1, - abstract_modules/1, fun_mfa/1, qlc/1]). + abstract_modules/1, fun_mfa/1, fun_mfa_r14/1, + fun_mfa_vars/1, qlc/1]). -export([ analyze/1, basic/1, md/1, q/1, variables/1, unused_locals/1]). @@ -82,7 +83,7 @@ groups() -> {files, [], [add, default, info, lib, read, read2, remove, replace, update, deprecated, trycatch, abstract_modules, fun_mfa, - qlc]}, + fun_mfa_r14, fun_mfa_vars, qlc]}, {analyses, [], [analyze, basic, md, q, variables, unused_locals]}, {misc, [], [format_error, otp_7423, otp_7831]}]. @@ -1771,6 +1772,88 @@ fun_mfa(Conf) when is_list(Conf) -> ?line ok = file:delete(Beam), ok. +%% Same as the previous test case, except that we use a BEAM file +%% that was compiled by an R14 compiler to test backward compatibility. +fun_mfa_r14(Conf) when is_list(Conf) -> + Dir = ?config(data_dir, Conf), + MFile = fname(Dir, "fun_mfa_r14"), + + A = fun_mfa_r14, + {ok, _} = xref:start(s), + {ok, A} = xref:add_module(s, MFile, {warnings,false}), + {ok, [{{{A,t,0},{'$M_EXPR','$F_EXPR',0}},[7]}, + {{{A,t,0},{A,t,0}},[6]}, + {{{A,t1,0},{'$M_EXPR','$F_EXPR',0}},[11]}, + {{{A,t1,0},{A,t,0}},[10]}, + {{{A,t2,0},{A,t,0}},[14]}, + {{{A,t3,0},{A,t3,0}},[17]}]} = + xref:q(s, "(Lin) E"), + + ok = check_state(s), + xref:stop(s), + + ok. + +%% fun M:F/A with varibles. +fun_mfa_vars(Conf) when is_list(Conf) -> + Dir = ?copydir, + File = fname(Dir, "fun_mfa_vars.erl"), + MFile = fname(Dir, "fun_mfa_vars"), + Beam = fname(Dir, "fun_mfa_vars.beam"), + Test = <<"-module(fun_mfa_vars). + + -export([t/1, t1/1, t2/3]). + + t(Mod) -> + F = fun Mod:bar/2, + (F)(a, b). + + t1(Name) -> + F = fun ?MODULE:Name/1, + (F)(a). + + t2(Mod, Name, Arity) -> + F = fun Mod:Name/Arity, + (F)(a). + + t3(Arity) -> + F = fun ?MODULE:t/Arity, + (F)(1, 2, 3). + + t4(Mod, Name) -> + F = fun Mod:Name/3, + (F)(a, b, c). + + t5(Mod, Arity) -> + F = fun Mod:t/Arity, + (F)(). + ">>, + + ok = file:write_file(File, Test), + A = fun_mfa_vars, + {ok, A} = compile:file(File, [report,debug_info,{outdir,Dir}]), + {ok, _} = xref:start(s), + {ok, A} = xref:add_module(s, MFile, {warnings,false}), + {ok, [{{{A,t,1},{'$M_EXPR','$F_EXPR',2}},[7]}, + {{{A,t,1},{'$M_EXPR',bar,2}},[6]}, + {{{A,t1,1},{'$M_EXPR','$F_EXPR',1}},[11]}, + {{{A,t1,1},{A,'$F_EXPR',1}},[10]}, + {{{A,t2,3},{'$M_EXPR','$F_EXPR',-1}},[14]}, + {{{A,t2,3},{'$M_EXPR','$F_EXPR',1}},[15]}, + {{{A,t3,1},{'$M_EXPR','$F_EXPR',3}},[19]}, + {{{A,t3,1},{fun_mfa_vars,t,-1}},[18]}, + {{{A,t4,2},{'$M_EXPR','$F_EXPR',3}},[22,23]}, + {{{A,t5,2},{'$M_EXPR','$F_EXPR',0}},[27]}, + {{{A,t5,2},{'$M_EXPR',t,-1}},[26]}]} = + xref:q(s, "(Lin) E"), + + ok = check_state(s), + xref:stop(s), + + ok = file:delete(File), + ok = file:delete(Beam), + ok. + qlc(suite) -> []; qlc(doc) -> ["OTP-5195: A bug fix when using qlc:q/1,2."]; qlc(Conf) when is_list(Conf) -> diff --git a/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam Binary files differnew file mode 100644 index 0000000000..4645525690 --- /dev/null +++ b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam diff --git a/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl new file mode 100644 index 0000000000..293bd83a8b --- /dev/null +++ b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl @@ -0,0 +1,18 @@ +-module(fun_mfa_r14). + +-export([t/0, t1/0, t2/0, t3/0]). + +t() -> + F = fun ?MODULE:t/0, + (F)(). + +t1() -> + F = fun t/0, + (F)(). + +t2() -> + fun ?MODULE:t/0(). + +t3() -> + fun t3/0(). + diff --git a/lib/wx/examples/demo/Makefile b/lib/wx/examples/demo/Makefile index 98d7c6a130..98d7c6a130 100755..100644 --- a/lib/wx/examples/demo/Makefile +++ b/lib/wx/examples/demo/Makefile diff --git a/lib/wx/examples/simple/hello.erl b/lib/wx/examples/simple/hello.erl index dc845ddfbb..dc845ddfbb 100755..100644 --- a/lib/wx/examples/simple/hello.erl +++ b/lib/wx/examples/simple/hello.erl diff --git a/lib/wx/examples/simple/menu.erl b/lib/wx/examples/simple/menu.erl index d573fcf13a..d573fcf13a 100755..100644 --- a/lib/wx/examples/simple/menu.erl +++ b/lib/wx/examples/simple/menu.erl diff --git a/lib/wx/examples/simple/minimal.erl b/lib/wx/examples/simple/minimal.erl index dca4adc643..dca4adc643 100755..100644 --- a/lib/wx/examples/simple/minimal.erl +++ b/lib/wx/examples/simple/minimal.erl diff --git a/lib/wx/examples/simple/sample.xpm b/lib/wx/examples/simple/sample.xpm index 3263b15f8a..3263b15f8a 100755..100644 --- a/lib/wx/examples/simple/sample.xpm +++ b/lib/wx/examples/simple/sample.xpm diff --git a/lib/wx/examples/sudoku/Makefile b/lib/wx/examples/sudoku/Makefile index b86c654fdd..b86c654fdd 100755..100644 --- a/lib/wx/examples/sudoku/Makefile +++ b/lib/wx/examples/sudoku/Makefile diff --git a/lib/wx/examples/sudoku/sudoku.erl b/lib/wx/examples/sudoku/sudoku.erl index 01caeb9524..01caeb9524 100755..100644 --- a/lib/wx/examples/sudoku/sudoku.erl +++ b/lib/wx/examples/sudoku/sudoku.erl diff --git a/lib/wx/examples/sudoku/sudoku.hrl b/lib/wx/examples/sudoku/sudoku.hrl index 775b563bdc..775b563bdc 100755..100644 --- a/lib/wx/examples/sudoku/sudoku.hrl +++ b/lib/wx/examples/sudoku/sudoku.hrl diff --git a/lib/wx/examples/sudoku/sudoku_board.erl b/lib/wx/examples/sudoku/sudoku_board.erl index 756837582f..756837582f 100755..100644 --- a/lib/wx/examples/sudoku/sudoku_board.erl +++ b/lib/wx/examples/sudoku/sudoku_board.erl diff --git a/lib/wx/examples/sudoku/sudoku_game.erl b/lib/wx/examples/sudoku/sudoku_game.erl index 470aee0e3b..470aee0e3b 100755..100644 --- a/lib/wx/examples/sudoku/sudoku_game.erl +++ b/lib/wx/examples/sudoku/sudoku_game.erl diff --git a/lib/wx/examples/sudoku/sudoku_gui.erl b/lib/wx/examples/sudoku/sudoku_gui.erl index 4aaecfe086..4aaecfe086 100755..100644 --- a/lib/wx/examples/sudoku/sudoku_gui.erl +++ b/lib/wx/examples/sudoku/sudoku_gui.erl diff --git a/lib/wx/examples/xrc/Makefile b/lib/wx/examples/xrc/Makefile index 1dfaae9689..1dfaae9689 100755..100644 --- a/lib/wx/examples/xrc/Makefile +++ b/lib/wx/examples/xrc/Makefile diff --git a/lib/xmerl/doc/examples/test_html.erl b/lib/xmerl/doc/examples/test_html.erl index 3ca15f30f8..3ca15f30f8 100755..100644 --- a/lib/xmerl/doc/examples/test_html.erl +++ b/lib/xmerl/doc/examples/test_html.erl diff --git a/lib/xmerl/doc/examples/xml/test.xml b/lib/xmerl/doc/examples/xml/test.xml index e803a83560..e803a83560 100755..100644 --- a/lib/xmerl/doc/examples/xml/test.xml +++ b/lib/xmerl/doc/examples/xml/test.xml diff --git a/lib/xmerl/doc/examples/xml/test2.xml b/lib/xmerl/doc/examples/xml/test2.xml index 0cb11194fc..0cb11194fc 100755..100644 --- a/lib/xmerl/doc/examples/xml/test2.xml +++ b/lib/xmerl/doc/examples/xml/test2.xml diff --git a/lib/xmerl/doc/examples/xml/test3.xml b/lib/xmerl/doc/examples/xml/test3.xml index dbdc1e62c2..dbdc1e62c2 100755..100644 --- a/lib/xmerl/doc/examples/xml/test3.xml +++ b/lib/xmerl/doc/examples/xml/test3.xml diff --git a/lib/xmerl/doc/examples/xml/test4.xml b/lib/xmerl/doc/examples/xml/test4.xml index e9d85b8d8f..e9d85b8d8f 100755..100644 --- a/lib/xmerl/doc/examples/xml/test4.xml +++ b/lib/xmerl/doc/examples/xml/test4.xml diff --git a/lib/xmerl/doc/examples/xml/test5.xml b/lib/xmerl/doc/examples/xml/test5.xml index e9d85b8d8f..e9d85b8d8f 100755..100644 --- a/lib/xmerl/doc/examples/xml/test5.xml +++ b/lib/xmerl/doc/examples/xml/test5.xml diff --git a/lib/xmerl/doc/examples/xml/testdtd.dtd b/lib/xmerl/doc/examples/xml/testdtd.dtd index 2ce1c513a6..2ce1c513a6 100755..100644 --- a/lib/xmerl/doc/examples/xml/testdtd.dtd +++ b/lib/xmerl/doc/examples/xml/testdtd.dtd diff --git a/lib/xmerl/doc/examples/xml/xmerl.xml b/lib/xmerl/doc/examples/xml/xmerl.xml index f02282dbef..f02282dbef 100755..100644 --- a/lib/xmerl/doc/examples/xml/xmerl.xml +++ b/lib/xmerl/doc/examples/xml/xmerl.xml diff --git a/lib/xmerl/doc/src/part_notes.xml b/lib/xmerl/doc/src/part_notes.xml index 827ffd90e9..827ffd90e9 100755..100644 --- a/lib/xmerl/doc/src/part_notes.xml +++ b/lib/xmerl/doc/src/part_notes.xml diff --git a/lib/xmerl/include/xmerl.hrl b/lib/xmerl/include/xmerl.hrl index 7bb3f4de9b..3760a5cce0 100755..100644 --- a/lib/xmerl/include/xmerl.hrl +++ b/lib/xmerl/include/xmerl.hrl @@ -61,10 +61,11 @@ }). %% namespace node - i.e. a {Prefix, URI} pair -%% TODO: these are not currently used?? /RC -record(xmlNsNode,{ - prefix, - uri = [] + parents = [], % [{atom(),integer()}] + pos, % integer() + prefix, % string() + uri = [] % [] | atom() }). %% XML Element @@ -103,9 +104,10 @@ %% processing instruction -record(xmlPI,{ - name, % atom() - pos, % integer() - value % IOlist() + name, % atom() + parents = [], % [{atom(),integer()}] + pos, % integer() + value % IOlist() }). -record(xmlDocument,{ @@ -154,6 +156,9 @@ declarations = [], % [{Name, Attrs}] doctype_name, doctype_DTD = internal, % internal | DTDId + comments = true, + document = false, + default_attrs = false, rules, keep_rules = false, % delete (ets) tab if false namespace_conformant = false, % true | false diff --git a/lib/xmerl/include/xmerl_xlink.hrl b/lib/xmerl/include/xmerl_xlink.hrl index 375e244c23..375e244c23 100755..100644 --- a/lib/xmerl/include/xmerl_xlink.hrl +++ b/lib/xmerl/include/xmerl_xlink.hrl diff --git a/lib/xmerl/src/xmerl_lib.erl b/lib/xmerl/src/xmerl_lib.erl index 6402f1cbeb..aeb821f411 100644 --- a/lib/xmerl/src/xmerl_lib.erl +++ b/lib/xmerl/src/xmerl_lib.erl @@ -160,8 +160,9 @@ expand_element(E = #xmlText{}, Pos, Parents, Norm) -> E#xmlText{pos = Pos, parents = Parents, value = expand_text(E#xmlText.value, Norm)}; -expand_element(E = #xmlPI{}, Pos, _Parents, Norm) -> +expand_element(E = #xmlPI{}, Pos, Parents, Norm) -> E#xmlPI{pos = Pos, + parents = Parents, value = expand_text(E#xmlPI.value, Norm)}; expand_element(E = #xmlComment{}, Pos, Parents, Norm) -> E#xmlComment{pos = Pos, diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 3b9eaa309c..ec9178ea25 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -944,14 +944,19 @@ parse_att_value(?STRING_REST("&", Rest), State, Stop, Acc) -> {unparsed, Name, _} -> ?fatal_error(State1, "Unparsed entity reference in attribute value: " ++ Name) end; -parse_att_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) -> +parse_att_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) -> {lists:reverse(Acc), Rest, State}; -parse_att_value(?STRING_UNBOUND_REST($<, _Rest), State, _Stop, _Acc) -> +parse_att_value(?STRING_UNBOUND_REST($<, _Rest), State, _Stop, _Acc) -> ?fatal_error(State, "< not allowed in attribute value"); -parse_att_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) -> - parse_att_value(Rest, State, Stop, [C|Acc]); -parse_att_value(Bytes, State, Stop, Acc) -> - unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_att_value/4], +parse_att_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) -> + if + ?is_char(C) -> + parse_att_value(Rest, State, Stop, [C|Acc]); + true -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character in attribute value: ~p", [C]))) + end; +parse_att_value(Bytes, State, Stop, Acc) -> + unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_att_value/4], undefined). @@ -1120,10 +1125,10 @@ parse_content(?STRING_UNBOUND_REST(C, Rest), State, Acc, _IgnorableWS) -> ?is_char(C) -> parse_content(Rest, State, [C|Acc], false); true -> - ?fatal_error(State, "Bad character in content: " ++ C) - end; -parse_content(Bytes, State, Acc, IgnorableWS) -> - unicode_incomplete_check([Bytes, State, Acc, IgnorableWS, fun parse_content/4], + ?fatal_error(State, lists:flatten(io_lib:format("Bad character in content: ~p", [C]))) + end; +parse_content(Bytes, State, Acc, IgnorableWS) -> + unicode_incomplete_check([Bytes, State, Acc, IgnorableWS, fun parse_content/4], undefined). @@ -2522,11 +2527,16 @@ parse_entity_value(?STRING_REST("%", Rest), #xmerl_sax_parser_state{file_type=Ty end end; -parse_entity_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) -> +parse_entity_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) -> {lists:reverse(Acc), Rest, State}; -parse_entity_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) -> - parse_entity_value(Rest, State, Stop, [C|Acc]); -parse_entity_value(Bytes, State, Stop, Acc) -> +parse_entity_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) -> + if + ?is_char(C) -> + parse_entity_value(Rest, State, Stop, [C|Acc]); + true -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character in entity value: ~p", [C]))) + end; +parse_entity_value(Bytes, State, Stop, Acc) -> unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_entity_value/4], undefined). diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 25c6547497..ec7ea534d6 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -100,7 +100,21 @@ %% <dd>Set default character set used (default UTF-8). %% This character set is used only if not explicitly given by the XML %% declaration. </dd> +%% <dt><code>{document, Flag}</code></dt> +%% <dd>Set to 'true' if xmerl should return a complete XML document +%% as an xmlDocument record (default 'false').</dd> +%% <dt><code>{comments, Flag}</code></dt> +%% <dd>Set to 'false' if xmerl should skip comments otherwise they will +%% be returned as xmlComment records (default 'true').</dd> +%% <dt><code>{default_attrs, Flag}</code></dt> +%% <dd>Set to 'true' if xmerl should add to elements missing attributes +%% with a defined default value (default 'false').</dd> %% </dl> +%% @type document() = xmlElement() | xmlDocument(). <p> +%% The document returned by <tt>xmerl_scan:string/[1,2]</tt> and +%% <tt>xmerl_scan:file/[1,2]</tt>. The type of the returned record depends on +%% the value of the document option passed to the function. +%% </p> -module(xmerl_scan). @@ -224,7 +238,7 @@ cont_state(X, S=#xmerl_scanner{fun_states = FS}) -> file(F) -> file(F, []). -%% @spec file(Filename::string(), Options::option_list()) -> {xmlElement(),Rest} +%% @spec file(Filename::string(), Options::option_list()) -> {document(),Rest} %% Rest = list() %%% @doc Parse file containing an XML document file(F, Options) -> @@ -264,7 +278,7 @@ int_file_decl(F, Options,_ExtCharset) -> string(Str) -> string(Str, []). -%% @spec string(Text::list(),Options::option_list()) -> {xmlElement(),Rest} +%% @spec string(Text::list(),Options::option_list()) -> {document(),Rest} %% Rest = list() %%% @doc Parse string containing an XML document string(Str, Options) -> @@ -381,6 +395,12 @@ initial_state([{quiet, F}|T], S) when F==true; F==false -> initial_state(T, S#xmerl_scanner{quiet = F}); initial_state([{doctype_DTD,DTD}|T], S) -> initial_state(T,S#xmerl_scanner{doctype_DTD = DTD}); +initial_state([{document, F}|T], S) when is_boolean(F) -> + initial_state(T,S#xmerl_scanner{document = F}); +initial_state([{comments, F}|T], S) when is_boolean(F) -> + initial_state(T,S#xmerl_scanner{comments = F}); +initial_state([{default_attrs, F}|T], S) when is_boolean(F) -> + initial_state(T,S#xmerl_scanner{default_attrs = F}); initial_state([{text_decl,Bool}|T], S) -> initial_state(T,S#xmerl_scanner{text_decl=Bool}); initial_state([{environment,Env}|T], S) -> @@ -518,6 +538,7 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, line = L, col = C, environment=Env, encoding=Charset, + document=Document, validation=ValidateResult}) -> S1 = Event(#xmerl_event{event = started, line = L, @@ -530,8 +551,8 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, Str=if Charset == "utf-8" -> Str0; - Charset=/=undefined -> % Default character set is UTF-8 - xmerl_ucs:to_unicode(Str0,list_to_atom(Charset)); + Charset =/= undefined -> % Default character set is UTF-8 + xmerl_ucs:to_unicode(Str0, list_to_atom(Charset)); true -> %% Charset is undefined if no external input is %% given, and no auto detection of character %% encoding was made. @@ -539,17 +560,17 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, end, %% M1 = erlang:memory(), %% io:format("Memory status before prolog: ~p~n",[M1]), - {T1, S2} = scan_prolog(Str, S1, _StartPos = 1), + {Prolog, Pos, T1, S2} = scan_prolog(Str, S1, _StartPos = 1), %% M2 = erlang:memory(), %% io:format("Memory status after prolog: ~p~n",[M2]), %%io:format("scan_document 2, prolog parsed~n",[]), - T2 = scan_mandatory("<",T1,1,S2,expected_element_start_tag), + T2 = scan_mandatory("<", T1, 1, S2, expected_element_start_tag), %% M3 = erlang:memory(), %% io:format("Memory status before element: ~p~n",[M3]), - {Res, T3, S3} =scan_element(T2,S2,_StartPos = 1), + {Res, T3, S3} = scan_element(T2,S2,Pos), %% M4 = erlang:memory(), %% io:format("Memory status after element: ~p~n",[M4]), - {Tail, S4}=scan_misc(T3, S3, _StartPos = 1), + {Misc, _Pos1, Tail, S4}=scan_misc(T3, S3, Pos + 1), %% M5 = erlang:memory(), %% io:format("Memory status after misc: ~p~n",[M5]), @@ -558,44 +579,52 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, col = S4#xmerl_scanner.col, data = document}, S4), - {Res2,S6} = case validation_mode(ValidateResult) of + {Res2, S6} = case validation_mode(ValidateResult) of off -> - {Res,cleanup(S5)}; + {Res, cleanup(S5)}; dtd when Env == element; Env == prolog -> check_decl2(S5), - case xmerl_validate:validate(S5,Res) of - {'EXIT',{error,Reason}} -> - S5b=cleanup(S5), - ?fatal({failed_validation,Reason}, S5b); - {'EXIT',Reason} -> - S5b=cleanup(S5), - ?fatal({failed_validation,Reason}, S5b); - {error,Reason} -> - S5b=cleanup(S5), - ?fatal({failed_validation,Reason}, S5b); - {error,Reason,_Next} -> - S5b=cleanup(S5), - ?fatal({failed_validation,Reason}, S5b); + case xmerl_validate:validate(S5, Res) of + {'EXIT', {error, Reason}} -> + S5b = cleanup(S5), + ?fatal({failed_validation, Reason}, S5b); + {'EXIT', Reason} -> + S5b = cleanup(S5), + ?fatal({failed_validation, Reason}, S5b); + {error, Reason} -> + S5b = cleanup(S5), + ?fatal({failed_validation, Reason}, S5b); + {error, Reason, _Next} -> + S5b = cleanup(S5), + ?fatal({failed_validation, Reason}, S5b); _XML -> - {Res,cleanup(S5)} + {Res, cleanup(S5)} end; schema -> - case schemaLocations(Res,S5) of - {ok,Schemas} -> + case schemaLocations(Res, S5) of + {ok, Schemas} -> cleanup(S5), %%io:format("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n", %% [Schemas,Res,inherit_options(S5)]), - XSDRes = xmerl_xsd:process_validate(Schemas,Res, + XSDRes = xmerl_xsd:process_validate(Schemas, Res, inherit_options(S5)), - handle_schema_result(XSDRes,S5); + handle_schema_result(XSDRes, S5); _ -> - {Res,cleanup(S5)} + {Res, cleanup(S5)} end; _ -> - {Res,cleanup(S5)} + {Res, cleanup(S5)} end, - {Res2, Tail, S6}. + Res3 = + case Document of + true -> + Content = lists:reverse(Prolog, [Res2 | lists:reverse(Misc)]), + #xmlDocument{content = Content}; + false -> + Res2 + end, + {Res3, Tail, S6}. scan_decl(Str, S=#xmerl_scanner{event_fun = Event, @@ -609,11 +638,11 @@ scan_decl(Str, S=#xmerl_scanner{event_fun = Event, data = document}, S), case scan_prolog(Str, S1, _StartPos = 1) of - {T2="<"++_, S2} -> + {_,_,T2="<"++_, S2} -> {{S2#xmerl_scanner.user_state,T2},[],S2}; - {[], S2}-> + {_,_,[], S2}-> {[],[],S2}; - {T2, S2} -> + {_,_,T2, S2} -> {_,_,S3} = scan_content(T2,S2,[],_Attrs=[],S2#xmerl_scanner.space, _Lang=[],_Parents=[],#xmlNamespace{}), {T2,[],S3} @@ -624,14 +653,17 @@ scan_decl(Str, S=#xmerl_scanner{event_fun = Event, %%% prolog ::= XMLDecl? Misc* (doctypedecl Misc*)? %%% %% empty text declarations are handled by the first function clause. -scan_prolog([], S=#xmerl_scanner{continuation_fun = F}, Pos) -> +scan_prolog(T, S, Pos) -> + scan_prolog(T, S, Pos, []). +scan_prolog([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_prolog(MoreBytes, S1, Pos) end, - fun(S1) -> {[], S1} end, + F(fun(MoreBytes, S1) -> scan_prolog(MoreBytes, S1, Pos, Acc) end, + fun(S1) -> {Acc, Pos, [], S1} end, S); -scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos) - when ?whitespace(hd(T)) -> - {Charset,T3, S3}= +scan_prolog("<?xml"++T, + S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L}, + Pos,Acc) when ?whitespace(hd(T)) -> + {Charset, T3, S3} = if Col==1,L==1,S0#xmerl_scanner.text_decl==true -> ?dbg("prolog(\"<?xml\")~n", []), @@ -639,13 +671,13 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos) {_,T1,S1} = mandatory_strip(T,S), {Decl,T2, S2}=scan_text_decl(T1,S1), Encoding=Decl#xmlDecl.encoding, - {Encoding,T2, S2#xmerl_scanner{encoding=Encoding}}; + {Encoding, T2, S2#xmerl_scanner{encoding=Encoding}}; Col==1,L==1 -> ?dbg("prolog(\"<?xml\")~n", []), ?bump_col(5), {Decl,T2, S2}=scan_xml_decl(T, S), Encoding=Decl#xmlDecl.encoding, - {Encoding,T2, S2#xmerl_scanner{encoding=Encoding}}; + {Encoding, T2, S2#xmerl_scanner{encoding=Encoding}}; true -> ?fatal({xml_declaration_must_be_first_in_doc,Col,L},S0) end, @@ -659,7 +691,7 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos) %% Now transform to declared character set. if Charset==Charset0 -> % Document already transformed to this charset! - scan_prolog(T3, S3, Pos); + scan_prolog(T3, S3, Pos, Acc); Charset0=/=undefined -> %% For example may an external entity %% have the BOM for utf-16 and the internal @@ -668,17 +700,18 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos) %% 'iso-10646-utf-1', and Charset will be 'utf-16', all %% legal. %% - scan_prolog(T3,S3#xmerl_scanner{encoding=Charset0},Pos); + scan_prolog(T3,S3#xmerl_scanner{encoding=Charset0},Pos,Acc); Charset == "utf-8" -> - scan_prolog(T3, S3, Pos); + scan_prolog(T3, S3, Pos, Acc); Charset=/=undefined -> % Document not previously transformed T4=xmerl_ucs:to_unicode(T3,list_to_atom(Charset)), - scan_prolog(T4, S3, Pos); + scan_prolog(T4, S3, Pos, Acc); true -> % No encoding info given - scan_prolog(T3, S3, Pos) + scan_prolog(T3, S3, Pos, Acc) end; -scan_prolog("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog, - encoding=_Charset}, Pos) -> +scan_prolog("<!DOCTYPE" ++ T, + S0=#xmerl_scanner{environment=prolog,encoding=_Charset}, + Pos, Acc) -> ?dbg("prolog(\"<!DOCTYPE\")~n", []), ?bump_col(9), %% If no known character set assume it is UTF-8 @@ -687,10 +720,13 @@ scan_prolog("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog, true -> T end, {T2, S1} = scan_doctype(T1, S), - scan_misc(T2, S1, Pos); -scan_prolog(Str="%"++_T,S=#xmerl_scanner{environment={external,_}},_Pos) -> - scan_ext_subset(Str,S); -scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset},Pos) -> + scan_misc(T2, S1, Pos, Acc); +scan_prolog(Str="%"++_T,S=#xmerl_scanner{environment={external,_}}, + Pos,Acc) -> + {T, S1} = scan_ext_subset(Str,S), + {Acc, Pos, T, S1}; +scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset}, + Pos,Acc) -> ?dbg("prolog(\"<\")~n", []), %% Check for Comments, PI before possible DOCTYPE declaration @@ -700,26 +736,28 @@ scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset},Pos) -> %% Charset==undefined -> xmerl_ucs:to_unicode(Str,'utf-8'); true -> Str end, - {T1, S1}=scan_misc(T, S, Pos), - scan_prolog2(T1,S1,Pos). + {Acc1, Pos1, T1, S1}=scan_misc(T, S, Pos, Acc), + scan_prolog2(T1,S1,Pos1,Acc1). -scan_prolog2([], S=#xmerl_scanner{continuation_fun = F}, Pos) -> +scan_prolog2([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_prolog2(MoreBytes, S1, Pos) end, - fun(S1) -> {[], S1} end, + F(fun(MoreBytes, S1) -> scan_prolog2(MoreBytes, S1, Pos, Acc) end, + fun(S1) -> {Acc, Pos, [], S1} end, S); -scan_prolog2("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog}, Pos) -> +scan_prolog2("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog}, + Pos, Acc) -> ?dbg("prolog(\"<!DOCTYPE\")~n", []), ?bump_col(9), {T1, S1} = scan_doctype(T, S), - scan_misc(T1, S1, Pos); -scan_prolog2(Str = "<!" ++ _, S, _Pos) -> + scan_misc(T1, S1, Pos, Acc); +scan_prolog2(Str = "<!" ++ _, S, Pos, Acc) -> ?dbg("prolog(\"<!\")~n", []), %% In e.g. a DTD, we jump directly to markup declarations - scan_ext_subset(Str, S); -scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) -> + {T, S1} = scan_ext_subset(Str, S), + {Acc, Pos, T, S1}; +scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos,Acc) -> ?dbg("prolog(\"<\")~n", []), %% Here we consider the DTD provided by doctype_DTD option, @@ -733,7 +771,7 @@ scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) -> end, %% Check for more Comments and PI after DOCTYPE declaration % ?bump_col(1), - scan_misc(Str, S1, Pos). + scan_misc(Str, S1, Pos, Acc). @@ -743,26 +781,46 @@ scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) -> %% - Neither of Comment and PI are returned in the resulting parsed %% structure. %% - scan_misc/3 implements Misc* as that is how the rule is always used -scan_misc([], S=#xmerl_scanner{continuation_fun = F}, Pos) -> +scan_misc(T, S, Pos) -> + scan_misc(T, S, Pos, []). +scan_misc([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_misc(MoreBytes, S1, Pos) end, - fun(S1) -> {[], S1} end, + F(fun(MoreBytes, S1) -> scan_misc(MoreBytes, S1, Pos, Acc) end, + fun(S1) -> {Acc, Pos, [], S1} end, S); -scan_misc("<!--" ++ T, S0, Pos) -> % Comment +scan_misc("<!--" ++ T, S0=#xmerl_scanner{acc_fun = F, comments=CF}, Pos, Acc) -> % Comment ?bump_col(4), - {_, T1, S1} = scan_comment(T, S, Pos, _Parents = [], _Lang = []), - scan_misc(T1,S1,Pos); -scan_misc("<?" ++ T, S0, Pos) -> % PI + {C, T1, S1} = scan_comment(T, S, Pos, _Parents = [], _Lang = []), + case CF of + true -> + {Acc2, Pos2, S3} = + case F(C, Acc, S1) of + {Acc1, S2} -> + {Acc1, Pos + 1, S2}; + {Acc1, Pos1, S2} -> + {Acc1, Pos1, S2} + end, + scan_misc(T1, S3, Pos2, Acc2); + false -> + scan_misc(T1, S1, Pos, Acc) + end; +scan_misc("<?" ++ T, S0=#xmerl_scanner{acc_fun = F}, Pos, Acc) -> % PI ?dbg("prolog(\"<?\")~n", []), ?bump_col(2), - {_PI, T1, S1} = scan_pi(T, S, Pos), - scan_misc(T1,S1,Pos); -scan_misc(T=[H|_T], S, Pos) when ?whitespace(H) -> + {PI, T1, S1} = scan_pi(T, S, Pos, []), + {Acc2, Pos2, S3} = case F(PI, Acc, S1) of + {Acc1, S2} -> + {Acc1, Pos + 1, S2}; + {Acc1, Pos1, S2} -> + {Acc1, Pos1, S2} + end, + scan_misc(T1,S3,Pos2,Acc2); +scan_misc(T=[H|_T], S, Pos, Acc) when ?whitespace(H) -> ?dbg("prolog(whitespace)~n", []), {_,T1,S1}=strip(T,S), - scan_misc(T1,S1,Pos); -scan_misc(T,S,_Pos) -> - {T,S}. + scan_misc(T1,S1,Pos,Acc); +scan_misc(T,S,Pos,Acc) -> + {Acc,Pos,T,S}. cleanup(S=#xmerl_scanner{keep_rules = false, @@ -789,7 +847,8 @@ scan_xml_decl(T, S) -> Attr = #xmlAttribute{name = version, parents = [{xml, _XMLPos = 1}], value = Vsn}, - scan_xml_decl(T4, S4, #xmlDecl{attributes = [Attr]}). + scan_xml_decl(T4, S4, #xmlDecl{vsn = Vsn, + attributes = [Attr]}). scan_xml_decl([], S=#xmerl_scanner{continuation_fun = F}, Decl) -> ?dbg("cont()...~n", []), @@ -1025,50 +1084,53 @@ xml_vsn([H|T], S=#xmerl_scanner{col = C}, Delim, Acc) -> %%%%%%% [16] PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char*)))? '?>' -scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos) -> +scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos, Ps) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos) end, + F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos, Ps) end, fun(S1) -> ?fatal(unexpected_end, S1) end, S); -scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos) +scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos, Ps) when H1==$x;H1==$X -> %% names beginning with [xX][mM][lL] are reserved for future use. ?bump_col(3), if ((H2==$m) or (H2==$M)) and ((H3==$l) or (H3==$L)) -> - scan_wellknown_pi(T,S,Pos); + scan_wellknown_pi(T,S,Pos,Ps); true -> {Target, _NamespaceInfo, T1, S1} = scan_name(Str, S), - scan_pi(T1, S1, Target, L, C, Pos, []) + scan_pi(T1, S1, Target, L, C, Pos, Ps, []) end; -scan_pi(Str, S=#xmerl_scanner{line = L, col = C}, Pos) -> +scan_pi(Str, S=#xmerl_scanner{line = L, col = C}, Pos, Ps) -> {Target, _NamespaceInfo, T1, S1} = scan_name(Str, S), - scan_pi(T1, S1, Target, L, C, Pos,[]). + scan_pi(T1, S1, Target, L, C, Pos, Ps, []). %%% More info on xml-stylesheet can be found at: %%% "Associating Style Sheets with XML documents", Version 1.0, %%% W3C Recommendation 29 June 1999 (http://www.w3.org/TR/xml-stylesheet/) -scan_wellknown_pi("-stylesheet"++T, S0=#xmerl_scanner{line=L,col=C},Pos) -> +scan_wellknown_pi("-stylesheet"++T, S0=#xmerl_scanner{line=L,col=C},Pos,Ps) -> ?dbg("prolog(\"<?xml-stylesheet\")~n", []), ?bump_col(16), - scan_pi(T, S, "xml-stylesheet",L,C,Pos,[]); -scan_wellknown_pi(Str,S,_Pos) -> + scan_pi(T, S, "xml-stylesheet",L,C,Pos,Ps,[]); +scan_wellknown_pi(Str,S,_Pos,_Ps) -> ?fatal({invalid_target_name, lists:sublist(Str, 1, 10)}, S). -scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target,L, C, Pos, Acc) -> +scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target, + L, C, Pos, Ps, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, L, C, Pos, Acc) end, + F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, + L, C, Pos, Ps, Acc) end, fun(S1) -> ?fatal(unexpected_end, S1) end, S); scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, - Target, L, C, Pos, Acc) -> + Target, L, C, Pos, Ps, Acc) -> ?bump_col(2), PI = #xmlPI{name = Target, + parents = Ps, pos = Pos, value = lists:reverse(Acc)}, S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, @@ -1077,22 +1139,25 @@ scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, data = PI}, S), {Ret, S2} = Hook(PI, S1), {Ret, T, S2}; -scan_pi([H|T], S, Target, L, C, Pos, Acc) when ?whitespace(H) -> +scan_pi([H|T], S, Target, L, C, Pos, Ps, Acc) when ?whitespace(H) -> ?strip1, - scan_pi2(T1, S1, Target, L, C, Pos, Acc); -scan_pi([H|_T],S,_Target, _L, _C, _Pos, _Acc) -> + scan_pi2(T1, S1, Target, L, C, Pos, Ps, Acc); +scan_pi([H|_T],S,_Target, _L, _C, _Pos, _Ps, _Acc) -> ?fatal({expected_whitespace_OR_end_of_PI,{char,H}}, S). -scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target,L, C, Pos, Acc) -> +scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target, + L, C, Pos, Ps, Acc) -> ?dbg("cont()...~n", []), - F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, L, C, Pos, Acc) end, + F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, + L, C, Pos, Ps, Acc) end, fun(S1) -> ?fatal(unexpected_end, S1) end, S); scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, - Target, L, C, Pos, Acc) -> + Target, L, C, Pos, Ps, Acc) -> ?bump_col(2), PI = #xmlPI{name = Target, + parents = Ps, pos = Pos, value = lists:reverse(Acc)}, S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, @@ -1101,10 +1166,10 @@ scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, data = PI}, S), {Ret, S2} = Hook(PI, S1), {Ret, T, S2}; -scan_pi2(Str, S0, Target, L, C, Pos, Acc) -> +scan_pi2(Str, S0, Target, L, C, Pos, Ps, Acc) -> ?bump_col(1), {Ch,T} = wfc_legal_char(Str,S), - scan_pi2(T, S, Target, L, C, Pos, [Ch|Acc]). + scan_pi2(T, S, Target, L, C, Pos, Ps, [Ch|Acc]). @@ -1575,7 +1640,7 @@ scan_markup_decl("<!--" ++ T, S0) -> scan_comment(T, S); scan_markup_decl("<?" ++ T, S0) -> ?bump_col(2), - {_PI, T1, S1} = scan_pi(T, S,_Pos=markup), + {_PI, T1, S1} = scan_pi(T, S,_Pos=markup,[]), strip(T1, S1); scan_markup_decl("<!ELEMENT" ++ T, #xmerl_scanner{rules_read_fun = Read, @@ -1981,7 +2046,7 @@ scan_element(T, S, Pos) -> scan_element(T, S=#xmerl_scanner{line=L,col=C}, Pos, SpaceDefault,Lang, Parents, NS) -> {Name, NamespaceInfo, T1, S1} = scan_name(T, S), - vc_Element_valid(Name,S), + vc_Element_valid(Name,NamespaceInfo,S), ?strip2, scan_element(T2, S2, Pos, Name, L, C, _Attrs = [], Lang, Parents, NamespaceInfo, NS, @@ -2016,7 +2081,8 @@ scan_element("/>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, Attrs = lists:reverse(Attrs0), E=processed_whole_element(S, Pos, Name, Attrs, Lang, Parents,NSI,Namespace), - wfc_unique_att_spec(Attrs,S), + #xmlElement{attributes = Attrs1} = E, + wfc_unique_att_spec(Attrs1,S), S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, line = L, col = C, @@ -2086,9 +2152,10 @@ scan_element(T, S, Pos, Name, StartL, StartC, Attrs, Lang, Parents, P+1 end, Attr = #xmlAttribute{name = AttName, + parents = [{Name, Pos}|Parents], pos = AttrPos, language = Lang, - namespace = NamespaceInfo, + nsinfo = NamespaceInfo, value = AttValue, normalized = IsNorm}, XMLBase=if @@ -2110,6 +2177,14 @@ scan_element(T, S, Pos, Name, StartL, StartC, Attrs, Lang, Parents, scan_element(T4, S5, Pos, Name, StartL, StartC, [Attr|Attrs], Lang, Parents, NSI, NewNS, SpaceDefault). +get_default_attrs(S = #xmerl_scanner{rules_read_fun = Read}, ElemName) -> + case Read(elem_def, ElemName, S) of + #xmlElement{attributes = Attrs} -> + [ {AttName, AttValue} || + {AttName, _, AttValue, _, _} <- Attrs, AttValue =/= no_value ]; + _ -> [] + end. + get_att_type(S=#xmerl_scanner{rules_read_fun=Read},AttName,ElemName) -> case Read(elem_def,ElemName,S) of #xmlElement{attributes = Attrs} -> @@ -2139,6 +2214,23 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook, Pos, Name, Attrs, Lang, Parents, NSI, Namespace) -> Language = check_language(Attrs, Lang), + AllAttrs = + case S#xmerl_scanner.default_attrs of + true -> + [ #xmlAttribute{name = AttName, + parents = [{Name, Pos} | Parents], + language = Lang, + nsinfo = NSI, + namespace = Namespace, + value = AttValue, + normalized = true} || + {AttName, AttValue} <- get_default_attrs(S, Name), + AttValue =/= no_value, + not lists:keymember(AttName, #xmlAttribute.name, Attrs) ]; + false -> + Attrs + end, + {ExpName, ExpAttrs} = case S#xmerl_scanner.namespace_conformant of true -> @@ -2153,14 +2245,15 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook, TempNamespace = Namespace#xmlNamespace{default = []}, ExpAttrsX = [A#xmlAttribute{ + namespace=Namespace, expanded_name=expanded_name( A#xmlAttribute.name, - A#xmlAttribute.namespace, + A#xmlAttribute.nsinfo, % NSI, - TempNamespace, S)} || A <- Attrs], + TempNamespace, S)} || A <- AllAttrs], {expanded_name(Name, NSI, Namespace, S), ExpAttrsX}; false -> - {Name, Attrs} + {Name, AllAttrs} end, #xmlElement{name = Name, @@ -2194,10 +2287,32 @@ check_namespace(_, _, _, NS) -> expanded_name(Name, [], #xmlNamespace{default = []}, _S) -> Name; -expanded_name(Name, [], #xmlNamespace{default = URI}, _S) -> - {URI, Name}; -expanded_name(_Name, {"xmlns", Local}, _NS, _S) -> % CHECK THIS /JB - {"xmlns",Local}; +expanded_name(Name, [], #xmlNamespace{default = URI}, S) -> + case URI of + 'http://www.w3.org/XML/1998/namespace' -> + ?fatal(cannot_bind_default_namespace_to_xml_namespace_name, S); + 'http://www.w3.org/2000/xmlns/' -> + ?fatal(cannot_bind_default_namespace_to_xmlns_namespace_name, S); + _ -> + {URI, Name} + end; +expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) -> + {_, Value} = lists:keyfind(Local, 1, Ns), + case Name of + 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' -> + ?fatal({xml_prefix_cannot_be_redeclared, Value}, S); + 'xmlns:xmlns' -> + ?fatal({xmlns_prefix_cannot_be_declared, Value}, S); + _ -> + case Value of + 'http://www.w3.org/XML/1998/namespace' -> + ?fatal({cannot_bind_prefix_to_xml_namespace, Local}, S); + 'http://www.w3.org/2000/xmlns/' -> + ?fatal({cannot_bind_prefix_to_xmlns_namespace, Local}, S); + _ -> + N + end + end; expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) -> case lists:keysearch(Prefix, 1, Ns) of {value, {_, URI}} -> @@ -2449,9 +2564,23 @@ scan_content("&" ++ T, S0, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) - _ -> scan_content(string_to_char_set(S1#xmerl_scanner.encoding,ExpRef)++T1,S1,Pos,Name,Attrs,Space,Lang,Parents,NS,Acc,[]) end; -scan_content("<!--" ++ T, S, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) -> - {_, T1, S1} = scan_comment(T, S, Pos, Parents, Lang), - scan_content(T1, S1, Pos+1, Name, Attrs, Space, Lang, Parents, NS, Acc,[]); +scan_content("<!--" ++ T, S0=#xmerl_scanner{acc_fun = F, comments=CF}, Pos, Name, Attrs, Space, + Lang, Parents, NS, Acc,[]) -> + ?bump_col(4), + {C, T1, S1} = scan_comment(T, S, Pos, Parents, Lang), + case CF of + true -> + {Acc2, Pos2, S3} = + case F(C, Acc, S1) of + {Acc1, S2} -> + {Acc1, Pos + 1, S2}; + {Acc1, Pos1, S2} -> + {Acc1, Pos1, S2} + end, + scan_content(T1, S3, Pos2, Name, Attrs, Space, Lang, Parents, NS, Acc2,[]); + false -> + scan_content(T1, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) + end; scan_content("<" ++ T, S0, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) -> ?bump_col(1), {Markup, T1, S1} = @@ -2508,9 +2637,9 @@ scan_content_markup("![CDATA[" ++ T, S0, Pos, _Name, _Attrs, _Space, _Lang, Parents, _NS) -> ?bump_col(8), scan_cdata(T, S, Pos, Parents); -scan_content_markup("?"++T,S0,Pos,_Name,_Attrs,_Space,_Lang,_Parents,_NS) -> +scan_content_markup("?"++T,S0,Pos,_Name,_Attrs,_Space,_Lang,Parents,_NS) -> ?bump_col(1), - scan_pi(T, S, Pos); + scan_pi(T, S, Pos, Parents); scan_content_markup(T, S, Pos, _Name, _Attrs, Space, Lang, Parents, NS) -> scan_element(T, S, Pos, Space, Lang, Parents, NS). @@ -3259,12 +3388,18 @@ mandatory_delimeter_wfc(T,S) -> wfc_unique_att_spec([],_S) -> ok; -wfc_unique_att_spec([#xmlAttribute{name=N}|Atts],S) -> +wfc_unique_att_spec([#xmlAttribute{name=N,expanded_name=EN}|Atts],S) -> case lists:keymember(N,#xmlAttribute.name,Atts) of true -> ?fatal({error,{unique_att_spec_required,N}},S); _ -> - wfc_unique_att_spec(Atts,S) + case S#xmerl_scanner.namespace_conformant andalso + lists:keymember(EN, #xmlAttribute.expanded_name, Atts) of + true -> + ?fatal({error,{unique_att_spec_required,EN}},S); + _ -> + wfc_unique_att_spec(Atts,S) + end end. wfc_legal_char(Chars,S) when is_list(Chars)-> @@ -3313,6 +3448,11 @@ wfc_Internal_parsed_entity(internal,Value,S) -> wfc_Internal_parsed_entity(_,_,_) -> ok. +vc_Element_valid(_Name, {"xmlns", _}, + S = #xmerl_scanner{namespace_conformant = true}) -> + ?fatal({error,{illegal_element_prefix,xmlns}},S); +vc_Element_valid(Name, _, S) -> + vc_Element_valid(Name, S). vc_Element_valid(_Name,#xmerl_scanner{environment=internal_parsed_entity}) -> ok; @@ -3917,7 +4057,7 @@ schemaLocations(El,#xmerl_scanner{schemaLocation=SL}) -> schemaLocations(#xmlElement{attributes=Atts,xmlbase=_Base}) -> Pred = fun(#xmlAttribute{name=schemaLocation}) -> false; - (#xmlAttribute{namespace={_,"schemaLocation"}}) -> false; + (#xmlAttribute{nsinfo={_,"schemaLocation"}}) -> false; (_) -> true end, case lists:dropwhile(Pred,Atts) of diff --git a/lib/xmerl/src/xmerl_validate.erl b/lib/xmerl/src/xmerl_validate.erl index 893e23ca34..4028fef2b9 100644 --- a/lib/xmerl/src/xmerl_validate.erl +++ b/lib/xmerl/src/xmerl_validate.erl @@ -399,25 +399,28 @@ test_attribute_value(_Rule,Attr,_,_) -> %% +type valid_contents([rule()],[xmlElement()])-> %% [xmlElement() | {error,???}. -valid_contents(Rule,XMLS,Rules,S,WSActionMode)-> - case parse(Rule,XMLS,Rules,WSActionMode,S) of - {XML_N,[]}-> - lists:flatten(XML_N); - {_,[#xmlElement{name=Name}|_T]} -> - exit({error,{element,Name,isnt_comprise_in_the_rule,Rule}}); - {_,[#xmlText{}=Txt|_T]} -> - exit({error,{element,text,Txt,isnt_comprise_in_the_rule,Rule}}); - {error,Reason} -> - {error,Reason}; - {error,Reason,N} -> - {error,Reason,N} +valid_contents(Rule, XMLS, Rules, S, WSActionMode)-> + case parse(Rule, XMLS, Rules, WSActionMode, S) of + {error, Reason} -> + {error, Reason}; + {error, Reason, N} -> + {error, Reason, N}; + {XML_N, Rest} -> %The list may consist of xmlComment{} records + case lists:dropwhile(fun(X) when is_record(X, xmlComment) -> true; (_) -> false end, Rest) of + [] -> + lists:flatten(XML_N); + [#xmlElement{name=Name} |_T] -> + exit({error, {element, Name, isnt_comprise_in_the_rule, Rule}}); + [#xmlText{} = Txt |_T] -> + exit({error, {element, text, Txt, isnt_comprise_in_the_rule, Rule}}) + end end. -parse({'*',SubRule},XMLS,Rules,WSaction,S)-> - star(SubRule,XMLS,Rules,WSaction,[],S); -parse({'+',SubRule},XMLS,Rules,WSaction,S) -> - plus(SubRule,XMLS,Rules,WSaction,S); -parse({choice,CHOICE},XMLS,Rules,WSaction,S)-> +parse({'*', SubRule}, XMLS, Rules, WSaction, S)-> + star(SubRule, XMLS, Rules, WSaction, [], S); +parse({'+',SubRule}, XMLS, Rules, WSaction, S) -> + plus(SubRule, XMLS, Rules, WSaction, S); +parse({choice,CHOICE}, XMLS, Rules, WSaction, S)-> % case XMLS of % [] -> % io:format("~p~n",[{choice,CHOICE,[]}]); @@ -426,47 +429,49 @@ parse({choice,CHOICE},XMLS,Rules,WSaction,S)-> % [#xmlText{value=V}|_] -> % io:format("~p~n",[{choice,CHOICE,{text,V}}]) % end, - choice(CHOICE,XMLS,Rules,WSaction,S); -parse(empty,[],_Rules,_WSaction,_S) -> - {[],[]}; -parse({'?',SubRule},XMLS,Rules,_WSaction,S)-> - question(SubRule,XMLS,Rules,S); -parse({seq,List},XMLS,Rules,WSaction,S) -> - seq(List,XMLS,Rules,WSaction,S); -parse(El_Name,[#xmlElement{name=El_Name}=XML|T],Rules,_WSaction,S) + choice(CHOICE, XMLS, Rules, WSaction, S); +parse(empty, [], _Rules, _WSaction, _S) -> + {[], []}; +parse({'?', SubRule}, XMLS, Rules, _WSaction, S)-> + question(SubRule, XMLS, Rules, S); +parse({seq,List}, XMLS, Rules, WSaction, S) -> + seq(List, XMLS, Rules, WSaction, S); +parse(El_Name, [#xmlElement{name=El_Name} = XML |T], Rules, _WSaction, S) when is_atom(El_Name)-> - case do_validation(read_rules(Rules,El_Name),XML,Rules,S) of - {error,R} -> + case do_validation(read_rules(Rules, El_Name), XML, Rules, S) of + {error, R} -> % {error,R}; exit(R); - {error,R,_N}-> + {error, R, _N}-> % {error,R,N}; exit(R); XML_-> - {[XML_],T} + {[XML_], T} end; -parse(any,Cont,Rules,_WSaction,S) -> - case catch parse_any(Cont,Rules,S) of - Err = {error,_} -> Err; - ValidContents -> {ValidContents,[]} +parse(any, Cont, Rules, _WSaction, S) -> + case catch parse_any(Cont, Rules, S) of + Err = {error, _} -> Err; + ValidContents -> {ValidContents, []} end; -parse(El_Name,[#xmlElement{name=Name}|_T]=S,_Rules,_WSa,_S) when is_atom(El_Name)-> +parse(El_Name, [#xmlElement{name=Name} |_T] = XMLS, _Rules, _WSa, _S) when is_atom(El_Name) -> {error, - {element_seq_not_conform,{wait,El_Name},{is,Name}}, - {{next,S},{act,[]}} }; -parse(_El_Name,[#xmlPI{}=H|T],_Rules,_WSa,_S) -> - {[H],T}; -parse('#PCDATA',XML,_Rules,_WSa,_S)-> + {element_seq_not_conform,{wait, El_Name}, {is, Name}}, + {{next, XMLS}, {act, []}}}; +parse(El_Name, [#xmlComment{} |T], Rules, WSa, S) -> + parse(El_Name, T, Rules, WSa, S); +parse(_El_Name, [#xmlPI{} = H |T], _Rules, _WSa, _S) -> + {[H], T}; +parse('#PCDATA', XMLS, _Rules, _WSa, _S)-> %%% PCDATA it is 0 , 1 or more #xmlText{}. - parse_pcdata(XML); -parse(El_Name,[#xmlText{}|_T]=S,_Rules,_WSa,_S)-> + parse_pcdata(XMLS); +parse(El_Name, [#xmlText{}|_T] = XMLS, _Rules, _WSa, _S)-> {error, - {text_in_place_of,El_Name}, - {{next,S},{act,[]}}}; -parse([],_,_,_,_) -> - {error,no_rule}; -parse(Rule,[],_,_,_) -> - {error,{no_xml_element,Rule}}. + {text_in_place_of, El_Name}, + {{next, XMLS}, {act, []}}}; +parse([], _, _, _, _) -> + {error, no_rule}; +parse(Rule, [], _, _, _) -> + {error, {no_xml_element, Rule}}. parse_any([],_Rules,_S) -> []; @@ -618,11 +623,15 @@ el_name(#xmlElement{name=Name})-> parse_pcdata([#xmlText{}=H|T])-> parse_pcdata(T,[H]); +parse_pcdata([#xmlComment{}|T])-> + parse_pcdata(T,[]); parse_pcdata(H) -> {[],H}. parse_pcdata([#xmlText{}=H|T],Acc)-> parse_pcdata(T,Acc++[H]); +parse_pcdata([#xmlComment{}|T],Acc)-> + parse_pcdata(T,Acc); parse_pcdata(H,Acc) -> {Acc,H}. diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index db3d3ac2d6..b3301f2faf 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -41,18 +41,13 @@ % xmerl_xpath_parse:parse(xmerl_xpath_scan:tokens("parent::processing-instruction('foo')")). %% </pre> %% -%% @type docEntity() = +%% @type nodeEntity() = %% xmlElement() %% | xmlAttribute() %% | xmlText() %% | xmlPI() %% | xmlComment() -%% @type nodeEntity() = -%% xmlElement() -%% | xmlAttribute() -%% | xmlText() -%% | xmlPI() -%% | xmlNamespace() +%% | xmlNsNode() %% | xmlDocument() %% @type option_list(). <p>Options allows to customize the behaviour of the %% XPath scanner. @@ -303,6 +298,17 @@ write_node(#xmlNode{pos = Pos, node = #xmlText{value = Txt, parents = Ps}}) -> {text, Pos, Txt, Ps}; +write_node(#xmlNode{pos = Pos, + node = #xmlComment{parents = Ps}}) -> + {comment, Pos, '', Ps}; +write_node(#xmlNode{pos = Pos, + node = #xmlPI{name = Name, + parents = Ps}}) -> + {processing_instruction, Pos, Name, Ps}; +write_node(#xmlNode{pos = Pos, + node = #xmlNsNode{parents = Ps, + prefix = Prefix}}) -> + {namespace, Pos, Prefix, Ps}; write_node(_) -> other. @@ -330,18 +336,16 @@ eval_path(rel, PathExpr, C = #xmlContext{}) -> Context = C#xmlContext{nodeset = NodeSet}, S = #state{context = Context}, path_expr(PathExpr, S); -eval_path(filter, {PathExpr, PredExpr}, C = #xmlContext{}) -> +eval_path(filter, {PathExpr, {pred, Pred}}, C = #xmlContext{}) -> S = #state{context = C}, - S1 = path_expr(PathExpr, S), - pred_expr(PredExpr, S1). + S1 = match_expr(PathExpr, S), + eval_pred(Pred, S1). -eval_primary_expr(FC = {function_call,_,_},S = #state{context = Context}) -> +eval_primary_expr(PrimExpr, S = #state{context = Context}) -> %% NewNodeSet = xmerl_xpath_pred:eval(FC, Context), - NewNodeSet = xmerl_xpath_lib:eval(primary_expr, FC, Context), + NewNodeSet = xmerl_xpath_lib:eval(primary_expr, PrimExpr, Context), NewContext = Context#xmlContext{nodeset = NewNodeSet}, - S#state{context = NewContext}; -eval_primary_expr(PrimExpr,_S) -> - exit({primary_expression,{not_implemented, PrimExpr}}). + S#state{context = NewContext}. %% axis(Axis,NodeTest,Context::xmlContext()) -> xmlContext() @@ -384,8 +388,8 @@ axis1(preceding, Tok, N, Acc, Context) -> match_preceding(Tok, N, Acc, Context); axis1(attribute, Tok, N, Acc, Context) -> match_attribute(Tok, N, Acc, Context); -%axis1(namespace, Tok, N, Acc, Context) -> -% match_namespace(Tok, N, Acc, Context); +axis1(namespace, Tok, N, Acc, Context) -> + match_namespace(Tok, N, Acc, Context); axis1(ancestor_or_self, Tok, N, Acc, Context) -> match_ancestor_or_self(Tok, N, Acc, Context); axis1(descendant_or_self, Tok, N, Acc, Context) -> @@ -627,14 +631,58 @@ node_type(#xmlAttribute{}) -> attribute; node_type(#xmlElement{}) -> element; node_type(#xmlText{}) -> text; node_type(#xmlPI{}) -> processing_instruction; -node_type(#xmlNamespace{}) -> namespace; +node_type(#xmlNsNode{}) -> namespace; +node_type(#xmlComment{}) -> comment; node_type(#xmlDocument{}) -> root_node. %% "The namespace axis contains the namespace nodes of the context node; %% the axis will be empty unless the context node is an element." -%match_namespace(_Tok, _N, _Acc, _Context) -> - %% TODO: IMPLEMENT NAMESPACE AXIS -% erlang:fault(not_yet_implemented). +match_namespace(Tok, N, Acc, Context) -> + case N#xmlNode.type of + element -> + #xmlNode{parents = Ps, node = E} = N, + #xmlElement{name = Name, + namespace = NS, + parents = EPs, + pos = Pos} = E, + #xmlNamespace{default = Default, nodes = NSPairs} = NS, + ThisEPs = [{Name, Pos}|EPs], + ThisPs = [N|Ps], + Acc0 = + case Default of + D when D =:= []; D =:= '' -> + {[], 1}; + URI -> + DefaultNSNode = #xmlNsNode{parents = ThisEPs, + pos = 1, + prefix = [], + uri = URI}, + Node = #xmlNode{type = namespace, + node = DefaultNSNode, + parents = ThisPs}, + {[Node], 2} + end, + {Nodes, _I} = + lists:foldr( + fun ({Prefix, URI}, {AccX, I}) -> + NSNode = #xmlNsNode{parents = ThisEPs, + pos = I, + prefix = Prefix, + uri = URI}, + ThisN = #xmlNode{pos = I, + type = namespace, + node = NSNode, + parents = ThisPs}, + {[ThisN | AccX], I + 1} + end, Acc0, NSPairs), + lists:foldr( + fun (ThisN, AccX) -> + match_self(Tok, ThisN, AccX, Context) + end, Acc, Nodes); + _Other -> + %%[] + Acc + end. update_nodeset(Context = #xmlContext{axis_type = AxisType}, NodeSet) -> @@ -655,8 +703,15 @@ update_nodeset(Context = #xmlContext{axis_type = AxisType}, NodeSet) -> node_test(F, N, Context) when is_function(F) -> F(N, Context); +node_test(_Test, #xmlNode{type=attribute,node=#xmlAttribute{name=xmlns}}, + _Context) -> + false; +node_test(_Test, + #xmlNode{type=attribute,node=#xmlAttribute{nsinfo={"xmlns",_Local}}}, + _Context) -> + false; node_test({wildcard, _}, #xmlNode{type=ElAt}, _Context) - when ElAt==element; ElAt==attribute -> + when ElAt==element; ElAt==attribute; ElAt==namespace -> true; node_test({prefix_test, Prefix}, #xmlNode{node = N}, _Context) -> case N of @@ -720,6 +775,9 @@ node_test({name, {_Tag, Prefix, Local}}, [{_Tag, Prefix, Local}, write_node(NSNodes)]), false end; +node_test({name, {_Tag, [], Local}}, + #xmlNode{node = #xmlNsNode{prefix = Local}}, _Context) -> + true; node_test({node_type, NT}, #xmlNode{node = N}, _Context) -> case {NT, N} of {text, #xmlText{}} -> @@ -728,14 +786,18 @@ node_test({node_type, NT}, #xmlNode{node = N}, _Context) -> true; {attribute, #xmlAttribute{}} -> true; - {namespace, #xmlNamespace{}} -> + {namespace, #xmlNsNode{}} -> + true; + {comment, #xmlComment{}} -> + true; + {processing_instruction, #xmlPI{}} -> true; _ -> false end; -node_test({processing_instruction, {literal, _, Name}}, - #xmlNode{node = {processing_instruction, Name, _Data}}, _Context) -> - true; +node_test({processing_instruction, Name1}, + #xmlNode{node = #xmlPI{name = Name2}}, _Context) -> + Name1 == atom_to_list(Name2); node_test(_Other, _N, _Context) -> %io:format("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]), false. diff --git a/lib/xmerl/src/xmerl_xpath_lib.erl b/lib/xmerl/src/xmerl_xpath_lib.erl index cfd0e36667..096f54ec30 100644 --- a/lib/xmerl/src/xmerl_xpath_lib.erl +++ b/lib/xmerl/src/xmerl_xpath_lib.erl @@ -49,5 +49,7 @@ primary_expr({function_call, F, Args}, C) -> %% here, we should look up the function in the context provided %% by the caller, but we haven't figured this out yet. exit({not_a_core_function, F}) - end. + end; +primary_expr(PrimExpr, _C) -> + exit({primary_expression, {not_implemented, PrimExpr}}). diff --git a/lib/xmerl/src/xmerl_xpath_parse.yrl b/lib/xmerl/src/xmerl_xpath_parse.yrl index 37576b9e61..f60cea0a2e 100644 --- a/lib/xmerl/src/xmerl_xpath_parse.yrl +++ b/lib/xmerl/src/xmerl_xpath_parse.yrl @@ -144,6 +144,7 @@ Expect 2. %% [7] 'NodeTest' -> 'NameTest' : '$1' . 'NodeTest' -> 'node_type' '(' ')' : {node_type, value('$1')} . +'NodeTest' -> 'processing-instruction' '(' ')' : {node_type, value('$1')} . 'NodeTest' -> 'processing-instruction' '(' 'literal' ')' : {processing_instruction, value('$3')} . diff --git a/lib/xmerl/src/xmerl_xpath_pred.erl b/lib/xmerl/src/xmerl_xpath_pred.erl index 451a09bee3..855b8599fe 100644 --- a/lib/xmerl/src/xmerl_xpath_pred.erl +++ b/lib/xmerl/src/xmerl_xpath_pred.erl @@ -337,6 +337,9 @@ local_name1([#xmlNode{type=element,node=El}|_]) -> local_name1([#xmlNode{type=attribute,node=Att}|_]) -> #xmlAttribute{name=Name,nsinfo=NSI} = Att, local_name2(Name,NSI); +local_name1([#xmlNode{type=namespace,node=N}|_]) -> + #xmlNsNode{prefix=Prefix} = N, + ?string(Prefix); local_name1([#xmlElement{name = Name, nsinfo = NSI}|_]) -> local_name2(Name,NSI). local_name2(Name, NSI) -> @@ -431,6 +434,9 @@ string_value(N=#xmlObj{}) -> string_value(A=#xmlNode{type=attribute}) -> #xmlAttribute{value=AttVal}=A#xmlNode.node, ?string(AttVal); +string_value(N=#xmlNode{type=namespace}) -> + #xmlNsNode{uri=URI}=N#xmlNode.node, + ?string(atom_to_list(URI)); string_value(El=#xmlNode{type=element}) -> #xmlElement{content=C} = El#xmlNode.node, TextValue = fun(#xmlText{value=T},_Fun) -> T; @@ -442,6 +448,9 @@ string_value(El=#xmlNode{type=element}) -> string_value(T=#xmlNode{type=text}) -> #xmlText{value=Txt} = T#xmlNode.node, ?string(Txt); +string_value(T=#xmlNode{type=comment}) -> + #xmlComment{value=Txt} = T#xmlNode.node, + ?string(Txt); string_value(infinity) -> ?string("Infinity"); string_value(neg_infinity) -> ?string("-Infinity"); string_value(A) when is_atom(A) -> diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl index dfdc6138ef..ed0890f0d0 100644 --- a/lib/xmerl/src/xmerl_xsd.erl +++ b/lib/xmerl/src/xmerl_xsd.erl @@ -245,21 +245,27 @@ process_validate2({SE,_},Schema,Xml,Opts) -> S4 = validation_options(S3,Opts), validate3(Schema,Xml,S4). -validate3(Schema,Xml,S=#xsd_state{errors=[]}) -> - Ret = {_,S2} = - case catch validate_xml(Xml,S) of - {[XML2],[],Sx} -> - {XML2,Sx}; - {XML2,[],Sx} -> - {XML2,Sx}; - {_,UnValidated,Sx} -> - {Xml,acc_errs(Sx,{error_path(UnValidated,Xml#xmlElement.name),?MODULE, - {unvalidated_rest,UnValidated}})}; - _Err = {error,Reason} -> - {Xml,acc_errs(S,Reason)}; - {'EXIT',Reason} -> - {Xml,acc_errs(S,{error_path(Xml,Xml#xmlElement.name),?MODULE, - {undefined,{internal_error,Reason}}})} +validate3(Schema, Xml,S =#xsd_state{errors=[]}) -> + Ret = {_, S2} = + case catch validate_xml(Xml, S) of + _Err = {error, Reason} -> + {Xml, acc_errs(S, Reason)}; + {'EXIT', Reason} -> + {Xml, acc_errs(S, {error_path(Xml, Xml#xmlElement.name), ?MODULE, + {undefined, {internal_error, Reason}}})}; + {XML2, Rest, Sx} -> + case lists:dropwhile(fun(X) when is_record(X, xmlComment) -> true; (_) -> false end, Rest) of + [] -> + case XML2 of + [XML3] -> + {XML3,Sx}; + XML3 -> + {XML3,Sx} + end; + UnValidated -> + {Xml,acc_errs(Sx,{error_path(UnValidated,Xml#xmlElement.name),?MODULE, + {unvalidated_rest,UnValidated}})} + end end, save_to_file(S2,filename:rootname(Schema)++".tab2"), case S2#xsd_state.errors of @@ -1950,7 +1956,7 @@ fetch_external_schema(Path,S) when is_list(Path) -> {EXSD,S#xsd_state{schema_name=File}} end; {_,{string,String},_} -> %% this is for a user defined fetch fun that returns an xml document on string format. - ?debug("scanning string: ~p~n",[File]), + ?debug("scanning string: ~p~n",[String]), case xmerl_scan:string(String,S#xsd_state.xml_options) of {error,Reason} -> {error,acc_errs(S,{[],?MODULE,{parsing_external_schema_failed,Path,Reason}})}; @@ -2520,9 +2526,9 @@ check_element_type([],#schema_complex_type{name=_Name,block=_Bl,content=C}, {error,{error_path(Checked,undefined),?MODULE, {empty_content_not_allowed,C}}} end; -check_element_type(C,{anyType,_},_Env,_Block,S,_Checked) -> +check_element_type(C, {anyType, _}, _Env, _Block, S, _Checked) -> %% permitt anything - {C,[],S}; + {lists:reverse(C), [], S}; check_element_type(XML=[#xmlText{}|_],Type=#schema_simple_type{}, _Env,_Block,S,_Checked) -> @@ -2585,7 +2591,7 @@ check_element_type(XML=[XMLEl=#xmlElement{name=Name}|RestXML], S6 = check_form(ElName,Name,XMLEl, actual_form_value(CMEl#schema_element.form, S5#xsd_state.elementFormDefault), - S5), + S5), %Step into content of XML element. {Content,_,S7} = case @@ -2605,12 +2611,12 @@ check_element_type(XML=[XMLEl=#xmlElement{name=Name}|RestXML], RestXML, set_scope(S5#xsd_state.scope,set_num_el(S7,S6))}; true -> - {error,{error_path(XMLEl,Name),?MODULE, - {element_not_suitable_with_schema,ElName,S}}}; + {error,{error_path(XMLEl, Name), ?MODULE, + {element_not_suitable_with_schema, ElName, S}}}; _ when S#xsd_state.num_el >= Min -> %% it may be a match error or an optional element not %% present - {[],XML,S#xsd_state{num_el=0}}; + {[], XML, S#xsd_state{num_el=0}}; _ -> {error,{error_path(XMLEl,Name),?MODULE, {element_not_suitable_with_schema,ElName,CMName,CMEl,S}}} @@ -2645,7 +2651,7 @@ check_element_type(XML=[#xmlElement{}|_Rest], check_element_type(XML=[E=#xmlElement{name=Name}|Rest], Any={any,{Namespace,_Occ={Min,_},ProcessorContents}},Env, _Block,S,_Checked) -> - ?debug("check any: {any,{~p,~p,~p}}~n",[Namespace,Occ,ProcessorContents]), + ?debug("check any: {any,{~p,~p,~p}}~n",[Namespace,_Occ,ProcessorContents]), %% ProcessorContents any of lax | strict | skip %% lax: may validate if schema is found %% strict: must validate @@ -2710,8 +2716,11 @@ check_element_type([],CM,_Env,_Block,S,Checked) -> {error,{error_path(Checked,undefined),?MODULE, {empty_content_not_allowed,CM}}} end; +check_element_type([C = #xmlComment{} |Rest],CM,Env,Block,S,Checked) -> + check_element_type(Rest,CM,Env,Block,S,[C |Checked]); check_element_type(XML,CM,_Env,_Block,S,_Checked) -> {error,{error_path(XML,undefined),?MODULE,{match_failure,XML,CM,S}}}. + %% single xml content object and single schema object check_text_type(XML=[#xmlText{}|_],optional_text,S) -> % {XMLTxt,optional_text}; @@ -2730,7 +2739,7 @@ check_text_type([XMLTxt=#xmlText{}|_],CMEl,_S) -> {cannot_contain_text,XMLTxt,CMEl}}}. split_xmlText(XML) -> - splitwith(fun(#xmlText{}) -> true;(_) -> false end,XML). + splitwith(fun(#xmlText{}) -> true;(#xmlComment{}) -> true;(_) -> false end,XML). %% Sequence check_sequence([T=#xmlText{}|Rest],Els,Occ,Env,S,Checked) -> @@ -2773,6 +2782,8 @@ check_sequence(Seq=[_InstEl=#xmlElement{}|_],[El|Els],Occ={_Min,_Max},Env,S,Chec count_num_el(set_num_el(S3,S2)), Ret++Checked) end; +check_sequence([C = #xmlComment{} |Rest], Els, Occ, Env, S, Checked) -> + check_sequence(Rest,Els,Occ,Env,S,[C |Checked]); check_sequence(Rest,[],_Occ,_Env,S,Checked) -> {Checked,Rest,set_num_el(S,0)}; check_sequence([],Els,_Occ,_Env,S,Checked) -> @@ -2869,6 +2880,8 @@ check_all(XML=[E=#xmlElement{name=Name}|RestXML],CM,Occ,Env,S, {element_not_in_all,ElName,E,CM}}, check_all(RestXML,CM,Occ,Env,acc_errs(S,Err),[E|Checked],PrevXML) end; +check_all([C=#xmlComment{} |RestXML], CM, Occ, Env, S, Checked, XML) -> + check_all(RestXML, CM, Occ, Env, S, [C |Checked], XML); check_all(XML,[],_,_,S,Checked,_) -> {Checked,XML,S}; check_all([],CM,_Occ,_,S,Checked,_PrevXML) -> @@ -2920,7 +2933,7 @@ check_target_namespace(XMLEl,S) -> schemaLocations(El=#xmlElement{attributes=Atts},S) -> Pred = fun(#xmlAttribute{name=schemaLocation}) -> false; - (#xmlAttribute{namespace={_,"schemaLocation"}}) -> false; + (#xmlAttribute{nsinfo={_,"schemaLocation"}}) -> false; (_) -> true end, case lists:dropwhile(Pred,Atts) of diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index 94c38d4d48..55b6d1844c 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -58,7 +58,7 @@ groups() -> {ticket_tests, [], [ticket_5998, ticket_7211, ticket_7214, ticket_7430, ticket_6873, ticket_7496, ticket_8156, ticket_8697, - ticket_9411, ticket_9457]}, + ticket_9411, ticket_9457, ticket_9664_schema, ticket_9664_dtd]}, {app_test, [], [{xmerl_app_test, all}]}, {appup_test, [], [{xmerl_appup_test, all}]}]. @@ -284,7 +284,7 @@ export(Config) -> ?line {E,_} = xmerl_scan:file(TestFile), ?line Exported = xmerl:export([E],xmerl_xml,[{prolog,Prolog}]), B = list_to_binary(Exported++"\n"), - ?line {ok,B} = file:read_file(TestFile), + ?line {ok, B} = file:read_file(TestFile), ok. %%---------------------------------------------------------------------- @@ -609,6 +609,38 @@ ticket_9457_cont(Continue, Exception, GlobalState) -> Exception(GlobalState) end. + +ticket_9664_schema(suite) -> []; +ticket_9664_schema(doc) -> + ["Test that comments are handled correct whith"]; +ticket_9664_schema(Config) -> + + ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc, + "ticket_9664_schema.xml"]),[]), + ?line {ok, S} = xmerl_xsd:process_schema(filename:join([?config(data_dir, Config), misc, + "motorcycles.xsd"])), + ?line {E1, _} = xmerl_xsd:validate(E, S), + + ?line {E1,_} = xmerl_xsd:process_validate(filename:join([?config(data_dir,Config), misc, + "motorcycles.xsd"]),E,[]), + + ?line {E1,_} = xmerl_scan:file(filename:join([?config(data_dir,Config), misc, + "ticket_9664_schema.xml"]), + [{schemaLocation, [{"mc", "motorcycles.xsd"}]}, + {validation, schema}]), + ok. + +ticket_9664_dtd(suite) -> []; +ticket_9664_dtd(doc) -> + ["Test that comments are handled correct whith"]; +ticket_9664_dtd(Config) -> + ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc, + "ticket_9664_dtd.xml"]),[]), + ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc, + "ticket_9664_dtd.xml"]),[{validation, true}]), + ok. + + %%====================================================================== %% Support Functions %%====================================================================== diff --git a/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz b/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz Binary files differindex fef7431845..ffc1d327a5 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz +++ b/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl index 850b7f8135..7b6f1e95b3 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl @@ -210,7 +210,7 @@ ticket_7496() -> ?line {Doc3,_} = xmerl_scan:file("documentRoot.xml"), ?line ok = Test(Doc3,"//child",[child,child,child]), ?line ok = Test(Doc3,"//child[@name='beta']",[child]), - ?line [{xmlAttribute,id,[],[],[],[],1,[],"2",false}] = + ?line [{xmlAttribute,id,[],[],[],_,1,[],"2",false}] = xmerl_xpath:string("/documentRoot/parent/child[@name='beta']/@id",Doc3), ?line ok = Test(Doc3,"/documentRoot/parent/child|/documentRoot/parent/pet", [child,child,child,pet,pet]), diff --git a/lib/xmerl/test/xmerl_xsd_SUITE_data/mim.xsd b/lib/xmerl/test/xmerl_xsd_SUITE_data/mim.xsd index 057344cde8..057344cde8 100755..100644 --- a/lib/xmerl/test/xmerl_xsd_SUITE_data/mim.xsd +++ b/lib/xmerl/test/xmerl_xsd_SUITE_data/mim.xsd diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index 82df8fdeef..de47e3418b 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.2.10 +XMERL_VSN = 1.3 diff --git a/lib/xmerl/xmerl.pub b/lib/xmerl/xmerl.pub index 29a81bbde2..29a81bbde2 100755..100644 --- a/lib/xmerl/xmerl.pub +++ b/lib/xmerl/xmerl.pub diff --git a/system/doc/reference_manual/code_loading.xml b/system/doc/reference_manual/code_loading.xml index f56e1ff408..3ea72a4057 100644 --- a/system/doc/reference_manual/code_loading.xml +++ b/system/doc/reference_manual/code_loading.xml @@ -112,8 +112,8 @@ loop() -> <c>code_switch</c> to it. The process then will make a fully qualified call to <c>m:loop()</c> and change to current code. Note that <c>m:loop/0</c> must be exported.</p> - <p>For code replacement of funs to work, the tuple syntax - <c>{Module,FunctionName}</c> must be used to represent the fun.</p> + <p>For code replacement of funs to work, the syntax + <c>fun Module:FunctionName/Arity</c> should be used.</p> </section> <section> diff --git a/system/doc/reference_manual/distributed.xml b/system/doc/reference_manual/distributed.xml index d0eac78404..bc55d14c90 100644 --- a/system/doc/reference_manual/distributed.xml +++ b/system/doc/reference_manual/distributed.xml @@ -176,11 +176,11 @@ dilbert@uab</pre> </row> <row> <cell align="left" valign="middle"><c>is_alive()</c></cell> - <cell align="left" valign="middle">Returns <c>true</c>if the runtime system is a node and can connect to other nodes, <c>false</c>otherwise.</cell> + <cell align="left" valign="middle">Returns <c>true</c> if the runtime system is a node and can connect to other nodes, <c>false</c> otherwise.</cell> </row> <row> <cell align="left" valign="middle"><c>monitor_node(Node, true|false)</c></cell> - <cell align="left" valign="middle">Monitor the status of <c>Node</c>. A message<c>{nodedown, Node}</c>is received if the connection to it is lost.</cell> + <cell align="left" valign="middle">Monitor the status of <c>Node</c>. A message<c>{nodedown, Node}</c> is received if the connection to it is lost.</cell> </row> <row> <cell align="left" valign="middle"><c>node()</c></cell> @@ -200,7 +200,7 @@ dilbert@uab</pre> </row> <row> <cell align="left" valign="middle"><c>set_cookie(Node, Cookie)</c></cell> - <cell align="left" valign="middle">Sets the magic cookie used when connecting to <c>Node</c>. If <c>Node</c>is the current node, <c>Cookie</c>will be used when connecting to all new nodes.</cell> + <cell align="left" valign="middle">Sets the magic cookie used when connecting to <c>Node</c>. If <c>Node</c> is the current node, <c>Cookie</c> will be used when connecting to all new nodes.</cell> </row> <row> <cell align="left" valign="middle"><c>spawn[_link|_opt](Node, Fun)</c></cell> diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index c24b1110a4..43d46d87cc 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -993,15 +993,19 @@ fun Module:Name/Arity</pre> <pre> fun (Arg1,...,ArgN) -> Name(Arg1,...,ArgN) end</pre> <p>In <c>Module:Name/Arity</c>, <c>Module</c> and <c>Name</c> are atoms - and <c>Arity</c> is an integer. + and <c>Arity</c> is an integer. Starting from the R15 release, + <c>Module</c>, <c>Name</c>, and <c>Arity</c> may also be variables. A fun defined in this way will refer to the function <c>Name</c> - with arity <c>Arity</c> in the <em>latest</em> version of module <c>Module</c>. + with arity <c>Arity</c> in the <em>latest</em> version of module + <c>Module</c>. A fun defined in this way will not be dependent on + the code for module in which it is defined. </p> <p>When applied to a number N of arguments, a tuple <c>{Module,FunctionName}</c> is interpreted as a fun, referring to the function <c>FunctionName</c> with arity N in the module <c>Module</c>. The function must be exported. - <em>This usage is deprecated.</em> + <em>This usage is deprecated.</em> Use <c>fun Module:Name/Arity</c> + instead. See <seealso marker="#calls">Function Calls</seealso> for an example.</p> <p>More examples can be found in <em>Programming Examples</em>.</p> </section> diff --git a/system/doc/reference_manual/macros.xml b/system/doc/reference_manual/macros.xml index 9dd5fc79bd..bfac7f8d79 100644 --- a/system/doc/reference_manual/macros.xml +++ b/system/doc/reference_manual/macros.xml @@ -234,7 +234,7 @@ or ?TESTCALL(you:function(2,1)).</code> <p>results in</p> <code type="none"> -io:format("Call ~s: ~w~n",["myfunction ( 1 , 2 )",m:myfunction(1,2)]), +io:format("Call ~s: ~w~n",["myfunction ( 1 , 2 )",myfunction(1,2)]), io:format("Call ~s: ~w~n",["you : function ( 2 , 1 )",you:function(2,1)]).</code> <p>That is, a trace output with both the function called and the resulting value.</p> diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index f08639f9a1..f08639f9a1 100755..100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml |
