diff options
476 files changed, 24540 insertions, 12752 deletions
diff --git a/Makefile.in b/Makefile.in index 6b5ce8c53f..b3ab11d29a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -316,6 +316,7 @@ endif # The steps to build a working system are: # * build an emulator # * setup the erl and erlc program in bootstrap/bin +# * optionally run pgo and build optimized emulator # * build additional compilers and copy them into bootstrap/lib # * use the bootstrap erl and erlc to build all the libs # @@ -396,7 +397,7 @@ else endif cd $(ERL_TOP)/erts && \ ERL_TOP=$(ERL_TOP) PATH=$(INST_PATH_PREFIX)"$${PATH}" \ - $(MAKE) BUILD_ALL=1 TESTROOT="$(RELEASE_ROOT)" release + $(MAKE) BUILD_ALL=1 PROFILE=$(PROFILE) TESTROOT="$(RELEASE_ROOT)" release ifeq ($(RELEASE_ROOT),) $(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(OTP_DEFAULT_RELEASE_PATH)/releases/@OTP_REL@" else @@ -438,10 +439,24 @@ BOOT_BINDIR=$(BOOTSTRAP_ROOT)/bootstrap/erts/bin BEAM_EVM=$(ERL_TOP)/bin/$(TARGET)/beam_evm BOOTSTRAP_COMPILER = $(BOOTSTRAP_TOP)/primary_compiler +# otp.mk is only used to figure out if we are doing PGO or not +include $(ERL_TOP)/make/$(TARGET)/otp.mk + .PHONY: emulator libs kernel stdlib compiler hipe syntax_tools preloaded -emulator: - $(make_verbose)cd erts && ERL_TOP=$(ERL_TOP) $(MAKE) NO_START_SCRIPTS=true $(TYPE) FLAVOR=$(FLAVOR) +ifeq ($(USE_PGO), true) +PROFILE=use +PROFILE_EMU_DEPS=emulator_profile_generate bootstrap_setup +emulator_profile_generate: + $(make_verbose)cd erts && ERL_TOP=$(ERL_TOP) $(MAKE) NO_START_SCRIPTS=true $(TYPE) FLAVOR=$(FLAVOR) PROFILE=generate +else +PROFILE= +PROFILE_EMU_DEPS= +endif + +emulator: $(PROFILE_EMU_DEPS) + $(make_verbose)cd erts && ERL_TOP=$(ERL_TOP) PATH=$(BOOT_PREFIX)"$${PATH}" \ + $(MAKE) NO_START_SCRIPTS=true $(TYPE) FLAVOR=$(FLAVOR) PROFILE=$(PROFILE) libs: ifeq ($(OTP_SMALL_BUILD),true) @@ -1007,7 +1022,7 @@ install-docs: install.emulator: cd erts && \ ERL_TOP=$(ERL_TOP) PATH=$(INST_PATH_PREFIX)"$${PATH}" \ - $(MAKE) TESTROOT="$(ERLANG_LIBDIR)" release + $(MAKE) PROFILE=$(PROFILE) TESTROOT="$(ERLANG_LIBDIR)" release install.libs: ifeq ($(OTP_SMALL_BUILD),true) diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 486df05381..0fa43faa1f 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex 486df05381..0fa43faa1f 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 28eaae1003..936e6886a6 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_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex b6c47725c6..0985c13769 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 effaf97032..46e7e4c530 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_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex 3e967d5466..132b756895 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 7b66277f10..6840f1e750 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_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam Binary files differindex a26cb84590..2bb2df33a3 100644 --- a/bootstrap/lib/compiler/ebin/beam_peep.beam +++ b/bootstrap/lib/compiler/ebin/beam_peep.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex 1aa648532b..5338e9079f 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 7e208c5ef8..d0e6da02a8 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 41d634ffaa..0f44d8e4d7 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 16fec0c12e..0e97168da7 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam Binary files differindex 3e01775a86..71db427c29 100644 --- a/bootstrap/lib/compiler/ebin/beam_z.beam +++ b/bootstrap/lib/compiler/ebin/beam_z.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex c92a7c3194..a92341690d 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index 3482c44d09..b2ca1a8cad 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -19,7 +19,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "7.1"}, + {vsn, "7.1.1"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 46d858ee26..277b35faa8 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"7.1", +{"7.1.1", [{<<".*">>,[{restart_application, compiler}]}], [{<<".*">>,[{restart_application, compiler}]}] }. diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex f7fb759eb0..9c5dee5418 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_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam Binary files differindex cacdac171a..e9f74a1d1c 100644 --- a/bootstrap/lib/compiler/ebin/core_scan.beam +++ b/bootstrap/lib/compiler/ebin/core_scan.beam diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex 6e3aad89df..060c6571af 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam Binary files differindex 792fdeafc5..17cc7fec75 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_bsm.beam b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam Binary files differindex f343655448..d5e06493c5 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex f4c62e9100..dfedc09f49 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/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 842c9904c8..c6c1593790 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex a63afcd2e0..05ecd20859 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 5db577a930..2f480b5e37 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex d29d1545fb..536da5c692 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 f315601583..4dc0ef29f2 100644 --- a/bootstrap/lib/kernel/ebin/disk_log.beam +++ b/bootstrap/lib/kernel/ebin/disk_log.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam Binary files differindex 8c4dff2c02..420a4e818b 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_1.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_1.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam Binary files differindex 9adde8e499..96bad0104e 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 07cea2b6c9..bcc27081b2 100644 --- a/bootstrap/lib/kernel/ebin/dist_ac.beam +++ b/bootstrap/lib/kernel/ebin/dist_ac.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 6376d791cf..fd4e4fb5de 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/erl_ddll.beam b/bootstrap/lib/kernel/ebin/erl_ddll.beam Binary files differindex 20ab0989a0..940a74c1c3 100644 --- a/bootstrap/lib/kernel/ebin/erl_ddll.beam +++ b/bootstrap/lib/kernel/ebin/erl_ddll.beam diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam Binary files differindex ea0cf3bfe9..4129e6af6e 100644 --- a/bootstrap/lib/kernel/ebin/error_logger.beam +++ b/bootstrap/lib/kernel/ebin/error_logger.beam diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam Binary files differindex 8d34178122..d0279971b0 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 464f1222e6..d609725fa8 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 bf95e63f23..ff9a409bf8 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/group_history.beam b/bootstrap/lib/kernel/ebin/group_history.beam Binary files differindex 1def2a5d42..9328355025 100644 --- a/bootstrap/lib/kernel/ebin/group_history.beam +++ b/bootstrap/lib/kernel/ebin/group_history.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex c0ae509717..667c67acb8 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex 8564b7d23d..e2b5639720 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 4cd63fb349..cebe72a7f0 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam Binary files differindex d5589620c9..a5b4d7611f 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 4c7b77c558..74b3a11f59 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 f8a95de32c..f25d7689f5 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.app b/bootstrap/lib/kernel/ebin/kernel.app index fd6213644c..b888d914e8 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "5.3"}, + {vsn, "5.3.1"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 451806a9d9..519e83f7e4 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"5.3", +{"5.3.1", %% Up from - max one major revision back [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.* %% Down to - max one major revision back diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam Binary files differindex d669a101a0..c557c45967 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 b8048a99c1..3d59085f05 100644 --- a/bootstrap/lib/kernel/ebin/net_kernel.beam +++ b/bootstrap/lib/kernel/ebin/net_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex 9a0f8169f6..b99d8ba810 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam Binary files differindex 303f62ad11..8f4e066f3a 100644 --- a/bootstrap/lib/kernel/ebin/ram_file.beam +++ b/bootstrap/lib/kernel/ebin/ram_file.beam diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam Binary files differindex cf4e55254c..947bc0f642 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 0b2b06ae5b..b6ac29d5c4 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/kernel/include/dist.hrl b/bootstrap/lib/kernel/include/dist.hrl index d6bccdf474..db4a5eaebc 100644 --- a/bootstrap/lib/kernel/include/dist.hrl +++ b/bootstrap/lib/kernel/include/dist.hrl @@ -40,3 +40,33 @@ -define(DFLAG_UTF8_ATOMS, 16#10000). -define(DFLAG_MAP_TAG, 16#20000). -define(DFLAG_BIG_CREATION, 16#40000). +-define(DFLAG_SEND_SENDER, 16#80000). + +%% DFLAGs that require strict ordering or:ed together... +-define(DFLAGS_STRICT_ORDER_DELIVERY, + ?DFLAG_DIST_HDR_ATOM_CACHE). + + +%% Also update dflag2str() in ../src/dist_util.erl +%% when adding flags... + +-define(DFLAGS_ALL, + (?DFLAG_PUBLISHED + bor ?DFLAG_ATOM_CACHE + bor ?DFLAG_EXTENDED_REFERENCES + bor ?DFLAG_DIST_MONITOR + bor ?DFLAG_FUN_TAGS + bor ?DFLAG_DIST_MONITOR_NAME + bor ?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_NEW_FUN_TAGS + bor ?DFLAG_EXTENDED_PIDS_PORTS + bor ?DFLAG_EXPORT_PTR_TAG + bor ?DFLAG_BIT_BINARIES + bor ?DFLAG_NEW_FLOATS + bor ?DFLAG_UNICODE_IO + bor ?DFLAG_DIST_HDR_ATOM_CACHE + bor ?DFLAG_SMALL_ATOM_TAGS + bor ?DFLAG_UTF8_ATOMS + bor ?DFLAG_MAP_TAG + bor ?DFLAG_BIG_CREATION + bor ?DFLAG_SEND_SENDER)). diff --git a/bootstrap/lib/kernel/include/dist_util.hrl b/bootstrap/lib/kernel/include/dist_util.hrl index e3d2fe0eb6..eeb0f8dd43 100644 --- a/bootstrap/lib/kernel/include/dist_util.hrl +++ b/bootstrap/lib/kernel/include/dist_util.hrl @@ -29,9 +29,9 @@ -endif. -ifdef(dist_trace). --define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:timestamp(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])). % Use the one below for config-file (early boot) connection tracing -%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +%-define(trace(Fmt,Args), erlang:display([erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])). -define(trace_factor,8). -else. -define(trace(Fmt,Args), ok). @@ -78,7 +78,13 @@ %% New in kernel-5.1 (OTP 19.1): mf_setopts, %% netkernel:setopts on active connection - mf_getopts %% netkernel:getopts on active connection + mf_getopts, %% netkernel:getopts on active connection + + %% New in kernel-6.0 (OTP 21.0) + f_handshake_complete, %% Notify handshake complete + add_flags, %% dflags to add + reject_flags, %% dflags not to use (not all can be rejected) + require_flags %% dflags that are required }). diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex 9d3e40ec78..603110cbf8 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex 6ecae88fbb..6840be1e57 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex fb5a9cdf87..567018d680 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v9.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam Binary files differindex 7918c739f6..b6f5e62671 100644 --- a/bootstrap/lib/stdlib/ebin/edlin.beam +++ b/bootstrap/lib/stdlib/ebin/edlin.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam Binary files differindex 3ed148ace7..8579266b8f 100644 --- a/bootstrap/lib/stdlib/ebin/edlin_expand.beam +++ b/bootstrap/lib/stdlib/ebin/edlin_expand.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam Binary files differindex 716a2b63df..11bd496e2e 100644 --- a/bootstrap/lib/stdlib/ebin/erl_anno.beam +++ b/bootstrap/lib/stdlib/ebin/erl_anno.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 78fedf492d..9244cff669 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 f20fba8ede..146f0cc6bd 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex f58974b75f..beaab5658b 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 20865989da..dc4c689263 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_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 49a9908831..e77e0f9136 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 38d6c42ba2..86307bc790 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 08fd3049ce..c2434b26ed 100644 --- a/bootstrap/lib/stdlib/ebin/erl_tar.beam +++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam Binary files differindex 957843b319..cac19681cc 100644 --- a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam +++ b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam Binary files differindex f1a884a0c9..788a7c2fcf 100644 --- a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam +++ b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex 7247d35dfc..30dea42a21 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 006e02496f..40be147afa 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam Binary files differindex 08707d9147..76ea9a4941 100644 --- a/bootstrap/lib/stdlib/ebin/eval_bits.beam +++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex 74685390ec..a94acbb852 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam Binary files differindex a8155b1cb4..7da423e0c6 100644 --- a/bootstrap/lib/stdlib/ebin/gen.beam +++ b/bootstrap/lib/stdlib/ebin/gen.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex d2a2986d4f..afeb6775ef 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 4a85d11c8b..9bb60f185c 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 df740137a1..27981c75b2 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam Binary files differindex 6cf2ab19c0..8123f65a42 100644 --- a/bootstrap/lib/stdlib/ebin/gen_statem.beam +++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam Binary files differindex 88695c8928..18f66f5443 100644 --- a/bootstrap/lib/stdlib/ebin/io.beam +++ b/bootstrap/lib/stdlib/ebin/io.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam Binary files differindex c51b65b000..a68d77b7f6 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex e9c9759a01..6ed1e3b7cc 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex 72c2c12551..b4c8527161 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex babe11a712..912dfba644 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex 5fd1cf52e2..7c9cfad78e 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/proplists.beam b/bootstrap/lib/stdlib/ebin/proplists.beam Binary files differindex bec0de2782..176a0e0db5 100644 --- a/bootstrap/lib/stdlib/ebin/proplists.beam +++ b/bootstrap/lib/stdlib/ebin/proplists.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 038a211a50..4a315e8d42 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 633c4953e1..a0e2b73018 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam Binary files differindex 4c1cb29615..299c24448d 100644 --- a/bootstrap/lib/stdlib/ebin/slave.beam +++ b/bootstrap/lib/stdlib/ebin/slave.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex a9e324ec31..f7f11b9b26 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam Binary files differindex fc95c3845c..1d4a16cd10 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/erts/Makefile b/erts/Makefile index 73d8560c1e..0393ccc759 100644 --- a/erts/Makefile +++ b/erts/Makefile @@ -49,11 +49,6 @@ debug opt lcnt clean: done (cd preloaded/src && $(MAKE) ../ebin/erts.app) -# ---------------------------------------------------------------------- -# These are "convenience targets", provided as shortcuts for developers -# - don't use them in scripts or assume they will always stay like this! -# - .PHONY: smp smp: $(V_at)for type in $(TYPES); do \ @@ -112,6 +107,11 @@ local_setup: $(ERL_TOP)/bin/start_clean.script \ $(ERL_TOP)/bin/no_dot_erlang.script +# ---------------------------------------------------------------------- +# These are "convenience targets", provided as shortcuts for developers +# - don't use them in scripts or assume they will always stay like this! +# + # Run the configure script .PHONY: configure configure: diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 80bf236188..887babc13f 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -2726,6 +2726,21 @@ AC_DEFUN([LM_TRY_ENABLE_CFLAG], [ fi ]) +AC_DEFUN([LM_CHECK_ENABLE_CFLAG], [ + AC_MSG_CHECKING([whether $CC accepts $1...]) + saved_CFLAGS=$CFLAGS; + CFLAGS="$1 $CFLAGS"; + AC_TRY_COMPILE([],[return 0;],can_enable_flag=true,can_enable_flag=false) + CFLAGS=$saved_CFLAGS; + if test "X$can_enable_flag" = "Xtrue"; then + AS_VAR_SET($2, true) + AC_MSG_RESULT([yes]) + else + AS_VAR_SET($2, false) + AC_MSG_RESULT([no]) + fi +]) + dnl ERL_TRY_LINK_JAVA(CLASSES, FUNCTION-BODY dnl [ACTION_IF_FOUND [, ACTION-IF-NOT-FOUND]]) dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a diff --git a/erts/configure.in b/erts/configure.in index 53386d5500..4184025a6c 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -554,6 +554,94 @@ AC_SUBST(WFLAGS) AC_SUBST(WERRORFLAGS) AC_SUBST(CFLAG_RUNTIME_LIBRARY_PATH) +## Check if we can do profile guided optimization of beam_emu +LM_CHECK_ENABLE_CFLAG([-fprofile-generate -Werror],[PROFILE_GENERATE]) +LM_CHECK_ENABLE_CFLAG([-fprofile-use -Werror],[PROFILE_USE]) + +## Check if this is clang +LM_CHECK_ENABLE_CFLAG([-fprofile-instr-generate -Werror],[PROFILE_INSTR_GENERATE]) +if test "X$PROFILE_INSTR_GENERATE" = "Xtrue"; then + # It was clang, now we also have to check if we have llvm-profdata and that + # we can link programs with -fprofile-instr-use + saved_CFLAGS=$CFLAGS; + CFLAGS="-fprofile-instr-generate -Werror $saved_CFLAGS" + AC_RUN_IFELSE([AC_LANG_PROGRAM([],[])], + [AC_CHECK_PROGS([LLVM_PROFDATA], [llvm-profdata]) + AC_CHECK_PROGS([XCRUN], [xcrun]) + if test "X$XCRUN" != "X" -a "X$LLVM_PROFDATA" = "X"; then + AC_MSG_CHECKING([for $XCRUN llvm-profdata]) + if $XCRUN llvm-profdata --help 2>& AS_MESSAGE_LOG_FD >& AS_MESSAGE_LOG_FD; then + LLVM_PROFDATA="$XCRUN llvm-profdata" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + fi + AC_SUBST(LLVM_PROFDATA) + if test "X$LLVM_PROFDATA" != "X"; then + CFLAGS="-fprofile-instr-use=default.profdata -Werror $saved_CFLAGS"; + $LLVM_PROFDATA merge -output=default.profdata *.profraw; + AC_MSG_CHECKING([whether gcc accepts -fprofile-instr-use=default.profdata -Werror]) + AC_COMPILE_IFELSE([], + [AC_MSG_RESULT([yes]) + PROFILE_INSTR_USE=true], + [AC_MSG_RESULT([no]) + PROFILE_INSTR_USE=false]) + rm -f default.profdata + fi], + []) + rm -f *.profraw + CFLAGS=$saved_CFLAGS; +fi + +AC_ARG_ENABLE(pgo, +AS_HELP_STRING([--enable-pgo], + [build erts using PGO (profile guided optimization)]), +[ case "$enableval" in + no) enable_pgo=no ;; + *) enable_pgo=yes ;; + esac +],enable_pgo=default) + +USE_PGO=false +AC_MSG_CHECKING([whether to do PGO of erts]) +if test $enable_pgo = no; then + AC_MSG_RESULT([no, disabled by user]) +elif test $CROSS_COMPILING = yes; then + if $enable_pgo = yes; then + AC_MSG_ERROR(cannot use PGO when cross-compiling) + else + AC_MSG_RESULT([no, cross compiling]) + fi +elif test "X$host" = "Xwin32"; then + AC_MSG_RESULT([no, not supported in windows]) +elif test "X$PROFILE_GENERATE" = "Xtrue" -a "X$PROFILE_USE" = "Xtrue"; then + USE_PGO=true + AC_MSG_RESULT([yes, using -fprofile-generate]) + PROFILE_COMPILER=gcc +# check if $CC accepts -fprofile-correction, if so we can use PGO on multi-threaded files. + LM_CHECK_ENABLE_CFLAG([-fprofile-use -fprofile-correction -Werror],[PROFILE_CORRECTION]) + if test "X$PROFILE_CORRECTION" = "Xtrue"; then + PROFILE_CORRECTION="-fprofile-correction" + else + PROFILE_CORRECTION="" + fi + AC_SUBST(PROFILE_CORRECTION) +elif test "X$PROFILE_INSTR_GENERATE" = "Xtrue" -a "X$PROFILE_INSTR_USE" = "Xtrue"; then + USE_PGO=true + AC_MSG_RESULT([yes, using -fprofile-instr-generate]) + PROFILE_COMPILER=clang +else + if $enable_pgo = yes; then + AC_MSG_ERROR(cannot use PGO with this compiler) + else + AC_MSG_RESULT([no]) + fi +fi + +AC_SUBST(USE_PGO) +AC_SUBST(PROFILE_COMPILER) + AC_CHECK_SIZEOF(void *) # Needed for ARCH and smp checks below if test "x$ac_cv_sizeof_void_p" = x8; then AC_SUBST(EXTERNAL_WORD_SIZE, 64) @@ -1570,6 +1658,8 @@ AC_CHECK_HEADER(sys/resource.h, [#include <sys/resource.h>])], [],[]) +AC_CHECK_FUNCS([getrusage]) + dnl Check if we have kernel poll support have_kernel_poll=no AC_CHECK_HEADER(sys/event.h, have_kernel_poll=kqueue) @@ -3260,10 +3350,7 @@ esac fi fi - - - - +AC_SUBST(FPE) dnl diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile index b96cbbce40..444adf4a6e 100644 --- a/erts/doc/src/Makefile +++ b/erts/doc/src/Makefile @@ -173,6 +173,8 @@ release_docs_spec: docs "$(RELSYSDIR)/doc/html" $(INSTALL_DATA) $(ERL_TOP)/erts/example/time_compat.erl \ "$(RELSYSDIR)/doc/html" + $(INSTALL_DATA) $(ERL_TOP)/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl \ + "$(RELSYSDIR)/doc/html" $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" diff --git a/erts/doc/src/alt_dist.xml b/erts/doc/src/alt_dist.xml index be969a8267..d3731a5391 100644 --- a/erts/doc/src/alt_dist.xml +++ b/erts/doc/src/alt_dist.xml @@ -47,23 +47,30 @@ runs on. The reason the C code is not made portable, is simply readability.</p> - <note> - <p>This section was written a long time ago. Most of it is still - valid, but some things have changed since then. - Most notably is the driver interface. Some updates have been made - to the documentation of the driver presented here, - but more can be done and is planned for the future. - The reader is encouraged to read the - <seealso marker="erl_driver"><c>erl_driver</c></seealso> and - <seealso marker="driver_entry"><c>driver_entry</c></seealso> - documentation also.</p> - </note> - <section> <title>Introduction</title> <p>To implement a new carrier for the Erlang distribution, the main steps are as follows.</p> + <note><p> + As of ERTS version 10.0 support for distribution controller + processes has been introduced. That is, the traffic over a + distribution channel can be managed by a process instead of + only by a port. This makes it possible to implement large + parts of the logic in Erlang code, and you perhaps do not + even need a new driver for the protocol. One example could + be Erlang distribution over UDP using <c>gen_udp</c> (your + Erlang code will of course have to take care of retranspissions, + etc in this example). That is, depending on what you want + to do you perhaps do not need to implement a driver at all + and can then skip the driver related sections below. + The <c>gen_tcp_dist</c> example described in the + <seealso marker="#distribution_module">Distribution + Module</seealso> section utilize distribution controller + processes and can be worth having a look at if you want to + use distribution controller processes. + </p></note> + <section> <title>Writing an Erlang Driver</title> <p>First, the protocol must be available to the Erlang machine, which @@ -152,7 +159,712 @@ </section> <section> + <marker id="distribution_module"/> + <title>Distribution Module</title> + <p> + The distribution module expose an API that <c>net_kernel</c> call + in order to manage connections to other nodes. The module name + should have the suffix <c>_dist</c>. + </p> + <p> + The module needs to create some kind of listening entity (process + or port) and an acceptor process that accepts incoming connections + using the listening entity. For each connection, the module at least + needs to create one connection supervisor process, which also is + responsible for the handshake when setting up the connection, and + a distribution controller (process or port) responsible for + transport of data over the connection. The distribution controller + and the connection supervisor process should be linked together + so both of them are cleaned up when the connection is taken down. + </p> + <p> + Note that there need to be exactly one distribution controller + per connection. A process or port can only be distribution + controller for one connection. The registration as distribution + controller cannot be undone. It will stick until the distribution + controller terminates. The distribution controller should not + ignore exit signals. It is allowed to trap exits, but it should + then voluntarily terminate when an exit signal is received. + </p> + <p> + An example implementation of a distribution module can be found + in + <url href="gen_tcp_dist.erl">$ERL_TOP/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl</url>. + It implements the distribution over TCP/IP using the <c>gen_tcp</c> + API with distribution controllers implemented by processes. This + instead of using port distribution controllers as the ordinary TCP/IP + distribution uses. + </p> + + <section> + <marker id="distribution_module_exported_callback_functions"/> + <title>Exported Callback Functions</title> + + <p> + The following functions are mandatory: + </p> + <taglist> + <tag><marker id="listen"/><c>listen(Name) -></c><br/> <c>{ok, {Listen, Address, Creation}} | {error, Error} </c></tag> + <item> + <p> + <c>listen/1</c> is called once in order to listen for incoming + connection requests. The call is made when the distribution is brought + up. The argument <c>Name</c> is the part of the node name before + the <c>@</c> sign in the full node name. It can be either an atom or a + string. + </p> + <p> + The return value consists of a <c>Listen</c> handle (which is + later passed to the <seealso marker="#accept"><c>accept/1</c></seealso> + callback), <c>Address</c> which is a <c>#net_address{}</c> record + with information about the address for the node (the + <c>#net_address{}</c> record is defined in + <c>kernel/include/net_address.hrl</c>), and <c>Creation</c> which + (currently) is an integer <c>1</c>, <c>2</c>, or <c>3</c>. + </p> + <p> + If <seealso marker="erts:epmd"><c>epmd</c></seealso> is to be used + for node discovery, you typically want to use the (unfortunately + undocumented) <c>erl_epmd</c> module (part of the <c>kernel</c> + application) in order to register the listen port with <c>epmd</c> + and retrieve <c>Creation</c> to use. + </p> + </item> + + <tag><marker id="accept"/><c>accept(Listen) -></c><br/> <c>AcceptorPid</c></tag> + <item> + <p> + <c>accept/1</c> should spawn a process that accepts connections. This + process should preferably execute on <c>max</c> priority. The process + identifier of this process should be returned. + </p> + <p> + The <c>Listen</c> argument will be the same as the <c>Listen</c> handle + part of the return value of the + <seealso marker="#listen"><c>listen/1</c></seealso> callback above. + <c>accept/1</c> is called only once when the distribution protocol is + started. + </p> + <p> + The caller of this function is a representative for <c>net_kernel</c> + (this may or may not be the process registered as <c>net_kernel</c>) + and is in this document identified as <c>Kernel</c>. + When a connection has been accepted by the acceptor process, it needs + to inform <c>Kernel</c> about the accepted connection. This is done by + passing a message on the form: + </p> + <code type="none"><![CDATA[Kernel ! {accept, AcceptorPid, DistController, Family, Proto}]]></code> + <p> + <c>DistController</c> is either the process or port identifier + of the distribution controller for the connection. The + distribution controller should be created by the acceptor + processes when a new connection is accepted. Its job is to + dispatch traffic on the connection. + </p> + <c>Kernel</c> responds with one of the following messages: + <taglist> + <tag><c>{Kernel, controller, SupervisorPid}</c></tag> + <item> + <p> + The request was accepted and <c>SupervisorPid</c> is the + process identifier of the connection supervisor process + (which is created in the + <seealso marker="#accept_connection"><c>accept_connection/5</c></seealso> + callback). + </p> + </item> + <tag><c>{Kernel, unsupported_protocol}</c></tag> + <item> + <p> + The request was rejected. This is a fatal error. The acceptor + process should terminate. + </p> + </item> + </taglist> + <p> + When an accept sequence has been completed the acceptor process + is expected to continue accepting further requests. + </p> + </item> + + <tag><marker id="accept_connection"/><c>accept_connection(AcceptorPid, DistCtrl, MyNode, Allowed, SetupTime) -></c><br/> <c>ConnectionSupervisorPid</c></tag> + <item> + <p> + <c>accept_connection/5</c> should spawn a process that will + perform the Erlang distribution handshake for the connection. + If the handshake successfully completes it should continue to + function as a connection supervisor. This process + should preferably execute on <c>max</c> priority. + </p> + <p>The arguments:</p> + <taglist> + <tag><c>AcceptorPid</c></tag> + <item> + <p> + Process identifier of the process created by the + <seealso marker="#accept"><c>accept/1</c></seealso> + callback. + </p> + </item> + <tag><c>DistCtrl</c></tag> + <item> + <p>The identifier of the distribution controller identifier + created by the acceptor process. To be passed along to + <c>dist_util:handshake_other_started(HsData)</c>. + </p> + </item> + <tag><c>MyNode</c></tag> + <item> + <p> + Node name of this node. To be passed along to + <c>dist_util:handshake_other_started(HsData)</c>. + </p> + </item> + <tag><c>Allowed</c></tag> + <item> + <p> + To be passed along to + <c>dist_util:handshake_other_started(HsData)</c>. + </p> + </item> + <tag><c>SetupTime</c></tag> + <item> + <p> + Time used for creating a setup timer by a + call to <c>dist_util:start_timer(SetupTime)</c>. + The timer should be passed along to + <c>dist_util:handshake_other_started(HsData)</c>. + </p> + </item> + </taglist> + <p> + The created process should provide callbacks and other + information needed for the handshake in a + <seealso marker="#hs_data_record"><c>#hs_data{}</c></seealso> + record and call <c>dist_util:handshake_other_started(HsData)</c> + with this record. + </p> + <p> + <c>dist_util:handshake_other_started(HsData)</c> will perform + the handshake and if the handshake successfully completes this + process will then continue in a connection supervisor loop + as long as the connection is up. + </p> + </item> + + <tag><marker id="setup"/><c>setup(Node, Type, MyNode, LongOrShortNames, SetupTime) -></c><br/> <c>ConnectionSupervisorPid</c></tag> + <item> + <p> + <c>setup/5</c> should spawn a process that connects to + <c>Node</c>. When connection has been established it should + perform the Erlang distribution handshake for the connection. + If the handshake successfully completes it should continue to + function as a connection supervisor. This process + should preferably execute on <c>max</c> priority. + </p> + <p>The arguments:</p> + <taglist> + <tag><c>Node</c></tag> + <item> + <p> + Node name of remote node. To be passed along to + <c>dist_util:handshake_we_started(HsData)</c>. + </p> + </item> + <tag><c>Type</c></tag> + <item> + <p> + Connection type. To be passed along to + <c>dist_util:handshake_we_started(HsData)</c>. + </p> + </item> + <tag><c>MyNode</c></tag> + <item> + <p> + Node name of this node. To be passed along to + <c>dist_util:handshake_we_started(HsData)</c>. + </p> + </item> + <tag><c>LongOrShortNames</c></tag> + <item> + <p> + Either the atom <c>longnames</c> or + the atom <c>shortnames</c> indicating + whether long or short names is used. + </p> + </item> + <tag><c>SetupTime</c></tag> + <item> + <p> + Time used for creating a setup timer by a + call to <c>dist_util:start_timer(SetupTime)</c>. + The timer should be passed along to + <c>dist_util:handshake_we_started(HsData)</c>. + </p> + </item> + </taglist> + <p> + The caller of this function is a representative for <c>net_kernel</c> + (this may or may not be the process registered as <c>net_kernel</c>) + and is in this document identified as <c>Kernel</c>. + </p> + <p> + This function should, besides spawning the connection supervisor, + also create a distribution controller. The distribution + controller is either a process or a port which is responsible + for dispatching traffic. + </p> + <p> + The created process should provide callbacks and other + information needed for the handshake in a + <seealso marker="#hs_data_record"><c>#hs_data{}</c></seealso> + record and call <c>dist_util:handshake_we_started(HsData)</c> + with this record. + </p> + <p> + <c>dist_util:handshake_we_started(HsData)</c> will perform + the handshake and the handshake successfully completes this + process will then continue in a connection supervisor loop + as long as the connection is up. + </p> + </item> + + <tag><marker id="close"/><c>close(Listen) -></c><br/> <c>void()</c></tag> + + <item><p> + Called in order to close the <c>Listen</c> handle + that originally was passed from the + <seealso marker="#listen"><c>listen/1</c></seealso> callback. + </p></item> + + <tag><marker id="select"/><c>select(NodeName) -></c><br/> <c>boolean()</c></tag> + <item> + <p>Return <c>true</c> if the host name part + of the <c>NodeName</c> is valid for use + with this protocol; otherwise, <c>false</c>. + </p> + </item> + + </taglist> + + <p> + There are also two optional functions that may be + exported: + </p> + <taglist> + <tag><marker id="select"/><c>setopts(Listen, Opts) -></c><br/> <c>ok | {error, Error}</c></tag> + <item> + <p> + The argument <c>Listen</c> is the handle originally passed + from the + <seealso marker="#listen"><c>listen/1</c></seealso> callback. + The argument <c>Opts</c> is a list of options to set on future + connections. + </p> + </item> + + <tag><marker id="select"/><c>getopts(Listen, Opts) -></c><br/> <c>{ok, OptionValues} | {error, Error}</c></tag> + <item> + <p> + The argument <c>Listen</c> is the handle originally passed + from the + <seealso marker="#listen"><c>listen/1</c></seealso> callback. + The argument <c>Opts</c> is a list of options to read for future + connections. + </p> + </item> + </taglist> + + </section> + <section> + <marker id="hs_data_record"/> + <title>The #hs_data{} Record</title> + <p> + The <c>dist_util:handshake_we_started/1</c> and + <c>dist_util:handshake_other_started/1</c> functions + takes a <c>#hs_data{}</c> record as argument. There + are quite a lot of fields in this record that you + need to set. The record is defined in + <c>kernel/include/dist_util.hrl</c>. Not documented + fields should not be set, i.e., should be left as + <c>undefined</c>. + </p> + <p> + The following <c>#hs_data{}</c> record fields need + to be set unless otherwise stated:</p> + <taglist> + <tag><marker id="hs_data_kernel_pid"/><c>kernel_pid</c></tag> + <item> + <p> + Process identifier of the <c>Kernel</c> process. That is, + the process that called either + <seealso marker="#setup"><c>setup/5</c></seealso> or + <seealso marker="#accept_connection"><c>accept_connection/5</c></seealso>. + </p> + </item> + + <tag><marker id="hs_data_other_node"/><c>other_node</c></tag> + <item> + <p>Name of the other node. This field is only + mandatory when this node initiates the connection. + That is, when connection is set up via + <seealso marker="#setup"><c>setup/5</c></seealso>. + </p> + </item> + + <tag><marker id="hs_data_this_node"/><c>this_node</c></tag> + <item> + <p> + The node name of this node. + </p> + </item> + + <tag><marker id="hs_data_socket"/><c>socket</c></tag> + <item> + <p> + The identifier of the distribution controller. + </p> + </item> + + <tag><marker id="hs_data_timer"/><c>timer</c></tag> + <item> + <p> + The timer created using <c>dist_util:start_timer/1</c>. + </p> + </item> + + <tag><marker id="hs_data_allowed"/><c>allowed</c></tag> + <item> + <p>Information passed as <c>Allowed</c> to + <c>accept_connection/5</c>. This field is only + mandatory when the remote node initiated the + connection. That is, when the connection is set + up via + <seealso marker="#accept_connection"><c>accept_connection/5</c></seealso>. + </p> + </item> + + <tag><marker id="hs_data_f_send"/><c>f_send</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr, Data) -> ok | {error, Error}]]></code> + <p> + where <c>DistCtrlr</c> is the identifier of + the distribution controller and <c>Data</c> + is io data to pass to the other side. + </p> + <p>Only used during handshake phase.</p> + </item> + + <tag><marker id="hs_data_f_recv"/><c>f_recv</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr, Length) -> {ok, Packet} | {error, Reason}]]></code> + <p> + where <c>DistCtrlr</c> is the identifier of the distribution + controller. + If <c>Length</c> is <c>0</c>, all available bytes should be + returned. If <c>Length > 0</c>, exactly <c>Length</c> bytes + should be returned, or an error; possibly discarding less + than <c>Length</c> bytes of data when the connection is + closed from the other side. + It is used for passive receive of data from the + other end. + </p> + <p>Only used during handshake phase.</p> + </item> + + <tag><marker id="hs_data_f_setopts_pre_nodeup"/><c>f_setopts_pre_nodeup</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr) -> ok | {error, Error}]]></code> + <p> + where <c>DistCtrlr</c> is the identifier of + the distribution controller. Called just + before the distribution channel is taken up + for normal traffic. + </p> + <p>Only used during handshake phase.</p> + </item> + + <tag><marker id="hs_data_f_setopts_post_nodeup"/><c>f_setopts_post_nodeup</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr) -> ok | {error, Error}]]></code> + <p> + where <c>DistCtrlr</c> is the identifier of + the distribution controller. Called just + after distribution channel has been taken + up for normal traffic. + </p> + <p>Only used during handshake phase.</p> + </item> + + <tag><marker id="hs_data_f_getll"/><c>f_getll</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr) -> ID]]></code> + <p> + where <c>DistCtrlr</c> is the identifier of + the distribution controller and <c>ID</c> is + the identifier of the low level entity that + handles the connection (often <c>DistCtrlr</c> + itself). + </p> + <p>Only used during handshake phase.</p> + </item> + + <tag><marker id="hs_data_f_address"/><c>f_address</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr, Node) -> NetAddress]]></code> + <p> + where <c>DistCtrlr</c> is the identifier of + the distribution controller, <c>Node</c> + is the node name of the node on the other end, + and <c>NetAddress</c> is a <c>#net_address{}</c> + record with information about the address + for the <c>Node</c> on the other end of the + connection. The <c>#net_address{}</c> record + is defined in + <c>kernel/include/net_address.hrl</c>. + </p> + <p>Only used during handshake phase.</p> + </item> + + <tag><marker id="hs_data_mf_tick"/><c>mf_tick</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr) -> void()]]></code> + <p> + where <c>DistCtrlr</c> is the identifier + of the distribution controller. This + function should send information over + the connection that is not interpreted + by the other end while increasing the + statistics of received packets on the + other end. This is usually implemented by + sending an empty packet. + </p> + <note><p> + It is of vital importance that this operation + does not block the caller for a long time. + This since it is called from the connection + supervisor. + </p></note> + <p>Used when connection is up.</p> + </item> + + <tag><marker id="hs_data_mf_getstat"/><c>mf_getstat</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr) -> {ok, Received, Sent, PendSend}]]></code> + <p> + where <c>DistCtrlr</c> is the identifier + of the distribution controller, <c>Received</c> + is received packets, <c>Sent</c> is + sent packets, and <c>PendSend</c> is + amount of packets in queue to be sent + or a <c>boolean()</c> indicating whether + there are packets in queue to be sent. + </p> + <note><p> + It is of vital importance that this operation + does not block the caller for a long time. + This since it is called from the connection + supervisor. + </p></note> + <p>Used when connection is up.</p> + </item> + + <tag><marker id="hs_data_request_type"/><c>request_type</c></tag> + <item> + <p> + The request <c>Type</c> as passed to + <seealso marker="#setup"><c>setup/5</c></seealso>. + This is only mandatory when the connection has + been initiated by this node. That is, the connection + is set up via <c>setup/5</c>. + </p> + </item> + + <tag><marker id="hs_data_mf_setopts"/><c>mf_setopts</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrl, Opts) -> ok | {error, Error}]]></code> + <p> + where <c>DistCtrlr</c> is the identifier + of the distribution controller and <c>Opts</c> + is a list of options to set on the connection. + </p> + <p>This function is optional. Used when connection is up.</p> + </item> + + <tag><marker id="hs_data_mf_getopts"/><c>mf_getopts</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrl, Opts) -> {ok, OptionValues} | {error, Error}]]></code> + <p> + where <c>DistCtrlr</c> is the identifier + of the distribution controller and <c>Opts</c> + is a list of options to read for the connection. + </p> + <p>This function is optional. Used when connection is up.</p> + </item> + + <tag><marker id="hs_data_f_handshake_complete"/><c>f_handshake_complete</c></tag> + <item> + <p> + A fun with the following signature: + </p> + <code type="none"><![CDATA[fun (DistCtrlr, Node, DHandle) -> void()]]></code> + <p> + where <c>DistCtrlr</c> is the identifier + of the distribution controller, <c>Node</c> is + the node name of the node connected at the other + end, and <c>DHandle</c> is a distribution handle + needed by a distribution controller process when + calling the following BIFs: + </p> + <list> + <item><p><seealso marker="erts:erlang#dist_ctrl_get_data/1"><c>erlang:dist_ctrl_get_data/1</c></seealso></p></item> + <item><p><seealso marker="erts:erlang#dist_ctrl_get_data_notification/1"><c>erlang:dist_ctrl_get_data_notification/1</c></seealso></p></item> + <item><p><seealso marker="erts:erlang#dist_ctrl_input_handler/2"><c>erlang:dist_ctrl_input_handler/2</c></seealso></p></item> + <item><p><seealso marker="erts:erlang#dist_ctrl_put_data/2"><c>erlang:dist_ctrl_put_data/2</c></seealso></p></item> + </list> + <p> + This function is called when the handshake has + completed and the distribution channel is up. + The distribution controller can begin dispatching + traffic over the channel. This function is optional. + </p> + <p>Only used during handshake phase.</p> + </item> + + <tag><marker id="hs_data_add_flags"/><c>add_flags</c></tag> + <item> + <p> + <seealso marker="erl_dist_protocol#dflags">Distribution flags</seealso> + to add to the connection. Currently all (non obsolete) flags will + automatically be enabled. + </p> + <p> + This flag field is optional. + </p> + </item> + + <tag><marker id="hs_data_reject_flags"/><c>reject_flags</c></tag> + <item> + <p> + <seealso marker="erl_dist_protocol#dflags">Distribution flags</seealso> + to reject. Currently the following distribution flags can be rejected: + </p> + <taglist> + <tag><c>DFLAG_DIST_HDR_ATOM_CACHE</c></tag> + <item>Do not use atom cache over this connection.</item> + <tag><c>DFLAGS_STRICT_ORDER_DELIVERY</c></tag> + <item>Do not use any features that require strict + order delivery.</item> + </taglist> + <p> + This flag field is optional. + </p> + </item> + + <tag><marker id="hs_data_require_flags"/><c>require_flags</c></tag> + <item> + <p> + Require these <seealso marker="erl_dist_protocol#dflags">distribution + flags</seealso> to be used. The connection will be aborted during the + handshake if the other end does not use them. + </p> + <p> + This flag field is optional. + </p> + </item> + + </taglist> + </section> + + <section> + <marker id="distribution_data_delivery"/> + <title>Distribution Data Delivery</title> + <p> + When using the default configuration, the data to pass + over a connection needs to be delivered as is + to the node on the receiving end in the <em>exact same + order</em>, with no loss of data what so ever, as sent + from the sending node. + </p> + <p> + The data delivery order can be relaxed by disabling + features that require strict ordering. This is done by + passing the <c>?DFLAGS_STRICT_ORDER_DELIVERY</c> + <seealso marker="erl_dist_protocol#dflags">distribution + flags</seealso> in the + <seealso marker="alt_dist#hs_data_reject_flags"><c>reject_flags</c></seealso> + field of the <seealso marker="#hs_data_record"><c>#hs_data{}</c></seealso> + record used when setting up the connection. When relaxed + ordering is used, only the order of signals with the same + sender/receiver pair has to be preserved. + However, note that disabling the features that require + strict ordering may have a negative impact on performance, + throughput, and/or latency. + </p> + </section> + + <section> + <marker id="enable_your_distribution_module"/> + <title>Enable Your Distribution Module</title> + + <p>For <c>net_kernel</c> to find out which distribution module to use, + the <c>erl</c> command-line argument <c>-proto_dist</c> is used. It + is followed by one or more distribution module names, with suffix + "_dist" removed. That is, <c>gen_tcp_dist</c> as a distribution module + is specified as <c>-proto_dist gen_tcp</c>.</p> + + <p>If no <c>epmd</c> (TCP port mapper daemon) is used, also command-line + option <c>-no_epmd</c> is to be specified, which makes + Erlang skip the <c>epmd</c> startup, both as an OS process and as an + Erlang ditto.</p> + </section> + + </section> + + <section> <title>The Driver</title> + + <note> + <p>This section was written a long time ago. Most of it is still + valid, but some things have changed since then. Some updates have + been made to the documentation of the driver presented here, + but more can be done and is planned for the future. + The reader is encouraged to read the + <seealso marker="erl_driver"><c>erl_driver</c></seealso> and + <seealso marker="driver_entry"><c>driver_entry</c></seealso> + documentation also.</p> + </note> + <p>Although Erlang drivers in general can be beyond the scope of this section, a brief introduction seems to be in place.</p> diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml index 610351db6c..a78b13aaa4 100644 --- a/erts/doc/src/erl_dist_protocol.xml +++ b/erts/doc/src/erl_dist_protocol.xml @@ -829,7 +829,31 @@ DiB == gen_digest(ChA, ICA)? <item> <p>The node understand UTF-8 encoded atoms.</p> </item> + <tag><c>-define(DFLAG_MAP_TAG, 16#20000).</c></tag> + <item> + <p>The node understand the map tag.</p> + </item> + <tag><c>-define(DFLAG_BIG_CREATION, 16#40000).</c></tag> + <item> + <p>The node understand big node creation.</p> + </item> + <tag><c>-define(DFLAG_SEND_SENDER, 16#80000).</c></tag> + <item> + <p> + Use the <c>SEND_SENDER</c> + <seealso marker="#control_message">control message</seealso> + instead of the <c>SEND</c> control message and use the + <c>SEND_SENDER_TT</c> control message instead + of the <c>SEND_TT</c> control message. + </p> + </item> </taglist> + <p> + There are also a collection of <c>DFLAG</c>s bitwise or:ed + together in the <c>DFLAGS_STRICT_ORDER_DELIVERY</c> macro. + These flags corresponds to features that require strict + ordering of data over distribution channels. + </p> </section> </section> @@ -922,6 +946,7 @@ DiB == gen_digest(ChA, ICA)? </item> </taglist> + <marker id="control_message"/> <p>The <c>ControlMessage</c> is a tuple, where the first element indicates which distributed operation it encodes:</p> @@ -1028,4 +1053,49 @@ DiB == gen_digest(ChA, ICA)? </item> </taglist> </section> + + <section> + <title>New Ctrlmessages for Erlang/OTP 21</title> + <taglist> + <tag><c>SEND_SENDER</c></tag> + <item> + <p><c>{22, FromPid, ToPid}</c></p> + <p>Followed by <c>Message</c>.</p> + <p> + This control messages replace the <c>SEND</c> control + message and will be sent when the distribution flag + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_SEND_SENDER</c></seealso> + has been negotiated in the connection setup handshake. + </p> + <note><p> + Messages encoded before the connection has + been set up may still use the <c>SEND</c> control + message. However, once a <c>SEND_SENDER</c> or <c>SEND_SENDER_TT</c> + control message has been sent, no more <c>SEND</c> + control messages will be sent in the same direction + on the connection. + </p></note> + </item> + <tag><c>SEND_SENDER_TT</c></tag> + <item> + <p><c>{23, FromPid, ToPid, TraceToken}</c></p> + <p>Followed by <c>Message</c>.</p> + <p> + This control messages replace the <c>SEND_TT</c> control + message and will be sent when the distribution flag + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_SEND_SENDER</c></seealso> + has been negotiated in the connection setup handshake. + </p> + <note><p> + Messages encoded before the connection has + been set up may still use the <c>SEND_TT</c> control + message. However, once a <c>SEND_SENDER</c> or <c>SEND_SENDER_TT</c> + control message has been sent, no more <c>SEND_TT</c> + control messages will be sent in the same direction + on the connection. + </p></note> + </item> + </taglist> + </section> + </chapter> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 5a69bed34c..419e41693e 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -206,7 +206,7 @@ ok <seealso marker="#enif_make_resource"> <c>enif_make_resource</c></seealso>. The term returned by <c>enif_make_resource</c> is opaque in nature. - It can be stored and passed between processes on the same node, but + It can be stored and passed between processes, but the only real end usage is to pass it back as an argument to a NIF. The NIF can then call <seealso marker="#enif_get_resource"> <c>enif_get_resource</c></seealso> and get back a pointer to the @@ -344,6 +344,81 @@ return term;</code> <c>enif_convert_time_unit()</c></seealso></item> </list> </item> + <tag><marker id="enif_ioq"/>I/O Queues</tag> + <item> + <p>The Erlang nif library contains function for easily working + with I/O vectors as used by the unix system call <c>writev</c>. + The I/O Queue is not thread safe, so some other synchronization + mechanism has to be used.</p> + <list type="bulleted"> + <item><seealso marker="#SysIOVec"> + <c>SysIOVec</c></seealso></item> + <item><seealso marker="#ErlNifIOVec"> + <c>ErlNifIOVec</c></seealso></item> + <item><seealso marker="#enif_ioq_create"> + <c>enif_ioq_create()</c></seealso></item> + <item><seealso marker="#enif_ioq_destroy"> + <c>enif_ioq_destroy()</c></seealso></item> + <item><seealso marker="#enif_ioq_enq_binary"> + <c>enif_ioq_enq_binary()</c></seealso></item> + <item><seealso marker="#enif_ioq_enqv"> + <c>enif_ioq_enqv()</c></seealso></item> + <item><seealso marker="#enif_ioq_deq"> + <c>enif_ioq_deq()</c></seealso></item> + <item><seealso marker="#enif_ioq_peek"> + <c>enif_ioq_peek()</c></seealso></item> + <item><seealso marker="#enif_inspect_iovec"> + <c>enif_inspect_iovec()</c></seealso></item> + <item><seealso marker="#enif_free_iovec"> + <c>enif_free_iovec()</c></seealso></item> + </list> + <p>Typical usage when writing to a file descriptor looks like this:</p> + <code type="none"><![CDATA[ +int writeiovec(ErlNifEnv *env, ERL_NIF_TERM term, ERL_NIF_TERM *tail, + ErlNifIOQueue *q, int fd) { + + ErlNifIOVec vec, *iovec = &vec; + SysIOVec *sysiovec; + int saved_errno; + int iovcnt, n; + + if (!enif_inspect_iovec(env, 64, term, tail, &iovec)) + return -2; + + if (enif_ioq_size(q) > 0) { + /* If the I/O queue contains data we enqueue the iovec and + then peek the data to write out of the queue. */ + if (!enif_ioq_enqv(q, iovec, 0)) + return -3; + + sysiovec = enif_ioq_peek(q, &iovcnt); + } else { + /* If the I/O queue is empty we skip the trip through it. */ + iovcnt = iovec->iovcnt; + sysiovec = iovec->iov; + } + + /* Attempt to write the data */ + n = writev(fd, sysiovec, iovcnt); + saved_errno = errno; + + if (enif_ioq_size(q) == 0) { + /* If the I/O queue was initially empty we enqueue any + remaining data into the queue for writing later. */ + if (n >= 0 && !enif_ioq_enqv(q, iovec, n)) + return -3; + } else { + /* Dequeue any data that was written from the queue. */ + if (n > 0 && !enif_ioq_deq(q, n, NULL)) + return -4; + } + + /* return n, which is either number of bytes written or -1 if + some error happened */ + errno = saved_errno; + return n; +}]]></code> + </item> <tag><marker id="lengthy_work"/>Long-running NIFs</tag> <item> <p>As mentioned in the <seealso marker="#WARNING">warning</seealso> text @@ -837,6 +912,36 @@ typedef enum { </item> </taglist> </item> + <tag><marker id="SysIOVec"/><c>SysIOVec</c></tag> + <item> + <p>A system I/O vector, as used by <c>writev</c> on + Unix and <c>WSASend</c> on Win32. It is used in + <c>ErlNifIOVec</c> and by + <seealso marker="#enif_ioq_peek"><c>enif_ioq_peek</c></seealso>.</p> + </item> + <tag><marker id="ErlNifIOVec"/><c>ErlNifIOVec</c></tag> + <item> + <code type="none"> +typedef struct { + int iovcnt; + size_t size; + SysIOVec* iov; +} ErlNifIOVec;</code> + <p>An I/O vector containing <c>iovcnt</c> <c>SysIOVec</c>s + pointing to the data. It is used by + <seealso marker="#enif_inspect_iovec"> + <c>enif_inspect_iovec</c></seealso> and + <seealso marker="#enif_ioq_enqv"> + <c>enif_ioq_enqv</c></seealso>.</p> + </item> + <tag><marker id="ErlNifIOQueueOpts"/><c>ErlNifIOQueueOpts</c></tag> + <item> + Options to configure a <c>ErlNifIOQueue</c>. + <taglist> + <tag>ERL_NIF_IOQ_NORMAL</tag> + <item><p>Create a normal I/O Queue</p></item> + </taglist> + </item> </taglist> </section> @@ -1143,6 +1248,31 @@ typedef enum { </func> <func> + <name><ret>void</ret> + <nametext>enif_free_iovec(ErlNifIOvec* iov)</nametext></name> + <fsummary>Free an ErlIOVec</fsummary> + <desc> + <p>Frees an io vector returned from + <seealso marker="#enif_inspect_iovec"> + <c>enif_inspect_iovec</c></seealso>. + This is needed only if a <c>NULL</c> environment is passed to + <seealso marker="#enif_inspect_iovec"> + <c>enif_inspect_iovec</c></seealso>.</p> + <code type="none"><![CDATA[ +ErlNifIOVec *iovec = NULL; +size_t max_elements = 128; +ERL_NIF_TERM tail; +if (!enif_inspect_iovec(NULL, max_elements, term, &tail, iovec)) + return 0; + +// Do things with the iovec + +/* Free the iovector, possibly in another thread or nif function call */ +enif_free_iovec(iovec);]]></code> + </desc> + </func> + + <func> <name><ret>int</ret><nametext>enif_get_atom(ErlNifEnv* env, ERL_NIF_TERM term, char* buf, unsigned size, ErlNifCharEncoding encode)</nametext> </name> @@ -1449,6 +1579,127 @@ typedef enum { </func> <func> + <name><ret>int</ret><nametext>enif_inspect_iovec(ErlNifEnv* + env, size_t max_elements, ERL_NIF_TERM iovec_term, ERL_NIF_TERM* tail, + ErlNifIOVec** iovec)</nametext></name> + <fsummary>Inspect a list of binaries as an ErlNifIOVec.</fsummary> + <desc> + <p>Fills <c>iovec</c> with the list of binaries provided in + <c>iovec_term</c>. The number of elements handled in the call is + limited to <c>max_elements</c>, and <c>tail</c> is set to the + remainder of the list. Note that the output may be longer than + <c>max_elements</c> on some platforms. + </p> + <p>To create a list of binaries from an arbitrary iolist, use + <seealso marker="erts:erlang#iolist_to_iovec/1"> + <c>erlang:iolist_to_iovec/1</c></seealso>.</p> + <p>When calling this function, <c>iovec</c> should contain a pointer to + <c>NULL</c> or a ErlNifIOVec structure that should be used if + possible. e.g. + </p> + <code type="none"> +/* Don't use a pre-allocated structure */ +ErlNifIOVec *iovec = NULL; +enif_inspect_iovec(env, max_elements, term, &tail, &iovec); + +/* Use a stack-allocated vector as an optimization for vectors with few elements */ +ErlNifIOVec vec, *iovec = &vec; +enif_inspect_iovec(env, max_elements, term, &tail, &iovec); +</code> + <p>The contents of the <c>iovec</c> is valid until the called nif + function returns. If the <c>iovec</c> should be valid after the nif + call returns, it is possible to call this function with a + <c>NULL</c> environment. If no environment is given the <c>iovec</c> + owns the data in the vector and it has to be explicitly freed using + <seealso marker="#enif_free_iovec"><c>enif_free_iovec</c> + </seealso>.</p> + <p>Returns <c>true</c> on success, or <c>false</c> if <c>iovec_term</c> + not an iovec.</p> + </desc> + </func> + + <func> + <name><ret>ErlNifIOQueue *</ret> + <nametext>enif_ioq_create(ErlNifIOQueueOpts opts)</nametext></name> + <fsummary>Create a new IO Queue</fsummary> + <desc> + <p>Create a new I/O Queue that can be used to store data. + <c>opts</c> has to be set to <c>ERL_NIF_IOQ_NORMAL</c>. + </p> + </desc> + </func> + + <func> + <name><ret>void</ret> + <nametext>enif_ioq_destroy(ErlNifIOQueue *q)</nametext></name> + <fsummary>Destroy an IO Queue and free it's content</fsummary> + <desc> + <p>Destroy the I/O queue and free all of it's contents</p> + </desc> + </func> + + <func> + <name><ret>int</ret> + <nametext>enif_ioq_deq(ErlNifIOQueue *q, size_t count, size_t *size)</nametext></name> + <fsummary>Dequeue count bytes from the IO Queue</fsummary> + <desc> + <p>Dequeue <c>count</c> bytes from the I/O queue. + If <c>size</c> is not <c>NULL</c>, the new size of the queue + is placed there.</p> + <p>Returns <c>true</c> on success, or <c>false</c> if the I/O does + not contain <c>count</c> bytes. On failure the queue is left un-altered.</p> + </desc> + </func> + + <func> + <name><ret>int</ret> + <nametext>enif_ioq_enq_binary(ErlNifIOQueue *q, ErlNifBinary *bin, size_t skip)</nametext></name> + <fsummary>Enqueue the binary into the IO Queue</fsummary> + <desc> + <p>Enqueue the <c>bin</c> into <c>q</c> skipping the first <c>skip</c> bytes.</p> + <p>Returns <c>true</c> on success, or <c>false</c> if <c>skip</c> is greater + than the size of <c>bin</c>. Any ownership of the binary data is transferred + to the queue and <c>bin</c> is to be considered read-only for the rest of the NIF + call and then as released.</p> + </desc> + </func> + + <func> + <name><ret>int</ret> + <nametext>enif_ioq_enqv(ErlNifIOQueue *q, ErlNifIOVec *iovec, size_t skip)</nametext></name> + <fsummary>Enqueue the iovec into the IO Queue</fsummary> + <desc> + <p>Enqueue the <c>iovec</c> into <c>q</c> skipping the first <c>skip</c> bytes.</p> + <p>Returns <c>true</c> on success, or <c>false</c> if <c>skip</c> is greater + than the size of <c>iovec</c>.</p> + </desc> + </func> + + <func> + <name><ret>SysIOVec *</ret> + <nametext>enif_ioq_peek(ErlNifIOQueue *q, int *iovlen)</nametext></name> + <fsummary>Peek inside the IO Queue</fsummary> + <desc> + <p>Get the I/O queue as a pointer to an array of <c>SysIOVec</c>s. + It also returns the number of elements in <c>iovlen</c>. + This is the only way to get data out of the queue.</p> + <p>Nothing is removed from the queue by this function, that must be done + with <seealso marker="#enif_ioq_deq"><c>enif_ioq_deq</c></seealso>.</p> + <p>The returned array is suitable to use with the Unix system + call <c>writev</c>.</p> + </desc> + </func> + + <func> + <name><ret>size_t</ret> + <nametext>enif_ioq_size(ErlNifIOQueue *q)</nametext></name> + <fsummary>Get the current size of the IO Queue</fsummary> + <desc> + <p>Get the size of <c>q</c>.</p> + </desc> + </func> + + <func> <name><ret>int</ret> <nametext>enif_is_atom(ErlNifEnv* env, ERL_NIF_TERM term)</nametext> </name> @@ -1952,10 +2203,33 @@ typedef enum { details, see the <seealso marker="#enif_resource_example">example of creating and returning a resource object</seealso> in the User's Guide.</p> - <p>Notice that the only defined behavior of using a resource term in - an Erlang program is to store it and send it between processes on the - same node. Other operations, such as matching or - <c>term_to_binary</c>, have unpredictable (but harmless) results.</p> + <note> + <p>Since ERTS 9.0 (OTP-20.0), resource terms have a defined behavior + when compared and serialized through <c>term_to_binary</c> or passed + between nodes.</p> + <list type="bulleted"> + <item> + <p>Two resource terms will compare equal iff they + would yield the same resource object pointer when passed to + <seealso marker="#enif_get_resource"><c>enif_get_resource</c></seealso>.</p> + </item> + <item> + <p>A resoure term can be serialized with <c>term_to_binary</c> and later + be fully recreated if the resource object is still alive when + <c>binary_to_term</c> is called. A <em>stale</em> resource term will be + returned from <c>binary_to_term</c> if the resource object has + been deallocated. <seealso marker="#enif_get_resource"><c>enif_get_resource</c></seealso> + will return false for stale resource terms.</p> + <p>The same principles of serialization apply when passing + resource terms in messages to remote nodes and back again. A + resource term will act stale on all nodes except the node where + its resource object is still alive in memory.</p> + </item> + </list> + <p>Before ERTS 9.0 (OTP-20.0), all resource terms did + compare equal to each other and to empty binaries (<c><<>></c>). + If serialized, they would be recreated as plain empty binaries.</p> + </note> </desc> </func> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index ba4e07b158..e6b983b6c2 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -60,6 +60,14 @@ </desc> </datatype> <datatype> + <name>iovec()</name> + <desc> + <p>A list of binaries. This datatype is useful to use + together with <seealso marker="erl_nif#enif_inspect_iovec"> + <c>enif_inspect_iovec</c></seealso>.</p> + </desc> + </datatype> + <datatype> <name name="message_queue_data"></name> <desc> <p>See <seealso marker="#process_flag_message_queue_data"> @@ -181,6 +189,14 @@ </taglist> </desc> </datatype> + + <datatype> + <name name="dist_handle"></name> + <desc> + <p>An opaque handle identifing a distribution channel.</p> + </desc> + </datatype> + </datatypes> <funcs> @@ -1215,6 +1231,141 @@ end</code> </func> <func> + <name name="dist_ctrl_get_data" arity="1"/> + <fsummary>Get distribution channel data to pass to another node.</fsummary> + <desc> + <p> + Get distribution channel data from the local node that is + to be passed to the remote node. The distribution channel + is identified by <c><anno>DHandle</anno></c>. If no data + is available, the atom <c>none</c> is returned. One + can request to be informed by a message when more + data is available by calling + <seealso marker="erlang#dist_ctrl_get_data_notification/1"><c>erlang:dist_ctrl_get_data_notification(DHandle)</c></seealso>. + </p> + <note><p> + Only the process registered as distribution + controller for the distribution channel identified by + <c><anno>DHandle</anno></c> is allowed to call this + function. + </p></note> + <p> + This function is used when implementing an alternative + distribution carrier using processes as distribution + controllers. <c><anno>DHandle</anno></c> is retrived + via the callback + <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>. + More information can be found in the documentation of + <seealso marker="erts:alt_dist#distribution_module">ERTS + User's Guide ➜ How to implement an Alternative Carrier + for the Erlang Distribution ➜ Distribution Module</seealso>. + </p> + </desc> + </func> + + <func> + <name name="dist_ctrl_get_data_notification" arity="1"/> + <fsummary>Request notification about available outgoing distribution channel data.</fsummary> + <desc> + <p> + Request notification when more data is available to + fetch using + <seealso marker="erlang#dist_ctrl_get_data/1"><c>erlang:dist_ctrl_get_data(DHandle)</c></seealso> + for the distribution channel identified by + <c><anno>DHandle</anno></c>. When more data is present, + the caller will be sent the message <c>dist_data</c>. + Once a <c>dist_data</c> messages has been sent, no + more <c>dist_data</c> messages will be sent until + the <c>dist_ctrl_get_data_notification/1</c> function has been called + again. + </p> + <note><p> + Only the process registered as distribution + controller for the distribution channel identified by + <c><anno>DHandle</anno></c> is allowed to call this + function. + </p></note> + <p> + This function is used when implementing an alternative + distribution carrier using processes as distribution + controllers. <c><anno>DHandle</anno></c> is retrived + via the callback + <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>. + More information can be found in the documentation of + <seealso marker="erts:alt_dist#distribution_module">ERTS + User's Guide ➜ How to implement an Alternative Carrier + for the Erlang Distribution ➜ Distribution Module</seealso>. + </p> + </desc> + </func> + + <func> + <name name="dist_ctrl_input_handler" arity="2"/> + <fsummary>Register distribution channel input handler process.</fsummary> + <desc> + <p> + Register an alternate input handler process for the + distribution channel identified by <c><anno>DHandle</anno></c>. + Once this function has been called, <c><anno>InputHandler</anno></c> + is the only process allowed to call + <seealso marker="erlang#dist_ctrl_put_data/2"><c>erlang:dist_ctrl_put_data(DHandle, Data)</c></seealso> + with the <c><anno>DHandle</anno></c> identifing this distribution + channel. + </p> + <note><p> + Only the process registered as distribution + controller for the distribution channel identified by + <c><anno>DHandle</anno></c> is allowed to call this + function. + </p></note> + <p> + This function is used when implementing an alternative + distribution carrier using processes as distribution + controllers. <c><anno>DHandle</anno></c> is retrived + via the callback + <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>. + More information can be found in the documentation of + <seealso marker="erts:alt_dist#distribution_module">ERTS + User's Guide ➜ How to implement an Alternative Carrier + for the Erlang Distribution ➜ Distribution Module</seealso>. + </p> + </desc> + </func> + + <func> + <name name="dist_ctrl_put_data" arity="2"/> + <fsummary>Pass data into the VM from a distribution channel.</fsummary> + <desc> + <p> + Deliver distribution channel data from a remote node to the + local node. + </p> + <note><p> + Only the process registered as distribution + controller for the distribution channel identified by + <c><anno>DHandle</anno></c> is allowed to call this + function unless an alternate input handler process + has been registered using + <seealso marker="erlang#dist_ctrl_input_handler/2"><c>erlang:dist_ctrl_input_handler(DHandle, InputHandler)</c></seealso>. + If an alternate input handler has been registered, only + the registered input handler process is allowed to call + this function. + </p></note> + <p> + This function is used when implementing an alternative + distribution carrier using processes as distribution + controllers. <c><anno>DHandle</anno></c> is retrived + via the callback + <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>. + More information can be found in the documentation of + <seealso marker="erts:alt_dist#distribution_module">ERTS + User's Guide ➜ How to implement an Alternative Carrier + for the Erlang Distribution ➜ Distribution Module</seealso>. + </p> + </desc> + </func> + + <func> <name name="element" arity="2"/> <fsummary>Return the Nth element of a tuple.</fsummary> <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> @@ -1943,23 +2094,26 @@ os_prompt%</pre> <item>The runtime system exits with integer value <c><anno>Status</anno></c> as status code to the calling environment (OS). + <note> + <p>On many platforms, the OS supports only status + codes 0-255. A too large status code is truncated by clearing + the high bits.</p> + </note> </item> <tag>string()</tag> <item>An Erlang crash dump is produced with <c><anno>Status</anno></c> as slogan. Then the runtime system exits with status code <c>1</c>. - Note that only code points in the range 0-255 may be used - and the string will be truncated if longer than 200 characters. + The string will be truncated if longer than 200 characters. + <note> + <p>Before ERTS 9.1 (OTP-20.1) only code points in the range 0-255 + was accepted in the string. Now any unicode string is valid.</p> + </note> </item> <tag><c>abort</c></tag> <item>The runtime system aborts producing a core dump, if that is enabled in the OS. </item> </taglist> - <note> - <p>On many platforms, the OS supports only status - codes 0-255. A too large status code is truncated by clearing - the high bits.</p> - </note> <p>For integer <c><anno>Status</anno></c>, the Erlang runtime system closes all ports and allows async threads to finish their operations before exiting. To exit without such flushing, use @@ -2125,6 +2279,15 @@ os_prompt%</pre> </func> <func> + <name name="iolist_to_iovec" arity="1"/> + <fsummary>Converts an iolist to a iovec.</fsummary> + <desc> + <p>Returns an iovec that is made from the integers and binaries in + <c><anno>IoListOrBinary</anno></c>.</p> + </desc> + </func> + + <func> <name name="is_alive" arity="0"/> <fsummary>Check whether the local node is alive.</fsummary> <desc> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 985ea11b49..050e84f0c1 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,54 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 9.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A timer internal bit-field used for storing scheduler id + was too small. As a result, VM internal timer data + structures could become inconsistent when using 1024 + schedulers on the system. Note that systems with less + than 1024 schedulers are not effected by this bug.</p> + <p> + This bug was introduced in ERTS version 7.0 (OTP 18.0).</p> + <p> + Own Id: OTP-14548 Aux Id: OTP-11997, ERL-468 </p> + </item> + <item> + <p> + Automatic cleanup of a BIF timer, when the owner process + terminated, could race with the timeout of the timer. + This could cause the VM internal data structures to + become inconsistent which very likely caused a VM crash.</p> + <p> + This bug was introduced in ERTS version 9.0 (OTP 20.0).</p> + <p> + Own Id: OTP-14554 Aux Id: OTP-14356, ERL-468 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 9.0.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Binary append operations did not check for overflow, + resulting in nonsensical results when huge binaries were + appended.</p> + <p> + Own Id: OTP-14524</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 9.0.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -555,7 +603,7 @@ marker="erts:erl"><c>erl</c></seealso> command.</p> <p> See <url - href="http://pcre.org/original/changelog.txt"><c>http://pcre.org/original/changelog.txt</c></url> + href="http://pcre.org/original/changelog.txt">http://pcre.org/original/changelog.txt</url> for information about changes made to PCRE between the versions 8.33 and 8.40.</p> <p> diff --git a/erts/doc/src/zlib.xml b/erts/doc/src/zlib.xml index 1d272c4c18..f5cc1b1e64 100644 --- a/erts/doc/src/zlib.xml +++ b/erts/doc/src/zlib.xml @@ -65,13 +65,17 @@ list_to_binary([Compressed|Last])</pre> <tag><c>badarg</c></tag> <item>Bad argument. </item> + <tag><c>not_initialized</c></tag> + <item>The stream hasn't been initialized, eg. if + <seealso marker="#inflateInit/1"><c>inflateInit/1</c></seealso> wasn't + called prior to a call to + <seealso marker="#inflate/2"><c>inflate/2</c></seealso>. + </item> <tag><c>data_error</c></tag> <item>The data contains errors. </item> <tag><c>stream_error</c></tag> <item>Inconsistent stream state.</item> - <tag><c>einval</c></tag> - <item>Bad value or wrong function called.</item> <tag><c>{need_dictionary,Adler32}</c></tag> <item>See <seealso marker="#inflate/2"><c>inflate/2</c></seealso>. </item> @@ -90,6 +94,9 @@ list_to_binary([Compressed|Last])</pre> <name name="zlevel"/> </datatype> <datatype> + <name name="zflush"/> + </datatype> + <datatype> <name name="zmemlevel"/> </datatype> <datatype> @@ -112,6 +119,11 @@ list_to_binary([Compressed|Last])</pre> <fsummary>Calculate the Adler checksum.</fsummary> <desc> <p>Calculates the Adler-32 checksum for <c><anno>Data</anno></c>.</p> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="erts:erlang#adler32/1"> + <c>erlang:adler32/1</c></seealso> instead.</p> + </warning> </desc> </func> @@ -127,6 +139,11 @@ list_to_binary([Compressed|Last])</pre> Crc = lists:foldl(fun(Data,Crc0) -> zlib:adler32(Z, Crc0, Data), end, zlib:adler32(Z,<< >>), Datas)</pre> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="erts:erlang#adler32/2"> + <c>erlang:adler32/2</c></seealso> instead.</p> + </warning> </desc> </func> @@ -141,6 +158,11 @@ Crc = lists:foldl(fun(Data,Crc0) -> <p>This function returns the <c><anno>Adler</anno></c> checksum of <c>[Data1,Data2]</c>, requiring only <c><anno>Adler1</anno></c>, <c><anno>Adler2</anno></c>, and <c><anno>Size2</anno></c>.</p> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="erts:erlang#adler32_combine/3"> + <c>erlang:adler32_combine/3</c></seealso> instead.</p> + </warning> </desc> </func> @@ -165,6 +187,12 @@ Crc = lists:foldl(fun(Data,Crc0) -> <fsummary>Get current CRC.</fsummary> <desc> <p>Gets the current calculated CRC checksum.</p> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="erts:erlang#crc32/1"> + <c>erlang:crc32/1</c></seealso> on the uncompressed data + instead.</p> + </warning> </desc> </func> @@ -173,6 +201,11 @@ Crc = lists:foldl(fun(Data,Crc0) -> <fsummary>Calculate CRC.</fsummary> <desc> <p>Calculates the CRC checksum for <c><anno>Data</anno></c>.</p> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="erts:erlang#crc32/1"> + <c>erlang:crc32/1</c></seealso> instead.</p> + </warning> </desc> </func> @@ -188,6 +221,11 @@ Crc = lists:foldl(fun(Data,Crc0) -> Crc = lists:foldl(fun(Data,Crc0) -> zlib:crc32(Z, Crc0, Data), end, zlib:crc32(Z,<< >>), Datas)</pre> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="erts:erlang#crc32/2"> + <c>erlang:crc32/2</c></seealso> instead.</p> + </warning> </desc> </func> @@ -202,6 +240,11 @@ Crc = lists:foldl(fun(Data,Crc0) -> <p>This function returns the <c><anno>CRC</anno></c> checksum of <c>[Data1,Data2]</c>, requiring only <c><anno>CRC1</anno></c>, <c><anno>CRC2</anno></c>, and <c><anno>Size2</anno></c>.</p> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="erts:erlang#crc32_combine/3"> + <c>erlang:crc32_combine/3</c></seealso> instead.</p> + </warning> </desc> </func> @@ -407,8 +450,8 @@ list_to_binary([B1,B2])</pre> <seealso marker="#deflateInit/1"><c>deflateInit/1,2,6</c></seealso> or <seealso marker="#deflateReset/1"><c>deflateReset/1</c></seealso>, before any call of - <seealso marker="#deflate/3"><c>deflate/3</c></seealso>. - The compressor and decompressor must use the same dictionary (see + <seealso marker="#deflate/3"><c>deflate/3</c></seealso>.</p> + <p>The compressor and decompressor must use the same dictionary (see <seealso marker="#inflateSetDictionary/2"> <c>inflateSetDictionary/2</c></seealso>).</p> <p>The Adler checksum of the dictionary is returned.</p> @@ -420,6 +463,10 @@ list_to_binary([B1,B2])</pre> <fsummary>Get buffer size.</fsummary> <desc> <p>Gets the size of the intermediate buffer.</p> + <warning> + <p>This function is deprecated and will be removed in a future + release.</p> + </warning> </desc> </func> @@ -443,14 +490,31 @@ list_to_binary([B1,B2])</pre> <name name="inflate" arity="2"/> <fsummary>Decompress data.</fsummary> <desc> - <p>Decompresses as much data as possible. - It can introduce some output latency (reading - input without producing any output).</p> - <p>If a preset dictionary is needed at this point (see - <seealso marker="#inflateSetDictionary/2"> - <c>inflateSetDictionary/2</c></seealso>), <c>inflate/2</c> throws a - <c>{need_dictionary,Adler}</c> exception, where <c>Adler</c> is - the Adler-32 checksum of the dictionary chosen by the compressor.</p> + <p>Equivalent to + <seealso marker="#inflate/3"><c>inflate(Z, Data, [])</c></seealso> + </p> + </desc> + </func> + + <func> + <name name="inflate" arity="3"/> + <fsummary>Decompress data.</fsummary> + <desc> + <p>Decompresses as much data as possible. It can introduce some output + latency (reading input without producing any output).</p> + <p>Currently the only available option is + <c>{exception_on_need_dict,boolean()}</c> which controls whether the + function should throw an exception when a preset dictionary is + required for decompression. When set to false, a + <c>need_dictionary</c> tuple will be returned instead. See + <seealso marker="#inflateSetDictionary/2"> + <c>inflateSetDictionary/2</c></seealso> for details.</p> + <warning> + <p>This option defaults to <c>true</c> for backwards compatibility + but we intend to remove the exception behavior in a future + release. New code that needs to handle dictionaries manually + should always specify <c>{exception_on_need_dict,false}</c>.</p> + </warning> </desc> </func> @@ -458,6 +522,11 @@ list_to_binary([B1,B2])</pre> <name name="inflateChunk" arity="1"/> <fsummary>Read next uncompressed chunk.</fsummary> <desc> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="#safeInflate/2"><c>safeInflate/2</c> + </seealso> instead.</p> + </warning> <p>Reads the next chunk of uncompressed data, initialized by <seealso marker="#inflateChunk/2"><c>inflateChunk/2</c></seealso>.</p> <p>This function is to be repeatedly called, while it returns @@ -469,23 +538,27 @@ list_to_binary([B1,B2])</pre> <name name="inflateChunk" arity="2"/> <fsummary>Decompress data with limited output size.</fsummary> <desc> + <warning> + <p>This function is deprecated and will be removed in a future + release. Use <seealso marker="#safeInflate/2"><c>safeInflate/2</c> + </seealso> instead.</p> + </warning> <p>Like <seealso marker="#inflate/2"><c>inflate/2</c></seealso>, - but decompresses no more data than will fit in the buffer configured - through <seealso marker="#setBufSize/2"><c>setBufSize/2</c></seealso>. - Is is useful when decompressing a stream with a high compression - ratio, such that a small amount of compressed input can expand up to - 1000 times.</p> + but decompresses no more data than will fit in the buffer configured + through <seealso marker="#setBufSize/2"><c>setBufSize/2</c> + </seealso>. Is is useful when decompressing a stream with a high + compression ratio, such that a small amount of compressed input can + expand up to 1000 times.</p> <p>This function returns <c>{more, Decompressed}</c>, when there is - more output available, and - <seealso marker="#inflateChunk/1"><c>inflateChunk/1</c></seealso> - is to be used to read it.</p> - <p>This function can introduce some output latency (reading - input without producing any output).</p> - <p>If a preset dictionary is needed at this point (see - <seealso marker="#inflateSetDictionary/2"> - <c>inflateSetDictionary/2</c></seealso>), this function throws a - <c>{need_dictionary,Adler}</c> exception, where <c>Adler</c> is - the Adler-32 checksum of the dictionary chosen by the compressor.</p> + more output available, and + <seealso marker="#inflateChunk/1"><c>inflateChunk/1</c></seealso> + is to be used to read it.</p> + <p>This function can introduce some output latency (reading input + without producing any output).</p> + <p>An exception will be thrown if a preset dictionary is required for + further decompression. See + <seealso marker="#inflateSetDictionary/2"> + <c>inflateSetDictionary/2</c></seealso> for details.</p> <p>Example:</p> <pre> walk(Compressed, Handler) -> @@ -517,6 +590,18 @@ loop(Z, Handler, Uncompressed) -> </func> <func> + <name name="inflateGetDictionary" arity="1"/> + <fsummary>Return the decompression dictionary.</fsummary> + <desc> + <p>Returns the decompression dictionary currently in use + by the stream. This function must be called between + <seealso marker="#inflateInit/1"><c>inflateInit/1,2</c></seealso> + and <seealso marker="#inflateEnd/1"><c>inflateEnd</c></seealso>.</p> + <p>Only supported if ERTS was compiled with zlib >= 1.2.8.</p> + </desc> + </func> + + <func> <name name="inflateInit" arity="1"/> <fsummary>Initialize a session for decompression.</fsummary> <desc> @@ -562,45 +647,83 @@ loop(Z, Handler, Uncompressed) -> <fsummary>Initialize the decompression dictionary.</fsummary> <desc> <p>Initializes the decompression dictionary from the specified - uncompressed byte sequence. This function must be called - immediately after a call of - <seealso marker="#inflate/2"><c>inflate/2</c></seealso> - if this call threw a <c>{need_dictionary,Adler}</c> exception. - The dictionary chosen by the compressor can be determined from the - Adler value thrown by the call to <c>inflate/2</c>. - The compressor and decompressor must use the same dictionary (see - <seealso marker="#deflateSetDictionary/2"> - <c>deflateSetDictionary/2</c></seealso>).</p> + uncompressed byte sequence. This function must be called as a + response to an inflate operation (eg. + <seealso marker="#safeInflate/2"><c>safeInflate/2</c></seealso>) + returning <c>{need_dictionary,Adler,Output}</c> or in the case of + deprecated functions, throwing an + <c>{'EXIT',{{need_dictionary,Adler},_StackTrace}}</c> exception.</p> + <p>The dictionary chosen by the compressor can be determined from the + Adler value returned or thrown by the call to the inflate function. + The compressor and decompressor must use the same dictionary (See + <seealso marker="#deflateSetDictionary/2"> + <c>deflateSetDictionary/2</c></seealso>).</p> + <p>After setting the dictionary the inflate operation should be + retried without new input.</p> <p>Example:</p> <pre> -unpack(Z, Compressed, Dict) -> +deprecated_unpack(Z, Compressed, Dict) -> case catch zlib:inflate(Z, Compressed) of - {'EXIT',{{need_dictionary,DictID},_}} -> - zlib:inflateSetDictionary(Z, Dict), + {'EXIT',{{need_dictionary,_DictID},_}} -> + ok = zlib:inflateSetDictionary(Z, Dict), Uncompressed = zlib:inflate(Z, []); Uncompressed -> Uncompressed - end.</pre> + end. + +new_unpack(Z, Compressed, Dict) -> + case zlib:inflate(Z, Compressed, [{exception_on_need_dict, false}]) of + {need_dictionary, _DictId, Output} -> + ok = zlib:inflateSetDictionary(Z, Dict), + [Output | zlib:inflate(Z, [])]; + Uncompressed -> + Uncompressed + end.</pre> </desc> </func> <func> - <name name="inflateGetDictionary" arity="1"/> - <fsummary>Return the decompression dictionary.</fsummary> + <name name="open" arity="0"/> + <fsummary>Open a stream and return a stream reference.</fsummary> <desc> - <p>Returns the decompression dictionary currently in use - by the stream. This function must be called between - <seealso marker="#inflateInit/1"><c>inflateInit/1,2</c></seealso> - and <seealso marker="#inflateEnd/1"><c>inflateEnd</c></seealso>.</p> - <p>Only supported if ERTS was compiled with zlib >= 1.2.8.</p> + <p>Opens a zlib stream.</p> </desc> </func> <func> - <name name="open" arity="0"/> - <fsummary>Open a stream and return a stream reference.</fsummary> + <name name="safeInflate" arity="2"/> + <fsummary>Decompress data with limited output size.</fsummary> <desc> - <p>Opens a zlib stream.</p> + <p>Like <seealso marker="#inflate/2"><c>inflate/2</c></seealso>, + but returns once it has expanded beyond a small + implementation-defined threshold. It's useful when decompressing + untrusted input which could have been maliciously crafted to expand + until the system runs out of memory.</p> + <p>This function returns <c>{continue | finished, Output}</c>, where + <anno>Output</anno> is the data that was decompressed in this call. + New input can be queued up on each call if desired, and the function + will return <c>{finished, Output}</c> once all queued data has been + decompressed.</p> + <p>This function can introduce some output latency (reading + input without producing any output).</p> + <p>If a preset dictionary is required for further decompression, this + function returns a <c>need_dictionary</c> tuple. See + <seealso marker="#inflateSetDictionary/2"> + <c>inflateSetDictionary/2</c></seealso>) for details.</p> + <p>Example:</p> + <pre> +walk(Compressed, Handler) -> + Z = zlib:open(), + zlib:inflateInit(Z), + loop(Z, Handler, zlib:safeInflate(Z, Compressed)), + zlib:inflateEnd(Z), + zlib:close(Z). + +loop(Z, Handler, {continue, Output}) -> + Handler(Output), + loop(Z, Handler, zlib:safeInflate(Z, [])); +loop(Z, Handler, {finished, Output}) -> + Handler(Output).</pre> </desc> </func> @@ -609,6 +732,10 @@ unpack(Z, Compressed, Dict) -> <fsummary>Set buffer size.</fsummary> <desc> <p>Sets the intermediate buffer size.</p> + <warning> + <p>This function is deprecated and will be removed in a future + release.</p> + </warning> </desc> </func> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 521fc46b47..1b29065486 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -28,10 +28,22 @@ HIPE_ENABLED=@HIPE_ENABLED@ DTRACE_ENABLED=@DTRACE_ENABLED@ DTRACE_ENABLED_2STEP=@DTRACE_ENABLED_2STEP@ USE_VM_PROBES=@USE_VM_PROBES@ +FPE=@FPE@ LIBS = @LIBS@ Z_LIB=@Z_LIB@ NO_INLINE_FUNCTIONS=false -OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab beam/ops.tab +OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab \ +beam/ops.tab \ +beam/macros.tab \ +beam/instrs.tab \ +beam/arith_instrs.tab \ +beam/bif_instrs.tab \ +beam/bs_instrs.tab \ +beam/float_instrs.tab \ +beam/map_instrs.tab \ +beam/msg_instrs.tab \ +beam/select_instrs.tab \ +beam/trace_instrs.tab DEBUG_CFLAGS = @DEBUG_CFLAGS@ CONFIGURE_CFLAGS = @CFLAGS@ @@ -51,6 +63,28 @@ ARFLAGS=rc OMIT_OMIT_FP=no TYPE_LIBS= +PROFILE_COMPILER=@PROFILE_COMPILER@ +PROFILE_MARKER= +ifeq ($(PROFILE),generate) +PROFILE_MARKER=_pg +else +ifeq ($(PROFILE),use) +PROFILE_MARKER=_pu +endif +endif + +ifeq ($(PROFILE_COMPILER), gcc) +PROFILE_CORRECTION=@PROFILE_CORRECTION@ +PROFILE_GENERATE=-fprofile-generate +PROFILE_USE=-fprofile-use $(PROFILE_CORRECTION) +PROFILE_USE_DEPS=$(OBJDIR)/%_pu.gcda +endif +ifeq ($(PROFILE_COMPILER), clang) +PROFILE_GENERATE=-fprofile-instr-generate +PROFILE_USE=-fprofile-instr-use=$(OBJDIR)/default.profdata +PROFILE_USE_DEPS=$(OBJDIR)/default.profdata +endif + DIRTY_SCHEDULER_SUPPORT=@DIRTY_SCHEDULER_SUPPORT@ DIRTY_SCHEDULER_TEST=@DIRTY_SCHEDULER_TEST@ @@ -406,9 +440,20 @@ ifeq ($(TARGET), win32) EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll else EMULATOR_EXECUTABLE = beam$(TF_MARKER) +PROFILE_EXECUTABLE = beam.prof$(TF_MARKER) endif CS_EXECUTABLE = erl_child_setup$(TYPEMARKER) +ifeq ($(PROFILE), generate) +EMULATOR_EXECUTABLE = $(PROFILE_EXECUTABLE) +ifeq ($(PROFILE_COMPILER), gcc) +PROFILE_LDFLAGS = -fprofile-generate +endif +ifeq ($(PROFILE_COMPILER), clang) +PROFILE_LDFLAGS = -fprofile-instr-generate +endif +endif + # ---------------------------------------------------------------------- ifeq ($(ERLANG_OSTYPE), unix) @@ -529,10 +574,11 @@ DTRACE_HEADERS = endif ifdef HIPE_ENABLED -OPCODE_TABLES += hipe/hipe_ops.tab +OPCODE_TABLES += hipe/hipe_ops.tab hipe/hipe_instrs.tab endif $(TTF_DIR)/beam_cold.h \ +$(TTF_DIR)/beam_warm.h \ $(TTF_DIR)/beam_hot.h \ $(TTF_DIR)/beam_opcodes.c \ $(TTF_DIR)/beam_opcodes.h \ @@ -544,6 +590,7 @@ $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops -wordsize @EXTERNAL_WORD_SIZE@ \ -outdir $(TTF_DIR) \ -DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \ + -DNO_FPE_SIGNALS=$(if $filter(unreliable,$(FPE)),1,0) \ -emulator $(OPCODE_TABLES) && echo $? >$(TTF_DIR)/OPCODES-GENERATED GENERATE += $(TTF_DIR)/OPCODES-GENERATED @@ -674,16 +721,33 @@ $(OBJDIR)/beams.$(RES_EXT): $(TARGET)/beams.rc endif -ifneq ($(filter tile-%,$(TARGET)),) -$(OBJDIR)/beam_emu.o: beam/beam_emu.c - $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) \ - $(INCLUDES) -c $< -o $@ -else # Usually the same as the default rule, but certain platforms (e.g. win32) mix # different compilers $(OBJDIR)/beam_emu.o: beam/beam_emu.c $(V_EMU_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ -endif + +$(OBJDIR)/%_pg.o: beam/%.c + $(V_CC) $(PROFILE_GENERATE) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ +$(OBJDIR)/%_pu.o: beam/%.c $(PROFILE_USE_DEPS) + $(V_CC) $(PROFILE_USE) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/PROFILE: $(BINDIR)/$(PROFILE_EXECUTABLE) + $(V_at)echo " PROFILE ${PROFILE_EXECUTABLE}" + $(V_at)rm -f $(OBJDIR)/erl*.profraw + $(V_at)set -e; LLVM_PROFILE_FILE="$(OBJDIR)/erlc-%m.profraw" \ + ERL_FLAGS="-emu_type prof${TYPEMARKER} +S 1" $(ERLC) -DPGO \ + -o $(OBJDIR) test/estone_SUITE.erl > $(OBJDIR)/PROFILE_LOG + $(V_at)set -e; LLVM_PROFILE_FILE="$(OBJDIR)/erl-%m.profraw" \ + ERL_FLAGS="-emu_type prof${TYPEMARKER} +S 1" $(ERL) -pa $(OBJDIR) \ + -noshell -s estone_SUITE pgo -s init stop >> $(OBJDIR)/PROFILE_LOG + $(V_at)touch $@ + +$(OBJDIR)/%_pu.gcda: $(OBJDIR)/PROFILE + $(V_at)mv $(OBJDIR)/$*_pg.gcda $@ + $(V_at)touch $@ + +$(OBJDIR)/default.profdata: $(OBJDIR)/PROFILE + $(V_LLVM_PROFDATA) merge -output $@ $(OBJDIR)/*.profraw $(OBJDIR)/%.o: beam/%.c $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ @@ -745,15 +809,23 @@ $(ERL_TOP)/lib/%.beam: INIT_OBJS = $(OBJDIR)/erl_main.o $(PRELOAD_OBJ) +# -fprofile-correction is needed in order to use PGO on erl_process +# as multiple threads execute in that file. +ifeq ($(PROFILE_CORRECTION),) +PROFILE_OBJS = $(OBJDIR)/beam_emu.o +RUN_OBJS = $(OBJDIR)/erl_process.o +else +PROFILE_OBJS = $(OBJDIR)/beam_emu.o $(OBJDIR)/erl_process.o +endif + EMU_OBJS = \ - $(OBJDIR)/beam_emu.o $(OBJDIR)/beam_opcodes.o \ + $(OBJDIR)/beam_opcodes.o \ $(OBJDIR)/beam_load.o $(OBJDIR)/beam_bif_load.o \ $(OBJDIR)/beam_debug.o $(OBJDIR)/beam_bp.o \ - $(OBJDIR)/beam_catches.o \ - $(OBJDIR)/code_ix.o \ + $(OBJDIR)/beam_catches.o $(OBJDIR)/code_ix.o \ $(OBJDIR)/beam_ranges.o -RUN_OBJS = \ +RUN_OBJS += \ $(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \ $(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \ $(OBJDIR)/erl_bestfit_alloc.o $(OBJDIR)/erl_afit_alloc.o \ @@ -769,7 +841,7 @@ RUN_OBJS = \ $(OBJDIR)/utils.o $(OBJDIR)/bif.o \ $(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\ $(OBJDIR)/erl_debug.o $(OBJDIR)/erl_md5.o \ - $(OBJDIR)/erl_message.o $(OBJDIR)/erl_process.o \ + $(OBJDIR)/erl_message.o \ $(OBJDIR)/erl_process_dict.o $(OBJDIR)/erl_process_lock.o \ $(OBJDIR)/erl_port_task.o $(OBJDIR)/erl_arith.o \ $(OBJDIR)/time.o $(OBJDIR)/erl_time_sup.o \ @@ -796,17 +868,19 @@ RUN_OBJS = \ $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \ $(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o \ $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \ - $(OBJDIR)/erl_msacc.o $(OBJDIR)/erl_lock_flags.o + $(OBJDIR)/erl_msacc.o $(OBJDIR)/erl_lock_flags.o \ + $(OBJDIR)/erl_io_queue.o LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o -NIF_OBJS = $(OBJDIR)/erl_tracer_nif.o +NIF_OBJS = \ + $(OBJDIR)/erl_tracer_nif.o \ + $(OBJDIR)/zlib_nif.o ifeq ($(TARGET),win32) DRV_OBJS = \ $(OBJDIR)/registry_drv.o \ $(OBJDIR)/efile_drv.o \ $(OBJDIR)/inet_drv.o \ - $(OBJDIR)/zlib_drv.o \ $(OBJDIR)/ram_file_drv.o \ $(OBJDIR)/ttsl_drv.o OS_OBJS = \ @@ -836,7 +910,6 @@ OS_OBJS = \ DRV_OBJS = \ $(OBJDIR)/efile_drv.o \ $(OBJDIR)/inet_drv.o \ - $(OBJDIR)/zlib_drv.o \ $(OBJDIR)/ram_file_drv.o \ $(OBJDIR)/ttsl_drv.o endif @@ -910,21 +983,23 @@ ifdef HIPE_ENABLED EXTRA_BASE_OBJS += $(HIPE_OBJS) endif -BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) $(LTTNG_OBJS) +BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) \ + $(LTTNG_OBJS) $(DRV_OBJS) $(NIF_OBJS) -before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) $(NIF_OBJS) +PROF_OBJS = $(patsubst %.o,%$(PROFILE_MARKER).o,$(PROFILE_OBJS)) $(BASE_OBJS) + +OBJS = $(PROF_OBJS) -DTRACE_OBJS = ifdef DTRACE_ENABLED_2STEP -DTRACE_OBJS = $(OBJDIR)/erlang_dtrace.o -$(OBJDIR)/erlang_dtrace.o: $(before_DTrace_OBJS) $(TARGET)/erlang_dtrace.h +# The $(PROFILE_MARKER) is placed in the object file name in order to +# make sure we re-compile with the new object files for the profiled emulator +OBJS += $(OBJDIR)/erlang$(PROFILE_MARKER)_dtrace.o +$(OBJDIR)/erlang$(PROFILE_MARKER)_dtrace.o: $(PROF_OBJS) $(TARGET)/erlang_dtrace.h dtrace -G -C -Ibeam \ -s beam/erlang_dtrace.d \ - -o $@ $(before_DTrace_OBJS) + -o $@ $(PROF_OBJS) endif -OBJS = $(before_DTrace_OBJS) $(DTRACE_OBJS) - $(INIT_OBJS): $(TTF_DIR)/GENERATED $(OBJS): $(TTF_DIR)/GENERATED @@ -1016,8 +1091,8 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) else $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) - $(ld_verbose)$(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ - $(HIPEBEAMLDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) \ + $(ld_verbose)$(PURIFY) $(LD) -o $@ \ + $(HIPEBEAMLDFLAGS) $(PROFILE_LDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) \ $(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS) $(LIBS) endif diff --git a/erts/emulator/beam/arith_instrs.tab b/erts/emulator/beam/arith_instrs.tab new file mode 100644 index 0000000000..7c9cd47e28 --- /dev/null +++ b/erts/emulator/beam/arith_instrs.tab @@ -0,0 +1,399 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +OUTLINED_ARITH_2(Fail, Live, Name, BIF, Op1, Op2, Dst) { + Eterm result; + Uint live = $Live; + HEAVY_SWAPOUT; + reg[live] = $Op1; + reg[live+1] = $Op2; + result = erts_gc_$Name (c_p, reg, live); + HEAVY_SWAPIN; + ERTS_HOLE_CHECK(c_p); + if (ERTS_LIKELY(is_value(result))) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + $BIF_ERROR_ARITY_2($Fail, $BIF, reg[live], reg[live+1]); +} + + +i_plus := plus.fetch.execute; + +plus.head() { + Eterm PlusOp1, PlusOp2; +} + +plus.fetch(Op1, Op2) { + PlusOp1 = $Op1; + PlusOp2 = $Op2; +} + +plus.execute(Fail, Live, Dst) { + if (ERTS_LIKELY(is_both_small(PlusOp1, PlusOp2))) { + Sint i = signed_val(PlusOp1) + signed_val(PlusOp2); + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (ERTS_LIKELY(MY_IS_SSMALL(i))) { + $Dst = make_small(i); + $NEXT0(); + } + } + $OUTLINED_ARITH_2($Fail, $Live, mixed_plus, BIF_splus_2, PlusOp1, PlusOp2, $Dst); +} + +i_minus := minus.fetch.execute; + +minus.head() { + Eterm MinusOp1, MinusOp2; +} + +minus.fetch(Op1, Op2) { + MinusOp1 = $Op1; + MinusOp2 = $Op2; +} + +minus.execute(Fail, Live, Dst) { + if (ERTS_LIKELY(is_both_small(MinusOp1, MinusOp2))) { + Sint i = signed_val(MinusOp1) - signed_val(MinusOp2); + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (ERTS_LIKELY(MY_IS_SSMALL(i))) { + $Dst = make_small(i); + $NEXT0(); + } + } + $OUTLINED_ARITH_2($Fail, $Live, mixed_minus, BIF_sminus_2, MinusOp1, MinusOp2, $Dst); +} + +i_increment := increment.fetch.execute; + +increment.head() { + Eterm increment_reg_val; + Eterm increment_val; + Uint live; + Eterm result; +} + +increment.fetch(Src) { + increment_reg_val = $Src; +} + +increment.execute(IncrementVal, Live, Dst) { + increment_val = $IncrementVal; + if (ERTS_LIKELY(is_small(increment_reg_val))) { + Sint i = signed_val(increment_reg_val) + increment_val; + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (ERTS_LIKELY(MY_IS_SSMALL(i))) { + $Dst = make_small(i); + $NEXT0(); + } + } + live = $Live; + HEAVY_SWAPOUT; + reg[live] = increment_reg_val; + reg[live+1] = make_small(increment_val); + result = erts_gc_mixed_plus(c_p, reg, live); + HEAVY_SWAPIN; + ERTS_HOLE_CHECK(c_p); + if (ERTS_LIKELY(is_value(result))) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); + goto find_func_info; +} + +i_times(Fail, Live, Op1, Op2, Dst) { + Eterm op1 = $Op1; + Eterm op2 = $Op2; + $OUTLINED_ARITH_2($Fail, $Live, mixed_times, BIF_stimes_2, op1, op2, $Dst); +} + +i_m_div(Fail, Live, Op1, Op2, Dst) { + Eterm op1 = $Op1; + Eterm op2 = $Op2; + $OUTLINED_ARITH_2($Fail, $Live, mixed_div, BIF_div_2, op1, op2, $Dst); +} + +i_int_div(Fail, Live, Op1, Op2, Dst) { + Eterm op1 = $Op1; + Eterm op2 = $Op2; + if (ERTS_UNLIKELY(op2 == SMALL_ZERO)) { + c_p->freason = BADARITH; + $BIF_ERROR_ARITY_2($Fail, BIF_intdiv_2, op1, op2); + } else if (ERTS_LIKELY(is_both_small(op1, op2))) { + Sint ires = signed_val(op1) / signed_val(op2); + if (ERTS_LIKELY(MY_IS_SSMALL(ires))) { + $Dst = make_small(ires); + $NEXT0(); + } + } + $OUTLINED_ARITH_2($Fail, $Live, int_div, BIF_intdiv_2, op1, op2, $Dst); +} + +i_rem := rem.fetch.execute; + +rem.head() { + Eterm RemOp1, RemOp2; +} + +rem.fetch(Src1, Src2) { + RemOp1 = $Src1; + RemOp2 = $Src2; +} + +rem.execute(Fail, Live, Dst) { + if (ERTS_UNLIKELY(RemOp2 == SMALL_ZERO)) { + c_p->freason = BADARITH; + $BIF_ERROR_ARITY_2($Fail, BIF_rem_2, RemOp1, RemOp2); + } else if (ERTS_LIKELY(is_both_small(RemOp1, RemOp2))) { + $Dst = make_small(signed_val(RemOp1) % signed_val(RemOp2)); + $NEXT0(); + } else { + $OUTLINED_ARITH_2($Fail, $Live, int_rem, BIF_rem_2, RemOp1, RemOp2, $Dst); + } +} + +i_band := band.fetch.execute; + +band.head() { + Eterm BandOp1, BandOp2; +} + +band.fetch(Src1, Src2) { + BandOp1 = $Src1; + BandOp2 = $Src2; +} + +band.execute(Fail, Live, Dst) { + if (ERTS_LIKELY(is_both_small(BandOp1, BandOp2))) { + /* + * No need to untag -- TAG & TAG == TAG. + */ + $Dst = BandOp1 & BandOp2; + $NEXT0(); + } + $OUTLINED_ARITH_2($Fail, $Live, band, BIF_band_2, BandOp1, BandOp2, $Dst); +} + +i_bor(Fail, Live, Src1, Src2, Dst) { + if (ERTS_LIKELY(is_both_small($Src1, $Src2))) { + /* + * No need to untag -- TAG | TAG == TAG. + */ + $Dst = $Src1 | $Src2; + $NEXT0(); + } + $OUTLINED_ARITH_2($Fail, $Live, bor, BIF_bor_2, $Src1, $Src2, $Dst); +} + +i_bxor(Fail, Live, Src1, Src2, Dst) { + if (ERTS_LIKELY(is_both_small($Src1, $Src2))) { + /* + * TAG ^ TAG == 0. + * + * Therefore, we perform the XOR operation on the tagged values, + * and OR in the tag bits. + */ + $Dst = ($Src1 ^ $Src2) | make_small(0); + $NEXT0(); + } + $OUTLINED_ARITH_2($Fail, $Live, bxor, BIF_bxor_2, $Src1, $Src2, $Dst); +} + +i_bsl := shift.setup_bsl.execute; +i_bsr := shift.setup_bsr.execute; + +shift.head() { + Eterm Op1, Op2; + Sint shift_left_count; +} + +shift.setup_bsr(Src1, Src2) { + Op1 = $Src1; + Op2 = $Src2; + shift_left_count = 0; + if (ERTS_LIKELY(is_small(Op2))) { + shift_left_count = -signed_val(Op2); + } else if (is_big(Op2)) { + /* + * N bsr NegativeBigNum == N bsl MAX_SMALL + * N bsr PositiveBigNum == N bsl MIN_SMALL + */ + shift_left_count = make_small(bignum_header_is_neg(*big_val(Op2)) ? + MAX_SMALL : MIN_SMALL); + } +} + +shift.setup_bsl(Src1, Src2) { + Op1 = $Src1; + Op2 = $Src2; + shift_left_count = 0; + if (ERTS_LIKELY(is_small(Op2))) { + shift_left_count = signed_val(Op2); + } else if (is_big(Op2)) { + if (bignum_header_is_neg(*big_val(Op2))) { + /* + * N bsl NegativeBigNum is either 0 or -1, depending on + * the sign of N. Since we don't believe this case + * is common, do the calculation with the minimum + * amount of code. + */ + shift_left_count = MIN_SMALL; + } else if (is_integer(Op1)) { + /* + * N bsl PositiveBigNum is too large to represent. + */ + shift_left_count = MAX_SMALL; + } + } +} + +shift.execute(Fail, Live, Dst) { + Uint big_words_needed; + + if (ERTS_LIKELY(is_small(Op1))) { + Sint int_res = signed_val(Op1); + if (ERTS_UNLIKELY(shift_left_count == 0 || int_res == 0)) { + if (ERTS_UNLIKELY(is_not_integer(Op2))) { + goto shift_error; + } + if (int_res == 0) { + $Dst = Op1; + $NEXT0(); + } + } else if (shift_left_count < 0) { /* Right shift */ + Eterm bsr_res; + shift_left_count = -shift_left_count; + if (shift_left_count >= SMALL_BITS-1) { + bsr_res = (int_res < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; + } else { + bsr_res = make_small(int_res >> shift_left_count); + } + $Dst = bsr_res; + $NEXT0(); + } else if (shift_left_count < SMALL_BITS-1) { /* Left shift */ + if ((int_res > 0 && + ((~(Uint)0 << ((SMALL_BITS-1)-shift_left_count)) & int_res) == 0) || + ((~(Uint)0 << ((SMALL_BITS-1)-shift_left_count)) & ~int_res) == 0) { + $Dst = make_small(int_res << shift_left_count); + $NEXT0(); + } + } + big_words_needed = 1; /* big_size(small_to_big(Op1)) */ + goto big_shift; + } else if (is_big(Op1)) { + if (shift_left_count == 0) { + if (is_not_integer(Op2)) { + goto shift_error; + } + $Dst = Op1; + $NEXT0(); + } + big_words_needed = big_size(Op1); + + big_shift: + if (shift_left_count > 0) { /* Left shift. */ + big_words_needed += (shift_left_count / D_EXP); + } else { /* Right shift. */ + if (big_words_needed <= (-shift_left_count / D_EXP)) { + big_words_needed = 3; /* ??? */ + } else { + big_words_needed -= (-shift_left_count / D_EXP); + } + } + { + Eterm tmp_big[2]; + Sint big_need_size = BIG_NEED_SIZE(big_words_needed+1); + + /* + * Slightly conservative check the size to avoid + * allocating huge amounts of memory for bignums that + * clearly would overflow the arity in the header + * word. + */ + if (big_need_size-8 > BIG_ARITY_MAX) { + $SYSTEM_LIMIT($Fail); + } + $GC_TEST_PRESERVE(big_need_size+1, $Live, Op1); + if (is_small(Op1)) { + Op1 = small_to_big(signed_val(Op1), tmp_big); + } + Op1 = big_lshift(Op1, shift_left_count, HTOP); + if (is_big(Op1)) { + HTOP += bignum_header_arity(*HTOP) + 1; + } + HEAP_SPACE_VERIFIED(0); + if (ERTS_UNLIKELY(is_nil(Op1))) { + /* + * This result must have been only slighty larger + * than allowed since it wasn't caught by the + * previous test. + */ + $SYSTEM_LIMIT($Fail); + } + ERTS_HOLE_CHECK(c_p); + $REFRESH_GEN_DEST(); + $Dst = Op1; + $NEXT0(); + } + } + + /* + * One or more non-integer arguments. + */ + shift_error: + c_p->freason = BADARITH; + if ($Fail) { + $FAIL($Fail); + } else { + reg[0] = Op1; + reg[1] = Op2; + SWAPOUT; + if (I[0] == (BeamInstr) OpCode(i_bsl_ssjtd)) { + I = handle_error(c_p, I, reg, &bif_export[BIF_bsl_2]->info.mfa); + } else { + ASSERT(I[0] == (BeamInstr) OpCode(i_bsr_ssjtd)); + I = handle_error(c_p, I, reg, &bif_export[BIF_bsr_2]->info.mfa); + } + goto post_error_handling; + } +} + +i_int_bnot(Fail, Src, Live, Dst) { + Eterm bnot_val = $Src; + if (ERTS_LIKELY(is_small(bnot_val))) { + bnot_val = make_small(~signed_val(bnot_val)); + } else { + Uint live = $Live; + HEAVY_SWAPOUT; + reg[live] = bnot_val; + bnot_val = erts_gc_bnot(c_p, reg, live); + HEAVY_SWAPIN; + ERTS_HOLE_CHECK(c_p); + if (ERTS_UNLIKELY(is_nil(bnot_val))) { + $BIF_ERROR_ARITY_1($Fail, BIF_bnot_1, reg[live]); + } + $REFRESH_GEN_DEST(); + } + $Dst = bnot_val; +} diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index 1b691386eb..bbe1cb3e11 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -136,7 +136,7 @@ atom_hash(Atom* obj) while(len--) { v = *p++; /* latin1 clutch for r16 */ - if ((v & 0xFE) == 0xC2 && (*p & 0xC0) == 0x80) { + if (len && (v & 0xFE) == 0xC2 && (*p & 0xC0) == 0x80) { v = (v << 6) | (*p & 0x3F); p++; len--; } diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index a44d23b181..fc55b687d4 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -217,6 +217,8 @@ atom discard atom display_items atom dist atom dist_cmd +atom dist_ctrl_put_data +atom dist_data atom Div='/' atom div atom dlink diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index fa912e52e9..21e295c63a 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -489,6 +489,14 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case 'n': /* Nil */ erts_print(to, to_arg, "[]"); break; + case 'S': /* Register */ + { + Uint reg_type = (*ap & 1) ? 'y' : 'x'; + Uint n = ap[0] / sizeof(Eterm); + erts_print(to, to_arg, "%c(%d)", reg_type, n); + ap++; + break; + } case 's': /* Any source (tagged constant or register) */ tag = loader_tag(*ap); if (tag == LOADER_X_REG) { @@ -522,12 +530,13 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) } ap++; break; - case 'I': /* Untagged integer. */ - case 't': + case 't': /* Untagged integers */ + case 'I': + case 'W': switch (op) { - case op_i_gc_bif1_jIsId: - case op_i_gc_bif2_jIIssd: - case op_i_gc_bif3_jIIssd: + case op_i_gc_bif1_jWstd: + case op_i_gc_bif2_jWtssd: + case op_i_gc_bif3_jWtssd: { const ErtsGcBif* p; BifFunction gcf = (BifFunction) *ap; @@ -672,8 +681,8 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_jump_on_val_xfII: - case op_i_jump_on_val_yfII: + case op_i_jump_on_val_xfIW: + case op_i_jump_on_val_yfIW: { int n; for (n = ap[-2]; n > 0; n--) { @@ -696,9 +705,9 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) break; case op_i_put_tuple_xI: case op_i_put_tuple_yI: - case op_new_map_dII: - case op_update_map_assoc_jsdII: - case op_update_map_exact_jsdII: + case op_new_map_dtI: + case op_update_map_assoc_sdtI: + case op_update_map_exact_jsdtI: { int n = unpacked[-1]; @@ -718,7 +727,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_new_small_map_lit_dIq: + case op_i_new_small_map_lit_dtq: { Eterm *tp = tuple_val(unpacked[-1]); int n = arityval(*tp); diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 25e16764ab..55990362ff 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -62,17 +62,17 @@ #endif #ifdef ERTS_ENABLE_LOCK_CHECK -# define PROCESS_MAIN_CHK_LOCKS(P) \ -do { \ - if ((P)) \ - erts_proc_lc_chk_only_proc_main((P)); \ - ERTS_LC_ASSERT(!erts_thr_progress_is_blocking()); \ +# define PROCESS_MAIN_CHK_LOCKS(P) \ +do { \ + if ((P)) \ + erts_proc_lc_chk_only_proc_main((P)); \ + ERTS_LC_ASSERT(!erts_thr_progress_is_blocking()); \ } while (0) # define ERTS_REQ_PROC_MAIN_LOCK(P) \ -do { \ - if ((P)) \ - erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \ - __FILE__, __LINE__); \ +do { \ + if ((P)) \ + erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \ + __FILE__, __LINE__); \ } while (0) # define ERTS_UNREQ_PROC_MAIN_LOCK(P) \ do { \ @@ -107,10 +107,6 @@ do { \ # define CHECK_ARGS(T) #endif -#ifndef MAX -#define MAX(x, y) (((x) > (y)) ? (x) : (y)) -#endif - #define GET_BIF_MODULE(p) (p->info.mfa.module) #define GET_BIF_FUNCTION(p) (p->info.mfa.function) #define GET_BIF_ARITY(p) (p->info.mfa.arity) @@ -153,65 +149,7 @@ do { \ * Register target (X or Y register). */ -#define REG_TARGET_PTR(Target) (((Target) & 1) ? &yb(Target-1) : &xb(Target)) -#define REG_TARGET(Target) (*REG_TARGET_PTR(Target)) - -/* - * Store a result into a register given a destination descriptor. - */ - -#define StoreResult(Result, DestDesc) \ - do { \ - Eterm stb_reg; \ - stb_reg = (DestDesc); \ - CHECK_TERM(Result); \ - REG_TARGET(stb_reg) = (Result); \ - } while (0) - -/* - * Store a result into a register and execute the next instruction. - * Dst points to the word with a destination descriptor, which MUST - * be just before the next instruction. - */ - -#define StoreBifResult(Dst, Result) \ - do { \ - BeamInstr* stb_next; \ - Eterm stb_reg; \ - stb_reg = Arg(Dst); \ - I += (Dst) + 2; \ - stb_next = (BeamInstr *) *I; \ - CHECK_TERM(Result); \ - REG_TARGET(stb_reg) = (Result); \ - Goto(stb_next); \ - } while (0) - -#define ClauseFail() goto jump_f - -#define SAVE_CP(X) \ - do { \ - *(X) = make_cp(c_p->cp); \ - c_p->cp = 0; \ - } while(0) - -#define RESTORE_CP(X) SET_CP(c_p, (BeamInstr *) cp_val(*(X))) - -#define ISCATCHEND(instr) ((Eterm *) *(instr) == OpCode(catch_end_y)) - -#define BIF_ERROR_ARITY_1(Op1, BIF) \ - if (Arg(0) != 0) goto jump_f; \ - reg[0] = Op1; \ - SWAPOUT; \ - I = handle_error(c_p, I, reg, &bif_export[BIF]->info.mfa); \ - goto post_error_handling - -#define BIF_ERROR_ARITY_2(Op1, Op2, BIF) \ - if (Arg(0) != 0) goto jump_f; \ - reg[0] = Op1; \ - reg[1] = Op2; \ - SWAPOUT; \ - I = handle_error(c_p, I, reg, &bif_export[BIF]->info.mfa); \ - goto post_error_handling +#define REG_TARGET_PTR(Target) (((Target) & 1) ? &yb((Target)-1) : &xb(Target)) /* * Special Beam instructions. @@ -300,7 +238,8 @@ void** beam_ops; #define tb(N) (N) #define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N))) #define yb(N) (*(Eterm *) (((unsigned char *)E) + (N))) -#define fb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N))) +#define Sb(N) (*REG_TARGET_PTR(N)) +#define lb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N))) #define Qb(N) (N) #define Ib(N) (N) #define x(N) reg[N] @@ -308,151 +247,6 @@ void** beam_ops; #define r(N) x(N) /* - * Makes sure that there are StackNeed + HeapNeed + 1 words available - * on the combined heap/stack segment, then allocates StackNeed + 1 - * words on the stack and saves CP. - * - * M is number of live registers to preserve during garbage collection - */ - -#define AH(StackNeed, HeapNeed, M) \ - do { \ - int needed; \ - needed = (StackNeed) + 1; \ - if (E - HTOP < (needed + (HeapNeed))) { \ - SWAPOUT; \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), \ - reg, (M), FCALLS); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - SWAPIN; \ - } \ - E -= needed; \ - SAVE_CP(E); \ - } while (0) - -#define Allocate(Ns, Live) AH(Ns, 0, Live) - -#define AllocateZero(Ns, Live) \ - do { Eterm* ptr; \ - int i = (Ns); \ - AH(i, 0, Live); \ - for (ptr = E + i; ptr > E; ptr--) { \ - make_blank(*ptr); \ - } \ - } while (0) - -#define AllocateHeap(Ns, Nh, Live) AH(Ns, Nh, Live) - -#define AllocateHeapZero(Ns, Nh, Live) \ - do { Eterm* ptr; \ - int i = (Ns); \ - AH(i, Nh, Live); \ - for (ptr = E + i; ptr > E; ptr--) { \ - make_blank(*ptr); \ - } \ - } while (0) - -#define AllocateInit(Ns, Live, Y) \ - do { AH(Ns, 0, Live); make_blank(Y); } while (0) - -/* - * Like the AH macro, but allocates no additional heap space. - */ - -#define A(StackNeed, M) AH(StackNeed, 0, M) - -#define D(N) \ - RESTORE_CP(E); \ - E += (N) + 1; - - - -#define TestBinVHeap(VNh, Nh, Live) \ - do { \ - unsigned need = (Nh); \ - if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\ - SWAPOUT; \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - SWAPIN; \ - } \ - HEAP_SPACE_VERIFIED(need); \ - } while (0) - - - -/* - * Check if Nh words of heap are available; if not, do a garbage collection. - * Live is number of active argument registers to be preserved. - */ - -#define TestHeap(Nh, Live) \ - do { \ - unsigned need = (Nh); \ - if (E - HTOP < need) { \ - SWAPOUT; \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - SWAPIN; \ - } \ - HEAP_SPACE_VERIFIED(need); \ - } while (0) - -/* - * Check if Nh words of heap are available; if not, do a garbage collection. - * Live is number of active argument registers to be preserved. - * Takes special care to preserve Extra if a garbage collection occurs. - */ - -#define TestHeapPreserve(Nh, Live, Extra) \ - do { \ - unsigned need = (Nh); \ - if (E - HTOP < need) { \ - SWAPOUT; \ - reg[Live] = Extra; \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1, FCALLS); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - Extra = reg[Live]; \ - SWAPIN; \ - } \ - HEAP_SPACE_VERIFIED(need); \ - } while (0) - -#define TestHeapPutList(Need, Reg) \ - do { \ - TestHeap((Need), 1); \ - PutList(Reg, r(0), r(0)); \ - CHECK_TERM(r(0)); \ - } while (0) - -#define Init(N) make_blank(yb(N)) - -#define Init2(Y1, Y2) do { make_blank(Y1); make_blank(Y2); } while (0) -#define Init3(Y1, Y2, Y3) \ - do { make_blank(Y1); make_blank(Y2); make_blank(Y3); } while (0) - -#define MakeFun(FunP, NumFree) \ - do { \ - HEAVY_SWAPOUT; \ - r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \ - HEAVY_SWAPIN; \ - } while (0) - -#define PutTuple(Dst, Arity) \ - do { \ - Dst = make_tuple(HTOP); \ - pt_arity = (Arity); \ - } while (0) - -/* * Check that we haven't used the reductions and jump to function pointed to by * the I register. If we are out of reductions, do a context switch. */ @@ -518,20 +312,7 @@ void** beam_ops; # define Dispatchfun() DispatchMacroFun() #endif -#define Self(R) R = c_p->common.id -#define Node(R) R = erts_this_node->sysname - #define Arg(N) I[(N)+1] -#define Next(N) \ - I += (N) + 1; \ - ASSERT(VALID_INSTR(*I)); \ - Goto(*I) - -#define PreFetch(N, Dst) do { Dst = (BeamInstr *) *(I + N + 1); } while (0) -#define NextPF(N, Dst) \ - I += N + 1; \ - ASSERT(VALID_INSTR(Dst)); \ - Goto(Dst) #define GetR(pos, tr) \ do { \ @@ -548,97 +329,20 @@ void** beam_ops; CHECK_TERM(tr); \ } while (0) -#define GetArg1(N, Dst) GetR((N), Dst) - -#define GetArg2(N, Dst1, Dst2) \ - do { \ - GetR(N, Dst1); \ - GetR((N)+1, Dst2); \ - } while (0) - -#define PutList(H, T, Dst) \ - do { \ - HTOP[0] = (H); HTOP[1] = (T); \ - Dst = make_list(HTOP); \ - HTOP += 2; \ - } while (0) - -#define Swap(R1, R2) \ - do { \ - Eterm V = R1; \ - R1 = R2; \ - R2 = V; \ - } while (0) - -#define SwapTemp(R1, R2, Tmp) \ - do { \ - Eterm V = R1; \ - R1 = R2; \ - R2 = Tmp = V; \ - } while (0) - -#define Move(Src, Dst) Dst = (Src) - -#define Move2Par(S1, D1, S2, D2) \ - do { \ - Eterm V1, V2; \ - V1 = (S1); V2 = (S2); D1 = V1; D2 = V2; \ - } while (0) - -#define MoveShift(Src, SD, D) \ - do { \ - Eterm V; \ - V = Src; D = SD; SD = V; \ - } while (0) - -#define MoveDup(Src, D1, D2) \ - do { \ - D1 = D2 = (Src); \ - } while (0) - -#define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3) - -#define MoveWindow3(S1, S2, S3, D) \ - do { \ - Eterm xt0, xt1, xt2; \ - Eterm *y = &D; \ - xt0 = S1; \ - xt1 = S2; \ - xt2 = S3; \ - y[0] = xt0; \ - y[1] = xt1; \ - y[2] = xt2; \ - } while (0) - -#define MoveWindow4(S1, S2, S3, S4, D) \ - do { \ - Eterm xt0, xt1, xt2, xt3; \ - Eterm *y = &D; \ - xt0 = S1; \ - xt1 = S2; \ - xt2 = S3; \ - xt3 = S4; \ - y[0] = xt0; \ - y[1] = xt1; \ - y[2] = xt2; \ - y[3] = xt3; \ - } while (0) - -#define MoveWindow5(S1, S2, S3, S4, S5, D) \ - do { \ - Eterm xt0, xt1, xt2, xt3, xt4; \ - Eterm *y = &D; \ - xt0 = S1; \ - xt1 = S2; \ - xt2 = S3; \ - xt3 = S4; \ - xt4 = S5; \ - y[0] = xt0; \ - y[1] = xt1; \ - y[2] = xt2; \ - y[3] = xt3; \ - y[4] = xt4; \ - } while (0) +#define PUT_TERM_REG(term, desc) \ +do { \ + switch (loader_tag(desc)) { \ + case LOADER_X_REG: \ + x(loader_x_reg_index(desc)) = (term); \ + break; \ + case LOADER_Y_REG: \ + y(loader_y_reg_index(desc)) = (term); \ + break; \ + default: \ + ASSERT(0); \ + break; \ + } \ +} while(0) #define DispatchReturn \ do { \ @@ -653,409 +357,14 @@ do { \ } \ } while (0) -#define MoveReturn(Src) \ - x(0) = (Src); \ - I = c_p->cp; \ - ASSERT(VALID_INSTR(*c_p->cp)); \ - c_p->cp = 0; \ - CHECK_TERM(r(0)); \ - DispatchReturn - -#define DeallocateReturn(Deallocate) \ - do { \ - int words_to_pop = (Deallocate); \ - SET_I((BeamInstr *) cp_val(*E)); \ - E = ADD_BYTE_OFFSET(E, words_to_pop); \ - CHECK_TERM(r(0)); \ - DispatchReturn; \ - } while (0) - -#define MoveDeallocateReturn(Src, Deallocate) \ - x(0) = (Src); \ - DeallocateReturn(Deallocate) - -#define MoveCall(Src, CallDest, Size) \ - x(0) = (Src); \ - SET_CP(c_p, I+Size+1); \ - SET_I((BeamInstr *) CallDest); \ - Dispatch(); - -#define MoveCallLast(Src, CallDest, Deallocate) \ - x(0) = (Src); \ - RESTORE_CP(E); \ - E = ADD_BYTE_OFFSET(E, (Deallocate)); \ - SET_I((BeamInstr *) CallDest); \ - Dispatch(); - -#define MoveCallOnly(Src, CallDest) \ - x(0) = (Src); \ - SET_I((BeamInstr *) CallDest); \ - Dispatch(); - -#define MoveJump(Src) \ - r(0) = (Src); \ - SET_I((BeamInstr *) Arg(0)); \ - Goto(*I); - -#define GetList(Src, H, T) \ - do { \ - Eterm* tmp_ptr = list_val(Src); \ - Eterm hd, tl; \ - hd = CAR(tmp_ptr); \ - tl = CDR(tmp_ptr); \ - H = hd; T = tl; \ - } while (0) - -#define GetTupleElement(Src, Element, Dest) \ - do { \ - Eterm* src; \ - src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ - (Dest) = *src; \ - } while (0) - -#define GetTupleElement2(Src, Element, Dest) \ - do { \ - Eterm* src; \ - Eterm* dst; \ - Eterm E1, E2; \ - src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ - dst = &(Dest); \ - E1 = src[0]; \ - E2 = src[1]; \ - dst[0] = E1; \ - dst[1] = E2; \ - } while (0) - -#define GetTupleElement2Y(Src, Element, D1, D2) \ - do { \ - Eterm* src; \ - Eterm E1, E2; \ - src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ - E1 = src[0]; \ - E2 = src[1]; \ - D1 = E1; \ - D2 = E2; \ - } while (0) - -#define GetTupleElement3(Src, Element, Dest) \ - do { \ - Eterm* src; \ - Eterm* dst; \ - Eterm E1, E2, E3; \ - src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ - dst = &(Dest); \ - E1 = src[0]; \ - E2 = src[1]; \ - E3 = src[2]; \ - dst[0] = E1; \ - dst[1] = E2; \ - dst[2] = E3; \ - } while (0) - -#define EqualImmed(X, Y, Action) if (X != Y) { Action; } -#define NotEqualImmed(X, Y, Action) if (X == Y) { Action; } -#define EqualExact(X, Y, Action) if (!EQ(X,Y)) { Action; } -#define NotEqualExact(X, Y, Action) if (EQ(X,Y)) { Action; } -#define Equal(X, Y, Action) CMP_EQ_ACTION(X,Y,Action) -#define NotEqual(X, Y, Action) CMP_NE_ACTION(X,Y,Action) -#define IsLessThan(X, Y, Action) CMP_LT_ACTION(X,Y,Action) -#define IsGreaterEqual(X, Y, Action) CMP_GE_ACTION(X,Y,Action) - -#define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; } - -#define IsInteger(Src, Fail) if (is_not_integer(Src)) { Fail; } - -#define IsNumber(X, Fail) if (is_not_integer(X) && is_not_float(X)) { Fail; } - -#define IsAtom(Src, Fail) if (is_not_atom(Src)) { Fail; } - -#define IsIntegerAllocate(Src, Need, Alive, Fail) \ - if (is_not_integer(Src)) { Fail; } \ - A(Need, Alive) - -#define IsNil(Src, Fail) if (is_not_nil(Src)) { Fail; } - -#define IsList(Src, Fail) if (is_not_list(Src) && is_not_nil(Src)) { Fail; } - -#define IsNonemptyList(Src, Fail) if (is_not_list(Src)) { Fail; } - -#define IsNonemptyListAllocate(Src, Need, Alive, Fail) \ - if (is_not_list(Src)) { Fail; } \ - A(Need, Alive) - -#define IsNonemptyListTestHeap(Need, Alive, Fail) \ - if (is_not_list(x(0))) { Fail; } \ - TestHeap(Need, Alive) - -#define IsNonemptyListGetList(Src, H, T, Fail) \ - if (is_not_list(Src)) { \ - Fail; \ - } else { \ - Eterm* tmp_ptr = list_val(Src); \ - Eterm hd, tl; \ - hd = CAR(tmp_ptr); \ - tl = CDR(tmp_ptr); \ - H = hd; T = tl; \ - } - -#define IsTuple(X, Action) if (is_not_tuple(X)) Action - -#define IsArity(Pointer, Arity, Fail) \ - if (*tuple_val(Pointer) != (Arity)) { \ - Fail; \ - } - -#define IsMap(Src, Fail) if (!is_map(Src)) { Fail; } - -#define GetMapElement(Src, Key, Dst, Fail) \ - do { \ - Eterm _res = get_map_element(Src, Key); \ - if (is_non_value(_res)) { \ - Fail; \ - } \ - Dst = _res; \ - } while (0) - -#define GetMapElementHash(Src, Key, Hx, Dst, Fail) \ - do { \ - Eterm _res = get_map_element_hash(Src, Key, Hx); \ - if (is_non_value(_res)) { \ - Fail; \ - } \ - Dst = _res; \ - } while (0) - -#define IsFunction(X, Action) \ - do { \ - if ( !(is_any_fun(X)) ) { \ - Action; \ - } \ - } while (0) - -#define IsFunction2(F, A, Action) \ - do { \ - if (erl_is_function(c_p, F, A) != am_true ) { \ - Action; \ - } \ - } while (0) - #ifdef DEBUG -#define IsTupleOfArity(Src, Arityval, Fail) \ - do { \ - if (!(is_tuple(Src) && *tuple_val(Src) == Arityval)) { \ - Fail; \ - } \ - } while (0) +/* Better static type testing by the C compiler */ +# define BEAM_IS_TUPLE(Src) is_tuple(Src) #else -#define IsTupleOfArity(Src, Arityval, Fail) \ - do { \ - if (!(is_boxed(Src) && *tuple_val(Src) == Arityval)) { \ - Fail; \ - } \ - } while (0) +/* Better performance */ +# define BEAM_IS_TUPLE(Src) is_boxed(Src) #endif -#define IsTaggedTuple(Src,Arityval,Tag,Fail) \ - do { \ - if (!(is_tuple(Src) && \ - (tuple_val(Src))[0] == Arityval && \ - (tuple_val(Src))[1] == Tag)) { \ - Fail; \ - } \ - } while (0) - -#define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; } - -#define IsBinary(Src, Fail) \ - if (is_not_binary(Src) || binary_bitsize(Src) != 0) { Fail; } - -#define IsBitstring(Src, Fail) \ - if (is_not_binary(Src)) { Fail; } - -#if defined(ARCH_64) -#define BsSafeMul(A, B, Fail, Target) \ - do { Uint64 _res = (A) * (B); \ - if (_res / B != A) { Fail; } \ - Target = _res; \ - } while (0) -#else -#define BsSafeMul(A, B, Fail, Target) \ - do { Uint64 _res = (Uint64)(A) * (Uint64)(B); \ - if ((_res >> (8*sizeof(Uint))) != 0) { Fail; } \ - Target = _res; \ - } while (0) -#endif - -#define BsGetFieldSize(Bits, Unit, Fail, Target) \ - do { \ - Sint _signed_size; Uint _uint_size; \ - Uint temp_bits; \ - if (is_small(Bits)) { \ - _signed_size = signed_val(Bits); \ - if (_signed_size < 0) { Fail; } \ - _uint_size = (Uint) _signed_size; \ - } else { \ - if (!term_to_Uint(Bits, &temp_bits)) { Fail; } \ - _uint_size = temp_bits; \ - } \ - BsSafeMul(_uint_size, Unit, Fail, Target); \ - } while (0) - -#define BsGetUncheckedFieldSize(Bits, Unit, Fail, Target) \ - do { \ - Sint _signed_size; Uint _uint_size; \ - Uint temp_bits; \ - if (is_small(Bits)) { \ - _signed_size = signed_val(Bits); \ - if (_signed_size < 0) { Fail; } \ - _uint_size = (Uint) _signed_size; \ - } else { \ - if (!term_to_Uint(Bits, &temp_bits)) { Fail; } \ - _uint_size = (Uint) temp_bits; \ - } \ - Target = _uint_size * Unit; \ - } while (0) - -#define BsGetFloat2(Ms, Live, Sz, Flags, Dst, Fail) \ - do { \ - ErlBinMatchBuffer *_mb; \ - Eterm _result; Sint _size; \ - if (!is_small(Sz) || (_size = unsigned_val(Sz)) > 64) { Fail; } \ - _size *= ((Flags) >> 3); \ - TestHeap(FLOAT_SIZE_OBJECT, Live); \ - _mb = ms_matchbuffer(Ms); \ - LIGHT_SWAPOUT; \ - _result = erts_bs_get_float_2(c_p, _size, (Flags), _mb); \ - LIGHT_SWAPIN; \ - HEAP_SPACE_VERIFIED(0); \ - if (is_non_value(_result)) { Fail; } \ - else { Dst = _result; } \ - } while (0) - -#define BsGetBinaryImm_2(Ms, Live, Sz, Flags, Dst, Fail) \ - do { \ - ErlBinMatchBuffer *_mb; \ - Eterm _result; \ - TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), Live); \ - _mb = ms_matchbuffer(Ms); \ - LIGHT_SWAPOUT; \ - _result = erts_bs_get_binary_2(c_p, (Sz), (Flags), _mb); \ - LIGHT_SWAPIN; \ - HEAP_SPACE_VERIFIED(0); \ - if (is_non_value(_result)) { Fail; } \ - else { Dst = _result; } \ - } while (0) - -#define BsGetBinary_2(Ms, Live, Sz, Flags, Dst, Fail) \ - do { \ - ErlBinMatchBuffer *_mb; \ - Eterm _result; Uint _size; \ - BsGetFieldSize(Sz, ((Flags) >> 3), Fail, _size); \ - TestHeap(ERL_SUB_BIN_SIZE, Live); \ - _mb = ms_matchbuffer(Ms); \ - LIGHT_SWAPOUT; \ - _result = erts_bs_get_binary_2(c_p, _size, (Flags), _mb); \ - LIGHT_SWAPIN; \ - HEAP_SPACE_VERIFIED(0); \ - if (is_non_value(_result)) { Fail; } \ - else { Dst = _result; } \ - } while (0) - -#define BsGetBinaryAll_2(Ms, Live, Unit, Dst, Fail) \ - do { \ - ErlBinMatchBuffer *_mb; \ - Eterm _result; \ - TestHeap(ERL_SUB_BIN_SIZE, Live); \ - _mb = ms_matchbuffer(Ms); \ - if (((_mb->size - _mb->offset) % Unit) == 0) { \ - LIGHT_SWAPOUT; \ - _result = erts_bs_get_binary_all_2(c_p, _mb); \ - LIGHT_SWAPIN; \ - HEAP_SPACE_VERIFIED(0); \ - ASSERT(is_value(_result)); \ - Dst = _result; \ - } else { \ - HEAP_SPACE_VERIFIED(0); \ - Fail; } \ - } while (0) - -#define BsSkipBits2(Ms, Bits, Unit, Fail) \ - do { \ - ErlBinMatchBuffer *_mb; \ - size_t new_offset; \ - Uint _size; \ - _mb = ms_matchbuffer(Ms); \ - BsGetFieldSize(Bits, Unit, Fail, _size); \ - new_offset = _mb->offset + _size; \ - if (new_offset <= _mb->size) { _mb->offset = new_offset; } \ - else { Fail; } \ - } while (0) - -#define BsSkipBitsAll2(Ms, Unit, Fail) \ - do { \ - ErlBinMatchBuffer *_mb; \ - _mb = ms_matchbuffer(Ms); \ - if (((_mb->size - _mb->offset) % Unit) == 0) {_mb->offset = _mb->size; } \ - else { Fail; } \ - } while (0) - -#define BsSkipBitsImm2(Ms, Bits, Fail) \ - do { \ - ErlBinMatchBuffer *_mb; \ - size_t new_offset; \ - _mb = ms_matchbuffer(Ms); \ - new_offset = _mb->offset + (Bits); \ - if (new_offset <= _mb->size) { _mb->offset = new_offset; } \ - else { Fail; } \ - } while (0) - -#define NewBsPutIntegerImm(Sz, Flags, Src) \ - do { \ - if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), (Sz), (Flags)))) { goto badarg; } \ - } while (0) - -#define NewBsPutInteger(Sz, Flags, Src) \ - do { \ - Sint _size; \ - BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \ - if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), _size, (Flags)))) \ - { goto badarg; } \ - } while (0) - -#define NewBsPutFloatImm(Sz, Flags, Src) \ - do { \ - if (!erts_new_bs_put_float(c_p, (Src), (Sz), (Flags))) { goto badarg; } \ - } while (0) - -#define NewBsPutFloat(Sz, Flags, Src) \ - do { \ - Sint _size; \ - BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \ - if (!erts_new_bs_put_float(c_p, (Src), _size, (Flags))) { goto badarg; } \ - } while (0) - -#define NewBsPutBinary(Sz, Flags, Src) \ - do { \ - Sint _size; \ - BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \ - if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), _size))) { goto badarg; } \ - } while (0) - -#define NewBsPutBinaryImm(Sz, Src) \ - do { \ - if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), (Sz)))) { goto badarg; } \ - } while (0) - -#define NewBsPutBinaryAll(Src, Unit) \ - do { \ - if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2((Src), (Unit)))) { goto badarg; } \ - } while (0) - - -#define IsPort(Src, Fail) if (is_not_port(Src)) { Fail; } -#define IsPid(Src, Fail) if (is_not_pid(Src)) { Fail; } -#define IsRef(Src, Fail) if (is_not_ref(Src)) { Fail; } - /* * process_main() is already huge, so we want to avoid inlining * into it. Especially functions that are seldom used. @@ -1079,21 +388,21 @@ static BeamInstr* call_error_handler(Process* p, ErtsCodeMFA* mfa, Eterm* reg, Eterm func) NOINLINE; static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity, BeamInstr *I, Uint offs) NOINLINE; -static BeamInstr* apply(Process* p, Eterm module, Eterm function, - Eterm args, Eterm* reg, - BeamInstr *I, Uint offs) NOINLINE; +static BeamInstr* apply(Process* p, Eterm* reg, + BeamInstr *I, Uint offs) NOINLINE; static BeamInstr* call_fun(Process* p, int arity, Eterm* reg, Eterm args) NOINLINE; static BeamInstr* apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg) NOINLINE; static Eterm new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) NOINLINE; -static Eterm new_map(Process* p, Eterm* reg, BeamInstr* I) NOINLINE; -static Eterm new_small_map_lit(Process* p, Eterm* reg, Uint* n_exp, BeamInstr* I) NOINLINE; -static Eterm update_map_assoc(Process* p, Eterm* reg, - Eterm map, BeamInstr* I) NOINLINE; -static Eterm update_map_exact(Process* p, Eterm* reg, - Eterm map, BeamInstr* I) NOINLINE; +static Eterm new_map(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* ptr) NOINLINE; +static Eterm new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal, + Uint live, BeamInstr* ptr) NOINLINE; +static Eterm update_map_assoc(Process* p, Eterm* reg, Uint live, + Uint n, BeamInstr* new_p) NOINLINE; +static Eterm update_map_exact(Process* p, Eterm* reg, Uint live, + Uint n, Eterm* new_p) NOINLINE; static Eterm get_map_element(Eterm map, Eterm key); static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx); @@ -1125,6 +434,12 @@ init_emulator(void) # define REG_stop asm("%l3") # define REG_I asm("%l4") # define REG_fcalls asm("%l5") +#elif defined(__GNUC__) && defined(__amd64__) && !defined(DEBUG) +# define REG_xregs asm("%r12") +# define REG_htop +# define REG_stop asm("%r13") +# define REG_I asm("%rbx") +# define REG_fcalls asm("%r14") #else # define REG_xregs # define REG_htop @@ -1244,6 +559,13 @@ init_emulator(void) #define ERTS_DBG_CHK_REDS(P, FC) #endif +#ifdef NO_FPE_SIGNALS +# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT +# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR +#else +# define ERTS_NO_FPE_CHECK_INIT(p) +# define ERTS_NO_FPE_ERROR(p, a, b) +#endif /* * process_main() is called twice: @@ -1307,8 +629,6 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) #endif #endif - Eterm pt_arity; /* Used by do_put_tuple */ - Uint64 start_time = 0; /* Monitor long schedule */ BeamInstr* start_time_i = NULL; @@ -1325,7 +645,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) * Note: c_p->arity must be set to reflect the number of useful terms in * c_p->arg_reg before calling the scheduler. */ - if (!init_done) { + if (ERTS_UNLIKELY(!init_done)) { /* This should only be reached during the init phase when only the main * process is running. I.e. there is no race for init_done. */ @@ -1449,1914 +769,8 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) #ifdef NO_JUMP_TABLE switch (Go) { #endif -#include "beam_hot.h" - { - Eterm increment_reg_val; - Eterm increment_val; - Uint live; - Eterm result; - - OpCase(i_increment_rIId): - increment_reg_val = x(0); - I--; - goto do_increment; - - OpCase(i_increment_xIId): - increment_reg_val = xb(Arg(0)); - goto do_increment; - - OpCase(i_increment_yIId): - increment_reg_val = yb(Arg(0)); - goto do_increment; - - do_increment: - increment_val = Arg(1); - if (is_small(increment_reg_val)) { - Sint i = signed_val(increment_reg_val) + increment_val; - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - StoreBifResult(3, result); - } - } - - live = Arg(2); - HEAVY_SWAPOUT; - reg[live] = increment_reg_val; - reg[live+1] = make_small(increment_val); - result = erts_gc_mixed_plus(c_p, reg, live); - HEAVY_SWAPIN; - ERTS_HOLE_CHECK(c_p); - if (is_value(result)) { - StoreBifResult(3, result); - } - ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); - goto find_func_info; - } - -#define DO_OUTLINED_ARITH_2(name, Op1, Op2, BIF)\ - do { \ - Eterm result; \ - Uint live = Arg(1); \ - \ - HEAVY_SWAPOUT; \ - reg[live] = Op1; \ - reg[live+1] = Op2; \ - result = erts_gc_##name(c_p, reg, live); \ - HEAVY_SWAPIN; \ - ERTS_HOLE_CHECK(c_p); \ - if (is_value(result)) { \ - StoreBifResult(4, result); \ - } \ - BIF_ERROR_ARITY_2(reg[live], reg[live+1], BIF);\ - } while (0) - - { - Eterm PlusOp1, PlusOp2; - Eterm result; - - OpCase(i_plus_jIxxd): - PlusOp1 = xb(Arg(2)); - PlusOp2 = xb(Arg(3)); - goto do_plus; - - OpCase(i_plus_jIxyd): - PlusOp1 = xb(Arg(2)); - PlusOp2 = yb(Arg(3)); - goto do_plus; - - OpCase(i_plus_jIssd): - GetArg2(2, PlusOp1, PlusOp2); - goto do_plus; - - do_plus: - if (is_both_small(PlusOp1, PlusOp2)) { - Sint i = signed_val(PlusOp1) + signed_val(PlusOp2); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - StoreBifResult(4, result); - } - } - DO_OUTLINED_ARITH_2(mixed_plus, PlusOp1, PlusOp2, BIF_splus_2); - } - - { - Eterm MinusOp1, MinusOp2; - Eterm result; - - OpCase(i_minus_jIxxd): - MinusOp1 = xb(Arg(2)); - MinusOp2 = xb(Arg(3)); - goto do_minus; - - OpCase(i_minus_jIssd): - GetArg2(2, MinusOp1, MinusOp2); - goto do_minus; - - do_minus: - if (is_both_small(MinusOp1, MinusOp2)) { - Sint i = signed_val(MinusOp1) - signed_val(MinusOp2); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - StoreBifResult(4, result); - } - } - DO_OUTLINED_ARITH_2(mixed_minus, MinusOp1, MinusOp2, BIF_sminus_2); - } - - { - Eterm is_eq_exact_lit_val; - - OpCase(i_is_eq_exact_literal_fxc): - is_eq_exact_lit_val = xb(Arg(1)); - goto do_is_eq_exact_literal; - - OpCase(i_is_eq_exact_literal_fyc): - is_eq_exact_lit_val = yb(Arg(1)); - goto do_is_eq_exact_literal; - - do_is_eq_exact_literal: - if (!eq(Arg(2), is_eq_exact_lit_val)) { - ClauseFail(); - } - Next(3); - } - - { - Eterm is_ne_exact_lit_val; - - OpCase(i_is_ne_exact_literal_fxc): - is_ne_exact_lit_val = xb(Arg(1)); - goto do_is_ne_exact_literal; - - OpCase(i_is_ne_exact_literal_fyc): - is_ne_exact_lit_val = yb(Arg(1)); - goto do_is_ne_exact_literal; - - do_is_ne_exact_literal: - if (eq(Arg(2), is_ne_exact_lit_val)) { - ClauseFail(); - } - Next(3); - } - - OpCase(i_move_call_only_fc): { - r(0) = Arg(1); - } - /* FALL THROUGH */ - OpCase(i_call_only_f): { - SET_I((BeamInstr *) Arg(0)); - DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I)); - Dispatch(); - } - - OpCase(i_move_call_last_fPc): { - r(0) = Arg(2); - } - /* FALL THROUGH */ - OpCase(i_call_last_fP): { - RESTORE_CP(E); - E = ADD_BYTE_OFFSET(E, Arg(1)); - SET_I((BeamInstr *) Arg(0)); - DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I)); - Dispatch(); - } - - OpCase(i_move_call_cf): { - r(0) = Arg(0); - I++; - } - /* FALL THROUGH */ - OpCase(i_call_f): { - SET_CP(c_p, I+2); - SET_I((BeamInstr *) Arg(0)); - DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I)); - Dispatch(); - } - - OpCase(i_move_call_ext_last_ePc): { - r(0) = Arg(2); - } - /* FALL THROUGH */ - OpCase(i_call_ext_last_eP): - RESTORE_CP(E); - E = ADD_BYTE_OFFSET(E, Arg(1)); - - /* - * Note: The pointer to the export entry is never NULL; if the module - * is not loaded, it points to code which will invoke the error handler - * (see lb_call_error_handler below). - */ - DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); - Dispatchx(); - - OpCase(i_move_call_ext_ce): { - r(0) = Arg(0); - I++; - } - /* FALL THROUGH */ - OpCase(i_call_ext_e): - SET_CP(c_p, I+2); - DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); - Dispatchx(); - - OpCase(i_move_call_ext_only_ec): { - r(0) = Arg(1); - } - /* FALL THROUGH */ - OpCase(i_call_ext_only_e): - DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); - Dispatchx(); - - OpCase(init_y): { - BeamInstr *next; - - PreFetch(1, next); - make_blank(yb(Arg(0))); - NextPF(1, next); - } - - OpCase(i_trim_I): { - BeamInstr *next; - Uint words; - Uint cp; - - words = Arg(0); - cp = E[0]; - PreFetch(1, next); - E += words; - E[0] = cp; - NextPF(1, next); - } - - OpCase(move_x1_c): { - x(1) = Arg(0); - Next(1); - } - - OpCase(move_x2_c): { - x(2) = Arg(0); - Next(1); - } - - OpCase(return): { - SET_I(c_p->cp); - DTRACE_RETURN_FROM_PC(c_p); - /* - * We must clear the CP to make sure that a stale value do not - * create a false module dependcy preventing code upgrading. - * It also means that we can use the CP in stack backtraces. - */ - c_p->cp = 0; - CHECK_TERM(r(0)); - HEAP_SPACE_VERIFIED(0); - DispatchReturn; - } - - /* - * Send is almost a standard call-BIF with two arguments, except for: - * 1) It cannot be traced. - * 2) There is no pointer to the send_2 function stored in - * the instruction. - */ - - OpCase(send): { - BeamInstr *next; - Eterm result; - - if (!(FCALLS > 0 || FCALLS > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the bif */ - c_p->arity = 2; - c_p->current = NULL; - goto context_switch3; - } - - PRE_BIF_SWAPOUT(c_p); - c_p->fcalls = FCALLS - 1; - result = erl_send(c_p, r(0), x(1)); - PreFetch(0, next); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - HTOP = HEAP_TOP(c_p); - FCALLS = c_p->fcalls; - if (is_value(result)) { - r(0) = result; - CHECK_TERM(r(0)); - NextPF(0, next); - } else if (c_p->freason == TRAP) { - SET_CP(c_p, I+1); - SET_I(c_p->i); - SWAPIN; - Dispatch(); - } - goto find_func_info; - } - - { - Eterm element_index; - Eterm element_tuple; - - OpCase(i_element_jxsd): - element_tuple = xb(Arg(1)); - goto do_element; - - OpCase(i_element_jysd): - element_tuple = yb(Arg(1)); - goto do_element; - - do_element: - GetArg1(2, element_index); - if (is_small(element_index) && is_tuple(element_tuple)) { - Eterm* tp = tuple_val(element_tuple); - - if ((signed_val(element_index) >= 1) && - (signed_val(element_index) <= arityval(*tp))) { - Eterm result = tp[signed_val(element_index)]; - StoreBifResult(3, result); - } - } - c_p->freason = BADARG; - BIF_ERROR_ARITY_2(element_index, element_tuple, BIF_element_2); - } - - OpCase(badarg_j): - badarg: - c_p->freason = BADARG; - goto lb_Cl_error; - - { - Eterm fast_element_tuple; - - OpCase(i_fast_element_jxId): - fast_element_tuple = xb(Arg(1)); - goto do_fast_element; - - OpCase(i_fast_element_jyId): - fast_element_tuple = yb(Arg(1)); - goto do_fast_element; - - do_fast_element: - if (is_tuple(fast_element_tuple)) { - Eterm* tp = tuple_val(fast_element_tuple); - Eterm pos = Arg(2); /* Untagged integer >= 1 */ - if (pos <= arityval(*tp)) { - Eterm result = tp[pos]; - StoreBifResult(3, result); - } - } - c_p->freason = BADARG; - BIF_ERROR_ARITY_2(make_small(Arg(2)), fast_element_tuple, BIF_element_2); - } - - OpCase(catch_yf): - c_p->catches++; - yb(Arg(0)) = Arg(1); - Next(2); - - OpCase(catch_end_y): { - c_p->catches--; - make_blank(yb(Arg(0))); - if (is_non_value(r(0))) { - c_p->fvalue = NIL; - if (x(1) == am_throw) { - r(0) = x(2); - } else { - if (x(1) == am_error) { - SWAPOUT; - x(2) = add_stacktrace(c_p, x(2), x(3)); - SWAPIN; - } - /* only x(2) is included in the rootset here */ - if (E - HTOP < 3) { - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - SWAPIN; - } - r(0) = TUPLE2(HTOP, am_EXIT, x(2)); - HTOP += 3; - } - } - CHECK_TERM(r(0)); - Next(1); - } - - OpCase(try_end_y): { - c_p->catches--; - make_blank(yb(Arg(0))); - if (is_non_value(r(0))) { - c_p->fvalue = NIL; - r(0) = x(1); - x(1) = x(2); - x(2) = x(3); - } - Next(1); - } - - /* - * Skeleton for receive statement: - * - * recv_mark L1 Optional - * call make_ref/monitor Optional - * ... - * recv_set L1 Optional - * L1: <-------------------+ - * <-----------+ | - * | | - * loop_rec L2 ------+---+ | - * ... | | | - * remove_message | | | - * jump L3 | | | - * ... | | | - * loop_rec_end L1 --+ | | - * L2: <---------------+ | - * wait L1 -----------------+ or wait_timeout - * timeout - * - * L3: Code after receive... - * - * - */ - - OpCase(recv_mark_f): { - /* - * Save the current position in message buffer and the - * the label for the loop_rec/2 instruction for the - * the receive statement. - */ - c_p->msg.mark = (BeamInstr *) Arg(0); - c_p->msg.saved_last = c_p->msg.last; - Next(1); - } - - OpCase(i_recv_set): { - /* - * If the mark is valid (points to the loop_rec/2 - * instruction that follows), we know that the saved - * position points to the first message that could - * possibly be matched out. - * - * If the mark is invalid, we do nothing, meaning that - * we will look through all messages in the message queue. - */ - if (c_p->msg.mark == (BeamInstr *) (I+1)) { - c_p->msg.save = c_p->msg.saved_last; - } - I++; - /* Fall through to the loop_rec/2 instruction */ - } - - /* - * Pick up the next message and place it in x(0). - * If no message, jump to a wait or wait_timeout instruction. - */ - OpCase(i_loop_rec_f): - { - BeamInstr *next; - ErtsMessage* msgp; - - /* - * We need to disable GC while matching messages - * in the queue. This since messages with data outside - * the heap will be corrupted by a GC. - */ - ASSERT(!(c_p->flags & F_DELAY_GC)); - c_p->flags |= F_DELAY_GC; - - loop_rec__: - - PROCESS_MAIN_CHK_LOCKS(c_p); - - msgp = PEEK_MESSAGE(c_p); - - if (!msgp) { - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - /* Make sure messages wont pass exit signals... */ - if (ERTS_PROC_PENDING_EXIT(c_p)) { - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - SWAPOUT; - c_p->flags &= ~F_DELAY_GC; - c_p->arity = 0; - goto do_schedule; /* Will be rescheduled for exit */ - } - ERTS_MSGQ_MV_INQ2PRIVQ(c_p); - msgp = PEEK_MESSAGE(c_p); - if (msgp) - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - else - { - c_p->flags &= ~F_DELAY_GC; - SET_I((BeamInstr *) Arg(0)); - Goto(*I); /* Jump to a wait or wait_timeout instruction */ - } - } - if (is_non_value(ERL_MESSAGE_TERM(msgp))) { - SWAPOUT; /* erts_decode_dist_message() may write to heap... */ - if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { - /* - * A corrupt distribution message that we weren't able to decode; - * remove it... - */ - /* No swapin should be needed */ - ASSERT(HTOP == c_p->htop && E == c_p->stop); - /* TODO: Add DTrace probe for this bad message situation? */ - UNLINK_MESSAGE(c_p, msgp); - msgp->next = NULL; - erts_cleanup_messages(msgp); - goto loop_rec__; - } - SWAPIN; - } - PreFetch(1, next); - r(0) = ERL_MESSAGE_TERM(msgp); - NextPF(1, next); - } - - /* - * Remove a (matched) message from the message queue. - */ - OpCase(remove_message): { - BeamInstr *next; - ErtsMessage* msgp; - PROCESS_MAIN_CHK_LOCKS(c_p); - - ERTS_CHK_MBUF_SZ(c_p); - - PreFetch(0, next); - msgp = PEEK_MESSAGE(c_p); - - if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { - save_calls(c_p, &exp_receive); - } - if (ERL_MESSAGE_TOKEN(msgp) == NIL) { -#ifdef USE_VM_PROBES - if (DT_UTAG(c_p) != NIL) { - if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) { - SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag; - } else { - DT_UTAG(c_p) = NIL; - SEQ_TRACE_TOKEN(c_p) = NIL; - } - } else { -#endif - SEQ_TRACE_TOKEN(c_p) = NIL; -#ifdef USE_VM_PROBES - } - DT_UTAG_FLAGS(c_p) &= ~DT_UTAG_SPREADING; -#endif - } else if (ERL_MESSAGE_TOKEN(msgp) != am_undefined) { - Eterm msg; - SEQ_TRACE_TOKEN(c_p) = ERL_MESSAGE_TOKEN(msgp); -#ifdef USE_VM_PROBES - if (ERL_MESSAGE_TOKEN(msgp) == am_have_dt_utag) { - if (DT_UTAG(c_p) == NIL) { - DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp); - } - DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING; - } else { -#endif - ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p))); - ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5); - ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p))); - ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p))); - ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p))); - ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p))); - c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); - if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) { - c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); - } - msg = ERL_MESSAGE_TERM(msgp); - seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE, - c_p->common.id, c_p); -#ifdef USE_VM_PROBES - } -#endif - } -#ifdef USE_VM_PROBES - if (DTRACE_ENABLED(message_receive)) { - Eterm token2 = NIL; - DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); - Sint tok_label = 0; - Sint tok_lastcnt = 0; - Sint tok_serial = 0; - - dtrace_proc_str(c_p, receiver_name); - token2 = SEQ_TRACE_TOKEN(c_p); - if (have_seqtrace(token2)) { - tok_label = signed_val(SEQ_TRACE_T_LABEL(token2)); - tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2)); - tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2)); - } - DTRACE6(message_receive, - receiver_name, size_object(ERL_MESSAGE_TERM(msgp)), - c_p->msg.len - 1, tok_label, tok_lastcnt, tok_serial); - } -#endif - UNLINK_MESSAGE(c_p, msgp); - JOIN_MESSAGE(c_p); - CANCEL_TIMER(c_p); - - erts_save_message_in_proc(c_p, msgp); - c_p->flags &= ~F_DELAY_GC; - - if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) { - /* - * We want to GC soon but we leave a few - * reductions giving the message some time - * to turn into garbage. - */ - ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS); - } - - ERTS_DBG_CHK_REDS(c_p, FCALLS); - ERTS_CHK_MBUF_SZ(c_p); - - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - NextPF(0, next); - } - - /* - * Advance the save pointer to the next message (the current - * message didn't match), then jump to the loop_rec instruction. - */ - OpCase(loop_rec_end_f): { - - ASSERT(c_p->flags & F_DELAY_GC); - - SET_I((BeamInstr *) Arg(0)); - SAVE_MESSAGE(c_p); - if (FCALLS > 0 || FCALLS > neg_o_reds) { - FCALLS--; - goto loop_rec__; - } - - c_p->flags &= ~F_DELAY_GC; - c_p->i = I; - SWAPOUT; - c_p->arity = 0; - c_p->current = NULL; - goto do_schedule; - } - /* - * Prepare to wait for a message or a timeout, whichever occurs first. - * - * Note: In order to keep the compatibility between 32 and 64 bits - * emulators, only timeout values that can be represented in 32 bits - * (unsigned) or less are allowed. - */ - - - OpCase(i_wait_timeout_fs): { - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - - /* Fall through */ - } - OpCase(i_wait_timeout_locked_fs): { - Eterm timeout_value; - - /* - * If we have already set the timer, we must NOT set it again. Therefore, - * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. - */ - if (c_p->flags & (F_INSLPQUEUE | F_TIMO)) { - goto wait2; - } - GetArg1(1, timeout_value); - if (timeout_value != make_small(0)) { - - if (timeout_value == am_infinity) - c_p->flags |= F_TIMO; - else { - int tres = erts_set_proc_timer_term(c_p, timeout_value); - if (tres == 0) { - /* - * The timer routiner will set c_p->i to the value in - * c_p->def_arg_reg[0]. Note that it is safe to use this - * location because there are no living x registers in - * a receive statement. - */ - BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg; - *pi = I+3; - } - else { /* Wrong time */ - OpCase(i_wait_error_locked): { - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - /* Fall through */ - } - OpCase(i_wait_error): { - c_p->freason = EXC_TIMEOUT_VALUE; - goto find_func_info; - } - } - } - - /* - * Prepare to wait indefinitely for a new message to arrive - * (or the time set above if falling through from above). - * - * When a new message arrives, control will be transferred - * the loop_rec instruction (at label L1). In case of - * of timeout, control will be transferred to the timeout - * instruction following the wait_timeout instruction. - */ - - OpCase(wait_locked_f): - OpCase(wait_f): - - wait2: { - c_p->i = (BeamInstr *) Arg(0); /* L1 */ - SWAPOUT; - c_p->arity = 0; - - if (!ERTS_PTMR_IS_TIMED_OUT(c_p)) - erts_atomic32_read_band_relb(&c_p->state, - ~ERTS_PSFLG_ACTIVE); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - c_p->current = NULL; - goto do_schedule; - } - OpCase(wait_unlocked_f): { - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - goto wait2; - } - } - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - Next(2); - } - - OpCase(i_wait_timeout_fI): { - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - } - - OpCase(i_wait_timeout_locked_fI): - { - /* - * If we have already set the timer, we must NOT set it again. Therefore, - * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. - */ - if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) { - BeamInstr** p = (BeamInstr **) c_p->def_arg_reg; - *p = I+3; - erts_set_proc_timer_uword(c_p, Arg(1)); - } - goto wait2; - } - - /* - * A timeout has occurred. Reset the save pointer so that the next - * receive statement will examine the first message first. - */ - OpCase(timeout_locked): { - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - } - - OpCase(timeout): { - BeamInstr *next; - - PreFetch(0, next); - if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) { - trace_receive(c_p, am_clock_service, am_timeout, NULL); - } - if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { - save_calls(c_p, &exp_timeout); - } - c_p->flags &= ~F_TIMO; - JOIN_MESSAGE(c_p); - NextPF(0, next); - } - - { - Eterm select_val2; - - OpCase(i_select_tuple_arity2_yfAAff): - select_val2 = yb(Arg(0)); - goto do_select_tuple_arity2; - - OpCase(i_select_tuple_arity2_xfAAff): - select_val2 = xb(Arg(0)); - goto do_select_tuple_arity2; - - do_select_tuple_arity2: - if (is_not_tuple(select_val2)) { - goto select_val2_fail; - } - select_val2 = *tuple_val(select_val2); - goto do_select_val2; - - OpCase(i_select_val2_yfccff): - select_val2 = yb(Arg(0)); - goto do_select_val2; - - OpCase(i_select_val2_xfccff): - select_val2 = xb(Arg(0)); - goto do_select_val2; - - do_select_val2: - if (select_val2 == Arg(2)) { - I += 3; - } else if (select_val2 == Arg(3)) { - I += 4; - } - - select_val2_fail: - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - { - Eterm select_val; - - OpCase(i_select_tuple_arity_xfI): - select_val = xb(Arg(0)); - goto do_select_tuple_arity; - - OpCase(i_select_tuple_arity_yfI): - select_val = yb(Arg(0)); - goto do_select_tuple_arity; - - do_select_tuple_arity: - if (is_tuple(select_val)) { - select_val = *tuple_val(select_val); - goto do_linear_search; - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - - OpCase(i_select_val_lins_xfI): - select_val = xb(Arg(0)); - goto do_linear_search; - - OpCase(i_select_val_lins_yfI): - select_val = yb(Arg(0)); - goto do_linear_search; - - do_linear_search: { - BeamInstr *vs = &Arg(3); - int ix = 0; - - for(;;) { - if (vs[ix+0] >= select_val) { ix += 0; break; } - if (vs[ix+1] >= select_val) { ix += 1; break; } - ix += 2; - } - - if (vs[ix] == select_val) { - I += ix + Arg(2) + 2; - } - - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - OpCase(i_select_val_bins_xfI): - select_val = xb(Arg(0)); - goto do_binary_search; - - OpCase(i_select_val_bins_yfI): - select_val = yb(Arg(0)); - goto do_binary_search; - - do_binary_search: - { - struct Pairs { - BeamInstr val; - BeamInstr* addr; - }; - struct Pairs* low; - struct Pairs* high; - struct Pairs* mid; - int bdiff; /* int not long because the arrays aren't that large */ - - low = (struct Pairs *) &Arg(3); - high = low + Arg(2); - - /* The pointer subtraction (high-low) below must produce - * a signed result, because high could be < low. That - * requires the compiler to insert quite a bit of code. - * - * However, high will be > low so the result will be - * positive. We can use that knowledge to optimise the - * entire sequence, from the initial comparison to the - * computation of mid. - * - * -- Mikael Pettersson, Acumem AB - * - * Original loop control code: - * - * while (low < high) { - * mid = low + (high-low) / 2; - * - */ - while ((bdiff = (int)((char*)high - (char*)low)) > 0) { - unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Pairs)-1); - - mid = (struct Pairs*)((char*)low + boffset); - if (select_val < mid->val) { - high = mid; - } else if (select_val > mid->val) { - low = mid + 1; - } else { - SET_I(mid->addr); - Goto(*I); - } - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - } - - { - Eterm jump_on_val_zero_index; - - OpCase(i_jump_on_val_zero_yfI): - jump_on_val_zero_index = yb(Arg(0)); - goto do_jump_on_val_zero_index; - - OpCase(i_jump_on_val_zero_xfI): - jump_on_val_zero_index = xb(Arg(0)); - goto do_jump_on_val_zero_index; - - do_jump_on_val_zero_index: - if (is_small(jump_on_val_zero_index)) { - jump_on_val_zero_index = signed_val(jump_on_val_zero_index); - if (jump_on_val_zero_index < Arg(2)) { - SET_I((BeamInstr *) (&Arg(3))[jump_on_val_zero_index]); - Goto(*I); - } - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - { - Eterm jump_on_val_index; - - - OpCase(i_jump_on_val_yfII): - jump_on_val_index = yb(Arg(0)); - goto do_jump_on_val_index; - - OpCase(i_jump_on_val_xfII): - jump_on_val_index = xb(Arg(0)); - goto do_jump_on_val_index; - - do_jump_on_val_index: - if (is_small(jump_on_val_index)) { - jump_on_val_index = (Uint) (signed_val(jump_on_val_index) - Arg(3)); - if (jump_on_val_index < Arg(2)) { - SET_I((BeamInstr *) (&Arg(4))[jump_on_val_index]); - Goto(*I); - } - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - do_put_tuple: { - Eterm* hp = HTOP; - - *hp++ = make_arityval(pt_arity); - - do { - Eterm term = *I++; - switch (loader_tag(term)) { - case LOADER_X_REG: - *hp++ = x(loader_x_reg_index(term)); - break; - case LOADER_Y_REG: - *hp++ = y(loader_y_reg_index(term)); - break; - default: - *hp++ = term; - break; - } - } while (--pt_arity != 0); - HTOP = hp; - Goto(*I); - } - - OpCase(new_map_dII): { - Eterm res; - - HEAVY_SWAPOUT; - res = new_map(c_p, reg, I-1); - HEAVY_SWAPIN; - StoreResult(res, Arg(0)); - Next(3+Arg(2)); - } - - OpCase(i_new_small_map_lit_dIq): { - Eterm res; - Uint n; - - HEAVY_SWAPOUT; - res = new_small_map_lit(c_p, reg, &n, I-1); - HEAVY_SWAPIN; - StoreResult(res, Arg(0)); - Next(3+n); - } - -#define PUT_TERM_REG(term, desc) \ -do { \ - switch (loader_tag(desc)) { \ - case LOADER_X_REG: \ - x(loader_x_reg_index(desc)) = (term); \ - break; \ - case LOADER_Y_REG: \ - y(loader_y_reg_index(desc)) = (term); \ - break; \ - default: \ - ASSERT(0); \ - break; \ - } \ -} while(0) - - OpCase(i_get_map_elements_fsI): { - Eterm map; - BeamInstr *fs; - Uint sz, n; - - GetArg1(1, map); - - /* this instruction assumes Arg1 is a map, - * i.e. that it follows a test is_map if needed. - */ - - n = (Uint)Arg(2) / 3; - fs = &Arg(3); /* pattern fields and target registers */ - - if (is_flatmap(map)) { - flatmap_t *mp; - Eterm *ks; - Eterm *vs; - - mp = (flatmap_t *)flatmap_val(map); - sz = flatmap_get_size(mp); - - if (sz == 0) { - ClauseFail(); - } - - ks = flatmap_get_keys(mp); - vs = flatmap_get_values(mp); - - while(sz) { - if (EQ((Eterm) fs[0], *ks)) { - PUT_TERM_REG(*vs, fs[1]); - n--; - fs += 3; - /* no more values to fetch, we are done */ - if (n == 0) { - I = fs; - Next(-1); - } - } - ks++, sz--, vs++; - } - - ClauseFail(); - } else { - const Eterm *v; - Uint32 hx; - ASSERT(is_hashmap(map)); - while(n--) { - hx = fs[2]; - ASSERT(hx == hashmap_make_hash((Eterm)fs[0])); - if ((v = erts_hashmap_get(hx, (Eterm)fs[0], map)) == NULL) { - ClauseFail(); - } - PUT_TERM_REG(*v, fs[1]); - fs += 3; - } - I = fs; - Next(-1); - } - } -#undef PUT_TERM_REG - - OpCase(update_map_assoc_jsdII): { - Eterm res; - Eterm map; - - GetArg1(1, map); - HEAVY_SWAPOUT; - res = update_map_assoc(c_p, reg, map, I); - HEAVY_SWAPIN; - if (is_value(res)) { - StoreResult(res, Arg(2)); - Next(5+Arg(4)); - } else { - /* - * This can only happen if the code was compiled - * with the compiler in OTP 17. - */ - c_p->freason = BADMAP; - c_p->fvalue = map; - goto lb_Cl_error; - } - } - - OpCase(update_map_exact_jsdII): { - Eterm res; - Eterm map; - - GetArg1(1, map); - HEAVY_SWAPOUT; - res = update_map_exact(c_p, reg, map, I); - HEAVY_SWAPIN; - if (is_value(res)) { - StoreResult(res, Arg(2)); - Next(5+Arg(4)); - } else { - goto lb_Cl_error; - } - } - - - /* - * All guards with zero arguments have special instructions: - * self/0 - * node/0 - * - * All other guard BIFs take one or two arguments. - */ - - /* - * Guard BIF in head. On failure, ignore the error and jump - * to the code for the next clause. We don't support tracing - * of guard BIFs. - */ - - OpCase(bif1_fbsd): - { - ErtsBifFunc bf; - Eterm tmp_reg[1]; - Eterm result; - - GetArg1(2, tmp_reg[0]); - bf = (BifFunction) Arg(1); - ERTS_DBG_CHK_REDS(c_p, FCALLS); - c_p->fcalls = FCALLS; - PROCESS_MAIN_CHK_LOCKS(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(3, result); - } - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - - /* - * Guard BIF in body. It can fail like any BIF. No trace support. - */ - - OpCase(bif1_body_bsd): - { - ErtsBifFunc bf; - - Eterm tmp_reg[1]; - Eterm result; - - GetArg1(1, tmp_reg[0]); - bf = (ErtsBifFunc) Arg(0); - ERTS_DBG_CHK_REDS(c_p, FCALLS); - c_p->fcalls = FCALLS; - PROCESS_MAIN_CHK_LOCKS(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(2, result); - } - reg[0] = tmp_reg[0]; - SWAPOUT; - I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); - goto post_error_handling; - } - - OpCase(i_gc_bif1_jIsId): - { - typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); - GcBifFunction bf; - Eterm result; - Uint live = (Uint) Arg(3); - - GetArg1(2, x(live)); - bf = (GcBifFunction) Arg(1); - ERTS_DBG_CHK_REDS(c_p, FCALLS); - c_p->fcalls = FCALLS; - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, reg, live); - ERTS_CHK_MBUF_SZ(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - SWAPIN; - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(4, result); - } - if (Arg(0) != 0) { - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - x(0) = x(live); - I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); - goto post_error_handling; - } - - OpCase(i_gc_bif2_jIIssd): /* Note, one less parameter than the i_gc_bif1 - and i_gc_bif3 */ - { - typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); - GcBifFunction bf; - Eterm result; - Uint live = (Uint) Arg(2); - - GetArg2(3, x(live), x(live+1)); - /* - * XXX This calling convention does not make sense. 'live' - * should point out the first argument, not the second - * (i.e. 'live' should not be incremented below). - */ - live++; - bf = (GcBifFunction) Arg(1); - ERTS_DBG_CHK_REDS(c_p, FCALLS); - c_p->fcalls = FCALLS; - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, reg, live); - ERTS_CHK_MBUF_SZ(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - SWAPIN; - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(5, result); - } - if (Arg(0) != 0) { - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - live--; - x(0) = x(live); - x(1) = x(live+1); - I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); - goto post_error_handling; - } - - OpCase(i_gc_bif3_jIIssd): - { - typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); - GcBifFunction bf; - Eterm result; - Uint live = (Uint) Arg(2); - - x(live) = x(SCRATCH_X_REG); - GetArg2(3, x(live+1), x(live+2)); - /* - * XXX This calling convention does not make sense. 'live' - * should point out the first argument, not the third - * (i.e. 'live' should not be incremented below). - */ - live += 2; - bf = (GcBifFunction) Arg(1); - ERTS_DBG_CHK_REDS(c_p, FCALLS); - c_p->fcalls = FCALLS; - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, reg, live); - ERTS_CHK_MBUF_SZ(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - SWAPIN; - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(5, result); - } - if (Arg(0) != 0) { - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - live -= 2; - x(0) = x(live); - x(1) = x(live+1); - x(2) = x(live+2); - I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); - goto post_error_handling; - } - - /* - * Guards bifs and, or, xor in guards. - */ - OpCase(i_bif2_fbssd): - { - Eterm tmp_reg[2]; - ErtsBifFunc bf; - Eterm result; - - GetArg2(2, tmp_reg[0], tmp_reg[1]); - bf = (ErtsBifFunc) Arg(1); - ERTS_DBG_CHK_REDS(c_p, FCALLS); - c_p->fcalls = FCALLS; - PROCESS_MAIN_CHK_LOCKS(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(4, result); - } - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - - /* - * Guards bifs and, or, xor, relational operators in body. - */ - OpCase(i_bif2_body_bssd): - { - Eterm tmp_reg[2]; - ErtsBifFunc bf; - Eterm result; - - GetArg2(1, tmp_reg[0], tmp_reg[1]); - bf = (ErtsBifFunc) Arg(0); - PROCESS_MAIN_CHK_LOCKS(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_HOLE_CHECK(c_p); - if (is_value(result)) { - ASSERT(!is_CP(result)); - StoreBifResult(3, result); - } - reg[0] = tmp_reg[0]; - reg[1] = tmp_reg[1]; - SWAPOUT; - I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); - goto post_error_handling; - } - - /* - * 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_bif_e): - { - ErtsBifFunc bf; - Eterm result; - BeamInstr *next; - ErlHeapFragment *live_hf_end; - Export *export = (Export*)Arg(0); - - - if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the bif */ - c_p->arity = GET_BIF_ARITY(export); - c_p->current = &export->info.mfa; - goto context_switch3; - } - - ERTS_MSACC_SET_BIF_STATE_CACHED_X( - GET_BIF_MODULE(export), GET_BIF_ADDRESS(export)); - - bf = GET_BIF_ADDRESS(export); - - PRE_BIF_SWAPOUT(c_p); - ERTS_DBG_CHK_REDS(c_p, FCALLS); - c_p->fcalls = FCALLS - 1; - if (FCALLS <= 0) { - save_calls(c_p, export); - } - PreFetch(1, next); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - live_hf_end = c_p->mbuf; - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_HOLE_CHECK(c_p); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - if (ERTS_IS_GC_DESIRED(c_p)) { - Uint arity = GET_BIF_ARITY(export); - result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, reg, arity); - E = c_p->stop; - } - PROCESS_MAIN_CHK_LOCKS(c_p); - HTOP = HEAP_TOP(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - /* We have to update the cache if we are enabled in order - to make sure no book keeping is done after we disabled - msacc. We don't always do this as it is quite expensive. */ - if (ERTS_MSACC_IS_ENABLED_CACHED_X()) - ERTS_MSACC_UPDATE_CACHE_X(); - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - if (is_value(result)) { - r(0) = result; - CHECK_TERM(r(0)); - NextPF(1, next); - } else if (c_p->freason == TRAP) { - SET_CP(c_p, I+2); - SET_I(c_p->i); - SWAPIN; - Dispatch(); - } - - /* - * Error handling. SWAPOUT is not needed because it was done above. - */ - ASSERT(c_p->stop == E); - I = handle_error(c_p, I, reg, &export->info.mfa); - goto post_error_handling; - } - - /* - * Arithmetic operations. - */ - - OpCase(i_times_jIssd): - { - Eterm Op1, Op2; - GetArg2(2, Op1, Op2); - DO_OUTLINED_ARITH_2(mixed_times, Op1, Op2, BIF_stimes_2); - } - - OpCase(i_m_div_jIssd): - { - Eterm Op1, Op2; - GetArg2(2, Op1, Op2); - DO_OUTLINED_ARITH_2(mixed_div, Op1, Op2, BIF_div_2); - } - - OpCase(i_int_div_jIssd): - { - Eterm Op1, Op2; - - GetArg2(2, Op1, Op2); - if (Op2 == SMALL_ZERO) { - c_p->freason = BADARITH; - BIF_ERROR_ARITY_2(Op1, Op2, BIF_intdiv_2); - } else if (is_both_small(Op1, Op2)) { - Sint ires = signed_val(Op1) / signed_val(Op2); - if (MY_IS_SSMALL(ires)) { - Eterm result = make_small(ires); - StoreBifResult(4, result); - } - } - DO_OUTLINED_ARITH_2(int_div, Op1, Op2, BIF_intdiv_2); - } - - { - Eterm RemOp1, RemOp2; - - OpCase(i_rem_jIxxd): - RemOp1 = xb(Arg(2)); - RemOp2 = xb(Arg(3)); - goto do_rem; - - OpCase(i_rem_jIssd): - GetArg2(2, RemOp1, RemOp2); - goto do_rem; - - do_rem: - if (RemOp2 == SMALL_ZERO) { - c_p->freason = BADARITH; - BIF_ERROR_ARITY_2(RemOp1, RemOp2, BIF_rem_2); - } else if (is_both_small(RemOp1, RemOp2)) { - Eterm result = make_small(signed_val(RemOp1) % signed_val(RemOp2)); - StoreBifResult(4, result); - } else { - DO_OUTLINED_ARITH_2(int_rem, RemOp1, RemOp2, BIF_rem_2); - } - } - - { - Eterm BandOp1, BandOp2; - - OpCase(i_band_jIxcd): - BandOp1 = xb(Arg(2)); - BandOp2 = Arg(3); - goto do_band; - - OpCase(i_band_jIssd): - GetArg2(2, BandOp1, BandOp2); - goto do_band; - - do_band: - if (is_both_small(BandOp1, BandOp2)) { - /* - * No need to untag -- TAG & TAG == TAG. - */ - Eterm result = BandOp1 & BandOp2; - StoreBifResult(4, result); - } - DO_OUTLINED_ARITH_2(band, BandOp1, BandOp2, BIF_band_2); - } - - /* - * An error occurred in an arithmetic operation or test that could - * appear either in a head or in a body. - * In a head, execution should continue at failure address in Arg(0). - * In a body, Arg(0) == 0 and an exception should be raised. - */ - lb_Cl_error: { - if (Arg(0) != 0) { - OpCase(jump_f): { - jump_f: - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - } - ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); - goto find_func_info; - } - - OpCase(i_bor_jIssd): - { - Eterm Op1, Op2; - - GetArg2(2, Op1, Op2); - if (is_both_small(Op1, Op2)) { - /* - * No need to untag -- TAG | TAG == TAG. - */ - Eterm result = Op1 | Op2; - StoreBifResult(4, result); - } - DO_OUTLINED_ARITH_2(bor, Op1, Op2, BIF_bor_2); - } - - OpCase(i_bxor_jIssd): - { - Eterm Op1, Op2; - - GetArg2(2, Op1, Op2); - if (is_both_small(Op1, Op2)) { - /* - * TAG ^ TAG == 0. - * - * Therefore, we perform the XOR operation on the tagged values, - * and OR in the tag bits. - */ - Eterm result = (Op1 ^ Op2) | make_small(0); - StoreBifResult(4, result); - } - DO_OUTLINED_ARITH_2(bxor, Op1, Op2, BIF_bxor_2); - } - - { - Eterm Op1, Op2; - Sint i; - Sint ires; - Eterm* bigp; - Eterm tmp_big[2]; - - OpCase(i_bsr_jIssd): - GetArg2(2, Op1, Op2); - if (is_small(Op2)) { - i = -signed_val(Op2); - if (is_small(Op1)) { - goto small_shift; - } else if (is_big(Op1)) { - if (i == 0) { - StoreBifResult(4, Op1); - } - ires = big_size(Op1); - goto big_shift; - } - } else if (is_big(Op2)) { - /* - * N bsr NegativeBigNum == N bsl MAX_SMALL - * N bsr PositiveBigNum == N bsl MIN_SMALL - */ - Op2 = make_small(bignum_header_is_neg(*big_val(Op2)) ? - MAX_SMALL : MIN_SMALL); - goto do_bsl; - } - c_p->freason = BADARITH; - BIF_ERROR_ARITY_2(Op1, Op2, BIF_bsr_2); - - OpCase(i_bsl_jIssd): - GetArg2(2, Op1, Op2); - do_bsl: - if (is_small(Op2)) { - i = signed_val(Op2); - - if (is_small(Op1)) { - small_shift: - ires = signed_val(Op1); - - if (i == 0 || ires == 0) { - StoreBifResult(4, Op1); - } else if (i < 0) { /* Right shift */ - i = -i; - if (i >= SMALL_BITS-1) { - Op1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; - } else { - Op1 = make_small(ires >> i); - } - StoreBifResult(4, Op1); - } else if (i < SMALL_BITS-1) { /* Left shift */ - if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) || - ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) { - Op1 = make_small(ires << i); - StoreBifResult(4, Op1); - } - } - ires = 1; /* big_size(small_to_big(Op1)) */ - - big_shift: - if (i > 0) { /* Left shift. */ - ires += (i / D_EXP); - } else { /* Right shift. */ - if (ires <= (-i / D_EXP)) - ires = 3; /* ??? */ - else - ires -= (-i / D_EXP); - } - { - ires = BIG_NEED_SIZE(ires+1); - /* - * Slightly conservative check the size to avoid - * allocating huge amounts of memory for bignums that - * clearly would overflow the arity in the header - * word. - */ - if (ires-8 > BIG_ARITY_MAX) { - c_p->freason = SYSTEM_LIMIT; - goto lb_Cl_error; - } - TestHeapPreserve(ires+1, Arg(1), Op1); - if (is_small(Op1)) { - Op1 = small_to_big(signed_val(Op1), tmp_big); - } - bigp = HTOP; - Op1 = big_lshift(Op1, i, bigp); - if (is_big(Op1)) { - HTOP += bignum_header_arity(*HTOP) + 1; - } - HEAP_SPACE_VERIFIED(0); - if (is_nil(Op1)) { - /* - * This result must have been only slight larger - * than allowed since it wasn't caught by the - * previous test. - */ - c_p->freason = SYSTEM_LIMIT; - goto lb_Cl_error; - } - ERTS_HOLE_CHECK(c_p); - StoreBifResult(4, Op1); - } - } else if (is_big(Op1)) { - if (i == 0) { - StoreBifResult(4, Op1); - } - ires = big_size(Op1); - goto big_shift; - } - } else if (is_big(Op2)) { - if (bignum_header_is_neg(*big_val(Op2))) { - /* - * N bsl NegativeBigNum is either 0 or -1, depending on - * the sign of N. Since we don't believe this case - * is common, do the calculation with the minimum - * amount of code. - */ - Op2 = make_small(MIN_SMALL); - goto do_bsl; - } else if (is_small(Op1) || is_big(Op1)) { - /* - * N bsl PositiveBigNum is too large to represent. - */ - c_p->freason = SYSTEM_LIMIT; - goto lb_Cl_error; - } - /* Fall through if the left argument is not an integer. */ - } - c_p->freason = BADARITH; - BIF_ERROR_ARITY_2(Op1, Op2, BIF_bsl_2); - } - - OpCase(i_int_bnot_jsId): - { - Eterm bnot_val; - - GetArg1(1, bnot_val); - if (is_small(bnot_val)) { - bnot_val = make_small(~signed_val(bnot_val)); - } else { - Uint live = Arg(2); - HEAVY_SWAPOUT; - reg[live] = bnot_val; - bnot_val = erts_gc_bnot(c_p, reg, live); - HEAVY_SWAPIN; - ERTS_HOLE_CHECK(c_p); - if (is_nil(bnot_val)) { - BIF_ERROR_ARITY_1(reg[live], BIF_bnot_1); - } - } - StoreBifResult(3, bnot_val); - } - - OpCase(i_apply): { - BeamInstr *next; - HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg, NULL, 0); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, I+1); - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(i_apply_last_P): { - BeamInstr *next; - HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg, I, Arg(0)); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, (BeamInstr *) E[0]); - E = ADD_BYTE_OFFSET(E, Arg(0)); - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(i_apply_only): { - BeamInstr *next; - HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg, I, 0); - HEAVY_SWAPIN; - if (next != NULL) { - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(apply_I): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0), NULL, 0); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, I+2); - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(apply_last_IP): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0), I, Arg(1)); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, (BeamInstr *) E[0]); - E = ADD_BYTE_OFFSET(E, Arg(1)); - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(i_apply_fun): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = apply_fun(c_p, r(0), x(1), reg); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, I+1); - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - - OpCase(i_apply_fun_last_P): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = apply_fun(c_p, r(0), x(1), reg); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, (BeamInstr *) E[0]); - E = ADD_BYTE_OFFSET(E, Arg(0)); - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - - OpCase(i_apply_fun_only): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = apply_fun(c_p, r(0), x(1), reg); - HEAVY_SWAPIN; - if (next != NULL) { - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - - OpCase(i_call_fun_I): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, I+2); - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - - OpCase(i_call_fun_last_IP): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, (BeamInstr *) E[0]); - E = ADD_BYTE_OFFSET(E, Arg(1)); - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } +#include "beam_hot.h" #ifdef DEBUG /* @@ -3457,25 +871,12 @@ do { \ goto do_schedule1; } - OpCase(set_tuple_element_sdP): { - Eterm element; - Eterm tuple; - BeamInstr *next; - Eterm* p; - - PreFetch(3, next); - GetArg1(0, element); - tuple = REG_TARGET(Arg(1)); - ASSERT(is_tuple(tuple)); - p = (Eterm *) ((unsigned char *) tuple_val(tuple) + Arg(2)); - *p = element; - NextPF(3, next); - } +#include "beam_warm.h" OpCase(normal_exit): { SWAPOUT; c_p->freason = EXC_NORMAL; - c_p->arity = 0; /* In case this process will never be garbed again. */ + c_p->arity = 0; /* In case this process will ever be garbed again. */ ERTS_UNREQ_PROC_MAIN_LOCK(c_p); erts_do_exit_process(c_p, am_normal); ERTS_REQ_PROC_MAIN_LOCK(c_p); @@ -3489,32 +890,6 @@ do { \ goto do_schedule; } - OpCase(i_raise): { - Eterm raise_trace = x(2); - Eterm raise_value = x(1); - struct StackTrace *s; - - c_p->fvalue = raise_value; - c_p->ftrace = raise_trace; - s = get_trace_from_exc(raise_trace); - if (s == NULL) { - c_p->freason = EXC_ERROR; - } else { - c_p->freason = PRIMARY_EXCEPTION(s->freason); - } - goto find_func_info; - } - - { - Eterm badmatch_val; - - OpCase(badmatch_x): - badmatch_val = xb(Arg(0)); - c_p->fvalue = badmatch_val; - c_p->freason = BADMATCH; - } - /* Fall through here */ - find_func_info: { SWAPOUT; I = handle_error(c_p, I, reg, NULL); @@ -3555,192 +930,6 @@ do { \ } } - { - Eterm nif_bif_result; - Eterm bif_nif_arity; - - OpCase(call_nif): - { - /* - * call_nif is always first instruction in function: - * - * I[-3]: Module - * I[-2]: Function - * I[-1]: Arity - * I[0]: &&call_nif - * I[1]: Function pointer to NIF function - * I[2]: Pointer to erl_module_nif - * I[3]: Function pointer to dirty NIF - * - * This layout is determined by the NifExport struct - */ - BifFunction vbf; - ErlHeapFragment *live_hf_end; - ErtsCodeMFA *codemfa; - - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); - - codemfa = erts_code_to_codemfa(I); - - c_p->current = codemfa; /* current and vbf set to please handle_error */ - - DTRACE_NIF_ENTRY(c_p, codemfa); - - HEAVY_SWAPOUT; - - PROCESS_MAIN_CHK_LOCKS(c_p); - bif_nif_arity = codemfa->arity; - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - { - typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); - NifF* fp = vbf = (NifF*) I[1]; - struct enif_environment_t env; - ASSERT(c_p->scheduler_data); - live_hf_end = c_p->mbuf; - ERTS_CHK_MBUF_SZ(c_p); - erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL); - nif_bif_result = (*fp)(&env, bif_nif_arity, reg); - if (env.exception_thrown) - nif_bif_result = THE_NON_VALUE; - erts_post_nif(&env); - ERTS_CHK_MBUF_SZ(c_p); - - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - ASSERT(!env.exiting); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - } - - DTRACE_NIF_RETURN(c_p, codemfa); - goto apply_bif_or_nif_epilogue; - - OpCase(apply_bif): - /* - * At this point, I points to the code[0] in the export entry for - * the BIF: - * - * code[-3]: Module - * code[-2]: Function - * code[-1]: Arity - * code[0]: &&apply_bif - * code[1]: Function pointer to BIF function - */ - - if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the bif */ - goto context_switch; - } - - codemfa = erts_code_to_codemfa(I); - - ERTS_MSACC_SET_BIF_STATE_CACHED_X(codemfa->module, (BifFunction)Arg(0)); - - - /* In case we apply process_info/1,2 or load_nif/1 */ - c_p->current = codemfa; - c_p->i = I; /* In case we apply check_process_code/2. */ - c_p->arity = 0; /* To allow garbage collection on ourselves - * (check_process_code/2). - */ - DTRACE_BIF_ENTRY(c_p, codemfa); - - SWAPOUT; - ERTS_DBG_CHK_REDS(c_p, FCALLS - 1); - c_p->fcalls = FCALLS - 1; - vbf = (BifFunction) Arg(0); - PROCESS_MAIN_CHK_LOCKS(c_p); - bif_nif_arity = codemfa->arity; - ASSERT(bif_nif_arity <= 4); - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - { - ErtsBifFunc bf = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - live_hf_end = c_p->mbuf; - ERTS_CHK_MBUF_SZ(c_p); - nif_bif_result = (*bf)(c_p, reg, I); - ERTS_CHK_MBUF_SZ(c_p); - 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); - } - /* We have to update the cache if we are enabled in order - to make sure no book keeping is done after we disabled - msacc. We don't always do this as it is quite expensive. */ - if (ERTS_MSACC_IS_ENABLED_CACHED_X()) - ERTS_MSACC_UPDATE_CACHE_X(); - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - DTRACE_BIF_RETURN(c_p, codemfa); - - apply_bif_or_nif_epilogue: - ERTS_REQ_PROC_MAIN_LOCK(c_p); - ERTS_HOLE_CHECK(c_p); - if (ERTS_IS_GC_DESIRED(c_p)) { - nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, - nif_bif_result, - reg, bif_nif_arity); - } - SWAPIN; /* There might have been a garbage collection. */ - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(nif_bif_result)) { - r(0) = nif_bif_result; - CHECK_TERM(r(0)); - SET_I(c_p->cp); - c_p->cp = 0; - Goto(*I); - } else if (c_p->freason == TRAP) { - SET_I(c_p->i); - if (c_p->flags & F_HIBERNATE_SCHED) { - c_p->flags &= ~F_HIBERNATE_SCHED; - goto do_schedule; - } - Dispatch(); - } - I = handle_error(c_p, c_p->cp, reg, c_p->current); - goto post_error_handling; - } - } - - OpCase(i_get_sd): - { - Eterm arg; - Eterm result; - - GetArg1(0, arg); - result = erts_pd_hash_get(c_p, arg); - StoreBifResult(1, result); - } - - OpCase(i_get_hash_cId): - { - Eterm arg; - Eterm result; - - GetArg1(0, arg); - result = erts_pd_hash_get_with_hx(c_p, Arg(1), arg); - StoreBifResult(2, result); - } - - { - Eterm case_end_val; - - OpCase(case_end_x): - case_end_val = xb(Arg(0)); - c_p->fvalue = case_end_val; - c_p->freason = EXC_CASE_CLAUSE; - goto find_func_info; - } - - OpCase(if_end): - c_p->freason = EXC_IF_CLAUSE; - goto find_func_info; - OpCase(i_func_info_IaaI): { ErtsCodeInfo *ci = (ErtsCodeInfo*)I; c_p->freason = EXC_FUNCTION_CLAUSE; @@ -3748,1382 +937,8 @@ do { \ goto handle_error; } - OpCase(try_case_end_s): - { - Eterm try_case_end_val; - GetArg1(0, try_case_end_val); - c_p->fvalue = try_case_end_val; - c_p->freason = EXC_TRY_CLAUSE; - goto find_func_info; - } - - /* - * Construction of binaries using new instructions. - */ - { - Eterm new_binary; - Eterm num_bits_term; - Uint num_bits; - Uint alloc; - Uint num_bytes; - - OpCase(i_bs_init_bits_heap_IIIx): { - num_bits = Arg(0); - alloc = Arg(1); - I++; - goto do_bs_init_bits_known; - } - - OpCase(i_bs_init_bits_IIx): { - num_bits = Arg(0); - alloc = 0; - goto do_bs_init_bits_known; - } - - OpCase(i_bs_init_bits_fail_heap_sIjIx): { - GetArg1(0, num_bits_term); - alloc = Arg(1); - I += 2; - goto do_bs_init_bits; - } - - OpCase(i_bs_init_bits_fail_yjIx): { - num_bits_term = yb(Arg(0)); - I++; - alloc = 0; - goto do_bs_init_bits; - } - OpCase(i_bs_init_bits_fail_xjIx): { - num_bits_term = xb(Arg(0)); - I++; - alloc = 0; - /* FALL THROUGH */ - } - - /* num_bits_term = Term for number of bits to build (small/big) - * alloc = Number of words to allocate on heap - * Operands: Fail Live Dst - */ - - do_bs_init_bits: - if (is_small(num_bits_term)) { - Sint size = signed_val(num_bits_term); - if (size < 0) { - goto badarg; - } - num_bits = (Uint) size; - } else { - Uint bits; - - if (!term_to_Uint(num_bits_term, &bits)) { - c_p->freason = bits; - goto lb_Cl_error; - - } - num_bits = (Eterm) bits; - } - - /* num_bits = Number of bits to build - * alloc = Number of extra words to allocate on heap - * Operands: NotUsed Live Dst - */ - do_bs_init_bits_known: - num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3; - if (num_bits & 7) { - alloc += ERL_SUB_BIN_SIZE; - } - if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { - alloc += heap_bin_size(num_bytes); - } else { - alloc += PROC_BIN_SIZE; - } - TestHeap(alloc, Arg(1)); - - /* num_bits = Number of bits to build - * num_bytes = Number of bytes to allocate in the binary - * alloc = Total number of words to allocate on heap - * Operands: NotUsed NotUsed Dst - */ - if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { - ErlHeapBin* hb; - - erts_bin_offset = 0; - erts_writable_bin = 0; - hb = (ErlHeapBin *) HTOP; - HTOP += heap_bin_size(num_bytes); - hb->thing_word = header_heap_bin(num_bytes); - hb->size = num_bytes; - erts_current_bin = (byte *) hb->data; - new_binary = make_binary(hb); - - do_bits_sub_bin: - if (num_bits & 7) { - ErlSubBin* sb; - - sb = (ErlSubBin *) HTOP; - HTOP += ERL_SUB_BIN_SIZE; - sb->thing_word = HEADER_SUB_BIN; - sb->size = num_bytes - 1; - sb->bitsize = num_bits & 7; - sb->offs = 0; - sb->bitoffs = 0; - sb->is_writable = 0; - sb->orig = new_binary; - new_binary = make_binary(sb); - } - HEAP_SPACE_VERIFIED(0); - xb(Arg(2)) = new_binary; - Next(3); - } else { - Binary* bptr; - ProcBin* pb; - - erts_bin_offset = 0; - erts_writable_bin = 0; - - /* - * Allocate the binary struct itself. - */ - bptr = erts_bin_nrml_alloc(num_bytes); - erts_current_bin = (byte *) bptr->orig_bytes; - - /* - * Now allocate the ProcBin on the heap. - */ - pb = (ProcBin *) HTOP; - HTOP += PROC_BIN_SIZE; - pb->thing_word = HEADER_PROC_BIN; - pb->size = num_bytes; - pb->next = MSO(c_p).first; - MSO(c_p).first = (struct erl_off_heap_header*) pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - OH_OVERHEAD(&(MSO(c_p)), pb->size / sizeof(Eterm)); - new_binary = make_binary(pb); - goto do_bits_sub_bin; - } - } - - { - Eterm BsOp1, BsOp2; - - OpCase(i_bs_init_fail_heap_sIjIx): { - GetArg1(0, BsOp1); - BsOp2 = Arg(1); - I += 2; - goto do_bs_init; - } - - OpCase(i_bs_init_fail_yjIx): { - BsOp1 = yb(Arg(0)); - BsOp2 = 0; - I++; - goto do_bs_init; - } - - OpCase(i_bs_init_fail_xjIx): { - BsOp1 = xb(Arg(0)); - BsOp2 = 0; - I++; - } - /* FALL THROUGH */ - do_bs_init: - if (is_small(BsOp1)) { - Sint size = signed_val(BsOp1); - if (size < 0) { - goto badarg; - } - BsOp1 = (Eterm) size; - } else { - Uint bytes; - - if (!term_to_Uint(BsOp1, &bytes)) { - c_p->freason = bytes; - goto lb_Cl_error; - } - if ((bytes >> (8*sizeof(Uint)-3)) != 0) { - goto system_limit; - } - BsOp1 = (Eterm) bytes; - } - if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) { - goto do_heap_bin_alloc; - } else { - goto do_proc_bin_alloc; - } - - - OpCase(i_bs_init_heap_IIIx): { - BsOp1 = Arg(0); - BsOp2 = Arg(1); - I++; - goto do_proc_bin_alloc; - } - - OpCase(i_bs_init_IIx): { - BsOp1 = Arg(0); - BsOp2 = 0; - } - /* FALL THROUGH */ - do_proc_bin_alloc: { - Binary* bptr; - ProcBin* pb; - - erts_bin_offset = 0; - erts_writable_bin = 0; - TestBinVHeap(BsOp1 / sizeof(Eterm), - BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1)); - - /* - * Allocate the binary struct itself. - */ - bptr = erts_bin_nrml_alloc(BsOp1); - erts_current_bin = (byte *) bptr->orig_bytes; - - /* - * Now allocate the ProcBin on the heap. - */ - pb = (ProcBin *) HTOP; - HTOP += PROC_BIN_SIZE; - pb->thing_word = HEADER_PROC_BIN; - pb->size = BsOp1; - pb->next = MSO(c_p).first; - MSO(c_p).first = (struct erl_off_heap_header*) pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - - OH_OVERHEAD(&(MSO(c_p)), BsOp1 / sizeof(Eterm)); - - xb(Arg(2)) = make_binary(pb); - Next(3); - } - - OpCase(i_bs_init_heap_bin_heap_IIIx): { - BsOp1 = Arg(0); - BsOp2 = Arg(1); - I++; - goto do_heap_bin_alloc; - } - - OpCase(i_bs_init_heap_bin_IIx): { - BsOp1 = Arg(0); - BsOp2 = 0; - } - /* Fall through */ - do_heap_bin_alloc: - { - ErlHeapBin* hb; - Uint bin_need; - - bin_need = heap_bin_size(BsOp1); - erts_bin_offset = 0; - erts_writable_bin = 0; - TestHeap(bin_need+BsOp2+ERL_SUB_BIN_SIZE, Arg(1)); - hb = (ErlHeapBin *) HTOP; - HTOP += bin_need; - hb->thing_word = header_heap_bin(BsOp1); - hb->size = BsOp1; - erts_current_bin = (byte *) hb->data; - BsOp1 = make_binary(hb); - xb(Arg(2)) = BsOp1; - Next(3); - } - } - - OpCase(bs_add_jssIx): { - Eterm Op1, Op2; - Uint Unit = Arg(3); - - GetArg2(1, Op1, Op2); - if (is_both_small(Op1, Op2)) { - Sint Arg1 = signed_val(Op1); - Sint Arg2 = signed_val(Op2); - - if (Arg1 >= 0 && Arg2 >= 0) { - BsSafeMul(Arg2, Unit, goto system_limit, Op1); - Op1 += Arg1; - - store_bs_add_result: - if (Op1 <= MAX_SMALL) { - Op1 = make_small(Op1); - } else { - /* - * May generate a heap fragment, but in this - * particular case it is OK, since the value will be - * stored into an x register (the GC will scan x - * registers for references to heap fragments) and - * there is no risk that value can be stored into a - * location that is not scanned for heap-fragment - * references (such as the heap). - */ - SWAPOUT; - Op1 = erts_make_integer(Op1, c_p); - HTOP = HEAP_TOP(c_p); - } - xb(Arg(4)) = Op1; - Next(5); - } - goto badarg; - } else { - Uint a; - Uint b; - Uint c; - - /* - * Now we know that one of the arguments is - * not a small. We must convert both arguments - * to Uints and check for errors at the same time. - * - * Error checking is tricky. - * - * If one of the arguments is not numeric or - * not positive, the error reason is BADARG. - * - * Otherwise if both arguments are numeric, - * but at least one argument does not fit in - * an Uint, the reason is SYSTEM_LIMIT. - */ - - if (!term_to_Uint(Op1, &a)) { - if (a == BADARG) { - goto badarg; - } - if (!term_to_Uint(Op2, &b)) { - c_p->freason = b; - goto lb_Cl_error; - } - goto system_limit; - } else if (!term_to_Uint(Op2, &b)) { - c_p->freason = b; - goto lb_Cl_error; - } - - /* - * The arguments are now correct and stored in a and b. - */ - - BsSafeMul(b, Unit, goto system_limit, c); - Op1 = a + c; - if (Op1 < a) { - /* - * If the result is less than one of the - * arguments, there must have been an overflow. - */ - goto system_limit; - } - goto store_bs_add_result; - } - /* No fallthrough */ - ASSERT(0); - } - - OpCase(bs_put_string_II): - { - BeamInstr *next; - PreFetch(2, next); - erts_new_bs_put_string(ERL_BITS_ARGS_2((byte *) Arg(1), Arg(0))); - NextPF(2, next); - } - - /* - * x(SCRATCH_X_REG); - * Operands: Fail ExtraHeap Live Unit Size Dst - */ - - OpCase(i_bs_append_jIIIsx): { - Uint live = Arg(2); - Uint res; - Eterm Size; - - GetArg1(4, Size); - HEAVY_SWAPOUT; - reg[live] = x(SCRATCH_X_REG); - res = erts_bs_append(c_p, reg, live, Size, Arg(1), Arg(3)); - HEAVY_SWAPIN; - if (is_non_value(res)) { - /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ - goto lb_Cl_error; - } - xb(Arg(5)) = res; - Next(6); - } - - /* - * Operands: Fail Size Src Unit Dst - */ - OpCase(i_bs_private_append_jIssx): { - Eterm res; - Eterm Size, Src; - - GetArg2(2, Size, Src); - res = erts_bs_private_append(c_p, Src, Size, Arg(1)); - if (is_non_value(res)) { - /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ - goto lb_Cl_error; - } - xb(Arg(4)) = res; - Next(5); - } - - OpCase(bs_init_writable): { - HEAVY_SWAPOUT; - r(0) = erts_bs_init_writable(c_p, r(0)); - HEAVY_SWAPIN; - Next(0); - } - - /* - * Calculate the number of bytes needed to encode the source - * operarand to UTF-8. If the source operand is invalid (e.g. wrong - * type or range) we return a nonsense integer result (0 or 4). We - * can get away with that because we KNOW that bs_put_utf8 will do - * full error checking. - */ - OpCase(i_bs_utf8_size_sx): { - Eterm arg; - Eterm result; - - GetArg1(0, arg); - if (arg < make_small(0x80UL)) { - result = make_small(1); - } else if (arg < make_small(0x800UL)) { - result = make_small(2); - } else if (arg < make_small(0x10000UL)) { - result = make_small(3); - } else { - result = make_small(4); - } - xb(Arg(1)) = result; - Next(2); - } - - OpCase(i_bs_put_utf8_js): { - Eterm arg; - - GetArg1(1, arg); - if (!erts_bs_put_utf8(ERL_BITS_ARGS_1(arg))) { - goto badarg; - } - Next(2); - } - - /* - * Calculate the number of bytes needed to encode the source - * operarand to UTF-8. If the source operand is invalid (e.g. wrong - * type or range) we return a nonsense integer result (2 or 4). We - * can get away with that because we KNOW that bs_put_utf16 will do - * full error checking. - */ - - OpCase(i_bs_utf16_size_sx): { - Eterm arg; - Eterm result = make_small(2); - - GetArg1(0, arg); - if (arg >= make_small(0x10000UL)) { - result = make_small(4); - } - xb(Arg(1)) = result; - Next(2); - } - - OpCase(bs_put_utf16_jIs): { - Eterm arg; - - GetArg1(2, arg); - if (!erts_bs_put_utf16(ERL_BITS_ARGS_2(arg, Arg(1)))) { - goto badarg; - } - Next(3); - } - - /* - * Only used for validating a value about to be stored in a binary. - */ - OpCase(i_bs_validate_unicode_js): { - Eterm val; - - GetArg1(1, val); - - /* - * There is no need to untag the integer, but it IS necessary - * to make sure it is small (if the term is a bignum, it could - * slip through the test, and there is no further test that - * would catch it, since bit syntax construction silently masks - * too big numbers). - */ - if (is_not_small(val) || val > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) { - goto badarg; - } - Next(2); - } - - /* - * Only used for validating a value matched out. - */ - OpCase(i_bs_validate_unicode_retract_jss): { - Eterm i; /* Integer to validate */ - - /* - * There is no need to untag the integer, but it IS necessary - * to make sure it is small (a bignum pointer could fall in - * the valid range). - */ - - GetArg1(1, i); - if (is_not_small(i) || i > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) { - Eterm ms; /* Match context */ - ErlBinMatchBuffer* mb; - - GetArg1(2, ms); - mb = ms_matchbuffer(ms); - mb->offset -= 32; - goto badarg; - } - Next(3); - } - - /* - * Matching of binaries. - */ - - { - Eterm header; - BeamInstr *next; - Uint slots; - Eterm context; - - do_start_match: - slots = Arg(2); - if (!is_boxed(context)) { - ClauseFail(); - } - PreFetch(4, next); - header = *boxed_val(context); - if (header_is_bin_matchstate(header)) { - ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(context); - Uint actual_slots = HEADER_NUM_SLOTS(header); - ms->save_offset[0] = ms->mb.offset; - if (actual_slots < slots) { - ErlBinMatchState* dst; - Uint live = Arg(1); - Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); - - TestHeapPreserve(wordsneeded, live, context); - ms = (ErlBinMatchState *) boxed_val(context); - dst = (ErlBinMatchState *) HTOP; - *dst = *ms; - *HTOP = HEADER_BIN_MATCHSTATE(slots); - HTOP += wordsneeded; - HEAP_SPACE_VERIFIED(0); - xb(Arg(3)) = make_matchstate(dst); - } - } else if (is_binary_header(header)) { - Eterm result; - Uint live = Arg(1); - Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); - TestHeapPreserve(wordsneeded, live, context); - HEAP_TOP(c_p) = HTOP; -#ifdef DEBUG - c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */ -#endif - result = erts_bs_start_match_2(c_p, context, slots); - HTOP = HEAP_TOP(c_p); - HEAP_SPACE_VERIFIED(0); - if (is_non_value(result)) { - ClauseFail(); - } else { - xb(Arg(3)) = result; - } - } else { - ClauseFail(); - } - NextPF(4, next); - - OpCase(i_bs_start_match2_xfIIx): { - context = xb(Arg(0)); - I++; - goto do_start_match; - } - OpCase(i_bs_start_match2_yfIIx): { - context = yb(Arg(0)); - I++; - goto do_start_match; - } - } - - OpCase(bs_test_zero_tail2_fx): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - - PreFetch(2, next); - _mb = (ErlBinMatchBuffer*) ms_matchbuffer(xb(Arg(1))); - if (_mb->size != _mb->offset) { - ClauseFail(); - } - NextPF(2, next); - } - - OpCase(bs_test_tail_imm2_fxI): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(3, next); - _mb = ms_matchbuffer(xb(Arg(1))); - if (_mb->size - _mb->offset != Arg(2)) { - ClauseFail(); - } - NextPF(3, next); - } - - OpCase(bs_test_unit_fxI): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(3, next); - _mb = ms_matchbuffer(xb(Arg(1))); - if ((_mb->size - _mb->offset) % Arg(2)) { - ClauseFail(); - } - NextPF(3, next); - } - - OpCase(bs_test_unit8_fx): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(2, next); - _mb = ms_matchbuffer(xb(Arg(1))); - if ((_mb->size - _mb->offset) & 7) { - ClauseFail(); - } - NextPF(2, next); - } - - { - Eterm bs_get_integer8_context; - - OpCase(i_bs_get_integer_8_xfx): { - ErlBinMatchBuffer *_mb; - Eterm _result; - bs_get_integer8_context = xb(Arg(0)); - I++; - _mb = ms_matchbuffer(bs_get_integer8_context); - if (_mb->size - _mb->offset < 8) { - ClauseFail(); - } - if (BIT_OFFSET(_mb->offset) != 0) { - _result = erts_bs_get_integer_2(c_p, 8, 0, _mb); - } else { - _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]); - _mb->offset += 8; - } - xb(Arg(1)) = _result; - Next(2); - } - } - - { - Eterm bs_get_integer_16_context; - - OpCase(i_bs_get_integer_16_xfx): - bs_get_integer_16_context = xb(Arg(0)); - I++; - - { - ErlBinMatchBuffer *_mb; - Eterm _result; - _mb = ms_matchbuffer(bs_get_integer_16_context); - if (_mb->size - _mb->offset < 16) { - ClauseFail(); - } - if (BIT_OFFSET(_mb->offset) != 0) { - _result = erts_bs_get_integer_2(c_p, 16, 0, _mb); - } else { - _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset))); - _mb->offset += 16; - } - xb(Arg(1)) = _result; - Next(2); - } - } - - { - Eterm bs_get_integer_32_context; - - OpCase(i_bs_get_integer_32_xfIx): - bs_get_integer_32_context = xb(Arg(0)); - I++; - - { - ErlBinMatchBuffer *_mb; - Uint32 _integer; - Eterm _result; - _mb = ms_matchbuffer(bs_get_integer_32_context); - if (_mb->size - _mb->offset < 32) { ClauseFail(); } - if (BIT_OFFSET(_mb->offset) != 0) { - _integer = erts_bs_get_unaligned_uint32(_mb); - } else { - _integer = get_int32(_mb->base + _mb->offset/8); - } - _mb->offset += 32; -#if !defined(ARCH_64) - if (IS_USMALL(0, _integer)) { -#endif - _result = make_small(_integer); -#if !defined(ARCH_64) - } else { - TestHeap(BIG_UINT_HEAP_SIZE, Arg(1)); - _result = uint_to_big((Uint) _integer, HTOP); - HTOP += BIG_UINT_HEAP_SIZE; - HEAP_SPACE_VERIFIED(0); - } -#endif - xb(Arg(2)) = _result; - Next(3); - } - } - - { - Eterm Ms, Sz; - - /* Operands: x(Reg) Size Live Fail Flags Dst */ - OpCase(i_bs_get_integer_imm_xIIfIx): { - Uint wordsneeded; - Ms = xb(Arg(0)); - Sz = Arg(1); - wordsneeded = 1+WSIZE(NBYTES(Sz)); - TestHeapPreserve(wordsneeded, Arg(2), Ms); - I += 3; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } - - /* Operands: x(Reg) Size Fail Flags Dst */ - OpCase(i_bs_get_integer_small_imm_xIfIx): { - Ms = xb(Arg(0)); - Sz = Arg(1); - I += 2; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } - - /* - * Ms = match context - * Sz = size of field - * Operands: Fail Flags Dst - */ - do_bs_get_integer_imm: { - ErlBinMatchBuffer* mb; - Eterm result; - - mb = ms_matchbuffer(Ms); - LIGHT_SWAPOUT; - result = erts_bs_get_integer_2(c_p, Sz, Arg(1), mb); - LIGHT_SWAPIN; - HEAP_SPACE_VERIFIED(0); - if (is_non_value(result)) { - ClauseFail(); - } - xb(Arg(2)) = result; - Next(3); - } - } - - /* - * Operands: Fail Live FlagsAndUnit Ms Sz Dst - */ - OpCase(i_bs_get_integer_fIIssx): { - Uint flags; - Uint size; - Eterm Ms; - Eterm Sz; - ErlBinMatchBuffer* mb; - Eterm result; - - flags = Arg(2); - GetArg2(3, Ms, Sz); - BsGetFieldSize(Sz, (flags >> 3), ClauseFail(), size); - if (size >= SMALL_BITS) { - Uint wordsneeded; - /* Check bits size before potential gc. - * We do not want a gc and then realize we don't need - * the allocated space (i.e. if the op fails). - * - * Remember to re-acquire the matchbuffer after gc. - */ - - mb = ms_matchbuffer(Ms); - if (mb->size - mb->offset < size) { - ClauseFail(); - } - wordsneeded = 1+WSIZE(NBYTES((Uint) size)); - TestHeapPreserve(wordsneeded, Arg(1), Ms); - } - mb = ms_matchbuffer(Ms); - LIGHT_SWAPOUT; - result = erts_bs_get_integer_2(c_p, size, flags, mb); - LIGHT_SWAPIN; - HEAP_SPACE_VERIFIED(0); - if (is_non_value(result)) { - ClauseFail(); - } - xb(Arg(5)) = result; - Next(6); - } - - { - Eterm get_utf8_context; - - /* Operands: MatchContext Fail Dst */ - OpCase(i_bs_get_utf8_xfx): { - get_utf8_context = xb(Arg(0)); - I++; - } - - /* - * get_utf8_context = match_context - * Operands: Fail Dst - */ - - { - Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context)); - if (is_non_value(result)) { - ClauseFail(); - } - xb(Arg(1)) = result; - Next(2); - } - } - - { - Eterm get_utf16_context; - - /* Operands: MatchContext Fail Flags Dst */ - OpCase(i_bs_get_utf16_xfIx): { - get_utf16_context = xb(Arg(0)); - I++; - } - - /* - * get_utf16_context = match_context - * Operands: Fail Flags Dst - */ - { - Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context), - Arg(1)); - if (is_non_value(result)) { - ClauseFail(); - } - xb(Arg(2)) = result; - Next(3); - } - } - - { - Eterm context_to_binary_context; - ErlBinMatchBuffer* mb; - ErlSubBin* sb; - Uint size; - Uint offs; - Uint orig; - Uint hole_size; - - OpCase(bs_context_to_binary_x): - context_to_binary_context = xb(Arg(0)); - I--; - - if (is_boxed(context_to_binary_context) && - header_is_bin_matchstate(*boxed_val(context_to_binary_context))) { - ErlBinMatchState* ms; - ms = (ErlBinMatchState *) boxed_val(context_to_binary_context); - mb = &ms->mb; - offs = ms->save_offset[0]; - size = mb->size - offs; - goto do_bs_get_binary_all_reuse_common; - } - Next(2); - - OpCase(i_bs_get_binary_all_reuse_xfI): { - context_to_binary_context = xb(Arg(0)); - I++; - } - - mb = ms_matchbuffer(context_to_binary_context); - size = mb->size - mb->offset; - if (size % Arg(1) != 0) { - ClauseFail(); - } - offs = mb->offset; - - do_bs_get_binary_all_reuse_common: - orig = mb->orig; - sb = (ErlSubBin *) boxed_val(context_to_binary_context); - hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE; - sb->thing_word = HEADER_SUB_BIN; - sb->size = BYTE_OFFSET(size); - sb->bitsize = BIT_OFFSET(size); - sb->offs = BYTE_OFFSET(offs); - sb->bitoffs = BIT_OFFSET(offs); - sb->is_writable = 0; - sb->orig = orig; - if (hole_size) { - sb[1].thing_word = make_pos_bignum_header(hole_size-1); - } - Next(2); - } - - { - Eterm match_string_context; - - OpCase(i_bs_match_string_xfII): { - match_string_context = xb(Arg(0)); - I++; - } - - { - BeamInstr *next; - byte* bytes; - Uint bits; - ErlBinMatchBuffer* mb; - Uint offs; - - PreFetch(3, next); - bits = Arg(1); - bytes = (byte *) Arg(2); - mb = ms_matchbuffer(match_string_context); - if (mb->size - mb->offset < bits) { - ClauseFail(); - } - offs = mb->offset & 7; - if (offs == 0 && (bits & 7) == 0) { - if (sys_memcmp(bytes, mb->base+(mb->offset>>3), bits>>3)) { - ClauseFail(); - } - } else if (erts_cmp_bits(bytes, 0, mb->base+(mb->offset>>3), mb->offset & 7, bits)) { - ClauseFail(); - } - mb->offset += bits; - NextPF(3, next); - } - } - - OpCase(i_bs_save2_xI): { - BeamInstr *next; - ErlBinMatchState *_ms; - PreFetch(2, next); - _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0))); - _ms->save_offset[Arg(1)] = _ms->mb.offset; - NextPF(2, next); - } - - OpCase(i_bs_restore2_xI): { - BeamInstr *next; - ErlBinMatchState *_ms; - PreFetch(2, next); - _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0))); - _ms->mb.offset = _ms->save_offset[Arg(1)]; - NextPF(2, next); - } - #include "beam_cold.h" - - /* - * This instruction is probably never used (because it is combined with a - * a return). However, a future compiler might for some reason emit a - * deallocate not followed by a return, and that should work. - */ - OpCase(deallocate_I): { - BeamInstr *next; - - PreFetch(1, next); - D(Arg(0)); - NextPF(1, next); - } - - /* - * Trace and debugging support. - */ - - OpCase(return_trace): { - ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[0]); - - SWAPOUT; /* Needed for shared heap */ - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - SWAPIN; - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[2])); - E += 3; - Goto(*I); - } - - OpCase(i_generic_breakpoint): { - BeamInstr real_I; - HEAVY_SWAPOUT; - real_I = erts_generic_breakpoint(c_p, erts_code_to_codeinfo(I), reg); - HEAVY_SWAPIN; - ASSERT(VALID_INSTR(real_I)); - Goto(real_I); - } - - OpCase(i_return_time_trace): { - BeamInstr *pc = (BeamInstr *) (UWord) E[0]; - SWAPOUT; - erts_trace_time_return(c_p, erts_code_to_codeinfo(pc)); - SWAPIN; - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[1])); - E += 2; - Goto(*I); - } - - OpCase(i_return_to_trace): { - if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) { - Uint *cpp = (Uint*) E; - for(;;) { - ASSERT(is_CP(*cpp)); - if (*cp_val(*cpp) == (BeamInstr) OpCode(return_trace)) { - do ++cpp; while(is_not_CP(*cpp)); - cpp += 2; - } else if (*cp_val(*cpp) == (BeamInstr) OpCode(i_return_to_trace)) { - do ++cpp; while(is_not_CP(*cpp)); - } else break; - } - SWAPOUT; /* Needed for shared heap */ - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - erts_trace_return_to(c_p, cp_val(*cpp)); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - SWAPIN; - } - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[0])); - E += 1; - Goto(*I); - } - - /* - * New floating point instructions. - */ - - OpCase(fmove_ql): { - Eterm fr = Arg(1); - BeamInstr *next; - - PreFetch(2, next); - GET_DOUBLE(Arg(0), *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); - NextPF(2, next); - } - - OpCase(fmove_dl): { - Eterm targ1; - Eterm fr = Arg(1); - BeamInstr *next; - - PreFetch(2, next); - targ1 = REG_TARGET(Arg(0)); - /* Arg(0) == HEADER_FLONUM */ - GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); - NextPF(2, next); - } - - OpCase(fmove_ld): { - Eterm fr = Arg(0); - Eterm dest = make_float(HTOP); - - PUT_DOUBLE(*(FloatDef*)ADD_BYTE_OFFSET(freg, fr), HTOP); - HTOP += FLOAT_SIZE_OBJECT; - StoreBifResult(1, dest); - } - - OpCase(fconv_dl): { - Eterm targ1; - Eterm fr = Arg(1); - BeamInstr *next; - - targ1 = REG_TARGET(Arg(0)); - PreFetch(2, next); - if (is_small(targ1)) { - fb(fr) = (double) signed_val(targ1); - } else if (is_big(targ1)) { - if (big_to_double(targ1, &fb(fr)) < 0) { - goto fbadarith; - } - } else if (is_float(targ1)) { - GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); - } else { - goto fbadarith; - } - NextPF(2, next); - } - -#ifdef NO_FPE_SIGNALS - OpCase(fclearerror): - OpCase(i_fcheckerror): - erts_exit(ERTS_ERROR_EXIT, "fclearerror/i_fcheckerror without fpe signals (beam_emu)"); -# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT -# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR -#else -# define ERTS_NO_FPE_CHECK_INIT(p) -# define ERTS_NO_FPE_ERROR(p, a, b) - - OpCase(fclearerror): { - BeamInstr *next; - - PreFetch(0, next); - ERTS_FP_CHECK_INIT(c_p); - NextPF(0, next); - } - - OpCase(i_fcheckerror): { - BeamInstr *next; - - PreFetch(0, next); - ERTS_FP_ERROR(c_p, freg[0].fd, goto fbadarith); - NextPF(0, next); - } -#endif - - - OpCase(i_fadd_lll): { - BeamInstr *next; - - PreFetch(3, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - fb(Arg(2)) = fb(Arg(0)) + fb(Arg(1)); - ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith); - NextPF(3, next); - } - OpCase(i_fsub_lll): { - BeamInstr *next; - - PreFetch(3, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - fb(Arg(2)) = fb(Arg(0)) - fb(Arg(1)); - ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith); - NextPF(3, next); - } - OpCase(i_fmul_lll): { - BeamInstr *next; - - PreFetch(3, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - fb(Arg(2)) = fb(Arg(0)) * fb(Arg(1)); - ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith); - NextPF(3, next); - } - OpCase(i_fdiv_lll): { - BeamInstr *next; - - PreFetch(3, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - fb(Arg(2)) = fb(Arg(0)) / fb(Arg(1)); - ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith); - NextPF(3, next); - } - OpCase(i_fnegate_ll): { - BeamInstr *next; - - PreFetch(2, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - fb(Arg(1)) = -fb(Arg(0)); - ERTS_NO_FPE_ERROR(c_p, fb(Arg(1)), goto fbadarith); - NextPF(2, next); - - fbadarith: - c_p->freason = BADARITH; - goto find_func_info; - } - -#ifdef HIPE - { -#define HIPE_MODE_SWITCH(Cmd) \ - SWAPOUT; \ - ERTS_DBG_CHK_REDS(c_p, FCALLS); \ - c_p->fcalls = FCALLS; \ - c_p->def_arg_reg[4] = -neg_o_reds; \ - c_p = hipe_mode_switch(c_p, Cmd, reg); \ - goto L_post_hipe_mode_switch - - OpCase(hipe_trap_call): { - /* - * I[-5]: &&lb_i_func_info_IaaI - * I[-4]: Native code callee (inserted by HiPE) - * I[-3]: Module (tagged atom) - * I[-2]: Function (tagged atom) - * I[-1]: Arity (untagged integer) - * I[ 0]: &&lb_hipe_trap_call - * ... remainder of original BEAM code - */ - ErtsCodeInfo *ci = erts_code_to_codeinfo(I); - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.u.ncallee = ci->u.ncallee; - ++hipe_trap_count; - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (ci->mfa.arity << 8)); - } - OpCase(hipe_trap_call_closure): { - ErtsCodeInfo *ci = erts_code_to_codeinfo(I); - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.u.ncallee = ci->u.ncallee; - ++hipe_trap_count; - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (ci->mfa.arity << 8)); - } - OpCase(hipe_trap_return): { - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN); - } - OpCase(hipe_trap_throw): { - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW); - } - OpCase(hipe_trap_resume): { - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME); - } -#undef HIPE_MODE_SWITCH - - L_post_hipe_mode_switch: -#ifdef DEBUG - pid = c_p->common.id; /* may have switched process... */ -#endif - reg = erts_proc_sched_data(c_p)->x_reg_array; - freg = erts_proc_sched_data(c_p)->f_reg_array; - ERL_BITS_RELOAD_STATEP(c_p); - /* XXX: this abuse of def_arg_reg[] is horrid! */ - neg_o_reds = -c_p->def_arg_reg[4]; - FCALLS = c_p->fcalls; - SWAPIN; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - switch( c_p->def_arg_reg[3] ) { - case HIPE_MODE_SWITCH_RES_RETURN: - ASSERT(is_value(reg[0])); - SET_I(c_p->cp); - c_p->cp = 0; - Goto(*I); - case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: - c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; - /*fall through*/ - case HIPE_MODE_SWITCH_RES_CALL_BEAM: - SET_I(c_p->i); - Dispatch(); - case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: - /* This can be used to call any function value, but currently it's - only used to call closures referring to unloaded modules. */ - { - BeamInstr *next; - - next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE); - HEAVY_SWAPIN; - if (next != NULL) { - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - case HIPE_MODE_SWITCH_RES_THROW: - c_p->cp = NULL; - I = handle_error(c_p, I, reg, NULL); - goto post_error_handling; - default: - erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]); - } - } - OpCase(hipe_call_count): { - /* - * I[-5]: &&lb_i_func_info_IaaI - * I[-4]: pointer to struct hipe_call_count (inserted by HiPE) - * I[-3]: Module (tagged atom) - * I[-2]: Function (tagged atom) - * I[-1]: Arity (untagged integer) - * I[ 0]: &&lb_hipe_call_count - * ... remainder of original BEAM code - */ - ErtsCodeInfo *ci = erts_code_to_codeinfo(I); - struct hipe_call_count *hcc = ci->u.hcc; - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); - ASSERT(hcc != NULL); - ASSERT(VALID_INSTR(hcc->opcode)); - ++(hcc->count); - Goto(hcc->opcode); - } -#endif /* HIPE */ - - OpCase(i_yield): - { - /* This is safe as long as REDS_IN(c_p) is never stored - * in c_p->arg_reg[0]. It is currently stored in c_p->def_arg_reg[5], - * which may be c_p->arg_reg[5], which is close, but no banana. - */ - c_p->arg_reg[0] = am_true; - c_p->arity = 1; /* One living register (the 'true' return value) */ - SWAPOUT; - c_p->i = I + 1; /* Next instruction */ - c_p->current = NULL; - goto do_schedule; - } - - OpCase(i_hibernate): { - HEAVY_SWAPOUT; - if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) { - FCALLS = c_p->fcalls; - c_p->flags &= ~F_HIBERNATE_SCHED; - goto do_schedule; - } else { - HEAVY_SWAPIN; - I = handle_error(c_p, I, reg, &bif_export[BIF_hibernate_3]->info.mfa); - goto post_error_handling; - } - } - - /* This is optimised as an instruction because - it has to be very very fast */ - OpCase(i_perf_counter): { - BeamInstr* next; - ErtsSysPerfCounter ts; - PreFetch(0, next); - - ts = erts_sys_perf_counter(); - - if (IS_SSMALL(ts)) { - r(0) = make_small((Sint)ts); - } else { - TestHeap(ERTS_SINT64_HEAP_SIZE(ts),0); - r(0) = make_big(HTOP); -#if defined(ARCH_32) - if (ts >= (((Uint64) 1) << 32)) { - *HTOP = make_pos_bignum_header(2); - BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff)); - BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff)); - HTOP += 3; - } - else -#endif - { - *HTOP = make_pos_bignum_header(1); - BIG_DIGIT(HTOP, 0) = (Uint) ts; - HTOP += 2; - } - } - NextPF(0, next); - } - - OpCase(i_debug_breakpoint): { - HEAVY_SWAPOUT; - I = call_error_handler(c_p, erts_code_to_codemfa(I), reg, am_breakpoint); - HEAVY_SWAPIN; - if (I) { - Goto(*I); - } - goto handle_error; - } - - - OpCase(system_limit_j): - system_limit: - c_p->freason = SYSTEM_LIMIT; - goto lb_Cl_error; - - #ifdef ERTS_OPCODE_COUNTER_SUPPORT DEFINE_COUNTING_LABELS; #endif @@ -6362,13 +2177,14 @@ apply_bif_error_adjustment(Process *p, Export *ep, } static BeamInstr* -apply( -Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg, -BeamInstr *I, Uint stack_offset) +apply(Process* p, Eterm* reg, BeamInstr *I, Uint stack_offset) { int arity; Export* ep; Eterm tmp; + Eterm module = reg[0]; + Eterm function = reg[1]; + Eterm args = reg[2]; /* * Check the arguments which should be of the form apply(Module, @@ -6485,8 +2301,9 @@ fixed_apply(Process* p, Eterm* reg, Uint arity, if (is_not_atom(module)) goto error; /* Handle apply of apply/3... */ - if (module == am_erlang && function == am_apply && arity == 3) - return apply(p, reg[0], reg[1], reg[2], reg, I, stack_offset); + if (module == am_erlang && function == am_apply && arity == 3) { + return apply(p, reg, I, stack_offset); + } /* * Get the index into the export table, or failing that the export @@ -6507,11 +2324,13 @@ fixed_apply(Process* p, Eterm* reg, Uint arity, } int -erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg) +erts_hibernate(Process* c_p, Eterm* reg) { int arity; Eterm tmp; - + Eterm module = reg[0]; + Eterm function = reg[1]; + Eterm args = reg[2]; if (is_not_atom(module) || is_not_atom(function)) { /* @@ -6918,24 +2737,20 @@ do { \ static Eterm -new_map(Process* p, Eterm* reg, BeamInstr* I) +new_map(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* ptr) { - Uint n = Arg(3); Uint i; Uint need = n + 1 /* hdr */ + 1 /*size*/ + 1 /* ptr */ + 1 /* arity */; Eterm keys; Eterm *mhp,*thp; Eterm *E; - BeamInstr *ptr; flatmap_t *mp; ErtsHeapFactory factory; - ptr = &Arg(4); - if (n > 2*MAP_SMALL_MAP_LIMIT) { Eterm res; if (HeapWordsLeft(p) < n) { - erts_garbage_collect(p, n, reg, Arg(2)); + erts_garbage_collect(p, n, reg, live); } mhp = p->htop; @@ -6956,7 +2771,7 @@ new_map(Process* p, Eterm* reg, BeamInstr* I) } if (HeapWordsLeft(p) < need) { - erts_garbage_collect(p, need, reg, Arg(2)); + erts_garbage_collect(p, need, reg, live); } thp = p->htop; @@ -6979,24 +2794,20 @@ new_map(Process* p, Eterm* reg, BeamInstr* I) } static Eterm -new_small_map_lit(Process* p, Eterm* reg, Uint* n_exp, BeamInstr* I) +new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal, Uint live, BeamInstr* ptr) { - Eterm* keys = tuple_val(Arg(3)); + Eterm* keys = tuple_val(keys_literal); Uint n = arityval(*keys); Uint need = n + 1 /* hdr */ + 1 /*size*/ + 1 /* ptr */ + 1 /* arity */; Uint i; - BeamInstr *ptr; flatmap_t *mp; Eterm *mhp; Eterm *E; - *n_exp = n; - ptr = &Arg(4); - ASSERT(n <= MAP_SMALL_MAP_LIMIT); if (HeapWordsLeft(p) < need) { - erts_garbage_collect(p, need, reg, Arg(2)); + erts_garbage_collect(p, need, reg, live); } mhp = p->htop; @@ -7005,7 +2816,7 @@ new_small_map_lit(Process* p, Eterm* reg, Uint* n_exp, BeamInstr* I) mp = (flatmap_t *)mhp; mhp += MAP_HEADER_FLATMAP_SZ; mp->thing_word = MAP_HEADER_FLATMAP; mp->size = n; - mp->keys = Arg(3); + mp->keys = keys_literal; for (i = 0; i < n; i++) { GET_TERM(*ptr++, *mhp++); @@ -7017,9 +2828,8 @@ new_small_map_lit(Process* p, Eterm* reg, Uint* n_exp, BeamInstr* I) } static Eterm -update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) +update_map_assoc(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* new_p) { - Uint n; Uint num_old; Uint num_updates; Uint need; @@ -7029,23 +2839,18 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) Eterm* E; Eterm* old_keys; Eterm* old_vals; - BeamInstr* new_p; Eterm new_key; Eterm* kp; + Eterm map; - new_p = &Arg(5); - num_updates = Arg(4) / 2; + num_updates = n / 2; + map = reg[live]; if (is_not_flatmap(map)) { Uint32 hx; Eterm val; - /* apparently the compiler does not emit is_map instructions, - * bad compiler */ - - if (is_not_hashmap(map)) - return THE_NON_VALUE; - + ASSERT(is_hashmap(map)); res = map; E = p->stop; while(num_updates--) { @@ -7069,7 +2874,7 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) */ if (num_old == 0) { - return new_map(p, reg, I+1); + return new_map(p, reg, live, n, new_p); } /* @@ -7079,8 +2884,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) need = 2*(num_old+num_updates) + 1 + MAP_HEADER_FLATMAP_SZ; if (HeapWordsLeft(p) < need) { - Uint live = Arg(3); - reg[live] = map; erts_garbage_collect(p, need, reg, live+1); map = reg[live]; old_mp = (flatmap_t *)flatmap_val(map); @@ -7227,9 +3030,8 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) */ static Eterm -update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) +update_map_exact(Process* p, Eterm* reg, Uint live, Uint n, Eterm* new_p) { - Uint n; Uint i; Uint num_old; Uint need; @@ -7239,12 +3041,12 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) Eterm* E; Eterm* old_keys; Eterm* old_vals; - BeamInstr* new_p; Eterm new_key; + Eterm map; - new_p = &Arg(5); - n = Arg(4) / 2; /* Number of values to be updated */ + n /= 2; /* Number of values to be updated */ ASSERT(n > 0); + map = reg[live]; if (is_not_flatmap(map)) { Uint32 hx; @@ -7298,8 +3100,6 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) need = num_old + MAP_HEADER_FLATMAP_SZ; if (HeapWordsLeft(p) < need) { - Uint live = Arg(3); - reg[live] = map; erts_garbage_collect(p, need, reg, live+1); map = reg[live]; old_mp = (flatmap_t *)flatmap_val(map); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 5429a61d7b..7d3a19ff86 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -83,8 +83,9 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int); typedef struct { Uint value; /* Value of label (NULL if not known yet). */ - Sint patches; /* Index (into code buffer) to first location - * which must be patched with the value of this label. + Sint patches; /* Index (into code buffer) to first + * location which must be patched with + * the value of this label. */ Uint looprec_targeted; /* Non-zero if this label is the target of a loop_rec * instruction. @@ -305,6 +306,7 @@ typedef struct LoaderState { int on_load; /* Index in the code for the on_load function * (or 0 if there is no on_load function) */ + int otp_20_or_higher; /* Compiled with OTP 20 or higher */ /* * Atom table. @@ -739,6 +741,13 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, } /* + * Find out whether the code was compiled with OTP 20 + * or higher. + */ + + stp->otp_20_or_higher = stp->chunks[UTF8_ATOM_CHUNK].size > 0; + + /* * Load the code chunk. */ @@ -2025,30 +2034,10 @@ load_code(LoaderState* stp) case 0: /* Floating point number. * Not generated by the compiler in R16B and later. + * (The literal pool is used instead.) */ - { - Eterm* hp; -#if !defined(ARCH_64) - Uint high, low; -# endif - last_op->a[arg].val = new_literal(stp, &hp, - FLOAT_SIZE_OBJECT); - hp[0] = HEADER_FLONUM; - last_op->a[arg].type = TAG_q; -#if defined(ARCH_64) - GetInt(stp, 8, hp[1]); -# else - GetInt(stp, 4, high); - GetInt(stp, 4, low); - if (must_swap_floats) { - Uint t = high; - high = low; - low = t; - } - hp[1] = high; - hp[2] = low; -# endif - } + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler"); break; case 1: /* List. */ if (arg+1 != arity) { @@ -2365,7 +2354,8 @@ load_code(LoaderState* stp) break; } break; - case 'd': /* Destination (x(0), x(N), y(N) */ + case 'd': /* Destination (x(N), y(N) */ + case 'S': /* Source (x(N), y(N)) */ switch (tag) { case TAG_x: code[ci++] = tmp_op->a[arg].val * sizeof(Eterm); @@ -2379,11 +2369,29 @@ load_code(LoaderState* stp) break; } break; - case 'I': /* Untagged integer (or pointer). */ - VerifyTag(stp, tag, TAG_u); - code[ci++] = tmp_op->a[arg].val; - break; - case 't': /* Small untagged integer -- can be packed. */ + case 't': /* Small untagged integer (16 bits) -- can be packed. */ + case 'I': /* Untagged integer (32 bits) -- can be packed. */ + case 'W': /* Untagged integer or pointer (machine word). */ +#ifdef DEBUG + switch (*sign) { + case 't': + if (tmp_op->a[arg].val >> 16 != 0) { + load_printf(__LINE__, stp, "value %lu of type 't' does not fit in 16 bits", + tmp_op->a[arg].val); + ASSERT(0); + } + break; +#ifdef ARCH_64 + case 'I': + if (tmp_op->a[arg].val >> 32 != 0) { + load_printf(__LINE__, stp, "value %lu of type 'I' does not fit in 32 bits", + tmp_op->a[arg].val); + ASSERT(0); + } + break; +#endif + } +#endif VerifyTag(stp, tag, TAG_u); code[ci++] = tmp_op->a[arg].val; break; @@ -2468,16 +2476,32 @@ load_code(LoaderState* stp) * The packing engine. */ if (opc[stp->specific_op].pack[0]) { - char* prog; /* Program for packing engine. */ - BeamInstr stack[8]; /* Stack. */ - BeamInstr* sp = stack; /* Points to next free position. */ - BeamInstr packed = 0; /* Accumulator for packed operations. */ + char* prog; /* Program for packing engine. */ + struct pack_stack { + BeamInstr instr; + LiteralPatch* patch; + } stack[8]; /* Stack. */ + struct pack_stack* sp = stack; /* Points to next free position. */ + BeamInstr packed = 0; /* Accumulator for packed operations. */ for (prog = opc[stp->specific_op].pack; *prog; prog++) { switch (*prog) { case 'g': /* Get instruction; push on stack. */ - *sp++ = code[--ci]; - break; + { + LiteralPatch* lp; + + ci--; + sp->instr = code[ci]; + sp->patch = 0; + for (lp = stp->literal_patches; lp && lp->pos > ci-MAX_OPARGS; lp = lp->next) { + if (lp->pos == ci) { + sp->patch = lp; + break; + } + } + sp++; + } + break; case 'i': /* Initialize packing accumulator. */ packed = code[--ci]; break; @@ -2493,10 +2517,17 @@ load_code(LoaderState* stp) break; #endif case 'p': /* Put instruction (from stack). */ - code[ci++] = *--sp; + --sp; + code[ci] = sp->instr; + if (sp->patch) { + sp->patch->pos = ci; + } + ci++; break; case 'P': /* Put packed operands. */ - *sp++ = packed; + sp->instr = packed; + sp->patch = 0; + sp++; packed = 0; break; default: @@ -2618,8 +2649,8 @@ load_code(LoaderState* stp) /* Remember offset for the on_load function. */ stp->on_load = ci; break; - case op_bs_put_string_II: - case op_i_bs_match_string_xfII: + case op_bs_put_string_WW: + case op_i_bs_match_string_xfWW: new_string_patch(stp, ci-1); break; @@ -2730,6 +2761,12 @@ load_code(LoaderState* stp) #define never(St) 0 +static int +compiled_with_otp_20_or_higher(LoaderState* stp) +{ + return stp->otp_20_or_higher; +} + /* * Predicate that tests whether a jump table can be used. */ @@ -2869,17 +2906,18 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, op->next = NULL; if (Index.type == TAG_i && Index.val > 0 && + Index.val <= ERTS_MAX_TUPLE_SIZE && (Tuple.type == TAG_x || Tuple.type == TAG_y)) { op->op = genop_i_fast_element_4; - op->a[0] = Fail; - op->a[1] = Tuple; + op->a[0] = Tuple; + op->a[1] = Fail; op->a[2].type = TAG_u; op->a[2].val = Index.val; op->a[3] = Dst; } else { op->op = genop_i_element_4; - op->a[0] = Fail; - op->a[1] = Tuple; + op->a[0] = Tuple; + op->a[1] = Fail; op->a[2] = Index; op->a[3] = Dst; } @@ -2959,13 +2997,14 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Dst; +#ifdef ARCH_64 } else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) { - op->op = genop_i_bs_get_integer_32_4; - op->arity = 4; + op->op = genop_i_bs_get_integer_32_3; + op->arity = 3; op->a[0] = Ms; op->a[1] = Fail; - op->a[2] = Live; - op->a[3] = Dst; + op->a[2] = Dst; +#endif } else { generic: if (bits < SMALL_BITS) { @@ -3100,16 +3139,6 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, } /* - * Predicate to test whether a heap binary should be generated. - */ - -static int -should_gen_heap_bin(LoaderState* stp, GenOpArg Src) -{ - return Src.val <= ERL_ONHEAP_BIN_LIMIT; -} - -/* * Predicate to test whether a binary construction is too big. */ @@ -3381,13 +3410,6 @@ negation_is_small(LoaderState* stp, GenOpArg Int) IS_SSMALL(-((Sint)Int.val)); } - -static int -smp(LoaderState* stp) -{ - return 1; -} - /* * Mark this label. */ @@ -3421,11 +3443,11 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) Sint timeout; NEW_GENOP(stp, op); - op->op = genop_i_wait_timeout_2; + op->op = genop_wait_timeout_unlocked_int_2; op->next = NULL; op->arity = 2; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->a[0].type = TAG_u; + op->a[1] = Fail; if (Time.type == TAG_i && (timeout = Time.val) >= 0 && #if defined(ARCH_64) @@ -3434,7 +3456,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) 1 #endif ) { - op->a[1].val = timeout; + op->a[0].val = timeout; #if !defined(ARCH_64) } else if (Time.type == TAG_q) { Eterm big; @@ -3448,7 +3470,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) } else { Uint u; (void) term_to_Uint(big, &u); - op->a[1].val = (BeamInstr) u; + op->a[0].val = (BeamInstr) u; } #endif } else { @@ -3468,12 +3490,12 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) Sint timeout; NEW_GENOP(stp, op); - op->op = genop_i_wait_timeout_locked_2; + op->op = genop_wait_timeout_locked_int_2; op->next = NULL; op->arity = 2; - op->a[0] = Fail; - op->a[1].type = TAG_u; - + op->a[0].type = TAG_u; + op->a[1] = Fail; + if (Time.type == TAG_i && (timeout = Time.val) >= 0 && #if defined(ARCH_64) (timeout >> 32) == 0 @@ -3481,7 +3503,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) 1 #endif ) { - op->a[1].val = timeout; + op->a[0].val = timeout; #if !defined(ARCH_64) } else if (Time.type == TAG_q) { Eterm big; @@ -3495,7 +3517,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) } else { Uint u; (void) term_to_Uint(big, &u); - op->a[1].val = (BeamInstr) u; + op->a[0].val = (BeamInstr) u; } #endif } else { @@ -5330,12 +5352,15 @@ get_tag_and_value(LoaderState* stp, Uint len_code, { Uint count; Sint val; - byte default_buf[128]; - byte* bigbuf = default_buf; + byte default_byte_buf[128]; + byte* byte_buf = default_byte_buf; + Eterm default_big_buf[128/sizeof(Eterm)]; + Eterm* big_buf = default_big_buf; + Eterm tmp_big; byte* s; int i; int neg = 0; - Uint arity; + Uint words_needed; Eterm* hp; /* @@ -5412,8 +5437,11 @@ get_tag_and_value(LoaderState* stp, Uint len_code, *result = val; return TAG_i; } else { - *result = new_literal(stp, &hp, BIG_UINT_HEAP_SIZE); - (void) small_to_big(val, hp); + tmp_big = small_to_big(val, big_buf); + if (!find_literal(stp, tmp_big, result)) { + *result = new_literal(stp, &hp, BIG_UINT_HEAP_SIZE); + sys_memcpy(hp, big_buf, BIG_UINT_HEAP_SIZE*sizeof(Eterm)); + } return TAG_q; } } @@ -5423,8 +5451,8 @@ get_tag_and_value(LoaderState* stp, Uint len_code, * (including margin). */ - if (count+8 > sizeof(default_buf)) { - bigbuf = erts_alloc(ERTS_ALC_T_LOADER_TMP, count+8); + if (count+8 > sizeof(default_byte_buf)) { + byte_buf = erts_alloc(ERTS_ALC_T_LOADER_TMP, count+8); } /* @@ -5433,20 +5461,20 @@ get_tag_and_value(LoaderState* stp, Uint len_code, GetString(stp, s, count); for (i = 0; i < count; i++) { - bigbuf[count-i-1] = *s++; + byte_buf[count-i-1] = *s++; } /* * Check if the number is negative, and negate it if so. */ - if ((bigbuf[count-1] & 0x80) != 0) { + if ((byte_buf[count-1] & 0x80) != 0) { unsigned carry = 1; neg = 1; for (i = 0; i < count; i++) { - bigbuf[i] = ~bigbuf[i] + carry; - carry = (bigbuf[i] == 0 && carry == 1); + byte_buf[i] = ~byte_buf[i] + carry; + carry = (byte_buf[i] == 0 && carry == 1); } ASSERT(carry == 0); } @@ -5455,33 +5483,52 @@ get_tag_and_value(LoaderState* stp, Uint len_code, * Align to word boundary. */ - if (bigbuf[count-1] == 0) { + if (byte_buf[count-1] == 0) { count--; } - if (bigbuf[count-1] == 0) { + if (byte_buf[count-1] == 0) { LoadError0(stp, "bignum not normalized"); } while (count % sizeof(Eterm) != 0) { - bigbuf[count++] = 0; + byte_buf[count++] = 0; } /* - * Allocate heap space for the bignum and copy it. + * Convert to a bignum. */ - arity = count/sizeof(Eterm); - *result = new_literal(stp, &hp, arity+1); - if (is_nil(bytes_to_big(bigbuf, count, neg, hp))) - goto load_error; + words_needed = count/sizeof(Eterm) + 1; + if (words_needed*sizeof(Eterm) > sizeof(default_big_buf)) { + big_buf = erts_alloc(ERTS_ALC_T_LOADER_TMP, words_needed*sizeof(Eterm)); + } + tmp_big = bytes_to_big(byte_buf, count, neg, big_buf); + if (is_nil(tmp_big)) { + goto load_error; + } + + /* + * Create a literal if there is no previous literal with the same value. + */ - if (bigbuf != default_buf) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf); + if (!find_literal(stp, tmp_big, result)) { + *result = new_literal(stp, &hp, words_needed); + sys_memcpy(hp, big_buf, words_needed*sizeof(Eterm)); + } + + if (byte_buf != default_byte_buf) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) byte_buf); + } + if (big_buf != default_big_buf) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) big_buf); } return TAG_q; load_error: - if (bigbuf != default_buf) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf); + if (byte_buf != default_byte_buf) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) byte_buf); + } + if (big_buf != default_big_buf) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) big_buf); } return -1; } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 4b45e98685..ded6c6f1a4 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -437,7 +437,6 @@ BIF_RETTYPE demonitor(Process *c_p, Eterm ref, Eterm *multip) ErtsMonitor *mon = NULL; /* The monitor entry to delete */ Eterm to = NIL; /* Monitor link traget */ DistEntry *dep = NULL; /* Target's distribution entry */ - int deref_de = 0; BIF_RETTYPE res = am_false; int unlock_link = 1; @@ -467,8 +466,6 @@ BIF_RETTYPE demonitor(Process *c_p, Eterm ref, Eterm *multip) ASSERT(is_node_name_atom(to)); dep = erts_sysname_to_connected_dist_entry(to); ASSERT(dep != erts_this_dist_entry); - if (dep) - deref_de = 1; } else if (is_port(to)) { if (port_dist_entry(to) != erts_this_dist_entry) { goto badarg; @@ -486,11 +483,6 @@ BIF_RETTYPE demonitor(Process *c_p, Eterm ref, Eterm *multip) unlock_link = 0; } else { /* Local monitor */ - if (deref_de) { - deref_de = 0; - erts_deref_dist_entry(dep); - } - dep = NULL; demonitor_local_process(c_p, ref, to, &res); } break; @@ -505,11 +497,6 @@ done: if (unlock_link) erts_proc_unlock(c_p, ERTS_PROC_LOCK_LINK); - if (deref_de) { - ASSERT(dep); - erts_deref_dist_entry(dep); - } - ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p)); BIF_RET(res); } @@ -844,7 +831,6 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2) Eterm target = BIF_ARG_2; BIF_RETTYPE ret; DistEntry *dep = NULL; - int deref_de = 0; /* Only process monitors are implemented */ switch (BIF_ARG_1) { @@ -904,21 +890,14 @@ local_port: } dep = erts_sysname_to_connected_dist_entry(remote_node); if (dep == erts_this_dist_entry) { - deref_de = 1; ret = local_name_monitor(BIF_P, BIF_ARG_1, name); } else { - if (dep) - deref_de = 1; ret = remote_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, dep, name, 1); } } else { badarg: ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); } - if (deref_de) { - deref_de = 0; - erts_deref_dist_entry(dep); - } return ret; } @@ -1271,7 +1250,11 @@ BIF_RETTYPE hibernate_3(BIF_ALIST_3) */ Eterm reg[3]; - if (erts_hibernate(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, reg)) { + reg[0] = BIF_ARG_1; + reg[1] = BIF_ARG_2; + reg[2] = BIF_ARG_3; + + if (erts_hibernate(BIF_P, reg)) { /* * If hibernate succeeded, TRAP. The process will be wait in a * hibernated state if its state is inactive (!ERTS_PSFLG_ACTIVE); @@ -2000,6 +1983,7 @@ static Sint remote_send(Process *p, DistEntry *dep, ASSERT(is_atom(to) || is_external_pid(to)); + ctx->dep = dep; code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_DSP_NO_LOCK, !ctx->suspend); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: @@ -2201,7 +2185,6 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) if (dep == erts_this_dist_entry) { Eterm id; - erts_deref_dist_entry(dep); if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) @@ -2224,11 +2207,9 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) } ret = remote_send(p, dep, tp[1], to, msg, ctx); - if (ret != SEND_YIELD_CONTINUE) { - if (dep) { - erts_deref_dist_entry(dep); - } - } else { + if (ret == SEND_YIELD_CONTINUE) { + if (dep) + erts_ref_dist_entry(dep); ctx->dep_to_deref = dep; } return ret; @@ -2963,17 +2944,17 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) { Eterm res; byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT); - Sint i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); - + Sint written; + int i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS, + &written); if (i < 0) { erts_free(ERTS_ALC_T_TMP, (void *) buf); - i = erts_list_length(BIF_ARG_1); - if (i > MAX_ATOM_CHARACTERS) { + if (i == -2) { BIF_ERROR(BIF_P, SYSTEM_LIMIT); } BIF_ERROR(BIF_P, BADARG); } - res = erts_atom_put(buf, i, ERTS_ATOM_ENC_UTF8, 1); + res = erts_atom_put(buf, written, ERTS_ATOM_ENC_UTF8, 1); ASSERT(is_atom(res)); erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(res); @@ -2984,8 +2965,9 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1) { byte *buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_SZ_LIMIT); - Sint i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); - + Sint written; + int i = erts_unicode_list_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS, + &written); if (i < 0) { error: erts_free(ERTS_ALC_T_TMP, (void *) buf); @@ -2993,7 +2975,7 @@ BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1) } else { Eterm a; - if (erts_atom_get((char *) buf, i, &a, ERTS_ATOM_ENC_UTF8)) { + if (erts_atom_get((char *) buf, written, &a, ERTS_ATOM_ENC_UTF8)) { erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(a); } else { @@ -3888,15 +3870,18 @@ BIF_RETTYPE display_string_1(BIF_ALIST_1) { Process* p = BIF_P; Eterm string = BIF_ARG_1; - Sint len = is_string(string); - char *str; + Sint len = erts_unicode_list_to_buf_len(string); + Sint written; + byte *str; + int res; - if (len <= 0) { + if (len < 0) { BIF_ERROR(p, BADARG); } - str = (char *) erts_alloc(ERTS_ALC_T_TMP, sizeof(char)*(len + 1)); - if (intlist_to_buf(string, str, len) != len) - erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__); + str = (byte *) erts_alloc(ERTS_ALC_T_TMP, sizeof(char)*(len + 1)); + res = erts_unicode_list_to_buf(string, str, len, &written); + if (res != 0 || written != len) + erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error (%d)\n", __FILE__, __LINE__, res); str[len] = '\0'; erts_fprintf(stderr, "%s", str); erts_free(ERTS_ALC_T_TMP, (void *) str); @@ -3912,9 +3897,6 @@ BIF_RETTYPE display_nl_0(BIF_ALIST_0) /**********************************************************************/ -#define HALT_MSG_SIZE 200 -static char halt_msg[HALT_MSG_SIZE+1]; - /* stop the system with exit code and flags */ BIF_RETTYPE halt_2(BIF_ALIST_2) { @@ -3964,16 +3946,17 @@ BIF_RETTYPE halt_2(BIF_ALIST_2) erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_exit(ERTS_ABORT_EXIT, ""); } - else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) { - Sint i; + else if (is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) { +# define HALT_MSG_SIZE 200 + static byte halt_msg[4*HALT_MSG_SIZE+1]; + Sint written; - if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE)) == -1) { + if (erts_unicode_list_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE, + &written) == -1 ) { goto error; } - if (i == -2) /* truncated string */ - i = HALT_MSG_SIZE; - ASSERT(i >= 0 && i <= HALT_MSG_SIZE); - halt_msg[i] = '\0'; + ASSERT(written >= 0 && written < sizeof(halt_msg)); + halt_msg[written] = '\0'; VERBOSE(DEBUG_SYSTEM, ("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2)); erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); @@ -4162,7 +4145,6 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1) goto bad; if(dep == erts_this_dist_entry) { - erts_deref_dist_entry(dep); BIF_RET(make_internal_pid(make_pid_data(c, b))); } else { @@ -4182,13 +4164,10 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1) etp->data.ui[0] = make_pid_data(c, b); MSO(BIF_P).first = (struct erl_off_heap_header*) etp; - erts_deref_dist_entry(dep); BIF_RET(make_external_pid(etp)); } bad: - if (dep) - erts_deref_dist_entry(dep); if (buf) erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_ERROR(BIF_P, BADARG); @@ -4233,7 +4212,6 @@ BIF_RETTYPE list_to_port_1(BIF_ALIST_1) goto bad; if(dep == erts_this_dist_entry) { - erts_deref_dist_entry(dep); BIF_RET(make_internal_port(p)); } else { @@ -4253,13 +4231,10 @@ BIF_RETTYPE list_to_port_1(BIF_ALIST_1) etp->data.ui[0] = p; MSO(BIF_P).first = (struct erl_off_heap_header*) etp; - erts_deref_dist_entry(dep); BIF_RET(make_external_port(etp)); } bad: - if (dep) - erts_deref_dist_entry(dep); BIF_ERROR(BIF_P, BADARG); } @@ -4379,12 +4354,9 @@ BIF_RETTYPE list_to_ref_1(BIF_ALIST_1) res = make_external_ref(etp); } - erts_deref_dist_entry(dep); BIF_RET(res); bad: - if (dep) - erts_deref_dist_entry(dep); BIF_ERROR(BIF_P, BADARG); } diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 962b00ae7b..f7b4451890 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -154,6 +154,12 @@ bif erlang:spawn_opt/1 bif erlang:setnode/2 bif erlang:setnode/3 bif erlang:dist_exit/3 +bif erlang:dist_get_stat/1 +bif erlang:dist_ctrl_input_handler/2 +bif erlang:dist_ctrl_put_data/2 +bif erlang:dist_ctrl_get_data/1 +bif erlang:dist_ctrl_get_data_notification/1 + # Static native functions in erts_internal bif erts_internal:port_info/1 @@ -679,3 +685,9 @@ bif math:ceil/1 bif math:fmod/2 bif os:set_signal/2 bif erts_internal:maps_to_list/2 + +# +# New in 20.1 +# + +bif erlang:iolist_to_iovec/1 diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab new file mode 100644 index 0000000000..3c95113907 --- /dev/null +++ b/erts/emulator/beam/bif_instrs.tab @@ -0,0 +1,539 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +// ================================================================ +// All guards with zero arguments have special instructions, +// for example: +// +// self/0 +// node/0 +// +// All other guard BIFs take one or two arguments. +// ================================================================ + +CALL_GUARD_BIF(BF, TmpReg, Dst) { + Eterm result; + + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS; + PROCESS_MAIN_CHK_LOCKS(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + ERTS_CHK_MBUF_SZ(c_p); + result = (*$BF)(c_p, $TmpReg, I); + ERTS_CHK_MBUF_SZ(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + if (ERTS_LIKELY(is_value(result))) { + $Dst = result; + $NEXT0(); + } +} + +// Guard BIF in head. On failure, ignore the error and jump +// to the code for the next clause. We don't support tracing +// of guard BIFs. + +bif1(Fail, Bif, Src, Dst) { + ErtsBifFunc bf; + Eterm tmp_reg[1]; + + tmp_reg[0] = $Src; + bf = (BifFunction) $Bif; + $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + + $FAIL($Fail); +} + +// +// Guard BIF in body. It can fail like any BIF. No trace support. +// + +bif1_body(Bif, Src, Dst) { + ErtsBifFunc bf; + Eterm tmp_reg[1]; + + tmp_reg[0] = $Src; + bf = (BifFunction) $Bif; + $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + + reg[0] = tmp_reg[0]; + SWAPOUT; + I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); + goto post_error_handling; +} + +// +// Guard bif in guard with two arguments ('and'/2, 'or'/2, 'xor'/2). +// + +i_bif2(Fail, Bif, Src1, Src2, Dst) { + Eterm tmp_reg[2]; + ErtsBifFunc bf; + + tmp_reg[0] = $Src1; + tmp_reg[1] = $Src2; + bf = (ErtsBifFunc) $Bif; + $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + $FAIL($Fail); +} + +// +// Guard bif in body with two arguments ('and'/2, 'or'/2, 'xor'/2). +// + +i_bif2_body(Bif, Src1, Src2, Dst) { + Eterm tmp_reg[2]; + ErtsBifFunc bf; + + tmp_reg[0] = $Src1; + tmp_reg[1] = $Src2; + bf = (ErtsBifFunc) $Bif; + $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + reg[0] = tmp_reg[0]; + reg[1] = tmp_reg[1]; + SWAPOUT; + I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); + goto post_error_handling; +} + +// +// Garbage-collecting BIF with one argument in either guard or body. +// + +i_gc_bif1(Fail, Bif, Src, Live, Dst) { + typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); + GcBifFunction bf; + Eterm result; + Uint live = (Uint) $Live; + + x(live) = $Src; + bf = (GcBifFunction) $Bif; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS; + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_CHK_MBUF_SZ(c_p); + result = (*bf)(c_p, reg, live); + ERTS_CHK_MBUF_SZ(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + if (ERTS_LIKELY(is_value(result))) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + if (ERTS_LIKELY($Fail != 0)) { /* Handle error in guard. */ + $NEXT($Fail); + } + + /* Handle error in body. */ + x(0) = x(live); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); + goto post_error_handling; +} + +// +// Garbage-collecting BIF with two arguments in either guard or body. +// + +i_gc_bif2(Fail, Bif, Live, Src1, Src2, Dst) { + typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); + GcBifFunction bf; + Eterm result; + Uint live = (Uint) $Live; + + /* + * XXX This calling convention does not make sense. 'live' + * should point out the first argument, not the second + * (i.e. 'live' should not be incremented below). + */ + x(live) = $Src1; + x(live+1) = $Src2; + live++; + + bf = (GcBifFunction) $Bif; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS; + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_CHK_MBUF_SZ(c_p); + result = (*bf)(c_p, reg, live); + ERTS_CHK_MBUF_SZ(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + if (ERTS_LIKELY(is_value(result))) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + + if (ERTS_LIKELY($Fail != 0)) { /* Handle error in guard. */ + $NEXT($Fail); + } + + /* Handle error in body. */ + live--; + x(0) = x(live); + x(1) = x(live+1); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); + goto post_error_handling; +} + +// +// Garbage-collecting BIF with three arguments in either guard or body. +// + +i_gc_bif3(Fail, Bif, Live, Src2, Src3, Dst) { + typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); + GcBifFunction bf; + Eterm result; + Uint live = (Uint) $Live; + + /* + * XXX This calling convention does not make sense. 'live' + * should point out the first argument, not the third + * (i.e. 'live' should not be incremented below). + */ + x(live) = x(SCRATCH_X_REG); + x(live+1) = $Src2; + x(live+2) = $Src3; + live += 2; + + bf = (GcBifFunction) $Bif; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS; + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_CHK_MBUF_SZ(c_p); + result = (*bf)(c_p, reg, live); + ERTS_CHK_MBUF_SZ(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + if (ERTS_LIKELY(is_value(result))) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + + /* Handle error in guard. */ + if (ERTS_LIKELY($Fail != 0)) { + $NEXT($Fail); + } + + /* Handle error in body. */ + live -= 2; + x(0) = x(live); + x(1) = x(live+1); + x(2) = x(live+2); + I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); + goto post_error_handling; +} + +// +// The most general BIF call. The BIF may build any amount of data +// on the heap. The result is always returned in r(0). +// +call_bif(Exp) { + ErtsBifFunc bf; + Eterm result; + ErlHeapFragment *live_hf_end; + Export *export = (Export*) $Exp; + + if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) { + /* If we have run out of reductions, we do a context + switch before calling the bif */ + c_p->arity = GET_BIF_ARITY(export); + c_p->current = &export->info.mfa; + goto context_switch3; + } + + ERTS_MSACC_SET_BIF_STATE_CACHED_X(GET_BIF_MODULE(export), + GET_BIF_ADDRESS(export)); + + bf = GET_BIF_ADDRESS(export); + + PRE_BIF_SWAPOUT(c_p); + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS - 1; + if (FCALLS <= 0) { + save_calls(c_p, export); + } + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + live_hf_end = c_p->mbuf; + ERTS_CHK_MBUF_SZ(c_p); + result = (*bf)(c_p, reg, I); + ERTS_CHK_MBUF_SZ(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_HOLE_CHECK(c_p); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + if (ERTS_IS_GC_DESIRED(c_p)) { + Uint arity = GET_BIF_ARITY(export); + result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, + reg, arity); + E = c_p->stop; + } + PROCESS_MAIN_CHK_LOCKS(c_p); + HTOP = HEAP_TOP(c_p); + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + /* We have to update the cache if we are enabled in order + to make sure no book keeping is done after we disabled + msacc. We don't always do this as it is quite expensive. */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + ERTS_MSACC_UPDATE_CACHE_X(); + } + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + if (ERTS_LIKELY(is_value(result))) { + r(0) = result; + CHECK_TERM(r(0)); + $NEXT0(); + } else if (c_p->freason == TRAP) { + SET_CP(c_p, I+2); + SET_I(c_p->i); + SWAPIN; + Dispatch(); + } + + /* + * Error handling. SWAPOUT is not needed because it was done above. + */ + ASSERT(c_p->stop == E); + I = handle_error(c_p, I, reg, &export->info.mfa); + goto post_error_handling; +} + +// +// Send is almost a standard call-BIF with two arguments, except for: +// 1. It cannot be traced. +// 2. There is no pointer to the send_2 function stored in +// the instruction. +// + +send() { + Eterm result; + + if (!(FCALLS > 0 || FCALLS > neg_o_reds)) { + /* If we have run out of reductions, we do a context + switch before calling the bif */ + c_p->arity = 2; + c_p->current = NULL; + goto context_switch3; + } + + PRE_BIF_SWAPOUT(c_p); + c_p->fcalls = FCALLS - 1; + result = erl_send(c_p, r(0), x(1)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + HTOP = HEAP_TOP(c_p); + FCALLS = c_p->fcalls; + if (ERTS_LIKELY(is_value(result))) { + r(0) = result; + CHECK_TERM(r(0)); + } else if (c_p->freason == TRAP) { + SET_CP(c_p, I+1); + SET_I(c_p->i); + SWAPIN; + Dispatch(); + } else { + goto find_func_info; + } +} + +call_nif := nif_bif.call_nif.epilogue; +apply_bif := nif_bif.apply_bif.epilogue; + +nif_bif.head() { + Eterm nif_bif_result; + Eterm bif_nif_arity; + BifFunction vbf; + ErlHeapFragment *live_hf_end; + ErtsCodeMFA *codemfa; +} + +nif_bif.call_nif() { + /* + * call_nif is always first instruction in function: + * + * I[-3]: Module + * I[-2]: Function + * I[-1]: Arity + * I[0]: &&call_nif + * I[1]: Function pointer to NIF function + * I[2]: Pointer to erl_module_nif + * I[3]: Function pointer to dirty NIF + * + * This layout is determined by the NifExport struct + */ + + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); + + codemfa = erts_code_to_codemfa(I); + + c_p->current = codemfa; /* current and vbf set to please handle_error */ + + DTRACE_NIF_ENTRY(c_p, codemfa); + + HEAVY_SWAPOUT; + + PROCESS_MAIN_CHK_LOCKS(c_p); + bif_nif_arity = codemfa->arity; + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + { + typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); + NifF* fp = vbf = (NifF*) I[1]; + struct enif_environment_t env; + ASSERT(c_p->scheduler_data); + live_hf_end = c_p->mbuf; + ERTS_CHK_MBUF_SZ(c_p); + erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL); + nif_bif_result = (*fp)(&env, bif_nif_arity, reg); + if (env.exception_thrown) + nif_bif_result = THE_NON_VALUE; + erts_post_nif(&env); + ERTS_CHK_MBUF_SZ(c_p); + + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + ASSERT(!env.exiting); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + } + + DTRACE_NIF_RETURN(c_p, codemfa); +} + +nif_bif.apply_bif() { + /* + * At this point, I points to the code[0] in the export entry for + * the BIF: + * + * code[-3]: Module + * code[-2]: Function + * code[-1]: Arity + * code[0]: &&apply_bif + * code[1]: Function pointer to BIF function + */ + + if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) { + /* If we have run out of reductions, we do a context + switch before calling the bif */ + goto context_switch; + } + + codemfa = erts_code_to_codemfa(I); + + ERTS_MSACC_SET_BIF_STATE_CACHED_X(codemfa->module, (BifFunction)Arg(0)); + + + /* In case we apply process_info/1,2 or load_nif/1 */ + c_p->current = codemfa; + c_p->i = I; /* In case we apply check_process_code/2. */ + c_p->arity = 0; /* To allow garbage collection on ourselves + * (check_process_code/2). + */ + DTRACE_BIF_ENTRY(c_p, codemfa); + + SWAPOUT; + ERTS_DBG_CHK_REDS(c_p, FCALLS - 1); + c_p->fcalls = FCALLS - 1; + vbf = (BifFunction) Arg(0); + PROCESS_MAIN_CHK_LOCKS(c_p); + bif_nif_arity = codemfa->arity; + ASSERT(bif_nif_arity <= 4); + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + { + ErtsBifFunc bf = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + live_hf_end = c_p->mbuf; + ERTS_CHK_MBUF_SZ(c_p); + nif_bif_result = (*bf)(c_p, reg, I); + ERTS_CHK_MBUF_SZ(c_p); + 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); + } + /* We have to update the cache if we are enabled in order + to make sure no book keeping is done after we disabled + msacc. We don't always do this as it is quite expensive. */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) + ERTS_MSACC_UPDATE_CACHE_X(); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + DTRACE_BIF_RETURN(c_p, codemfa); +} + +nif_bif.epilogue() { + ERTS_REQ_PROC_MAIN_LOCK(c_p); + ERTS_HOLE_CHECK(c_p); + if (ERTS_IS_GC_DESIRED(c_p)) { + nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, + nif_bif_result, + reg, bif_nif_arity); + } + SWAPIN; /* There might have been a garbage collection. */ + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + if (ERTS_LIKELY(is_value(nif_bif_result))) { + r(0) = nif_bif_result; + CHECK_TERM(r(0)); + SET_I(c_p->cp); + c_p->cp = 0; + Goto(*I); + } else if (c_p->freason == TRAP) { + SET_I(c_p->i); + if (c_p->flags & F_HIBERNATE_SCHED) { + c_p->flags &= ~F_HIBERNATE_SCHED; + goto do_schedule; + } + Dispatch(); + } + I = handle_error(c_p, c_p->cp, reg, c_p->current); + goto post_error_handling; +} diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab new file mode 100644 index 0000000000..a4d4afe7d4 --- /dev/null +++ b/erts/emulator/beam/bs_instrs.tab @@ -0,0 +1,1023 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +%if ARCH_64 +BS_SAFE_MUL(A, B, Fail, Dst) { + Uint64 res = ($A) * ($B); + if (res / $B != $A) { + $Fail; + } + $Dst = res; +} +%else +BS_SAFE_MUL(A, B, Fail, Dst) { + Uint64 res = (Uint64)($A) * (Uint64)($B); + if ((res >> (8*sizeof(Uint))) != 0) { + $Fail; + } + $Dst = res; +} +%endif + +BS_GET_FIELD_SIZE(Bits, Unit, Fail, Dst) { + Sint signed_size; + Uint uint_size; + Uint temp_bits; + + if (is_small($Bits)) { + signed_size = signed_val($Bits); + if (signed_size < 0) { + $Fail; + } + uint_size = (Uint) signed_size; + } else { + if (!term_to_Uint($Bits, &temp_bits)) { + $Fail; + } + uint_size = temp_bits; + } + $BS_SAFE_MUL(uint_size, $Unit, $Fail, $Dst); +} + +BS_GET_UNCHECKED_FIELD_SIZE(Bits, Unit, Fail, Dst) { + Sint signed_size; + Uint uint_size; + Uint temp_bits; + + if (is_small($Bits)) { + signed_size = signed_val($Bits); + if (signed_size < 0) { + $Fail; + } + uint_size = (Uint) signed_size; + } else { + if (!term_to_Uint($Bits, &temp_bits)) { + $Fail; + } + uint_size = temp_bits; + } + $Dst = uint_size * $Unit; +} + +TEST_BIN_VHEAP(VNh, Nh, Live) { + Uint need = $Nh; + if (E - HTOP < need || MSO(c_p).overhead + $VNh >= BIN_VHEAP_SZ(c_p)) { + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + } + HEAP_SPACE_VERIFIED(need); +} + +i_bs_get_binary_all2(Fail, Ms, Live, Unit, Dst) { + ErlBinMatchBuffer *_mb; + Eterm _result; + + $GC_TEST(0, ERL_SUB_BIN_SIZE, $Live); + _mb = ms_matchbuffer($Ms); + if (((_mb->size - _mb->offset) % $Unit) == 0) { + LIGHT_SWAPOUT; + _result = erts_bs_get_binary_all_2(c_p, _mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + ASSERT(is_value(_result)); + $Dst = _result; + } else { + HEAP_SPACE_VERIFIED(0); + $FAIL($Fail); + } +} + +i_bs_get_binary2(Fail, Ms, Live, Sz, Flags, Dst) { + ErlBinMatchBuffer *_mb; + Eterm _result; + Uint _size; + $BS_GET_FIELD_SIZE($Sz, (($Flags) >> 3), $FAIL($Fail), _size); + $GC_TEST(0, ERL_SUB_BIN_SIZE, $Live); + _mb = ms_matchbuffer($Ms); + LIGHT_SWAPOUT; + _result = erts_bs_get_binary_2(c_p, _size, $Flags, _mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(_result)) { + $FAIL($Fail); + } else { + $Dst = _result; + } +} + +i_bs_get_binary_imm2(Fail, Ms, Live, Sz, Flags, Dst) { + ErlBinMatchBuffer *_mb; + Eterm _result; + $GC_TEST(0, heap_bin_size(ERL_ONHEAP_BIN_LIMIT), $Live); + _mb = ms_matchbuffer($Ms); + LIGHT_SWAPOUT; + _result = erts_bs_get_binary_2(c_p, $Sz, $Flags, _mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(_result)) { + $FAIL($Fail); + } else { + $Dst = _result; + } +} + +i_bs_get_float2(Fail, Ms, Live, Sz, Flags, Dst) { + ErlBinMatchBuffer *_mb; + Eterm _result; + Sint _size; + + if (!is_small($Sz) || (_size = unsigned_val($Sz)) > 64) { + $FAIL($Fail); + } + _size *= (($Flags) >> 3); + $GC_TEST(0, FLOAT_SIZE_OBJECT, $Live); + _mb = ms_matchbuffer($Ms); + LIGHT_SWAPOUT; + _result = erts_bs_get_float_2(c_p, _size, ($Flags), _mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(_result)) { + $FAIL($Fail); + } else { + $Dst = _result; + } +} + +i_bs_skip_bits2(Fail, Ms, Bits, Unit) { + ErlBinMatchBuffer *_mb; + size_t new_offset; + Uint _size; + + _mb = ms_matchbuffer($Ms); + $BS_GET_FIELD_SIZE($Bits, $Unit, $FAIL($Fail), _size); + new_offset = _mb->offset + _size; + if (new_offset <= _mb->size) { + _mb->offset = new_offset; + } else { + $FAIL($Fail); + } +} + +i_bs_skip_bits_all2(Fail, Ms, Unit) { + ErlBinMatchBuffer *_mb; + _mb = ms_matchbuffer($Ms); + if (((_mb->size - _mb->offset) % $Unit) == 0) { + _mb->offset = _mb->size; + } else { + $FAIL($Fail); + } +} + +i_bs_skip_bits_imm2(Fail, Ms, Bits) { + ErlBinMatchBuffer *_mb; + size_t new_offset; + _mb = ms_matchbuffer($Ms); + new_offset = _mb->offset + ($Bits); + if (new_offset <= _mb->size) { + _mb->offset = new_offset; + } else { + $FAIL($Fail); + } +} + +i_new_bs_put_binary(Fail, Sz, Flags, Src) { + Sint _size; + $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size); + if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), _size))) { + $BADARG($Fail); + } +} + +i_new_bs_put_binary_all(Fail, Src, Unit) { + if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2(($Src), ($Unit)))) { + $BADARG($Fail); + } +} + +i_new_bs_put_binary_imm(Fail, Sz, Src) { + if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), ($Sz)))) { + $BADARG($Fail); + } +} + +i_new_bs_put_float(Fail, Sz, Flags, Src) { + Sint _size; + $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size); + if (!erts_new_bs_put_float(c_p, ($Src), _size, ($Flags))) { + $BADARG($Fail); + } +} + +i_new_bs_put_float_imm(Fail, Sz, Flags, Src) { + if (!erts_new_bs_put_float(c_p, ($Src), ($Sz), ($Flags))) { + $BADARG($Fail); + } +} + +i_new_bs_put_integer(Fail, Sz, Flags, Src) { + Sint _size; + $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size); + if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), _size, ($Flags)))) { + $BADARG($Fail); + } +} + +i_new_bs_put_integer_imm(Fail, Sz, Flags, Src) { + if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), ($Sz), ($Flags)))) { + $BADARG($Fail); + } +} + +# +# i_bs_init* +# + +i_bs_init_fail_heap := bs_init.fail_heap.verify.execute; +i_bs_init_fail := bs_init.fail.verify.execute; +i_bs_init := bs_init.plain.execute; +i_bs_init_heap := bs_init.heap.execute; + +bs_init.head() { + Eterm BsOp1; + Eterm BsOp2; +} + +bs_init.fail_heap(Size, HeapAlloc) { + BsOp1 = $Size; + BsOp2 = $HeapAlloc; +} + +bs_init.fail(Size) { + BsOp1 = $Size; + BsOp2 = 0; +} + +bs_init.plain(Size) { + BsOp1 = $Size; + BsOp2 = 0; +} + +bs_init.heap(Size, HeapAlloc) { + BsOp1 = $Size; + BsOp2 = $HeapAlloc; +} + +bs_init.verify(Fail) { + if (is_small(BsOp1)) { + Sint size = signed_val(BsOp1); + if (size < 0) { + $BADARG($Fail); + } + BsOp1 = (Eterm) size; + } else { + Uint bytes; + + if (!term_to_Uint(BsOp1, &bytes)) { + c_p->freason = bytes; + $FAIL_HEAD_OR_BODY($Fail); + } + if ((bytes >> (8*sizeof(Uint)-3)) != 0) { + $SYSTEM_LIMIT($Fail); + } + BsOp1 = (Eterm) bytes; + } +} + +bs_init.execute(Live, Dst) { + if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin* hb; + Uint bin_need; + + bin_need = heap_bin_size(BsOp1); + erts_bin_offset = 0; + erts_writable_bin = 0; + $GC_TEST(0, bin_need+BsOp2+ERL_SUB_BIN_SIZE, $Live); + hb = (ErlHeapBin *) HTOP; + HTOP += bin_need; + hb->thing_word = header_heap_bin(BsOp1); + hb->size = BsOp1; + erts_current_bin = (byte *) hb->data; + $Dst = make_binary(hb); + } else { + Binary* bptr; + ProcBin* pb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + $TEST_BIN_VHEAP(BsOp1 / sizeof(Eterm), + BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, $Live); + + /* + * Allocate the binary struct itself. + */ + bptr = erts_bin_nrml_alloc(BsOp1); + erts_current_bin = (byte *) bptr->orig_bytes; + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) HTOP; + HTOP += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = BsOp1; + pb->next = MSO(c_p).first; + MSO(c_p).first = (struct erl_off_heap_header*) pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + + OH_OVERHEAD(&(MSO(c_p)), BsOp1 / sizeof(Eterm)); + + $Dst = make_binary(pb); + } +} + +# +# i_bs_init_bits* +# + +i_bs_init_bits := bs_init_bits.plain.execute; +i_bs_init_bits_heap := bs_init_bits.heap.execute; +i_bs_init_bits_fail := bs_init_bits.fail.verify.execute; +i_bs_init_bits_fail_heap := bs_init_bits.fail_heap.verify.execute; + +bs_init_bits.head() { + Eterm new_binary; + Eterm num_bits_term; + Uint num_bits; + Uint alloc; + Uint num_bytes; +} + +bs_init_bits.plain(NumBits) { + num_bits = $NumBits; + alloc = 0; +} + +bs_init_bits.heap(NumBits, Alloc) { + num_bits = $NumBits; + alloc = $Alloc; +} + +bs_init_bits.fail(NumBitsTerm) { + num_bits_term = $NumBitsTerm; + alloc = 0; +} + +bs_init_bits.fail_heap(NumBitsTerm, Alloc) { + num_bits_term = $NumBitsTerm; + alloc = $Alloc; +} + +bs_init_bits.verify(Fail) { + if (is_small(num_bits_term)) { + Sint size = signed_val(num_bits_term); + if (size < 0) { + $BADARG($Fail); + } + num_bits = (Uint) size; + } else { + Uint bits; + + if (!term_to_Uint(num_bits_term, &bits)) { + c_p->freason = bits; + $FAIL_HEAD_OR_BODY($Fail); + } + num_bits = (Uint) bits; + } +} + +bs_init_bits.execute(Live, Dst) { + num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3; + if (num_bits & 7) { + alloc += ERL_SUB_BIN_SIZE; + } + if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { + alloc += heap_bin_size(num_bytes); + } else { + alloc += PROC_BIN_SIZE; + } + $test_heap(alloc, $Live); + + /* num_bits = Number of bits to build + * num_bytes = Number of bytes to allocate in the binary + * alloc = Total number of words to allocate on heap + * Operands: NotUsed NotUsed Dst + */ + if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin* hb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + hb = (ErlHeapBin *) HTOP; + HTOP += heap_bin_size(num_bytes); + hb->thing_word = header_heap_bin(num_bytes); + hb->size = num_bytes; + erts_current_bin = (byte *) hb->data; + new_binary = make_binary(hb); + + do_bits_sub_bin: + if (num_bits & 7) { + ErlSubBin* sb; + + sb = (ErlSubBin *) HTOP; + HTOP += ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = num_bytes - 1; + sb->bitsize = num_bits & 7; + sb->offs = 0; + sb->bitoffs = 0; + sb->is_writable = 0; + sb->orig = new_binary; + new_binary = make_binary(sb); + } + HEAP_SPACE_VERIFIED(0); + $Dst = new_binary; + } else { + Binary* bptr; + ProcBin* pb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + + /* + * Allocate the binary struct itself. + */ + bptr = erts_bin_nrml_alloc(num_bytes); + erts_current_bin = (byte *) bptr->orig_bytes; + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) HTOP; + HTOP += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = num_bytes; + pb->next = MSO(c_p).first; + MSO(c_p).first = (struct erl_off_heap_header*) pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(&(MSO(c_p)), pb->size / sizeof(Eterm)); + new_binary = make_binary(pb); + goto do_bits_sub_bin; + } +} + +bs_add(Fail, Src1, Src2, Unit, Dst) { + Eterm Op1 = $Src1; + Eterm Op2 = $Src2; + Uint unit = $Unit; + + if (is_both_small(Op1, Op2)) { + Sint Arg1 = signed_val(Op1); + Sint Arg2 = signed_val(Op2); + + if (Arg1 >= 0 && Arg2 >= 0) { + $BS_SAFE_MUL(Arg2, unit, $SYSTEM_LIMIT($Fail), Op1); + Op1 += Arg1; + + store_bs_add_result: + if (Op1 <= MAX_SMALL) { + Op1 = make_small(Op1); + } else { + /* + * May generate a heap fragment, but in this + * particular case it is OK, since the value will be + * stored into an x register (the GC will scan x + * registers for references to heap fragments) and + * there is no risk that value can be stored into a + * location that is not scanned for heap-fragment + * references (such as the heap). + */ + SWAPOUT; + Op1 = erts_make_integer(Op1, c_p); + HTOP = HEAP_TOP(c_p); + } + $Dst = Op1; + $NEXT0(); + } + $BADARG($Fail); + } else { + Uint a; + Uint b; + Uint c; + + /* + * Now we know that one of the arguments is + * not a small. We must convert both arguments + * to Uints and check for errors at the same time. + * + * Error checking is tricky. + * + * If one of the arguments is not numeric or + * not positive, the error reason is BADARG. + * + * Otherwise if both arguments are numeric, + * but at least one argument does not fit in + * an Uint, the reason is SYSTEM_LIMIT. + */ + + if (!term_to_Uint(Op1, &a)) { + if (a == BADARG) { + $BADARG($Fail); + } + if (!term_to_Uint(Op2, &b)) { + c_p->freason = b; + $FAIL_HEAD_OR_BODY($Fail); + } + $SYSTEM_LIMIT($Fail); + } else if (!term_to_Uint(Op2, &b)) { + c_p->freason = b; + $FAIL_HEAD_OR_BODY($Fail); + } + + /* + * The arguments are now correct and stored in a and b. + */ + + $BS_SAFE_MUL(b, unit, $SYSTEM_LIMIT($Fail), c); + Op1 = a + c; + if (Op1 < a) { + /* + * If the result is less than one of the + * arguments, there must have been an overflow. + */ + $SYSTEM_LIMIT($Fail); + } + goto store_bs_add_result; + } + /* No fallthrough */ + ASSERT(0); +} + +bs_put_string(Len, Ptr) { + erts_new_bs_put_string(ERL_BITS_ARGS_2((byte *) $Ptr, $Len)); +} + +i_bs_append(Fail, ExtraHeap, Live, Unit, Size, Dst) { + Uint live = $Live; + Uint res; + + HEAVY_SWAPOUT; + reg[live] = x(SCRATCH_X_REG); + res = erts_bs_append(c_p, reg, live, $Size, $ExtraHeap, $Unit); + HEAVY_SWAPIN; + if (is_non_value(res)) { + /* c_p->freason is already set (to BADARG or SYSTEM_LIMIT). */ + $FAIL_HEAD_OR_BODY($Fail); + } + $Dst = res; +} + +i_bs_private_append(Fail, Unit, Size, Src, Dst) { + Eterm res; + + res = erts_bs_private_append(c_p, $Src, $Size, $Unit); + if (is_non_value(res)) { + /* c_p->freason is already set (to BADARG or SYSTEM_LIMIT). */ + $FAIL_HEAD_OR_BODY($Fail); + } + $Dst = res; +} + +bs_init_writable() { + HEAVY_SWAPOUT; + r(0) = erts_bs_init_writable(c_p, r(0)); + HEAVY_SWAPIN; +} + +i_bs_utf8_size(Src, Dst) { + Eterm arg = $Src; + Eterm result; + + /* + * Calculate the number of bytes needed to encode the source + * operand to UTF-8. If the source operand is invalid (e.g. wrong + * type or range) we return a nonsense integer result (0 or 4). We + * can get away with that because we KNOW that bs_put_utf8 will do + * full error checking. + */ + + if (arg < make_small(0x80UL)) { + result = make_small(1); + } else if (arg < make_small(0x800UL)) { + result = make_small(2); + } else if (arg < make_small(0x10000UL)) { + result = make_small(3); + } else { + result = make_small(4); + } + $Dst = result; +} + +i_bs_put_utf8(Fail, Src) { + if (!erts_bs_put_utf8(ERL_BITS_ARGS_1($Src))) { + $BADARG($Fail); + } +} + +i_bs_utf16_size(Src, Dst) { + Eterm arg = $Src; + Eterm result = make_small(2); + + /* + * Calculate the number of bytes needed to encode the source + * operarand to UTF-16. If the source operand is invalid (e.g. wrong + * type or range) we return a nonsense integer result (2 or 4). We + * can get away with that because we KNOW that bs_put_utf16 will do + * full error checking. + */ + + if (arg >= make_small(0x10000UL)) { + result = make_small(4); + } + $Dst = result; +} + +bs_put_utf16(Fail, Flags, Src) { + if (!erts_bs_put_utf16(ERL_BITS_ARGS_2($Src, $Flags))) { + $BADARG($Fail); + } +} + +// Validate a value about to be stored in a binary. +i_bs_validate_unicode(Fail, Src) { + Eterm val = $Src; + + /* + * There is no need to untag the integer, but it IS necessary + * to make sure it is small (if the term is a bignum, it could + * slip through the test, and there is no further test that + * would catch it, since bit syntax construction silently masks + * too big numbers). + */ + if (is_not_small(val) || val > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) { + $BADARG($Fail); + } +} + +// Validate a value that has been matched out. +i_bs_validate_unicode_retract(Fail, Src, Ms) { + /* + * There is no need to untag the integer, but it IS necessary + * to make sure it is small (a bignum pointer could fall in + * the valid range). + */ + + Eterm i = $Src; + if (is_not_small(i) || i > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) { + Eterm ms = $Ms; /* Match context */ + ErlBinMatchBuffer* mb; + + /* Invalid value. Retract the position in the binary. */ + mb = ms_matchbuffer(ms); + mb->offset -= 32; + $BADARG($Fail); + } +} + + +// +// Matching of binaries. +// + +i_bs_start_match2 := bs_start_match.fetch.execute; + +bs_start_match.head() { + Uint slots; + Uint live; + Eterm header; + Eterm context; +} + +bs_start_match.fetch(Src) { + context = $Src; +} + +bs_start_match.execute(Fail, Live, Slots, Dst) { + if (!is_boxed(context)) { + $FAIL($Fail); + } + header = *boxed_val(context); + slots = $Slots; + live = $Live; + if (header_is_bin_matchstate(header)) { + ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(context); + Uint actual_slots = HEADER_NUM_SLOTS(header); + ms->save_offset[0] = ms->mb.offset; + if (actual_slots < slots) { + ErlBinMatchState* dst; + Uint live = $Live; + Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); + + $GC_TEST_PRESERVE(wordsneeded, live, context); + ms = (ErlBinMatchState *) boxed_val(context); + dst = (ErlBinMatchState *) HTOP; + *dst = *ms; + *HTOP = HEADER_BIN_MATCHSTATE(slots); + HTOP += wordsneeded; + HEAP_SPACE_VERIFIED(0); + $Dst = make_matchstate(dst); + } + } else if (is_binary_header(header)) { + Eterm result; + Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); + $GC_TEST_PRESERVE(wordsneeded, live, context); + HEAP_TOP(c_p) = HTOP; +#ifdef DEBUG + c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */ +#endif + result = erts_bs_start_match_2(c_p, context, slots); + HTOP = HEAP_TOP(c_p); + HEAP_SPACE_VERIFIED(0); + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; + } else { + $FAIL($Fail); + } +} + +bs_test_zero_tail2(Fail, Ctx) { + ErlBinMatchBuffer *_mb; + _mb = (ErlBinMatchBuffer*) ms_matchbuffer($Ctx); + if (_mb->size != _mb->offset) { + $FAIL($Fail); + } +} + +bs_test_tail_imm2(Fail, Ctx, Offset) { + ErlBinMatchBuffer *_mb; + _mb = ms_matchbuffer($Ctx); + if (_mb->size - _mb->offset != $Offset) { + $FAIL($Fail); + } +} + +bs_test_unit(Fail, Ctx, Unit) { + ErlBinMatchBuffer *_mb; + _mb = ms_matchbuffer($Ctx); + if ((_mb->size - _mb->offset) % $Unit) { + $FAIL($Fail); + } +} + +bs_test_unit8(Fail, Ctx) { + ErlBinMatchBuffer *_mb; + _mb = ms_matchbuffer($Ctx); + if ((_mb->size - _mb->offset) & 7) { + $FAIL($Fail); + } +} + +i_bs_get_integer_8(Ctx, Fail, Dst) { + Eterm _result; + ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx); + + if (_mb->size - _mb->offset < 8) { + $FAIL($Fail); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _result = erts_bs_get_integer_2(c_p, 8, 0, _mb); + } else { + _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]); + _mb->offset += 8; + } + $Dst = _result; +} + +i_bs_get_integer_16(Ctx, Fail, Dst) { + Eterm _result; + ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx); + + if (_mb->size - _mb->offset < 16) { + $FAIL($Fail); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _result = erts_bs_get_integer_2(c_p, 16, 0, _mb); + } else { + _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset))); + _mb->offset += 16; + } + $Dst = _result; +} + +%if ARCH_64 +i_bs_get_integer_32(Ctx, Fail, Dst) { + Uint32 _integer; + ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx); + + if (_mb->size - _mb->offset < 32) { + $FAIL($Fail); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _integer = erts_bs_get_unaligned_uint32(_mb); + } else { + _integer = get_int32(_mb->base + _mb->offset/8); + } + _mb->offset += 32; + $Dst = make_small(_integer); +} +%endif + +i_bs_get_integer_imm := bs_get_integer.fetch.execute; +i_bs_get_integer_small_imm := bs_get_integer.fetch_small.execute; + +bs_get_integer.head() { + Eterm Ms, Sz; +} + +bs_get_integer.fetch(Ctx, Size, Live) { + Uint wordsneeded; + Ms = $Ctx; + Sz = $Size; + wordsneeded = 1+WSIZE(NBYTES(Sz)); + $GC_TEST_PRESERVE(wordsneeded, $Live, Ms); +} + +bs_get_integer.fetch_small(Ctx, Size) { + Ms = $Ctx; + Sz = $Size; +} + +bs_get_integer.execute(Fail, Flags, Dst) { + ErlBinMatchBuffer* mb; + Eterm result; + + mb = ms_matchbuffer(Ms); + LIGHT_SWAPOUT; + result = erts_bs_get_integer_2(c_p, Sz, $Flags, mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; +} + +i_bs_get_integer(Fail, Live, FlagsAndUnit, Ms, Sz, Dst) { + Uint flags; + Uint size; + Eterm ms; + ErlBinMatchBuffer* mb; + Eterm result; + + flags = $FlagsAndUnit; + ms = $Ms; + $BS_GET_FIELD_SIZE($Sz, (flags >> 3), $FAIL($Fail), size); + if (size >= SMALL_BITS) { + Uint wordsneeded; + /* Check bits size before potential gc. + * We do not want a gc and then realize we don't need + * the allocated space (i.e. if the op fails). + * + * Remember to re-acquire the matchbuffer after gc. + */ + + mb = ms_matchbuffer(ms); + if (mb->size - mb->offset < size) { + $FAIL($Fail); + } + wordsneeded = 1+WSIZE(NBYTES((Uint) size)); + $GC_TEST_PRESERVE(wordsneeded, $Live, ms); + } + mb = ms_matchbuffer(ms); + LIGHT_SWAPOUT; + result = erts_bs_get_integer_2(c_p, size, flags, mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; +} + +i_bs_get_utf8(Ctx, Fail, Dst) { + ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx); + Eterm result = erts_bs_get_utf8(mb); + + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; +} + +i_bs_get_utf16(Ctx, Fail, Flags, Dst) { + ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx); + Eterm result = erts_bs_get_utf16(mb, $Flags); + + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; +} + +bs_context_to_binary := ctx_to_bin.fetch.execute; +i_bs_get_binary_all_reuse := ctx_to_bin.fetch_bin.execute; + +ctx_to_bin.head() { + Eterm context; + ErlBinMatchBuffer* mb; + ErlSubBin* sb; + Uint size; + Uint offs; + Uint orig; + Uint hole_size; +} + +ctx_to_bin.fetch(Src) { + context = $Src; + if (is_boxed(context) && + header_is_bin_matchstate(*boxed_val(context))) { + ErlBinMatchState* ms; + ms = (ErlBinMatchState *) boxed_val(context); + mb = &ms->mb; + offs = ms->save_offset[0]; + size = mb->size - offs; + } else { + $NEXT0(); + } +} + +ctx_to_bin.fetch_bin(Src, Fail, Unit) { + context = $Src; + mb = ms_matchbuffer(context); + size = mb->size - mb->offset; + if (size % $Unit != 0) { + $FAIL($Fail); + } + offs = mb->offset; +} + +ctx_to_bin.execute() { + orig = mb->orig; + sb = (ErlSubBin *) boxed_val(context); + hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = BYTE_OFFSET(size); + sb->bitsize = BIT_OFFSET(size); + sb->offs = BYTE_OFFSET(offs); + sb->bitoffs = BIT_OFFSET(offs); + sb->is_writable = 0; + sb->orig = orig; + if (hole_size) { + sb[1].thing_word = make_pos_bignum_header(hole_size-1); + } +} + +i_bs_match_string(Ctx, Fail, Bits, Ptr) { + byte* bytes = (byte *) $Ptr; + Uint bits = $Bits; + ErlBinMatchBuffer* mb; + Uint offs; + + mb = ms_matchbuffer($Ctx); + if (mb->size - mb->offset < bits) { + $FAIL($Fail); + } + offs = mb->offset & 7; + if (offs == 0 && (bits & 7) == 0) { + if (sys_memcmp(bytes, mb->base+(mb->offset>>3), bits>>3)) { + $FAIL($Fail); + } + } else if (erts_cmp_bits(bytes, 0, mb->base+(mb->offset>>3), mb->offset & 7, bits)) { + $FAIL($Fail); + } + mb->offset += bits; +} + +i_bs_save2(Src, Slot) { + ErlBinMatchState* _ms = (ErlBinMatchState*) boxed_val((Eterm) $Src); + _ms->save_offset[$Slot] = _ms->mb.offset; +} + +i_bs_restore2(Src, Slot) { + ErlBinMatchState* _ms = (ErlBinMatchState*) boxed_val((Eterm) $Src); + _ms->mb.offset = _ms->save_offset[$Slot]; +} diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 491c4d378e..bc168fc58d 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -121,7 +121,7 @@ Export* dexit_trap = NULL; Export* dmonitor_p_trap = NULL; /* local variables */ - +static Export *dist_ctrl_put_data_trap; /* forward declarations */ @@ -156,9 +156,7 @@ create_cache(DistEntry *dep) int i; ErtsAtomCache *cp; - ERTS_LC_ASSERT( - is_internal_port(dep->cid) - && erts_lc_is_port_locked(erts_port_lookup_raw(dep->cid))); + ERTS_LC_ASSERT(is_nil(dep->cid)); ASSERT(!dep->cache); dep->cache = cp = (ErtsAtomCache*) erts_alloc(ERTS_ALC_T_DCACHE, @@ -176,11 +174,13 @@ Uint erts_dist_cache_size(void) } static ErtsProcList * -get_suspended_on_de(DistEntry *dep, Uint32 unset_qflgs) +get_suspended_on_de(DistEntry *dep, erts_aint32_t unset_qflgs) { + erts_aint32_t qflgs; ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&dep->qlock)); - dep->qflgs &= ~unset_qflgs; - if (dep->qflgs & ERTS_DE_QFLG_EXIT) { + qflgs = erts_atomic32_read_band_acqb(&dep->qflgs, ~unset_qflgs); + qflgs &= ~unset_qflgs; + if (qflgs & ERTS_DE_QFLG_EXIT) { /* No resume when exit has been scheduled */ return NULL; } @@ -446,7 +446,35 @@ inc_no_nodes(void) #endif erts_atomic_inc_mb(&no_nodes); } - + +static void +kill_dist_ctrl_proc(void *vpid) +{ + Eterm pid = (Eterm) vpid; + ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; + Process *rp = erts_pid2proc(NULL, 0, pid, rp_locks); + if (rp) { + erts_send_exit_signal(NULL, rp->common.id, rp, &rp_locks, + am_kill, NIL, NULL, 0); + if (rp_locks) + erts_proc_unlock(rp, rp_locks); + } +} + +static void +schedule_kill_dist_ctrl_proc(Eterm pid) +{ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + int sched_id = 1; + if (!esdp || ERTS_SCHEDULER_IS_DIRTY(esdp)) + sched_id = 1; + else + sched_id = (int) esdp->no; + erts_schedule_misc_aux_work(sched_id, + kill_dist_ctrl_proc, + (void *) (UWord) pid); +} + /* * proc is currently running or exiting process. */ @@ -456,58 +484,62 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) if (dep == erts_this_dist_entry) { /* Net kernel has died (clean up!!) */ DistEntry *tdep; - int no_dist_port = 0; + int no_dist_ctrl = 0; Eterm nd_reason = (reason == am_no_network ? am_no_network : am_net_kernel_terminated); erts_rwmtx_rlock(&erts_dist_table_rwmtx); for (tdep = erts_hidden_dist_entries; tdep; tdep = tdep->next) - no_dist_port++; + no_dist_ctrl++; for (tdep = erts_visible_dist_entries; tdep; tdep = tdep->next) - no_dist_port++; + no_dist_ctrl++; /* KILL all port controllers */ - if (no_dist_port == 0) + if (no_dist_ctrl == 0) erts_rwmtx_runlock(&erts_dist_table_rwmtx); else { Eterm def_buf[128]; int i = 0; - Eterm *dist_port; + Eterm *dist_ctrl; - if (no_dist_port <= sizeof(def_buf)/sizeof(def_buf[0])) - dist_port = &def_buf[0]; + if (no_dist_ctrl <= sizeof(def_buf)/sizeof(def_buf[0])) + dist_ctrl = &def_buf[0]; else - dist_port = erts_alloc(ERTS_ALC_T_TMP, - sizeof(Eterm)*no_dist_port); + dist_ctrl = erts_alloc(ERTS_ALC_T_TMP, + sizeof(Eterm)*no_dist_ctrl); for (tdep = erts_hidden_dist_entries; tdep; tdep = tdep->next) { - ASSERT(is_internal_port(tdep->cid)); - dist_port[i++] = tdep->cid; + ASSERT(is_internal_port(tdep->cid) || is_internal_pid(tdep->cid)); + dist_ctrl[i++] = tdep->cid; } for (tdep = erts_visible_dist_entries; tdep; tdep = tdep->next) { - ASSERT(is_internal_port(tdep->cid)); - dist_port[i++] = tdep->cid; + ASSERT(is_internal_port(tdep->cid) || is_internal_pid(tdep->cid)); + dist_ctrl[i++] = tdep->cid; } erts_rwmtx_runlock(&erts_dist_table_rwmtx); - for (i = 0; i < no_dist_port; i++) { - Port *prt = erts_port_lookup(dist_port[i], - ERTS_PORT_SFLGS_INVALID_LOOKUP); - if (!prt) - continue; - ASSERT(erts_atomic32_read_nob(&prt->state) - & ERTS_PORT_SFLG_DISTRIBUTION); - - erts_port_exit(NULL, ERTS_PORT_SIG_FLG_FORCE_SCHED, - prt, dist_port[i], nd_reason, NULL); + for (i = 0; i < no_dist_ctrl; i++) { + if (is_internal_pid(dist_ctrl[i])) + schedule_kill_dist_ctrl_proc(dist_ctrl[i]); + else { + Port *prt = erts_port_lookup(dist_ctrl[i], + ERTS_PORT_SFLGS_INVALID_LOOKUP); + if (prt) { + ASSERT(erts_atomic32_read_nob(&prt->state) + & ERTS_PORT_SFLG_DISTRIBUTION); + + erts_port_exit(NULL, ERTS_PORT_SIG_FLG_FORCE_SCHED, + prt, dist_ctrl[i], nd_reason, NULL); + } + } } - if (dist_port != &def_buf[0]) - erts_free(ERTS_ALC_T_TMP, dist_port); + if (dist_ctrl != &def_buf[0]) + erts_free(ERTS_ALC_T_TMP, dist_ctrl); } /* - * When last dist port exits, node will be taken + * When last dist ctrl exits, node will be taken * from alive to not alive. */ ASSERT(is_nil(nodedown.reason) && !nodedown.bp); @@ -524,7 +556,7 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) &nodedown.bp->off_heap); } } - else { /* Call from distribution port */ + else { /* Call from distribution controller (port/process) */ NetExitsContext nec = {dep}; ErtsLink *nlinks; ErtsLink *node_links; @@ -534,24 +566,23 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) erts_atomic_set_mb(&dep->dist_cmd_scheduled, 1); erts_de_rwlock(dep); - ERTS_LC_ASSERT(is_internal_port(dep->cid) - && erts_lc_is_port_locked(erts_port_lookup_raw(dep->cid))); + if (is_internal_port(dep->cid)) { + ERTS_LC_ASSERT(erts_lc_is_port_locked(erts_port_lookup_raw(dep->cid))); - if (erts_port_task_is_scheduled(&dep->dist_cmd)) - erts_port_task_abort(&dep->dist_cmd); + if (erts_port_task_is_scheduled(&dep->dist_cmd)) + erts_port_task_abort(&dep->dist_cmd); + } if (dep->status & ERTS_DE_SFLG_EXITING) { #ifdef DEBUG - erts_mtx_lock(&dep->qlock); - ASSERT(dep->qflgs & ERTS_DE_QFLG_EXIT); - erts_mtx_unlock(&dep->qlock); + ASSERT(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT); #endif } else { dep->status |= ERTS_DE_SFLG_EXITING; erts_mtx_lock(&dep->qlock); - ASSERT(!(dep->qflgs & ERTS_DE_QFLG_EXIT)); - dep->qflgs |= ERTS_DE_QFLG_EXIT; + ASSERT(!(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT)); + erts_atomic32_read_bor_relb(&dep->qflgs, ERTS_DE_QFLG_EXIT); erts_mtx_unlock(&dep->qlock); } @@ -616,6 +647,9 @@ void init_dist(void) dgroup_leader_trap = trap_function(am_dgroup_leader,2); dexit_trap = trap_function(am_dexit, 2); dmonitor_p_trap = trap_function(am_dmonitor_p, 2); + dist_ctrl_put_data_trap = erts_export_put(am_erts_internal, + am_dist_ctrl_put_data, + 2); } #define ErtsDistOutputBuf2Binary(OB) \ @@ -658,6 +692,8 @@ static void clear_dist_entry(DistEntry *dep) ErtsDistOutputBuf *obuf; erts_de_rwlock(dep); + erts_atomic_set_nob(&dep->input_handler, + (erts_aint_t) NIL); cache = dep->cache; dep->cache = NULL; @@ -671,6 +707,9 @@ static void clear_dist_entry(DistEntry *dep) erts_mtx_lock(&dep->qlock); + erts_atomic64_set_nob(&dep->in, 0); + erts_atomic64_set_nob(&dep->out, 0); + if (!dep->out_queue.last) obuf = dep->finalized_out_queue.first; else { @@ -678,8 +717,15 @@ static void clear_dist_entry(DistEntry *dep) obuf = dep->out_queue.first; } + if (dep->tmp_out_queue.first) { + dep->tmp_out_queue.last->next = obuf; + obuf = dep->tmp_out_queue.first; + } + dep->out_queue.first = NULL; dep->out_queue.last = NULL; + dep->tmp_out_queue.first = NULL; + dep->tmp_out_queue.last = NULL; dep->finalized_out_queue.first = NULL; dep->finalized_out_queue.last = NULL; dep->status = 0; @@ -704,8 +750,9 @@ static void clear_dist_entry(DistEntry *dep) if (obufsize) { erts_mtx_lock(&dep->qlock); - ASSERT(dep->qsize >= obufsize); - dep->qsize -= obufsize; + ASSERT(erts_atomic_read_nob(&dep->qsize) >= obufsize); + erts_atomic_add_nob(&dep->qsize, + (erts_aint_t) -obufsize); erts_mtx_unlock(&dep->qlock); } } @@ -904,11 +951,30 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) } #endif - if (token != NIL) - ctl = TUPLE4(&ctx->ctl_heap[0], - make_small(DOP_SEND_TT), am_Empty, remote, token); - else - ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Empty, remote); + if (token != NIL) { + Eterm el1, el2; + if (ctx->dep->flags & DFLAG_SEND_SENDER) { + el1 = make_small(DOP_SEND_SENDER_TT); + el2 = sender->common.id; + } + else { + el1 = make_small(DOP_SEND_TT); + el2 = am_Empty; + } + ctl = TUPLE4(&ctx->ctl_heap[0], el1, el2, remote, token); + } + else { + Eterm el1, el2; + if (ctx->dep->flags & DFLAG_SEND_SENDER) { + el1 = make_small(DOP_SEND_SENDER); + el2 = sender->common.id; + } + else { + el1 = make_small(DOP_SEND); + el2 = am_Empty; + } + ctl = TUPLE3(&ctx->ctl_heap[0], el1, el2, remote); + } DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, @@ -1145,6 +1211,7 @@ int erts_net_message(Port *prt, ErtsLink *lnk; Uint tuple_arity; int res; + Uint32 connection_id; #ifdef ERTS_DIST_MSG_DBG ErlDrvSizeT orig_len = len; #endif @@ -1153,14 +1220,16 @@ int erts_net_message(Port *prt, ERTS_CHK_NO_PROC_LOCKS; - ERTS_LC_ASSERT(erts_lc_is_port_locked(prt)); + ERTS_LC_ASSERT(!prt || erts_lc_is_port_locked(prt)); if (!erts_is_alive) { UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); return 0; } - if (hlen != 0) - goto data_error; + + + ASSERT(hlen == 0); + if (len == 0) { /* HANDLE TICK !!! */ UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); return 0; @@ -1179,30 +1248,31 @@ int erts_net_message(Port *prt, len--; } - if (len == 0) { - PURIFY_MSG("data error"); - goto data_error; - } - - res = erts_prepare_dist_ext(&ede, t, len, dep, dep->cache); + res = erts_prepare_dist_ext(&ede, t, len, dep, dep->cache, &connection_id); - if (res >= 0) - res = ctl_len = erts_decode_dist_ext_size(&ede); - else { + switch (res) { + case ERTS_PREP_DIST_EXT_CLOSED: + return 0; /* Connection not alive; ignore signal... */ + case ERTS_PREP_DIST_EXT_FAILED: #ifdef ERTS_DIST_MSG_DBG erts_fprintf(stderr, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n"); bw(buf, orig_len); #endif - ctl_len = 0; - } - - if (res < 0) { + goto data_error; + case ERTS_PREP_DIST_EXT_SUCCESS: + ctl_len = erts_decode_dist_ext_size(&ede); + if (ctl_len < 0) { #ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n"); - bw(buf, orig_len); + erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n"); + bw(buf, orig_len); #endif - PURIFY_MSG("data error"); - goto data_error; + PURIFY_MSG("data error"); + goto data_error; + } + break; + default: + ERTS_INTERNAL_ERROR("Unexpected result from erts_prepare_dist_ext()"); + break; } if (ctl_len > DIST_CTL_DEFAULT_SIZE) { @@ -1233,6 +1303,7 @@ int erts_net_message(Port *prt, } token_size = 0; + token = NIL; switch (type = unsigned_val(tuple[1])) { case DOP_LINK: @@ -1462,38 +1533,52 @@ int erts_net_message(Port *prt, } break; + case DOP_SEND_SENDER_TT: { + Uint xsize; case DOP_SEND_TT: + if (tuple_arity != 4) { goto invalid_message; } - - token_size = size_object(tuple[4]); - /* Fall through ... */ + + token = tuple[4]; + token_size = size_object(token); + xsize = ERTS_HEAP_FRAG_SIZE(token_size); + goto send_common; + + case DOP_SEND_SENDER: case DOP_SEND: + + token = NIL; + xsize = 0; + if (tuple_arity != 3) + goto invalid_message; + + send_common: + /* - * There is intentionally no testing of the cookie (it is always '') - * from R9B and onwards. + * If DOP_SEND_SENDER or DOP_SEND_SENDER_TT element 2 contains + * the sender pid (i.e. DFLAG_SEND_SENDER is set); otherwise, + * the atom '' (empty cookie). */ + ASSERT((type == DOP_SEND_SENDER || type == DOP_SEND_SENDER_TT) + ? (is_pid(tuple[2]) && (dep->flags & DFLAG_SEND_SENDER)) + : tuple[2] == am_Empty); + #ifdef ERTS_DIST_MSG_DBG dist_msg_dbg(&ede, "MSG", buf, orig_len); #endif - if (type != DOP_SEND_TT && tuple_arity != 3) { - goto invalid_message; - } to = tuple[3]; if (is_not_pid(to)) { goto invalid_message; } rp = erts_proc_lookup(to); if (rp) { - Uint xsize = type == DOP_SEND ? 0 : ERTS_HEAP_FRAG_SIZE(token_size); ErtsProcLocks locks = 0; ErtsDistExternal *ede_copy; ede_copy = erts_make_dist_ext_copy(&ede, xsize); - if (type == DOP_SEND) { - token = NIL; - } else { + if (is_not_nil(token)) { ErlHeapFragment *heap_frag; ErlOffHeap *ohp; ASSERT(xsize); @@ -1501,15 +1586,15 @@ int erts_net_message(Port *prt, ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size); hp = heap_frag->mem; ohp = &heap_frag->off_heap; - token = tuple[4]; token = copy_struct(token, token_size, &hp, ohp); } - erts_queue_dist_message(rp, locks, ede_copy, token, tuple[2]); + erts_queue_dist_message(rp, locks, ede_copy, token, am_Empty); if (locks) erts_proc_unlock(rp, locks); } break; + } case DOP_MONITOR_P_EXIT: { /* We are monitoring a process on the remote node which dies, we get @@ -1723,7 +1808,7 @@ decode_error: } data_error: UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); - erts_deliver_port_exit(prt, dep->cid, am_killed, 0, 1); + erts_kill_dist_connection(dep, connection_id); ERTS_CHK_NO_PROC_LOCKS; return -1; } @@ -1744,6 +1829,31 @@ static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy) return ret; } +static ERTS_INLINE void +notify_dist_data(Process *c_p, Eterm pid) +{ + Process *rp; + ErtsProcLocks rp_locks; + + ASSERT(erts_get_scheduler_data() + && !ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())); + ASSERT(is_internal_pid(pid)); + + if (c_p && c_p->common.id == pid) { + rp = c_p; + rp_locks = ERTS_PROC_LOCK_MAIN; + } + else { + rp = erts_proc_lookup(pid); + rp_locks = 0; + } + + if (rp) { + ErtsMessage *mp = erts_alloc_message(0, NULL); + erts_queue_message(rp, rp_locks, mp, am_dist_data, am_system); + } +} + int erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) { @@ -1859,12 +1969,32 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) free_dist_obuf(ctx->obuf); } else { + Sint qsize; + erts_aint32_t qflgs; ErtsProcList *plp = NULL; + Eterm notify_proc = NIL; + Sint obsz = size_obuf(ctx->obuf); + erts_mtx_lock(&dep->qlock); - dep->qsize += size_obuf(ctx->obuf); - if (dep->qsize >= erts_dist_buf_busy_limit) - dep->qflgs |= ERTS_DE_QFLG_BUSY; - if (!ctx->force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) { + qsize = erts_atomic_add_read_nob(&dep->qsize, (erts_aint_t) obsz); + ASSERT(qsize >= obsz); + qflgs = erts_atomic32_read_nob(&dep->qflgs); + if (!(qflgs & ERTS_DE_QFLG_BUSY) && qsize >= erts_dist_buf_busy_limit) { + erts_atomic32_read_bor_relb(&dep->qflgs, ERTS_DE_QFLG_BUSY); + qflgs |= ERTS_DE_QFLG_BUSY; + } + if (qsize == obsz && (qflgs & ERTS_DE_QFLG_REQ_INFO)) { + /* Previously empty queue and info requested... */ + qflgs = erts_atomic32_read_band_mb(&dep->qflgs, + ~ERTS_DE_QFLG_REQ_INFO); + if (qflgs & ERTS_DE_QFLG_REQ_INFO) { + notify_proc = dep->cid; + ASSERT(is_internal_pid(notify_proc)); + } + /* else: requester will send itself the message... */ + qflgs &= ~ERTS_DE_QFLG_REQ_INFO; + } + if (!ctx->force_busy && (qflgs & ERTS_DE_QFLG_BUSY)) { erts_mtx_unlock(&dep->qlock); plp = erts_proclist_create(ctx->c_p); @@ -1881,7 +2011,8 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) dep->out_queue.last = ctx->obuf; if (!ctx->force_busy) { - if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) { + qflgs = erts_atomic32_read_nob(&dep->qflgs); + if (!(qflgs & ERTS_DE_QFLG_BUSY)) { if (suspended) resume = 1; /* was busy when we started, but isn't now */ #ifdef USE_VM_PROBES @@ -1906,8 +2037,11 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) } erts_mtx_unlock(&dep->qlock); - erts_schedule_dist_command(NULL, dep); + if (is_internal_port(dep->cid)) + erts_schedule_dist_command(NULL, dep); erts_de_runlock(dep); + if (is_internal_pid(notify_proc)) + notify_dist_data(ctx->c_p, notify_proc); if (resume) { erts_resume(ctx->c_p, ERTS_PROC_LOCK_MAIN); @@ -1961,16 +2095,20 @@ static Uint dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) { int fpe_was_unmasked; - Uint size = obuf->ext_endp - obuf->extp; + ErlDrvSizeT size; + char *bufp; ERTS_CHK_NO_PROC_LOCKS; ERTS_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (size > (Uint) INT_MAX) - erts_exit(ERTS_DUMP_EXIT, - "Absurdly large distribution output data buffer " - "(%beu bytes) passed.\n", - size); + if (!obuf) { + size = 0; + bufp = NULL; + } + else { + size = obuf->ext_endp - obuf->extp; + bufp = (char*) obuf->extp; + } #ifdef USE_VM_PROBES if (DTRACE_ENABLED(dist_output)) { @@ -1985,11 +2123,10 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) remote_str, size); } #endif + prt->caller = NIL; fpe_was_unmasked = erts_block_fpe(); - (*prt->drv_ptr->output)((ErlDrvData) prt->drv_data, - (char*) obuf->extp, - (int) size); + (*prt->drv_ptr->output)((ErlDrvData) prt->drv_data, bufp, size); erts_unblock_fpe(fpe_was_unmasked); return size; } @@ -1998,7 +2135,7 @@ static Uint dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) { int fpe_was_unmasked; - Uint size = obuf->ext_endp - obuf->extp; + ErlDrvSizeT size; SysIOVec iov[2]; ErlDrvBinary* bv[2]; ErlIOVec eiov; @@ -2006,25 +2143,33 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) ERTS_CHK_NO_PROC_LOCKS; ERTS_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (size > (Uint) INT_MAX) - erts_exit(ERTS_DUMP_EXIT, - "Absurdly large distribution output data buffer " - "(%beu bytes) passed.\n", - size); - iov[0].iov_base = NULL; iov[0].iov_len = 0; bv[0] = NULL; - iov[1].iov_base = obuf->extp; - iov[1].iov_len = size; - bv[1] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf)); + if (!obuf) { + size = 0; + eiov.vsize = 1; + } + else { + size = obuf->ext_endp - obuf->extp; + eiov.vsize = 2; + + iov[1].iov_base = obuf->extp; + iov[1].iov_len = size; + bv[1] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf)); + } - eiov.vsize = 2; eiov.size = size; eiov.iov = iov; eiov.binv = bv; + if (size > (Uint) INT_MAX) + erts_exit(ERTS_DUMP_EXIT, + "Absurdly large distribution output data buffer " + "(%beu bytes) passed.\n", + size); + ASSERT(prt->drv_ptr->outputv); #ifdef USE_VM_PROBES @@ -2072,7 +2217,7 @@ erts_dist_command(Port *prt, int reds_limit) Sint reds = ERTS_PORT_REDS_DIST_CMD_START; Uint32 status; Uint32 flags; - Sint obufsize = 0; + Sint qsize, obufsize = 0; ErtsDistOutputQueue oq, foq; DistEntry *dep = prt->dist_entry; Uint (*send)(Port *prt, ErtsDistOutputBuf *obuf); @@ -2081,9 +2226,6 @@ erts_dist_command(Port *prt, int reds_limit) ERTS_LC_ASSERT(erts_lc_is_port_locked(prt)); - erts_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be - removed if port command fails */ - erts_atomic_set_mb(&dep->dist_cmd_scheduled, 0); erts_de_rlock(dep); @@ -2094,7 +2236,6 @@ erts_dist_command(Port *prt, int reds_limit) if (status & ERTS_DE_SFLG_EXITING) { erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1); - erts_deref_dist_entry(dep); return reds + ERTS_PORT_REDS_DIST_CMD_EXIT; } @@ -2128,20 +2269,20 @@ erts_dist_command(Port *prt, int reds_limit) if (!(sched_flags & ERTS_PTS_FLG_BUSY_PORT) && foq.first) { int preempt = 0; do { - Uint size; - ErtsDistOutputBuf *fob; - - size = (*send)(prt, foq.first); - esdp->io.out += (Uint64) size; + Uint size; + ErtsDistOutputBuf *fob; + size = (*send)(prt, foq.first); + erts_atomic64_inc_nob(&dep->out); + esdp->io.out += (Uint64) size; #ifdef ERTS_RAW_DIST_MSG_DBG - erts_fprintf(stderr, ">> "); - bw(foq.first->extp, size); + erts_fprintf(stderr, ">> "); + bw(foq.first->extp, size); #endif - reds += ERTS_PORT_REDS_DIST_CMD_DATA(size); - fob = foq.first; - obufsize += size_obuf(fob); - foq.first = foq.first->next; - free_dist_obuf(fob); + reds += ERTS_PORT_REDS_DIST_CMD_DATA(size); + fob = foq.first; + obufsize += size_obuf(fob); + foq.first = foq.first->next; + free_dist_obuf(fob); sched_flags = erts_atomic32_read_nob(&prt->sched.flags); preempt = reds > reds_limit || (sched_flags & ERTS_PTS_FLG_EXIT); if (sched_flags & ERTS_PTS_FLG_BUSY_PORT) @@ -2202,31 +2343,33 @@ erts_dist_command(Port *prt, int reds_limit) } } else { + int de_busy; int preempt = 0; while (oq.first && !preempt) { - ErtsDistOutputBuf *fob; - Uint size; - oq.first->extp - = erts_encode_ext_dist_header_finalize(oq.first->extp, - dep->cache, - flags); - reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) - *--oq.first->extp = PASS_THROUGH; /* Old node; 'pass through' - needed */ - ASSERT(&oq.first->data[0] <= oq.first->extp - && oq.first->extp < oq.first->ext_endp); - size = (*send)(prt, oq.first); - esdp->io.out += (Uint64) size; + ErtsDistOutputBuf *fob; + Uint size; + oq.first->extp + = erts_encode_ext_dist_header_finalize(oq.first->extp, + dep->cache, + flags); + reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + *--oq.first->extp = PASS_THROUGH; /* Old node; 'pass through' + needed */ + ASSERT(&oq.first->data[0] <= oq.first->extp + && oq.first->extp < oq.first->ext_endp); + size = (*send)(prt, oq.first); + erts_atomic64_inc_nob(&dep->out); + esdp->io.out += (Uint64) size; #ifdef ERTS_RAW_DIST_MSG_DBG - erts_fprintf(stderr, ">> "); - bw(oq.first->extp, size); + erts_fprintf(stderr, ">> "); + bw(oq.first->extp, size); #endif - reds += ERTS_PORT_REDS_DIST_CMD_DATA(size); - fob = oq.first; - obufsize += size_obuf(fob); - oq.first = oq.first->next; - free_dist_obuf(fob); + reds += ERTS_PORT_REDS_DIST_CMD_DATA(size); + fob = oq.first; + obufsize += size_obuf(fob); + oq.first = oq.first->next; + free_dist_obuf(fob); sched_flags = erts_atomic32_read_nob(&prt->sched.flags); preempt = reds > reds_limit || (sched_flags & ERTS_PTS_FLG_EXIT); if ((sched_flags & ERTS_PTS_FLG_BUSY_PORT) && oq.first && !preempt) @@ -2255,12 +2398,13 @@ erts_dist_command(Port *prt, int reds_limit) * processes. */ erts_mtx_lock(&dep->qlock); - ASSERT(dep->qsize >= obufsize); - dep->qsize -= obufsize; + de_busy = !!(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_BUSY); + qsize = (Sint) erts_atomic_add_read_nob(&dep->qsize, + (erts_aint_t) -obufsize); + ASSERT(qsize >= 0); obufsize = 0; if (!(sched_flags & ERTS_PTS_FLG_BUSY_PORT) - && (dep->qflgs & ERTS_DE_QFLG_BUSY) - && dep->qsize < erts_dist_buf_busy_limit) { + && de_busy && qsize < erts_dist_buf_busy_limit) { ErtsProcList *suspendees; int resumed; suspendees = get_suspended_on_de(dep, ERTS_DE_QFLG_BUSY); @@ -2280,8 +2424,13 @@ erts_dist_command(Port *prt, int reds_limit) if (obufsize != 0) { ASSERT(obufsize > 0); erts_mtx_lock(&dep->qlock); - ASSERT(dep->qsize >= obufsize); - dep->qsize -= obufsize; +#ifdef DEBUG + qsize = (Sint) erts_atomic_add_read_nob(&dep->qsize, + (erts_aint_t) -obufsize); + ASSERT(qsize >= 0); +#else + erts_atomic_add_nob(&dep->qsize, (erts_aint_t) -obufsize); +#endif erts_mtx_unlock(&dep->qlock); } @@ -2299,8 +2448,6 @@ erts_dist_command(Port *prt, int reds_limit) if (reds > INT_MAX/2) reds = INT_MAX/2; - erts_deref_dist_entry(dep); - return reds; preempted: @@ -2337,7 +2484,7 @@ erts_dist_command(Port *prt, int reds_limit) #ifdef DEBUG erts_mtx_lock(&dep->qlock); - ASSERT(dep->qsize == obufsize); + ASSERT(erts_atomic_read_nob(&dep->qsize) == obufsize); erts_mtx_unlock(&dep->qlock); #endif } @@ -2348,7 +2495,7 @@ erts_dist_command(Port *prt, int reds_limit) * in out_queue. */ erts_mtx_lock(&dep->qlock); - dep->qsize -= obufsize; + erts_atomic_add_nob(&dep->qsize, -obufsize); obufsize = 0; oq.last->next = dep->out_queue.first; dep->out_queue.first = oq.first; @@ -2362,6 +2509,370 @@ erts_dist_command(Port *prt, int reds_limit) goto done; } +#if 0 + +int +dist_data_finalize(Process *c_p, int reds_limit) +{ + int reds = 5; + DistEntry *dep = ; + ErtsDistOutputQueue oq, foq; + ErtsDistOutputBuf *ob; + int preempt; + + + erts_mtx_lock(&dep->qlock); + flags = dep->flags; + oq.first = dep->out_queue.first; + oq.last = dep->out_queue.last; + dep->out_queue.first = NULL; + dep->out_queue.last = NULL; + erts_mtx_unlock(&dep->qlock); + + if (!oq.first) { + ASSERT(!oq.last); + oq.first = dep->tmp_out_queue.first; + oq.last = dep->tmp_out_queue.last; + } + else { + ErtsDistOutputBuf *f, *l; + ASSERT(oq.last); + if (dep->tmp_out_queue.last) { + dep->tmp_out_queue.last->next = oq.first; + oq.first = dep->tmp_out_queue.first; + } + } + + if (!oq.first) { + /* Nothing to do... */ + ASSERT(!oq.last); + return reds; + } + + foq.first = dep->finalized_out_queue.first; + foq.last = dep->finalized_out_queue.last; + + preempt = 0; + ob = oq.first; + ASSERT(ob); + + do { + ob->extp = erts_encode_ext_dist_header_finalize(ob->extp, + dep->cache, + flags); + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + *--ob->extp = PASS_THROUGH; /* Old node; 'pass through' + needed */ + ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp); + reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; + preempt = reds > reds_limit; + if (preempt) + break; + ob = ob->next; + } while (ob); + /* + * At least one buffer was finalized; if we got preempted, + * ob points to the last buffer that we finalized. + */ + if (foq.last) + foq.last->next = oq.first; + else + foq.first = oq.first; + if (!preempt) { + /* All buffers finalized */ + foq.last = oq.last; + oq.first = oq.last = NULL; + } + else { + /* Not all buffers finalized; split oq. */ + foq.last = ob; + oq.first = ob->next; + if (oq.first) + ob->next = NULL; + else + oq.last = NULL; + } + + dep->finalized_out_queue.first = foq.first; + dep->finalized_out_queue.last = foq.last; + dep->tmp_out_queue.first = oq.first; + dep->tmp_out_queue.last = oq.last; + + return reds; +} + +#endif + +BIF_RETTYPE +dist_ctrl_get_data_notification_1(BIF_ALIST_1) +{ + DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P); + erts_aint32_t qflgs; + erts_aint_t qsize; + Eterm receiver = NIL; + + if (!dep) + BIF_ERROR(BIF_P, EXC_NOTSUP); + + if (erts_dhandle_to_dist_entry(BIF_ARG_1) != dep) + BIF_ERROR(BIF_P, BADARG); + + /* + * Caller is the only one that can consume from this queue + * and the only one that can set the req-info flag... + */ + + erts_de_rlock(dep); + + ASSERT(dep->cid == BIF_P->common.id); + + qflgs = erts_atomic32_read_acqb(&dep->qflgs); + + if (!(qflgs & ERTS_DE_QFLG_REQ_INFO)) { + qsize = erts_atomic_read_acqb(&dep->qsize); + ASSERT(qsize >= 0); + if (qsize > 0) + receiver = BIF_P->common.id; /* Notify ourselves... */ + else { /* Empty queue; set req-info flag... */ + qflgs = erts_atomic32_read_bor_mb(&dep->qflgs, + ERTS_DE_QFLG_REQ_INFO); + qsize = erts_atomic_read_acqb(&dep->qsize); + ASSERT(qsize >= 0); + if (qsize > 0) { + qflgs = erts_atomic32_read_band_mb(&dep->qflgs, + ~ERTS_DE_QFLG_REQ_INFO); + if (qflgs & ERTS_DE_QFLG_REQ_INFO) + receiver = BIF_P->common.id; /* Notify ourselves... */ + /* else: someone else will notify us... */ + } + /* else: still empty queue... */ + } + } + /* else: Already requested... */ + + erts_de_runlock(dep); + + if (is_internal_pid(receiver)) + notify_dist_data(BIF_P, receiver); + + BIF_RET(am_ok); +} + +BIF_RETTYPE +dist_ctrl_put_data_2(BIF_ALIST_2) +{ + DistEntry *dep; + ErlDrvSizeT size; + Eterm input_handler; + + if (is_binary(BIF_ARG_2)) + size = binary_size(BIF_ARG_2); + else if (is_nil(BIF_ARG_2)) + size = 0; + else if (is_list(BIF_ARG_2)) + BIF_TRAP2(dist_ctrl_put_data_trap, + BIF_P, BIF_ARG_1, BIF_ARG_2); + else + BIF_ERROR(BIF_P, BADARG); + + dep = erts_dhandle_to_dist_entry(BIF_ARG_1); + if (!dep) + BIF_ERROR(BIF_P, BADARG); + + input_handler = (Eterm) erts_atomic_read_nob(&dep->input_handler); + + if (input_handler != BIF_P->common.id) + BIF_ERROR(BIF_P, EXC_NOTSUP); + + erts_atomic64_inc_nob(&dep->in); + + if (size != 0) { + byte *data, *temp_alloc = NULL; + + data = (byte *) erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc); + if (!data) + BIF_ERROR(BIF_P, BADARG); + + erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + + (void) erts_net_message(NULL, dep, NULL, 0, data, size); + /* + * We ignore any decode failures. On fatal failures the + * connection will be taken down by killing the + * distribution channel controller... + */ + + erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + + BUMP_REDS(BIF_P, 5); + + erts_free_aligned_binary_bytes(temp_alloc); + + } + + BIF_RET(am_ok); +} + +BIF_RETTYPE +dist_get_stat_1(BIF_ALIST_1) +{ + Sint64 read, write, pend; + Eterm res, *hp, **hpp; + Uint sz, *szp; + DistEntry *dep = erts_dhandle_to_dist_entry(BIF_ARG_1); + + if (!dep) + BIF_ERROR(BIF_P, BADARG); + + erts_de_rlock(dep); + + read = (Sint64) erts_atomic64_read_nob(&dep->in); + write = (Sint64) erts_atomic64_read_nob(&dep->out); + pend = (Sint64) erts_atomic_read_nob(&dep->qsize); + + erts_de_runlock(dep); + + sz = 0; + szp = &sz; + hpp = NULL; + + while (1) { + res = erts_bld_tuple(hpp, szp, 4, + am_ok, + erts_bld_sint64(hpp, szp, read), + erts_bld_sint64(hpp, szp, write), + pend ? am_true : am_false); + if (hpp) + break; + hp = HAlloc(BIF_P, sz); + hpp = &hp; + szp = NULL; + } + + BIF_RET(res); +} + +BIF_RETTYPE +dist_ctrl_input_handler_2(BIF_ALIST_2) +{ + DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P); + + if (!dep) + BIF_ERROR(BIF_P, EXC_NOTSUP); + + if (erts_dhandle_to_dist_entry(BIF_ARG_1) != dep) + BIF_ERROR(BIF_P, BADARG); + + if (is_not_internal_pid(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + + erts_atomic_set_nob(&dep->input_handler, + (erts_aint_t) BIF_ARG_2); + + BIF_RET(am_ok); +} + +BIF_RETTYPE +dist_ctrl_get_data_1(BIF_ALIST_1) +{ + DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P); + int reds = 1; + ErtsDistOutputBuf *obuf; + Eterm *hp; + ProcBin *pb; + erts_aint_t qsize; + + if (!dep) + BIF_ERROR(BIF_P, EXC_NOTSUP); + + if (erts_dhandle_to_dist_entry(BIF_ARG_1) != dep) + BIF_ERROR(BIF_P, BADARG); + + erts_de_rlock(dep); + + if (dep->status & ERTS_DE_SFLG_EXITING) + goto return_none; + + ASSERT(dep->cid == BIF_P->common.id); + +#if 0 + if (dep->finalized_out_queue.first) { + obuf = dep->finalized_out_queue.first; + dep->finalized_out_queue.first = obuf->next; + if (!obuf->next) + dep->finalized_out_queue.last = NULL; + } + else +#endif + { + if (!dep->tmp_out_queue.first) { + ASSERT(!dep->tmp_out_queue.last); + qsize = erts_atomic_read_acqb(&dep->qsize); + if (qsize > 0) { + erts_mtx_lock(&dep->qlock); + dep->tmp_out_queue.first = dep->out_queue.first; + dep->tmp_out_queue.last = dep->out_queue.last; + dep->out_queue.first = NULL; + dep->out_queue.last = NULL; + erts_mtx_unlock(&dep->qlock); + } + } + + if (!dep->tmp_out_queue.first) { + ASSERT(!dep->tmp_out_queue.last); + return_none: + erts_de_runlock(dep); + BIF_RET(am_none); + } + else { + obuf = dep->tmp_out_queue.first; + dep->tmp_out_queue.first = obuf->next; + if (!obuf->next) + dep->tmp_out_queue.last = NULL; + } + + obuf->extp = erts_encode_ext_dist_header_finalize(obuf->extp, + dep->cache, + dep->flags); + reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; + if (!(dep->flags & DFLAG_DIST_HDR_ATOM_CACHE)) + *--obuf->extp = PASS_THROUGH; /* 'pass through' needed */ + ASSERT(&obuf->data[0] <= obuf->extp + && obuf->extp < obuf->ext_endp); + } + + erts_atomic64_inc_nob(&dep->out); + + erts_de_runlock(dep); + + hp = HAlloc(BIF_P, PROC_BIN_SIZE); + pb = (ProcBin *) (char *) hp; + pb->thing_word = HEADER_PROC_BIN; + pb->size = obuf->ext_endp - obuf->extp; + pb->next = MSO(BIF_P).first; + MSO(BIF_P).first = (struct erl_off_heap_header*) pb; + pb->val = ErtsDistOutputBuf2Binary(obuf); + pb->bytes = (byte*) obuf->extp; + pb->flags = 0; + + qsize = erts_atomic_add_read_nob(&dep->qsize, -size_obuf(obuf)); + ASSERT(qsize >= 0); + + if (qsize < erts_dist_buf_busy_limit/2 + && (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY)) { + ErtsProcList *resume_procs = NULL; + erts_mtx_lock(&dep->qlock); + resume_procs = get_suspended_on_de(dep, ERTS_DE_QFLG_BUSY); + erts_mtx_unlock(&dep->qlock); + if (resume_procs) { + int resumed = erts_resume_processes(resume_procs); + reds += resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED; + } + } + + BIF_RET2(make_binary(pb), reds); +} + void erts_dist_port_not_busy(Port *prt) { @@ -2385,18 +2896,20 @@ void erts_kill_dist_connection(DistEntry *dep, Uint32 connection_id) { erts_de_rwlock(dep); - if (is_internal_port(dep->cid) - && connection_id == dep->connection_id + if (connection_id == dep->connection_id && !(dep->status & ERTS_DE_SFLG_EXITING)) { dep->status |= ERTS_DE_SFLG_EXITING; erts_mtx_lock(&dep->qlock); - ASSERT(!(dep->qflgs & ERTS_DE_QFLG_EXIT)); - dep->qflgs |= ERTS_DE_QFLG_EXIT; + ASSERT(!(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT)); + erts_atomic32_read_bor_nob(&dep->qflgs, ERTS_DE_QFLG_EXIT); erts_mtx_unlock(&dep->qlock); - erts_schedule_dist_command(NULL, dep); + if (is_internal_port(dep->cid)) + erts_schedule_dist_command(NULL, dep); + else if (is_internal_pid(dep->cid)) + schedule_kill_dist_ctrl_proc(dep->cid); } erts_de_rwunlock(dep); } @@ -2513,9 +3026,6 @@ info_dist_entry(fmtfn_t to, void *arg, DistEntry *dep, int visible, int connecte } erts_print(to, arg, "Name: %T", dep->sysname); -#ifdef DEBUG - erts_print(to, arg, " (refc=%d)", erts_refc_read(&dep->refc, 0)); -#endif erts_print(to, arg, "\n"); if (!connected && is_nil(dep->cid)) { if (dep->nlinks) { @@ -2635,17 +3145,23 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) goto error; } - net_kernel = erts_whereis_process(BIF_P, ERTS_PROC_LOCK_MAIN, - am_net_kernel, ERTS_PROC_LOCK_MAIN, 0); - if (!net_kernel) + net_kernel = erts_whereis_process(BIF_P, + ERTS_PROC_LOCK_MAIN, + am_net_kernel, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS, + 0); + if (!net_kernel || ERTS_PROC_GET_DIST_ENTRY(net_kernel)) goto error; /* By setting F_DISTRIBUTION on net_kernel, - * do_net_exist will be called when net_kernel is terminated !! */ + * erts_do_net_exits will be called when net_kernel is terminated !! */ net_kernel->flags |= F_DISTRIBUTION; - if (net_kernel != BIF_P) - erts_proc_unlock(net_kernel, ERTS_PROC_LOCK_MAIN); + erts_proc_unlock(net_kernel, + (ERTS_PROC_LOCK_STATUS + | ((net_kernel != BIF_P) + ? ERTS_PROC_LOCK_MAIN + : 0))); #ifdef DEBUG erts_rwmtx_rlock(&erts_dist_table_rwmtx); @@ -2662,6 +3178,14 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) erts_thr_progress_unblock(); erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + /* + * Note erts_this_dist_entry is changed by erts_set_this_node(), + * so we *need* to use the new one after erts_set_this_node() + * is called. + */ + erts_ref_dist_entry(erts_this_dist_entry); + ERTS_PROC_SET_DIST_ENTRY(net_kernel, erts_this_dist_entry); + BIF_RET(am_true); error: @@ -2691,18 +3215,18 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) Eterm ic, oc; Eterm *tp; DistEntry *dep = NULL; + ErtsProcLocks proc_unlock = 0; + Process *proc; Port *pp = NULL; - /* Prepare for success */ - ERTS_BIF_PREP_RET(ret, am_true); - /* * Check and pick out arguments */ if (!is_node_name_atom(BIF_ARG_1) || - is_not_internal_port(BIF_ARG_2) || - (erts_this_node->sysname == am_Noname)) { + !(is_internal_port(BIF_ARG_2) + || is_internal_pid(BIF_ARG_2)) + || (erts_this_node->sysname == am_Noname)) { goto badarg; } @@ -2746,77 +3270,124 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) else if (!dep) goto system_limit; /* Should never happen!!! */ - pp = erts_id2port_sflgs(BIF_ARG_2, - BIF_P, - ERTS_PROC_LOCK_MAIN, - ERTS_PORT_SFLGS_INVALID_LOOKUP); - erts_de_rwlock(dep); + if (is_internal_pid(BIF_ARG_2)) { + if (BIF_P->common.id == BIF_ARG_2) { + proc_unlock = 0; + proc = BIF_P; + } + else { + proc_unlock = ERTS_PROC_LOCK_MAIN; + proc = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_2, proc_unlock); + } + erts_de_rwlock(dep); - if (!pp || (erts_atomic32_read_nob(&pp->state) - & ERTS_PORT_SFLG_EXITING)) - goto badarg; + if (!proc) + goto badarg; + else if (proc == ERTS_PROC_LOCK_BUSY) { + proc_unlock = 0; + goto yield; + } - if ((pp->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY) == 0) - goto badarg; + erts_proc_lock(proc, ERTS_PROC_LOCK_STATUS); + proc_unlock |= ERTS_PROC_LOCK_STATUS; + + if (ERTS_PROC_GET_DIST_ENTRY(proc)) { + if (dep == ERTS_PROC_GET_DIST_ENTRY(proc) + && (proc->flags & F_DISTRIBUTION) + && dep->cid == BIF_ARG_2) { + ERTS_BIF_PREP_RET(ret, erts_make_dhandle(BIF_P, dep)); + goto done; + } + goto badarg; + } - if (dep->cid == BIF_ARG_2 && pp->dist_entry == dep) - goto done; /* Already set */ + if (is_not_nil(dep->cid)) + goto badarg; + + proc->flags |= F_DISTRIBUTION; + ERTS_PROC_SET_DIST_ENTRY(proc, dep); + + proc_unlock &= ~ERTS_PROC_LOCK_STATUS; + erts_proc_unlock(proc, ERTS_PROC_LOCK_STATUS); + + dep->send = NULL; /* Only for distr ports... */ - if (dep->status & ERTS_DE_SFLG_EXITING) { - /* Suspend on dist entry waiting for the exit to finish */ - ErtsProcList *plp = erts_proclist_create(BIF_P); - plp->next = NULL; - erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); - erts_mtx_lock(&dep->qlock); - erts_proclist_store_last(&dep->suspended, plp); - erts_mtx_unlock(&dep->qlock); - goto yield; } + else { - ASSERT(!(dep->status & ERTS_DE_SFLG_EXITING)); + pp = erts_id2port_sflgs(BIF_ARG_2, + BIF_P, + ERTS_PROC_LOCK_MAIN, + ERTS_PORT_SFLGS_INVALID_LOOKUP); + erts_de_rwlock(dep); - if (pp->dist_entry || is_not_nil(dep->cid)) - goto badarg; + if (!pp || (erts_atomic32_read_nob(&pp->state) + & ERTS_PORT_SFLG_EXITING)) + goto badarg; - erts_atomic32_read_bor_nob(&pp->state, ERTS_PORT_SFLG_DISTRIBUTION); + if ((pp->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY) == 0) + goto badarg; - /* - * Dist-ports do not use the "busy port message queue" functionality, but - * instead use "busy dist entry" functionality. - */ - { - ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED; - erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL); - } + if (dep->cid == BIF_ARG_2 && pp->dist_entry == dep) { + ERTS_BIF_PREP_RET(ret, erts_make_dhandle(BIF_P, dep)); + goto done; /* Already set */ + } - pp->dist_entry = dep; + if (dep->status & ERTS_DE_SFLG_EXITING) { + /* Suspend on dist entry waiting for the exit to finish */ + ErtsProcList *plp = erts_proclist_create(BIF_P); + plp->next = NULL; + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + erts_mtx_lock(&dep->qlock); + erts_proclist_store_last(&dep->suspended, plp); + erts_mtx_unlock(&dep->qlock); + goto yield; + } - dep->version = version; - dep->creation = 0; + ASSERT(!(dep->status & ERTS_DE_SFLG_EXITING)); - ASSERT(pp->drv_ptr->outputv || pp->drv_ptr->output); + if (pp->dist_entry || is_not_nil(dep->cid)) + goto badarg; -#if 1 - dep->send = (pp->drv_ptr->outputv - ? dist_port_commandv - : dist_port_command); -#else - dep->send = dist_port_command; -#endif - ASSERT(dep->send); + erts_atomic32_read_bor_nob(&pp->state, ERTS_PORT_SFLG_DISTRIBUTION); + + pp->dist_entry = dep; + + ASSERT(pp->drv_ptr->outputv || pp->drv_ptr->output); + + dep->send = (pp->drv_ptr->outputv + ? dist_port_commandv + : dist_port_command); + ASSERT(dep->send); + + /* + * Dist-ports do not use the "busy port message queue" functionality, but + * instead use "busy dist entry" functionality. + */ + { + ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED; + erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL); + } + + } + + dep->version = version; + dep->creation = 0; #ifdef DEBUG - erts_mtx_lock(&dep->qlock); - ASSERT(dep->qsize == 0); - erts_mtx_unlock(&dep->qlock); + ASSERT(erts_atomic_read_nob(&dep->qsize) == 0); #endif - erts_set_dist_entry_connected(dep, BIF_ARG_2, flags); - if (flags & DFLAG_DIST_HDR_ATOM_CACHE) create_cache(dep); + erts_set_dist_entry_connected(dep, BIF_ARG_2, flags); + erts_de_rwunlock(dep); + + ERTS_BIF_PREP_RET(ret, erts_make_dhandle(BIF_P, dep)); + dep = NULL; /* inc of refc transferred to port (dist_entry field) */ inc_no_nodes(); @@ -2836,6 +3407,9 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) if (pp) erts_port_release(pp); + if (proc_unlock) + erts_proc_unlock(proc, proc_unlock); + return ret; yield: @@ -3138,7 +3712,6 @@ monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options) erts_proc_unlock(p, ERTS_PROC_LOCK_LINK); done: - erts_deref_dist_entry(dep); BIF_RET(am_true); } diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index 05016cafc5..d4765c50b8 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -44,6 +44,7 @@ #define DFLAG_UTF8_ATOMS 0x10000 #define DFLAG_MAP_TAG 0x20000 #define DFLAG_BIG_CREATION 0x40000 +#define DFLAG_SEND_SENDER 0x80000 /* All flags that should be enabled when term_to_binary/1 is used. */ #define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \ @@ -74,6 +75,9 @@ #define DOP_DEMONITOR_P 20 #define DOP_MONITOR_P_EXIT 21 +#define DOP_SEND_SENDER 22 +#define DOP_SEND_SENDER_TT 23 + /* distribution trap functions */ extern Export* dsend2_trap; extern Export* dsend3_trap; @@ -161,13 +165,10 @@ erts_dsig_prepare(ErtsDSigData *dsdp, goto fail; } if (no_suspend) { - failure = ERTS_DSIG_PREP_CONNECTED; - erts_mtx_lock(&dep->qlock); - if (dep->qflgs & ERTS_DE_QFLG_BUSY) + if (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY) { failure = ERTS_DSIG_PREP_WOULD_SUSPEND; - erts_mtx_unlock(&dep->qlock); - if (failure == ERTS_DSIG_PREP_WOULD_SUSPEND) goto fail; + } } dsdp->proc = proc; dsdp->dep = dep; @@ -349,6 +350,7 @@ typedef struct { Eterm ctl_heap[6]; ErtsDSigData dsd; DistEntry* dep_to_deref; + DistEntry *dep; struct erts_dsig_send_context dss; Eterm return_term; diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index 30d7baf769..faeb5ef368 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -230,10 +230,6 @@ void erts_lcnt_update_allocator_locks(int enable); # endif #endif -#undef MIN -#undef MAX -#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) -#define MAX(X, Y) ((X) > (Y) ? (X) : (Y)) #define FLOOR(X, I) (((X)/(I))*(I)) #define CEILING(X, I) ((((X) - 1)/(I) + 1)*(I)) diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c index 861532f241..f2a3e411ec 100644 --- a/erts/emulator/beam/erl_arith.c +++ b/erts/emulator/beam/erl_arith.c @@ -276,8 +276,12 @@ shift(Process* p, Eterm arg1, Eterm arg2, int right) goto do_bsl; } else if (is_small(arg1) || is_big(arg1)) { /* - * N bsl PositiveBigNum is too large to represent. + * N bsl PositiveBigNum is too large to represent, + * unless N is 0. */ + if (arg1 == make_small(0)) { + BIF_RET(arg1); + } BIF_ERROR(p, SYSTEM_LIMIT); } /* Fall through if the left argument is not an integer. */ diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 756c7dce05..dcffde5777 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -229,13 +229,6 @@ static void dump_ac_node(ACNode *node, int indent, int ch); MYALIGN(sizeof(ACTrie))) /* Structure */ -#ifndef MAX -#define MAX(A,B) (((A) > (B)) ? (A) : (B)) -#endif - -#ifndef MIN -#define MIN(A,B) (((A) > (B)) ? (B) : (A)) -#endif /* * Callback for the magic binary */ diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 2ff95a3338..93f5f9ec11 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -48,6 +48,7 @@ #include "erl_map.h" #define ERTS_PTAB_WANT_DEBUG_FUNCS__ #include "erl_ptab.h" +#include "erl_time.h" #ifdef HIPE #include "hipe_arch.h" #endif @@ -3467,7 +3468,7 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) ErtsMonotonicTime u1, u2; Eterm b1, b2; Uint hsz; - elapsed_time_both(&u1, NULL, &u2, NULL); + erts_runtime_elapsed_both(&u1, NULL, &u2, NULL); hsz = 3; /* 2-tuple */ (void) erts_bld_monotonic_time(NULL, &hsz, u1); (void) erts_bld_monotonic_time(NULL, &hsz, u2); @@ -3483,7 +3484,7 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) ErtsMonotonicTime w1, w2; Eterm b1, b2; Uint hsz; - wall_clock_elapsed_time_both(&w1, &w2); + erts_wall_clock_elapsed_both(&w1, &w2); hsz = 3; /* 2-tuple */ (void) erts_bld_monotonic_time(NULL, &hsz, w1); (void) erts_bld_monotonic_time(NULL, &hsz, w2); @@ -3750,7 +3751,6 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) subres = make_link_list(BIF_P, dep->nlinks, NIL); subres = make_link_list(BIF_P, dep->node_links, subres); erts_de_links_unlock(dep); - erts_deref_dist_entry(dep); BIF_RET(subres); } else { BIF_RET(am_undefined); @@ -3781,7 +3781,6 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) erts_de_links_lock(dep); ml = make_monitor_list(BIF_P, dep->monitors); erts_de_links_unlock(dep); - erts_deref_dist_entry(dep); BIF_RET(ml); } else { BIF_RET(am_undefined); @@ -3796,7 +3795,6 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) else { Uint cno = dist_entry_channel_no(dep); res = make_small(cno); - erts_deref_dist_entry(dep); } BIF_RET(res); } @@ -3858,15 +3856,14 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) DFLAG_BIT_BINARIES); BIF_RET(erts_term_to_binary(BIF_P, tp[2], 0, dflags)); } - else if (ERTS_IS_ATOM_STR("dist_port", tp[1])) { + else if (ERTS_IS_ATOM_STR("dist_ctrl", tp[1])) { Eterm res = am_undefined; DistEntry *dep = erts_sysname_to_connected_dist_entry(tp[2]); if (dep) { erts_de_rlock(dep); - if (is_internal_port(dep->cid)) + if (is_internal_port(dep->cid) || is_internal_pid(dep->cid)) res = dep->cid; erts_de_runlock(dep); - erts_deref_dist_entry(dep); } BIF_RET(res); } @@ -4275,7 +4272,6 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) con_id = dep->connection_id; erts_de_runlock(dep); erts_kill_dist_connection(dep, con_id); - erts_deref_dist_entry(dep); BIF_RET(am_true); } } diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 2035b56eb5..3a16913473 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -32,15 +32,6 @@ #include "erl_bits.h" #include "erl_binary.h" -#ifdef MAX -#undef MAX -#endif -#define MAX(x,y) (((x)>(y))?(x):(y)) -#ifdef MIN -#undef MIN -#endif -#define MIN(x,y) (((x)<(y))?(x):(y)) - #if defined(WORDS_BIGENDIAN) # define BIT_ENDIAN_MACHINE 0 #else @@ -1303,7 +1294,14 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, goto badarg; } } + + if((ERTS_UINT_MAX - build_size_in_bits) < erts_bin_offset) { + c_p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + used_size_in_bits = erts_bin_offset + build_size_in_bits; + sb->is_writable = 0; /* Make sure that no one else can write. */ pb->size = NBYTES(used_size_in_bits); pb->flags |= PB_ACTIVE_WRITER; @@ -1377,9 +1375,21 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, goto badarg; } } - used_size_in_bits = erts_bin_offset + build_size_in_bits; - used_size_in_bytes = NBYTES(used_size_in_bits); - bin_size = 2*used_size_in_bytes; + + if((ERTS_UINT_MAX - build_size_in_bits) < erts_bin_offset) { + c_p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + + used_size_in_bits = erts_bin_offset + build_size_in_bits; + used_size_in_bytes = NBYTES(used_size_in_bits); + + if(used_size_in_bits < (ERTS_UINT_MAX / 2)) { + bin_size = 2 * used_size_in_bytes; + } else { + bin_size = NBYTES(ERTS_UINT_MAX); + } + bin_size = (bin_size < 256) ? 256 : bin_size; /* @@ -1469,6 +1479,12 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit) * Calculate new size in bytes. */ erts_bin_offset = 8*sb->size + sb->bitsize; + + if((ERTS_UINT_MAX - build_size_in_bits) < erts_bin_offset) { + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + pos_in_bits_after_build = erts_bin_offset + build_size_in_bits; pb->size = (pos_in_bits_after_build+7) >> 3; pb->flags |= PB_ACTIVE_WRITER; diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 25072ede97..5d49b2ea14 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -269,9 +269,6 @@ static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix, return ix; } -#ifndef MIN -#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) -#endif /* * Some special binary flags diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 038f6602bf..5a276b9d88 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -85,9 +85,6 @@ #define EMPTY_NODE(Dtt) (TOP_NODE(Dtt) == NULL) -#ifndef MIN -#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) -#endif /* Obtain table static stack if available. NULL if not. ** Must be released with release_stack() diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 0e8ebf0c98..5ad616fec3 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -40,7 +40,6 @@ #include "erl_drv_nif.h" #include <stdlib.h> -#include <sys/types.h> /* ssize_t */ #if defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_) #ifndef STATIC_ERLANG_DRIVER @@ -48,24 +47,6 @@ #define ERL_DRIVER_TYPES_ONLY #define WIN32_DYNAMIC_ERL_DRIVER #endif -/* - * This structure can be cast to a WSABUF structure. - */ -typedef struct _SysIOVec { - unsigned long iov_len; - char* iov_base; -} SysIOVec; -#else /* Unix */ -# ifdef HAVE_SYS_UIO_H -# include <sys/types.h> -# include <sys/uio.h> -typedef struct iovec SysIOVec; -# else -typedef struct { - char* iov_base; - size_t iov_len; -} SysIOVec; -# endif #endif #ifndef EXTERN diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h index f88138063e..31b4817fb1 100644 --- a/erts/emulator/beam/erl_drv_nif.h +++ b/erts/emulator/beam/erl_drv_nif.h @@ -144,8 +144,25 @@ typedef signed int ErlNapiSInt; #define ERTS_NAPI_USEC__ 2 #define ERTS_NAPI_NSEC__ 3 -#endif /* __ERL_DRV_NIF_H__ */ - - - +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +/* + * This structure can be cast to a WSABUF structure. + */ +typedef struct _SysIOVec { + unsigned long iov_len; + char* iov_base; +} SysIOVec; +#else /* Unix */ +# include <sys/types.h> +# ifdef HAVE_SYS_UIO_H +# include <sys/uio.h> +typedef struct iovec SysIOVec; +# else +typedef struct { + char* iov_base; + size_t iov_len; +} SysIOVec; +# endif +#endif +#endif /* __ERL_DRV_NIF_H__ */ diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index f8cbe6f49a..bda2c9b94d 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -96,14 +96,14 @@ typedef enum { #define ERTS_BIF_TIMER_SHORT_TIME 5000 -/* Bit 0 to 9 contains scheduler id (see mask below) */ -#define ERTS_TMR_ROFLG_HLT (((Uint32) 1) << 10) -#define ERTS_TMR_ROFLG_BIF_TMR (((Uint32) 1) << 11) -#define ERTS_TMR_ROFLG_PRE_ALC (((Uint32) 1) << 12) -#define ERTS_TMR_ROFLG_REG_NAME (((Uint32) 1) << 13) -#define ERTS_TMR_ROFLG_PROC (((Uint32) 1) << 14) -#define ERTS_TMR_ROFLG_PORT (((Uint32) 1) << 15) -#define ERTS_TMR_ROFLG_CALLBACK (((Uint32) 1) << 16) +/* Bit 0 to 10 contains scheduler id (see mask below) */ +#define ERTS_TMR_ROFLG_HLT (((Uint32) 1) << 11) +#define ERTS_TMR_ROFLG_BIF_TMR (((Uint32) 1) << 12) +#define ERTS_TMR_ROFLG_PRE_ALC (((Uint32) 1) << 13) +#define ERTS_TMR_ROFLG_REG_NAME (((Uint32) 1) << 14) +#define ERTS_TMR_ROFLG_PROC (((Uint32) 1) << 15) +#define ERTS_TMR_ROFLG_PORT (((Uint32) 1) << 16) +#define ERTS_TMR_ROFLG_CALLBACK (((Uint32) 1) << 17) #define ERTS_TMR_ROFLG_SID_MASK \ (ERTS_TMR_ROFLG_HLT - (Uint32) 1) @@ -1256,14 +1256,15 @@ bif_timer_timeout(ErtsHLTimerService *srv, ERTS_HLT_ASSERT(proc); } if (proc) { + int dec_refc = 0; + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = tmr->btm.bp; + tmr->btm.bp = NULL; + erts_queue_message(proc, 0, mp, tmr->btm.message, + am_clock_service); + erts_proc_lock(proc, ERTS_PROC_LOCK_BTM); + /* If the process is exiting do not disturb the cleanup... */ if (!ERTS_PROC_IS_EXITING(proc)) { - int dec_refc = 0; - ErtsMessage *mp = erts_alloc_message(0, NULL); - mp->data.heap_frag = tmr->btm.bp; - tmr->btm.bp = NULL; - erts_queue_message(proc, 0, mp, tmr->btm.message, - am_clock_service); - erts_proc_lock(proc, ERTS_PROC_LOCK_BTM); #ifdef ERTS_MAGIC_REF_BIF_TIMERS if (tmr->btm.proc_list.next) { proc_btm_list_delete(&proc->bif_timers, tmr); @@ -1276,10 +1277,10 @@ bif_timer_timeout(ErtsHLTimerService *srv, dec_refc = 1; } #endif - erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM); - if (dec_refc) - timer_pre_dec_refc((ErtsTimer *) tmr); } + erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM); + if (dec_refc) + timer_pre_dec_refc((ErtsTimer *) tmr); } if (tmr->btm.bp) free_message_buffer(tmr->btm.bp); diff --git a/erts/emulator/beam/erl_io_queue.c b/erts/emulator/beam/erl_io_queue.c new file mode 100644 index 0000000000..a01b676d39 --- /dev/null +++ b/erts/emulator/beam/erl_io_queue.c @@ -0,0 +1,1230 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2017. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "global.h" + +#define ERL_WANT_HIPE_BIF_WRAPPER__ +#include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ + +#include "erl_bits.h" +#include "erl_io_queue.h" + +#define IOL2V_SMALL_BIN_LIMIT (ERL_ONHEAP_BIN_LIMIT * 4) + +static void free_binary(ErtsIOQBinary *b, int driver); +static ErtsIOQBinary *alloc_binary(Uint size, char *source, void **iov_base, int driver); + +void erts_ioq_init(ErtsIOQueue *q, ErtsAlcType_t alct, int driver) +{ + + ERTS_CT_ASSERT(offsetof(ErlNifIOVec,flags) == sizeof(ErtsIOVecCommon)); + ERTS_CT_ASSERT(sizeof(ErlIOVec) == sizeof(ErtsIOVecCommon)); + ERTS_CT_ASSERT(sizeof(size_t) == sizeof(ErlDrvSizeT)); + ERTS_CT_ASSERT(sizeof(size_t) == sizeof(Uint)); + + q->alct = alct; + q->driver = driver; + q->size = 0; + q->v_head = q->v_tail = q->v_start = q->v_small; + q->v_end = q->v_small + ERTS_SMALL_IO_QUEUE; + q->b_head = q->b_tail = q->b_start = q->b_small; + q->b_end = q->b_small + ERTS_SMALL_IO_QUEUE; +} + +void erts_ioq_clear(ErtsIOQueue *q) +{ + ErtsIOQBinary** binp = q->b_head; + int driver = q->driver; + + if (q->v_start != q->v_small) + erts_free(q->alct, (void *) q->v_start); + + while(binp < q->b_tail) { + if (*binp != NULL) + free_binary(*binp, driver); + binp++; + } + if (q->b_start != q->b_small) + erts_free(q->alct, (void *) q->b_start); + q->v_start = q->v_end = q->v_head = q->v_tail = NULL; + q->b_start = q->b_end = q->b_head = q->b_tail = NULL; + q->size = 0; +} + +static void free_binary(ErtsIOQBinary *b, int driver) +{ + if (driver) + driver_free_binary(&b->driver); + else if (erts_refc_dectest(&b->nif.intern.refc, 0) == 0) + erts_bin_free(&b->nif); +} + +static ErtsIOQBinary *alloc_binary(Uint size, char *source, void **iov_base, int driver) +{ + if (driver) { + ErlDrvBinary *bin = driver_alloc_binary(size); + if (!bin) return NULL; + sys_memcpy(bin->orig_bytes, source, size); + *iov_base = bin->orig_bytes; + return (ErtsIOQBinary *)bin; + } else { + /* This clause can be triggered in enif_ioq_enq_binary is used */ + Binary *bin = erts_bin_nrml_alloc(size); + if (!bin) return NULL; + erts_refc_init(&bin->intern.refc, 1); + sys_memcpy(bin->orig_bytes, source, size); + *iov_base = bin->orig_bytes; + return (ErtsIOQBinary *)bin; + } +} + +Uint erts_ioq_size(ErtsIOQueue *q) +{ + return q->size; +} + +/* expand queue to hold n elements in tail or head */ +static int expandq(ErtsIOQueue* q, int n, int tail) +/* tail: 0 if make room in head, make room in tail otherwise */ +{ + int h_sz; /* room before header */ + int t_sz; /* room after tail */ + int q_sz; /* occupied */ + int nvsz; + SysIOVec* niov; + ErtsIOQBinary** nbinv; + + h_sz = q->v_head - q->v_start; + t_sz = q->v_end - q->v_tail; + q_sz = q->v_tail - q->v_head; + + if (tail && (n <= t_sz)) /* do we need to expand tail? */ + return 0; + else if (!tail && (n <= h_sz)) /* do we need to expand head? */ + return 0; + else if (n > (h_sz + t_sz)) { /* need to allocate */ + /* we may get little extra but it ok */ + nvsz = (q->v_end - q->v_start) + n; + + niov = erts_alloc_fnf(q->alct, nvsz * sizeof(SysIOVec)); + if (!niov) + return -1; + nbinv = erts_alloc_fnf(q->alct, nvsz * sizeof(ErtsIOQBinary**)); + if (!nbinv) { + erts_free(q->alct, (void *) niov); + return -1; + } + if (tail) { + sys_memcpy(niov, q->v_head, q_sz*sizeof(SysIOVec)); + if (q->v_start != q->v_small) + erts_free(q->alct, (void *) q->v_start); + q->v_start = niov; + q->v_end = niov + nvsz; + q->v_head = q->v_start; + q->v_tail = q->v_head + q_sz; + + sys_memcpy(nbinv, q->b_head, q_sz*sizeof(ErtsIOQBinary*)); + if (q->b_start != q->b_small) + erts_free(q->alct, (void *) q->b_start); + q->b_start = nbinv; + q->b_end = nbinv + nvsz; + q->b_head = q->b_start; + q->b_tail = q->b_head + q_sz; + } + else { + sys_memcpy(niov+nvsz-q_sz, q->v_head, q_sz*sizeof(SysIOVec)); + if (q->v_start != q->v_small) + erts_free(q->alct, (void *) q->v_start); + q->v_start = niov; + q->v_end = niov + nvsz; + q->v_tail = q->v_end; + q->v_head = q->v_tail - q_sz; + + sys_memcpy(nbinv+nvsz-q_sz, q->b_head, q_sz*sizeof(ErtsIOQBinary*)); + if (q->b_start != q->b_small) + erts_free(q->alct, (void *) q->b_start); + q->b_start = nbinv; + q->b_end = nbinv + nvsz; + q->b_tail = q->b_end; + q->b_head = q->b_tail - q_sz; + } + } + else if (tail) { /* move to beginning to make room in tail */ + sys_memmove(q->v_start, q->v_head, q_sz*sizeof(SysIOVec)); + q->v_head = q->v_start; + q->v_tail = q->v_head + q_sz; + sys_memmove(q->b_start, q->b_head, q_sz*sizeof(ErtsIOQBinary*)); + q->b_head = q->b_start; + q->b_tail = q->b_head + q_sz; + } + else { /* move to end to make room */ + sys_memmove(q->v_end-q_sz, q->v_head, q_sz*sizeof(SysIOVec)); + q->v_tail = q->v_end; + q->v_head = q->v_tail-q_sz; + sys_memmove(q->b_end-q_sz, q->b_head, q_sz*sizeof(ErtsIOQBinary*)); + q->b_tail = q->b_end; + q->b_head = q->b_tail-q_sz; + } + + return 0; +} + +static +int skip(ErtsIOVec* vec, Uint skipbytes, + SysIOVec **iovp, ErtsIOQBinary ***binvp, + Uint *lenp) +{ + int n; + Uint len; + SysIOVec* iov; + ErtsIOQBinary** binv; + + if (vec->common.size <= skipbytes) + return -1; + + iov = vec->common.iov; + binv = vec->common.binv; + n = vec->common.vsize; + /* we use do here to strip iov_len=0 from beginning */ + do { + len = iov->iov_len; + if (len <= skipbytes) { + skipbytes -= len; + iov++; + binv++; + n--; + } + else { + iov->iov_base = ((char *)(iov->iov_base)) + skipbytes; + iov->iov_len -= skipbytes; + skipbytes = 0; + } + } while(skipbytes > 0); + + *binvp = binv; + *iovp = iov; + *lenp = len; + + return n; +} + +/* Put elements from vec at q tail */ +int erts_ioq_enqv(ErtsIOQueue *q, ErtsIOVec *eiov, Uint skipbytes) +{ + int n; + Uint len; + Uint size = eiov->common.size - skipbytes; + SysIOVec *iov; + ErtsIOQBinary** binv; + ErtsIOQBinary* b; + + if (q == NULL) + return -1; + + ASSERT(eiov->common.size >= skipbytes); + if (eiov->common.size <= skipbytes) + return 0; + + n = skip(eiov, skipbytes, &iov, &binv, &len); + + if (n < 0) + return n; + + if (q->v_tail + n >= q->v_end) + if (expandq(q, n, 1)) + return -1; + + /* Queue and reference all binaries (remove zero length items) */ + while(n--) { + if ((len = iov->iov_len) > 0) { + if ((b = *binv) == NULL) { /* special case create binary ! */ + b = alloc_binary(len, iov->iov_base, (void**)&q->v_tail->iov_base, + q->driver); + if (!b) return -1; + *q->b_tail++ = b; + q->v_tail->iov_len = len; + q->v_tail++; + } + else { + if (q->driver) + driver_binary_inc_refc(&b->driver); + else + erts_refc_inc(&b->nif.intern.refc, 1); + *q->b_tail++ = b; + *q->v_tail++ = *iov; + } + } + iov++; + binv++; + } + q->size += size; /* update total size in queue */ + return 0; +} + +/* Put elements from vec at q head */ +int erts_ioq_pushqv(ErtsIOQueue *q, ErtsIOVec* vec, Uint skipbytes) +{ + int n; + Uint len; + Uint size = vec->common.size - skipbytes; + SysIOVec* iov; + ErtsIOQBinary** binv; + ErtsIOQBinary* b; + + if (q == NULL) + return -1; + + ASSERT(vec->common.size >= skipbytes); + if (vec->common.size <= skipbytes) + return 0; + + n = skip(vec, skipbytes, &iov, &binv, &len); + + if (n < 0) + return n; + + if (q->v_head - n < q->v_start) + if (expandq(q, n, 0)) + return -1; + + /* Queue and reference all binaries (remove zero length items) */ + iov += (n-1); /* move to end */ + binv += (n-1); /* move to end */ + while(n--) { + if ((len = iov->iov_len) > 0) { + if ((b = *binv) == NULL) { /* special case create binary ! */ + if (q->driver) { + ErlDrvBinary *bin = driver_alloc_binary(len); + if (!bin) return -1; + sys_memcpy(bin->orig_bytes, iov->iov_base, len); + b = (ErtsIOQBinary *)bin; + q->v_head->iov_base = bin->orig_bytes; + } + *--q->b_head = b; + q->v_head--; + q->v_head->iov_len = len; + } + else { + if (q->driver) + driver_binary_inc_refc(&b->driver); + else + erts_refc_inc(&b->nif.intern.refc, 1); + *--q->b_head = b; + *--q->v_head = *iov; + } + } + iov--; + binv--; + } + q->size += size; /* update total size in queue */ + return 0; +} + + +/* +** Remove size bytes from queue head +** Return number of bytes that remain in queue +*/ +int erts_ioq_deq(ErtsIOQueue *q, Uint size) +{ + Uint len; + + if ((q == NULL) || (q->size < size)) + return -1; + q->size -= size; + while (size > 0) { + ASSERT(q->v_head != q->v_tail); + + len = q->v_head->iov_len; + if (len <= size) { + size -= len; + free_binary(*q->b_head, q->driver); + *q->b_head++ = NULL; + q->v_head++; + } + else { + q->v_head->iov_base = ((char *)(q->v_head->iov_base)) + size; + q->v_head->iov_len -= size; + size = 0; + } + } + + /* restart pointers (optimised for enq) */ + if (q->v_head == q->v_tail) { + q->v_head = q->v_tail = q->v_start; + q->b_head = q->b_tail = q->b_start; + } + return 0; +} + + +Uint erts_ioq_peekqv(ErtsIOQueue *q, ErtsIOVec *ev) { + ASSERT(ev); + + if (! q) { + return (Uint) -1; + } else { + if ((ev->common.vsize = q->v_tail - q->v_head) == 0) { + ev->common.size = 0; + ev->common.iov = NULL; + ev->common.binv = NULL; + } else { + ev->common.size = q->size; + ev->common.iov = q->v_head; + ev->common.binv = q->b_head; + } + return q->size; + } +} + +SysIOVec* erts_ioq_peekq(ErtsIOQueue *q, int* vlenp) /* length of io-vector */ +{ + + if (q == NULL) { + *vlenp = -1; + return NULL; + } + if ((*vlenp = (q->v_tail - q->v_head)) == 0) + return NULL; + return q->v_head; +} + +/* Fills a possibly deep list of chars and binaries into vec +** Small characters are first stored in the buffer buf of length ln +** binaries found are copied and linked into msoh +** Return vector length on succsess, +** -1 on overflow +** -2 on type error +*/ + +static ERTS_INLINE void +io_list_to_vec_set_vec(SysIOVec **iov, ErtsIOQBinary ***binv, + ErtsIOQBinary *bin, byte *ptr, Uint len, + int *vlen) +{ + while (len > MAX_SYSIOVEC_IOVLEN) { + (*iov)->iov_base = ptr; + (*iov)->iov_len = MAX_SYSIOVEC_IOVLEN; + ptr += MAX_SYSIOVEC_IOVLEN; + len -= MAX_SYSIOVEC_IOVLEN; + (*iov)++; + (*vlen)++; + *(*binv)++ = bin; + } + (*iov)->iov_base = ptr; + (*iov)->iov_len = len; + *(*binv)++ = bin; + (*iov)++; + (*vlen)++; +} + +int +erts_ioq_iolist_to_vec(Eterm obj, /* io-list */ + SysIOVec* iov, /* io vector */ + ErtsIOQBinary** binv, /* binary reference vector */ + ErtsIOQBinary* cbin, /* binary to store characters */ + Uint bin_limit, /* small binaries limit */ + int driver) +{ + DECLARE_ESTACK(s); + Eterm* objp; + byte *buf = NULL; + Uint len = 0; + Uint csize = 0; + int vlen = 0; + byte* cptr; + + if (cbin) { + if (driver) { + buf = (byte*)cbin->driver.orig_bytes; + len = cbin->driver.orig_size; + } else { + buf = (byte*)cbin->nif.orig_bytes; + len = cbin->nif.orig_size; + } + } + cptr = buf; + + goto L_jump_start; /* avoid push */ + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_jump_start: + if (is_list(obj)) { + L_iter_list: + objp = list_val(obj); + obj = CAR(objp); + if (is_byte(obj)) { + if (len == 0) + goto L_overflow; + *buf++ = unsigned_val(obj); + csize++; + len--; + } else if (is_binary(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto handle_binary; + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto L_iter_list; /* on head */ + } else if (!is_nil(obj)) { + goto L_type_error; + } + obj = CDR(objp); + if (is_list(obj)) + goto L_iter_list; /* on tail */ + else if (is_binary(obj)) { + goto handle_binary; + } else if (!is_nil(obj)) { + goto L_type_error; + } + } else if (is_binary(obj)) { + Eterm real_bin; + Uint offset; + Eterm* bptr; + Uint size; + int bitoffs; + int bitsize; + + handle_binary: + size = binary_size(obj); + ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); + ASSERT(bitsize == 0); + bptr = binary_val(real_bin); + if (*bptr == HEADER_PROC_BIN) { + ProcBin* pb = (ProcBin *) bptr; + if (bitoffs != 0) { + if (len < size) { + goto L_overflow; + } + erts_copy_bits(pb->bytes+offset, bitoffs, 1, + (byte *) buf, 0, 1, size*8); + csize += size; + buf += size; + len -= size; + } else if (bin_limit && size < bin_limit) { + if (len < size) { + goto L_overflow; + } + sys_memcpy(buf, pb->bytes+offset, size); + csize += size; + buf += size; + len -= size; + } else { + ErtsIOQBinary *qbin; + if (csize != 0) { + io_list_to_vec_set_vec(&iov, &binv, cbin, + cptr, csize, &vlen); + cptr = buf; + csize = 0; + } + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + if (driver) + qbin = (ErtsIOQBinary*)Binary2ErlDrvBinary(pb->val); + else + qbin = (ErtsIOQBinary*)pb->val; + + io_list_to_vec_set_vec( + &iov, &binv, qbin, + pb->bytes+offset, size, &vlen); + } + } else { + ErlHeapBin* hb = (ErlHeapBin *) bptr; + if (len < size) { + goto L_overflow; + } + copy_binary_to_buffer(buf, 0, + ((byte *) hb->data)+offset, bitoffs, + 8*size); + csize += size; + buf += size; + len -= size; + } + } else if (!is_nil(obj)) { + goto L_type_error; + } + } + + if (csize != 0) { + io_list_to_vec_set_vec(&iov, &binv, cbin, cptr, csize, &vlen); + } + + DESTROY_ESTACK(s); + return vlen; + + L_type_error: + DESTROY_ESTACK(s); + return -2; + + L_overflow: + DESTROY_ESTACK(s); + return -1; +} + +static ERTS_INLINE int +io_list_vec_count(Eterm obj, Uint *v_size, + Uint *c_size, Uint *b_size, Uint *in_clist, + Uint *p_v_size, Uint *p_c_size, Uint *p_in_clist, + Uint blimit) +{ + Uint size = binary_size(obj); + Eterm real; + ERTS_DECLARE_DUMMY(Uint offset); + int bitoffs; + int bitsize; + ERTS_GET_REAL_BIN(obj, real, offset, bitoffs, bitsize); + if (bitsize != 0) return 1; + if (thing_subtag(*binary_val(real)) == REFC_BINARY_SUBTAG && + bitoffs == 0) { + *b_size += size; + if (*b_size < size) return 2; + *in_clist = 0; + ++*v_size; + /* If iov_len is smaller then Uint we split the binary into*/ + /* multiple smaller (2GB) elements in the iolist.*/ + *v_size += size / MAX_SYSIOVEC_IOVLEN; + if (size >= blimit) { + *p_in_clist = 0; + ++*p_v_size; + } else { + *p_c_size += size; + if (!*p_in_clist) { + *p_in_clist = 1; + ++*p_v_size; + } + } + } else { + *c_size += size; + if (*c_size < size) return 2; + if (!*in_clist) { + *in_clist = 1; + ++*v_size; + } + *p_c_size += size; + if (!*p_in_clist) { + *p_in_clist = 1; + ++*p_v_size; + } + } + return 0; +} + +#define IO_LIST_VEC_COUNT(obj) \ + do { \ + switch (io_list_vec_count(obj, &v_size, &c_size, \ + &b_size, &in_clist, \ + &p_v_size, &p_c_size, &p_in_clist, \ + blimit)) { \ + case 1: goto L_type_error; \ + case 2: goto L_overflow_error; \ + default: break; \ + } \ + } while(0) + +/* + * Returns 0 if successful and a non-zero value otherwise. + * + * Return values through pointers: + * *vsize - SysIOVec size needed for a writev + * *csize - Number of bytes not in binary (in the common binary) + * *pvsize - SysIOVec size needed if packing small binaries + * *pcsize - Number of bytes in the common binary if packing + * *total_size - Total size of iolist in bytes + */ +int +erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize, + Uint* pvsize, Uint* pcsize, + Uint* total_size, Uint blimit) +{ + DECLARE_ESTACK(s); + Eterm* objp; + Uint v_size = 0; + Uint c_size = 0; + Uint b_size = 0; + Uint in_clist = 0; + Uint p_v_size = 0; + Uint p_c_size = 0; + Uint p_in_clist = 0; + Uint total; + + goto L_jump_start; /* avoid a push */ + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_jump_start: + if (is_list(obj)) { + L_iter_list: + objp = list_val(obj); + obj = CAR(objp); + + if (is_byte(obj)) { + c_size++; + if (c_size == 0) { + goto L_overflow_error; + } + if (!in_clist) { + in_clist = 1; + v_size++; + } + p_c_size++; + if (!p_in_clist) { + p_in_clist = 1; + p_v_size++; + } + } + else if (is_binary(obj)) { + IO_LIST_VEC_COUNT(obj); + } + else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto L_iter_list; /* on head */ + } + else if (!is_nil(obj)) { + goto L_type_error; + } + + obj = CDR(objp); + if (is_list(obj)) + goto L_iter_list; /* on tail */ + else if (is_binary(obj)) { /* binary tail is OK */ + IO_LIST_VEC_COUNT(obj); + } + else if (!is_nil(obj)) { + goto L_type_error; + } + } + else if (is_binary(obj)) { + IO_LIST_VEC_COUNT(obj); + } + else if (!is_nil(obj)) { + goto L_type_error; + } + } + + total = c_size + b_size; + if (total < c_size) { + goto L_overflow_error; + } + *total_size = total; + + DESTROY_ESTACK(s); + *vsize = v_size; + *csize = c_size; + *pvsize = p_v_size; + *pcsize = p_c_size; + return 0; + + L_type_error: + L_overflow_error: + DESTROY_ESTACK(s); + return 1; +} + +typedef struct { + Eterm result_head; + Eterm result_tail; + Eterm input_list; + + UWord acc_size; + Binary *acc; + + /* We yield after copying this many bytes into the accumulator (Minus + * eating a few on consing etc). Large binaries will only count to the + * extent their split (if any) resulted in a copy op. */ + UWord bytereds_available; + UWord bytereds_spent; + + Process *process; + ErtsEStack estack; + + Eterm magic_reference; +} iol2v_state_t; + +static int iol2v_state_destructor(Binary *data) { + iol2v_state_t *state = ERTS_MAGIC_BIN_UNALIGNED_DATA(data); + + DESTROY_SAVED_ESTACK(&state->estack); + + if (state->acc != NULL) { + erts_bin_free(state->acc); + } + + return 1; +} + +static void iol2v_init(iol2v_state_t *state, Process *process, Eterm input) { + state->process = process; + + state->result_head = NIL; + state->result_tail = NIL; + state->input_list = input; + + state->magic_reference = NIL; + state->acc_size = 0; + state->acc = NULL; + + CLEAR_SAVED_ESTACK(&state->estack); +} + +static Eterm iol2v_make_sub_bin(iol2v_state_t *state, Eterm bin_term, + UWord offset, UWord size) { + Uint byte_offset, bit_offset, bit_size; + ErlSubBin *sb; + Eterm orig_pb_term; + + sb = (ErlSubBin*)HAlloc(state->process, ERL_SUB_BIN_SIZE); + + ERTS_GET_REAL_BIN(bin_term, orig_pb_term, + byte_offset, bit_offset, bit_size); + + (void)bit_offset; + (void)bit_size; + + sb->thing_word = HEADER_SUB_BIN; + sb->bitsize = 0; + sb->bitoffs = 0; + sb->orig = orig_pb_term; + sb->is_writable = 0; + + sb->offs = byte_offset + offset; + sb->size = size; + + return make_binary(sb); +} + +static Eterm iol2v_promote_acc(iol2v_state_t *state) { + ProcBin *pb; + + state->acc = erts_bin_realloc(state->acc, state->acc_size); + + pb = (ProcBin*)HAlloc(state->process, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = state->acc_size; + pb->val = state->acc; + pb->bytes = (byte*)(state->acc)->orig_bytes; + pb->flags = 0; + pb->next = MSO(state->process).first; + OH_OVERHEAD(&(MSO(state->process)), pb->size / sizeof(Eterm)); + MSO(state->process).first = (struct erl_off_heap_header*)pb; + + state->acc_size = 0; + state->acc = NULL; + + return make_binary(pb); +} + +/* Destructively enqueues a term to the result list, saving us the hassle of + * having to reverse it later. This is safe since GC is disabled and we never + * leak the unfinished term to the outside. */ +static void iol2v_enqueue_result(iol2v_state_t *state, Eterm term) { + Eterm prev_tail; + Eterm *hp; + + prev_tail = state->result_tail; + + hp = HAlloc(state->process, 2); + state->result_tail = CONS(hp, term, NIL); + + if(prev_tail != NIL) { + Eterm *prev_cell = list_val(prev_tail); + CDR(prev_cell) = state->result_tail; + } else { + state->result_head = state->result_tail; + } + + state->bytereds_spent += 1; +} + +#ifndef DEBUG + #define ACC_REALLOCATION_LIMIT (IOL2V_SMALL_BIN_LIMIT * 32) +#else + #define ACC_REALLOCATION_LIMIT (IOL2V_SMALL_BIN_LIMIT * 4) +#endif + +static void iol2v_expand_acc(iol2v_state_t *state, UWord extra) { + UWord required_bytes, acc_alloc_size; + + ERTS_CT_ASSERT(ERTS_UWORD_MAX > ACC_REALLOCATION_LIMIT / 2); + ASSERT(extra >= 1); + + acc_alloc_size = state->acc != NULL ? (state->acc)->orig_size : 0; + required_bytes = state->acc_size + extra; + + if (state->acc == NULL) { + UWord new_size = MAX(required_bytes, IOL2V_SMALL_BIN_LIMIT); + + state->acc = erts_bin_nrml_alloc(new_size); + } else if (required_bytes > acc_alloc_size) { + Binary *prev_acc; + UWord new_size; + + if (acc_alloc_size >= ACC_REALLOCATION_LIMIT) { + /* We skip reallocating once we hit a certain point; it often + * results in extra copying and we're very likely to overallocate + * on anything other than absurdly long byte/heapbin sequences. */ + iol2v_enqueue_result(state, iol2v_promote_acc(state)); + iol2v_expand_acc(state, extra); + return; + } + + new_size = MAX(required_bytes, acc_alloc_size * 2); + prev_acc = state->acc; + + state->acc = erts_bin_realloc(prev_acc, new_size); + + if (prev_acc != state->acc) { + state->bytereds_spent += state->acc_size; + } + } + + state->bytereds_spent += extra; +} + +static int iol2v_append_byte_seq(iol2v_state_t *state, Eterm seq_start, Eterm *seq_end) { + Eterm lookahead, iterator; + Uint observed_bits; + SWord seq_length; + char *acc_data; + + lookahead = seq_start; + seq_length = 0; + + ASSERT(state->bytereds_available > state->bytereds_spent); + + while (is_list(lookahead)) { + Eterm *cell = list_val(lookahead); + + if (!is_small(CAR(cell))) { + break; + } + + if (seq_length * 2 >= (state->bytereds_available - state->bytereds_spent)) { + break; + } + + lookahead = CDR(cell); + seq_length += 1; + } + + ASSERT(seq_length >= 1); + + iol2v_expand_acc(state, seq_length); + + /* Bump a few extra reductions to account for list traversal. */ + state->bytereds_spent += seq_length; + + acc_data = &(state->acc)->orig_bytes[state->acc_size]; + state->acc_size += seq_length; + + iterator = seq_start; + observed_bits = 0; + + while (iterator != lookahead) { + Eterm *cell; + Uint byte; + + cell = list_val(iterator); + iterator = CDR(cell); + + byte = unsigned_val(CAR(cell)); + observed_bits |= byte; + + ASSERT(acc_data < &(state->acc)->orig_bytes[state->acc_size]); + *(acc_data++) = byte; + } + + if (observed_bits > UCHAR_MAX) { + return 0; + } + + ASSERT(acc_data == &(state->acc)->orig_bytes[state->acc_size]); + *seq_end = iterator; + + return 1; +} + +static int iol2v_append_binary(iol2v_state_t *state, Eterm bin_term) { + int is_acc_small, is_bin_small; + UWord combined_size; + UWord binary_size; + + Uint byte_offset, bit_offset, bit_size; + Eterm *parent_header; + Eterm parent_binary; + byte *binary_data; + + ASSERT(state->bytereds_available > state->bytereds_spent); + + ERTS_GET_REAL_BIN(bin_term, parent_binary, byte_offset, bit_offset, bit_size); + parent_header = binary_val(parent_binary); + binary_size = binary_size(bin_term); + + if (bit_offset != 0 || bit_size != 0) { + return 0; + } else if (binary_size == 0) { + state->bytereds_spent += 1; + return 1; + } + + is_acc_small = state->acc_size < IOL2V_SMALL_BIN_LIMIT; + is_bin_small = binary_size < IOL2V_SMALL_BIN_LIMIT; + combined_size = binary_size + state->acc_size; + + if (thing_subtag(*parent_header) == REFC_BINARY_SUBTAG) { + ProcBin *pb = (ProcBin*)parent_header; + + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + + binary_data = pb->bytes; + } else { + ErlHeapBin *hb = (ErlHeapBin*)parent_header; + + ASSERT(thing_subtag(*parent_header) == HEAP_BINARY_SUBTAG); + ASSERT(is_bin_small); + + binary_data = &((unsigned char*)&hb->data)[byte_offset]; + } + + if (!is_bin_small && (state->acc_size == 0 || !is_acc_small)) { + /* Avoid combining if we encounter an acceptably large binary while the + * accumulator is either empty or large enough to be returned on its + * own. */ + if (state->acc_size != 0) { + iol2v_enqueue_result(state, iol2v_promote_acc(state)); + } + + iol2v_enqueue_result(state, bin_term); + } else if (is_bin_small || combined_size < (IOL2V_SMALL_BIN_LIMIT * 2)) { + /* If the candidate is small or we can't split the combination in two, + * then just copy it into the accumulator. */ + iol2v_expand_acc(state, binary_size); + + sys_memcpy(&(state->acc)->orig_bytes[state->acc_size], + binary_data, binary_size); + + state->acc_size += binary_size; + } else { + /* Otherwise, append enough data for the accumulator to be valid, and + * then return the rest as a sub-binary. */ + UWord spill = IOL2V_SMALL_BIN_LIMIT - state->acc_size; + Eterm binary_tail; + + iol2v_expand_acc(state, spill); + + sys_memcpy(&(state->acc)->orig_bytes[state->acc_size], + binary_data, spill); + + state->acc_size += spill; + + binary_tail = iol2v_make_sub_bin(state, bin_term, spill, + binary_size - spill); + + iol2v_enqueue_result(state, iol2v_promote_acc(state)); + iol2v_enqueue_result(state, binary_tail); + } + + return 1; +} + +static BIF_RETTYPE iol2v_yield(iol2v_state_t *state) { + if (is_nil(state->magic_reference)) { + iol2v_state_t *boxed_state; + Binary *magic_binary; + Eterm *hp; + + magic_binary = erts_create_magic_binary_x(sizeof(*state), + &iol2v_state_destructor, ERTS_ALC_T_BINARY, 1); + + boxed_state = ERTS_MAGIC_BIN_UNALIGNED_DATA(magic_binary); + sys_memcpy(boxed_state, state, sizeof(*state)); + + hp = HAlloc(boxed_state->process, ERTS_MAGIC_REF_THING_SIZE); + boxed_state->magic_reference = + erts_mk_magic_ref(&hp, &MSO(boxed_state->process), magic_binary); + + state = boxed_state; + } + + ERTS_BIF_YIELD1(bif_export[BIF_iolist_to_iovec_1], + state->process, state->magic_reference); +} + +static BIF_RETTYPE iol2v_continue(iol2v_state_t *state) { + Eterm iterator; + + DECLARE_ESTACK(s); + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); + + state->bytereds_available = + ERTS_BIF_REDS_LEFT(state->process) * IOL2V_SMALL_BIN_LIMIT; + state->bytereds_spent = 0; + + if (state->estack.start) { + ESTACK_RESTORE(s, &state->estack); + } + + iterator = state->input_list; + + for(;;) { + if (state->bytereds_spent >= state->bytereds_available) { + ESTACK_SAVE(s, &state->estack); + state->input_list = iterator; + + return iol2v_yield(state); + } + + while (is_list(iterator)) { + Eterm *cell; + Eterm head; + + cell = list_val(iterator); + head = CAR(cell); + + if (is_binary(head)) { + if (!iol2v_append_binary(state, head)) { + goto l_badarg; + } + + iterator = CDR(cell); + } else if (is_small(head)) { + Eterm seq_end; + + if (!iol2v_append_byte_seq(state, iterator, &seq_end)) { + goto l_badarg; + } + + iterator = seq_end; + } else if (is_list(head) || is_nil(head)) { + Eterm tail = CDR(cell); + + if (!is_nil(tail)) { + ESTACK_PUSH(s, tail); + } + + state->bytereds_spent += 1; + iterator = head; + } else { + goto l_badarg; + } + + if (state->bytereds_spent >= state->bytereds_available) { + ESTACK_SAVE(s, &state->estack); + state->input_list = iterator; + + return iol2v_yield(state); + } + } + + if (is_binary(iterator)) { + if (!iol2v_append_binary(state, iterator)) { + goto l_badarg; + } + } else if (!is_nil(iterator)) { + goto l_badarg; + } + + if(ESTACK_ISEMPTY(s)) { + break; + } + + iterator = ESTACK_POP(s); + } + + if (state->acc_size != 0) { + iol2v_enqueue_result(state, iol2v_promote_acc(state)); + } + + BUMP_REDS(state->process, state->bytereds_spent / IOL2V_SMALL_BIN_LIMIT); + + CLEAR_SAVED_ESTACK(&state->estack); + DESTROY_ESTACK(s); + + BIF_RET(state->result_head); + +l_badarg: + CLEAR_SAVED_ESTACK(&state->estack); + DESTROY_ESTACK(s); + + if (state->acc != NULL) { + erts_bin_free(state->acc); + state->acc = NULL; + } + + BIF_ERROR(state->process, BADARG); +} + +HIPE_WRAPPER_BIF_DISABLE_GC(iolist_to_iovec, 1) + +BIF_RETTYPE iolist_to_iovec_1(BIF_ALIST_1) { + BIF_RETTYPE result; + + if (is_nil(BIF_ARG_1)) { + BIF_RET(NIL); + } else if (is_binary(BIF_ARG_1)) { + if (binary_size(BIF_ARG_1) != 0) { + Eterm *hp = HAlloc(BIF_P, 2); + + BIF_RET(CONS(hp, BIF_ARG_1, NIL)); + } else { + BIF_RET(NIL); + } + } else if (is_internal_magic_ref(BIF_ARG_1)) { + iol2v_state_t *state; + Binary *magic; + + magic = erts_magic_ref2bin(BIF_ARG_1); + + if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != &iol2v_state_destructor) { + ASSERT(!(BIF_P->flags & F_DISABLE_GC)); + BIF_ERROR(BIF_P, BADARG); + } + + ASSERT(BIF_P->flags & F_DISABLE_GC); + + state = ERTS_MAGIC_BIN_UNALIGNED_DATA(magic); + result = iol2v_continue(state); + } else if (!is_list(BIF_ARG_1)) { + ASSERT(!(BIF_P->flags & F_DISABLE_GC)); + BIF_ERROR(BIF_P, BADARG); + } else { + iol2v_state_t state; + + iol2v_init(&state, BIF_P, BIF_ARG_1); + + erts_set_gc_state(BIF_P, 0); + + result = iol2v_continue(&state); + } + + if (result != THE_NON_VALUE || BIF_P->freason != TRAP) { + erts_set_gc_state(BIF_P, 1); + } + + BIF_RET(result); +} diff --git a/erts/emulator/beam/erl_io_queue.h b/erts/emulator/beam/erl_io_queue.h new file mode 100644 index 0000000000..51abe99510 --- /dev/null +++ b/erts/emulator/beam/erl_io_queue.h @@ -0,0 +1,201 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2017. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: A queue used for storing binary data that should be + * passed to writev or similar functions. Used by both + * the nif and driver api. + * + * Author: Lukas Larsson + */ + +#ifndef ERL_IO_QUEUE_H__TYPES__ +#define ERL_IO_QUEUE_H__TYPES__ + +#define ERTS_BINARY_TYPES_ONLY__ +#include "erl_binary.h" +#undef ERTS_BINARY_TYPES_ONLY__ +#include "erl_nif.h" + +#ifdef DEBUG +#define MAX_SYSIOVEC_IOVLEN (1ull << (32 - 1)) +#else +#define MAX_SYSIOVEC_IOVLEN (1ull << (sizeof(((SysIOVec*)0)->iov_len) * 8 - 1)) +#endif + +#define ERTS_SMALL_IO_QUEUE 5 + +typedef union { + ErlDrvBinary driver; + Binary nif; +} ErtsIOQBinary; + +typedef struct { + int vsize; /* length of vectors */ + Uint size; /* total size in bytes */ + SysIOVec* iov; + ErtsIOQBinary** binv; +} ErtsIOVecCommon; + +typedef union { + ErtsIOVecCommon common; + ErlIOVec driver; + ErlNifIOVec nif; +} ErtsIOVec; + +/* head/tail represent the data in the queue + * start/end represent the edges of the allocated queue + * small is used when the number of iovec elements is < SMALL_IO_QUEUE + */ +typedef struct erts_io_queue { + ErtsAlcType_t alct; + int driver; + Uint size; /* total size in bytes */ + + SysIOVec* v_start; + SysIOVec* v_end; + SysIOVec* v_head; + SysIOVec* v_tail; + SysIOVec v_small[ERTS_SMALL_IO_QUEUE]; + + ErtsIOQBinary **b_start; + ErtsIOQBinary **b_end; + ErtsIOQBinary **b_head; + ErtsIOQBinary **b_tail; + ErtsIOQBinary *b_small[ERTS_SMALL_IO_QUEUE]; + +} ErtsIOQueue; + +#endif /* ERL_IO_QUEUE_H__TYPES__ */ + +#if !defined(ERL_IO_QUEUE_H) && !defined(ERTS_IO_QUEUE_TYPES_ONLY__) +#define ERL_IO_QUEUE_H + +#include "erl_binary.h" +#include "erl_bits.h" + +void erts_ioq_init(ErtsIOQueue *q, ErtsAlcType_t alct, int driver); +void erts_ioq_clear(ErtsIOQueue *q); +Uint erts_ioq_size(ErtsIOQueue *q); +int erts_ioq_enqv(ErtsIOQueue *q, ErtsIOVec *vec, Uint skip); +int erts_ioq_pushqv(ErtsIOQueue *q, ErtsIOVec *vec, Uint skip); +int erts_ioq_deq(ErtsIOQueue *q, Uint Uint); +Uint erts_ioq_peekqv(ErtsIOQueue *q, ErtsIOVec *ev); +SysIOVec *erts_ioq_peekq(ErtsIOQueue *q, int *vlenp); +Uint erts_ioq_sizeq(ErtsIOQueue *q); + +int erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize, + Uint* pvsize, Uint* pcsize, + Uint* total_size, Uint blimit); +int erts_ioq_iolist_to_vec(Eterm obj, SysIOVec* iov, + ErtsIOQBinary** binv, ErtsIOQBinary* cbin, + Uint bin_limit, int driver_binary); + +ERTS_GLB_INLINE +int erts_ioq_iodata_vec_len(Eterm obj, int* vsize, Uint* csize, + Uint* pvsize, Uint* pcsize, + Uint* total_size, Uint blimit); +ERTS_GLB_INLINE +int erts_ioq_iodata_to_vec(Eterm obj, SysIOVec* iov, + ErtsIOQBinary** binv, ErtsIOQBinary* cbin, + Uint bin_limit, int driver_binary); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE +int erts_ioq_iodata_vec_len(Eterm obj, int* vsize, Uint* csize, + Uint* pvsize, Uint* pcsize, + Uint* total_size, Uint blimit) { + if (is_binary(obj)) { + /* We optimize for when we get a procbin without a bit-offset + * that fits in one iov slot + */ + Eterm real_bin; + byte bitoffs; + byte bitsize; + ERTS_DECLARE_DUMMY(Uint offset); + Uint size = binary_size(obj); + ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); + if (size < MAX_SYSIOVEC_IOVLEN && bitoffs == 0 && bitsize == 0) { + *vsize = 1; + *pvsize = 1; + if (thing_subtag(*binary_val(real_bin)) == REFC_BINARY_SUBTAG) { + *csize = 0; + *pcsize = 0; + } else { + *csize = size; + *pcsize = size; + } + *total_size = size; + return 0; + } + } + + return erts_ioq_iolist_vec_len(obj, vsize, csize, + pvsize, pcsize, total_size, blimit); +} + +ERTS_GLB_INLINE +int erts_ioq_iodata_to_vec(Eterm obj, + SysIOVec *iov, + ErtsIOQBinary **binv, + ErtsIOQBinary *cbin, + Uint bin_limit, + int driver) +{ + if (is_binary(obj)) { + Eterm real_bin; + byte bitoffs; + byte bitsize; + Uint offset; + Uint size = binary_size(obj); + ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); + if (size < MAX_SYSIOVEC_IOVLEN && bitoffs == 0 && bitsize == 0) { + Eterm *bptr = binary_val(real_bin); + if (thing_subtag(*bptr) == REFC_BINARY_SUBTAG) { + ProcBin *pb = (ProcBin *)bptr; + if (pb->flags) + erts_emasculate_writable_binary(pb); + iov[0].iov_base = pb->bytes+offset; + iov[0].iov_len = size; + if (driver) + binv[0] = (ErtsIOQBinary*)Binary2ErlDrvBinary(pb->val); + else + binv[0] = (ErtsIOQBinary*)pb->val; + return 1; + } else { + ErlHeapBin* hb = (ErlHeapBin *)bptr; + byte *buf = driver ? (byte*)cbin->driver.orig_bytes : + (byte*)cbin->nif.orig_bytes; + copy_binary_to_buffer(buf, 0, ((byte *) hb->data)+offset, 0, 8*size); + iov[0].iov_base = buf; + iov[0].iov_len = size; + binv[0] = cbin; + return 1; + } + } + } + return erts_ioq_iolist_to_vec(obj, iov, binv, cbin, bin_limit, driver); +} + +#endif + +#endif /* ERL_IO_QUEUE_H */ diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index b68b48874d..47c0fd2869 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -160,9 +160,9 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "xports_list_pre_alloc_lock", "address" }, { "inet_buffer_stack_lock", NULL }, { "system_block", NULL }, - { "timeofday", NULL }, { "get_time", NULL }, { "get_corrected_time", NULL }, + { "runtime", NULL }, { "breakpoints", NULL }, { "pix_lock", "address" }, { "run_queues_lists", NULL }, diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index 67c552b364..1c840d89f6 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -993,7 +993,6 @@ Eterm erts_debug_dump_monitors_1(BIF_ALIST_1) erts_dump_monitors(dep->monitors,0); erts_de_links_unlock(dep); erts_printf("Monitors dumped-------------------------\n"); - erts_deref_dist_entry(dep); BIF_RET(am_true); } else { BIF_ERROR(p,BADARG); @@ -1038,7 +1037,6 @@ Eterm erts_debug_dump_links_1(BIF_ALIST_1) erts_dump_links(dep->nlinks,0); erts_de_links_unlock(dep); erts_printf("Links dumped----------------------------\n"); - erts_deref_dist_entry(dep); BIF_RET(am_true); } else { BIF_ERROR(p,BADARG); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 9ffb53d532..d3271a4560 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -56,6 +56,7 @@ #include "erl_process.h" #include "erl_bif_unique.h" #include "erl_utils.h" +#include "erl_io_queue.h" #undef ERTS_WANT_NFUNC_SCHED_INTERNALS__ #define ERTS_WANT_NFUNC_SCHED_INTERNALS__ #include "erl_nfunc_sched.h" @@ -66,7 +67,6 @@ #include <limits.h> #include <stddef.h> /* offsetof */ - /* Information about a loaded nif library. * Each successful call to erlang:load_nif will allocate an instance of * erl_module_nif. Two calls opening the same library will thus have the same @@ -587,6 +587,10 @@ int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks) ErlTraceMessageQueue *msgq, **last_msgq; int reds = 0; + /* Only one thread at a time is allowed to flush trace messages, + so we require the main lock to be held when doing the flush */ + ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p); + erts_proc_lock(c_p, ERTS_PROC_LOCK_TRACE); msgq = c_p->trace_msg_q; @@ -3255,6 +3259,363 @@ int enif_compare_monitors(const ErlNifMonitor *monitor1, ERTS_REF_THING_SIZE*sizeof(Eterm)); } +ErlNifIOQueue *enif_ioq_create(ErlNifIOQueueOpts opts) +{ + ErlNifIOQueue *q; + + if (opts != ERL_NIF_IOQ_NORMAL) + return NULL; + + q = enif_alloc(sizeof(ErlNifIOQueue)); + if (!q) return NULL; + erts_ioq_init(q, ERTS_ALC_T_NIF, 0); + + return q; +} + +void enif_ioq_destroy(ErlNifIOQueue *q) +{ + erts_ioq_clear(q); + enif_free(q); +} + +/* If the iovec was preallocated (Stack or otherwise) it needs to be marked as + * such to perform a proper free. */ +#define ERL_NIF_IOVEC_FLAGS_PREALLOC (1 << 0) + +void enif_free_iovec(ErlNifIOVec *iov) +{ + int i; + /* Decrement the refc of all the binaries */ + for (i = 0; i < iov->iovcnt; i++) { + Binary *bptr = ((Binary**)iov->ref_bins)[i]; + /* bptr can be null if enq_binary was used */ + if (bptr && erts_refc_dectest(&bptr->intern.refc, 0) == 0) { + erts_bin_free(bptr); + } + } + + if (!(iov->flags & ERL_NIF_IOVEC_FLAGS_PREALLOC)) { + enif_free(iov); + } +} + +typedef struct { + UWord sublist_length; + Eterm sublist_start; + Eterm sublist_end; + + UWord offheap_size; + UWord onheap_size; + + UWord iovec_len; +} iovec_slice_t; + +static int examine_iovec_term(Eterm list, UWord max_length, iovec_slice_t *result) { + Eterm lookahead; + + result->sublist_start = list; + result->sublist_length = 0; + result->offheap_size = 0; + result->onheap_size = 0; + result->iovec_len = 0; + + lookahead = result->sublist_start; + + while (is_list(lookahead)) { + Eterm *binary_header, binary; + Eterm *cell; + UWord size; + + cell = list_val(lookahead); + binary = CAR(cell); + + if (!is_binary(binary)) { + return 0; + } + + size = binary_size(binary); + binary_header = binary_val(binary); + + /* If we're a sub-binary we'll need to check our underlying binary to + * determine whether we're on-heap or not. */ + if(thing_subtag(*binary_header) == SUB_BINARY_SUBTAG) { + ErlSubBin *sb = (ErlSubBin*)binary_header; + + /* Reject bitstrings */ + if((sb->bitoffs + sb->bitsize) > 0) { + return 0; + } + + ASSERT(size <= binary_size(sb->orig)); + binary_header = binary_val(sb->orig); + } + + if(thing_subtag(*binary_header) == HEAP_BINARY_SUBTAG) { + ASSERT(size <= ERL_ONHEAP_BIN_LIMIT); + + result->iovec_len += 1; + result->onheap_size += size; + } else { + ASSERT(thing_subtag(*binary_header) == REFC_BINARY_SUBTAG); + + result->iovec_len += 1 + size / MAX_SYSIOVEC_IOVLEN; + result->offheap_size += size; + } + + result->sublist_length += 1; + lookahead = CDR(cell); + + if(result->sublist_length >= max_length) { + break; + } + } + + if (!is_nil(lookahead) && !is_list(lookahead)) { + return 0; + } + + result->sublist_end = lookahead; + + return 1; +} + +static void inspect_raw_binary_data(Eterm binary, ErlNifBinary *result) { + Eterm *parent_header; + Eterm parent_binary; + + int bit_offset, bit_size; + Uint byte_offset; + + ASSERT(is_binary(binary)); + + ERTS_GET_REAL_BIN(binary, parent_binary, byte_offset, bit_offset, bit_size); + + parent_header = binary_val(parent_binary); + + result->size = binary_size(binary); + result->bin_term = binary; + + if (thing_subtag(*parent_header) == REFC_BINARY_SUBTAG) { + ProcBin *pb = (ProcBin*)parent_header; + + ASSERT(pb->val != NULL); + ASSERT(byte_offset < pb->size); + ASSERT(&pb->bytes[byte_offset] >= (byte*)(pb->val)->orig_bytes); + + result->data = (unsigned char*)&pb->bytes[byte_offset]; + result->ref_bin = (void*)pb->val; + } else { + ErlHeapBin *hb = (ErlHeapBin*)parent_header; + + ASSERT(thing_subtag(*parent_header) == HEAP_BINARY_SUBTAG); + + result->data = &((unsigned char*)&hb->data)[byte_offset]; + result->ref_bin = NULL; + } +} + +static int fill_iovec_with_slice(ErlNifEnv *env, + iovec_slice_t *slice, + ErlNifIOVec *iovec) { + UWord onheap_offset, iovec_idx; + ErlNifBinary onheap_data; + Eterm sublist_iterator; + + /* Set up a common refc binary for all on-heap binaries. */ + if (slice->onheap_size > 0) { + if (!enif_alloc_binary(slice->onheap_size, &onheap_data)) { + return 0; + } + } + + sublist_iterator = slice->sublist_start; + onheap_offset = 0; + iovec_idx = 0; + + while (sublist_iterator != slice->sublist_end) { + ErlNifBinary raw_data; + Eterm *cell; + + cell = list_val(sublist_iterator); + inspect_raw_binary_data(CAR(cell), &raw_data); + + /* If this isn't a refc binary, copy its contents to the onheap buffer + * and reference that instead. */ + if (raw_data.ref_bin == NULL) { + ASSERT(onheap_offset < onheap_data.size); + ASSERT(slice->onheap_size > 0); + + sys_memcpy(&onheap_data.data[onheap_offset], + raw_data.data, raw_data.size); + + raw_data.data = &onheap_data.data[onheap_offset]; + raw_data.ref_bin = onheap_data.ref_bin; + } + + ASSERT(raw_data.ref_bin != NULL); + + while (raw_data.size > 0) { + UWord chunk_len = MIN(raw_data.size, MAX_SYSIOVEC_IOVLEN); + + ASSERT(iovec_idx < iovec->iovcnt); + + iovec->iov[iovec_idx].iov_base = raw_data.data; + iovec->iov[iovec_idx].iov_len = chunk_len; + + iovec->ref_bins[iovec_idx] = raw_data.ref_bin; + + raw_data.data += chunk_len; + raw_data.size -= chunk_len; + + iovec_idx += 1; + } + + sublist_iterator = CDR(cell); + } + + ASSERT(iovec_idx == iovec->iovcnt); + + if (env == NULL) { + int i; + for (i = 0; i < iovec->iovcnt; i++) { + Binary *refc_binary = (Binary*)(iovec->ref_bins[i]); + erts_refc_inc(&refc_binary->intern.refc, 1); + } + + if (slice->onheap_size > 0) { + /* Transfer ownership to the iovec; we've taken references to it in + * the above loop. */ + enif_release_binary(&onheap_data); + } + } else { + if (slice->onheap_size > 0) { + /* Attach the binary to our environment and let the GC take care of + * it after returning. */ + enif_make_binary(env, &onheap_data); + } + } + + return 1; +} + +static int create_iovec_from_slice(ErlNifEnv *env, + iovec_slice_t *slice, + ErlNifIOVec **result) { + ErlNifIOVec *iovec = *result; + + if (iovec && slice->iovec_len < ERL_NIF_IOVEC_SIZE) { + iovec->iov = iovec->small_iov; + iovec->ref_bins = iovec->small_ref_bin; + iovec->flags = ERL_NIF_IOVEC_FLAGS_PREALLOC; + } else { + UWord iov_offset, binv_offset, alloc_size; + char *alloc_base; + + iov_offset = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErlNifIOVec)); + binv_offset = iov_offset; + binv_offset += ERTS_ALC_DATA_ALIGN_SIZE(slice->iovec_len * sizeof(SysIOVec)); + alloc_size = binv_offset; + alloc_size += slice->iovec_len * sizeof(Binary*); + + /* If we have an environment we'll attach the allocated data to it. The + * GC will take care of releasing it later on. */ + if (env != NULL) { + ErlNifBinary gc_bin; + + if (!enif_alloc_binary(alloc_size, &gc_bin)) { + return 0; + } + + alloc_base = (char*)gc_bin.data; + enif_make_binary(env, &gc_bin); + } else { + alloc_base = enif_alloc(alloc_size); + } + + iovec = (ErlNifIOVec*)alloc_base; + iovec->iov = (SysIOVec*)(alloc_base + iov_offset); + iovec->ref_bins = (void**)(alloc_base + binv_offset); + iovec->flags = 0; + } + + iovec->size = slice->offheap_size + slice->onheap_size; + iovec->iovcnt = slice->iovec_len; + + if(!fill_iovec_with_slice(env, slice, iovec)) { + if (env == NULL && !(iovec->flags & ERL_NIF_IOVEC_FLAGS_PREALLOC)) { + enif_free(iovec); + } + + return 0; + } + + *result = iovec; + + return 1; +} + +int enif_inspect_iovec(ErlNifEnv *env, size_t max_elements, + ERL_NIF_TERM list, ERL_NIF_TERM *tail, + ErlNifIOVec **iov) { + iovec_slice_t slice; + + if(!examine_iovec_term(list, max_elements, &slice)) { + return 0; + } else if(!create_iovec_from_slice(env, &slice, iov)) { + return 0; + } + + (*tail) = slice.sublist_end; + + return 1; +} + +/* */ +int enif_ioq_enqv(ErlNifIOQueue *q, ErlNifIOVec *iov, size_t skip) +{ + if(skip <= iov->size) { + return !erts_ioq_enqv(q, (ErtsIOVec*)iov, skip); + } + + return 0; +} + +int enif_ioq_enq_binary(ErlNifIOQueue *q, ErlNifBinary *bin, size_t skip) +{ + ErlNifIOVec vec = {1, bin->size, NULL, NULL, ERL_NIF_IOVEC_FLAGS_PREALLOC }; + Binary *ref_bin = (Binary*)bin->ref_bin; + int res; + vec.iov = vec.small_iov; + vec.ref_bins = vec.small_ref_bin; + vec.iov[0].iov_base = bin->data; + vec.iov[0].iov_len = bin->size; + ((Binary**)(vec.ref_bins))[0] = ref_bin; + + res = enif_ioq_enqv(q, &vec, skip); + enif_release_binary(bin); + return res; +} + +size_t enif_ioq_size(ErlNifIOQueue *q) +{ + return erts_ioq_size(q); +} + +int enif_ioq_deq(ErlNifIOQueue *q, size_t elems, size_t *size) +{ + if (erts_ioq_deq(q, elems) == -1) + return 0; + if (size) + *size = erts_ioq_size(q); + return 1; +} + +SysIOVec *enif_ioq_peek(ErlNifIOQueue *q, int *iovlen) +{ + return erts_ioq_peekq(q, iovlen); +} + /*************************************************************************** ** load_nif/2 ** ***************************************************************************/ diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index b0d5c39798..d195721054 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -50,6 +50,7 @@ ** 2.9: 18.2 enif_getenv ** 2.10: Time API ** 2.11: 19.0 enif_snprintf +** 2.12: 20.0 add enif_queue */ #define ERL_NIF_MAJOR_VERSION 2 #define ERL_NIF_MINOR_VERSION 12 @@ -241,6 +242,28 @@ typedef enum { ERL_NIF_PHASH2 = 2 } ErlNifHash; +#define ERL_NIF_IOVEC_SIZE 16 + +typedef struct erl_nif_io_vec { + int iovcnt; /* length of vectors */ + size_t size; /* total size in bytes */ + SysIOVec *iov; + + /* internals (avert your eyes) */ + void **ref_bins; /* Binary[] */ + int flags; + + /* Used when stack allocating the io vec */ + SysIOVec small_iov[ERL_NIF_IOVEC_SIZE]; + void *small_ref_bin[ERL_NIF_IOVEC_SIZE]; +} ErlNifIOVec; + +typedef struct erts_io_queue ErlNifIOQueue; + +typedef enum { + ERL_NIF_IOQ_NORMAL = 1 +} ErlNifIOQueueOpts; + /* * Return values from enif_thread_type(). Negative values * reserved for specific types of non-scheduler threads. diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 94c04cd126..9e573307d8 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -184,6 +184,21 @@ ERL_NIF_API_FUNC_DECL(ErlNifUInt64,enif_hash,(ErlNifHash type, ERL_NIF_TERM term ERL_NIF_API_FUNC_DECL(int, enif_whereis_pid, (ErlNifEnv *env, ERL_NIF_TERM name, ErlNifPid *pid)); ERL_NIF_API_FUNC_DECL(int, enif_whereis_port, (ErlNifEnv *env, ERL_NIF_TERM name, ErlNifPort *port)); +ERL_NIF_API_FUNC_DECL(ErlNifIOQueue *,enif_ioq_create,(ErlNifIOQueueOpts opts)); +ERL_NIF_API_FUNC_DECL(void,enif_ioq_destroy,(ErlNifIOQueue *q)); + +ERL_NIF_API_FUNC_DECL(int,enif_ioq_enq_binary,(ErlNifIOQueue *q, ErlNifBinary *bin, size_t skip)); +ERL_NIF_API_FUNC_DECL(int,enif_ioq_enqv,(ErlNifIOQueue *q, ErlNifIOVec *iov, size_t skip)); + +ERL_NIF_API_FUNC_DECL(size_t,enif_ioq_size,(ErlNifIOQueue *q)); +ERL_NIF_API_FUNC_DECL(int,enif_ioq_deq,(ErlNifIOQueue *q, size_t count, size_t *size)); + +ERL_NIF_API_FUNC_DECL(SysIOVec*,enif_ioq_peek,(ErlNifIOQueue *q, int *iovlen)); + +ERL_NIF_API_FUNC_DECL(int,enif_inspect_iovec,(ErlNifEnv *env, size_t max_length, ERL_NIF_TERM iovec_term, ERL_NIF_TERM *tail, ErlNifIOVec **iovec)); +ERL_NIF_API_FUNC_DECL(void,enif_free_iovec,(ErlNifIOVec *iov)); + + /* ** ADD NEW ENTRIES HERE (before this comment) !!! */ @@ -348,6 +363,16 @@ ERL_NIF_API_FUNC_DECL(int, enif_whereis_port, (ErlNifEnv *env, ERL_NIF_TERM name # define enif_hash ERL_NIF_API_FUNC_MACRO(enif_hash) # define enif_whereis_pid ERL_NIF_API_FUNC_MACRO(enif_whereis_pid) # define enif_whereis_port ERL_NIF_API_FUNC_MACRO(enif_whereis_port) +# define enif_ioq_create ERL_NIF_API_FUNC_MACRO(enif_ioq_create) +# define enif_ioq_destroy ERL_NIF_API_FUNC_MACRO(enif_ioq_destroy) +# define enif_ioq_enq ERL_NIF_API_FUNC_MACRO(enif_ioq_enq) +# define enif_ioq_enq_binary ERL_NIF_API_FUNC_MACRO(enif_ioq_enq_binary) +# define enif_ioq_enqv ERL_NIF_API_FUNC_MACRO(enif_ioq_enqv) +# define enif_ioq_size ERL_NIF_API_FUNC_MACRO(enif_ioq_size) +# define enif_ioq_deq ERL_NIF_API_FUNC_MACRO(enif_ioq_deq) +# define enif_ioq_peek ERL_NIF_API_FUNC_MACRO(enif_ioq_peek) +# define enif_inspect_iovec ERL_NIF_API_FUNC_MACRO(enif_inspect_iovec) +# define enif_free_iovec ERL_NIF_API_FUNC_MACRO(enif_free_iovec) /* ** ADD NEW ENTRIES HERE (before this comment) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index f8e9fec27a..0f3dfa797c 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -29,6 +29,8 @@ #include "error.h" #include "erl_thr_progress.h" #include "dtrace-wrapper.h" +#include "erl_binary.h" +#include "erl_bif_unique.h" Hash erts_dist_table; Hash erts_node_table; @@ -57,6 +59,58 @@ static ErtsMonotonicTime node_tab_delete_delay; /* -- The distribution table ---------------------------------------------- */ +#define ErtsBin2DistEntry(B) \ + ((DistEntry *) ERTS_MAGIC_BIN_DATA((B))) +#define ErtsDistEntry2Bin(DEP) \ + ((Binary *) ERTS_MAGIC_BIN_FROM_DATA((DEP))) + +static ERTS_INLINE erts_aint_t +de_refc_read(DistEntry *dep, erts_aint_t min) +{ + return erts_refc_read(&ErtsDistEntry2Bin(dep)->intern.refc, min); +} + +static ERTS_INLINE erts_aint_t +de_refc_inc_read(DistEntry *dep, erts_aint_t min) +{ + return erts_refc_inctest(&ErtsDistEntry2Bin(dep)->intern.refc, min); +} + +static ERTS_INLINE void +de_refc_inc(DistEntry *dep, erts_aint_t min) +{ + erts_refc_inc(&ErtsDistEntry2Bin(dep)->intern.refc, min); +} + +static ERTS_INLINE void +de_refc_dec(DistEntry *dep, erts_aint_t min) +{ +#ifdef DEBUG + (void) erts_refc_read(&ErtsDistEntry2Bin(dep)->intern.refc, min+1); +#endif + erts_bin_release(ErtsDistEntry2Bin(dep)); +} + +static ERTS_INLINE erts_aint_t +de_refc_dec_read(DistEntry *dep, erts_aint_t min) +{ + return erts_refc_dectest(&ErtsDistEntry2Bin(dep)->intern.refc, min); +} + +void +erts_ref_dist_entry(DistEntry *dep) +{ + ASSERT(dep); + de_refc_inc(dep, 1); +} + +void +erts_deref_dist_entry(DistEntry *dep) +{ + ASSERT(dep); + de_refc_dec(dep, 0); +} + #ifdef DEBUG static int is_in_de_list(DistEntry *dep, DistEntry *dep_list) @@ -85,22 +139,39 @@ dist_table_cmp(void *dep1, void *dep2) static void* dist_table_alloc(void *dep_tmpl) { +#ifdef DEBUG + erts_aint_t refc; +#endif Eterm sysname; + Binary *bin; DistEntry *dep; erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER; rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ; sysname = ((DistEntry *) dep_tmpl)->sysname; - dep = (DistEntry *) erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry)); + + bin = erts_create_magic_binary_x(sizeof(DistEntry), + erts_dist_entry_destructor, + ERTS_ALC_T_DIST_ENTRY, + 0); + dep = ErtsBin2DistEntry(bin); dist_entries++; +#ifdef DEBUG + refc = +#else + (void) +#endif + de_refc_dec_read(dep, -1); + ASSERT(refc == -1); + dep->prev = NULL; - erts_refc_init(&dep->refc, -1); erts_rwmtx_init_opt(&dep->rwmtx, &rwmtx_opt, "dist_entry", sysname, ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION); dep->sysname = sysname; dep->cid = NIL; + erts_atomic_init_nob(&dep->input_handler, (erts_aint_t) NIL); dep->connection_id = 0; dep->status = 0; dep->flags = 0; @@ -114,12 +185,16 @@ dist_table_alloc(void *dep_tmpl) erts_mtx_init(&dep->qlock, "dist_entry_out_queue", sysname, ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION); - dep->qflgs = 0; - dep->qsize = 0; + erts_atomic32_init_nob(&dep->qflgs, 0); + erts_atomic_init_nob(&dep->qsize, 0); + erts_atomic64_init_nob(&dep->in, 0); + erts_atomic64_init_nob(&dep->out, 0); dep->out_queue.first = NULL; dep->out_queue.last = NULL; dep->suspended = NULL; + dep->tmp_out_queue.first = NULL; + dep->tmp_out_queue.last = NULL; dep->finalized_out_queue.first = NULL; dep->finalized_out_queue.last = NULL; @@ -181,7 +256,7 @@ dist_table_free(void *vdep) #ifdef DEBUG sys_memset(vdep, 0x77, sizeof(DistEntry)); #endif - erts_free(ERTS_ALC_T_DIST_ENTRY, (void *) dep); + erts_bin_free(ErtsDistEntry2Bin(dep)); ASSERT(dist_entries > 0); dist_entries--; @@ -199,19 +274,52 @@ erts_dist_table_info(fmtfn_t to, void *to_arg) erts_rwmtx_runlock(&erts_dist_table_rwmtx); } +static ERTS_INLINE DistEntry *find_dist_entry(Eterm sysname, + int inc_refc, + int connected_only) +{ + DistEntry *res; + DistEntry de; + de.sysname = sysname; + erts_rwmtx_rlock(&erts_dist_table_rwmtx); + res = hash_get(&erts_dist_table, (void *) &de); + if (res) { + if (connected_only && is_nil(res->cid)) + res = NULL; + else { + int pend_delete; + erts_aint_t refc; + if (inc_refc) { + refc = de_refc_inc_read(res, 1); + pend_delete = refc < 2; + } + else { + refc = de_refc_read(res, 0); + pend_delete = refc < 1; + } + if (pend_delete) /* Pending delete */ + de_refc_inc(res, 1); + } + } + erts_rwmtx_runlock(&erts_dist_table_rwmtx); + return res; +} + DistEntry * erts_channel_no_to_dist_entry(Uint cno) { + /* + * Does NOT increase reference count! + */ + /* * For this node (and previous incarnations of this node), * ERST_INTERNAL_CHANNEL_NO (will always be 0 I guess) is used as * channel no. For other nodes, the atom index of the atom corresponding * to the node name is used as channel no. */ - if(cno == ERST_INTERNAL_CHANNEL_NO) { - erts_refc_inc(&erts_this_dist_entry->refc, 2); + if (cno == ERST_INTERNAL_CHANNEL_NO) return erts_this_dist_entry; - } if((cno > MAX_ATOM_INDEX) || (cno >= atom_table_size()) @@ -220,80 +328,97 @@ erts_channel_no_to_dist_entry(Uint cno) /* cno is a valid atom index; find corresponding dist entry (if there is one) */ - return erts_find_dist_entry(make_atom(cno)); + return find_dist_entry(make_atom(cno), 0, 0); } - DistEntry * erts_sysname_to_connected_dist_entry(Eterm sysname) { - DistEntry de; - DistEntry *res_dep; - de.sysname = sysname; - - if(erts_this_dist_entry->sysname == sysname) { - erts_refc_inc(&erts_this_dist_entry->refc, 2); + /* + * Does NOT increase reference count! + */ + if(erts_this_dist_entry->sysname == sysname) return erts_this_dist_entry; - } - - erts_rwmtx_rlock(&erts_dist_table_rwmtx); - res_dep = (DistEntry *) hash_get(&erts_dist_table, (void *) &de); - if (res_dep) { - erts_aint_t refc = erts_refc_inctest(&res_dep->refc, 1); - if (refc < 2) /* Pending delete */ - erts_refc_inc(&res_dep->refc, 1); - } - erts_rwmtx_runlock(&erts_dist_table_rwmtx); - if (res_dep) { - int deref; - erts_rwmtx_rlock(&res_dep->rwmtx); - deref = is_nil(res_dep->cid); - erts_rwmtx_runlock(&res_dep->rwmtx); - if (deref) { - erts_deref_dist_entry(res_dep); - res_dep = NULL; - } - } - return res_dep; + return find_dist_entry(sysname, 0, 1); } DistEntry *erts_find_or_insert_dist_entry(Eterm sysname) { + /* + * This function DOES increase reference count! + */ DistEntry *res; DistEntry de; erts_aint_t refc; - res = erts_find_dist_entry(sysname); + res = find_dist_entry(sysname, 1, 0); if (res) return res; de.sysname = sysname; erts_rwmtx_rwlock(&erts_dist_table_rwmtx); res = hash_put(&erts_dist_table, (void *) &de); - refc = erts_refc_inctest(&res->refc, 0); + refc = de_refc_inc_read(res, 0); if (refc < 2) /* New or pending delete */ - erts_refc_inc(&res->refc, 1); + de_refc_inc(res, 1); erts_rwmtx_rwunlock(&erts_dist_table_rwmtx); return res; } DistEntry *erts_find_dist_entry(Eterm sysname) { - DistEntry *res; - DistEntry de; - de.sysname = sysname; - erts_rwmtx_rlock(&erts_dist_table_rwmtx); - res = hash_get(&erts_dist_table, (void *) &de); - if (res) { - erts_aint_t refc = erts_refc_inctest(&res->refc, 1); - if (refc < 2) /* Pending delete */ - erts_refc_inc(&res->refc, 1); - } - erts_rwmtx_runlock(&erts_dist_table_rwmtx); - return res; + /* + * Does NOT increase reference count! + */ + return find_dist_entry(sysname, 0, 0); } -static void try_delete_dist_entry(void *vdep) +DistEntry * +erts_dhandle_to_dist_entry(Eterm dhandle) { - DistEntry *dep = (DistEntry *) vdep; + Binary *bin; + if (!is_internal_magic_ref(dhandle)) + return NULL; + bin = erts_magic_ref2bin(dhandle); + if (ERTS_MAGIC_BIN_DESTRUCTOR(bin) != erts_dist_entry_destructor) + return NULL; + return ErtsBin2DistEntry(bin); +} + +Eterm +erts_make_dhandle(Process *c_p, DistEntry *dep) +{ + Binary *bin; + Eterm *hp; + + bin = ErtsDistEntry2Bin(dep); + ASSERT(bin); + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dist_entry_destructor); + hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); + return erts_mk_magic_ref(&hp, &c_p->off_heap, bin); +} + +static void try_delete_dist_entry(void *vbin); + +static void +prepare_try_delete_dist_entry(void *vbin) +{ + Binary *bin = (Binary *) vbin; + DistEntry *dep = ErtsBin2DistEntry(bin); + Uint size; + erts_aint_t refc; + + refc = de_refc_read(dep, 0); + if (refc > 0) + return; + + size = ERTS_MAGIC_BIN_SIZE(sizeof(DistEntry)); + erts_schedule_thr_prgr_later_cleanup_op(try_delete_dist_entry, + vbin, &dep->later_op, size); +} + +static void try_delete_dist_entry(void *vbin) +{ + Binary *bin = (Binary *) vbin; + DistEntry *dep = ErtsBin2DistEntry(bin); erts_aint_t refc; erts_rwmtx_rwlock(&erts_dist_table_rwmtx); @@ -312,26 +437,39 @@ static void try_delete_dist_entry(void *vdep) * * If refc > 0, the entry is in use. Keep the entry. */ - refc = erts_refc_dectest(&dep->refc, -1); + refc = de_refc_dec_read(dep, -1); if (refc == -1) (void) hash_erase(&erts_dist_table, (void *) dep); erts_rwmtx_rwunlock(&erts_dist_table_rwmtx); - if (refc == 0) - erts_schedule_delete_dist_entry(dep); + if (refc == 0) { + if (node_tab_delete_delay == 0) + prepare_try_delete_dist_entry(vbin); + else if (node_tab_delete_delay > 0) + erts_start_timer_callback(node_tab_delete_delay, + prepare_try_delete_dist_entry, + vbin); + } } -void erts_schedule_delete_dist_entry(DistEntry *dep) +int erts_dist_entry_destructor(Binary *bin) { - ASSERT(dep != erts_this_dist_entry); - if (dep != erts_this_dist_entry) { - if (node_tab_delete_delay == 0) - try_delete_dist_entry((void *) dep); - else if (node_tab_delete_delay > 0) - erts_start_timer_callback(node_tab_delete_delay, - try_delete_dist_entry, - (void *) dep); - } + DistEntry *dep = ErtsBin2DistEntry(bin); + erts_aint_t refc; + + refc = de_refc_read(dep, -1); + + if (refc == -1) + return 1; /* Allow deallocation of structure... */ + + if (node_tab_delete_delay == 0) + prepare_try_delete_dist_entry((void *) bin); + else if (node_tab_delete_delay > 0) + erts_start_timer_callback(node_tab_delete_delay, + prepare_try_delete_dist_entry, + (void *) bin); + + return 0; } Uint @@ -384,7 +522,7 @@ erts_set_dist_entry_not_connected(DistEntry *dep) erts_rwmtx_rwlock(&erts_dist_table_rwmtx); ASSERT(dep != erts_this_dist_entry); - ASSERT(is_internal_port(dep->cid)); + ASSERT(is_internal_port(dep->cid) || is_internal_pid(dep->cid)); if(dep->flags & DFLAG_PUBLISHED) { if(dep->prev) { @@ -439,7 +577,7 @@ erts_set_dist_entry_connected(DistEntry *dep, Eterm cid, Uint flags) ASSERT(dep != erts_this_dist_entry); ASSERT(is_nil(dep->cid)); - ASSERT(is_internal_port(cid)); + ASSERT(is_internal_port(cid) || is_internal_pid(cid)); if(dep->prev) { ASSERT(is_in_de_list(dep, erts_not_connected_dist_entries)); @@ -459,10 +597,19 @@ erts_set_dist_entry_connected(DistEntry *dep, Eterm cid, Uint flags) dep->status |= ERTS_DE_SFLG_CONNECTED; dep->flags = flags; dep->cid = cid; + erts_atomic_set_nob(&dep->input_handler, + (erts_aint_t) cid); + dep->connection_id++; dep->connection_id &= ERTS_DIST_EXT_CON_ID_MASK; dep->prev = NULL; + erts_atomic64_set_nob(&dep->in, 0); + erts_atomic64_set_nob(&dep->out, 0); + erts_atomic32_set_nob(&dep->qflgs, + (is_internal_port(cid) + ? ERTS_DE_QFLG_PORT_CTRL + : ERTS_DE_QFLG_PROC_CTRL)); if(flags & DFLAG_PUBLISHED) { dep->next = erts_visible_dist_entries; if(erts_visible_dist_entries) { @@ -716,19 +863,18 @@ void erts_set_this_node(Eterm sysname, Uint creation) { ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); - ASSERT(erts_refc_read(&erts_this_dist_entry->refc, 2)); + ASSERT(2 <= de_refc_read(erts_this_dist_entry, 2)); if (erts_refc_dectest(&erts_this_node->refc, 0) == 0) try_delete_node(erts_this_node); - if (erts_refc_dectest(&erts_this_dist_entry->refc, 0) == 0) - try_delete_dist_entry(erts_this_dist_entry); + erts_deref_dist_entry(erts_this_dist_entry); erts_this_node = NULL; /* to make sure refc is bumped for this node */ erts_this_node = erts_find_or_insert_node(sysname, creation); erts_this_dist_entry = erts_this_node->dist_entry; - erts_refc_inc(&erts_this_dist_entry->refc, 2); + erts_ref_dist_entry(erts_this_dist_entry); erts_this_node_sysname = erts_this_node_sysname_BUFFER; erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER), @@ -797,9 +943,9 @@ void erts_init_node_tables(int dd_sec) ASSERT(erts_this_node->dist_entry != NULL); erts_this_dist_entry = erts_this_node->dist_entry; /* +1 for erts_this_dist_entry */ - /* +1 for erts_this_node->dist_entry */ - erts_refc_init(&erts_this_dist_entry->refc, 2); + erts_ref_dist_entry(erts_this_dist_entry); + ASSERT(2 == de_refc_read(erts_this_dist_entry, 2)); erts_this_node_sysname = erts_this_node_sysname_BUFFER; erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER), @@ -876,6 +1022,7 @@ static Eterm AM_node_references; static Eterm AM_system; static Eterm AM_timer; static Eterm AM_delayed_delete_timer; +static Eterm AM_thread_progress_delete_timer; static void setup_reference_table(void); static Eterm reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp); @@ -965,6 +1112,7 @@ erts_get_node_and_dist_references(struct process *proc) INIT_AM(timer); INIT_AM(system); INIT_AM(delayed_delete_timer); + INIT_AM(thread_progress_delete_timer); references_atoms_need_init = 0; } @@ -1148,6 +1296,10 @@ insert_offheap2(ErlOffHeap *oh, void *arg) insert_offheap(oh, a->type, a->id); } +#define ErtsIsDistEntryBinary(Bin) \ + (((Bin)->intern.flags & BIN_FLAG_MAGIC) \ + && ERTS_MAGIC_BIN_DESTRUCTOR((Bin)) == erts_dist_entry_destructor) + static void insert_offheap(ErlOffHeap *oh, int type, Eterm id) { @@ -1158,7 +1310,10 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) for (u.hdr = oh->first; u.hdr; u.hdr = u.hdr->next) { switch (thing_subtag(u.hdr->thing_word)) { case REF_SUBTAG: - if(IsMatchProgBinary(u.mref->mb)) { + if (ErtsIsDistEntryBinary(u.mref->mb)) + insert_dist_entry(ErtsBin2DistEntry(u.mref->mb), + type, id, 0); + else if(IsMatchProgBinary(u.mref->mb)) { InsertedBin *ib; int insert_bin = 1; for (ib = inserted_bins; ib; ib = ib->next) @@ -1301,26 +1456,34 @@ insert_delayed_delete_node(void *state, ErtsMonotonicTime timeout_pos, void *vnp) { - DeclareTmpHeapNoproc(heap,3); - UseTmpHeapNoproc(3); + Eterm heap[3]; insert_node((ErlNode *) vnp, SYSTEM_REF, TUPLE2(&heap[0], AM_system, AM_delayed_delete_timer)); - UnUseTmpHeapNoproc(3); +} + +static void +insert_thr_prgr_delete_dist_entry(void *arg, ErtsThrPrgrVal thr_prgr, void *vbin) +{ + DistEntry *dep = ErtsBin2DistEntry(vbin); + Eterm heap[3]; + insert_dist_entry(dep, + SYSTEM_REF, + TUPLE2(&heap[0], AM_system, AM_thread_progress_delete_timer), + 0); } static void insert_delayed_delete_dist_entry(void *state, ErtsMonotonicTime timeout_pos, - void *vdep) + void *vbin) { - DeclareTmpHeapNoproc(heap,3); - UseTmpHeapNoproc(3); - insert_dist_entry((DistEntry *) vdep, + DistEntry *dep = ErtsBin2DistEntry(vbin); + Eterm heap[3]; + insert_dist_entry(dep, SYSTEM_REF, TUPLE2(&heap[0], AM_system, AM_delayed_delete_timer), 0); - UnUseTmpHeapNoproc(3); } static void @@ -1354,9 +1517,12 @@ setup_reference_table(void) erts_debug_callback_timer_foreach(try_delete_node, insert_delayed_delete_node, NULL); - erts_debug_callback_timer_foreach(try_delete_dist_entry, + erts_debug_callback_timer_foreach(prepare_try_delete_dist_entry, insert_delayed_delete_dist_entry, NULL); + erts_debug_later_op_foreach(try_delete_dist_entry, + insert_thr_prgr_delete_dist_entry, + NULL); UseTmpHeapNoproc(3); insert_node(erts_this_node, @@ -1421,6 +1587,14 @@ setup_reference_table(void) insert_links(ERTS_P_LINKS(proc), proc->common.id); if (ERTS_P_MONITORS(proc)) insert_monitors(ERTS_P_MONITORS(proc), proc->common.id); + { + DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(proc); + if (dep) + insert_dist_entry(dep, + CTRL_REF, + proc->common.id, + 0); + } } } @@ -1719,7 +1893,7 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp) /* DistList = [{Dist, Refc, ReferenceIdList}] */ tup = MK_3TUP(referred_dists[i].dist->sysname, - MK_UINT(erts_refc_read(&referred_dists[i].dist->refc, 0)), + MK_UINT(de_refc_read(referred_dists[i].dist, 0)), dril); dl = MK_CONS(tup, dl); } diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index 7974b25444..3bba673435 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -47,6 +47,9 @@ #define ERTS_PORT_TASK_ONLY_BASIC_TYPES__ #include "erl_port_task.h" #undef ERTS_PORT_TASK_ONLY_BASIC_TYPES__ +#define ERTS_BINARY_TYPES_ONLY__ +#include "erl_binary.h" +#undef ERTS_BINARY_TYPES_ONLY__ #define ERTS_NODE_TAB_DELAY_GC_DEFAULT (60) #define ERTS_NODE_TAB_DELAY_GC_MAX (100*1000*1000) @@ -60,11 +63,17 @@ #define ERTS_DE_SFLGS_ALL (ERTS_DE_SFLG_CONNECTED \ | ERTS_DE_SFLG_EXITING) -#define ERTS_DE_QFLG_BUSY (((Uint32) 1) << 0) -#define ERTS_DE_QFLG_EXIT (((Uint32) 1) << 1) +#define ERTS_DE_QFLG_BUSY (((erts_aint32_t) 1) << 0) +#define ERTS_DE_QFLG_EXIT (((erts_aint32_t) 1) << 1) +#define ERTS_DE_QFLG_REQ_INFO (((erts_aint32_t) 1) << 2) +#define ERTS_DE_QFLG_PORT_CTRL (((erts_aint32_t) 1) << 3) +#define ERTS_DE_QFLG_PROC_CTRL (((erts_aint32_t) 1) << 4) #define ERTS_DE_QFLGS_ALL (ERTS_DE_QFLG_BUSY \ - | ERTS_DE_QFLG_EXIT) + | ERTS_DE_QFLG_EXIT \ + | ERTS_DE_QFLG_REQ_INFO \ + | ERTS_DE_QFLG_PORT_CTRL \ + | ERTS_DE_QFLG_PROC_CTRL) #if defined(ARCH_64) #define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713f713f713UL) @@ -106,12 +115,13 @@ typedef struct dist_entry_ { HashBucket hash_bucket; /* Hash bucket */ struct dist_entry_ *next; /* Next entry in dist_table (not sorted) */ struct dist_entry_ *prev; /* Previous entry in dist_table (not sorted) */ - erts_refc_t refc; /* Reference count */ - erts_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */ + erts_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */ Eterm sysname; /* name@host atom for efficiency */ Uint32 creation; /* creation of connected node */ - Eterm cid; /* connection handler (pid or port), NIL == free */ + erts_atomic_t input_handler; /* Input handler */ + Eterm cid; /* connection handler (pid or port), + NIL == free */ Uint32 connection_id; /* Connection id incremented on connect */ Uint32 status; /* Slot status, like exiting reserved etc */ Uint32 flags; /* Distribution flags, like hidden, @@ -119,7 +129,7 @@ typedef struct dist_entry_ { unsigned long version; /* Protocol version */ - erts_mtx_t lnk_mtx; /* Protects node_links, nlinks, and + erts_mtx_t lnk_mtx; /* Protects node_links, nlinks, and monitors. */ ErtsLink *node_links; /* In a dist entry, node links are kept in a separate tree, while they are @@ -131,12 +141,15 @@ typedef struct dist_entry_ { ErtsLink *nlinks; /* Link tree with subtrees */ ErtsMonitor *monitors; /* Monitor tree */ - erts_mtx_t qlock; /* Protects qflgs and out_queue */ - Uint32 qflgs; - Sint qsize; + erts_mtx_t qlock; /* Protects qflgs and out_queue */ + erts_atomic32_t qflgs; + erts_atomic_t qsize; + erts_atomic64_t in; + erts_atomic64_t out; ErtsDistOutputQueue out_queue; struct ErtsProcList_ *suspended; + ErtsDistOutputQueue tmp_out_queue; ErtsDistOutputQueue finalized_out_queue; erts_atomic_t dist_cmd_scheduled; ErtsPortTaskHandle dist_cmd; @@ -144,6 +157,8 @@ typedef struct dist_entry_ { Uint (*send)(Port *prt, ErtsDistOutputBuf *obuf); struct cache* cache; /* The atom cache */ + + ErtsThrPrgrLaterOp later_op; } DistEntry; typedef struct erl_node_ { @@ -193,12 +208,12 @@ Eterm erts_get_node_and_dist_references(struct process *); int erts_lc_is_de_rwlocked(DistEntry *); int erts_lc_is_de_rlocked(DistEntry *); #endif +int erts_dist_entry_destructor(Binary *bin); +DistEntry *erts_dhandle_to_dist_entry(Eterm dhandle); +Eterm erts_make_dhandle(Process *c_p, DistEntry *dep); +void erts_ref_dist_entry(DistEntry *dep); +void erts_deref_dist_entry(DistEntry *dep); -#ifdef ERTS_ENABLE_LOCK_COUNT -void erts_lcnt_update_distribution_locks(int enable); -#endif - -ERTS_GLB_INLINE void erts_deref_dist_entry(DistEntry *dep); ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np); ERTS_GLB_INLINE void erts_de_rlock(DistEntry *dep); ERTS_GLB_INLINE void erts_de_runlock(DistEntry *dep); @@ -210,14 +225,6 @@ ERTS_GLB_INLINE void erts_de_links_unlock(DistEntry *dep); #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void -erts_deref_dist_entry(DistEntry *dep) -{ - ASSERT(dep); - if (erts_refc_dectest(&dep->refc, 0) == 0) - erts_schedule_delete_dist_entry(dep); -} - -ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np) { ASSERT(np); diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index 98e9b9ccaf..9117eb1f72 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -31,6 +31,9 @@ typedef struct ErtsProc2PortSigData_ ErtsProc2PortSigData; #include "erl_ptab.h" #include "erl_thr_progress.h" #include "erl_trace.h" +#define ERTS_IO_QUEUE_TYPES_ONLY__ +#include "erl_io_queue.h" +#undef ERTS_IO_QUEUE_TYPES_ONLY__ #ifndef __WIN32__ #define ERTS_DEFAULT_MAX_PORTS (1 << 16) @@ -75,23 +78,8 @@ typedef struct erts_driver_t_ erts_driver_t; #define ERTS_Port2ErlDrvPort(PH) ((ErlDrvPort) (PH)) #endif -#define SMALL_IO_QUEUE 5 /* Number of fixed elements */ +typedef ErtsIOQueue ErlPortIOQueue; -typedef struct { - ErlDrvSizeT size; /* total size in bytes */ - - SysIOVec* v_start; - SysIOVec* v_end; - SysIOVec* v_head; - SysIOVec* v_tail; - SysIOVec v_small[SMALL_IO_QUEUE]; - - ErlDrvBinary** b_start; - ErlDrvBinary** b_end; - ErlDrvBinary** b_head; - ErlDrvBinary** b_tail; - ErlDrvBinary* b_small[SMALL_IO_QUEUE]; -} ErlIOQueue; typedef struct line_buf { /* Buffer used in line oriented I/O */ ErlDrvSizeT bufsiz; /* Size of character buffer */ @@ -165,7 +153,7 @@ struct _erl_drv_port { Uint bytes_in; /* Number of bytes read */ Uint bytes_out; /* Number of bytes written */ - ErlIOQueue ioq; /* driver accessible i/o queue */ + ErlPortIOQueue ioq; /* driver accessible i/o queue */ DistEntry *dist_entry; /* Dist entry used in DISTRIBUTION */ char *name; /* String used in the open */ erts_driver_t* drv_ptr; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 88b2bda59c..ab5030e5b9 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -776,6 +776,11 @@ erts_pre_init_process(void) = ERTS_PSD_ETS_FIXED_TABLES_GET_LOCKS; erts_psd_required_locks[ERTS_PSD_ETS_FIXED_TABLES].set_locks = ERTS_PSD_ETS_FIXED_TABLES_SET_LOCKS; + + erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].get_locks + = ERTS_PSD_DIST_ENTRY_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].set_locks + = ERTS_PSD_DIST_ENTRY_SET_LOCKS; #endif } @@ -11403,9 +11408,11 @@ flush_dirty_trace_messages(void *vpid) erts_free(ERTS_ALC_T_DIRTY_SL, vpid); #endif - proc = erts_proc_lookup(pid); - if (proc) - (void) erts_flush_trace_messages(proc, 0); + proc = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_MAIN, 0); + if (proc) { + (void) erts_flush_trace_messages(proc, ERTS_PROC_LOCK_MAIN); + erts_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + } } #endif /* ERTS_DIRTY_SCHEDULERS */ @@ -13080,7 +13087,6 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) } erts_destroy_monitor(rmon); } - erts_deref_dist_entry(dep); } } else { ASSERT(is_pid(mon->u.pid) || is_port(mon->u.pid)); @@ -13320,7 +13326,6 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext) erts_de_links_unlock(dep); if (rlnk) erts_destroy_link(rlnk); - erts_deref_dist_entry(dep); } break; @@ -13428,7 +13433,7 @@ erts_continue_exit_process(Process *p) ErtsMonitor *mon; ErtsProcLocks curr_locks = ERTS_PROC_LOCK_MAIN; Eterm reason = p->fvalue; - DistEntry *dep; + DistEntry *dep = NULL; erts_aint32_t state; int delay_del_proc = 0; @@ -13629,13 +13634,16 @@ erts_continue_exit_process(Process *p) if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ)) erts_proc_dec_refc(p); } - - dep = (p->flags & F_DISTRIBUTION) ? erts_this_dist_entry : NULL; + + dep = ((p->flags & F_DISTRIBUTION) + ? ERTS_PROC_SET_DIST_ENTRY(p, NULL) + : NULL); erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL); if (dep) { - erts_do_net_exits(dep, reason); + erts_do_net_exits(dep, (reason == am_kill) ? am_killed : reason); + erts_deref_dist_entry(dep); } /* @@ -13667,16 +13675,16 @@ erts_continue_exit_process(Process *p) have none here */ } - erts_flush_trace_messages(p, 0); + erts_proc_lock(p, ERTS_PROC_LOCK_MAIN); + ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + + erts_flush_trace_messages(p, ERTS_PROC_LOCK_MAIN); ERTS_TRACER_CLEAR(&ERTS_TRACER(p)); if (!delay_del_proc) delete_process(p); - erts_proc_lock(p, ERTS_PROC_LOCK_MAIN); - ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); - return; yield: @@ -14043,3 +14051,24 @@ erts_dbg_check_halloc_lock(Process *p) return 0; } #endif + +void +erts_debug_later_op_foreach(void (*callback)(void*), + void (*func)(void *, ErtsThrPrgrVal, void *), + void *arg) +{ + int six; + if (!erts_thr_progress_is_blocking()) + ERTS_INTERNAL_ERROR("Not blocking thread progress"); + + for (six = 0; six < erts_no_schedulers; six++) { + ErtsSchedulerData *esdp = &erts_aligned_scheduler_data[six].esd; + ErtsThrPrgrLaterOp *lop = esdp->aux_work_data.later_op.first; + + while (lop) { + if (lop->func == callback) + func(arg, lop->later, lop->data); + lop = lop->next; + } + } +} diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 7ca37882c2..150f22556c 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -697,6 +697,11 @@ extern ErtsAlignedSchedulerData *erts_aligned_dirty_io_scheduler_data; int erts_lc_runq_is_locked(ErtsRunQueue *); #endif +void +erts_debug_later_op_foreach(void (*callback)(void*), + void (*func)(void *, ErtsThrPrgrVal, void *), + void *arg); + #ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS void erts_empty_runq(ErtsRunQueue *rq); @@ -803,14 +808,15 @@ erts_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_NIF_TRAP_EXPORT 5 #define ERTS_PSD_ETS_OWNED_TABLES 6 #define ERTS_PSD_ETS_FIXED_TABLES 7 -#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 8 +#define ERTS_PSD_DIST_ENTRY 8 +#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 9 /* keep last... */ -#define ERTS_PSD_SIZE 9 +#define ERTS_PSD_SIZE 10 #if !defined(HIPE) # undef ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF # undef ERTS_PSD_SIZE -# define ERTS_PSD_SIZE 8 +# define ERTS_PSD_SIZE 9 #endif typedef struct { @@ -844,6 +850,9 @@ typedef struct { #define ERTS_PSD_ETS_FIXED_TABLES_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_ETS_FIXED_TABLES_SET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_DIST_ENTRY_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_DIST_ENTRY_SET_LOCKS ERTS_PROC_LOCK_MAIN + typedef struct { ErtsProcLocks get_locks; ErtsProcLocks set_locks; @@ -2041,6 +2050,11 @@ erts_psd_set(Process *p, int ix, void *data) #define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, NTE) \ erts_psd_set((P), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) +#define ERTS_PROC_GET_DIST_ENTRY(P) \ + ((DistEntry *) erts_psd_get((P), ERTS_PSD_DIST_ENTRY)) +#define ERTS_PROC_SET_DIST_ENTRY(P, DE) \ + ((DistEntry *) erts_psd_set((P), ERTS_PSD_DIST_ENTRY, (void *) (DE))) + #ifdef HIPE #define ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(P) \ ((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF)) diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index ccc5526664..27164d50a0 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -130,6 +130,13 @@ Eterm erts_get_monotonic_end_time(struct process *c_p); Eterm erts_monotonic_time_source(struct process*c_p); Eterm erts_system_time_source(struct process*c_p); +void erts_runtime_elapsed_both(ErtsMonotonicTime *ms_user, + ErtsMonotonicTime *ms_sys, + ErtsMonotonicTime *ms_user_diff, + ErtsMonotonicTime *ms_sys_diff); +void erts_wall_clock_elapsed_both(ErtsMonotonicTime *total, + ErtsMonotonicTime *diff); + #ifdef SYS_CLOCK_RESOLUTION #define ERTS_CLKTCK_RESOLUTION ((ErtsMonotonicTime) (SYS_CLOCK_RESOLUTION*1000)) #else diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index c06b464458..f2e0900fec 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -36,12 +36,29 @@ #include "erl_driver.h" #include "erl_nif.h" -static erts_mtx_t erts_timeofday_mtx; static erts_mtx_t erts_get_time_mtx; -static SysTimes t_start; /* Used in elapsed_time_both */ -static ErtsMonotonicTime prev_wall_clock_elapsed; /* Used in wall_clock_elapsed_time_both */ -static ErtsMonotonicTime previous_now; /* Used in get_now */ + /* used by erts_runtime_elapsed_both */ +typedef struct { + erts_mtx_t mtx; + ErtsMonotonicTime user; + ErtsMonotonicTime sys; +} ErtsRunTimePrevData; + +static union { + ErtsRunTimePrevData data; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsRunTimePrevData))]; +} runtime_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE); + +static union { + erts_atomic64_t time; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_atomic64_t))]; +} wall_clock_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE); + +static union { + erts_atomic64_t time; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_atomic64_t))]; +} now_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE); static ErtsMonitor *time_offset_monitors = NULL; static Uint no_time_offset_monitors = 0; @@ -954,10 +971,12 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) ASSERT(ERTS_MONOTONIC_TIME_MIN < ERTS_MONOTONIC_TIME_MAX); - erts_mtx_init(&erts_timeofday_mtx, "timeofday", NIL, - ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC); erts_mtx_init(&erts_get_time_mtx, "get_time", NIL, ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC); + erts_mtx_init(&runtime_prev.data.mtx, "runtime", NIL, + ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC); + runtime_prev.data.user = 0; + runtime_prev.data.sys = 0; time_sup.r.o.correction = time_correction; time_sup.r.o.warp_mode = time_warp_mode; @@ -1157,9 +1176,13 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) time_sup.f.c.last_not_corrected_time = 0; } - prev_wall_clock_elapsed = 0; + erts_atomic64_init_nob(&wall_clock_prev.time, + (erts_aint64_t) 0); + + erts_atomic64_init_nob( + &now_prev.time, + (erts_aint64_t) ERTS_MONOTONIC_TO_USEC(get_time_offset())); - previous_now = ERTS_MONOTONIC_TO_USEC(get_time_offset()); #ifdef DEBUG time_sup_initialized = 1; @@ -1289,36 +1312,65 @@ erts_finalize_time_offset(void) /* info functions */ void -elapsed_time_both(ErtsMonotonicTime *ms_user, ErtsMonotonicTime *ms_sys, - ErtsMonotonicTime *ms_user_diff, ErtsMonotonicTime *ms_sys_diff) +erts_runtime_elapsed_both(ErtsMonotonicTime *ms_user, ErtsMonotonicTime *ms_sys, + ErtsMonotonicTime *ms_user_diff, ErtsMonotonicTime *ms_sys_diff) { - ErtsMonotonicTime prev_total_user, prev_total_sys; - ErtsMonotonicTime total_user, total_sys; + ErtsMonotonicTime prev_user, prev_sys, user, sys; + +#ifdef HAVE_GETRUSAGE + + struct rusage now; + + if (getrusage(RUSAGE_SELF, &now) != 0) { + erts_exit(ERTS_ABORT_EXIT, "getrusage(RUSAGE_SELF, _) failed: %d\n", errno); + return; + } + + user = (ErtsMonotonicTime) now.ru_utime.tv_sec; + user *= (ErtsMonotonicTime) 1000000; + user += (ErtsMonotonicTime) now.ru_utime.tv_usec; + user /= (ErtsMonotonicTime) 1000; + + sys = (ErtsMonotonicTime) now.ru_stime.tv_sec; + sys *= (ErtsMonotonicTime) 1000000; + sys += (ErtsMonotonicTime) now.ru_stime.tv_usec; + sys /= (ErtsMonotonicTime) 1000; + +#else + SysTimes now; sys_times(&now); - total_user = (ErtsMonotonicTime) ((now.tms_utime * 1000) / SYS_CLK_TCK); - total_sys = (ErtsMonotonicTime) ((now.tms_stime * 1000) / SYS_CLK_TCK); + user = (ErtsMonotonicTime) now.tms_utime; + user *= (ErtsMonotonicTime) 1000; + user /= (ErtsMonotonicTime) SYS_CLK_TCK; - if (ms_user != NULL) - *ms_user = total_user; - if (ms_sys != NULL) - *ms_sys = total_sys; + sys = (ErtsMonotonicTime) now.tms_stime; + sys *= (ErtsMonotonicTime) 1000; + sys /= (ErtsMonotonicTime) SYS_CLK_TCK; + +#endif + + if (ms_user) + *ms_user = user; + if (ms_sys) + *ms_sys = sys; if (ms_user_diff || ms_sys_diff) { - erts_mtx_lock(&erts_timeofday_mtx); - - prev_total_user = (ErtsMonotonicTime) ((t_start.tms_utime * 1000) / SYS_CLK_TCK); - prev_total_sys = (ErtsMonotonicTime) ((t_start.tms_stime * 1000) / SYS_CLK_TCK); - t_start = now; - - erts_mtx_unlock(&erts_timeofday_mtx); + + erts_mtx_lock(&runtime_prev.data.mtx); - if (ms_user_diff != NULL) - *ms_user_diff = total_user - prev_total_user; - - if (ms_sys_diff != NULL) - *ms_sys_diff = total_sys - prev_total_sys; + prev_user = runtime_prev.data.user; + prev_sys = runtime_prev.data.sys; + runtime_prev.data.user = user; + runtime_prev.data.sys = sys; + + erts_mtx_unlock(&runtime_prev.data.mtx); + + if (ms_user_diff) + *ms_user_diff = user - prev_user; + if (ms_sys_diff) + *ms_sys_diff = sys - prev_sys; } } @@ -1326,7 +1378,7 @@ elapsed_time_both(ErtsMonotonicTime *ms_user, ErtsMonotonicTime *ms_sys, /* wall clock routines */ void -wall_clock_elapsed_time_both(ErtsMonotonicTime *ms_total, ErtsMonotonicTime *ms_diff) +erts_wall_clock_elapsed_both(ErtsMonotonicTime *ms_total, ErtsMonotonicTime *ms_diff) { ErtsMonotonicTime now, elapsed; @@ -1334,16 +1386,18 @@ wall_clock_elapsed_time_both(ErtsMonotonicTime *ms_total, ErtsMonotonicTime *ms_ update_last_mtime(NULL, now); elapsed = ERTS_MONOTONIC_TO_MSEC(now); + elapsed -= ERTS_MONOTONIC_TO_MSEC(ERTS_MONOTONIC_BEGIN); *ms_total = elapsed; if (ms_diff) { - erts_mtx_lock(&erts_timeofday_mtx); + ErtsMonotonicTime prev; - *ms_diff = elapsed - prev_wall_clock_elapsed; - prev_wall_clock_elapsed = elapsed; + prev = ((ErtsMonotonicTime) + erts_atomic64_xchg_mb(&wall_clock_prev.time, + (erts_aint64_t) elapsed)); - erts_mtx_unlock(&erts_timeofday_mtx); + *ms_diff = elapsed - prev; } } @@ -1722,22 +1776,27 @@ univ_to_local(Sint *year, Sint *month, Sint *day, void get_now(Uint* megasec, Uint* sec, Uint* microsec) { - ErtsMonotonicTime now_megasec, now_sec, now, mtime, time_offset; + ErtsMonotonicTime now_megasec, now_sec, now, prev, mtime, time_offset; mtime = time_sup.r.o.get_time(); time_offset = get_time_offset(); update_last_mtime(NULL, mtime); now = ERTS_MONOTONIC_TO_USEC(mtime + time_offset); - erts_mtx_lock(&erts_timeofday_mtx); - /* Make sure now time is later than last time */ - if (now <= previous_now) - now = previous_now + 1; - - previous_now = now; - - erts_mtx_unlock(&erts_timeofday_mtx); + prev = erts_atomic64_read_nob(&now_prev.time); + while (1) { + ErtsMonotonicTime act; + if (now <= prev) + now = prev + 1; + act = ((ErtsMonotonicTime) + erts_atomic64_cmpxchg_mb(&now_prev.time, + (erts_aint64_t) now, + (erts_aint64_t) prev)); + if (act == prev) + break; + prev = act; + } now_megasec = now / ERTS_MONOTONIC_TIME_TERA; now_sec = now / ERTS_MONOTONIC_TIME_MEGA; diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 42082f9c3e..f2d0af64df 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -102,9 +102,11 @@ if ((ptr) == (endp)) { \ ; \ } else if (HEAP_START(p) <= (ptr) && (ptr) < HEAP_TOP(p)) { \ + ASSERT(HEAP_TOP(p) == (endp)); \ HEAP_TOP(p) = (ptr); \ } else { \ - erts_heap_frag_shrink(p, ptr); \ + ASSERT(MBUF(p)->mem + MBUF(p)->used_size == (endp)); \ + erts_heap_frag_shrink(p, ptr); \ } #define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p)) diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 0874be7250..1c2f8f9843 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -616,7 +616,7 @@ erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize) sys_memcpy((void *) ep, (void *) edep, dist_ext_sz); ep += dist_ext_sz; if (new_edep->dep) - erts_refc_inc(&new_edep->dep->refc, 1); + erts_ref_dist_entry(new_edep->dep); new_edep->extp = ep; new_edep->ext_endp = ep + ext_sz; new_edep->heap_size = -1; @@ -629,7 +629,8 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, byte *ext, Uint size, DistEntry *dep, - ErtsAtomCache *cache) + ErtsAtomCache *cache, + Uint32 *connection_id) { #undef ERTS_EXT_FAIL #undef ERTS_EXT_HDR_FAIL @@ -650,33 +651,36 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, if (size < 2) ERTS_EXT_FAIL; + if (!dep) + ERTS_INTERNAL_ERROR("Invalid use"); + if (ep[0] != VERSION_MAGIC) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - if (dep) - erts_dsprintf(dsbufp, - "** Got message from incompatible erlang on " - "channel %d\n", - dist_entry_channel_no(dep)); - else - erts_dsprintf(dsbufp, - "** Attempt to convert old incompatible " - "binary %d\n", - *ep); + erts_dsprintf(dsbufp, + "** Got message from incompatible erlang on " + "channel %d\n", + dist_entry_channel_no(dep)); erts_send_error_to_logger_nogl(dsbufp); ERTS_EXT_FAIL; } edep->flags = 0; edep->dep = dep; - if (dep) { - erts_de_rlock(dep); - if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE) - edep->flags |= ERTS_DIST_EXT_DFLAG_HDR; - - edep->flags |= (dep->connection_id & ERTS_DIST_EXT_CON_ID_MASK); - erts_de_runlock(dep); + + erts_de_rlock(dep); + + if ((dep->status & (ERTS_DE_SFLG_EXITING|ERTS_DE_SFLG_CONNECTED)) + != ERTS_DE_SFLG_CONNECTED) { + erts_de_runlock(dep); + return ERTS_PREP_DIST_EXT_CLOSED; } + if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE) + edep->flags |= ERTS_DIST_EXT_DFLAG_HDR; + + *connection_id = dep->connection_id; + edep->flags |= (dep->connection_id & ERTS_DIST_EXT_CON_ID_MASK); + if (ep[1] != DIST_HEADER) { if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) ERTS_EXT_HDR_FAIL; @@ -835,14 +839,15 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, ERTS_EXT_FAIL; #endif - return 0; + erts_de_runlock(dep); + + return ERTS_PREP_DIST_EXT_SUCCESS; #undef CHKSIZE #undef ERTS_EXT_FAIL #undef ERTS_EXT_HDR_FAIL - bad_hdr: - if (dep) { + bad_hdr: { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "%T got a corrupted distribution header from %T " @@ -855,10 +860,11 @@ erts_prepare_dist_ext(ErtsDistExternal *edep, erts_dsprintf(dsbufp, ">>"); erts_send_warning_to_logger_nogl(dsbufp); } - fail: - if (dep) - erts_kill_dist_connection(dep, dep->connection_id); - return -1; + fail: { + erts_de_runlock(dep); + erts_kill_dist_connection(dep, *connection_id); + } + return ERTS_PREP_DIST_EXT_FAILED; } static void diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index f00426cc16..3c61d013da 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -185,8 +185,13 @@ ERTS_GLB_INLINE void *erts_dist_ext_trailer(ErtsDistExternal *); ErtsDistExternal *erts_make_dist_ext_copy(ErtsDistExternal *, Uint); void *erts_dist_ext_trailer(ErtsDistExternal *); void erts_destroy_dist_ext_copy(ErtsDistExternal *); + +#define ERTS_PREP_DIST_EXT_FAILED (-1) +#define ERTS_PREP_DIST_EXT_SUCCESS (0) +#define ERTS_PREP_DIST_EXT_CLOSED (1) + int erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint, - DistEntry *, ErtsAtomCache *); + DistEntry *, ErtsAtomCache *, Uint32 *); Sint erts_decode_dist_ext_size(ErtsDistExternal *); Eterm erts_decode_dist_ext(ErtsHeapFactory* factory, ErtsDistExternal *); diff --git a/erts/emulator/beam/float_instrs.tab b/erts/emulator/beam/float_instrs.tab new file mode 100644 index 0000000000..3d4db77892 --- /dev/null +++ b/erts/emulator/beam/float_instrs.tab @@ -0,0 +1,88 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +LOAD_DOUBLE(Src, Dst) { + GET_DOUBLE($Src, *(FloatDef *) &$Dst); +} + +fload(Reg, Dst) { + $LOAD_DOUBLE($Reg, $Dst); +} + +fstore(Float, Dst) { + PUT_DOUBLE(*((FloatDef *) &$Float), HTOP); + $Dst = make_float(HTOP); + HTOP += FLOAT_SIZE_OBJECT; +} + +fconv(Src, Dst) { + Eterm src = $Src; + + if (is_small(src)) { + $Dst = (double) signed_val(src); + } else if (is_big(src)) { + if (big_to_double(src, &$Dst) < 0) { + $BADARITH0(); + } + } else if (is_float(src)) { + $LOAD_DOUBLE(src, $Dst); + } else { + $BADARITH0(); + } +} + +FLOAT_OP(Src1, OP, Src2, Dst) { + ERTS_NO_FPE_CHECK_INIT(c_p); + $Dst = $Src1 $OP $Src2; + ERTS_NO_FPE_ERROR(c_p, $Dst, $BADARITH0()); +} + +i_fadd(Src1, Src2, Dst) { + $FLOAT_OP($Src1, +, $Src2, $Dst); +} + +i_fsub(Src1, Src2, Dst) { + $FLOAT_OP($Src1, -, $Src2, $Dst); +} + +i_fmul(Src1, Src2, Dst) { + $FLOAT_OP($Src1, *, $Src2, $Dst); +} + +i_fdiv(Src1, Src2, Dst) { + $FLOAT_OP($Src1, /, $Src2, $Dst); +} + +i_fnegate(Src, Dst) { + ERTS_NO_FPE_CHECK_INIT(c_p); + $Dst = -$Src; + ERTS_NO_FPE_ERROR(c_p, $Dst, $BADARITH0()); +} + +%unless NO_FPE_SIGNALS +fclearerror() { + ERTS_FP_CHECK_INIT(c_p); +} + +i_fcheckerror() { + ERTS_FP_ERROR(c_p, freg[0].fd, $BADARITH0()); +} +%endif diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 7cb94ba3d2..c72ae32f2c 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1280,7 +1280,8 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen); void bin_write(fmtfn_t, void*, byte*, size_t); Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */ -Sint erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len); +int erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len, Sint* written); +Sint erts_unicode_list_to_buf_len(Eterm list); struct Sint_buf { #if defined(ARCH_64) @@ -1385,7 +1386,7 @@ Uint erts_current_reductions(Process* current, Process *p); int erts_print_system_version(fmtfn_t to, void *arg, Process *c_p); -int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg); +int erts_hibernate(Process* c_p, Eterm* reg); ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr); diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab new file mode 100644 index 0000000000..b79b960fd7 --- /dev/null +++ b/erts/emulator/beam/instrs.tab @@ -0,0 +1,907 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +// Stack manipulation instructions + +allocate(NeedStack, Live) { + $AH($NeedStack, 0, $Live); +} + +allocate_heap(NeedStack, NeedHeap, Live) { + $AH($NeedStack, $NeedHeap, $Live); +} + +allocate_init(NeedStack, Live, Y) { + $AH($NeedStack, 0, $Live); + make_blank($Y); +} + +allocate_zero(NeedStack, Live) { + Eterm* ptr; + int i = $NeedStack; + $AH(i, 0, $Live); + for (ptr = E + i; ptr > E; ptr--) { + make_blank(*ptr); + } +} + +allocate_heap_zero(NeedStack, NeedHeap, Live) { + Eterm* ptr; + int i = $NeedStack; + $AH(i, $NeedHeap, $Live); + for (ptr = E + i; ptr > E; ptr--) { + make_blank(*ptr); + } +} + +// This instruction is probably never used (because it is combined with a +// a return). However, a future compiler might for some reason emit a +// deallocate not followed by a return, and that should work. + +deallocate(Deallocate) { + //| -no_prefetch + SET_CP(c_p, (BeamInstr *) cp_val(*E)); + E = ADD_BYTE_OFFSET(E, $Deallocate); +} + +deallocate_return(Deallocate) { + //| -no_next + int words_to_pop = $Deallocate; + SET_I((BeamInstr *) cp_val(*E)); + E = ADD_BYTE_OFFSET(E, words_to_pop); + CHECK_TERM(x(0)); + DispatchReturn; +} + +move_deallocate_return(Src, Deallocate) { + x(0) = $Src; + $deallocate_return($Deallocate); +} + +// Call instructions + +DISPATCH(CallDest) { + //| -no_next + SET_I((BeamInstr *) $CallDest); + DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I)); + Dispatch(); +} + +i_call(CallDest) { + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH($CallDest); +} + +move_call(Src, CallDest) { + x(0) = $Src; + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH($CallDest); +} + +i_call_last(CallDest, Deallocate) { + $deallocate($Deallocate); + $DISPATCH($CallDest); +} + +move_call_last(Src, CallDest, Deallocate) { + x(0) = $Src; + $i_call_last($CallDest, $Deallocate); +} + +i_call_only(CallDest) { + $DISPATCH($CallDest); +} + +move_call_only(Src, CallDest) { + x(0) = $Src; + $i_call_only($CallDest); +} + +DISPATCHX(Dest) { + //| -no_next + DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, $Dest); + // Dispatchx assumes the Export* is in Arg(0) + I = (&$Dest) - 1; + Dispatchx(); +} + +i_call_ext(Dest) { + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCHX($Dest); +} + +i_move_call_ext(Src, Dest) { + x(0) = $Src; + $i_call_ext($Dest); +} + +i_call_ext_only(Dest) { + $DISPATCHX($Dest); +} + +i_move_call_ext_only(Dest, Src) { + x(0) = $Src; + $i_call_ext_only($Dest); +} + +i_call_ext_last(Dest, Deallocate) { + $deallocate($Deallocate); + $DISPATCHX($Dest); +} + +i_move_call_ext_last(Dest, StackOffset, Src) { + x(0) = $Src; + $i_call_ext_last($Dest, $StackOffset); +} + +APPLY(I, Deallocate, Next) { + //| -no_next + HEAVY_SWAPOUT; + $Next = apply(c_p, reg, $I, $Deallocate); + HEAVY_SWAPIN; +} + +HANDLE_APPLY_ERROR() { + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); + goto post_error_handling; +} + +i_apply() { + BeamInstr *next; + $APPLY(NULL, 0, next); + if (ERTS_LIKELY(next != NULL)) { + $i_call(next); + } + $HANDLE_APPLY_ERROR(); +} + +i_apply_last(Deallocate) { + BeamInstr *next; + $APPLY(I, $Deallocate, next); + if (ERTS_LIKELY(next != NULL)) { + $i_call_last(next, $Deallocate); + } + $HANDLE_APPLY_ERROR(); +} + +i_apply_only() { + BeamInstr *next; + $APPLY(I, 0, next); + if (ERTS_LIKELY(next != NULL)) { + $i_call_only(next); + } + $HANDLE_APPLY_ERROR(); +} + +FIXED_APPLY(Arity, I, Deallocate, Next) { + //| -no_next + HEAVY_SWAPOUT; + $Next = fixed_apply(c_p, reg, $Arity, $I, $Deallocate); + HEAVY_SWAPIN; +} + +apply(Arity) { + BeamInstr *next; + $FIXED_APPLY($Arity, NULL, 0, next); + if (ERTS_LIKELY(next != NULL)) { + $i_call(next); + } + $HANDLE_APPLY_ERROR(); +} + +apply_last(Arity, Deallocate) { + BeamInstr *next; + $FIXED_APPLY($Arity, I, $Deallocate, next); + if (ERTS_LIKELY(next != NULL)) { + $i_call_last(next, $Deallocate); + } + $HANDLE_APPLY_ERROR(); +} + +APPLY_FUN(Next) { + HEAVY_SWAPOUT; + $Next = apply_fun(c_p, r(0), x(1), reg); + HEAVY_SWAPIN; +} + +HANDLE_APPLY_FUN_ERROR() { + goto find_func_info; +} + +DISPATCH_FUN(I) { + SET_I($I); + Dispatchfun(); +} + +i_apply_fun() { + BeamInstr *next; + $APPLY_FUN(next); + if (ERTS_LIKELY(next != NULL)) { + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +i_apply_fun_last(Deallocate) { + BeamInstr *next; + $APPLY_FUN(next); + if (ERTS_LIKELY(next != NULL)) { + $deallocate($Deallocate); + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +i_apply_fun_only() { + BeamInstr *next; + $APPLY_FUN(next); + if (ERTS_LIKELY(next != NULL)) { + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +CALL_FUN(Fun, Next) { + //| -no_next + HEAVY_SWAPOUT; + $Next = call_fun(c_p, $Fun, reg, THE_NON_VALUE); + HEAVY_SWAPIN; +} + +i_call_fun(Fun) { + BeamInstr *next; + $CALL_FUN($Fun, next); + if (ERTS_LIKELY(next != NULL)) { + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +i_call_fun_last(Fun, Deallocate) { + BeamInstr *next; + $CALL_FUN($Fun, next); + if (ERTS_LIKELY(next != NULL)) { + $deallocate($Deallocate); + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +return() { + SET_I(c_p->cp); + DTRACE_RETURN_FROM_PC(c_p); + + /* + * We must clear the CP to make sure that a stale value do not + * create a false module dependcy preventing code upgrading. + * It also means that we can use the CP in stack backtraces. + */ + c_p->cp = 0; + CHECK_TERM(r(0)); + HEAP_SPACE_VERIFIED(0); + DispatchReturn; +} + +get_list(Src, Hd, Tl) { + Eterm* tmp_ptr = list_val($Src); + Eterm hd, tl; + hd = CAR(tmp_ptr); + tl = CDR(tmp_ptr); + $Hd = hd; + $Tl = tl; +} + +i_get(Src, Dst) { + $Dst = erts_pd_hash_get(c_p, $Src); +} + +i_get_hash(Src, Hash, Dst) { + $Dst = erts_pd_hash_get_with_hx(c_p, $Hash, $Src); +} + +i_get_tuple_element(Src, Element, Dst) { + Eterm* src = ADD_BYTE_OFFSET(tuple_val($Src), $Element); + $Dst = *src; +} + +i_get_tuple_element2(Src, Element, Dst) { + Eterm* src; + Eterm* dst; + Eterm E1, E2; + src = ADD_BYTE_OFFSET(tuple_val($Src), $Element); + dst = &($Dst); + E1 = src[0]; + E2 = src[1]; + dst[0] = E1; + dst[1] = E2; +} + +i_get_tuple_element2y(Src, Element, D1, D2) { + Eterm* src; + Eterm E1, E2; + src = ADD_BYTE_OFFSET(tuple_val($Src), $Element); + E1 = src[0]; + E2 = src[1]; + $D1 = E1; + $D2 = E2; +} + +i_get_tuple_element3(Src, Element, Dst) { + Eterm* src; + Eterm* dst; + Eterm E1, E2, E3; + src = ADD_BYTE_OFFSET(tuple_val($Src), $Element); + dst = &($Dst); + E1 = src[0]; + E2 = src[1]; + E3 = src[2]; + dst[0] = E1; + dst[1] = E2; + dst[2] = E3; +} + +i_element := element_group.fetch.execute; + + +element_group.head() { + Eterm element_index; + Eterm element_tuple; +} + +element_group.fetch(Src) { + element_tuple = $Src; +} + +element_group.execute(Fail, Index, Dst) { + element_index = $Index; + if (ERTS_LIKELY(is_small(element_index) && is_tuple(element_tuple))) { + Eterm* tp = tuple_val(element_tuple); + + if ((signed_val(element_index) >= 1) && + (signed_val(element_index) <= arityval(*tp))) { + $Dst = tp[signed_val(element_index)]; + $NEXT0(); + } + } + c_p->freason = BADARG; + $BIF_ERROR_ARITY_2($Fail, BIF_element_2, element_index, element_tuple); +} + +i_fast_element := fast_element_group.fetch.execute; + +fast_element_group.head() { + Eterm fast_element_tuple; +} + +fast_element_group.fetch(Src) { + fast_element_tuple = $Src; +} + +fast_element_group.execute(Fail, Index, Dst) { + if (ERTS_LIKELY(is_tuple(fast_element_tuple))) { + Eterm* tp = tuple_val(fast_element_tuple); + Eterm pos = $Index; /* Untagged integer >= 1 */ + if (pos <= arityval(*tp)) { + $Dst = tp[pos]; + $NEXT0(); + } + } + c_p->freason = BADARG; + $BIF_ERROR_ARITY_2($Fail, BIF_element_2, make_small($Index), fast_element_tuple); +} + +init(Y) { + make_blank($Y); +} + +init2(Y1, Y2) { + make_blank($Y1); + make_blank($Y2); +} + +init3(Y1, Y2, Y3) { + make_blank($Y1); + make_blank($Y2); + make_blank($Y3); +} + +i_make_fun(FunP, NumFree) { + HEAVY_SWAPOUT; + x(0) = new_fun(c_p, reg, (ErlFunEntry *) $FunP, $NumFree); + HEAVY_SWAPIN; +} + +i_trim(Words) { + Uint cp = E[0]; + E += $Words; + E[0] = cp; +} + +move(Src, Dst) { + $Dst = $Src; +} + +move3(S1, D1, S2, D2, S3, D3) { + $D1 = $S1; + $D2 = $S2; + $D3 = $S3; +} + +move_dup(Src, D1, D2) { + $D1 = $D2 = $Src; +} + +move2_par(S1, D1, S2, D2) { + Eterm V1, V2; + V1 = $S1; + V2 = $S2; + $D1 = V1; + $D2 = V2; +} + +move_shift(Src, SD, D) { + Eterm V; + V = $Src; + $D = $SD; + $SD = V; +} + +move_window3(S1, S2, S3, D) { + Eterm xt0, xt1, xt2; + Eterm* y = &$D; + xt0 = $S1; + xt1 = $S2; + xt2 = $S3; + y[0] = xt0; + y[1] = xt1; + y[2] = xt2; +} + +move_window4(S1, S2, S3, S4, D) { + Eterm xt0, xt1, xt2, xt3; + Eterm* y = &$D; + xt0 = $S1; + xt1 = $S2; + xt2 = $S3; + xt3 = $S4; + y[0] = xt0; + y[1] = xt1; + y[2] = xt2; + y[3] = xt3; +} + +move_window5(S1, S2, S3, S4, S5, D) { + Eterm xt0, xt1, xt2, xt3, xt4; + Eterm *y = &$D; + xt0 = $S1; + xt1 = $S2; + xt2 = $S3; + xt3 = $S4; + xt4 = $S5; + y[0] = xt0; + y[1] = xt1; + y[2] = xt2; + y[3] = xt3; + y[4] = xt4; +} + +move_return(Src) { + //| -no_next + x(0) = $Src; + SET_I(c_p->cp); + c_p->cp = 0; + DispatchReturn; +} + +move_x1(Src) { + x(1) = $Src; +} + +move_x2(Src) { + x(2) = $Src; +} + +node(Dst) { + $Dst = erts_this_node->sysname; +} + +put_list(Hd, Tl, Dst) { + HTOP[0] = $Hd; + HTOP[1] = $Tl; + $Dst = make_list(HTOP); + HTOP += 2; +} + +i_put_tuple := i_put_tuple.make.fill; + +i_put_tuple.make(Dst) { + $Dst = make_tuple(HTOP); +} + +i_put_tuple.fill(Arity) { + Eterm* hp = HTOP; + Eterm arity = $Arity; + + //| -no_next + *hp++ = make_arityval(arity); + I = $NEXT_INSTRUCTION; + do { + Eterm term = *I++; + switch (loader_tag(term)) { + case LOADER_X_REG: + *hp++ = x(loader_x_reg_index(term)); + break; + case LOADER_Y_REG: + *hp++ = y(loader_y_reg_index(term)); + break; + default: + *hp++ = term; + break; + } + } while (--arity != 0); + HTOP = hp; + Goto(*I); +} + +self(Dst) { + $Dst = c_p->common.id; +} + +set_tuple_element(Element, Tuple, Offset) { + Eterm* p; + + ASSERT(is_tuple($Tuple)); + p = (Eterm *) ((unsigned char *) tuple_val($Tuple) + $Offset); + *p = $Element; +} + +swap(R1, R2) { + Eterm V = $R1; + $R1 = $R2; + $R2 = V; +} + +swap_temp(R1, R2, Tmp) { + Eterm V = $R1; + $R1 = $R2; + $R2 = $Tmp = V; +} + +test_heap(Nh, Live) { + $GC_TEST(0, $Nh, $Live); +} + +test_heap_1_put_list(Nh, Reg) { + $test_heap($Nh, 1); + $put_list($Reg, x(0), x(0)); +} + +is_integer_allocate(Fail, Src, NeedStack, Live) { + //| -no_prefetch + $is_integer($Fail, $Src); + $AH($NeedStack, 0, $Live); +} + +is_nonempty_list(Fail, Src) { + //| -no_prefetch + if (is_not_list($Src)) { + $FAIL($Fail); + } +} + +is_nonempty_list_test_heap(Fail, Need, Live) { + //| -no_prefetch + $is_nonempty_list($Fail, x(0)); + $test_heap($Need, $Live); +} + +is_nonempty_list_allocate(Fail, Src, Need, Live) { + //| -no_prefetch + $is_nonempty_list($Fail, $Src); + $AH($Need, 0, $Live); +} + +is_nonempty_list_get_list(Fail, Src, Hd, Tl) { + //| -no_prefetch + $is_nonempty_list($Fail, $Src); + $get_list($Src, $Hd, $Tl); +} + +jump(Fail) { + $JUMP($Fail); +} + +move_jump(Fail, Src) { + x(0) = $Src; + $jump($Fail); +} + +// +// Test instructions. +// + +is_atom(Fail, Src) { + if (is_not_atom($Src)) { + $FAIL($Fail); + } +} + +is_boolean(Fail, Src) { + if (($Src) != am_true && ($Src) != am_false) { + $FAIL($Fail); + } +} + +is_binary(Fail, Src) { + if (is_not_binary($Src) || binary_bitsize($Src) != 0) { + $FAIL($Fail); + } +} + +is_bitstring(Fail, Src) { + if (is_not_binary($Src)) { + $FAIL($Fail); + } +} + +is_float(Fail, Src) { + if (is_not_float($Src)) { + $FAIL($Fail); + } +} + +is_function(Fail, Src) { + if ( !(is_any_fun($Src)) ) { + $FAIL($Fail); + } +} + +is_function2(Fail, Fun, Arity) { + if (erl_is_function(c_p, $Fun, $Arity) != am_true ) { + $FAIL($Fail); + } +} + +is_integer(Fail, Src) { + if (is_not_integer($Src)) { + $FAIL($Fail); + } +} + +is_list(Fail, Src) { + if (is_not_list($Src) && is_not_nil($Src)) { + $FAIL($Fail); + } +} + +is_map(Fail, Src) { + if (is_not_map($Src)) { + $FAIL($Fail); + } +} + +is_nil(Fail, Src) { + if (is_not_nil($Src)) { + $FAIL($Fail); + } +} + +is_number(Fail, Src) { + if (is_not_integer($Src) && is_not_float($Src)) { + $FAIL($Fail); + } +} + +is_pid(Fail, Src) { + if (is_not_pid($Src)) { + $FAIL($Fail); + } +} + +is_port(Fail, Src) { + if (is_not_port($Src)) { + $FAIL($Fail); + } +} + +is_reference(Fail, Src) { + if (is_not_ref($Src)) { + $FAIL($Fail); + } +} + +is_tagged_tuple(Fail, Src, Arityval, Tag) { + if (!(BEAM_IS_TUPLE($Src) && + (tuple_val($Src))[0] == $Arityval && + (tuple_val($Src))[1] == $Tag)) { + $FAIL($Fail); + } +} + +is_tuple(Fail, Src) { + if (is_not_tuple($Src)) { + $FAIL($Fail); + } +} + +is_tuple_of_arity(Fail, Src, Arityval) { + if (!(BEAM_IS_TUPLE($Src) && *tuple_val($Src) == $Arityval)) { + $FAIL($Fail); + } +} + +test_arity(Fail, Pointer, Arity) { + if (*tuple_val($Pointer) != $Arity) { + $FAIL($Fail); + } +} + +i_is_eq_exact_immed(Fail, X, Y) { + if ($X != $Y) { + $FAIL($Fail); + } +} + +i_is_ne_exact_immed(Fail, X, Y) { + if ($X == $Y) { + $FAIL($Fail); + } +} + +is_eq_exact(Fail, X, Y) { + if (!EQ($X, $Y)) { + $FAIL($Fail); + } +} + +i_is_eq_exact_literal(Fail, Src, Literal) { + if (!eq($Src, $Literal)) { + $FAIL($Fail); + } +} + +is_ne_exact(Fail, X, Y) { + if (EQ($X, $Y)) { + $FAIL($Fail); + } +} + +i_is_ne_exact_literal(Fail, Src, Literal) { + if (eq($Src, $Literal)) { + $FAIL($Fail); + } +} + +is_eq(Fail, X, Y) { + CMP_EQ_ACTION($X, $Y, $FAIL($Fail)); +} + +is_ne(Fail, X, Y) { + CMP_NE_ACTION($X, $Y, $FAIL($Fail)); +} + +is_lt(Fail, X, Y) { + CMP_LT_ACTION($X, $Y, $FAIL($Fail)); +} + +is_ge(Fail, X, Y) { + CMP_GE_ACTION($X, $Y, $FAIL($Fail)); +} + +badarg(Fail) { + $BADARG($Fail); + //| -no_next; +} + +badmatch(Src) { + c_p->fvalue = $Src; + c_p->freason = BADMATCH; + goto find_func_info; +} + +case_end(Src) { + c_p->fvalue = $Src; + c_p->freason = EXC_CASE_CLAUSE; + goto find_func_info; +} + +if_end() { + c_p->freason = EXC_IF_CLAUSE; + goto find_func_info; + //| -no_next; +} + +system_limit(Fail) { + $SYSTEM_LIMIT($Fail); + //| -no_next; +} + +catch(Y, Fail) { + c_p->catches++; + $Y = $Fail; +} + +catch_end(Y) { + c_p->catches--; + make_blank($Y); + if (is_non_value(r(0))) { + c_p->fvalue = NIL; + if (x(1) == am_throw) { + r(0) = x(2); + } else { + if (x(1) == am_error) { + SWAPOUT; + x(2) = add_stacktrace(c_p, x(2), x(3)); + SWAPIN; + } + /* only x(2) is included in the rootset here */ + if (E - HTOP < 3) { + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + } + r(0) = TUPLE2(HTOP, am_EXIT, x(2)); + HTOP += 3; + } + } + CHECK_TERM(r(0)); +} + +try_end(Y) { + c_p->catches--; + make_blank($Y); + if (is_non_value(r(0))) { + c_p->fvalue = NIL; + r(0) = x(1); + x(1) = x(2); + x(2) = x(3); + } +} + +try_case_end(Src) { + c_p->fvalue = $Src; + c_p->freason = EXC_TRY_CLAUSE; + goto find_func_info; + //| -no_next; +} + +i_raise() { + Eterm raise_trace = x(2); + Eterm raise_value = x(1); + struct StackTrace *s; + + c_p->fvalue = raise_value; + c_p->ftrace = raise_trace; + s = get_trace_from_exc(raise_trace); + if (s == NULL) { + c_p->freason = EXC_ERROR; + } else { + c_p->freason = PRIMARY_EXCEPTION(s->freason); + } + goto find_func_info; + //| -no_next +} + diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index c8925e159e..3f44d6e242 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -52,6 +52,7 @@ #include "erl_bif_unique.h" #include "erl_hl_timer.h" #include "erl_time.h" +#include "erl_io_queue.h" extern ErlDrvEntry fd_driver_entry; extern ErlDrvEntry vanilla_driver_entry; @@ -102,7 +103,7 @@ static void driver_monitor_unlock_pdl(Port *p); #define ERL_SMALL_IO_BIN_LIMIT (4*ERL_ONHEAP_BIN_LIMIT) #define SMALL_WRITE_VEC 16 -static ERTS_INLINE ErlIOQueue* +static ERTS_INLINE ErlPortIOQueue* drvport2ioq(ErlDrvPort drvport) { Port *prt = erts_thr_drvport2port(drvport, 0); @@ -117,11 +118,11 @@ is_port_ioq_empty(Port *pp) int res; ERTS_LC_ASSERT(erts_lc_is_port_locked(pp)); if (!pp->port_data_lock) - res = (pp->ioq.size == 0); + res = (erts_ioq_size(&pp->ioq) == 0); else { ErlDrvPDL pdl = pp->port_data_lock; erts_mtx_lock(&pdl->mtx); - res = (pp->ioq.size == 0); + res = (erts_ioq_size(&pp->ioq) == 0); erts_mtx_unlock(&pdl->mtx); } return res; @@ -136,14 +137,14 @@ erts_is_port_ioq_empty(Port *pp) Uint erts_port_ioq_size(Port *pp) { - int res; + ErlDrvSizeT res; ERTS_LC_ASSERT(erts_lc_is_port_locked(pp)); if (!pp->port_data_lock) - res = pp->ioq.size; + res = erts_ioq_size(&pp->ioq); else { ErlDrvPDL pdl = pp->port_data_lock; erts_mtx_lock(&pdl->mtx); - res = pp->ioq.size; + res = erts_ioq_size(&pp->ioq); erts_mtx_unlock(&pdl->mtx); } return (Uint) res; @@ -473,41 +474,17 @@ erts_port_free(Port *prt) */ static void initq(Port* prt) { - ErlIOQueue* q = &prt->ioq; - ERTS_LC_ASSERT(!prt->port_data_lock); - - q->size = 0; - q->v_head = q->v_tail = q->v_start = q->v_small; - q->v_end = q->v_small + SMALL_IO_QUEUE; - q->b_head = q->b_tail = q->b_start = q->b_small; - q->b_end = q->b_small + SMALL_IO_QUEUE; + erts_ioq_init(&prt->ioq, ERTS_ALC_T_IOQ, 1); } static void stopq(Port* prt) { - ErlIOQueue* q; - ErlDrvBinary** binp; if (prt->port_data_lock) driver_pdl_lock(prt->port_data_lock); - q = &prt->ioq; - binp = q->b_head; - - if (q->v_start != q->v_small) - erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start); - - while(binp < q->b_tail) { - if (*binp != NULL) - driver_free_binary(*binp); - binp++; - } - if (q->b_start != q->b_small) - erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start); - q->v_start = q->v_end = q->v_head = q->v_tail = NULL; - q->b_start = q->b_end = q->b_head = q->b_tail = NULL; - q->size = 0; + erts_ioq_clear(&prt->ioq); if (prt->port_data_lock) { driver_pdl_unlock(prt->port_data_lock); @@ -876,311 +853,6 @@ int erts_port_handle_xports(Port *prt) return reds; } -/* Fills a possibly deep list of chars and binaries into vec -** Small characters are first stored in the buffer buf of length ln -** binaries found are copied and linked into msoh -** Return vector length on succsess, -** -1 on overflow -** -2 on type error -*/ - -#ifdef DEBUG -#define MAX_SYSIOVEC_IOVLEN (1ull << (32 - 1)) -#else -#define MAX_SYSIOVEC_IOVLEN (1ull << (sizeof(((SysIOVec*)0)->iov_len) * 8 - 1)) -#endif - -static ERTS_INLINE void -io_list_to_vec_set_vec(SysIOVec **iov, ErlDrvBinary ***binv, - ErlDrvBinary *bin, byte *ptr, Uint len, - int *vlen) -{ - while (len > MAX_SYSIOVEC_IOVLEN) { - (*iov)->iov_base = ptr; - (*iov)->iov_len = MAX_SYSIOVEC_IOVLEN; - ptr += MAX_SYSIOVEC_IOVLEN; - len -= MAX_SYSIOVEC_IOVLEN; - (*iov)++; - (*vlen)++; - *(*binv)++ = bin; - } - (*iov)->iov_base = ptr; - (*iov)->iov_len = len; - *(*binv)++ = bin; - (*iov)++; - (*vlen)++; -} - -static int -io_list_to_vec(Eterm obj, /* io-list */ - SysIOVec* iov, /* io vector */ - ErlDrvBinary** binv, /* binary reference vector */ - ErlDrvBinary* cbin, /* binary to store characters */ - ErlDrvSizeT bin_limit) /* small binaries limit */ -{ - DECLARE_ESTACK(s); - Eterm* objp; - byte *buf = (byte*)cbin->orig_bytes; - Uint len = cbin->orig_size; - Uint csize = 0; - int vlen = 0; - byte* cptr = buf; - - goto L_jump_start; /* avoid push */ - - while (!ESTACK_ISEMPTY(s)) { - obj = ESTACK_POP(s); - L_jump_start: - if (is_list(obj)) { - L_iter_list: - objp = list_val(obj); - obj = CAR(objp); - if (is_byte(obj)) { - if (len == 0) - goto L_overflow; - *buf++ = unsigned_val(obj); - csize++; - len--; - } else if (is_binary(obj)) { - ESTACK_PUSH(s, CDR(objp)); - goto handle_binary; - } else if (is_list(obj)) { - ESTACK_PUSH(s, CDR(objp)); - goto L_iter_list; /* on head */ - } else if (!is_nil(obj)) { - goto L_type_error; - } - obj = CDR(objp); - if (is_list(obj)) - goto L_iter_list; /* on tail */ - else if (is_binary(obj)) { - goto handle_binary; - } else if (!is_nil(obj)) { - goto L_type_error; - } - } else if (is_binary(obj)) { - Eterm real_bin; - Uint offset; - Eterm* bptr; - ErlDrvSizeT size; - int bitoffs; - int bitsize; - - handle_binary: - size = binary_size(obj); - ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); - ASSERT(bitsize == 0); - bptr = binary_val(real_bin); - if (*bptr == HEADER_PROC_BIN) { - ProcBin* pb = (ProcBin *) bptr; - if (bitoffs != 0) { - if (len < size) { - goto L_overflow; - } - erts_copy_bits(pb->bytes+offset, bitoffs, 1, - (byte *) buf, 0, 1, size*8); - csize += size; - buf += size; - len -= size; - } else if (bin_limit && size < bin_limit) { - if (len < size) { - goto L_overflow; - } - sys_memcpy(buf, pb->bytes+offset, size); - csize += size; - buf += size; - len -= size; - } else { - if (csize != 0) { - io_list_to_vec_set_vec(&iov, &binv, cbin, - cptr, csize, &vlen); - cptr = buf; - csize = 0; - } - if (pb->flags) { - erts_emasculate_writable_binary(pb); - } - io_list_to_vec_set_vec( - &iov, &binv, Binary2ErlDrvBinary(pb->val), - pb->bytes+offset, size, &vlen); - } - } else { - ErlHeapBin* hb = (ErlHeapBin *) bptr; - if (len < size) { - goto L_overflow; - } - copy_binary_to_buffer(buf, 0, - ((byte *) hb->data)+offset, bitoffs, - 8*size); - csize += size; - buf += size; - len -= size; - } - } else if (!is_nil(obj)) { - goto L_type_error; - } - } - - if (csize != 0) { - io_list_to_vec_set_vec(&iov, &binv, cbin, cptr, csize, &vlen); - } - - DESTROY_ESTACK(s); - return vlen; - - L_type_error: - DESTROY_ESTACK(s); - return -2; - - L_overflow: - DESTROY_ESTACK(s); - return -1; -} - -#define IO_LIST_VEC_COUNT(obj) \ -do { \ - Uint _size = binary_size(obj); \ - Eterm _real; \ - ERTS_DECLARE_DUMMY(Uint _offset); \ - int _bitoffs; \ - int _bitsize; \ - ERTS_GET_REAL_BIN(obj, _real, _offset, _bitoffs, _bitsize); \ - if (_bitsize != 0) goto L_type_error; \ - if (thing_subtag(*binary_val(_real)) == REFC_BINARY_SUBTAG && \ - _bitoffs == 0) { \ - b_size += _size; \ - if (b_size < _size) goto L_overflow_error; \ - in_clist = 0; \ - v_size++; \ - /* If iov_len is smaller then Uint we split the binary into*/ \ - /* multiple smaller (2GB) elements in the iolist.*/ \ - v_size += _size / MAX_SYSIOVEC_IOVLEN; \ - if (_size >= ERL_SMALL_IO_BIN_LIMIT) { \ - p_in_clist = 0; \ - p_v_size++; \ - } else { \ - p_c_size += _size; \ - if (!p_in_clist) { \ - p_in_clist = 1; \ - p_v_size++; \ - } \ - } \ - } else { \ - c_size += _size; \ - if (c_size < _size) goto L_overflow_error; \ - if (!in_clist) { \ - in_clist = 1; \ - v_size++; \ - } \ - p_c_size += _size; \ - if (!p_in_clist) { \ - p_in_clist = 1; \ - p_v_size++; \ - } \ - } \ -} while (0) - - -/* - * Returns 0 if successful and a non-zero value otherwise. - * - * Return values through pointers: - * *vsize - SysIOVec size needed for a writev - * *csize - Number of bytes not in binary (in the common binary) - * *pvsize - SysIOVec size needed if packing small binaries - * *pcsize - Number of bytes in the common binary if packing - * *total_size - Total size of iolist in bytes - */ - -static int -io_list_vec_len(Eterm obj, int* vsize, Uint* csize, - Uint* pvsize, Uint* pcsize, - ErlDrvSizeT* total_size) -{ - DECLARE_ESTACK(s); - Eterm* objp; - Uint v_size = 0; - Uint c_size = 0; - Uint b_size = 0; - Uint in_clist = 0; - Uint p_v_size = 0; - Uint p_c_size = 0; - Uint p_in_clist = 0; - Uint total; - - goto L_jump_start; /* avoid a push */ - - while (!ESTACK_ISEMPTY(s)) { - obj = ESTACK_POP(s); - L_jump_start: - if (is_list(obj)) { - L_iter_list: - objp = list_val(obj); - obj = CAR(objp); - - if (is_byte(obj)) { - c_size++; - if (c_size == 0) { - goto L_overflow_error; - } - if (!in_clist) { - in_clist = 1; - v_size++; - } - p_c_size++; - if (!p_in_clist) { - p_in_clist = 1; - p_v_size++; - } - } - else if (is_binary(obj)) { - IO_LIST_VEC_COUNT(obj); - } - else if (is_list(obj)) { - ESTACK_PUSH(s, CDR(objp)); - goto L_iter_list; /* on head */ - } - else if (!is_nil(obj)) { - goto L_type_error; - } - - obj = CDR(objp); - if (is_list(obj)) - goto L_iter_list; /* on tail */ - else if (is_binary(obj)) { /* binary tail is OK */ - IO_LIST_VEC_COUNT(obj); - } - else if (!is_nil(obj)) { - goto L_type_error; - } - } - else if (is_binary(obj)) { - IO_LIST_VEC_COUNT(obj); - } - else if (!is_nil(obj)) { - goto L_type_error; - } - } - - total = c_size + b_size; - if (total < c_size) { - goto L_overflow_error; - } - *total_size = (ErlDrvSizeT) total; - - DESTROY_ESTACK(s); - *vsize = v_size; - *csize = c_size; - *pvsize = p_v_size; - *pcsize = p_c_size; - return 0; - - L_type_error: - L_overflow_error: - DESTROY_ESTACK(s); - return 1; -} - typedef enum { ERTS_TRY_IMM_DRV_CALL_OK, ERTS_TRY_IMM_DRV_CALL_BUSY_LOCK, @@ -1750,8 +1422,7 @@ cleanup_scheduled_outputv(ErlIOVec *ev, ErlDrvBinary *cbinp) int i; /* Need to free all binaries */ for (i = 1; i < ev->vsize; i++) - if (ev->binv[i]) - driver_free_binary(ev->binv[i]); + driver_free_binary(ev->binv[i]); if (cbinp) driver_free_binary(cbinp); } @@ -1919,15 +1590,14 @@ erts_port_output_async(Port *prt, Eterm from, Eterm list) size_t size; int task_flags; ErtsProc2PortSigCallback port_sig_callback; - ErlDrvBinary *cbin = NULL; - ErlIOVec *evp = NULL; + ErtsIOQBinary *cbin = NULL; + ErtsIOVec *evp = NULL; char *buf = NULL; ErtsPortTaskHandle *ns_pthp; if (drv->outputv) { - ErlIOVec ev; SysIOVec* ivp; - ErlDrvBinary** bvp; + ErtsIOQBinary** bvp; int vsize; Uint csize; Uint pvsize; @@ -1937,91 +1607,63 @@ erts_port_output_async(Port *prt, Eterm from, Eterm list) char *ptr; int i; - Eterm* bptr = NULL; - Uint offset; - - if (is_binary(list)) { - /* We optimize for when we get a procbin without offset */ - Eterm real_bin; - int bitoffs; - int bitsize; - ERTS_GET_REAL_BIN(list, real_bin, offset, bitoffs, bitsize); - bptr = binary_val(real_bin); - if (*bptr == HEADER_PROC_BIN && bitoffs == 0) { - size = binary_size(list); - vsize = 1; - } else - bptr = NULL; - } - - if (!bptr) { - if (io_list_vec_len(list, &vsize, &csize, &pvsize, &pcsize, &size)) - goto bad_value; + if (erts_ioq_iodata_vec_len(list, &vsize, &csize, &pvsize, &pcsize, + &size, ERL_SMALL_IO_BIN_LIMIT)) + goto bad_value; - /* To pack or not to pack (small binaries) ...? */ - if (vsize >= SMALL_WRITE_VEC) { - /* Do pack */ - vsize = pvsize + 1; - csize = pcsize; - blimit = ERL_SMALL_IO_BIN_LIMIT; - } - cbin = driver_alloc_binary(csize); + /* To pack or not to pack (small binaries) ...? */ + if (vsize >= SMALL_WRITE_VEC) { + /* Do pack */ + vsize = pvsize + 1; + csize = pcsize; + blimit = ERL_SMALL_IO_BIN_LIMIT; + } + if (csize) { + cbin = (ErtsIOQBinary *)driver_alloc_binary(csize); if (!cbin) erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, ERTS_SIZEOF_Binary(csize)); } - iov_offset = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErlIOVec)); binv_offset = iov_offset; binv_offset += ERTS_ALC_DATA_ALIGN_SIZE((vsize+1)*sizeof(SysIOVec)); alloc_size = binv_offset; - alloc_size += (vsize+1)*sizeof(ErlDrvBinary *); + alloc_size += (vsize+1)*sizeof(ErtsIOQBinary *); sigdp = erts_port_task_alloc_p2p_sig_data_extra(alloc_size, (void**)&ptr); - evp = (ErlIOVec *) ptr; - ivp = evp->iov = (SysIOVec *) (ptr + iov_offset); - bvp = evp->binv = (ErlDrvBinary **) (ptr + binv_offset); + evp = (ErtsIOVec *) ptr; + ivp = evp->driver.iov = (SysIOVec *) (ptr + iov_offset); + bvp = evp->common.binv = (ErtsIOQBinary **) (ptr + binv_offset); ivp[0].iov_base = NULL; ivp[0].iov_len = 0; bvp[0] = NULL; - if (bptr) { - ProcBin* pb = (ProcBin *) bptr; - - ivp[1].iov_base = pb->bytes+offset; - ivp[1].iov_len = size; - bvp[1] = Binary2ErlDrvBinary(pb->val); - - evp->vsize = 1; - } else { - - evp->vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit); - if (evp->vsize < 0) { - if (evp != &ev) - erts_free(ERTS_ALC_T_DRV_CMD_DATA, evp); - driver_free_binary(cbin); - goto bad_value; - } + evp->driver.vsize = erts_ioq_iodata_to_vec(list, ivp+1, bvp+1, cbin, + blimit, 1); + if (evp->driver.vsize < 0) { + erts_free(ERTS_ALC_T_DRV_CMD_DATA, evp); + driver_free_binary(&cbin->driver); + goto bad_value; } #if 0 /* This assertion may say something useful, but it can be falsified during the emulator test suites. */ ASSERT(evp->vsize == vsize); #endif - evp->vsize++; - evp->size = size; /* total size */ + evp->driver.vsize++; + evp->driver.size = size; /* total size */ /* Need to increase refc on all binaries */ - for (i = 1; i < evp->vsize; i++) + for (i = 1; i < evp->driver.vsize; i++) if (bvp[i]) - driver_binary_inc_refc(bvp[i]); + driver_binary_inc_refc(&bvp[i]->driver); sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUTV; sigdp->u.outputv.from = from; - sigdp->u.outputv.evp = evp; - sigdp->u.outputv.cbinp = cbin; + sigdp->u.outputv.evp = &evp->driver; + sigdp->u.outputv.cbinp = &cbin->driver; port_sig_callback = port_sig_outputv; } else { ErlDrvSizeT ERTS_DECLARE_DUMMY(r); @@ -2092,8 +1734,8 @@ erts_port_output(Process *c_p, erts_aint32_t sched_flags, busy_flgs, invalid_flags; int task_flags; ErtsProc2PortSigCallback port_sig_callback; - ErlDrvBinary *cbin = NULL; - ErlIOVec *evp = NULL; + ErtsIOQBinary *cbin = NULL; + ErtsIOVec *evp = NULL; char *buf = NULL; int force_immediate_call = (flags & ERTS_PORT_SIG_FLG_FORCE_IMM_CALL); int async_nosuspend; @@ -2139,11 +1781,11 @@ erts_port_output(Process *c_p, } #endif if (drv->outputv) { - ErlIOVec ev; + ErtsIOVec ev; SysIOVec iv[SMALL_WRITE_VEC]; - ErlDrvBinary* bv[SMALL_WRITE_VEC]; + ErtsIOQBinary* bv[SMALL_WRITE_VEC]; SysIOVec* ivp; - ErlDrvBinary** bvp; + ErtsIOQBinary** bvp; int vsize; Uint csize; Uint pvsize; @@ -2151,18 +1793,19 @@ erts_port_output(Process *c_p, Uint blimit; size_t iov_offset, binv_offset, alloc_size; - if (io_list_vec_len(list, &vsize, &csize, &pvsize, &pcsize, &size)) + if (erts_ioq_iodata_vec_len(list, &vsize, &csize, &pvsize, &pcsize, + &size, ERL_SMALL_IO_BIN_LIMIT)) goto bad_value; iov_offset = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErlIOVec)); binv_offset = iov_offset; binv_offset += ERTS_ALC_DATA_ALIGN_SIZE((vsize+1)*sizeof(SysIOVec)); alloc_size = binv_offset; - alloc_size += (vsize+1)*sizeof(ErlDrvBinary *); + alloc_size += (vsize+1)*sizeof(ErtsIOQBinary *); if (try_call && vsize < SMALL_WRITE_VEC) { - ivp = ev.iov = iv; - bvp = ev.binv = bv; + ivp = ev.common.iov = iv; + bvp = ev.common.binv = bv; evp = &ev; } else { @@ -2173,9 +1816,9 @@ erts_port_output(Process *c_p, sigdp = erts_port_task_alloc_p2p_sig_data_extra( alloc_size, (void**)&ptr); } - evp = (ErlIOVec *) ptr; - ivp = evp->iov = (SysIOVec *) (ptr + iov_offset); - bvp = evp->binv = (ErlDrvBinary **) (ptr + binv_offset); + evp = (ErtsIOVec *) ptr; + ivp = evp->driver.iov = (SysIOVec *) (ptr + iov_offset); + bvp = evp->common.binv = (ErtsIOQBinary **) (ptr + binv_offset); } /* To pack or not to pack (small binaries) ...? */ @@ -2191,23 +1834,26 @@ erts_port_output(Process *c_p, } /* Use vsize and csize from now on */ - cbin = driver_alloc_binary(csize); - if (!cbin) - erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, ERTS_SIZEOF_Binary(csize)); + if (csize) { + cbin = (ErtsIOQBinary *)driver_alloc_binary(csize); + if (!cbin) + erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, ERTS_SIZEOF_Binary(csize)); + } /* Element 0 is for driver usage to add header block */ ivp[0].iov_base = NULL; ivp[0].iov_len = 0; bvp[0] = NULL; - evp->vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit); - if (evp->vsize < 0) { + evp->driver.vsize = erts_ioq_iodata_to_vec(list, ivp+1, bvp+1, + cbin, blimit, 1); + if (evp->driver.vsize < 0) { if (evp != &ev) { if (try_call) erts_free(ERTS_ALC_T_TMP, evp); else erts_port_task_free_p2p_sig_data(sigdp); } - driver_free_binary(cbin); + driver_free_binary(&cbin->driver); goto bad_value; } #if 0 @@ -2215,19 +1861,19 @@ erts_port_output(Process *c_p, be falsified during the emulator test suites. */ ASSERT(evp->vsize == vsize); #endif - evp->vsize++; - evp->size = size; /* total size */ + evp->driver.vsize++; + evp->driver.size = size; /* total size */ if (!try_call) { int i; /* Need to increase refc on all binaries */ - for (i = 1; i < evp->vsize; i++) - if (bvp[i]) - driver_binary_inc_refc(bvp[i]); + for (i = 1; i < evp->driver.vsize; i++) + if (bvp[i]) + driver_binary_inc_refc(&bvp[i]->driver); } else { int i; - ErlIOVec *new_evp; + ErtsIOVec *new_evp; ErtsTryImmDrvCallResult try_call_res; ErtsTryImmDrvCallState try_call_state = ERTS_INIT_TRY_IMM_DRV_CALL_STATE( @@ -2250,14 +1896,14 @@ erts_port_output(Process *c_p, from, prt, drv, - evp); + &evp->driver); if (force_immediate_call) finalize_force_imm_drv_call(&try_call_state); else finalize_imm_drv_call(&try_call_state); /* Fall through... */ case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT: - driver_free_binary(cbin); + driver_free_binary(&cbin->driver); if (evp != &ev) { ASSERT(!sigdp); erts_free(ERTS_ALC_T_TMP, evp); @@ -2271,7 +1917,7 @@ erts_port_output(Process *c_p, sched_flags = try_call_state.sched_flags; if (async_nosuspend && (sched_flags & (busy_flgs|ERTS_PTS_FLG_EXIT))) { - driver_free_binary(cbin); + driver_free_binary(&cbin->driver); if (evp != &ev) { ASSERT(!sigdp); erts_free(ERTS_ALC_T_TMP, evp); @@ -2286,9 +1932,9 @@ erts_port_output(Process *c_p, } /* Need to increase refc on all binaries */ - for (i = 1; i < evp->vsize; i++) + for (i = 1; i < evp->driver.vsize; i++) if (bvp[i]) - driver_binary_inc_refc(bvp[i]); + driver_binary_inc_refc(&bvp[i]->driver); /* The port task and iovec is allocated in the same structure as an optimization. This @@ -2301,18 +1947,18 @@ erts_port_output(Process *c_p, if (evp != &ev) { /* Copy from TMP alloc to port task */ sys_memcpy((void *) new_evp, (void *) evp, alloc_size); - new_evp->iov = (SysIOVec *) (((char *) new_evp) - + iov_offset); - bvp = new_evp->binv = (ErlDrvBinary **) (((char *) new_evp) - + binv_offset); + new_evp->driver.iov = (SysIOVec *) (((char *) new_evp) + + iov_offset); + bvp = new_evp->common.binv = (ErtsIOQBinary **) (((char *) new_evp) + + binv_offset); #ifdef DEBUG - ASSERT(new_evp->vsize == evp->vsize); - ASSERT(new_evp->size == evp->size); - for (i = 0; i < evp->vsize; i++) { - ASSERT(new_evp->iov[i].iov_len == evp->iov[i].iov_len); - ASSERT(new_evp->iov[i].iov_base == evp->iov[i].iov_base); - ASSERT(new_evp->binv[i] == evp->binv[i]); + ASSERT(new_evp->driver.vsize == evp->driver.vsize); + ASSERT(new_evp->driver.size == evp->driver.size); + for (i = 0; i < evp->driver.vsize; i++) { + ASSERT(new_evp->driver.iov[i].iov_len == evp->driver.iov[i].iov_len); + ASSERT(new_evp->driver.iov[i].iov_base == evp->driver.iov[i].iov_base); + ASSERT(new_evp->driver.binv[i] == evp->driver.binv[i]); } #endif @@ -2321,24 +1967,24 @@ erts_port_output(Process *c_p, else { /* from stack allocated structure; offsets may differ */ sys_memcpy((void *) new_evp, (void *) evp, sizeof(ErlIOVec)); - new_evp->iov = (SysIOVec *) (((char *) new_evp) - + iov_offset); - sys_memcpy((void *) new_evp->iov, - (void *) evp->iov, - evp->vsize * sizeof(SysIOVec)); - new_evp->binv = (ErlDrvBinary **) (((char *) new_evp) - + binv_offset); - sys_memcpy((void *) new_evp->binv, - (void *) evp->binv, - evp->vsize * sizeof(ErlDrvBinary *)); + new_evp->driver.iov = (SysIOVec *) (((char *) new_evp) + + iov_offset); + sys_memcpy((void *) new_evp->driver.iov, + (void *) evp->driver.iov, + evp->driver.vsize * sizeof(SysIOVec)); + new_evp->common.binv = (ErtsIOQBinary **) (((char *) new_evp) + + binv_offset); + sys_memcpy((void *) new_evp->common.binv, + (void *) evp->common.binv, + evp->driver.vsize * sizeof(ErtsIOQBinary *)); #ifdef DEBUG - ASSERT(new_evp->vsize == evp->vsize); - ASSERT(new_evp->size == evp->size); - for (i = 0; i < evp->vsize; i++) { - ASSERT(new_evp->iov[i].iov_len == evp->iov[i].iov_len); - ASSERT(new_evp->iov[i].iov_base == evp->iov[i].iov_base); - ASSERT(new_evp->binv[i] == evp->binv[i]); + ASSERT(new_evp->driver.vsize == evp->driver.vsize); + ASSERT(new_evp->driver.size == evp->driver.size); + for (i = 0; i < evp->driver.vsize; i++) { + ASSERT(new_evp->driver.iov[i].iov_len == evp->driver.iov[i].iov_len); + ASSERT(new_evp->driver.iov[i].iov_base == evp->driver.iov[i].iov_base); + ASSERT(new_evp->driver.binv[i] == evp->driver.binv[i]); } #endif @@ -2349,8 +1995,8 @@ erts_port_output(Process *c_p, sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUTV; sigdp->u.outputv.from = from; - sigdp->u.outputv.evp = evp; - sigdp->u.outputv.cbinp = cbin; + sigdp->u.outputv.evp = &evp->driver; + sigdp->u.outputv.cbinp = &cbin->driver; port_sig_callback = port_sig_outputv; } else { @@ -6682,6 +6328,7 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, else erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) (hlen + len)); if (state & ERTS_PORT_SFLG_DISTRIBUTION) { + erts_atomic64_inc_nob(&prt->dist_entry->in); return erts_net_message(prt, prt->dist_entry, (byte*) hbuf, hlen, @@ -6722,6 +6369,7 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, else erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) (hlen + len)); if (state & ERTS_PORT_SFLG_DISTRIBUTION) { + erts_atomic64_inc_nob(&prt->dist_entry->in); if (len == 0) return erts_net_message(prt, prt->dist_entry, @@ -7088,307 +6736,51 @@ driver_pdl_dec_refc(ErlDrvPDL pdl) return refc; } -/* expand queue to hold n elements in tail or head */ -static int expandq(ErlIOQueue* q, int n, int tail) -/* tail: 0 if make room in head, make room in tail otherwise */ -{ - int h_sz; /* room before header */ - int t_sz; /* room after tail */ - int q_sz; /* occupied */ - int nvsz; - SysIOVec* niov; - ErlDrvBinary** nbinv; - - h_sz = q->v_head - q->v_start; - t_sz = q->v_end - q->v_tail; - q_sz = q->v_tail - q->v_head; - - if (tail && (n <= t_sz)) /* do we need to expand tail? */ - return 0; - else if (!tail && (n <= h_sz)) /* do we need to expand head? */ - return 0; - else if (n > (h_sz + t_sz)) { /* need to allocate */ - /* we may get little extra but it ok */ - nvsz = (q->v_end - q->v_start) + n; - - niov = erts_alloc_fnf(ERTS_ALC_T_IOQ, nvsz * sizeof(SysIOVec)); - if (!niov) - return -1; - nbinv = erts_alloc_fnf(ERTS_ALC_T_IOQ, nvsz * sizeof(ErlDrvBinary**)); - if (!nbinv) { - erts_free(ERTS_ALC_T_IOQ, (void *) niov); - return -1; - } - if (tail) { - sys_memcpy(niov, q->v_head, q_sz*sizeof(SysIOVec)); - if (q->v_start != q->v_small) - erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start); - q->v_start = niov; - q->v_end = niov + nvsz; - q->v_head = q->v_start; - q->v_tail = q->v_head + q_sz; - - sys_memcpy(nbinv, q->b_head, q_sz*sizeof(ErlDrvBinary*)); - if (q->b_start != q->b_small) - erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start); - q->b_start = nbinv; - q->b_end = nbinv + nvsz; - q->b_head = q->b_start; - q->b_tail = q->b_head + q_sz; - } - else { - sys_memcpy(niov+nvsz-q_sz, q->v_head, q_sz*sizeof(SysIOVec)); - if (q->v_start != q->v_small) - erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start); - q->v_start = niov; - q->v_end = niov + nvsz; - q->v_tail = q->v_end; - q->v_head = q->v_tail - q_sz; - - sys_memcpy(nbinv+nvsz-q_sz, q->b_head, q_sz*sizeof(ErlDrvBinary*)); - if (q->b_start != q->b_small) - erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start); - q->b_start = nbinv; - q->b_end = nbinv + nvsz; - q->b_tail = q->b_end; - q->b_head = q->b_tail - q_sz; - } - } - else if (tail) { /* move to beginning to make room in tail */ - sys_memmove(q->v_start, q->v_head, q_sz*sizeof(SysIOVec)); - q->v_head = q->v_start; - q->v_tail = q->v_head + q_sz; - sys_memmove(q->b_start, q->b_head, q_sz*sizeof(ErlDrvBinary*)); - q->b_head = q->b_start; - q->b_tail = q->b_head + q_sz; - } - else { /* move to end to make room */ - sys_memmove(q->v_end-q_sz, q->v_head, q_sz*sizeof(SysIOVec)); - q->v_tail = q->v_end; - q->v_head = q->v_tail-q_sz; - sys_memmove(q->b_end-q_sz, q->b_head, q_sz*sizeof(ErlDrvBinary*)); - q->b_tail = q->b_end; - q->b_head = q->b_tail-q_sz; - } - - return 0; -} - - - /* Put elements from vec at q tail */ int driver_enqv(ErlDrvPort ix, ErlIOVec* vec, ErlDrvSizeT skip) { - int n; - size_t len; - ErlDrvSizeT size; - SysIOVec* iov; - ErlDrvBinary** binv; - ErlDrvBinary* b; - ErlIOQueue* q = drvport2ioq(ix); - - if (q == NULL) - return -1; - - ASSERT(vec->size >= skip); /* debug only */ - if (vec->size <= skip) - return 0; - size = vec->size - skip; - - iov = vec->iov; - binv = vec->binv; - n = vec->vsize; - - /* we use do here to strip iov_len=0 from beginning */ - do { - len = iov->iov_len; - if (len <= skip) { - skip -= len; - iov++; - binv++; - n--; - } - else { - iov->iov_base = ((char *)(iov->iov_base)) + skip; - iov->iov_len -= skip; - skip = 0; - } - } while(skip > 0); - - if (q->v_tail + n >= q->v_end) - expandq(q, n, 1); - - /* Queue and reference all binaries (remove zero length items) */ - while(n--) { - if ((len = iov->iov_len) > 0) { - if ((b = *binv) == NULL) { /* speical case create binary ! */ - b = driver_alloc_binary(len); - sys_memcpy(b->orig_bytes, iov->iov_base, len); - *q->b_tail++ = b; - q->v_tail->iov_len = len; - q->v_tail->iov_base = b->orig_bytes; - q->v_tail++; - } - else { - driver_binary_inc_refc(b); - *q->b_tail++ = b; - *q->v_tail++ = *iov; - } - } - iov++; - binv++; - } - q->size += size; /* update total size in queue */ - return 0; + ASSERT(vec->size >= skip); + return erts_ioq_enqv(drvport2ioq(ix), (ErtsIOVec*)vec, skip); } /* Put elements from vec at q head */ int driver_pushqv(ErlDrvPort ix, ErlIOVec* vec, ErlDrvSizeT skip) { - int n; - size_t len; - ErlDrvSizeT size; - SysIOVec* iov; - ErlDrvBinary** binv; - ErlDrvBinary* b; - ErlIOQueue* q = drvport2ioq(ix); - - if (q == NULL) - return -1; - - if (vec->size <= skip) - return 0; - size = vec->size - skip; - - iov = vec->iov; - binv = vec->binv; - n = vec->vsize; - - /* we use do here to strip iov_len=0 from beginning */ - do { - len = iov->iov_len; - if (len <= skip) { - skip -= len; - iov++; - binv++; - n--; - } - else { - iov->iov_base = ((char *)(iov->iov_base)) + skip; - iov->iov_len -= skip; - skip = 0; - } - } while(skip > 0); - - if (q->v_head - n < q->v_start) - expandq(q, n, 0); - - /* Queue and reference all binaries (remove zero length items) */ - iov += (n-1); /* move to end */ - binv += (n-1); /* move to end */ - while(n--) { - if ((len = iov->iov_len) > 0) { - if ((b = *binv) == NULL) { /* speical case create binary ! */ - b = driver_alloc_binary(len); - sys_memcpy(b->orig_bytes, iov->iov_base, len); - *--q->b_head = b; - q->v_head--; - q->v_head->iov_len = len; - q->v_head->iov_base = b->orig_bytes; - } - else { - driver_binary_inc_refc(b); - *--q->b_head = b; - *--q->v_head = *iov; - } - } - iov--; - binv--; - } - q->size += size; /* update total size in queue */ - return 0; + ASSERT(vec->size >= skip); + return erts_ioq_pushqv(drvport2ioq(ix), (ErtsIOVec*)vec, skip); } - /* ** Remove size bytes from queue head ** Return number of bytes that remain in queue */ ErlDrvSizeT driver_deq(ErlDrvPort ix, ErlDrvSizeT size) { - ErlIOQueue* q = drvport2ioq(ix); - ErlDrvSizeT len; - - if ((q == NULL) || (q->size < size)) - return -1; - q->size -= size; - while (size > 0) { - ASSERT(q->v_head != q->v_tail); - - len = q->v_head->iov_len; - if (len <= size) { - size -= len; - driver_free_binary(*q->b_head); - *q->b_head++ = NULL; - q->v_head++; - } - else { - q->v_head->iov_base = ((char *)(q->v_head->iov_base)) + size; - q->v_head->iov_len -= size; - size = 0; - } - } - - /* restart pointers (optimised for enq) */ - if (q->v_head == q->v_tail) { - q->v_head = q->v_tail = q->v_start; - q->b_head = q->b_tail = q->b_start; - } - return q->size; + ErlPortIOQueue *q = drvport2ioq(ix); + if (erts_ioq_deq(q, size) == -1) + return -1; + return erts_ioq_size(q); } -ErlDrvSizeT driver_peekqv(ErlDrvPort ix, ErlIOVec *ev) { - ErlIOQueue *q = drvport2ioq(ix); - ASSERT(ev); - - if (! q) { - return (ErlDrvSizeT) -1; - } else { - if ((ev->vsize = q->v_tail - q->v_head) == 0) { - ev->size = 0; - ev->iov = NULL; - ev->binv = NULL; - } else { - ev->size = q->size; - ev->iov = q->v_head; - ev->binv = q->b_head; - } - return q->size; - } +ErlDrvSizeT driver_peekqv(ErlDrvPort ix, ErlIOVec *ev) +{ + return erts_ioq_peekqv(drvport2ioq(ix), (ErtsIOVec*)ev); } SysIOVec* driver_peekq(ErlDrvPort ix, int* vlenp) /* length of io-vector */ { - ErlIOQueue* q = drvport2ioq(ix); - - if (q == NULL) { - *vlenp = -1; - return NULL; - } - if ((*vlenp = (q->v_tail - q->v_head)) == 0) - return NULL; - return q->v_head; + return erts_ioq_peekq(drvport2ioq(ix), vlenp); } ErlDrvSizeT driver_sizeq(ErlDrvPort ix) { - ErlIOQueue* q = drvport2ioq(ix); + ErlPortIOQueue *q = drvport2ioq(ix); if (q == NULL) - return (size_t) -1; - return q->size; + return (ErlDrvSizeT) -1; + return erts_ioq_size(q); } diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab new file mode 100644 index 0000000000..bac96be7d3 --- /dev/null +++ b/erts/emulator/beam/macros.tab @@ -0,0 +1,150 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +// +// Use if there is a garbage collection before storing to a +// general destination (either X or Y register). +// + +REFRESH_GEN_DEST() { + dst_ptr = REG_TARGET_PTR(dst); +} + +FAIL(Fail) { + //| -no_prefetch + SET_I((BeamInstr *) $Fail); + Goto(*I); +} + +JUMP(Fail) { + //| -no_next + SET_I((BeamInstr *) $Fail); + Goto(*I); +} + +GC_TEST(Ns, Nh, Live) { + Uint need = $Nh + $Ns; + if (ERTS_UNLIKELY(E - HTOP < need)) { + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + } + HEAP_SPACE_VERIFIED($Nh); +} + +GC_TEST_PRESERVE(NeedHeap, Live, PreserveTerm) { + Uint need = $NeedHeap; + if (ERTS_UNLIKELY(E - HTOP < need)) { + SWAPOUT; + reg[$Live] = $PreserveTerm; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live+1, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + $PreserveTerm = reg[$Live]; + SWAPIN; + } + HEAP_SPACE_VERIFIED($Nh); +} + + +// Make sure that there are NeedStack + NeedHeap + 1 words available +// on the combined heap/stack segment, then allocates NeedHeap + 1 +// words on the stack and saves CP. +AH(NeedStack, NeedHeap, Live) { + unsigned needed = $NeedStack + 1; + $GC_TEST(needed, $NeedHeap, $Live); + E -= needed; + *E = make_cp(c_p->cp); + c_p->cp = 0; +} + +NEXT0() { + //| -no_next + SET_I((BeamInstr *) $NEXT_INSTRUCTION); + Goto(*I); +} + +NEXT(Addr) { + //| -no_next + SET_I((BeamInstr *) $Addr); + Goto(*I); +} + +FAIL_BODY() { + //| -no_prefetch + goto find_func_info; +} + +FAIL_HEAD_OR_BODY(Fail) { + //| -no_prefetch + + /* + * In a correctly working program, we expect failures in + * guards to be more likely than failures in bodies. + */ + + if (ERTS_LIKELY($Fail)) { + $FAIL($Fail); + } + goto find_func_info; +} + +BADARG(Fail) { + c_p->freason = BADARG; + $FAIL_HEAD_OR_BODY($Fail); +} + +BADARITH0() { + c_p->freason = BADARITH; + goto find_func_info; +} + +SYSTEM_LIMIT(Fail) { + c_p->freason = SYSTEM_LIMIT; + $FAIL_HEAD_OR_BODY($Fail); +} + +BIF_ERROR_ARITY_1(Fail, BIF, Op1) { + //| -no_prefetch + if (ERTS_LIKELY($Fail)) { + $FAIL($Fail); + } + reg[0] = $Op1; + SWAPOUT; + I = handle_error(c_p, I, reg, &bif_export[$BIF]->info.mfa); + goto post_error_handling; +} + +BIF_ERROR_ARITY_2(Fail, BIF, Op1, Op2) { + //| -no_prefetch + if (ERTS_LIKELY($Fail)) { + $FAIL($Fail); + } + reg[0] = $Op1; + reg[1] = $Op2; + SWAPOUT; + I = handle_error(c_p, I, reg, &bif_export[$BIF]->info.mfa); + goto post_error_handling; +} diff --git a/erts/emulator/beam/map_instrs.tab b/erts/emulator/beam/map_instrs.tab new file mode 100644 index 0000000000..bbb2f49b66 --- /dev/null +++ b/erts/emulator/beam/map_instrs.tab @@ -0,0 +1,159 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +ensure_map(Map) { + if (is_not_map($Map)) { + c_p->freason = BADMAP; + c_p->fvalue = $Map; + $FAIL_BODY(); + } +} + +new_map(Dst, Live, N) { + Eterm res; + + HEAVY_SWAPOUT; + res = new_map(c_p, reg, $Live, $N, $NEXT_INSTRUCTION); + HEAVY_SWAPIN; + $REFRESH_GEN_DEST(); + $Dst = res; + $NEXT($NEXT_INSTRUCTION+$N); +} + +i_new_small_map_lit(Dst, Live, Keys) { + Eterm res; + Uint n; + Eterm keys = $Keys; + + HEAVY_SWAPOUT; + res = new_small_map_lit(c_p, reg, keys, $Live, $NEXT_INSTRUCTION); + HEAVY_SWAPIN; + $REFRESH_GEN_DEST(); + $Dst = res; + n = arityval(*tuple_val(keys)); + $NEXT($NEXT_INSTRUCTION+n); +} + +i_get_map_element(Fail, Src, Key, Dst) { + Eterm res = get_map_element($Src, $Key); + if (is_non_value(res)) { + $FAIL($Fail); + } + $Dst = res; +} + +i_get_map_element_hash(Fail, Src, Key, Hx, Dst) { + Eterm res = get_map_element_hash($Src, $Key, $Hx); + if (is_non_value(res)) { + $FAIL($Fail); + } + $Dst = res; +} + +i_get_map_elements(Fail, Src, N) { + Eterm map; + BeamInstr *fs; + Uint sz, n; + + map = $Src; + + /* This instruction assumes Arg1 is a map, + * i.e. that it follows a test is_map if needed. + */ + + n = (Uint)$N / 3; + fs = $NEXT_INSTRUCTION; + + if (is_flatmap(map)) { + flatmap_t *mp; + Eterm *ks; + Eterm *vs; + + mp = (flatmap_t *)flatmap_val(map); + sz = flatmap_get_size(mp); + + if (sz == 0) { + $FAIL($Fail); + } + + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + + while(sz) { + if (EQ((Eterm) fs[0], *ks)) { + PUT_TERM_REG(*vs, fs[1]); + n--; + fs += 3; + /* no more values to fetch, we are done */ + if (n == 0) { + $NEXT(fs); + } + } + ks++, sz--, vs++; + } + $FAIL($Fail); + } else { + const Eterm *v; + Uint32 hx; + ASSERT(is_hashmap(map)); + while(n--) { + hx = fs[2]; + ASSERT(hx == hashmap_make_hash((Eterm)fs[0])); + if ((v = erts_hashmap_get(hx, (Eterm)fs[0], map)) == NULL) { + $FAIL($Fail); + } + PUT_TERM_REG(*v, fs[1]); + fs += 3; + } + $NEXT(fs); + } +} + +update_map_assoc(Src, Dst, Live, N) { + Eterm res; + Uint live = $Live; + + reg[live] = $Src; + HEAVY_SWAPOUT; + res = update_map_assoc(c_p, reg, live, $N, $NEXT_INSTRUCTION); + HEAVY_SWAPIN; + ASSERT(is_value(res)); + $REFRESH_GEN_DEST(); + $Dst = res; + $NEXT($NEXT_INSTRUCTION+$N); +} + +update_map_exact(Fail, Src, Dst, Live, N) { + Eterm res; + Uint live = $Live; + + reg[live] = $Src; + HEAVY_SWAPOUT; + res = update_map_exact(c_p, reg, live, $N, $NEXT_INSTRUCTION); + HEAVY_SWAPIN; + if (is_value(res)) { + $REFRESH_GEN_DEST(); + $Dst = res; + $NEXT($NEXT_INSTRUCTION+$N); + } else { + $FAIL_HEAD_OR_BODY($Fail); + } +} diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab new file mode 100644 index 0000000000..093d48c64c --- /dev/null +++ b/erts/emulator/beam/msg_instrs.tab @@ -0,0 +1,390 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +// /* +// * Skeleton for receive statement: +// * +// * recv_mark L1 Optional +// * call make_ref/monitor Optional +// * ... +// * recv_set L1 Optional +// * L1: <-------------------+ +// * <-----------+ | +// * | | +// * loop_rec L2 ------+---+ | +// * ... | | | +// * remove_message | | | +// * jump L3 | | | +// * ... | | | +// * loop_rec_end L1 --+ | | +// * L2: <---------------+ | +// * wait L1 -------------------+ or wait_timeout +// * timeout +// * +// * L3: Code after receive... +// * +// */ + +recv_mark(Dest) { + /* + * Save the current position in message buffer and the + * the label for the loop_rec/2 instruction for the + * the receive statement. + */ + c_p->msg.mark = (BeamInstr *) $Dest; + c_p->msg.saved_last = c_p->msg.last; +} + +i_recv_set() { + /* + * If the mark is valid (points to the loop_rec/2 + * instruction that follows), we know that the saved + * position points to the first message that could + * possibly be matched out. + * + * If the mark is invalid, we do nothing, meaning that + * we will look through all messages in the message queue. + */ + if (c_p->msg.mark == (BeamInstr *) ($NEXT_INSTRUCTION)) { + c_p->msg.save = c_p->msg.saved_last; + } + SET_I($NEXT_INSTRUCTION); + goto loop_rec_top__; + //| -no_next +} + +i_loop_rec(Dest) { + //| -no_prefetch + + /* + * Pick up the next message and place it in x(0). + * If no message, jump to a wait or wait_timeout instruction. + */ + + ErtsMessage* msgp; + + /* Entry point from recv_set */ + loop_rec_top__: + ; + + /* + * We need to disable GC while matching messages + * in the queue. This since messages with data outside + * the heap will be corrupted by a GC. + */ + ASSERT(!(c_p->flags & F_DELAY_GC)); + c_p->flags |= F_DELAY_GC; + + /* Entry point from loop_rec_end */ + loop_rec__: + + PROCESS_MAIN_CHK_LOCKS(c_p); + + msgp = PEEK_MESSAGE(c_p); + + if (!msgp) { + erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + /* Make sure messages wont pass exit signals... */ + if (ERTS_PROC_PENDING_EXIT(c_p)) { + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + SWAPOUT; + c_p->flags &= ~F_DELAY_GC; + c_p->arity = 0; + goto do_schedule; /* Will be rescheduled for exit */ + } + ERTS_MSGQ_MV_INQ2PRIVQ(c_p); + msgp = PEEK_MESSAGE(c_p); + if (msgp) { + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + } else { + c_p->flags &= ~F_DELAY_GC; + SET_I((BeamInstr *) $Dest); + Goto(*I); /* Jump to a wait or wait_timeout instruction */ + } + } + if (is_non_value(ERL_MESSAGE_TERM(msgp))) { + SWAPOUT; /* erts_decode_dist_message() may write to heap... */ + if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { + /* + * A corrupt distribution message that we weren't able to decode; + * remove it... + */ + /* No swapin should be needed */ + ASSERT(HTOP == c_p->htop && E == c_p->stop); + /* TODO: Add DTrace probe for this bad message situation? */ + UNLINK_MESSAGE(c_p, msgp); + msgp->next = NULL; + erts_cleanup_messages(msgp); + goto loop_rec__; + } + SWAPIN; + } + r(0) = ERL_MESSAGE_TERM(msgp); +} + +remove_message() { + //| -no_prefetch + + /* + * Remove a (matched) message from the message queue. + */ + + ErtsMessage* msgp; + PROCESS_MAIN_CHK_LOCKS(c_p); + + ERTS_CHK_MBUF_SZ(c_p); + + msgp = PEEK_MESSAGE(c_p); + + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + save_calls(c_p, &exp_receive); + } + if (ERL_MESSAGE_TOKEN(msgp) == NIL) { +#ifdef USE_VM_PROBES + if (DT_UTAG(c_p) != NIL) { + if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) { + SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag; + } else { + DT_UTAG(c_p) = NIL; + SEQ_TRACE_TOKEN(c_p) = NIL; + } + } else { +#endif + SEQ_TRACE_TOKEN(c_p) = NIL; +#ifdef USE_VM_PROBES + } + DT_UTAG_FLAGS(c_p) &= ~DT_UTAG_SPREADING; +#endif + } else if (ERL_MESSAGE_TOKEN(msgp) != am_undefined) { + Eterm msg; + SEQ_TRACE_TOKEN(c_p) = ERL_MESSAGE_TOKEN(msgp); +#ifdef USE_VM_PROBES + if (ERL_MESSAGE_TOKEN(msgp) == am_have_dt_utag) { + if (DT_UTAG(c_p) == NIL) { + DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp); + } + DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING; + } else { +#endif + ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p))); + ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5); + ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p))); + ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p))); + ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p))); + ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p))); + c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); + if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) { + c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); + } + msg = ERL_MESSAGE_TERM(msgp); + seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE, + c_p->common.id, c_p); +#ifdef USE_VM_PROBES + } +#endif + } +#ifdef USE_VM_PROBES + if (DTRACE_ENABLED(message_receive)) { + Eterm token2 = NIL; + DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); + Sint tok_label = 0; + Sint tok_lastcnt = 0; + Sint tok_serial = 0; + + dtrace_proc_str(c_p, receiver_name); + token2 = SEQ_TRACE_TOKEN(c_p); + if (have_seqtrace(token2)) { + tok_label = signed_val(SEQ_TRACE_T_LABEL(token2)); + tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2)); + tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2)); + } + DTRACE6(message_receive, + receiver_name, size_object(ERL_MESSAGE_TERM(msgp)), + c_p->msg.len - 1, tok_label, tok_lastcnt, tok_serial); + } +#endif + UNLINK_MESSAGE(c_p, msgp); + JOIN_MESSAGE(c_p); + CANCEL_TIMER(c_p); + + erts_save_message_in_proc(c_p, msgp); + c_p->flags &= ~F_DELAY_GC; + + if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) { + /* + * We want to GC soon but we leave a few + * reductions giving the message some time + * to turn into garbage. + */ + ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS); + } + + ERTS_DBG_CHK_REDS(c_p, FCALLS); + ERTS_CHK_MBUF_SZ(c_p); + + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); +} + +loop_rec_end(Dest) { + //| -no_next + /* + * Advance the save pointer to the next message (the current + * message didn't match), then jump to the loop_rec instruction. + */ + + ASSERT(c_p->flags & F_DELAY_GC); + + SET_I((BeamInstr *) $Dest); + SAVE_MESSAGE(c_p); + if (FCALLS > 0 || FCALLS > neg_o_reds) { + FCALLS--; + goto loop_rec__; + } + + c_p->flags &= ~F_DELAY_GC; + c_p->i = I; + SWAPOUT; + c_p->arity = 0; + c_p->current = NULL; + goto do_schedule; +} + +timeout_locked() { + /* + * A timeout has occurred. Reset the save pointer so that the next + * receive statement will examine the first message first. + */ + + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + $timeout(); +} + +timeout() { + if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) { + trace_receive(c_p, am_clock_service, am_timeout, NULL); + } + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + save_calls(c_p, &exp_timeout); + } + c_p->flags &= ~F_TIMO; + JOIN_MESSAGE(c_p); +} + +TIMEOUT_VALUE() { + c_p->freason = EXC_TIMEOUT_VALUE; + goto find_func_info; + //| -no_next +} + +i_wait_error_locked() { + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + $TIMEOUT_VALUE(); +} + +i_wait_error() { + $TIMEOUT_VALUE(); +} + +wait_timeout_unlocked_int := wait.lock.int.execute; +wait_timeout_locked_int := wait.int.execute; + +wait_timeout_unlocked := wait.lock.src.execute; +wait_timeout_locked := wait.src.execute; + +wait_unlocked := wait.lock.execute; +wait_locked := wait.unlocked.execute; + +wait.lock() { + erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); +} + +wait.unlocked() { +} + +wait.int(Int) { + /* + * If we have already set the timer, we must NOT set it again. Therefore, + * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. + */ + if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) { + BeamInstr** pi = (BeamInstr **) c_p->def_arg_reg; + *pi = $NEXT_INSTRUCTION; + erts_set_proc_timer_uword(c_p, $Int); + } +} + +wait.src(Src) { + /* + * If we have already set the timer, we must NOT set it again. Therefore, + * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. + */ + if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) { + Eterm timeout_value = $Src; + if (timeout_value == make_small(0)) { + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + $NEXT0(); + } else if (timeout_value == am_infinity) { + c_p->flags |= F_TIMO; + } else { + int tres = erts_set_proc_timer_term(c_p, timeout_value); + if (tres == 0) { + /* + * The timer routiner will set c_p->i to the value in + * c_p->def_arg_reg[0]. Note that it is safe to use this + * location because there are no living x registers in + * a receive statement. + */ + BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg; + *pi = $NEXT_INSTRUCTION; + } else { /* Wrong time */ + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + c_p->freason = EXC_TIMEOUT_VALUE; + goto find_func_info; + } + } + } +} + +// +// Prepare to wait indefinitely for a new message to arrive +// (or the time set above if falling through from above). +// When a new message arrives, control will be transferred +// the loop_rec instruction (at label L1). In case of +// of timeout, control will be transferred to the timeout +// instruction following the wait_timeout instruction. +// + +wait.execute(JumpTarget) { + c_p->i = (BeamInstr *) $JumpTarget; /* L1 */ + SWAPOUT; + c_p->arity = 0; + + if (!ERTS_PTMR_IS_TIMED_OUT(c_p)) { + erts_atomic32_read_band_relb(&c_p->state, + ~ERTS_PSFLG_ACTIVE); + } + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + c_p->current = NULL; + goto do_schedule; + //| -no_next +} diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index ed856b760b..d64f6f2cfc 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -59,6 +59,7 @@ put_tuple u==0 d => too_old_compiler # All the other instructions. # +%cold label L i_func_info I a a I int_code_end @@ -68,6 +69,7 @@ i_debug_breakpoint i_return_time_trace i_return_to_trace i_yield +%hot return @@ -96,22 +98,19 @@ line Loc | func_info M F A => func_info M F A | line Loc line I - -%macro: allocate Allocate -pack -%macro: allocate_zero AllocateZero -pack -%macro: allocate_heap AllocateHeap -pack -%macro: allocate_heap_zero AllocateHeapZero -pack -%macro: test_heap TestHeap -pack - allocate t t allocate_heap t I t -deallocate I + +%cold +deallocate Q +%hot + init y allocate_zero t t allocate_heap_zero t I t trim N Remaining => i_trim N -i_trim I +i_trim t test_heap I t @@ -122,8 +121,6 @@ init2 y y init3 y y y init Y1 | init Y2 | init Y3 => init3 Y1 Y2 Y3 init Y1 | init Y2 => init2 Y1 Y2 -%macro: init2 Init2 -pack -%macro: init3 Init3 -pack # Selecting values @@ -172,9 +169,8 @@ i_select_tuple_arity2 xy f A A f f i_jump_on_val_zero xy f I -i_jump_on_val xy f I I +i_jump_on_val xy f I W -%macro: get_list GetList -pack get_list xy xy xy # The following get_list instructions using x(0) are frequently used. @@ -194,31 +190,27 @@ try Y F => catch Y F try_case Y => try_end Y try_end y +%cold try_case_end s +%hot # Destructive set tuple element -set_tuple_element s d P +set_tuple_element s S P # Get tuple element -%macro: i_get_tuple_element GetTupleElement -pack i_get_tuple_element xy P x %cold i_get_tuple_element xy P y %hot -%macro: i_get_tuple_element2 GetTupleElement2 -pack i_get_tuple_element2 x P x - -%macro: i_get_tuple_element2y GetTupleElement2Y -pack i_get_tuple_element2y x P y y -%macro: i_get_tuple_element3 GetTupleElement3 -pack i_get_tuple_element3 x P x -%macro: is_number IsNumber -fail_action %cold is_number f x is_number f y @@ -229,6 +221,11 @@ is_number Fail Literal=q => move Literal x | is_number Fail x jump f +# +# Expection rasing instructions. Infrequently executed. +# + +%cold case_end NotInX=cy => move NotInX x | case_end x badmatch NotInX=cy => move NotInX x | badmatch x @@ -250,9 +247,14 @@ i_raise badarg j system_limit j +%hot + +# +# Move instructions. +# + move C=cxy x==0 | jump Lbl => move_jump Lbl C -%macro: move_jump MoveJump -nonext move_jump f ncxy # Movement to and from the stack is common @@ -276,10 +278,6 @@ move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \ move_window X1=x X2=x X3=x Y1=y Y3=y => move_window3 X1 X2 X3 Y1 move_window X1=x X2=x X3=x X4=x Y1=y Y4=y => move_window4 X1 X2 X3 X4 Y1 -%macro: move_window3 MoveWindow3 -pack -%macro: move_window4 MoveWindow4 -pack -%macro: move_window5 MoveWindow5 -pack - move_window3 x x x y move_window4 x x x x y move_window5 x x x x x y @@ -304,10 +302,8 @@ swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \ swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \ is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D -%macro: swap_temp SwapTemp -pack swap_temp x xy x -%macro: swap Swap -pack swap x xy move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2 @@ -351,17 +347,13 @@ move C=aiq X=x==2 => move_x2 C move_x1 c move_x2 c -%macro: move_shift MoveShift -pack move_shift x x x move_shift y x x move_shift x y x move_shift x x y -%macro: move_dup MoveDup -pack move_dup xy x xy -%macro: move2_par Move2Par -pack - move2_par x y x y move2_par y x y x move2_par x x x x @@ -373,7 +365,6 @@ move2_par y x x y move2_par x x y x move2_par y x x x -%macro: move3 Move3 -pack move3 x y x y x y move3 y x y x y x move3 x x x x x x @@ -383,7 +374,6 @@ move3 x x x x x x move S=n D=y => init D move S=c D=y => move S x | move x D -%macro:move Move -pack move x x move x y move y x @@ -403,13 +393,15 @@ move r y loop_rec Fail x==0 | smp_mark_target_label(Fail) => i_loop_rec Fail -label L | wait_timeout Fail Src | smp_already_locked(L) => label L | i_wait_timeout_locked Fail Src -wait_timeout Fail Src => i_wait_timeout Fail Src -i_wait_timeout Fail Src=aiq => gen_literal_timeout(Fail, Src) -i_wait_timeout_locked Fail Src=aiq => gen_literal_timeout_locked(Fail, Src) +label L | wait_timeout Fail Src | smp_already_locked(L) => \ + label L | wait_timeout_locked Src Fail +wait_timeout Fail Src => wait_timeout_unlocked Src Fail + +wait_timeout_unlocked Src=aiq Fail => gen_literal_timeout(Fail, Src) +wait_timeout_locked Src=aiq Fail => gen_literal_timeout_locked(Fail, Src) label L | wait Fail | smp_already_locked(L) => label L | wait_locked Fail -wait Fail | smp() => wait_unlocked Fail +wait Fail => wait_unlocked Fail label L | timeout | smp_already_locked(L) => label L | timeout_locked @@ -418,15 +410,19 @@ timeout timeout_locked i_loop_rec f loop_rec_end f -wait f wait_locked f wait_unlocked f -i_wait_timeout f I -i_wait_timeout f s -i_wait_timeout_locked f I -i_wait_timeout_locked f s + +# Note that a timeout value must fit in 32 bits. +wait_timeout_unlocked_int I f +wait_timeout_unlocked s f +wait_timeout_locked_int I f +wait_timeout_locked s f + +%cold i_wait_error i_wait_error_locked +%hot send @@ -440,22 +436,18 @@ is_eq_exact Lbl R=xy C=q => i_is_eq_exact_literal Lbl R C is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C -%macro: i_is_eq_exact_immed EqualImmed -fail_action - i_is_eq_exact_immed f rxy c + i_is_eq_exact_literal f xy c -%macro: i_is_ne_exact_immed NotEqualImmed -fail_action i_is_ne_exact_immed f xy c i_is_ne_exact_literal f xy c is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y -%macro: is_eq_exact EqualExact -fail_action -pack is_eq_exact f x xy is_eq_exact f s s -%macro: is_lt IsLessThan -fail_action is_lt f x x is_lt f x c is_lt f c x @@ -463,7 +455,6 @@ is_lt f c x is_lt f s s %hot -%macro: is_ge IsGreaterEqual -fail_action is_ge f x x is_ge f x c is_ge f c x @@ -471,13 +462,10 @@ is_ge f c x is_ge f s s %hot -%macro: is_ne_exact NotEqualExact -fail_action is_ne_exact f s s -%macro: is_eq Equal -fail_action is_eq f s s -%macro: is_ne NotEqual -fail_action is_ne f s s # @@ -495,7 +483,6 @@ i_put_tuple Dst Arity Puts=* | put S => \ i_put_tuple/2 -%macro:i_put_tuple PutTuple -pack -goto:do_put_tuple i_put_tuple xy I # @@ -505,8 +492,6 @@ i_put_tuple xy I # put_list Const=c n Dst => move Const x | put_list x n Dst -%macro:put_list PutList -pack - put_list x n x put_list y n x put_list x x x @@ -547,6 +532,7 @@ put_list s s d # Some more only used by the emulator # +%cold normal_exit continue_exit apply_bif @@ -554,6 +540,7 @@ call_nif call_error_handler error_action_code return_trace +%hot # # Instruction transformations & folded instructions. @@ -564,22 +551,18 @@ return_trace move S x==0 | return => move_return S -%macro: move_return MoveReturn -nonext move_return xcn move S x==0 | deallocate D | return => move_deallocate_return S D -%macro: move_deallocate_return MoveDeallocateReturn -pack -nonext move_deallocate_return xycn Q deallocate D | return => deallocate_return D -%macro: deallocate_return DeallocateReturn -nonext deallocate_return Q test_heap Need u==1 | put_list Y=y x==0 x==0 => test_heap_1_put_list Need Y -%macro: test_heap_1_put_list TestHeapPutList -pack test_heap_1_put_list I y # @@ -590,8 +573,6 @@ is_tagged_tuple Fail Literal=q Arity Atom => \ move Literal x | is_tagged_tuple Fail x Arity Atom is_tagged_tuple Fail=f c Arity Atom => jump Fail -%macro:is_tagged_tuple IsTaggedTuple -fail_action - is_tagged_tuple f rxy A a # Test tuple & arity (head) @@ -600,17 +581,13 @@ is_tuple Fail Literal=q => move Literal x | is_tuple Fail x is_tuple Fail=f c => jump Fail is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S Arity -%macro:is_tuple_of_arity IsTupleOfArity -fail_action - is_tuple_of_arity f rxy A -%macro: is_tuple IsTuple -fail_action is_tuple f rxy test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity test_arity Fail=f c Arity => jump Fail -%macro: test_arity IsArity -fail_action test_arity f xy A get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ @@ -632,16 +609,13 @@ is_integer Fail Literal=q => move Literal x | is_integer Fail x is_integer Fail=f S=x | allocate Need Regs => is_integer_allocate Fail S Need Regs -%macro: is_integer_allocate IsIntegerAllocate -fail_action -is_integer_allocate f x I I +is_integer_allocate f x t t -%macro: is_integer IsInteger -fail_action is_integer f xy is_list Fail=f n => is_list Fail Literal=q => move Literal x | is_list Fail x is_list Fail=f c => jump Fail -%macro: is_list IsList -fail_action is_list f x %cold is_list f y @@ -649,24 +623,16 @@ is_list f y is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs -%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack -is_nonempty_list_allocate f rx I t - -is_nonempty_list F=f x==0 | test_heap I1 I2 => is_non_empty_list_test_heap F I1 I2 - -%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack -is_non_empty_list_test_heap f I t +is_nonempty_list F=f x==0 | test_heap I1 I2 => is_nonempty_list_test_heap F I1 I2 is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \ is_nonempty_list_get_list Fail S D1 D2 -%macro: is_nonempty_list_get_list IsNonemptyListGetList -fail_action -pack +is_nonempty_list_allocate f rx t t +is_nonempty_list_test_heap f I t is_nonempty_list_get_list f rx x x - -%macro: is_nonempty_list IsNonemptyList -fail_action is_nonempty_list f xy -%macro: is_atom IsAtom -fail_action is_atom f x %cold is_atom f y @@ -674,7 +640,6 @@ is_atom f y is_atom Fail=f a => is_atom Fail=f niq => jump Fail -%macro: is_float IsFloat -fail_action is_float f x %cold is_float f y @@ -685,12 +650,10 @@ is_float Fail Literal=q => move Literal x | is_float Fail x is_nil Fail=f n => is_nil Fail=f qia => jump Fail -%macro: is_nil IsNil -fail_action is_nil f xy is_binary Fail Literal=q => move Literal x | is_binary Fail x is_binary Fail=f c => jump Fail -%macro: is_binary IsBinary -fail_action is_binary f x %cold is_binary f y @@ -701,28 +664,24 @@ is_bitstr Fail Term => is_bitstring Fail Term is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x is_bitstring Fail=f c => jump Fail -%macro: is_bitstring IsBitstring -fail_action is_bitstring f x %cold is_bitstring f y %hot is_reference Fail=f cq => jump Fail -%macro: is_reference IsRef -fail_action is_reference f x %cold is_reference f y %hot is_pid Fail=f cq => jump Fail -%macro: is_pid IsPid -fail_action is_pid f x %cold is_pid f y %hot is_port Fail=f cq => jump Fail -%macro: is_port IsPort -fail_action is_port f x %cold is_port f y @@ -733,7 +692,6 @@ is_boolean Fail=f a==am_false => is_boolean Fail=f ac => jump Fail %cold -%macro: is_boolean IsBoolean -fail_action is_boolean f xy %hot @@ -741,14 +699,12 @@ is_function2 Fail=f acq Arity => jump Fail is_function2 Fail=f Fun a => jump Fail is_function2 f s s -%macro: is_function2 IsFunction2 -fail_action # Allocating & initializing. allocate Need Regs | init Y => allocate_init Need Regs Y init Y1 | init Y2 => init2 Y1 Y2 -%macro: allocate_init AllocateInit -pack -allocate_init t I y +allocate_init t t y ################################################################# # External function and bif calls. @@ -1002,9 +958,11 @@ i_apply_fun i_apply_fun_last P i_apply_fun_only +%cold i_hibernate i_perf_counter +%hot call_bif e @@ -1027,19 +985,18 @@ bif2 Fail Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst i_get_hash c I d i_get s d -%macro: self Self self xy -%macro: node Node node x %cold node y %hot -i_fast_element j x I d -i_fast_element j y I d +# Note: 'I' is sufficient because this instruction will only be used +# if the arity fits in 24 bits. +i_fast_element xy j I d -i_element j xy s d +i_element xy j s d bif1 f b s d bif1_body b s d @@ -1050,50 +1007,35 @@ i_bif2_body b s s d # Internal calls. # -move S=c x==0 | call Ar P=f => i_move_call S P -move S=s x==0 | call Ar P=f => move_call S P - -i_move_call c f +move S=cxy x==0 | call Ar P=f => move_call S P -%macro:move_call MoveCall -arg_f -size -nonext move_call/2 +move_call cxy f -move_call xy f - -move S=c x==0 | call_last Ar P=f D => i_move_call_last P D S move S x==0 | call_last Ar P=f D => move_call_last S P D -i_move_call_last f P c - -%macro:move_call_last MoveCallLast -arg_f -nonext -pack - move_call_last/3 -move_call_last xy f Q +move_call_last cxy f Q -move S=c x==0 | call_only Ar P=f => i_move_call_only P S -move S=x x==0 | call_only Ar P=f => move_call_only S P +move S=cx x==0 | call_only Ar P=f => move_call_only S P -i_move_call_only f c - -%macro:move_call_only MoveCallOnly -arg_f -nonext move_call_only/2 - -move_call_only x f +move_call_only cx f call Ar Func => i_call Func call_last Ar Func D => i_call_last Func D call_only Ar Func => i_call_only Func i_call f -i_call_last f P +i_call_last f Q i_call_only f i_call_ext e -i_call_ext_last e P +i_call_ext_last e Q i_call_ext_only e i_move_call_ext c e -i_move_call_ext_last e P c +i_move_call_ext_last e Q c i_move_call_ext_only e c # Fun calls. @@ -1101,17 +1043,15 @@ i_move_call_ext_only e c call_fun Arity | deallocate D | return => i_call_fun_last Arity D call_fun Arity => i_call_fun Arity -i_call_fun I -i_call_fun_last I P +i_call_fun t +i_call_fun_last t Q make_fun2 OldIndex=u => gen_make_fun2(OldIndex) -%macro: i_make_fun MakeFun -pack %cold -i_make_fun I t +i_make_fun W t %hot -%macro: is_function IsFunction -fail_action is_function f xy is_function Fail=f c => jump Fail @@ -1121,7 +1061,7 @@ func_info M F A => i_func_info u M F A # New bit syntax matching (R11B). # ================================================================ -%cold +%warm bs_start_match2 Fail=f ica X Y D => jump Fail bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D i_bs_start_match2 xy f I I x @@ -1135,28 +1075,27 @@ i_bs_restore2 x I # Matching integers bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val -i_bs_match_string x f I I +i_bs_match_string x f W W # Fetching integers from binaries. bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -i_bs_get_integer_small_imm x I f I x -i_bs_get_integer_imm x I I f I x +i_bs_get_integer_small_imm x W f t x +i_bs_get_integer_imm x W t f t x i_bs_get_integer f I I s s x i_bs_get_integer_8 x f x i_bs_get_integer_16 x f x -i_bs_get_integer_32 x f I x + +%if ARCH_64 +i_bs_get_integer_32 x f x +%endif # Fetching binaries from binaries. bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -%macro: i_bs_get_binary_imm2 BsGetBinaryImm_2 -fail_action -%macro: i_bs_get_binary2 BsGetBinary_2 -fail_action -%macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action - -i_bs_get_binary_imm2 f x I I I x +i_bs_get_binary_imm2 f x t W t x i_bs_get_binary2 f x I s I x i_bs_get_binary_all2 f x I I x i_bs_get_binary_all_reuse x f I @@ -1167,7 +1106,6 @@ bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail -%macro: i_bs_get_float2 BsGetFloat2 -fail_action i_bs_get_float2 f x I s I x # Miscellanous @@ -1175,19 +1113,14 @@ i_bs_get_float2 f x I s I x bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \ gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) -%macro: i_bs_skip_bits_imm2 BsSkipBitsImm2 -fail_action -i_bs_skip_bits_imm2 f x I - -%macro: i_bs_skip_bits2 BsSkipBits2 -fail_action +i_bs_skip_bits_imm2 f x W i_bs_skip_bits2 f x xy I - -%macro: i_bs_skip_bits_all2 BsSkipBitsAll2 -fail_action -i_bs_skip_bits_all2 f x I +i_bs_skip_bits_all2 f x I bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits bs_test_zero_tail2 f x -bs_test_tail_imm2 f x I +bs_test_tail_imm2 f x W bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms bs_test_unit f x I @@ -1226,16 +1159,12 @@ i_bs_validate_unicode_retract j s s # # Constructing binaries # -%cold +%warm bs_init2 Fail Sz Words Regs Flags Dst | binary_too_big(Sz) => system_limit Fail -bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst | should_gen_heap_bin(Sz) => \ - i_bs_init_heap_bin Sz Regs Dst bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst => i_bs_init Sz Regs Dst -bs_init2 Fail Sz=u Words Regs Flags Dst | should_gen_heap_bin(Sz) => \ - i_bs_init_heap_bin_heap Sz Words Regs Dst bs_init2 Fail Sz=u Words Regs Flags Dst => \ i_bs_init_heap Sz Words Regs Dst @@ -1244,15 +1173,13 @@ bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \ bs_init2 Fail Sz Words Regs Flags Dst => \ i_bs_init_fail_heap Sz Words Fail Regs Dst -i_bs_init_fail xy j I x +i_bs_init_fail xy j t x -i_bs_init_fail_heap s I j I x +i_bs_init_fail_heap s I j t x -i_bs_init I I x -i_bs_init_heap_bin I I x +i_bs_init W t x -i_bs_init_heap I I I x -i_bs_init_heap_bin_heap I I I x +i_bs_init_heap W I t x bs_init_bits Fail Sz=o Words Regs Flags Dst => system_limit Fail @@ -1265,16 +1192,16 @@ bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \ bs_init_bits Fail Sz Words Regs Flags Dst => \ i_bs_init_bits_fail_heap Sz Words Fail Regs Dst -i_bs_init_bits_fail xy j I x +i_bs_init_bits_fail xy j t x -i_bs_init_bits_fail_heap s I j I x +i_bs_init_bits_fail_heap s I j t x -i_bs_init_bits I I x -i_bs_init_bits_heap I I I x +i_bs_init_bits W t x +i_bs_init_bits_heap W I t x bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D -bs_add j s s I x +bs_add j s s t x bs_append Fail Size Extra Live Unit Bin Flags Dst => \ move Bin x | i_bs_append Fail Extra Live Unit Size Dst @@ -1284,8 +1211,8 @@ bs_private_append Fail Size Unit Bin Flags Dst => \ bs_init_writable -i_bs_append j I I I s x -i_bs_private_append j I s s x +i_bs_append j I t t s x +i_bs_private_append j t s s x # # Storing integers into binaries. @@ -1294,11 +1221,8 @@ i_bs_private_append j I s s x bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \ gen_put_integer(Fail, Sz, Unit, Flags, Src) -%macro: i_new_bs_put_integer NewBsPutInteger -%macro: i_new_bs_put_integer_imm NewBsPutIntegerImm - -i_new_bs_put_integer j s I s -i_new_bs_put_integer_imm j I I s +i_new_bs_put_integer j s t s +i_new_bs_put_integer_imm j W t s # # Utf8/utf16/utf32 support. (R12B-5) @@ -1316,7 +1240,7 @@ bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s -bs_put_utf16 j I s +bs_put_utf16 j t s bs_put_utf32 Fail=j Flags=u Src=s => \ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src @@ -1331,11 +1255,8 @@ bs_put_float Fail Sz=q Unit Flags Val => badarg Fail bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_float(Fail, Sz, Unit, Flags, Src) -%macro: i_new_bs_put_float NewBsPutFloat -%macro: i_new_bs_put_float_imm NewBsPutFloatImm - -i_new_bs_put_float j s I s -i_new_bs_put_float_imm j I I s +i_new_bs_put_float j s t s +i_new_bs_put_float_imm j W t s # # Storing binaries into binaries. @@ -1344,14 +1265,9 @@ i_new_bs_put_float_imm j I I s bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_binary(Fail, Sz, Unit, Flags, Src) -%macro: i_new_bs_put_binary NewBsPutBinary -i_new_bs_put_binary j s I s - -%macro: i_new_bs_put_binary_imm NewBsPutBinaryImm -i_new_bs_put_binary_imm j I s - -%macro: i_new_bs_put_binary_all NewBsPutBinaryAll -i_new_bs_put_binary_all j s I +i_new_bs_put_binary j s t s +i_new_bs_put_binary_imm j W s +i_new_bs_put_binary_all j s t # # Warning: The i_bs_put_string and i_new_bs_put_string instructions @@ -1359,9 +1275,7 @@ i_new_bs_put_binary_all j s I # Don't change the instruction format unless you change the loader too. # -bs_put_string I I - -%hot +bs_put_string W W # # New floating point instructions (R8). @@ -1375,11 +1289,13 @@ fnegate p FR1 FR2 => i_fnegate FR1 FR2 fconv Arg=iqan Dst=l => move Arg x | fconv x Dst -fmove q l -fmove d l -fmove l d +fmove Arg=l Dst=d => fstore Arg Dst +fmove Arg=dq Dst=l => fload Arg Dst + +fstore l d +fload Sq l -fconv d l +fconv S l i_fadd l l l i_fsub l l l @@ -1389,36 +1305,70 @@ i_fnegate l l fclearerror | no_fpe_signals() => fcheckerror p | no_fpe_signals() => + +%unless NO_FPE_SIGNALS fcheckerror p => i_fcheckerror i_fcheckerror fclearerror +%endif + +%hot # # New apply instructions in R10B. # -apply I -apply_last I P +apply t +apply_last t Q + +# +# Handle compatibility with OTP 17 here. +# + +i_put_map_assoc/4 + +# We KNOW that in OTP 20 (actually OTP 18 and higher), a put_map_assoc instruction +# is always preceded by an is_map test. That means that put_map_assoc can never +# fail and does not need any failure label. + +put_map_assoc Fail Map Dst Live Size Rest=* | compiled_with_otp_20_or_higher() => \ + i_put_map_assoc Map Dst Live Size Rest + +# Translate the put_map_assoc instruction if the module was compiled by a compiler +# before 20. This is only necessary if the OTP 17 compiler was used, but we +# have no safe and relatively easy way to know whether OTP 18/19 was used. + +put_map_assoc Fail=p Map Dst Live Size Rest=* => \ + ensure_map Map | i_put_map_assoc Map Dst Live Size Rest +put_map_assoc Fail=f Map Dst Live Size Rest=* => \ + is_map Fail Map | i_put_map_assoc Map Dst Live Size Rest + +ensure_map Lit=q | literal_is_map(Lit) => +ensure_map Src=cqy => move Src x | ensure_map x + +%cold +ensure_map x +%hot # -# Map instructions in R17. +# Map instructions. First introduced in R17. # -sorted_put_map_assoc/5 -put_map_assoc F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \ - sorted_put_map_assoc F Map Dst Live Size Rest +sorted_put_map_assoc/4 +i_put_map_assoc Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \ + sorted_put_map_assoc Map Dst Live Size Rest sorted_put_map_exact/5 put_map_exact F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \ sorted_put_map_exact F Map Dst Live Size Rest -sorted_put_map_assoc j Map Dst Live Size Rest=* | is_empty_map(Map) => \ +sorted_put_map_assoc Map Dst Live Size Rest=* | is_empty_map(Map) => \ new_map Dst Live Size Rest -sorted_put_map_assoc F Src=s Dst Live Size Rest=* => \ - update_map_assoc F Src Dst Live Size Rest -sorted_put_map_assoc F Src Dst Live Size Rest=* => \ - move Src x | update_map_assoc F x Dst Live Size Rest +sorted_put_map_assoc Src=s Dst Live Size Rest=* => \ + update_map_assoc Src Dst Live Size Rest +sorted_put_map_assoc Src Dst Live Size Rest=* => \ + move Src x | update_map_assoc x Dst Live Size Rest sorted_put_map_exact F Src=s Dst Live Size Rest=* => \ update_map_exact F Src Dst Live Size Rest @@ -1428,15 +1378,14 @@ sorted_put_map_exact F Src Dst Live Size Rest=* => \ new_map Dst Live Size Rest=* | is_small_map_literal_keys(Size, Rest) => \ gen_new_small_map_lit(Dst, Live, Size, Rest) -new_map d I I -i_new_small_map_lit d I q -update_map_assoc j s d I I -update_map_exact j s d I I +new_map d t I +i_new_small_map_lit d t q +update_map_assoc s d t I +update_map_exact j s d t I is_map Fail Lit=q | literal_is_map(Lit) => is_map Fail cq => jump Fail -%macro: is_map IsMap -fail_action is_map f xy ## Transform has_map_fields #{ K1 := _, K2 := _ } to has_map_elements @@ -1456,10 +1405,8 @@ i_get_map_elements f s I i_get_map_element Fail Src=xy Key=y Dst => \ move Key x | i_get_map_element Fail Src x Dst -%macro: i_get_map_element_hash GetMapElementHash -fail_action i_get_map_element_hash f xy c I xy -%macro: i_get_map_element GetMapElement -fail_action i_get_map_element f xy x xy # @@ -1495,9 +1442,9 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ # GCing arithmetic instructions. # -gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst +gen_plus Fail Live S1 S2 Dst => i_plus S1 S2 Fail Live Dst -gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst +gen_minus Fail Live S1 S2 Dst => i_minus S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:stimes/2 S1 S2 Dst => \ i_times Fail Live S1 S2 Dst @@ -1508,15 +1455,15 @@ gc_bif2 Fail Live u$bif:erlang:intdiv/2 S1 S2 Dst => \ i_int_div Fail Live S1 S2 Dst gc_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \ - i_rem Fail Live S1 S2 Dst + i_rem S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:bsl/2 S1 S2 Dst => \ - i_bsl Fail Live S1 S2 Dst + i_bsl S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:bsr/2 S1 S2 Dst => \ - i_bsr Fail Live S1 S2 Dst + i_bsr S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:band/2 S1 S2 Dst => \ - i_band Fail Live S1 S2 Dst + i_band S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:bor/2 S1 S2 Dst => \ i_bor Fail Live S1 S2 Dst @@ -1526,32 +1473,32 @@ gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \ gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst -i_increment rxy I I d +i_increment rxy W t d -i_plus j I x xy d -i_plus j I s s d +i_plus x xy j t d +i_plus s s j t d -i_minus j I x x d -i_minus j I s s d +i_minus x x j t d +i_minus s s j t d -i_times j I s s d +i_times j t s s d -i_m_div j I s s d -i_int_div j I s s d +i_m_div j t s s d +i_int_div j t s s d -i_rem j I x x d -i_rem j I s s d +i_rem x x j t d +i_rem s s j t d -i_bsl j I s s d -i_bsr j I s s d +i_bsl s s j t d +i_bsr s s j t d -i_band j I x c d -i_band j I s s d +i_band x c j t d +i_band s s j t d i_bor j I s s d i_bxor j I s s d -i_int_bnot j s I d +i_int_bnot j s t d # # Old guard BIFs that creates heap fragments are no longer allowed. @@ -1575,9 +1522,9 @@ gc_bif2 Fail I Bif S1 S2 Dst => \ gc_bif3 Fail I Bif S1 S2 S3 Dst => \ gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) -i_gc_bif1 j I s I d +i_gc_bif1 j W s t d -i_gc_bif2 j I I s s d +i_gc_bif2 j W t s s d ii_gc_bif3/7 @@ -1586,7 +1533,7 @@ ii_gc_bif3/7 ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \ move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst -i_gc_bif3 j I I s s d +i_gc_bif3 j W t s s d # # The following instruction is specially handled in beam_load.c diff --git a/erts/emulator/beam/select_instrs.tab b/erts/emulator/beam/select_instrs.tab new file mode 100644 index 0000000000..e85ed2c304 --- /dev/null +++ b/erts/emulator/beam/select_instrs.tab @@ -0,0 +1,196 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +i_select_val_bins := select_val_bins.fetch.select; + +select_val_bins.head() { + Eterm select_val; +} + +select_val_bins.fetch(Src) { + select_val = $Src; +} + +select_val_bins.select(Fail, NumElements) { + struct Pairs { + BeamInstr val; + BeamInstr* addr; + }; + struct Pairs* low; + struct Pairs* high; + struct Pairs* mid; + int bdiff; /* int not long because the arrays aren't that large */ + + low = (struct Pairs *) (&$NumElements + 1); + high = low + $NumElements; + + /* The pointer subtraction (high-low) below must produce + * a signed result, because high could be < low. That + * requires the compiler to insert quite a bit of code. + * + * However, high will be > low so the result will be + * positive. We can use that knowledge to optimise the + * entire sequence, from the initial comparison to the + * computation of mid. + * + * -- Mikael Pettersson, Acumem AB + * + * Original loop control code: + * + * while (low < high) { + * mid = low + (high-low) / 2; + * + */ + while ((bdiff = (int)((char*)high - (char*)low)) > 0) { + unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Pairs)-1); + + mid = (struct Pairs*)((char*)low + boffset); + if (select_val < mid->val) { + high = mid; + } else if (select_val > mid->val) { + low = mid + 1; + } else { + $NEXT(mid->addr); + } + } + $NEXT($Fail); +} + +i_select_tuple_arity2 := select_val2.src.ta_fail.execute; +i_select_val2 := select_val2.src.fail.execute; + +select_val2.head() { + Eterm select_val2; + BeamInstr* select_fail; +} + +select_val2.src(Src) { + select_val2 = $Src; +} + +select_val2.ta_fail(Fail) { + select_fail = &$Fail; + if (is_not_tuple(select_val2)) { + $FAIL(*select_fail); + } + select_val2 = *tuple_val(select_val2); +} + +select_val2.fail(Fail) { + select_fail = &$Fail; +} + +select_val2.execute(T1, T2, D1, D2) { + if (select_val2 == $T1) { + $JUMP($D1); + } else if (select_val2 == $T2) { + $JUMP($D2); + } else { + $FAIL(*select_fail); + } +} + +i_select_tuple_arity := select_val_lin.fetch.ta_fail.execute; +i_select_val_lins := select_val_lin.fetch.fail.execute; + +select_val_lin.head() { + Eterm select_val; + BeamInstr* select_fail; +} + +select_val_lin.fetch(Src) { + select_val = $Src; +} + +select_val_lin.ta_fail(Fail) { + select_fail = &$Fail; + if (is_tuple(select_val)) { + select_val = *tuple_val(select_val); + } else { + $JUMP(*select_fail); + } +} + +select_val_lin.fail(Fail) { + select_fail = &$Fail; +} + +select_val_lin.execute(N) { + BeamInstr* vs = $NEXT_INSTRUCTION; + int ix = 0; + + for (;;) { + if (vs[ix+0] >= select_val) { + ix += 0; + break; + } + if (vs[ix+1] >= select_val) { + ix += 1; + break; + } + ix += 2; + } + + if (vs[ix] == select_val) { + I = $NEXT_INSTRUCTION + $N + ix; + $JUMP(*I); + } else { + $JUMP(*select_fail); + } +} + +JUMP_ON_VAL(Fail, Index, N, Base) { + if (is_small($Index)) { + $Index = (Uint) (signed_val($Index) - $Base); + if ($Index < $N) { + $JUMP((($NEXT_INSTRUCTION)[$Index])); + } + } + $FAIL($Fail); +} + +i_jump_on_val_zero := jump_on_val_zero.fetch.execute; + +jump_on_val_zero.head() { + Eterm index; +} + +jump_on_val_zero.fetch(Src) { + index = $Src; +} + +jump_on_val_zero.execute(Fail, N) { + $JUMP_ON_VAL($Fail, index, $N, 0); +} + +i_jump_on_val := jump_on_val.fetch.execute; + +jump_on_val.head() { + Eterm index; +} + +jump_on_val.fetch(Src) { + index = $Src; +} + +jump_on_val.execute(Fail, N, Base) { + $JUMP_ON_VAL($Fail, index, $N, $Base); +} diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 615f44364b..68ef0a23f3 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -757,10 +757,6 @@ Preload* sys_preloaded(void); unsigned char* sys_preload_begin(Preload*); void sys_preload_end(Preload*); int sys_get_key(int); -void elapsed_time_both(ErtsMonotonicTime *ms_user, ErtsMonotonicTime *ms_sys, - ErtsMonotonicTime *ms_user_diff, ErtsMonotonicTime *ms_sys_diff); -void wall_clock_elapsed_time_both(ErtsMonotonicTime *ms_total, - ErtsMonotonicTime *ms_diff); void get_time(int *hour, int *minute, int *second); void get_date(int *year, int *month, int *day); void get_localtime(int *year, int *month, int *day, @@ -1109,6 +1105,14 @@ void erl_bin_write(unsigned char *, int, int); # define DEBUGF(x) #endif +#ifndef MAX +#define MAX(A, B) ((A) > (B) ? (A) : (B)) +#endif + +#ifndef MIN +#define MIN(A, B) ((A) < (B) ? (A) : (B)) +#endif + #ifdef __WIN32__ #ifdef ARCH_64 #define ERTS_ALLOC_ALIGN_BYTES 16 diff --git a/erts/emulator/beam/trace_instrs.tab b/erts/emulator/beam/trace_instrs.tab new file mode 100644 index 0000000000..c71f2ef003 --- /dev/null +++ b/erts/emulator/beam/trace_instrs.tab @@ -0,0 +1,155 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +return_trace() { + ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[0]); + + SWAPOUT; /* Needed for shared heap */ + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + SWAPIN; + c_p->cp = NULL; + SET_I((BeamInstr *) cp_val(E[2])); + E += 3; + Goto(*I); + //| -no_next +} + +i_generic_breakpoint() { + BeamInstr real_I; + HEAVY_SWAPOUT; + real_I = erts_generic_breakpoint(c_p, erts_code_to_codeinfo(I), reg); + HEAVY_SWAPIN; + ASSERT(VALID_INSTR(real_I)); + Goto(real_I); + //| -no_next +} + +i_return_time_trace() { + BeamInstr *pc = (BeamInstr *) (UWord) E[0]; + SWAPOUT; + erts_trace_time_return(c_p, erts_code_to_codeinfo(pc)); + SWAPIN; + c_p->cp = NULL; + SET_I((BeamInstr *) cp_val(E[1])); + E += 2; + Goto(*I); + //| -no_next +} + +i_return_to_trace() { + if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) { + Uint *cpp = (Uint*) E; + for(;;) { + ASSERT(is_CP(*cpp)); + if (*cp_val(*cpp) == (BeamInstr) OpCode(return_trace)) { + do + ++cpp; + while (is_not_CP(*cpp)); + cpp += 2; + } else if (*cp_val(*cpp) == (BeamInstr) OpCode(i_return_to_trace)) { + do + ++cpp; + while (is_not_CP(*cpp)); + } else { + break; + } + } + SWAPOUT; /* Needed for shared heap */ + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + erts_trace_return_to(c_p, cp_val(*cpp)); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + SWAPIN; + } + c_p->cp = NULL; + SET_I((BeamInstr *) cp_val(E[0])); + E += 1; + Goto(*I); + //| -no_next +} + +i_yield() { + /* This is safe as long as REDS_IN(c_p) is never stored + * in c_p->arg_reg[0]. It is currently stored in c_p->def_arg_reg[5]. + */ + c_p->arg_reg[0] = am_true; + c_p->arity = 1; /* One living register (the 'true' return value) */ + SWAPOUT; + c_p->i = $NEXT_INSTRUCTION; + c_p->current = NULL; + goto do_schedule; + //| -no_next +} + +i_hibernate() { + HEAVY_SWAPOUT; + if (erts_hibernate(c_p, reg)) { + FCALLS = c_p->fcalls; + c_p->flags &= ~F_HIBERNATE_SCHED; + goto do_schedule; + } else { + HEAVY_SWAPIN; + I = handle_error(c_p, I, reg, &bif_export[BIF_hibernate_3]->info.mfa); + goto post_error_handling; + } + //| -no_next +} + +// This is optimised as an instruction because +// it has to be very very fast. + +i_perf_counter() { + ErtsSysPerfCounter ts; + + ts = erts_sys_perf_counter(); + if (IS_SSMALL(ts)) { + r(0) = make_small((Sint)ts); + } else { + $GC_TEST(0, ERTS_SINT64_HEAP_SIZE(ts), 0); + r(0) = make_big(HTOP); +#if defined(ARCH_32) + if (ts >= (((Uint64) 1) << 32)) { + *HTOP = make_pos_bignum_header(2); + BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff)); + BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff)); + HTOP += 3; + } + else +#endif + { + *HTOP = make_pos_bignum_header(1); + BIG_DIGIT(HTOP, 0) = (Uint) ts; + HTOP += 2; + } + } +} + +i_debug_breakpoint() { + HEAVY_SWAPOUT; + I = call_error_handler(c_p, erts_code_to_codemfa(I), reg, am_breakpoint); + HEAVY_SWAPIN; + if (I) { + Goto(*I); + } + goto handle_error; + //| -no_next +} diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index dcb1468d60..993585be10 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -51,6 +51,7 @@ #include "erl_ptab.h" #include "erl_check_io.h" #include "erl_bif_unique.h" +#include "erl_io_queue.h" #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" #ifdef HIPE @@ -3605,13 +3606,78 @@ intlist_to_buf(Eterm list, char *buf, Sint len) return -2; /* not enough space */ } -/* Fill buf with the contents of the unicode list. - * Return the number of bytes in the buffer, - * or -1 for type error, - * or -2 for not enough buffer space (buffer contains truncated result). +/** @brief Fill buf with the UTF8 contents of the unicode list + * @param len Max number of characters to write. + * @param written NULL or bytes written. + * @return 0 ok, + * -1 type error, + * -2 list too long, only \c len characters written */ +int +erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len, Sint* written) +{ + Eterm* listptr; + Sint sz = 0; + Sint val; + int res; + + while (1) { + if (is_nil(list)) { + res = 0; + break; + } + if (is_not_list(list)) { + res = -1; + break; + } + listptr = list_val(list); + + if (len-- <= 0) { + res = -2; + break; + } + + if (is_not_small(CAR(listptr))) { + res = -1; + break; + } + val = signed_val(CAR(listptr)); + if (0 <= val && val < 0x80) { + buf[sz] = val; + sz++; + } else if (val < 0x800) { + buf[sz+0] = 0xC0 | (val >> 6); + buf[sz+1] = 0x80 | (val & 0x3F); + sz += 2; + } else if (val < 0x10000UL) { + if (0xD800 <= val && val <= 0xDFFF) { + res = -1; + break; + } + buf[sz+0] = 0xE0 | (val >> 12); + buf[sz+1] = 0x80 | ((val >> 6) & 0x3F); + buf[sz+2] = 0x80 | (val & 0x3F); + sz += 3; + } else if (val < 0x110000) { + buf[sz+0] = 0xF0 | (val >> 18); + buf[sz+1] = 0x80 | ((val >> 12) & 0x3F); + buf[sz+2] = 0x80 | ((val >> 6) & 0x3F); + buf[sz+3] = 0x80 | (val & 0x3F); + sz += 4; + } else { + res = -1; + break; + } + list = CDR(listptr); + } + + if (written) + *written = sz; + return res; +} + Sint -erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len) +erts_unicode_list_to_buf_len(Eterm list) { Eterm* listptr; Sint sz = 0; @@ -3624,7 +3690,7 @@ erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len) } listptr = list_val(list); - while (len-- > 0) { + while (1) { Sint val; if (is_not_small(CAR(listptr))) { @@ -3632,25 +3698,15 @@ erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len) } val = signed_val(CAR(listptr)); if (0 <= val && val < 0x80) { - buf[sz] = val; sz++; } else if (val < 0x800) { - buf[sz+0] = 0xC0 | (val >> 6); - buf[sz+1] = 0x80 | (val & 0x3F); sz += 2; } else if (val < 0x10000UL) { if (0xD800 <= val && val <= 0xDFFF) { return -1; } - buf[sz+0] = 0xE0 | (val >> 12); - buf[sz+1] = 0x80 | ((val >> 6) & 0x3F); - buf[sz+2] = 0x80 | (val & 0x3F); sz += 3; } else if (val < 0x110000) { - buf[sz+0] = 0xF0 | (val >> 18); - buf[sz+1] = 0x80 | ((val >> 12) & 0x3F); - buf[sz+2] = 0x80 | ((val >> 6) & 0x3F); - buf[sz+3] = 0x80 | (val & 0x3F); sz += 4; } else { return -1; @@ -3664,7 +3720,6 @@ erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len) } listptr = list_val(list); } - return -2; /* not enough space */ } /* diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c deleted file mode 100644 index e342e414b5..0000000000 --- a/erts/emulator/drivers/common/zlib_drv.c +++ /dev/null @@ -1,792 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2003-2017. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * ZLib interface for erlang - * - */ -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif -#include <stdio.h> -#include <zlib.h> -#include <errno.h> -#include <string.h> - -#include "erl_driver.h" - - -#define DEFLATE_INIT 1 -#define DEFLATE_INIT2 2 -#define DEFLATE_SETDICT 3 -#define DEFLATE_RESET 4 -#define DEFLATE_END 5 -#define DEFLATE_PARAMS 6 -#define DEFLATE 7 - -#define INFLATE_INIT 8 -#define INFLATE_INIT2 9 -#define INFLATE_SETDICT 10 -#define INFLATE_GETDICT 11 -#define INFLATE_SYNC 12 -#define INFLATE_RESET 13 -#define INFLATE_END 14 -#define INFLATE 15 - -#define CRC32_0 16 -#define CRC32_1 17 -#define CRC32_2 18 - -#define SET_BUFSZ 19 -#define GET_BUFSZ 20 -#define GET_QSIZE 21 - -#define ADLER32_1 22 -#define ADLER32_2 23 - -#define CRC32_COMBINE 24 -#define ADLER32_COMBINE 25 - -#define INFLATE_CHUNK 26 - - -#define DEFAULT_BUFSZ 4000 - -/* According to zlib documentation, it can never exceed this */ -#define INFL_DICT_SZ 32768 - -/* This flag is used in the same places, where zlib return codes - * (Z_OK, Z_STREAM_END, Z_NEED_DICT) are. So, we need to set it to - * relatively large value to avoid possible value clashes in future. - * */ -#define INFLATE_HAS_MORE 100 - -static int zlib_init(void); -static ErlDrvData zlib_start(ErlDrvPort port, char* buf); -static void zlib_stop(ErlDrvData e); -static void zlib_flush(ErlDrvData e); -static ErlDrvSSizeT zlib_ctl(ErlDrvData drv_data, unsigned int command, char *buf, - ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen); -static void zlib_outputv(ErlDrvData drv_data, ErlIOVec *ev); - -ErlDrvEntry zlib_driver_entry = { - zlib_init, - zlib_start, - zlib_stop, - NULL, /* output */ - NULL, /* ready_input */ - NULL, /* ready_output */ - "zlib_drv", - NULL, /* finish */ - NULL, /* handle */ - zlib_ctl, - NULL, /* timeout */ - zlib_outputv, - NULL, /* read_async */ - zlib_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, /* process_exit */ -}; - -typedef enum { - ST_NONE = 0, - ST_DEFLATE = 1, - ST_INFLATE = 2 -} ZLibState; - - -typedef struct { - z_stream s; - ZLibState state; - ErlDrvBinary* bin; - int binsz; - int binsz_need; - uLong crc; - int inflate_eos_seen; - int want_crc; /* 1 if crc is calculated on clear text */ - ErlDrvPort port; /* the associcated port */ -} ZLibData; - -static int zlib_inflate(ZLibData* d, int flush); -static int zlib_deflate(ZLibData* d, int flush); - -#if defined(__WIN32__) -static int i32(char* buf) -#else -static __inline__ int i32(char* buf) -#endif -{ - return (int) ( - (((int)((unsigned char*)buf)[0]) << 24) | - (((int)((unsigned char*)buf)[1]) << 16) | - (((int)((unsigned char*)buf)[2]) << 8) | - (((int)((unsigned char*)buf)[3]) << 0)); -} - -static char* zlib_reason(int code, int* err) -{ - switch(code) { - case Z_OK: - *err = 0; - return "ok"; - case Z_STREAM_END: - *err = 0; - return "stream_end"; - case Z_ERRNO: - *err = 1; - return erl_errno_id(errno); - case Z_STREAM_ERROR: - *err = 1; - return "stream_error"; - case Z_DATA_ERROR: - *err = 1; - return "data_error"; - case Z_MEM_ERROR: - *err = 1; - return "mem_error"; - case Z_BUF_ERROR: - *err = 1; - return "buf_error"; - case Z_VERSION_ERROR: - *err = 1; - return "version_error"; - default: - *err = 1; - return "unknown_error"; - } -} - - -static ErlDrvSSizeT zlib_return(int code, char** rbuf, ErlDrvSizeT rlen) -{ - int msg_code = 0; /* 0=ok, 1=error */ - char* dst = *rbuf; - char* src; - ErlDrvSizeT len = 0; - - src = zlib_reason(code, &msg_code); - *dst++ = msg_code; - rlen--; - len = 1; - - while((rlen > 0) && *src) { - *dst++ = *src++; - rlen--; - len++; - } - return len; -} - -static ErlDrvSSizeT zlib_value2(int msg_code, int value, - char** rbuf, ErlDrvSizeT rlen) -{ - char* dst = *rbuf; - - if (rlen < 5) { - return -1; - } - *dst++ = msg_code; - *dst++ = (value >> 24) & 0xff; - *dst++ = (value >> 16) & 0xff; - *dst++ = (value >> 8) & 0xff; - *dst++ = value & 0xff; - return 5; -} - -static ErlDrvSSizeT zlib_value(int value, char** rbuf, ErlDrvSizeT rlen) -{ - return zlib_value2(2, value, rbuf, rlen); -} - -static int zlib_output_init(ZLibData* d) -{ - if (d->bin != NULL) - driver_free_binary(d->bin); - if ((d->bin = driver_alloc_binary(d->binsz_need)) == NULL) - return -1; - d->binsz = d->binsz_need; - d->s.next_out = (unsigned char*)d->bin->orig_bytes; - d->s.avail_out = d->binsz; - return 0; -} - -/* - * Send compressed or uncompressed data - * and restart output procesing - */ -static int zlib_output(ZLibData* d) -{ - if (d->bin != NULL) { - int len = d->binsz - d->s.avail_out; - if (len > 0) { - if (driver_output_binary(d->port, NULL, 0, d->bin, 0, len) < 0) - return -1; - } - driver_free_binary(d->bin); - d->bin = NULL; - d->binsz = 0; - } - return zlib_output_init(d); -} - -static int zlib_inflate_get_dictionary(ZLibData* d) -{ -#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY - ErlDrvBinary* dbin = driver_alloc_binary(INFL_DICT_SZ); - uInt dlen = 0; - int res = inflateGetDictionary(&d->s, (unsigned char*)dbin->orig_bytes, &dlen); - if ((res == Z_OK) && (driver_output_binary(d->port, NULL, 0, dbin, 0, dlen) < 0)) { - res = Z_ERRNO; - } - driver_free_binary(dbin); - return res; -#else - abort(); /* never called, just to silence 'unresolved symbol' - for non-optimizing compiler */ -#endif -} - -static int zlib_inflate(ZLibData* d, int flush) -{ - int res = Z_OK; - - if ((d->bin == NULL) && (zlib_output_init(d) < 0)) { - errno = ENOMEM; - return Z_ERRNO; - } - - while ((driver_sizeq(d->port) > 0) && (res != Z_STREAM_END)) { - int vlen; - SysIOVec* iov = driver_peekq(d->port, &vlen); - int len; - int possibly_more_output = 0; - - d->s.next_in = iov[0].iov_base; - d->s.avail_in = iov[0].iov_len; - while((possibly_more_output || (d->s.avail_in > 0)) && (res != Z_STREAM_END)) { - res = inflate(&d->s, Z_NO_FLUSH); - if (res == Z_NEED_DICT) { - /* Essential to eat the header bytes that zlib has looked at */ - len = iov[0].iov_len - d->s.avail_in; - driver_deq(d->port, len); - return res; - } - if (res == Z_BUF_ERROR) { - /* Was possible more output, but actually not */ - res = Z_OK; - } - else if (res < 0) { - return res; - } - if (d->s.avail_out != 0) { - possibly_more_output = 0; - } else { - if (d->want_crc) - d->crc = crc32(d->crc, (unsigned char*)d->bin->orig_bytes, - d->binsz - d->s.avail_out); - zlib_output(d); - possibly_more_output = 1; - } - } - len = iov[0].iov_len - d->s.avail_in; - driver_deq(d->port, len); - } - - if (d->want_crc) { - d->crc = crc32(d->crc, (unsigned char*) d->bin->orig_bytes, - d->binsz - d->s.avail_out); - } - zlib_output(d); - if (res == Z_STREAM_END) { - d->inflate_eos_seen = 1; - } - return res; -} - -static int zlib_inflate_chunk(ZLibData* d) -{ - int res = Z_OK; - - if ((d->bin == NULL) && (zlib_output_init(d) < 0)) { - errno = ENOMEM; - return Z_ERRNO; - } - - while ((driver_sizeq(d->port) > 0) && (d->s.avail_out > 0) && - (res != Z_STREAM_END)) { - int vlen; - SysIOVec* iov = driver_peekq(d->port, &vlen); - int len; - - d->s.next_in = iov[0].iov_base; - d->s.avail_in = iov[0].iov_len; - while((d->s.avail_in > 0) && (d->s.avail_out > 0) && (res != Z_STREAM_END)) { - res = inflate(&d->s, Z_NO_FLUSH); - if (res == Z_NEED_DICT) { - /* Essential to eat the header bytes that zlib has looked at */ - len = iov[0].iov_len - d->s.avail_in; - driver_deq(d->port, len); - return res; - } - if (res == Z_BUF_ERROR) { - /* Was possible more output, but actually not */ - res = Z_OK; - } - else if (res < 0) { - return res; - } - } - len = iov[0].iov_len - d->s.avail_in; - driver_deq(d->port, len); - } - - /* We are here because all input was consumed or EOS reached or output - * buffer is full */ - if (d->want_crc) { - d->crc = crc32(d->crc, (unsigned char*) d->bin->orig_bytes, - d->binsz - d->s.avail_out); - } - zlib_output(d); - if ((res == Z_OK) && (d->s.avail_in > 0)) - res = INFLATE_HAS_MORE; - else if (res == Z_STREAM_END) { - d->inflate_eos_seen = 1; - } - return res; -} - -static int zlib_deflate(ZLibData* d, int flush) -{ - int res = Z_OK; - - if ((d->bin == NULL) && (zlib_output_init(d) < 0)) { - errno = ENOMEM; - return Z_ERRNO; - } - - while ((driver_sizeq(d->port) > 0) && (res != Z_STREAM_END)) { - int vlen; - SysIOVec* iov = driver_peekq(d->port, &vlen); - int len; - - d->s.next_in = iov[0].iov_base; - d->s.avail_in = iov[0].iov_len; - - while((d->s.avail_in > 0) && (res != Z_STREAM_END)) { - if ((res = deflate(&d->s, Z_NO_FLUSH)) < 0) { - return res; - } - if (d->s.avail_out == 0) { - zlib_output(d); - } - } - len = iov[0].iov_len - d->s.avail_in; - if (d->want_crc) { - d->crc = crc32(d->crc, iov[0].iov_base, len); - } - driver_deq(d->port, len); - } - - if (flush != Z_NO_FLUSH) { - if ((res = deflate(&d->s, flush)) < 0) { - return res; - } - if (flush == Z_FINISH) { - while (d->s.avail_out < d->binsz) { - zlib_output(d); - if (res == Z_STREAM_END) { - break; - } - if ((res = deflate(&d->s, flush)) < 0) { - return res; - } - } - } else { - while (d->s.avail_out == 0) { - zlib_output(d); - if ((res = deflate(&d->s, flush)) < 0) { - return res; - } - } - if (d->s.avail_out < d->binsz) { - zlib_output(d); - } - } - } - return res; -} - - - -static void* zlib_alloc(void* data, unsigned int items, unsigned int size) -{ - return (void*) driver_alloc(items*size); -} - -static void zlib_free(void* data, void* addr) -{ - driver_free(addr); -} - -#if defined(__APPLE__) && defined(__MACH__) && defined(HAVE_ZLIB_INFLATEGETDICTIONARY) - -/* Work around broken build system with runtime version test */ -static int have_inflateGetDictionary; - -static int zlib_init() -{ - unsigned int v[4] = {0, 0, 0, 0}; - unsigned hexver; - - sscanf(zlibVersion(), "%u.%u.%u.%u", &v[0], &v[1], &v[2], &v[3]); - - hexver = (v[0] << (8*3)) | (v[1] << (8*2)) | (v[2] << (8)) | v[3]; - - have_inflateGetDictionary = (hexver >= 0x1020701); /* 1.2.7.1 */ - - return 0; -} -#else /* trust configure got it right */ -# ifdef HAVE_ZLIB_INFLATEGETDICTIONARY -# define have_inflateGetDictionary 1 -# else -# define have_inflateGetDictionary 0 -# endif -static int zlib_init() -{ - return 0; -} -#endif - -static ErlDrvData zlib_start(ErlDrvPort port, char* buf) -{ - ZLibData* d; - - if ((d = (ZLibData*) driver_alloc(sizeof(ZLibData))) == NULL) - return ERL_DRV_ERROR_GENERAL; - - memset(&d->s, 0, sizeof(z_stream)); - - d->s.zalloc = zlib_alloc; - d->s.zfree = zlib_free; - d->s.opaque = d; - d->s.data_type = Z_BINARY; - - d->port = port; - d->state = ST_NONE; - d->bin = NULL; - d->binsz = 0; - d->binsz_need = DEFAULT_BUFSZ; - d->crc = crc32(0L, Z_NULL, 0); - d->inflate_eos_seen = 0; - d->want_crc = 0; - return (ErlDrvData)d; -} - - -static void zlib_stop(ErlDrvData e) -{ - ZLibData* d = (ZLibData*)e; - - if (d->state == ST_DEFLATE) - deflateEnd(&d->s); - else if (d->state == ST_INFLATE) - inflateEnd(&d->s); - - if (d->bin != NULL) - driver_free_binary(d->bin); - - driver_free(d); -} - -static void zlib_flush(ErlDrvData drv_data) -{ - ZLibData* d = (ZLibData*) drv_data; - - driver_deq(d->port, driver_sizeq(d->port)); -} - -static ErlDrvSSizeT zlib_ctl(ErlDrvData drv_data, unsigned int command, char *buf, - ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) -{ - ZLibData* d = (ZLibData*)drv_data; - int res; - - switch(command) { - case DEFLATE_INIT: - if (len != 4) goto badarg; - if (d->state != ST_NONE) goto badarg; - res = deflateInit(&d->s, i32(buf)); - if (res == Z_OK) { - d->state = ST_DEFLATE; - d->want_crc = 0; - d->crc = crc32(0L, Z_NULL, 0); - } - return zlib_return(res, rbuf, rlen); - - case DEFLATE_INIT2: { - int wbits; - - if (len != 20) goto badarg; - if (d->state != ST_NONE) goto badarg; - wbits = i32(buf+8); - res = deflateInit2(&d->s, i32(buf), i32(buf+4), wbits, - i32(buf+12), i32(buf+16)); - if (res == Z_OK) { - d->state = ST_DEFLATE; - d->want_crc = (wbits < 0); - d->crc = crc32(0L, Z_NULL, 0); - } - return zlib_return(res, rbuf, rlen); - } - - case DEFLATE_SETDICT: - if (d->state != ST_DEFLATE) goto badarg; - res = deflateSetDictionary(&d->s, (unsigned char*)buf, len); - if (res == Z_OK) { - return zlib_value(d->s.adler, rbuf, rlen); - } else { - return zlib_return(res, rbuf, rlen); - } - - case DEFLATE_RESET: - if (len != 0) goto badarg; - if (d->state != ST_DEFLATE) goto badarg; - driver_deq(d->port, driver_sizeq(d->port)); - res = deflateReset(&d->s); - return zlib_return(res, rbuf, rlen); - - case DEFLATE_END: - if (len != 0) goto badarg; - if (d->state != ST_DEFLATE) goto badarg; - driver_deq(d->port, driver_sizeq(d->port)); - res = deflateEnd(&d->s); - d->state = ST_NONE; - return zlib_return(res, rbuf, rlen); - - case DEFLATE_PARAMS: - if (len != 8) goto badarg; - if (d->state != ST_DEFLATE) goto badarg; - res = deflateParams(&d->s, i32(buf), i32(buf+4)); - return zlib_return(res, rbuf, rlen); - - case DEFLATE: - if (d->state != ST_DEFLATE) goto badarg; - if (len != 4) goto badarg; - res = zlib_deflate(d, i32(buf)); - return zlib_return(res, rbuf, rlen); - - case INFLATE_INIT: - if (len != 0) goto badarg; - if (d->state != ST_NONE) goto badarg; - res = inflateInit(&d->s); - if (res == Z_OK) { - d->state = ST_INFLATE; - d->inflate_eos_seen = 0; - d->want_crc = 0; - d->crc = crc32(0L, Z_NULL, 0); - } - return zlib_return(res, rbuf, rlen); - - case INFLATE_INIT2: { - int wbits; - - if (len != 4) goto badarg; - if (d->state != ST_NONE) goto badarg; - wbits = i32(buf); - res = inflateInit2(&d->s, wbits); - if (res == Z_OK) { - d->state = ST_INFLATE; - d->inflate_eos_seen = 0; - d->want_crc = (wbits < 0); - d->crc = crc32(0L, Z_NULL, 0); - } - return zlib_return(res, rbuf, rlen); - } - - case INFLATE_SETDICT: - if (d->state != ST_INFLATE) goto badarg; - res = inflateSetDictionary(&d->s, (unsigned char*)buf, len); - return zlib_return(res, rbuf, rlen); - - case INFLATE_GETDICT: - if (have_inflateGetDictionary) { - if (d->state != ST_INFLATE) goto badarg; - res = zlib_inflate_get_dictionary(d); - } else { - errno = ENOTSUP; - res = Z_ERRNO; - } - return zlib_return(res, rbuf, rlen); - - case INFLATE_SYNC: - if (d->state != ST_INFLATE) goto badarg; - if (len != 0) goto badarg; - if (driver_sizeq(d->port) == 0) { - res = Z_BUF_ERROR; - } else { - int vlen; - SysIOVec* iov = driver_peekq(d->port, &vlen); - - d->s.next_in = iov[0].iov_base; - d->s.avail_in = iov[0].iov_len; - res = inflateSync(&d->s); - } - return zlib_return(res, rbuf, rlen); - - case INFLATE_RESET: - if (d->state != ST_INFLATE) goto badarg; - if (len != 0) goto badarg; - driver_deq(d->port, driver_sizeq(d->port)); - res = inflateReset(&d->s); - d->inflate_eos_seen = 0; - return zlib_return(res, rbuf, rlen); - - case INFLATE_END: - if (d->state != ST_INFLATE) goto badarg; - if (len != 0) goto badarg; - driver_deq(d->port, driver_sizeq(d->port)); - res = inflateEnd(&d->s); - if (res == Z_OK && d->inflate_eos_seen == 0) { - res = Z_DATA_ERROR; - } - d->state = ST_NONE; - return zlib_return(res, rbuf, rlen); - - case INFLATE: - if (d->state != ST_INFLATE) goto badarg; - if (len != 4) goto badarg; - res = zlib_inflate(d, i32(buf)); - if (res == Z_NEED_DICT) { - return zlib_value2(3, d->s.adler, rbuf, rlen); - } else { - return zlib_return(res, rbuf, rlen); - } - - case INFLATE_CHUNK: - if (d->state != ST_INFLATE) goto badarg; - if (len != 0) goto badarg; - res = zlib_inflate_chunk(d); - if (res == INFLATE_HAS_MORE) { - return zlib_value2(4, 0, rbuf, rlen); - } else if (res == Z_NEED_DICT) { - return zlib_value2(3, d->s.adler, rbuf, rlen); - } else { - return zlib_return(res, rbuf, rlen); - } - - case GET_QSIZE: - return zlib_value(driver_sizeq(d->port), rbuf, rlen); - - case GET_BUFSZ: - return zlib_value(d->binsz_need, rbuf, rlen); - - case SET_BUFSZ: { - int need; - if (len != 4) goto badarg; - need = i32(buf); - if ((need < 16) || (need > 0x00ffffff)) - goto badarg; - if (d->binsz_need != need) { - d->binsz_need = need; - if (d->bin != NULL) { - if (d->s.avail_out == d->binsz) { - driver_free_binary(d->bin); - d->bin = NULL; - d->binsz = 0; - } - else - zlib_output(d); - } - } - return zlib_return(Z_OK, rbuf, rlen); - } - - case CRC32_0: - return zlib_value(d->crc, rbuf, rlen); - - case CRC32_1: { - uLong crc = crc32(0L, Z_NULL, 0); - crc = crc32(crc, (unsigned char*) buf, len); - return zlib_value(crc, rbuf, rlen); - } - - case CRC32_2: { - uLong crc; - if (len < 4) goto badarg; - crc = (unsigned int) i32(buf); - crc = crc32(crc, (unsigned char*) buf+4, len-4); - return zlib_value(crc, rbuf, rlen); - } - - case ADLER32_1: { - uLong adler = adler32(0L, Z_NULL, 0); - adler = adler32(adler, (unsigned char*) buf, len); - return zlib_value(adler, rbuf, rlen); - } - - case ADLER32_2: { - uLong adler; - if (len < 4) goto badarg; - adler = (unsigned int) i32(buf); - adler = adler32(adler, (unsigned char*) buf+4, len-4); - return zlib_value(adler, rbuf, rlen); - } - - case CRC32_COMBINE: { - uLong crc, crc1, crc2, len2; - if (len != 12) goto badarg; - crc1 = (unsigned int) i32(buf); - crc2 = (unsigned int) i32(buf+4); - len2 = (unsigned int) i32(buf+8); - crc = crc32_combine(crc1, crc2, len2); - return zlib_value(crc, rbuf, rlen); - } - - case ADLER32_COMBINE: { - uLong adler, adler1, adler2, len2; - if (len != 12) goto badarg; - adler1 = (unsigned int) i32(buf); - adler2 = (unsigned int) i32(buf+4); - len2 = (unsigned int) i32(buf+8); - adler = adler32_combine(adler1, adler2, len2); - return zlib_value(adler, rbuf, rlen); - } - } - - badarg: - errno = EINVAL; - return zlib_return(Z_ERRNO, rbuf, rlen); -} - - - -static void zlib_outputv(ErlDrvData drv_data, ErlIOVec *ev) -{ - ZLibData* d = (ZLibData*) drv_data; - - driver_enqv(d->port, ev, 0); -} diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 3d1e58abe3..8efe35e321 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -108,16 +108,15 @@ static int lbuf_size = BUFSIZ; static Uint32 *lbuf; /* The current line buffer */ static int llen; /* The current line length */ static int lpos; /* The current "cursor position" in the line buffer */ - + /* NOTE: not the same as column position a char may not take a" + * column to display or it might take many columns + */ /* * Tags used in line buffer to show that these bytes represent special characters, * Max unicode is 0x0010ffff, so we have lots of place for meta tags... */ #define CONTROL_TAG 0x10000000U /* Control character, value in first position */ #define ESCAPED_TAG 0x01000000U /* Escaped character, value in first position */ -#ifdef HAVE_WCWIDTH -#define WIDE_TAG 0x02000000U /* Wide character, value in first position */ -#endif #define TAG_MASK 0xFF000000U #define MAXSIZE (1 << 16) @@ -156,6 +155,8 @@ static int insert_buf(byte*,int); static int write_buf(Uint32 *,int); static int outc(int c); static int move_cursor(int,int); +static int cp_pos_to_col(int cp_pos); + /* Termcap functions. */ static int start_termcap(void); @@ -991,24 +992,26 @@ static int del_chars(int n) { int i, l, r; int pos; + int gcs; /* deleted grapheme characters */ update_cols(); /* Step forward or backwards over n logical characters. */ pos = step_over_chars(n); - + DEBUGLOG(("del_chars: %d from %d %d %d\n", n, lpos, pos, llen)); if (pos > lpos) { l = pos - lpos; /* Buffer characters to delete */ r = llen - lpos - l; /* Characters after deleted */ + gcs = cp_pos_to_col(pos) - cp_pos_to_col(lpos); /* Fix up buffer and buffer pointers. */ if (r > 0) memmove(lbuf + lpos, lbuf + pos, r * sizeof(Uint32)); llen -= l; /* Write out characters after, blank the tail and jump back to lpos. */ write_buf(lbuf + lpos, r); - for (i = l ; i > 0; --i) + for (i = gcs ; i > 0; --i) outc(' '); - if (COL(llen+l) == 0 && xn) + if (xn && COL(cp_pos_to_col(llen)+gcs) == 0) { outc(' '); move_left(1); @@ -1018,7 +1021,7 @@ static int del_chars(int n) else if (pos < lpos) { l = lpos - pos; /* Buffer characters */ r = llen - lpos; /* Characters after deleted */ - move_cursor(lpos, lpos-l); /* Move back */ + gcs = -move_cursor(lpos, lpos-l); /* Move back */ /* Fix up buffer and buffer pointers. */ if (r > 0) memmove(lbuf + pos, lbuf + lpos, r * sizeof(Uint32)); @@ -1026,14 +1029,14 @@ static int del_chars(int n) llen -= l; /* Write out characters after, blank the tail and jump back to lpos. */ write_buf(lbuf + lpos, r); - for (i = l ; i > 0; --i) - outc(' '); - if (COL(llen+l) == 0 && xn) + for (i = gcs ; i > 0; --i) + outc(' '); + if (xn && COL(cp_pos_to_col(llen)+gcs) == 0) { - outc(' '); - move_left(1); + outc(' '); + move_left(1); } - move_cursor(llen + l, lpos); + move_cursor(llen + l, lpos); } return TRUE; } @@ -1047,22 +1050,12 @@ static int step_over_chars(int n) end = lbuf + llen; c = lbuf + lpos; for ( ; n > 0 && c < end; --n) { -#ifdef HAVE_WCWIDTH - while (*c & WIDE_TAG) { - c++; - } -#endif c++; while (c < end && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0)) c++; } for ( ; n < 0 && c > beg; n++) { --c; -#ifdef HAVE_WCWIDTH - while (c > beg + 1 && (c[-1] & WIDE_TAG)) { - --c; - } -#endif while (c > beg && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0)) --c; } @@ -1088,15 +1081,6 @@ static int insert_buf(byte *s, int n) ++pos; } if ((utf8_mode && (ch >= 128 || isprint(ch))) || (ch <= 255 && isprint(ch))) { -#ifdef HAVE_WCWIDTH - int width; - if ((width = wcwidth(ch)) > 1) { - while (--width) { - DEBUGLOG(("insert_buf: Wide(UTF-8):%d,%d",width,ch)); - lbuf[lpos++] = (WIDE_TAG | ((Uint32) ch)); - } - } -#endif DEBUGLOG(("insert_buf: Printable(UTF-8):%d",ch)); lbuf[lpos++] = (Uint32) ch; } else if (ch >= 128) { /* not utf8 mode */ @@ -1110,15 +1094,13 @@ static int insert_buf(byte *s, int n) lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch)); ch = 0; } while (lpos % 8); - } else if (ch == '\e' || ch == '\n' || ch == '\r') { + } else if (ch == '\e') { + lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch)); + } else if (ch == '\n' || ch == '\r') { write_buf(lbuf + buffpos, lpos - buffpos); - if (ch == '\e') { - outc('\e'); - } else { outc('\r'); if (ch == '\n') outc('\n'); - } if (llen > lpos) { memcpy(lbuf, lbuf + lpos, llen - lpos); } @@ -1166,14 +1148,17 @@ static int write_buf(Uint32 *s, int n) } --n; ++s; - } - else if (*s == (CONTROL_TAG | ((Uint32) '\t'))) { + } else if (*s == (CONTROL_TAG | ((Uint32) '\t'))) { outc(lastput = ' '); --n; s++; while (n > 0 && *s == CONTROL_TAG) { outc(lastput = ' '); --n; s++; } + } else if (*s == (CONTROL_TAG | ((Uint32) '\e'))) { + outc('\e'); + --n; + ++s; } else if (*s & CONTROL_TAG) { outc('^'); outc(lastput = ((byte) ((*s == 0177) ? '?' : *s | 0x40))); @@ -1204,10 +1189,6 @@ static int write_buf(Uint32 *s, int n) if (octbuff != octtmp) { driver_free(octbuff); } -#ifdef HAVE_WCWIDTH - } else if (*s & WIDE_TAG) { - --n; s++; -#endif } else { DEBUGLOG(("write_buf: Very unexpected character %d",(int) *s)); ++n; @@ -1216,7 +1197,7 @@ static int write_buf(Uint32 *s, int n) } /* Check landed in first column of new line and have 'xn' bug. */ n = s - lbuf; - if (COL(n) == 0 && xn && n != 0) { + if (xn && n != 0 && COL(cp_pos_to_col(n)) == 0) { if (n >= llen) { outc(' '); } else if (lastput == 0) { /* A multibyte UTF8 character */ @@ -1246,14 +1227,19 @@ static int outc(int c) return 1; } -static int move_cursor(int from, int to) +static int move_cursor(int from_pos, int to_pos) { + int from_col, to_col; int dc, dl; - update_cols(); - dc = COL(to) - COL(from); - dl = LINE(to) - LINE(from); + from_col = cp_pos_to_col(from_pos); + to_col = cp_pos_to_col(to_pos); + + dc = COL(to_col) - COL(from_col); + dl = LINE(to_col) - LINE(from_col); + DEBUGLOG(("move_cursor: from %d %d to %d %d => %d %d\n", + from_pos, from_col, to_pos, to_col, dl, dc)); if (dl > 0) move_down(dl); else if (dl < 0) @@ -1262,7 +1248,29 @@ static int move_cursor(int from, int to) move_right(dc); else if (dc < 0) move_left(-dc); - return TRUE; + return to_col-from_col; +} + +static int cp_pos_to_col(int cp_pos) +{ +#ifdef HAVE_WCWIDTH + int i; + int col = 0; + + for (i = 0; i < cp_pos; i++) { + int w = wcwidth(lbuf[i]); + if (w > 0) { + col += w; + } + } + return col; +#else + /* + * We dont' have any character width information. Assume that + * code points are one column wide. + */ + return cp_pos; +#endif } static int start_termcap(void) diff --git a/erts/emulator/hipe/hipe_instrs.tab b/erts/emulator/hipe/hipe_instrs.tab new file mode 100644 index 0000000000..bcce196a1d --- /dev/null +++ b/erts/emulator/hipe/hipe_instrs.tab @@ -0,0 +1,141 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + + +HIPE_MODE_SWITCH(Cmd) { + SWAPOUT; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS; + c_p->def_arg_reg[4] = -neg_o_reds; + c_p = hipe_mode_switch(c_p, $Cmd, reg); +} + +hipe_trap_call := hipe_trap.call.post; +hipe_trap_call_closure := hipe_trap.call_closure.post; +hipe_trap_return := hipe_trap.return.post; +hipe_trap_throw := hipe_trap.throw.post; +hipe_trap_resume := hipe_trap.resume.post; + +hipe_trap.call() { + /* + * I[-5]: &&lb_i_func_info_IaaI + * I[-4]: Native code callee (inserted by HiPE) + * I[-3]: Module (tagged atom) + * I[-2]: Function (tagged atom) + * I[-1]: Arity (untagged integer) + * I[ 0]: &&lb_hipe_trap_call + * ... remainder of original BEAM code + */ + ErtsCodeInfo *ci = erts_code_to_codeinfo(I); + ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + c_p->hipe.u.ncallee = ci->u.ncallee; + ++hipe_trap_count; + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (ci->mfa.arity << 8)); +} + +hipe_trap.call_closure() { + ErtsCodeInfo *ci = erts_code_to_codeinfo(I); + ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + c_p->hipe.u.ncallee = ci->u.ncallee; + ++hipe_trap_count; + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (ci->mfa.arity << 8)); +} + +hipe_trap.return() { + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN); +} + +hipe_trap.throw() { + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW); +} + +hipe_trap.resume() { + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME); +} + +hipe_trap.post() { +#ifdef DEBUG + pid = c_p->common.id; /* may have switched process... */ +#endif + reg = erts_proc_sched_data(c_p)->x_reg_array; + freg = erts_proc_sched_data(c_p)->f_reg_array; + ERL_BITS_RELOAD_STATEP(c_p); + /* XXX: this abuse of def_arg_reg[] is horrid! */ + neg_o_reds = -c_p->def_arg_reg[4]; + FCALLS = c_p->fcalls; + SWAPIN; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + switch( c_p->def_arg_reg[3] ) { + case HIPE_MODE_SWITCH_RES_RETURN: + ASSERT(is_value(reg[0])); + SET_I(c_p->cp); + c_p->cp = 0; + Goto(*I); + case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: + c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; + /*fall through*/ + case HIPE_MODE_SWITCH_RES_CALL_BEAM: + SET_I(c_p->i); + Dispatch(); + case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: + /* This can be used to call any function value, but currently + it's only used to call closures referring to unloaded + modules. */ + { + BeamInstr *next; + + next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE); + HEAVY_SWAPIN; + if (next != NULL) { + SET_I(next); + Dispatchfun(); + } + goto find_func_info; + } + case HIPE_MODE_SWITCH_RES_THROW: + c_p->cp = NULL; + I = handle_error(c_p, I, reg, NULL); + goto post_error_handling; + default: + erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]); + } + //| -no_next; +} + +hipe_call_count() { + /* + * I[-5]: &&lb_i_func_info_IaaI + * I[-4]: pointer to struct hipe_call_count (inserted by HiPE) + * I[-3]: Module (tagged atom) + * I[-2]: Function (tagged atom) + * I[-1]: Arity (untagged integer) + * I[ 0]: &&lb_hipe_call_count + * ... remainder of original BEAM code + */ + ErtsCodeInfo *ci = erts_code_to_codeinfo(I); + struct hipe_call_count *hcc = ci->u.hcc; + ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + ASSERT(hcc != NULL); + ASSERT(VALID_INSTR(hcc->opcode)); + ++(hcc->count); + Goto(hcc->opcode); + //| -no_next; +} diff --git a/erts/emulator/hipe/hipe_ops.tab b/erts/emulator/hipe/hipe_ops.tab index 96e4c0da91..19a3820a6a 100644 --- a/erts/emulator/hipe/hipe_ops.tab +++ b/erts/emulator/hipe/hipe_ops.tab @@ -23,4 +23,7 @@ hipe_trap_call_closure hipe_trap_return hipe_trap_throw hipe_trap_resume + +%cold hipe_call_count +%hot diff --git a/erts/emulator/nifs/common/zlib_nif.c b/erts/emulator/nifs/common/zlib_nif.c new file mode 100644 index 0000000000..a1a65e1946 --- /dev/null +++ b/erts/emulator/nifs/common/zlib_nif.c @@ -0,0 +1,1011 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson 2017. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#define STATIC_ERLANG_NIF 1 + +#include <stdio.h> +#include <zlib.h> + +#include "erl_nif.h" +#include "config.h" +#include "sys.h" + +#ifdef VALGRIND +# include <valgrind/memcheck.h> +#endif + +#define INFL_DICT_SZ (32768) + +/* NIF interface declarations */ +static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv *env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv *env, void* priv_data); + +static ErlNifResourceType *rtype_zlib; + +static ERL_NIF_TERM am_not_on_controlling_process; + +static ERL_NIF_TERM am_not_initialized; +static ERL_NIF_TERM am_already_initialized; + +static ERL_NIF_TERM am_ok; +static ERL_NIF_TERM am_error; + +static ERL_NIF_TERM am_continue; +static ERL_NIF_TERM am_finished; + +static ERL_NIF_TERM am_not_supported; +static ERL_NIF_TERM am_need_dictionary; + +static ERL_NIF_TERM am_empty; + +static ERL_NIF_TERM am_stream_end; +static ERL_NIF_TERM am_stream_error; +static ERL_NIF_TERM am_data_error; +static ERL_NIF_TERM am_mem_error; +static ERL_NIF_TERM am_buf_error; +static ERL_NIF_TERM am_version_error; +static ERL_NIF_TERM am_unknown_error; + +typedef enum { + ST_NONE = 0, + ST_DEFLATE = 1, + ST_INFLATE = 2, + ST_CLOSED = 3 +} zlib_state; + +typedef struct { + z_stream s; + zlib_state state; + + /* These refer to the plaintext CRC, and are only needed for zlib:crc32/1 + * which is deprecated. */ + uLong input_crc; + uLong output_crc; + int want_input_crc; + int want_output_crc; + + int is_raw_stream; + + int eos_seen; + + /* DEPRECATED */ + int inflateChunk_buffer_size; + + ErlNifPid controlling_process; + + ErlNifIOQueue *input_queue; + + ErlNifEnv *stash_env; + ERL_NIF_TERM stash_term; +} zlib_data_t; + +/* The NIFs: */ + +static ERL_NIF_TERM zlib_open(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_close(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_deflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_deflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_deflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_deflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_deflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_deflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM zlib_inflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_inflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_inflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_inflateGetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_inflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_inflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM zlib_crc32(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM zlib_clearStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_setStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_getStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM zlib_getBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM zlib_setBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM zlib_enqueue_input(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + /* deflate */ + {"deflateInit_nif", 2, zlib_deflateInit}, + {"deflateInit_nif", 6, zlib_deflateInit2}, + {"deflateSetDictionary_nif", 2, zlib_deflateSetDictionary}, + {"deflateReset_nif", 1, zlib_deflateReset}, + {"deflateEnd_nif", 1, zlib_deflateEnd}, + {"deflateParams_nif", 3, zlib_deflateParams}, + {"deflate_nif", 4, zlib_deflate}, + + /* inflate */ + {"inflateInit_nif", 1, zlib_inflateInit}, + {"inflateInit_nif", 2, zlib_inflateInit2}, + {"inflateSetDictionary_nif", 2, zlib_inflateSetDictionary}, + {"inflateGetDictionary_nif", 1, zlib_inflateGetDictionary}, + {"inflateReset_nif", 1, zlib_inflateReset}, + {"inflateEnd_nif", 1, zlib_inflateEnd}, + {"inflate_nif", 4, zlib_inflate}, + + /* running checksum */ + {"crc32_nif", 1, zlib_crc32}, + + /* open & close */ + {"close_nif", 1, zlib_close}, + {"open_nif", 0, zlib_open}, + + /* The stash keeps a single term alive across calls, and is used in + * exception_on_need_dict/1 to retain the old error behavior, and for + * saving data flushed through deflateParams/3. */ + {"getStash_nif", 1, zlib_getStash}, + {"clearStash_nif", 1, zlib_clearStash}, + {"setStash_nif", 2, zlib_setStash}, + + /* DEPRECATED: buffer size for inflateChunk */ + {"getBufSize_nif", 1, zlib_getBufSize}, + {"setBufSize_nif", 2, zlib_setBufSize}, + + {"enqueue_nif", 2, zlib_enqueue_input}, +}; + +ERL_NIF_INIT(zlib, nif_funcs, load, NULL, upgrade, unload) + +static void gc_zlib(ErlNifEnv *env, void* data); + +static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM load_info) +{ + am_not_on_controlling_process = + enif_make_atom(env, "not_on_controlling_process"); + + am_not_initialized = enif_make_atom(env, "not_initialized"); + am_already_initialized = enif_make_atom(env, "already_initialized"); + + am_ok = enif_make_atom(env, "ok"); + am_error = enif_make_atom(env, "error"); + + am_continue = enif_make_atom(env, "continue"); + am_finished = enif_make_atom(env, "finished"); + + am_not_supported = enif_make_atom(env, "not_supported"); + am_need_dictionary = enif_make_atom(env, "need_dictionary"); + + am_empty = enif_make_atom(env, "empty"); + + am_stream_end = enif_make_atom(env, "stream_end"); + am_stream_error = enif_make_atom(env, "stream_error"); + am_data_error = enif_make_atom(env, "data_error"); + am_mem_error = enif_make_atom(env, "mem_error"); + am_buf_error = enif_make_atom(env, "buf_error"); + am_version_error = enif_make_atom(env, "version_error"); + am_unknown_error = enif_make_atom(env, "unknown_error"); + + rtype_zlib = enif_open_resource_type(env, NULL, + "gc_zlib", gc_zlib, ERL_NIF_RT_CREATE, NULL); + *priv_data = NULL; + + return 0; +} + +static void unload(ErlNifEnv *env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv *env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) +{ + if(*old_priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if(*priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if(load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +static void* zlib_alloc(void* data, unsigned int items, unsigned int size) +{ + return (void*) enif_alloc(items * size); +} + +static void zlib_free(void* data, void* addr) +{ + enif_free(addr); +} + +static ERL_NIF_TERM zlib_return(ErlNifEnv *env, int code) { + ERL_NIF_TERM reason; + switch(code) { + case Z_OK: + reason = am_ok; + break; + case Z_STREAM_END: + reason = am_stream_end; + break; + case Z_ERRNO: + reason = enif_make_int(env, errno); + break; + case Z_STREAM_ERROR: + reason = enif_raise_exception(env, am_stream_error); + break; + case Z_DATA_ERROR: + reason = enif_raise_exception(env, am_data_error); + break; + case Z_MEM_ERROR: + reason = am_mem_error; + break; + case Z_BUF_ERROR: + reason = am_buf_error; + break; + case Z_VERSION_ERROR: + reason = am_version_error; + break; + default: + reason = am_unknown_error; + break; + } + return reason; +} + +static void gc_zlib(ErlNifEnv *env, void* data) { + zlib_data_t *d = (zlib_data_t*)data; + + if(d->state == ST_DEFLATE) { + deflateEnd(&d->s); + } else if(d->state == ST_INFLATE) { + inflateEnd(&d->s); + } + + if(d->state != ST_CLOSED) { + enif_ioq_destroy(d->input_queue); + + if(d->stash_env != NULL) { + enif_free_env(d->stash_env); + } + + d->state = ST_CLOSED; + } +} + +static int get_zlib_data(ErlNifEnv *env, ERL_NIF_TERM opaque, zlib_data_t **d) { + return enif_get_resource(env, opaque, rtype_zlib, (void **)d); +} + +static int zlib_process_check(ErlNifEnv *env, zlib_data_t *d) { + ErlNifPid current_process; + + enif_self(env, ¤t_process); + + return enif_is_identical(enif_make_pid(env, ¤t_process), + enif_make_pid(env, &d->controlling_process)); +} + +static void zlib_reset_input(zlib_data_t *d) { + enif_ioq_destroy(d->input_queue); + d->input_queue = enif_ioq_create(ERL_NIF_IOQ_NORMAL); + + if(d->stash_env != NULL) { + enif_free_env(d->stash_env); + d->stash_env = NULL; + d->stash_term = NIL; + } +} + +static int zlib_flush_queue(int (*codec)(z_stream*, int), ErlNifEnv *env, + zlib_data_t *d, size_t input_limit, ErlNifBinary *output_buffer, int flush, + size_t *bytes_produced, size_t *bytes_consumed, size_t *bytes_remaining) { + + int vec_len, vec_idx; + SysIOVec *input_vec; + int res; + + input_vec = enif_ioq_peek(d->input_queue, &vec_len); + vec_idx = 0; + res = Z_OK; + + *bytes_produced = 0; + *bytes_consumed = 0; + + d->s.avail_out = output_buffer->size; + d->s.next_out = output_buffer->data; + + while(res == Z_OK && vec_idx < vec_len && *bytes_consumed < input_limit) { + size_t timeslice_percent, block_consumed, block_size; + + block_size = MIN(input_vec[vec_idx].iov_len, input_limit); + + d->s.next_in = input_vec[vec_idx].iov_base; + d->s.avail_in = block_size; + + res = codec(&d->s, Z_NO_FLUSH); + + ASSERT(d->s.avail_in == 0 || d->s.avail_out == 0 || res != Z_OK); + + block_consumed = block_size - d->s.avail_in; + *bytes_consumed += block_consumed; + + if(d->want_input_crc) { + d->input_crc = + crc32(d->input_crc, input_vec[vec_idx].iov_base, block_consumed); + } + + timeslice_percent = (100 * block_consumed) / input_limit; + if(enif_consume_timeslice(env, MAX(1, timeslice_percent))) { + break; + } + + vec_idx++; + } + + if(!enif_ioq_deq(d->input_queue, *bytes_consumed, bytes_remaining)) { + *bytes_remaining = 0; + res = Z_BUF_ERROR; + } + + if(res == Z_OK && flush != Z_NO_FLUSH && (*bytes_remaining == 0)) { + d->s.next_in = NULL; + d->s.avail_in = 0; + + res = codec(&d->s, flush); + } + + *bytes_produced = output_buffer->size - d->s.avail_out; + + return res; +} + +static ERL_NIF_TERM zlib_codec(int (*codec)(z_stream*, int), + ErlNifEnv *env, zlib_data_t *d, + int input_chunk_size, + int output_chunk_size, + int flush) { + + size_t bytes_produced, bytes_consumed, bytes_remaining; + ErlNifBinary output_buffer; + int res; + + if(!enif_alloc_binary(output_chunk_size, &output_buffer)) { + return zlib_return(env, Z_MEM_ERROR); + } + + res = zlib_flush_queue(codec, env, d, input_chunk_size, &output_buffer, + flush, &bytes_produced, &bytes_consumed, &bytes_remaining); + + if(res < 0 && res != Z_BUF_ERROR) { + enif_release_binary(&output_buffer); + return zlib_return(env, res); + } + + if(res == Z_STREAM_END) { + d->eos_seen = 1; + } + + if(d->want_output_crc) { + d->output_crc = + crc32(d->output_crc, output_buffer.data, bytes_produced); + } + + if(bytes_consumed == 0 && bytes_produced == 0 && bytes_remaining != 0) { + /* Die if we've made zero progress; this should not happen on + * well-formed input. */ + + enif_release_binary(&output_buffer); + return zlib_return(env, Z_DATA_ERROR); + } else { + ERL_NIF_TERM flushed_output; + + if(bytes_produced > 0) { + if(bytes_produced < output_buffer.size) { + enif_realloc_binary(&output_buffer, bytes_produced); + } + + flushed_output = + enif_make_list1(env, enif_make_binary(env, &output_buffer)); + } else { + enif_release_binary(&output_buffer); + flushed_output = enif_make_list(env, 0); + } + + if(bytes_remaining == 0 && bytes_produced < output_chunk_size) { + return enif_make_tuple2(env, am_finished, flushed_output); + } else if(res != Z_NEED_DICT) { + return enif_make_tuple2(env, am_continue, flushed_output); + } + + return enif_make_tuple3(env, am_need_dictionary, + enif_make_int(env, d->s.adler), flushed_output); + } +} + +/* zlib nifs */ + +static ERL_NIF_TERM zlib_getStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } + + if(d->stash_env == NULL) { + return am_empty; + } + + return enif_make_tuple2(env, am_ok, enif_make_copy(env, d->stash_term)); +} + +static ERL_NIF_TERM zlib_clearStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->stash_env == NULL) { + return enif_raise_exception(env, am_error); + } + + enif_free_env(d->stash_env); + d->stash_env = NULL; + d->stash_term = NIL; + + return am_ok; +} + +static ERL_NIF_TERM zlib_setStash(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + if(argc != 2 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->stash_env != NULL) { + return enif_raise_exception(env, am_error); + } + + d->stash_env = enif_alloc_env(); + d->stash_term = enif_make_copy(d->stash_env, argv[1]); + + return am_ok; +} + +static ERL_NIF_TERM zlib_open(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + ERL_NIF_TERM result; + + d = (zlib_data_t *) enif_alloc_resource(rtype_zlib, sizeof(zlib_data_t)); + + memset(&d->s, 0, sizeof(z_stream)); + + enif_self(env, &d->controlling_process); + + d->input_queue = enif_ioq_create(ERL_NIF_IOQ_NORMAL); + + d->s.zalloc = zlib_alloc; + d->s.zfree = zlib_free; + d->s.opaque = d; + d->s.data_type = Z_BINARY; + + d->state = ST_NONE; + d->eos_seen = 0; + + d->want_output_crc = 0; + d->want_input_crc = 0; + d->is_raw_stream = 0; + + d->output_crc = crc32(0L, Z_NULL, 0); + d->input_crc = crc32(0L, Z_NULL, 0); + + d->stash_env = NULL; + d->stash_term = NIL; + + d->inflateChunk_buffer_size = 4000; + + result = enif_make_resource(env, d); + enif_release_resource(d); + + return result; +} + +static ERL_NIF_TERM zlib_close(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + /* strictly speaking not needed since the gc will handle this */ + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state == ST_CLOSED) { + return enif_raise_exception(env, am_not_initialized); + } + + gc_zlib(env, d); + + return am_ok; +} + +/* deflate */ + +static ERL_NIF_TERM zlib_deflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int level, res; + + if(argc != 2 || !get_zlib_data(env, argv[0], &d) || + !enif_get_int(env, argv[1], &level)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_NONE) { + return enif_raise_exception(env, am_already_initialized); + } + + res = deflateInit(&d->s, level); + + if(res == Z_OK) { + d->state = ST_DEFLATE; + d->eos_seen = 0; + + /* FIXME: crc32/1 is documented as returning "the current calculated + * checksum," but failed to mention that the old implementation only + * calculated it when WindowBits < 0 (See zlib_deflateInit2). + * + * We could fix this behavior by setting d->want_input_crc to 1 here, + * but we've decided to retain this quirk since the performance hit is + * quite significant. */ + d->want_output_crc = 0; + d->want_input_crc = 0; + + d->output_crc = crc32(0L, Z_NULL, 0); + d->input_crc = crc32(0L, Z_NULL, 0); + } + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_deflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int level, method, windowBits, memLevel, strategy, res; + + if(argc != 6 || !get_zlib_data(env, argv[0], &d) + || !enif_get_int(env, argv[1], &level) + || !enif_get_int(env, argv[2], &method) + || !enif_get_int(env, argv[3], &windowBits) + || !enif_get_int(env, argv[4], &memLevel) + || !enif_get_int(env, argv[5], &strategy)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_NONE) { + return enif_raise_exception(env, am_already_initialized); + } + + res = deflateInit2(&d->s, level, method, windowBits, memLevel, strategy); + + if(res == Z_OK) { + d->state = ST_DEFLATE; + d->eos_seen = 0; + + d->is_raw_stream = (windowBits < 0); + + d->want_output_crc = 0; + d->want_input_crc = d->is_raw_stream; + + d->output_crc = crc32(0L, Z_NULL, 0); + d->input_crc = crc32(0L, Z_NULL, 0); + } + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_deflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + ErlNifBinary bin; + int res; + + if(argc != 2 || !get_zlib_data(env, argv[0], &d) + || !enif_inspect_iolist_as_binary(env, argv[1], &bin)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_DEFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + if((res = deflateSetDictionary(&d->s, bin.data, bin.size)) == Z_OK) { + uLong checksum = d->s.adler; + + /* d->s.adler is not updated in raw deflate mode, so we'll calculate it + * ourselves in case the user wants to rely on that behavior. */ + if(d->is_raw_stream) { + checksum = adler32(0, bin.data, bin.size); + } + + return enif_make_int(env, checksum); + } + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_deflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int res; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_DEFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + res = deflateReset(&d->s); + + d->input_crc = crc32(0L, Z_NULL, 0); + d->eos_seen = 0; + + zlib_reset_input(d); + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_deflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int res; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_DEFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + res = deflateEnd(&d->s); + + if(res == Z_OK && enif_ioq_size(d->input_queue) > 0) { + res = Z_DATA_ERROR; + } + + zlib_reset_input(d); + d->state = ST_NONE; + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int res, level, strategy; + + if(argc != 3 || !get_zlib_data(env, argv[0], &d) + || !enif_get_int(env, argv[1], &level) + || !enif_get_int(env, argv[2], &strategy)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_DEFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + /* deflateParams will flush everything currently in the stream, corrupting + * the heap unless it's empty. We therefore pretend to have a full output + * buffer, forcing a Z_BUF_ERROR if there's anything left to be flushed. */ + d->s.avail_out = 0; + res = deflateParams(&d->s, level, strategy); + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_deflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + int input_chunk_size, output_chunk_size, flush; + + if(argc != 4 || !get_zlib_data(env, argv[0], &d) + || !enif_get_int(env, argv[1], &input_chunk_size) + || !enif_get_int(env, argv[2], &output_chunk_size) + || !enif_get_int(env, argv[3], &flush)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_DEFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + return zlib_codec(&deflate, env, d, input_chunk_size, output_chunk_size, flush); +} + +/* inflate */ + +static ERL_NIF_TERM zlib_inflateInit(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int res; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_NONE) { + return enif_raise_exception(env, am_already_initialized); + } + + res = inflateInit(&d->s); + + if(res == Z_OK) { + d->state = ST_INFLATE; + d->eos_seen = 0; + + d->want_output_crc = 0; + d->want_input_crc = 0; + d->is_raw_stream = 0; + + d->output_crc = crc32(0L, Z_NULL, 0); + d->input_crc = crc32(0L, Z_NULL, 0); + } + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_inflateInit2(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int windowBits, res; + + if(argc != 2 || !get_zlib_data(env, argv[0], &d) + || !enif_get_int(env, argv[1], &windowBits)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_NONE) { + return enif_raise_exception(env, am_already_initialized); + } + + res = inflateInit2(&d->s, windowBits); + + if(res == Z_OK) { + d->state = ST_INFLATE; + d->eos_seen = 0; + + d->is_raw_stream = (windowBits < 0); + + d->want_output_crc = d->is_raw_stream; + d->want_input_crc = 0; + + d->output_crc = crc32(0L, Z_NULL, 0); + d->input_crc = crc32(0L, Z_NULL, 0); + } + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_inflateSetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + ErlNifBinary bin; + int res; + + if(argc != 2 || !get_zlib_data(env, argv[0], &d) + || !enif_inspect_iolist_as_binary(env, argv[1], &bin)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_INFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + res = inflateSetDictionary(&d->s, bin.data, bin.size); + + return zlib_return(env, res); +} + +#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY +/* Work around broken build system with runtime version test */ +static int zlib_supports_inflateGetDictionary(void) { + static int supportsGetDictionary = -1; + +#if defined(__APPLE__) && defined(__MACH__) + if(supportsGetDictionary < 0) { + unsigned int v[4] = {0, 0, 0, 0}; + unsigned hexver; + + sscanf(zlibVersion(), "%u.%u.%u.%u", &v[0], &v[1], &v[2], &v[3]); + + hexver = (v[0] << (8*3)) | (v[1] << (8*2)) | (v[2] << (8)) | v[3]; + supportsGetDictionary = (hexver >= 0x1020701); /* 1.2.7.1 */ + } +#endif + + return supportsGetDictionary; +} +#endif + +static ERL_NIF_TERM zlib_inflateGetDictionary(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_INFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + +#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY + if(zlib_supports_inflateGetDictionary()) { + ErlNifBinary obin; + uInt len; + int res; + + enif_alloc_binary(INFL_DICT_SZ, &obin); + len = 0; + + if((res = inflateGetDictionary(&d->s, obin.data, &len)) < 0) { + enif_release_binary(&obin); + return zlib_return(env, res); + } + + enif_realloc_binary(&obin, (size_t)len); + return enif_make_binary(env, &obin); + } +#endif + + return enif_raise_exception(env, am_not_supported); +} + +static ERL_NIF_TERM zlib_inflateReset(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int res; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_INFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + res = inflateReset(&d->s); + + d->output_crc = crc32(0L, Z_NULL, 0); + d->eos_seen = 0; + + zlib_reset_input(d); + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_inflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + int res; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_INFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + res = inflateEnd(&d->s); + + if(res == Z_OK && (!d->eos_seen || enif_ioq_size(d->input_queue) > 0)) { + res = Z_DATA_ERROR; + } + + zlib_reset_input(d); + d->state = ST_NONE; + + return zlib_return(env, res); +} + +static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + int input_chunk_size, output_chunk_size, flush; + + if(argc != 4 || !get_zlib_data(env, argv[0], &d) + || !enif_get_int(env, argv[1], &input_chunk_size) + || !enif_get_int(env, argv[2], &output_chunk_size) + || !enif_get_int(env, argv[3], &flush)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_INFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + return zlib_codec(&inflate, env, d, input_chunk_size, output_chunk_size, flush); +} + +static ERL_NIF_TERM zlib_crc32(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } + + if(d->state == ST_DEFLATE) { + return enif_make_ulong(env, d->input_crc); + } else if(d->state == ST_INFLATE) { + return enif_make_ulong(env, d->output_crc); + } + + return enif_raise_exception(env, am_not_initialized); +} + +static ERL_NIF_TERM zlib_getBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + if(argc != 1 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } + + return enif_make_int(env, d->inflateChunk_buffer_size); +} + +static ERL_NIF_TERM zlib_setBufSize(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + if(argc != 2 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } + + if(!enif_get_int(env, argv[1], &d->inflateChunk_buffer_size)) { + return enif_make_badarg(env); + } + + return am_ok; +} + +static ERL_NIF_TERM zlib_enqueue_input(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + zlib_data_t *d; + + ErlNifIOVec prealloc, *iovec = &prealloc; + ERL_NIF_TERM tail; + + if(argc != 2 || !get_zlib_data(env, argv[0], &d)) { + return enif_make_badarg(env); + } else if(!zlib_process_check(env, d)) { + return enif_raise_exception(env, am_not_on_controlling_process); + } else if(d->state != ST_DEFLATE && d->state != ST_INFLATE) { + return enif_raise_exception(env, am_not_initialized); + } + + if(!enif_inspect_iovec(env, 256, argv[1], &tail, &iovec)) { + return enif_make_badarg(env); + } else if(!enif_ioq_enqv(d->input_queue, iovec, 0)) { + return enif_make_badarg(env); + } + + if(!enif_is_empty_list(env, tail)) { + return enif_make_tuple2(env, am_continue, tail); + } + + return am_ok; +} diff --git a/erts/emulator/pcre/local_config.h b/erts/emulator/pcre/local_config.h index e90f4dcada..c6af423d72 100644 --- a/erts/emulator/pcre/local_config.h +++ b/erts/emulator/pcre/local_config.h @@ -86,4 +86,4 @@ #define SUPPORT_UTF /* Version number of package */ -#define VERSION "8.40" +#define VERSION "8.41" diff --git a/erts/emulator/pcre/pcre-8.40.tar.bz2 b/erts/emulator/pcre/pcre-8.40.tar.bz2 Binary files differdeleted file mode 100644 index 6147917f4e..0000000000 --- a/erts/emulator/pcre/pcre-8.40.tar.bz2 +++ /dev/null diff --git a/erts/emulator/pcre/pcre-8.41.tar.bz2 b/erts/emulator/pcre/pcre-8.41.tar.bz2 Binary files differnew file mode 100644 index 0000000000..1798432dc9 --- /dev/null +++ b/erts/emulator/pcre/pcre-8.41.tar.bz2 diff --git a/erts/emulator/pcre/pcre.h b/erts/emulator/pcre/pcre.h index 9cbd9c0293..ab8f40cfc1 100644 --- a/erts/emulator/pcre/pcre.h +++ b/erts/emulator/pcre/pcre.h @@ -43,9 +43,9 @@ POSSIBILITY OF SUCH DAMAGE. /* The current PCRE version information. */ #define PCRE_MAJOR 8 -#define PCRE_MINOR 40 +#define PCRE_MINOR 41 #define PCRE_PRERELEASE -#define PCRE_DATE 2017-01-11 +#define PCRE_DATE 2017-07-05 /* When an application links to a PCRE DLL in Windows, the symbols that are imported have to be identified as such. When building PCRE, the appropriate diff --git a/erts/emulator/pcre/pcre_compile.c b/erts/emulator/pcre/pcre_compile.c index 6e841c9cf8..e79284ab79 100644 --- a/erts/emulator/pcre/pcre_compile.c +++ b/erts/emulator/pcre/pcre_compile.c @@ -5740,6 +5740,21 @@ for (;; ptr++) ptr = p - 1; /* Character before the next significant one. */ } + /* We also need to skip over (?# comments, which are not dependent on + extended mode. */ + + if (ptr[1] == CHAR_LEFT_PARENTHESIS && ptr[2] == CHAR_QUESTION_MARK && + ptr[3] == CHAR_NUMBER_SIGN) + { + ptr += 4; + while (*ptr != CHAR_NULL && *ptr != CHAR_RIGHT_PARENTHESIS) ptr++; + if (*ptr == CHAR_NULL) + { + *errorcodeptr = ERR18; + goto FAILED; + } + } + /* If the next character is '+', we have a possessive quantifier. This implies greediness, whatever the setting of the PCRE_UNGREEDY option. If the next character is '?' this is a minimizing repeat, by default, @@ -8211,7 +8226,6 @@ for (;; ptr++) if (mclength == 1 || req_caseopt == 0) { - firstchar = mcbuffer[0] | req_caseopt; firstchar = mcbuffer[0]; firstcharflags = req_caseopt; diff --git a/erts/emulator/pcre/pcre_dfa_exec.c b/erts/emulator/pcre/pcre_dfa_exec.c index 529f40685b..c859d67fc7 100644 --- a/erts/emulator/pcre/pcre_dfa_exec.c +++ b/erts/emulator/pcre/pcre_dfa_exec.c @@ -7,7 +7,7 @@ and semantics are as close as possible to those of the Perl 5 language (but see below for why this module is different). Written by Philip Hazel - Copyright (c) 1997-2014 University of Cambridge + Copyright (c) 1997-2017 University of Cambridge ----------------------------------------------------------------------------- Redistribution and use in source and binary forms, with or without @@ -2626,7 +2626,7 @@ for (;;) if (isinclass) { int max = (int)GET2(ecode, 1 + IMM2_SIZE); - if (*ecode == OP_CRPOSRANGE) + if (*ecode == OP_CRPOSRANGE && count >= (int)GET2(ecode, 1)) { active_count--; /* Remove non-match possibility */ next_active_state--; diff --git a/erts/emulator/pcre/pcre_exec.c b/erts/emulator/pcre/pcre_exec.c index 0f682d3daf..6708ba92a6 100644 --- a/erts/emulator/pcre/pcre_exec.c +++ b/erts/emulator/pcre/pcre_exec.c @@ -755,7 +755,7 @@ if (ecode == NULL) return match((PCRE_PUCHAR)&rdepth, NULL, NULL, 0, NULL, NULL, 1); else { - int len = (char *)&rdepth - (char *)eptr; + int len = (int)((char *)&rdepth - (char *)eptr); return (len > 0)? -len : len; } } diff --git a/erts/emulator/pcre/pcre_internal.h b/erts/emulator/pcre/pcre_internal.h index cc4f171438..c84dcb5a38 100644 --- a/erts/emulator/pcre/pcre_internal.h +++ b/erts/emulator/pcre/pcre_internal.h @@ -2791,6 +2791,9 @@ extern const pcre_uint8 PRIV(ucd_stage1)[]; extern const pcre_uint16 PRIV(ucd_stage2)[]; extern const pcre_uint32 PRIV(ucp_gentype)[]; extern const pcre_uint32 PRIV(ucp_gbtable)[]; +#ifdef COMPILE_PCRE32 +extern const ucd_record PRIV(dummy_ucd_record)[]; +#endif #ifdef SUPPORT_JIT extern const int PRIV(ucp_typerange)[]; #endif @@ -2799,10 +2802,16 @@ extern const int PRIV(ucp_typerange)[]; /* UCD access macros */ #define UCD_BLOCK_SIZE 128 -#define GET_UCD(ch) (PRIV(ucd_records) + \ +#define REAL_GET_UCD(ch) (PRIV(ucd_records) + \ PRIV(ucd_stage2)[PRIV(ucd_stage1)[(int)(ch) / UCD_BLOCK_SIZE] * \ UCD_BLOCK_SIZE + (int)(ch) % UCD_BLOCK_SIZE]) +#ifdef COMPILE_PCRE32 +#define GET_UCD(ch) ((ch > 0x10ffff)? PRIV(dummy_ucd_record) : REAL_GET_UCD(ch)) +#else +#define GET_UCD(ch) REAL_GET_UCD(ch) +#endif + #define UCD_CHARTYPE(ch) GET_UCD(ch)->chartype #define UCD_SCRIPT(ch) GET_UCD(ch)->script #define UCD_CATEGORY(ch) PRIV(ucp_gentype)[UCD_CHARTYPE(ch)] diff --git a/erts/emulator/pcre/pcre_jit_compile.c b/erts/emulator/pcre/pcre_jit_compile.c index 89400498f0..932ca2c389 100644 --- a/erts/emulator/pcre/pcre_jit_compile.c +++ b/erts/emulator/pcre/pcre_jit_compile.c @@ -487,7 +487,7 @@ typedef struct compare_context { #undef CMP /* Used for accessing the elements of the stack. */ -#define STACK(i) ((-(i) - 1) * (int)sizeof(sljit_sw)) +#define STACK(i) ((i) * (int)sizeof(sljit_sw)) #define TMP1 SLJIT_R0 #define TMP2 SLJIT_R2 @@ -552,13 +552,15 @@ the start pointers when the end of the capturing group has not yet reached. */ sljit_emit_cmp(compiler, (type), (src1), (src1w), (src2), (src2w)) #define CMPTO(type, src1, src1w, src2, src2w, label) \ sljit_set_label(sljit_emit_cmp(compiler, (type), (src1), (src1w), (src2), (src2w)), (label)) -#define OP_FLAGS(op, dst, dstw, src, srcw, type) \ - sljit_emit_op_flags(compiler, (op), (dst), (dstw), (src), (srcw), (type)) +#define OP_FLAGS(op, dst, dstw, type) \ + sljit_emit_op_flags(compiler, (op), (dst), (dstw), (type)) #define GET_LOCAL_BASE(dst, dstw, offset) \ sljit_get_local_base(compiler, (dst), (dstw), (offset)) #define READ_CHAR_MAX 0x7fffffff +#define INVALID_UTF_CHAR 888 + static pcre_uchar *bracketend(pcre_uchar *cc) { SLJIT_ASSERT((*cc >= OP_ASSERT && *cc <= OP_ASSERTBACK_NOT) || (*cc >= OP_ONCE && *cc <= OP_SCOND)); @@ -784,7 +786,7 @@ switch(*cc) default: /* All opcodes are supported now! */ - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); return NULL; } } @@ -1660,9 +1662,9 @@ while (cc < ccend) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0)); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -OVECTOR(0)); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); setsom_found = TRUE; } cc += 1; @@ -1676,9 +1678,9 @@ while (cc < ccend) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->mark_ptr); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -common->mark_ptr); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); setmark_found = TRUE; } cc += 1 + 2 + cc[1]; @@ -1689,27 +1691,27 @@ while (cc < ccend) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(0)); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -OVECTOR(0)); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); setsom_found = TRUE; } if (common->mark_ptr != 0 && !setmark_found) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->mark_ptr); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -common->mark_ptr); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); setmark_found = TRUE; } if (common->capture_last_ptr != 0 && !capture_last_found) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -common->capture_last_ptr); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); capture_last_found = TRUE; } cc += 1 + LINK_SIZE; @@ -1723,20 +1725,20 @@ while (cc < ccend) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->capture_last_ptr); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, -common->capture_last_ptr); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); capture_last_found = TRUE; } offset = (GET2(cc, 1 + LINK_SIZE)) << 1; OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, SLJIT_IMM, OVECTOR(offset)); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset)); OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1)); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP1, 0); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), stackpos, TMP2, 0); - stackpos += (int)sizeof(sljit_sw); + stackpos -= (int)sizeof(sljit_sw); cc += 1 + LINK_SIZE + IMM2_SIZE; break; @@ -1887,18 +1889,17 @@ BOOL tmp1empty = TRUE; BOOL tmp2empty = TRUE; pcre_uchar *alternative; enum { - start, loop, end } status; -status = save ? start : loop; -stackptr = STACK(stackptr - 2); +status = loop; +stackptr = STACK(stackptr); stacktop = STACK(stacktop - 1); if (!save) { - stackptr += (needs_control_head ? 2 : 1) * sizeof(sljit_sw); + stacktop -= (needs_control_head ? 2 : 1) * sizeof(sljit_sw); if (stackptr < stacktop) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), stackptr); @@ -1914,196 +1915,186 @@ if (!save) /* The tmp1next must be TRUE in either way. */ } +SLJIT_ASSERT(common->recursive_head_ptr != 0); + do { count = 0; - switch(status) + if (cc >= ccend) { - case start: - SLJIT_ASSERT(save && common->recursive_head_ptr != 0); + if (!save) + break; + count = 1; srcw[0] = common->recursive_head_ptr; if (needs_control_head) { SLJIT_ASSERT(common->control_head_ptr != 0); count = 2; - srcw[1] = common->control_head_ptr; + srcw[0] = common->control_head_ptr; + srcw[1] = common->recursive_head_ptr; + } + status = end; + } + else switch(*cc) + { + case OP_KET: + if (PRIVATE_DATA(cc) != 0) + { + count = 1; + srcw[0] = PRIVATE_DATA(cc); + SLJIT_ASSERT(PRIVATE_DATA(cc + 1) != 0); + cc += PRIVATE_DATA(cc + 1); } - status = loop; + cc += 1 + LINK_SIZE; + break; + + case OP_ASSERT: + case OP_ASSERT_NOT: + case OP_ASSERTBACK: + case OP_ASSERTBACK_NOT: + case OP_ONCE: + case OP_ONCE_NC: + case OP_BRAPOS: + case OP_SBRA: + case OP_SBRAPOS: + case OP_SCOND: + count = 1; + srcw[0] = PRIVATE_DATA(cc); + SLJIT_ASSERT(srcw[0] != 0); + cc += 1 + LINK_SIZE; break; - case loop: - if (cc >= ccend) + case OP_CBRA: + case OP_SCBRA: + if (common->optimized_cbracket[GET2(cc, 1 + LINK_SIZE)] == 0) { - status = end; - break; + count = 1; + srcw[0] = OVECTOR_PRIV(GET2(cc, 1 + LINK_SIZE)); } + cc += 1 + LINK_SIZE + IMM2_SIZE; + break; - switch(*cc) - { - case OP_KET: - if (PRIVATE_DATA(cc) != 0) - { - count = 1; - srcw[0] = PRIVATE_DATA(cc); - SLJIT_ASSERT(PRIVATE_DATA(cc + 1) != 0); - cc += PRIVATE_DATA(cc + 1); - } - cc += 1 + LINK_SIZE; - break; + case OP_CBRAPOS: + case OP_SCBRAPOS: + count = 2; + srcw[0] = PRIVATE_DATA(cc); + srcw[1] = OVECTOR_PRIV(GET2(cc, 1 + LINK_SIZE)); + SLJIT_ASSERT(srcw[0] != 0 && srcw[1] != 0); + cc += 1 + LINK_SIZE + IMM2_SIZE; + break; - case OP_ASSERT: - case OP_ASSERT_NOT: - case OP_ASSERTBACK: - case OP_ASSERTBACK_NOT: - case OP_ONCE: - case OP_ONCE_NC: - case OP_BRAPOS: - case OP_SBRA: - case OP_SBRAPOS: - case OP_SCOND: + case OP_COND: + /* Might be a hidden SCOND. */ + alternative = cc + GET(cc, 1); + if (*alternative == OP_KETRMAX || *alternative == OP_KETRMIN) + { count = 1; srcw[0] = PRIVATE_DATA(cc); SLJIT_ASSERT(srcw[0] != 0); - cc += 1 + LINK_SIZE; - break; - - case OP_CBRA: - case OP_SCBRA: - if (common->optimized_cbracket[GET2(cc, 1 + LINK_SIZE)] == 0) - { - count = 1; - srcw[0] = OVECTOR_PRIV(GET2(cc, 1 + LINK_SIZE)); - } - cc += 1 + LINK_SIZE + IMM2_SIZE; - break; + } + cc += 1 + LINK_SIZE; + break; - case OP_CBRAPOS: - case OP_SCBRAPOS: - count = 2; + CASE_ITERATOR_PRIVATE_DATA_1 + if (PRIVATE_DATA(cc)) + { + count = 1; srcw[0] = PRIVATE_DATA(cc); - srcw[1] = OVECTOR_PRIV(GET2(cc, 1 + LINK_SIZE)); - SLJIT_ASSERT(srcw[0] != 0 && srcw[1] != 0); - cc += 1 + LINK_SIZE + IMM2_SIZE; - break; - - case OP_COND: - /* Might be a hidden SCOND. */ - alternative = cc + GET(cc, 1); - if (*alternative == OP_KETRMAX || *alternative == OP_KETRMIN) - { - count = 1; - srcw[0] = PRIVATE_DATA(cc); - SLJIT_ASSERT(srcw[0] != 0); - } - cc += 1 + LINK_SIZE; - break; - - CASE_ITERATOR_PRIVATE_DATA_1 - if (PRIVATE_DATA(cc)) - { - count = 1; - srcw[0] = PRIVATE_DATA(cc); - } - cc += 2; + } + cc += 2; #ifdef SUPPORT_UTF - if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]); + if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]); #endif - break; + break; - CASE_ITERATOR_PRIVATE_DATA_2A - if (PRIVATE_DATA(cc)) - { - count = 2; - srcw[0] = PRIVATE_DATA(cc); - srcw[1] = PRIVATE_DATA(cc) + sizeof(sljit_sw); - } - cc += 2; + CASE_ITERATOR_PRIVATE_DATA_2A + if (PRIVATE_DATA(cc)) + { + count = 2; + srcw[0] = PRIVATE_DATA(cc); + srcw[1] = PRIVATE_DATA(cc) + sizeof(sljit_sw); + } + cc += 2; #ifdef SUPPORT_UTF - if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]); + if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]); #endif - break; + break; - CASE_ITERATOR_PRIVATE_DATA_2B - if (PRIVATE_DATA(cc)) - { - count = 2; - srcw[0] = PRIVATE_DATA(cc); - srcw[1] = PRIVATE_DATA(cc) + sizeof(sljit_sw); - } - cc += 2 + IMM2_SIZE; + CASE_ITERATOR_PRIVATE_DATA_2B + if (PRIVATE_DATA(cc)) + { + count = 2; + srcw[0] = PRIVATE_DATA(cc); + srcw[1] = PRIVATE_DATA(cc) + sizeof(sljit_sw); + } + cc += 2 + IMM2_SIZE; #ifdef SUPPORT_UTF - if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]); + if (common->utf && HAS_EXTRALEN(cc[-1])) cc += GET_EXTRALEN(cc[-1]); #endif - break; + break; - CASE_ITERATOR_TYPE_PRIVATE_DATA_1 - if (PRIVATE_DATA(cc)) + CASE_ITERATOR_TYPE_PRIVATE_DATA_1 + if (PRIVATE_DATA(cc)) + { + count = 1; + srcw[0] = PRIVATE_DATA(cc); + } + cc += 1; + break; + + CASE_ITERATOR_TYPE_PRIVATE_DATA_2A + if (PRIVATE_DATA(cc)) + { + count = 2; + srcw[0] = PRIVATE_DATA(cc); + srcw[1] = srcw[0] + sizeof(sljit_sw); + } + cc += 1; + break; + + CASE_ITERATOR_TYPE_PRIVATE_DATA_2B + if (PRIVATE_DATA(cc)) + { + count = 2; + srcw[0] = PRIVATE_DATA(cc); + srcw[1] = srcw[0] + sizeof(sljit_sw); + } + cc += 1 + IMM2_SIZE; + break; + + case OP_CLASS: + case OP_NCLASS: +#if defined SUPPORT_UTF || !defined COMPILE_PCRE8 + case OP_XCLASS: + size = (*cc == OP_XCLASS) ? GET(cc, 1) : 1 + 32 / (int)sizeof(pcre_uchar); +#else + size = 1 + 32 / (int)sizeof(pcre_uchar); +#endif + if (PRIVATE_DATA(cc)) + switch(get_class_iterator_size(cc + size)) { + case 1: count = 1; srcw[0] = PRIVATE_DATA(cc); - } - cc += 1; - break; + break; - CASE_ITERATOR_TYPE_PRIVATE_DATA_2A - if (PRIVATE_DATA(cc)) - { + case 2: count = 2; srcw[0] = PRIVATE_DATA(cc); srcw[1] = srcw[0] + sizeof(sljit_sw); - } - cc += 1; - break; + break; - CASE_ITERATOR_TYPE_PRIVATE_DATA_2B - if (PRIVATE_DATA(cc)) - { - count = 2; - srcw[0] = PRIVATE_DATA(cc); - srcw[1] = srcw[0] + sizeof(sljit_sw); + default: + SLJIT_UNREACHABLE(); + break; } - cc += 1 + IMM2_SIZE; - break; - - case OP_CLASS: - case OP_NCLASS: -#if defined SUPPORT_UTF || !defined COMPILE_PCRE8 - case OP_XCLASS: - size = (*cc == OP_XCLASS) ? GET(cc, 1) : 1 + 32 / (int)sizeof(pcre_uchar); -#else - size = 1 + 32 / (int)sizeof(pcre_uchar); -#endif - if (PRIVATE_DATA(cc)) - switch(get_class_iterator_size(cc + size)) - { - case 1: - count = 1; - srcw[0] = PRIVATE_DATA(cc); - break; - - case 2: - count = 2; - srcw[0] = PRIVATE_DATA(cc); - srcw[1] = srcw[0] + sizeof(sljit_sw); - break; - - default: - SLJIT_ASSERT_STOP(); - break; - } - cc += size; - break; - - default: - cc = next_opcode(common, cc); - SLJIT_ASSERT(cc != NULL); - break; - } + cc += size; break; - case end: - SLJIT_ASSERT_STOP(); + default: + cc = next_opcode(common, cc); + SLJIT_ASSERT(cc != NULL); break; } @@ -2312,7 +2303,7 @@ static SLJIT_INLINE void count_match(compiler_common *common) { DEFINE_COMPILER; -OP2(SLJIT_SUB | SLJIT_SET_E, COUNT_MATCH, 0, COUNT_MATCH, 0, SLJIT_IMM, 1); +OP2(SLJIT_SUB | SLJIT_SET_Z, COUNT_MATCH, 0, COUNT_MATCH, 0, SLJIT_IMM, 1); add_jump(compiler, &common->calllimit, JUMP(SLJIT_ZERO)); } @@ -2322,7 +2313,7 @@ static SLJIT_INLINE void allocate_stack(compiler_common *common, int size) DEFINE_COMPILER; SLJIT_ASSERT(size > 0); -OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, size * sizeof(sljit_sw)); +OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, size * sizeof(sljit_sw)); #ifdef DESTROY_REGISTERS OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, 12345); OP1(SLJIT_MOV, TMP3, 0, TMP1, 0); @@ -2330,7 +2321,7 @@ OP1(SLJIT_MOV, RETURN_ADDR, 0, TMP1, 0); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, TMP1, 0); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, TMP1, 0); #endif -add_stub(common, CMP(SLJIT_GREATER, STACK_TOP, 0, STACK_LIMIT, 0)); +add_stub(common, CMP(SLJIT_LESS, STACK_TOP, 0, STACK_LIMIT, 0)); } static SLJIT_INLINE void free_stack(compiler_common *common, int size) @@ -2338,7 +2329,7 @@ static SLJIT_INLINE void free_stack(compiler_common *common, int size) DEFINE_COMPILER; SLJIT_ASSERT(size > 0); -OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, size * sizeof(sljit_sw)); +OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, size * sizeof(sljit_sw)); } static sljit_uw * allocate_read_only_data(compiler_common *common, sljit_uw size) @@ -2396,7 +2387,7 @@ else OP1(SLJIT_MOV, SLJIT_R2, 0, SLJIT_IMM, length - 1); loop = LABEL(); OP1(SLJIT_MOVU, SLJIT_MEM1(SLJIT_R1), sizeof(sljit_sw), SLJIT_R0, 0); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_R2, 0, SLJIT_R2, 0, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, loop); } } @@ -2434,7 +2425,7 @@ else OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_IMM, length - 2); loop = LABEL(); OP1(SLJIT_MOVU, SLJIT_MEM1(TMP2), sizeof(sljit_sw), TMP1, 0); - OP2(SLJIT_SUB | SLJIT_SET_E, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, loop); } @@ -2452,22 +2443,22 @@ static sljit_sw SLJIT_CALL do_search_mark(sljit_sw *current, const pcre_uchar *s { while (current != NULL) { - switch (current[-2]) + switch (current[1]) { case type_then_trap: break; case type_mark: - if (STRCMP_UC_UC(skip_arg, (pcre_uchar *)current[-3]) == 0) - return current[-4]; + if (STRCMP_UC_UC(skip_arg, (pcre_uchar *)current[2]) == 0) + return current[3]; break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } - SLJIT_ASSERT(current > (sljit_sw*)current[-1]); - current = (sljit_sw*)current[-1]; + SLJIT_ASSERT(current[0] == 0 || current < (sljit_sw*)current[0]); + current = (sljit_sw*)current[0]; } return -1; } @@ -2501,7 +2492,7 @@ OP2(SLJIT_ADD, SLJIT_S0, 0, SLJIT_S0, 0, SLJIT_IMM, sizeof(sljit_sw)); OP2(SLJIT_ASHR, SLJIT_S1, 0, SLJIT_S1, 0, SLJIT_IMM, UCHAR_SHIFT); #endif OP1(SLJIT_MOVU_S32, SLJIT_MEM1(SLJIT_R2), sizeof(int), SLJIT_S1, 0); -OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, 1); +OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_R1, 0, SLJIT_R1, 0, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, loop); JUMPHERE(early_quit); @@ -3106,8 +3097,8 @@ if (common->utf) OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); /* Skip low surrogate if necessary. */ OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xdc00); - OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xdc00); + OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL); OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, TMP1, 0); return; @@ -3126,6 +3117,7 @@ struct sljit_jump *jump; if (nltype == NLTYPE_ANY) { add_jump(compiler, &common->anynewline, JUMP(SLJIT_FAST_CALL)); + sljit_set_current_flags(compiler, SLJIT_SET_Z); add_jump(compiler, backtracks, JUMP(jumpifmatch ? SLJIT_NOT_ZERO : SLJIT_ZERO)); } else if (nltype == NLTYPE_ANYCRLF) @@ -3167,7 +3159,7 @@ OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f); OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0); /* Searching for the first zero. */ -OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x800); +OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x800); jump = JUMP(SLJIT_NOT_ZERO); /* Two byte sequence. */ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); @@ -3181,7 +3173,7 @@ OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 6); OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f); OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0); -OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x10000); +OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x10000); jump = JUMP(SLJIT_NOT_ZERO); /* Three byte sequence. */ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2)); @@ -3215,15 +3207,15 @@ OP2(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_IMM, 0x3f); OP2(SLJIT_OR, TMP1, 0, TMP1, 0, TMP2, 0); /* Searching for the first zero. */ -OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x800); +OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x800); jump = JUMP(SLJIT_NOT_ZERO); /* Two byte sequence. */ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); sljit_emit_fast_return(compiler, RETURN_ADDR, 0); JUMPHERE(jump); -OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x400); -OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_NOT_ZERO); +OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x400); +OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_NOT_ZERO); /* This code runs only in 8 bit mode. No need to shift the value. */ OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP2, 0); OP1(MOV_UCHAR, TMP2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); @@ -3246,7 +3238,7 @@ struct sljit_jump *compare; sljit_emit_fast_enter(compiler, RETURN_ADDR, 0); -OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, 0x20); +OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, 0x20); jump = JUMP(SLJIT_NOT_ZERO); /* Two byte sequence. */ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0)); @@ -3287,10 +3279,30 @@ static void do_getucd(compiler_common *common) /* Search the UCD record for the character comes in TMP1. Returns chartype in TMP1 and UCD offset in TMP2. */ DEFINE_COMPILER; +#ifdef COMPILE_PCRE32 +struct sljit_jump *jump; +#endif + +#if defined SLJIT_DEBUG && SLJIT_DEBUG +/* dummy_ucd_record */ +const ucd_record *record = GET_UCD(INVALID_UTF_CHAR); +SLJIT_ASSERT(record->script == ucp_Common && record->chartype == ucp_Cn && record->gbprop == ucp_gbOther); +SLJIT_ASSERT(record->caseset == 0 && record->other_case == 0); +#endif SLJIT_ASSERT(UCD_BLOCK_SIZE == 128 && sizeof(ucd_record) == 8); sljit_emit_fast_enter(compiler, RETURN_ADDR, 0); + +#ifdef COMPILE_PCRE32 +if (!common->utf) + { + jump = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0x10ffff + 1); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, INVALID_UTF_CHAR); + JUMPHERE(jump); + } +#endif + OP2(SLJIT_LSHR, TMP2, 0, TMP1, 0, SLJIT_IMM, UCD_BLOCK_SHIFT); OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(ucd_stage1)); OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, UCD_BLOCK_MASK); @@ -3365,8 +3377,8 @@ if (newlinecheck) OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); end = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0); OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, common->newline & 0xff); - OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, common->newline & 0xff); + OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL); #if defined COMPILE_PCRE16 || defined COMPILE_PCRE32 OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, UCHAR_SHIFT); #endif @@ -3403,8 +3415,8 @@ if (common->utf) { singlechar = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xd800); OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800); - OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800); + OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL); OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0); JUMPHERE(singlechar); @@ -3853,7 +3865,7 @@ while (TRUE) } } -#if (defined SLJIT_CONFIG_X86 && SLJIT_CONFIG_X86) +#if (defined SLJIT_CONFIG_X86 && SLJIT_CONFIG_X86) && !(defined SUPPORT_VALGRIND) static sljit_s32 character_to_int32(pcre_uchar chr) { @@ -4019,6 +4031,7 @@ instruction[0] = 0x0f; instruction[1] = 0xbc; instruction[2] = 0xc0 | (tmp1_ind << 3) | tmp1_ind; sljit_emit_op_custom(compiler, instruction, 3); +sljit_set_current_flags(compiler, SLJIT_SET_Z); nomatch = JUMP(SLJIT_ZERO); @@ -4119,6 +4132,7 @@ instruction[0] = 0x0f; instruction[1] = 0xbc; instruction[2] = 0xc0 | (tmp1_ind << 3) | tmp1_ind; sljit_emit_op_custom(compiler, instruction, 3); +sljit_set_current_flags(compiler, SLJIT_SET_Z); JUMPTO(SLJIT_ZERO, start); @@ -4155,18 +4169,8 @@ if (has_match_end) OP1(SLJIT_MOV, TMP3, 0, STR_END, 0); OP2(SLJIT_ADD, STR_END, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr, SLJIT_IMM, IN_UCHARS(offset + 1)); -#if (defined SLJIT_CONFIG_X86 && SLJIT_CONFIG_X86) - if (sljit_x86_is_cmov_available()) - { - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, STR_END, 0, TMP3, 0); - sljit_x86_emit_cmov(compiler, SLJIT_GREATER, STR_END, TMP3, 0); - } -#endif - { - quit = CMP(SLJIT_LESS_EQUAL, STR_END, 0, TMP3, 0); - OP1(SLJIT_MOV, STR_END, 0, TMP3, 0); - JUMPHERE(quit); - } + OP2(SLJIT_SUB | SLJIT_SET_GREATER, SLJIT_UNUSED, 0, STR_END, 0, TMP3, 0); + sljit_emit_cmov(compiler, SLJIT_GREATER, STR_END, TMP3, 0); } #if defined SUPPORT_UTF && !defined COMPILE_PCRE32 @@ -4174,11 +4178,11 @@ if (common->utf && offset > 0) utf_start = LABEL(); #endif -#if (defined SLJIT_CONFIG_X86 && SLJIT_CONFIG_X86) +#if (defined SLJIT_CONFIG_X86 && SLJIT_CONFIG_X86) && !(defined SUPPORT_VALGRIND) /* SSE2 accelerated first character search. */ -if (sljit_x86_is_sse2_available()) +if (sljit_has_cpu_feature(SLJIT_HAS_SSE2)) { fast_forward_first_char2_sse2(common, char1, char2); @@ -4213,16 +4217,16 @@ if (sljit_x86_is_sse2_available()) if (offset > 0) OP2(SLJIT_SUB, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(offset)); } - else if (sljit_x86_is_cmov_available()) - { - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, STR_PTR, 0, STR_END, 0); - sljit_x86_emit_cmov(compiler, SLJIT_GREATER_EQUAL, STR_PTR, has_match_end ? SLJIT_MEM1(SLJIT_SP) : STR_END, has_match_end ? common->match_end_ptr : 0); - } else { - quit = CMP(SLJIT_LESS, STR_PTR, 0, STR_END, 0); - OP1(SLJIT_MOV, STR_PTR, 0, has_match_end ? SLJIT_MEM1(SLJIT_SP) : STR_END, has_match_end ? common->match_end_ptr : 0); - JUMPHERE(quit); + OP2(SLJIT_SUB | SLJIT_SET_GREATER_EQUAL, SLJIT_UNUSED, 0, STR_PTR, 0, STR_END, 0); + if (has_match_end) + { + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), common->match_end_ptr); + sljit_emit_cmov(compiler, SLJIT_GREATER_EQUAL, STR_PTR, TMP1, 0); + } + else + sljit_emit_cmov(compiler, SLJIT_GREATER_EQUAL, STR_PTR, STR_END, 0); } if (has_match_end) @@ -4249,10 +4253,10 @@ else } else { - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, char1); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, char2); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, char1); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, char2); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL); found = JUMP(SLJIT_NOT_ZERO); } } @@ -4571,8 +4575,8 @@ if (common->nltype == NLTYPE_FIXED && common->newline > 255) firstchar = CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, TMP2, 0); OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, IN_UCHARS(2)); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, STR_PTR, 0, TMP1, 0); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_GREATER_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_GREATER_EQUAL, SLJIT_UNUSED, 0, STR_PTR, 0, TMP1, 0); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_GREATER_EQUAL); #if defined COMPILE_PCRE16 || defined COMPILE_PCRE32 OP2(SLJIT_SHL, TMP2, 0, TMP2, 0, SLJIT_IMM, UCHAR_SHIFT); #endif @@ -4616,8 +4620,8 @@ if (common->nltype == NLTYPE_ANY || common->nltype == NLTYPE_ANYCRLF) JUMPHERE(foundcr); notfoundnl = CMP(SLJIT_GREATER_EQUAL, STR_PTR, 0, STR_END, 0); OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), 0); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_NL); - OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, CHAR_NL); + OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL); #if defined COMPILE_PCRE16 || defined COMPILE_PCRE32 OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, UCHAR_SHIFT); #endif @@ -4670,7 +4674,7 @@ if (!check_class_ranges(common, start_bits, (start_bits[31] & 0x80) != 0, TRUE, OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3); OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)start_bits); OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0); - OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); + OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); found = JUMP(SLJIT_NOT_ZERO); } @@ -4692,8 +4696,8 @@ if (common->utf) { CMPTO(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xd800, start); OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800); - OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800); + OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL); OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0); } @@ -4780,31 +4784,31 @@ struct sljit_jump *jump; struct sljit_label *mainloop; sljit_emit_fast_enter(compiler, RETURN_ADDR, 0); -OP1(SLJIT_MOV, TMP1, 0, STACK_TOP, 0); -GET_LOCAL_BASE(TMP3, 0, 0); +OP1(SLJIT_MOV, TMP3, 0, STACK_TOP, 0); +GET_LOCAL_BASE(TMP1, 0, 0); /* Drop frames until we reach STACK_TOP. */ mainloop = LABEL(); -OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(TMP1), 0); -OP2(SLJIT_SUB | SLJIT_SET_S, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, 0); -jump = JUMP(SLJIT_SIG_LESS_EQUAL); - -OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, TMP3, 0); -OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, SLJIT_MEM1(TMP1), sizeof(sljit_sw)); -OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), sizeof(sljit_sw), SLJIT_MEM1(TMP1), 2 * sizeof(sljit_sw)); -OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 3 * sizeof(sljit_sw)); +OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), -sizeof(sljit_sw)); +jump = CMP(SLJIT_SIG_LESS_EQUAL, TMP2, 0, SLJIT_IMM, 0); + +OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, TMP1, 0); +OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, SLJIT_MEM1(STACK_TOP), -2 * sizeof(sljit_sw)); +OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), sizeof(sljit_sw), SLJIT_MEM1(STACK_TOP), -3 * sizeof(sljit_sw)); +OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 3 * sizeof(sljit_sw)); JUMPTO(SLJIT_JUMP, mainloop); JUMPHERE(jump); -jump = JUMP(SLJIT_SIG_LESS); -/* End of dropping frames. */ +jump = CMP(SLJIT_NOT_ZERO /* SIG_LESS */, TMP2, 0, SLJIT_IMM, 0); +/* End of reverting values. */ +OP1(SLJIT_MOV, STACK_TOP, 0, TMP3, 0); sljit_emit_fast_return(compiler, RETURN_ADDR, 0); JUMPHERE(jump); OP1(SLJIT_NEG, TMP2, 0, TMP2, 0); -OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, TMP3, 0); -OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, SLJIT_MEM1(TMP1), sizeof(sljit_sw)); -OP2(SLJIT_ADD, TMP1, 0, TMP1, 0, SLJIT_IMM, 2 * sizeof(sljit_sw)); +OP2(SLJIT_ADD, TMP2, 0, TMP2, 0, TMP1, 0); +OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), 0, SLJIT_MEM1(STACK_TOP), -2 * sizeof(sljit_sw)); +OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, 2 * sizeof(sljit_sw)); JUMPTO(SLJIT_JUMP, mainloop); } @@ -4837,11 +4841,11 @@ if (common->use_ucp) jump = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_UNDERSCORE); add_jump(compiler, &common->getucd, JUMP(SLJIT_FAST_CALL)); OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ucp_Ll); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_Lu - ucp_Ll); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_Lu - ucp_Ll); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL); OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ucp_Nd - ucp_Ll); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_No - ucp_Nd); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_No - ucp_Nd); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL); JUMPHERE(jump); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, TMP2, 0); } @@ -4881,11 +4885,11 @@ if (common->use_ucp) jump = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_UNDERSCORE); add_jump(compiler, &common->getucd, JUMP(SLJIT_FAST_CALL)); OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ucp_Ll); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_Lu - ucp_Ll); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_Lu - ucp_Ll); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL); OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, ucp_Nd - ucp_Ll); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_No - ucp_Nd); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ucp_No - ucp_Nd); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL); JUMPHERE(jump); } else @@ -4913,7 +4917,7 @@ else } set_jumps(skipread_list, LABEL()); -OP2(SLJIT_XOR | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1); +OP2(SLJIT_XOR | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1); sljit_emit_fast_return(compiler, SLJIT_MEM1(SLJIT_SP), LOCALS0); } @@ -5064,7 +5068,7 @@ switch(length) return TRUE; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); return FALSE; } } @@ -5077,22 +5081,22 @@ DEFINE_COMPILER; sljit_emit_fast_enter(compiler, RETURN_ADDR, 0); OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x0a); -OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x0d - 0x0a); -OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS_EQUAL); -OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x0a); +OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x0d - 0x0a); +OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL); +OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x0a); #if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32 #ifdef COMPILE_PCRE8 if (common->utf) { #endif - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x1); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2029 - 0x0a); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2029 - 0x0a); #ifdef COMPILE_PCRE8 } #endif #endif /* SUPPORT_UTF || COMPILE_PCRE16 || COMPILE_PCRE32 */ -OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); +OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL); sljit_emit_fast_return(compiler, RETURN_ADDR, 0); } @@ -5103,34 +5107,34 @@ DEFINE_COMPILER; sljit_emit_fast_enter(compiler, RETURN_ADDR, 0); -OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x09); -OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); -OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x20); -OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); -OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xa0); +OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x09); +OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL); +OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x20); +OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); +OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xa0); #if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32 #ifdef COMPILE_PCRE8 if (common->utf) { #endif - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x1680); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x1680); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x2000); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x200A - 0x2000); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x202f - 0x2000); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x205f - 0x2000); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x3000 - 0x2000); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x200A - 0x2000); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x202f - 0x2000); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x205f - 0x2000); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x3000 - 0x2000); #ifdef COMPILE_PCRE8 } #endif #endif /* SUPPORT_UTF || COMPILE_PCRE16 || COMPILE_PCRE32 */ -OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); +OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL); sljit_emit_fast_return(compiler, RETURN_ADDR, 0); } @@ -5143,22 +5147,22 @@ DEFINE_COMPILER; sljit_emit_fast_enter(compiler, RETURN_ADDR, 0); OP2(SLJIT_SUB, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x0a); -OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x0d - 0x0a); -OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS_EQUAL); -OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x0a); +OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x0d - 0x0a); +OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL); +OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x0a); #if defined SUPPORT_UTF || defined COMPILE_PCRE16 || defined COMPILE_PCRE32 #ifdef COMPILE_PCRE8 if (common->utf) { #endif - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); OP2(SLJIT_OR, TMP1, 0, TMP1, 0, SLJIT_IMM, 0x1); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2029 - 0x0a); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2029 - 0x0a); #ifdef COMPILE_PCRE8 } #endif #endif /* SUPPORT_UTF || COMPILE_PCRE16 || COMPILE_PCRE32 */ -OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); +OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL); sljit_emit_fast_return(compiler, RETURN_ADDR, 0); } @@ -5183,7 +5187,7 @@ label = LABEL(); OP1(MOVU_UCHAR, CHAR1, 0, SLJIT_MEM1(TMP1), IN_UCHARS(1)); OP1(MOVU_UCHAR, CHAR2, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); jump = CMP(SLJIT_NOT_EQUAL, CHAR1, 0, CHAR2, 0); -OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); +OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); JUMPTO(SLJIT_NOT_ZERO, label); JUMPHERE(jump); @@ -5227,7 +5231,7 @@ OP1(SLJIT_MOV_U8, CHAR2, 0, SLJIT_MEM2(LCC_TABLE, CHAR2), 0); JUMPHERE(jump); #endif jump = CMP(SLJIT_NOT_EQUAL, CHAR1, 0, CHAR2, 0); -OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); +OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, IN_UCHARS(1)); JUMPTO(SLJIT_NOT_ZERO, label); JUMPHERE(jump); @@ -5394,7 +5398,7 @@ do #endif default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } context->ucharptr = 0; @@ -5568,7 +5572,7 @@ while (*cc != XCL_END) break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } cc += 2; @@ -5592,7 +5596,7 @@ if ((cc[-1] & XCL_HASPROP) == 0) OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3); OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)cc); OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0); - OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); + OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); add_jump(compiler, &found, JUMP(SLJIT_NOT_ZERO)); } @@ -5625,7 +5629,7 @@ else if ((cc[-1] & XCL_MAP) != 0) OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3); OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)cc); OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0); - OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); + OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); add_jump(compiler, list, JUMP(SLJIT_NOT_ZERO)); #ifdef COMPILE_PCRE8 @@ -5644,6 +5648,15 @@ if (needstype || needsscript) if (needschar && !charsaved) OP1(SLJIT_MOV, RETURN_ADDR, 0, TMP1, 0); +#ifdef COMPILE_PCRE32 + if (!common->utf) + { + jump = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0x10ffff + 1); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_IMM, INVALID_UTF_CHAR); + JUMPHERE(jump); + } +#endif + OP2(SLJIT_LSHR, TMP2, 0, TMP1, 0, SLJIT_IMM, UCD_BLOCK_SHIFT); OP1(SLJIT_MOV_U8, TMP2, 0, SLJIT_MEM1(TMP2), (sljit_sw)PRIV(ucd_stage1)); OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, UCD_BLOCK_MASK); @@ -5735,14 +5748,14 @@ while (*cc != XCL_END) if (numberofcmps < 3 && (*cc == XCL_SINGLE || *cc == XCL_RANGE)) { - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset)); - OP_FLAGS(numberofcmps == 0 ? SLJIT_MOV : SLJIT_OR, TMP2, 0, numberofcmps == 0 ? SLJIT_UNUSED : TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset)); + OP_FLAGS(numberofcmps == 0 ? SLJIT_MOV : SLJIT_OR, TMP2, 0, SLJIT_EQUAL); numberofcmps++; } else if (numberofcmps > 0) { - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset)); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset)); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL); jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp); numberofcmps = 0; } @@ -5761,14 +5774,14 @@ while (*cc != XCL_END) if (numberofcmps < 3 && (*cc == XCL_SINGLE || *cc == XCL_RANGE)) { - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset)); - OP_FLAGS(numberofcmps == 0 ? SLJIT_MOV : SLJIT_OR, TMP2, 0, numberofcmps == 0 ? SLJIT_UNUSED : TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset)); + OP_FLAGS(numberofcmps == 0 ? SLJIT_MOV : SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL); numberofcmps++; } else if (numberofcmps > 0) { - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset)); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(c - charoffset)); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_LESS_EQUAL); jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp); numberofcmps = 0; } @@ -5793,12 +5806,12 @@ while (*cc != XCL_END) break; case PT_LAMP: - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lu - typeoffset); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Ll - typeoffset); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lt - typeoffset); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lu - typeoffset); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Ll - typeoffset); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lt - typeoffset); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_EQUAL); jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp); break; @@ -5820,33 +5833,33 @@ while (*cc != XCL_END) case PT_SPACE: case PT_PXSPACE: SET_CHAR_OFFSET(9); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd - 0x9); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd - 0x9); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x9); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x85 - 0x9); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e - 0x9); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e - 0x9); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); SET_TYPE_OFFSET(ucp_Zl); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Zs - ucp_Zl); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Zs - ucp_Zl); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_LESS_EQUAL); jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp); break; case PT_WORD: - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_UNDERSCORE - charoffset)); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_UNDERSCORE - charoffset)); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL); /* Fall through. */ case PT_ALNUM: SET_TYPE_OFFSET(ucp_Ll); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lu - ucp_Ll); - OP_FLAGS((*cc == PT_ALNUM) ? SLJIT_MOV : SLJIT_OR, TMP2, 0, (*cc == PT_ALNUM) ? SLJIT_UNUSED : TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Lu - ucp_Ll); + OP_FLAGS((*cc == PT_ALNUM) ? SLJIT_MOV : SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL); SET_TYPE_OFFSET(ucp_Nd); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_No - ucp_Nd); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_No - ucp_Nd); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_LESS_EQUAL); jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp); break; @@ -5868,8 +5881,8 @@ while (*cc != XCL_END) OP2(SLJIT_ADD, TMP2, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)charoffset); OP2(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_IMM, other_cases[1] ^ other_cases[0]); } - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, other_cases[1]); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, other_cases[1]); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL); other_cases += 2; } else if (is_powerof2(other_cases[2] ^ other_cases[1])) @@ -5881,63 +5894,63 @@ while (*cc != XCL_END) OP2(SLJIT_ADD, TMP2, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)charoffset); OP2(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_IMM, other_cases[1] ^ other_cases[0]); } - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, other_cases[2]); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP2, 0, SLJIT_IMM, other_cases[2]); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(other_cases[0] - charoffset)); - OP_FLAGS(SLJIT_OR | ((other_cases[3] == NOTACHAR) ? SLJIT_SET_E : 0), TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(other_cases[0] - charoffset)); + OP_FLAGS(SLJIT_OR | ((other_cases[3] == NOTACHAR) ? SLJIT_SET_Z : 0), TMP2, 0, SLJIT_EQUAL); other_cases += 3; } else { - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(*other_cases++ - charoffset)); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(*other_cases++ - charoffset)); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL); } while (*other_cases != NOTACHAR) { - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(*other_cases++ - charoffset)); - OP_FLAGS(SLJIT_OR | ((*other_cases == NOTACHAR) ? SLJIT_SET_E : 0), TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(*other_cases++ - charoffset)); + OP_FLAGS(SLJIT_OR | ((*other_cases == NOTACHAR) ? SLJIT_SET_Z : 0), TMP2, 0, SLJIT_EQUAL); } jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp); break; case PT_UCNC: - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_DOLLAR_SIGN - charoffset)); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_COMMERCIAL_AT - charoffset)); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_GRAVE_ACCENT - charoffset)); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_DOLLAR_SIGN - charoffset)); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_COMMERCIAL_AT - charoffset)); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(CHAR_GRAVE_ACCENT - charoffset)); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); SET_CHAR_OFFSET(0xa0); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(0xd7ff - charoffset)); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (sljit_sw)(0xd7ff - charoffset)); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_LESS_EQUAL); SET_CHAR_OFFSET(0); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xe000 - 0); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_GREATER_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_GREATER_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xe000 - 0); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_GREATER_EQUAL); jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp); break; case PT_PXGRAPH: /* C and Z groups are the farthest two groups. */ SET_TYPE_OFFSET(ucp_Ll); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Ll); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_GREATER); + OP2(SLJIT_SUB | SLJIT_SET_GREATER, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Ll); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_GREATER); jump = CMP(SLJIT_NOT_EQUAL, typereg, 0, SLJIT_IMM, ucp_Cf - ucp_Ll); /* In case of ucp_Cf, we overwrite the result. */ SET_CHAR_OFFSET(0x2066); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2069 - 0x2066); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2069 - 0x2066); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x061c - 0x2066); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x061c - 0x2066); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e - 0x2066); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x180e - 0x2066); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); JUMPHERE(jump); jump = CMP(SLJIT_ZERO ^ invertcmp, TMP2, 0, SLJIT_IMM, 0); @@ -5946,21 +5959,21 @@ while (*cc != XCL_END) case PT_PXPRINT: /* C and Z groups are the farthest two groups. */ SET_TYPE_OFFSET(ucp_Ll); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Ll); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_GREATER); + OP2(SLJIT_SUB | SLJIT_SET_GREATER, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Ll); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_GREATER); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Zs - ucp_Ll); - OP_FLAGS(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_NOT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Zs - ucp_Ll); + OP_FLAGS(SLJIT_AND, TMP2, 0, SLJIT_NOT_EQUAL); jump = CMP(SLJIT_NOT_EQUAL, typereg, 0, SLJIT_IMM, ucp_Cf - ucp_Ll); /* In case of ucp_Cf, we overwrite the result. */ SET_CHAR_OFFSET(0x2066); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2069 - 0x2066); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x2069 - 0x2066); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x061c - 0x2066); - OP_FLAGS(SLJIT_OR, TMP2, 0, TMP2, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x061c - 0x2066); + OP_FLAGS(SLJIT_OR, TMP2, 0, SLJIT_EQUAL); JUMPHERE(jump); jump = CMP(SLJIT_ZERO ^ invertcmp, TMP2, 0, SLJIT_IMM, 0); @@ -5968,21 +5981,21 @@ while (*cc != XCL_END) case PT_PXPUNCT: SET_TYPE_OFFSET(ucp_Sc); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Sc); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_So - ucp_Sc); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS_EQUAL); SET_CHAR_OFFSET(0); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x7f); - OP_FLAGS(SLJIT_AND, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0x7f); + OP_FLAGS(SLJIT_AND, TMP2, 0, SLJIT_LESS_EQUAL); SET_TYPE_OFFSET(ucp_Pc); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Ps - ucp_Pc); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_LESS_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS_EQUAL, SLJIT_UNUSED, 0, typereg, 0, SLJIT_IMM, ucp_Ps - ucp_Pc); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_LESS_EQUAL); jump = JUMP(SLJIT_NOT_ZERO ^ invertcmp); break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } cc += 2; @@ -6028,6 +6041,7 @@ switch(type) case OP_NOT_WORD_BOUNDARY: case OP_WORD_BOUNDARY: add_jump(compiler, &common->wordboundary, JUMP(SLJIT_FAST_CALL)); + sljit_set_current_flags(compiler, SLJIT_SET_Z); add_jump(compiler, backtracks, JUMP(type == OP_NOT_WORD_BOUNDARY ? SLJIT_NOT_ZERO : SLJIT_ZERO)); return cc; @@ -6043,10 +6057,10 @@ switch(type) else { jump[1] = CMP(SLJIT_EQUAL, TMP2, 0, STR_END, 0); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP2, 0, STR_END, 0); - OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_UNUSED, 0, SLJIT_LESS); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff); - OP_FLAGS(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_NOT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_LESS, SLJIT_UNUSED, 0, TMP2, 0, STR_END, 0); + OP_FLAGS(SLJIT_MOV, TMP2, 0, SLJIT_LESS); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, (common->newline >> 8) & 0xff); + OP_FLAGS(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, SLJIT_NOT_EQUAL); add_jump(compiler, backtracks, JUMP(SLJIT_NOT_EQUAL)); check_partial(common, TRUE); add_jump(compiler, backtracks, JUMP(SLJIT_JUMP)); @@ -6068,9 +6082,9 @@ switch(type) OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(0)); jump[1] = CMP(SLJIT_NOT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_CR); OP2(SLJIT_ADD, TMP2, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(2)); - OP2(SLJIT_SUB | SLJIT_SET_U, SLJIT_UNUSED, 0, TMP2, 0, STR_END, 0); + OP2(SLJIT_SUB | SLJIT_SET_Z | SLJIT_SET_GREATER, SLJIT_UNUSED, 0, TMP2, 0, STR_END, 0); jump[2] = JUMP(SLJIT_GREATER); - add_jump(compiler, backtracks, JUMP(SLJIT_LESS)); + add_jump(compiler, backtracks, JUMP(SLJIT_NOT_EQUAL) /* LESS */); /* Equal. */ OP1(MOV_UCHAR, TMP1, 0, SLJIT_MEM1(STR_PTR), IN_UCHARS(1)); jump[3] = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_IMM, CHAR_NL); @@ -6089,6 +6103,7 @@ switch(type) read_char_range(common, common->nlmin, common->nlmax, TRUE); add_jump(compiler, backtracks, CMP(SLJIT_NOT_EQUAL, STR_PTR, 0, STR_END, 0)); add_jump(compiler, &common->anynewline, JUMP(SLJIT_FAST_CALL)); + sljit_set_current_flags(compiler, SLJIT_SET_Z); add_jump(compiler, backtracks, JUMP(SLJIT_ZERO)); OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), LOCALS1); } @@ -6204,7 +6219,7 @@ switch(type) label = LABEL(); add_jump(compiler, backtracks, CMP(SLJIT_LESS_EQUAL, STR_PTR, 0, TMP3, 0)); skip_char_back(common); - OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, TMP2, 0, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, TMP2, 0, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, label); } else @@ -6217,7 +6232,7 @@ switch(type) check_start_used_ptr(common); return cc + LINK_SIZE; } -SLJIT_ASSERT_STOP(); +SLJIT_UNREACHABLE(); return cc; } @@ -6250,7 +6265,7 @@ switch(type) #endif read_char8_type(common, type == OP_NOT_DIGIT); /* Flip the starting bit in the negative case. */ - OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_digit); + OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_digit); add_jump(compiler, backtracks, JUMP(type == OP_DIGIT ? SLJIT_ZERO : SLJIT_NOT_ZERO)); return cc; @@ -6264,7 +6279,7 @@ switch(type) else #endif read_char8_type(common, type == OP_NOT_WHITESPACE); - OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_space); + OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_space); add_jump(compiler, backtracks, JUMP(type == OP_WHITESPACE ? SLJIT_ZERO : SLJIT_NOT_ZERO)); return cc; @@ -6278,7 +6293,7 @@ switch(type) else #endif read_char8_type(common, type == OP_NOT_WORDCHAR); - OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_word); + OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, ctype_word); add_jump(compiler, backtracks, JUMP(type == OP_WORDCHAR ? SLJIT_ZERO : SLJIT_NOT_ZERO)); return cc; @@ -6320,8 +6335,8 @@ switch(type) #elif defined COMPILE_PCRE16 jump[0] = CMP(SLJIT_LESS, TMP1, 0, SLJIT_IMM, 0xd800); OP2(SLJIT_AND, TMP1, 0, TMP1, 0, SLJIT_IMM, 0xfc00); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800); - OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_UNUSED, 0, SLJIT_EQUAL); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, SLJIT_IMM, 0xd800); + OP_FLAGS(SLJIT_MOV, TMP1, 0, SLJIT_EQUAL); OP2(SLJIT_SHL, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, TMP1, 0); #endif @@ -6383,6 +6398,7 @@ switch(type) detect_partial_match(common, backtracks); read_char_range(common, 0x9, 0x3000, type == OP_NOT_HSPACE); add_jump(compiler, &common->hspace, JUMP(SLJIT_FAST_CALL)); + sljit_set_current_flags(compiler, SLJIT_SET_Z); add_jump(compiler, backtracks, JUMP(type == OP_NOT_HSPACE ? SLJIT_NOT_ZERO : SLJIT_ZERO)); return cc; @@ -6392,6 +6408,7 @@ switch(type) detect_partial_match(common, backtracks); read_char_range(common, 0xa, 0x2029, type == OP_NOT_VSPACE); add_jump(compiler, &common->vspace, JUMP(SLJIT_FAST_CALL)); + sljit_set_current_flags(compiler, SLJIT_SET_Z); add_jump(compiler, backtracks, JUMP(type == OP_NOT_VSPACE ? SLJIT_NOT_ZERO : SLJIT_ZERO)); return cc; @@ -6418,7 +6435,7 @@ switch(type) OP1(SLJIT_MOV_U32, TMP1, 0, SLJIT_MEM1(STACK_TOP), (sljit_sw)PRIV(ucp_gbtable)); OP1(SLJIT_MOV, STACK_TOP, 0, TMP2, 0); OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0); - OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); + OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); JUMPTO(SLJIT_NOT_ZERO, label); OP1(SLJIT_MOV, STR_PTR, 0, TMP3, 0); @@ -6587,7 +6604,7 @@ switch(type) OP2(SLJIT_LSHR, TMP1, 0, TMP1, 0, SLJIT_IMM, 3); OP1(SLJIT_MOV_U8, TMP1, 0, SLJIT_MEM1(TMP1), (sljit_sw)cc); OP2(SLJIT_SHL, TMP2, 0, SLJIT_IMM, 1, TMP2, 0); - OP2(SLJIT_AND | SLJIT_SET_E, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); + OP2(SLJIT_AND | SLJIT_SET_Z, SLJIT_UNUSED, 0, TMP1, 0, TMP2, 0); add_jump(compiler, backtracks, JUMP(SLJIT_ZERO)); #if defined SUPPORT_UTF || !defined COMPILE_PCRE8 @@ -6604,7 +6621,7 @@ switch(type) return cc + GET(cc, 0) - 1; #endif } -SLJIT_ASSERT_STOP(); +SLJIT_UNREACHABLE(); return cc; } @@ -6790,9 +6807,9 @@ else #endif /* SUPPORT_UTF && SUPPORT_UCP */ { if (ref) - OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), TMP1, 0); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), TMP1, 0); else - OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw), TMP1, 0); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw), TMP1, 0); if (withchecks) jump = JUMP(SLJIT_ZERO); @@ -6883,7 +6900,7 @@ switch(type) cc += 1 + IMM2_SIZE + 1 + 2 * IMM2_SIZE; break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } @@ -6897,7 +6914,7 @@ if (!minimize) OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(1), SLJIT_IMM, 0); /* Temporary release of STR_PTR. */ - OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); + OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); /* Handles both invalid and empty cases. Since the minimum repeat, is zero the invalid case is basically the same as an empty case. */ if (ref) @@ -6910,7 +6927,7 @@ if (!minimize) zerolength = CMP(SLJIT_EQUAL, TMP1, 0, SLJIT_MEM1(TMP2), sizeof(sljit_sw)); } /* Restore if not zero length. */ - OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); } else { @@ -7157,7 +7174,7 @@ return (*PUBL(callout))(callout_block); (((int)sizeof(PUBL(callout_block)) + 7) & ~7) #define CALLOUT_ARG_OFFSET(arg) \ - (-CALLOUT_ARG_SIZE + SLJIT_OFFSETOF(PUBL(callout_block), arg)) + SLJIT_OFFSETOF(PUBL(callout_block), arg) static SLJIT_INLINE pcre_uchar *compile_callout_matchingpath(compiler_common *common, pcre_uchar *cc, backtrack_common *parent) { @@ -7187,7 +7204,8 @@ OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), CALLOUT_ARG_OFFSET(mark), (common->mark_pt /* Needed to save important temporary registers. */ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS0, STACK_TOP, 0); -OP2(SLJIT_SUB, SLJIT_R1, 0, STACK_TOP, 0, SLJIT_IMM, CALLOUT_ARG_SIZE); +/* SLJIT_R0 = arguments */ +OP1(SLJIT_MOV, SLJIT_R1, 0, STACK_TOP, 0); GET_LOCAL_BASE(SLJIT_R2, 0, OVECTOR_START); sljit_emit_ijump(compiler, SLJIT_CALL3, SLJIT_IMM, SLJIT_FUNC_OFFSET(do_callout)); OP1(SLJIT_MOV_S32, SLJIT_RETURN_REG, 0, SLJIT_RETURN_REG, 0); @@ -7195,12 +7213,12 @@ OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), LOCALS0); free_stack(common, CALLOUT_ARG_SIZE / sizeof(sljit_sw)); /* Check return value. */ -OP2(SLJIT_SUB | SLJIT_SET_S, SLJIT_UNUSED, 0, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0); +OP2(SLJIT_SUB | SLJIT_SET_Z | SLJIT_SET_SIG_GREATER, SLJIT_UNUSED, 0, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0); add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_SIG_GREATER)); if (common->forced_quit_label == NULL) - add_jump(compiler, &common->forced_quit, JUMP(SLJIT_SIG_LESS)); + add_jump(compiler, &common->forced_quit, JUMP(SLJIT_NOT_EQUAL) /* SIG_LESS */); else - JUMPTO(SLJIT_SIG_LESS, common->forced_quit_label); + JUMPTO(SLJIT_NOT_EQUAL /* SIG_LESS */, common->forced_quit_label); return cc + 2 + 2 * LINK_SIZE; } @@ -7321,7 +7339,7 @@ else allocate_stack(common, framesize + extrasize); OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); - OP2(SLJIT_SUB, TMP2, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + extrasize) * sizeof(sljit_sw)); + OP2(SLJIT_ADD, TMP2, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + extrasize) * sizeof(sljit_sw)); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP2, 0); if (needs_control_head) OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr); @@ -7392,22 +7410,22 @@ while (1) free_stack(common, extrasize); if (needs_control_head) - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), 0); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(-1)); } else { if ((opcode != OP_ASSERT_NOT && opcode != OP_ASSERTBACK_NOT) || conditional) { /* We don't need to keep the STR_PTR, only the previous private_data_ptr. */ - OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 1) * sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 1) * sizeof(sljit_sw)); if (needs_control_head) - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), 0); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(-1)); } else { OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); if (needs_control_head) - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), (framesize + 1) * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_MEM1(STACK_TOP), STACK(-framesize - 2)); add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); } } @@ -7418,25 +7436,25 @@ while (1) if (conditional) { if (extrasize > 0) - OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), needs_control_head ? sizeof(sljit_sw) : 0); + OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), needs_control_head ? STACK(-2) : STACK(-1)); } else if (bra == OP_BRAZERO) { if (framesize < 0) - OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), (extrasize - 1) * sizeof(sljit_sw)); + OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(-extrasize)); else { - OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), framesize * sizeof(sljit_sw)); - OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), (framesize + extrasize - 1) * sizeof(sljit_sw)); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(-framesize - 1)); + OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(-framesize - extrasize)); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, TMP1, 0); } - OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0); } else if (framesize >= 0) { /* For OP_BRA and OP_BRAMINZERO. */ - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), framesize * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-framesize - 1)); } } add_jump(compiler, found, JUMP(SLJIT_JUMP)); @@ -7480,12 +7498,12 @@ if (common->positive_assert_quit != NULL) set_jumps(common->positive_assert_quit, LABEL()); SLJIT_ASSERT(framesize != no_stack); if (framesize < 0) - OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, extrasize * sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, extrasize * sizeof(sljit_sw)); else { OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); - OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + extrasize) * sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + extrasize) * sizeof(sljit_sw)); } JUMPHERE(jump); } @@ -7534,18 +7552,18 @@ if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK) { /* We know that STR_PTR was stored on the top of the stack. */ if (extrasize > 0) - OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), (extrasize - 1) * sizeof(sljit_sw)); + OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(-extrasize)); /* Keep the STR_PTR on the top of the stack. */ if (bra == OP_BRAZERO) { - OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); if (extrasize == 2) OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), STR_PTR, 0); } else if (bra == OP_BRAMINZERO) { - OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0); } } @@ -7554,13 +7572,13 @@ if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK) if (bra == OP_BRA) { /* We don't need to keep the STR_PTR, only the previous private_data_ptr. */ - OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 1) * sizeof(sljit_sw)); - OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), (extrasize - 2) * sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 1) * sizeof(sljit_sw)); + OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(-extrasize + 1)); } else { /* We don't need to keep the STR_PTR, only the previous private_data_ptr. */ - OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 2) * sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + 2) * sizeof(sljit_sw)); if (extrasize == 2) { OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(STACK_TOP), STACK(0)); @@ -7588,7 +7606,7 @@ if (opcode == OP_ASSERT || opcode == OP_ASSERTBACK) { OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), framesize * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-framesize - 1)); } set_jumps(backtrack->common.topbacktracks, LABEL()); } @@ -7675,23 +7693,23 @@ if (framesize < 0) } if (needs_control_head) - OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), (ket != OP_KET || has_alternatives) ? sizeof(sljit_sw) : 0); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), (ket != OP_KET || has_alternatives) ? STACK(-2) : STACK(-1)); /* TMP2 which is set here used by OP_KETRMAX below. */ if (ket == OP_KETRMAX) - OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), 0); + OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(-1)); else if (ket == OP_KETRMIN) { /* Move the STR_PTR to the private_data_ptr. */ - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), 0); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-1)); } } else { stacksize = (ket != OP_KET || has_alternatives) ? 2 : 1; - OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + stacksize) * sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, (framesize + stacksize) * sizeof(sljit_sw)); if (needs_control_head) - OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), 0); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(-1)); if (ket == OP_KETRMAX) { @@ -7927,7 +7945,7 @@ if (bra == OP_BRAMINZERO) { /* Except when the whole stack frame must be saved. */ OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); - braminzero = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_MEM1(TMP1), (BACKTRACK_AS(bracket_backtrack)->u.framesize + 1) * sizeof(sljit_sw)); + braminzero = CMP(SLJIT_EQUAL, STR_PTR, 0, SLJIT_MEM1(TMP1), STACK(-BACKTRACK_AS(bracket_backtrack)->u.framesize - 2)); } JUMPHERE(skip); } @@ -8000,7 +8018,7 @@ if (opcode == OP_ONCE) OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize), STR_PTR, 0); if (BACKTRACK_AS(bracket_backtrack)->u.framesize == no_frame) - OP2(SLJIT_SUB, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0, SLJIT_IMM, needs_control_head ? (2 * sizeof(sljit_sw)) : sizeof(sljit_sw)); + OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0, SLJIT_IMM, needs_control_head ? (2 * sizeof(sljit_sw)) : sizeof(sljit_sw)); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(stacksize + 1), TMP2, 0); } else if (ket == OP_KETRMAX || has_alternatives) @@ -8018,7 +8036,7 @@ if (opcode == OP_ONCE) OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), TMP2, 0); OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); - OP2(SLJIT_SUB, TMP2, 0, STACK_TOP, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw)); + OP2(SLJIT_ADD, TMP2, 0, STACK_TOP, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw)); stacksize = needs_control_head ? 1 : 0; if (ket != OP_KET || has_alternatives) @@ -8090,13 +8108,13 @@ if (opcode == OP_COND || opcode == OP_SCOND) slot = common->name_table + GET2(matchingpath, 1) * common->name_entry_size; OP1(SLJIT_MOV, TMP3, 0, STR_PTR, 0); OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(1)); - OP2(SLJIT_SUB | SLJIT_SET_E, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(GET2(slot, 0) << 1), TMP1, 0); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP2, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(GET2(slot, 0) << 1), TMP1, 0); slot += common->name_entry_size; i--; while (i-- > 0) { OP2(SLJIT_SUB, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), OVECTOR(GET2(slot, 0) << 1), TMP1, 0); - OP2(SLJIT_OR | SLJIT_SET_E, TMP2, 0, TMP2, 0, STR_PTR, 0); + OP2(SLJIT_OR | SLJIT_SET_Z, TMP2, 0, TMP2, 0, STR_PTR, 0); slot += common->name_entry_size; } OP1(SLJIT_MOV, STR_PTR, 0, TMP3, 0); @@ -8111,7 +8129,7 @@ if (opcode == OP_COND || opcode == OP_SCOND) if (*matchingpath == OP_FAIL) stacksize = 0; - if (*matchingpath == OP_RREF) + else if (*matchingpath == OP_RREF) { stacksize = GET2(matchingpath, 1); if (common->currententry == NULL) @@ -8244,7 +8262,7 @@ if (ket == OP_KETRMAX) { if (has_alternatives) BACKTRACK_AS(bracket_backtrack)->alternative_matchingpath = LABEL(); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, rmax_label); /* Drop STR_PTR for greedy plus quantifier. */ if (opcode != OP_ONCE) @@ -8274,7 +8292,7 @@ if (ket == OP_KETRMAX) if (repeat_type == OP_EXACT) { count_match(common); - OP2(SLJIT_SUB | SLJIT_SET_E, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_MEM1(SLJIT_SP), repeat_ptr, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, rmax_label); } else if (repeat_type == OP_UPTO) @@ -8374,7 +8392,7 @@ switch(opcode) break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } @@ -8452,7 +8470,7 @@ else OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); if (needs_control_head) OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr); - OP2(SLJIT_SUB, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0, SLJIT_IMM, -STACK(stacksize - 1)); + OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_SP), private_data_ptr, STACK_TOP, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw)); stack = 0; if (!zero) @@ -8524,7 +8542,7 @@ while (*cc != OP_KETRPOS) { if (offset != 0) { - OP2(SLJIT_ADD, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, stacksize * sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_IMM, stacksize * sizeof(sljit_sw)); OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), cbraprivptr); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), OVECTOR(offset + 1), STR_PTR, 0); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), cbraprivptr, STR_PTR, 0); @@ -8535,10 +8553,10 @@ while (*cc != OP_KETRPOS) else { OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); - OP2(SLJIT_ADD, STACK_TOP, 0, TMP2, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, TMP2, 0, SLJIT_IMM, stacksize * sizeof(sljit_sw)); if (opcode == OP_SBRAPOS) - OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), (framesize + 1) * sizeof(sljit_sw)); - OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), (framesize + 1) * sizeof(sljit_sw), STR_PTR, 0); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP2), STACK(-framesize - 2)); + OP1(SLJIT_MOV, SLJIT_MEM1(TMP2), STACK(-framesize - 2), STR_PTR, 0); } /* Even if the match is empty, we need to reset the control head. */ @@ -8584,7 +8602,7 @@ while (*cc != OP_KETRPOS) else { OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); - OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(TMP2), (framesize + 1) * sizeof(sljit_sw)); + OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(TMP2), STACK(-framesize - 2)); } } @@ -8601,7 +8619,7 @@ if (!zero) if (framesize < 0) add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(stacksize - 1), SLJIT_IMM, 0)); else /* TMP2 is set to [private_data_ptr] above. */ - add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_NOT_EQUAL, SLJIT_MEM1(TMP2), (stacksize - 1) * sizeof(sljit_sw), SLJIT_IMM, 0)); + add_jump(compiler, &backtrack->topbacktracks, CMP(SLJIT_NOT_EQUAL, SLJIT_MEM1(TMP2), STACK(-stacksize), SLJIT_IMM, 0)); } /* None of them matched. */ @@ -8824,7 +8842,7 @@ if (exact > 1) OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, exact); label = LABEL(); compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks, FALSE); - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, label); } else @@ -8832,7 +8850,7 @@ if (exact > 1) OP1(SLJIT_MOV, tmp_base, tmp_offset, SLJIT_IMM, exact); label = LABEL(); compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks, TRUE); - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, label); } } @@ -8862,7 +8880,7 @@ switch(opcode) if (opcode == OP_UPTO) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), POSSESSIVE0); - OP2(SLJIT_SUB | SLJIT_SET_E, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); jump = JUMP(SLJIT_ZERO); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE0, TMP1, 0); } @@ -8924,7 +8942,7 @@ switch(opcode) label = LABEL(); if (opcode == OP_UPTO) { - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); add_jump(compiler, &backtrack->topbacktracks, JUMP(SLJIT_ZERO)); } compile_char1_matchingpath(common, type, cc, &backtrack->topbacktracks, FALSE); @@ -8944,7 +8962,7 @@ switch(opcode) OP1(SLJIT_MOV, base, offset1, STR_PTR, 0); if (opcode == OP_UPTO) { - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); add_jump(compiler, &no_match, JUMP(SLJIT_ZERO)); } @@ -8971,7 +8989,7 @@ switch(opcode) if (opcode == OP_UPTO) { - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, label); } else @@ -9000,7 +9018,7 @@ switch(opcode) if (opcode == OP_UPTO) { - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, label); } else @@ -9026,7 +9044,7 @@ switch(opcode) compile_char1_matchingpath(common, type, cc, &no_char1_match, FALSE); if (opcode == OP_UPTO) { - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, label); OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); } @@ -9113,7 +9131,7 @@ switch(opcode) label = LABEL(); compile_char1_matchingpath(common, type, cc, &no_match, TRUE); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), POSSESSIVE1, STR_PTR, 0); - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, label); set_jumps(no_match, LABEL()); OP1(SLJIT_MOV, STR_PTR, 0, SLJIT_MEM1(SLJIT_SP), POSSESSIVE1); @@ -9124,7 +9142,7 @@ switch(opcode) label = LABEL(); detect_partial_match(common, &no_match); compile_char1_matchingpath(common, type, cc, &no_char1_match, FALSE); - OP2(SLJIT_SUB | SLJIT_SET_E, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, tmp_base, tmp_offset, tmp_base, tmp_offset, SLJIT_IMM, 1); JUMPTO(SLJIT_NOT_ZERO, label); OP2(SLJIT_ADD, STR_PTR, 0, STR_PTR, 0, SLJIT_IMM, IN_UCHARS(1)); set_jumps(no_char1_match, LABEL()); @@ -9142,7 +9160,7 @@ switch(opcode) break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } @@ -9264,7 +9282,7 @@ size = 3 + (size < 0 ? 0 : size); OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr); allocate_stack(common, size); if (size > 3) - OP2(SLJIT_SUB, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, STACK_TOP, 0, SLJIT_IMM, (size - 3) * sizeof(sljit_sw)); + OP2(SLJIT_ADD, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, STACK_TOP, 0, SLJIT_IMM, (size - 3) * sizeof(sljit_sw)); else OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, STACK_TOP, 0); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(size - 1), SLJIT_IMM, BACKTRACK_AS(then_trap_backtrack)->start); @@ -9569,7 +9587,7 @@ while (cc < ccend) break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); return; } if (cc == NULL) @@ -9677,7 +9695,7 @@ switch(opcode) case OP_MINUPTO: OP1(SLJIT_MOV, TMP1, 0, base, offset1); OP1(SLJIT_MOV, STR_PTR, 0, base, offset0); - OP2(SLJIT_SUB | SLJIT_SET_E, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); + OP2(SLJIT_SUB | SLJIT_SET_Z, TMP1, 0, TMP1, 0, SLJIT_IMM, 1); add_jump(compiler, &jumplist, JUMP(SLJIT_ZERO)); OP1(SLJIT_MOV, base, offset1, TMP1, 0); @@ -9723,7 +9741,7 @@ switch(opcode) break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } @@ -9831,7 +9849,7 @@ if (*cc == OP_ASSERT || *cc == OP_ASSERTBACK) { OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(assert_backtrack)->private_data_ptr); add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(assert_backtrack)->private_data_ptr, SLJIT_MEM1(STACK_TOP), CURRENT_AS(assert_backtrack)->framesize * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(assert_backtrack)->private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-CURRENT_AS(assert_backtrack)->framesize - 1)); set_jumps(current->topbacktracks, LABEL()); } @@ -9841,7 +9859,7 @@ else if (bra == OP_BRAZERO) { /* We know there is enough place on the stack. */ - OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); + OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, sizeof(sljit_sw)); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(0), SLJIT_IMM, 0); JUMPTO(SLJIT_JUMP, CURRENT_AS(assert_backtrack)->matchingpath); JUMPHERE(brajump); @@ -9954,7 +9972,7 @@ else if (ket == OP_KETRMIN) else { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(SLJIT_SP), private_data_ptr); - CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(TMP1), (CURRENT_AS(bracket_backtrack)->u.framesize + 1) * sizeof(sljit_sw), CURRENT_AS(bracket_backtrack)->recursive_matchingpath); + CMPTO(SLJIT_NOT_EQUAL, STR_PTR, 0, SLJIT_MEM1(TMP1), STACK(-CURRENT_AS(bracket_backtrack)->u.framesize - 2), CURRENT_AS(bracket_backtrack)->recursive_matchingpath); } /* Drop STR_PTR for non-greedy plus quantifier. */ if (opcode != OP_ONCE) @@ -10060,7 +10078,7 @@ if (SLJIT_UNLIKELY(opcode == OP_COND) || SLJIT_UNLIKELY(opcode == OP_SCOND)) { OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr); add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr, SLJIT_MEM1(STACK_TOP), assert->framesize * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-assert->framesize - 1)); } cond = JUMP(SLJIT_JUMP); set_jumps(CURRENT_AS(bracket_backtrack)->u.assert->condfailed, LABEL()); @@ -10201,7 +10219,7 @@ if (has_alternatives) { OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr); add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr, SLJIT_MEM1(STACK_TOP), assert->framesize * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), assert->private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-assert->framesize - 1)); } JUMPHERE(cond); } @@ -10256,7 +10274,7 @@ else if (opcode == OP_ONCE) JUMPHERE(once); /* Restore previous private_data_ptr */ if (CURRENT_AS(bracket_backtrack)->u.framesize >= 0) - OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), CURRENT_AS(bracket_backtrack)->u.framesize * sizeof(sljit_sw)); + OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-CURRENT_AS(bracket_backtrack)->u.framesize - 1)); else if (ket == OP_KETRMIN) { OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(1)); @@ -10346,7 +10364,7 @@ if (current->topbacktracks) free_stack(common, CURRENT_AS(bracketpos_backtrack)->stacksize); JUMPHERE(jump); } -OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(bracketpos_backtrack)->private_data_ptr, SLJIT_MEM1(STACK_TOP), CURRENT_AS(bracketpos_backtrack)->framesize * sizeof(sljit_sw)); +OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), CURRENT_AS(bracketpos_backtrack)->private_data_ptr, SLJIT_MEM1(STACK_TOP), STACK(-CURRENT_AS(bracketpos_backtrack)->framesize - 1)); } static SLJIT_INLINE void compile_braminzero_backtrackingpath(compiler_common *common, struct backtrack_common *current) @@ -10392,10 +10410,10 @@ if (opcode == OP_THEN || opcode == OP_THEN_ARG) jump = JUMP(SLJIT_JUMP); loop = LABEL(); - OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), -(int)sizeof(sljit_sw)); + OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(STACK_TOP), STACK(0)); JUMPHERE(jump); - CMPTO(SLJIT_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), -(int)(2 * sizeof(sljit_sw)), TMP1, 0, loop); - CMPTO(SLJIT_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), -(int)(3 * sizeof(sljit_sw)), TMP2, 0, loop); + CMPTO(SLJIT_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(1), TMP1, 0, loop); + CMPTO(SLJIT_NOT_EQUAL, SLJIT_MEM1(STACK_TOP), STACK(2), TMP2, 0, loop); add_jump(compiler, &common->then_trap->quit, JUMP(SLJIT_JUMP)); return; } @@ -10645,7 +10663,7 @@ while (current) break; default: - SLJIT_ASSERT_STOP(); + SLJIT_UNREACHABLE(); break; } current = current->prev; @@ -10684,7 +10702,7 @@ sljit_emit_fast_enter(compiler, TMP2, 0); count_match(common); allocate_stack(common, private_data_size + framesize + alternativesize); OP1(SLJIT_MOV, SLJIT_MEM1(STACK_TOP), STACK(private_data_size + framesize + alternativesize - 1), TMP2, 0); -copy_private_data(common, ccbegin, ccend, TRUE, private_data_size + framesize + alternativesize, framesize + alternativesize, needs_control_head); +copy_private_data(common, ccbegin, ccend, TRUE, framesize + alternativesize, private_data_size + framesize + alternativesize, needs_control_head); if (needs_control_head) OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, SLJIT_IMM, 0); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr, STACK_TOP, 0); @@ -10737,9 +10755,9 @@ if (common->quit != NULL) OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr); if (needs_frame) { - OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw)); - add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw)); + add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); + OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw)); } OP1(SLJIT_MOV, TMP3, 0, SLJIT_IMM, 0); common->quit = NULL; @@ -10750,32 +10768,32 @@ set_jumps(common->accept, LABEL()); OP1(SLJIT_MOV, STACK_TOP, 0, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr); if (needs_frame) { - OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw)); - add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); OP2(SLJIT_ADD, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw)); + add_jump(compiler, &common->revertframes, JUMP(SLJIT_FAST_CALL)); + OP2(SLJIT_SUB, STACK_TOP, 0, STACK_TOP, 0, SLJIT_IMM, (framesize + alternativesize) * sizeof(sljit_sw)); } OP1(SLJIT_MOV, TMP3, 0, SLJIT_IMM, 1); JUMPHERE(jump); if (common->quit != NULL) set_jumps(common->quit, LABEL()); -copy_private_data(common, ccbegin, ccend, FALSE, private_data_size + framesize + alternativesize, framesize + alternativesize, needs_control_head); +copy_private_data(common, ccbegin, ccend, FALSE, framesize + alternativesize, private_data_size + framesize + alternativesize, needs_control_head); free_stack(common, private_data_size + framesize + alternativesize); if (needs_control_head) { - OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), 2 * sizeof(sljit_sw)); - OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), sizeof(sljit_sw)); + OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(STACK_TOP), STACK(-3)); + OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(-2)); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr, TMP1, 0); OP1(SLJIT_MOV, TMP1, 0, TMP3, 0); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->control_head_ptr, TMP2, 0); } else { - OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), sizeof(sljit_sw)); + OP1(SLJIT_MOV, TMP2, 0, SLJIT_MEM1(STACK_TOP), STACK(-2)); OP1(SLJIT_MOV, TMP1, 0, TMP3, 0); OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), common->recursive_head_ptr, TMP2, 0); } -sljit_emit_fast_return(compiler, SLJIT_MEM1(STACK_TOP), 0); +sljit_emit_fast_return(compiler, SLJIT_MEM1(STACK_TOP), STACK(-1)); } #undef COMPILE_BACKTRACKINGPATH @@ -11237,7 +11255,7 @@ OP1(SLJIT_MOV, SLJIT_MEM1(SLJIT_SP), LOCALS1, TMP2, 0); OP1(SLJIT_MOV, TMP1, 0, ARGUMENTS, 0); OP1(SLJIT_MOV, TMP1, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(jit_arguments, stack)); OP1(SLJIT_MOV, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, top), STACK_TOP, 0); -OP2(SLJIT_ADD, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, limit), SLJIT_IMM, STACK_GROWTH_RATE); +OP2(SLJIT_SUB, TMP2, 0, SLJIT_MEM1(TMP1), SLJIT_OFFSETOF(struct sljit_stack, limit), SLJIT_IMM, STACK_GROWTH_RATE); sljit_emit_ijump(compiler, SLJIT_CALL2, SLJIT_IMM, SLJIT_FUNC_OFFSET(sljit_stack_resize)); jump = CMP(SLJIT_NOT_EQUAL, SLJIT_RETURN_REG, 0, SLJIT_IMM, 0); @@ -11391,10 +11409,10 @@ union { sljit_u8 local_space[MACHINE_STACK_SIZE]; struct sljit_stack local_stack; -local_stack.top = (sljit_sw)&local_space; -local_stack.base = local_stack.top; -local_stack.limit = local_stack.base + MACHINE_STACK_SIZE; -local_stack.max_limit = local_stack.limit; +local_stack.max_limit = local_space; +local_stack.limit = local_space; +local_stack.base = local_space + MACHINE_STACK_SIZE; +local_stack.top = local_space + MACHINE_STACK_SIZE; arguments->stack = &local_stack; convert_executable_func.executable_func = executable_func; return convert_executable_func.call_executable_func(arguments); diff --git a/erts/emulator/pcre/pcre_tables.c b/erts/emulator/pcre/pcre_tables.c index 2f6302e2e1..08e31f1460 100644 --- a/erts/emulator/pcre/pcre_tables.c +++ b/erts/emulator/pcre/pcre_tables.c @@ -6,7 +6,7 @@ and semantics are as close as possible to those of the Perl 5 language. Written by Philip Hazel - Copyright (c) 1997-2012 University of Cambridge + Copyright (c) 1997-2017 University of Cambridge ----------------------------------------------------------------------------- Redistribution and use in source and binary forms, with or without @@ -162,7 +162,7 @@ const pcre_uint32 PRIV(ucp_gbtable[]) = { (1<<ucp_gbExtend)|(1<<ucp_gbSpacingMark), /* 5 SpacingMark */ (1<<ucp_gbExtend)|(1<<ucp_gbSpacingMark)|(1<<ucp_gbL)| /* 6 L */ - (1<<ucp_gbL)|(1<<ucp_gbV)|(1<<ucp_gbLV)|(1<<ucp_gbLVT), + (1<<ucp_gbV)|(1<<ucp_gbLV)|(1<<ucp_gbLVT), (1<<ucp_gbExtend)|(1<<ucp_gbSpacingMark)|(1<<ucp_gbV)| /* 7 V */ (1<<ucp_gbT), diff --git a/erts/emulator/pcre/pcre_ucd.c b/erts/emulator/pcre/pcre_ucd.c index 9b700c0785..2dd4b05751 100644 --- a/erts/emulator/pcre/pcre_ucd.c +++ b/erts/emulator/pcre/pcre_ucd.c @@ -38,6 +38,20 @@ const pcre_uint16 PRIV(ucd_stage2)[] = {0}; const pcre_uint32 PRIV(ucd_caseless_sets)[] = {0}; #else +/* If the 32-bit library is run in non-32-bit mode, character values +greater than 0x10ffff may be encountered. For these we set up a +special record. */ + +#ifdef COMPILE_PCRE32 +const ucd_record PRIV(dummy_ucd_record)[] = {{ + ucp_Common, /* script */ + ucp_Cn, /* type unassigned */ + ucp_gbOther, /* grapheme break property */ + 0, /* case set */ + 0, /* other case */ + }}; +#endif + /* When recompiling tables with a new Unicode version, please check the types in this structure definition from pcre_internal.h (the actual field names will be different): diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index cbbd0e6f40..b6f5b319ee 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -86,6 +86,10 @@ #include <sys/times.h> +#ifdef HAVE_SYS_RESOURCE_H +# include <sys/resource.h> +#endif + #ifdef HAVE_IEEEFP_H #include <ieeefp.h> #endif diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 370fcb0f3a..b17170c8b8 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -71,6 +71,7 @@ MODULES= \ hash_SUITE \ hibernate_SUITE \ hipe_SUITE \ + iovec_SUITE \ list_bif_SUITE \ lttng_SUITE \ lcnt_SUITE \ diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index 339c827602..04b7f2de15 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -24,7 +24,7 @@ -include_lib("kernel/include/file.hrl"). -export([all/0, suite/0, - display/1, display_huge/0, + display/1, display_huge/0, display_string/1, erl_bif_types/1,guard_bifs_in_erl_bif_types/1, shadow_comments/1,list_to_utf8_atom/1, specs/1,improper_bif_stubs/1,auto_imports/1, @@ -43,7 +43,7 @@ all() -> [erl_bif_types, guard_bifs_in_erl_bif_types, shadow_comments, specs, improper_bif_stubs, auto_imports, t_list_to_existing_atom, os_env, otp_7526, - display, list_to_utf8_atom, + display, display_string, list_to_utf8_atom, atom_to_binary, binary_to_atom, binary_to_existing_atom, erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, error_stacktrace, error_stacktrace_during_call_trace]. @@ -68,6 +68,28 @@ deeep(N,Acc) -> deeep(N) -> deeep(N,[hello]). +display_string(Config) when is_list(Config) -> + true = erlang:display_string("hej"), + true = erlang:display_string(""), + true = erlang:display_string("hopp"), + true = erlang:display_string("\n"), + true = erlang:display_string(lists:seq(1100,1200)), + {error,badarg} = try + erlang:display_string(atom), + ok + catch + T0:E0 -> + {T0, E0} + end, + {error,badarg} = try + erlang:display_string(make_ref()), + ok + catch + T1:E1 -> + {T1, E1} + end, + ok. + erl_bif_types(Config) when is_list(Config) -> ensure_erl_bif_types_compiled(), @@ -503,6 +525,8 @@ binary_to_atom(Config) when is_list(Config) -> ?BADARG(binary_to_atom(id(<<255>>), utf8)), ?BADARG(binary_to_atom(id(<<255,0>>), utf8)), ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0. + <<B:1/binary, _/binary>> = id(<<194, 163>>), %Truncated character ERL-474 + ?BADARG(binary_to_atom(B, utf8)), %% system_limit failures. ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), @@ -691,6 +715,9 @@ erlang_halt(Config) when is_list(Config) -> {badrpc,nodedown} = rpc:call(N3, erlang, halt, [0,[]]), {ok,N4} = slave:start(H, halt_node4), {badrpc,nodedown} = rpc:call(N4, erlang, halt, [lists:duplicate(300,$x)]), + %% Test unicode slogan + {ok,N4} = slave:start(H, halt_node4), + {badrpc,nodedown} = rpc:call(N4, erlang, halt, [[339,338,254,230,198,295,167,223,32,12507,12531,12480]]), % This test triggers a segfault when dumping a crash dump % to make sure that we can handle it properly. diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index c308760211..5939d024ae 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -339,6 +339,13 @@ system_limit(Config) when is_list(Config) -> {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])), {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)), {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)), + + %% There should be no system_limit exception when shifting a zero. + 0 = id(0) bsl (1 bsl 128), + 0 = id(0) bsr -(1 bsl 128), + Erlang = id(erlang), + 0 = Erlang:'bsl'(id(0), 1 bsl 128), + 0 = Erlang:'bsr'(id(0), -(1 bsl 128)), ok. maxbig() -> diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 4d17276e5c..61536bacd7 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -599,6 +599,9 @@ bad_binary_to_term(Config) when is_list(Config) -> %% Bad float. bad_bin_to_term(<<131,70,-1:64>>), + + %% Truncated UTF8 character (ERL-474) + bad_bin_to_term(<<131,119,1,194,163>>), ok. bad_bin_to_term(BadBin) -> diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index b79f4b995d..ce50bcdd86 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -905,14 +905,28 @@ bs_add_overflow(_Config) -> _ when Memsize < (2 bsl 30) -> {skip, "Less then 2 GB of memory"}; 4 -> - Large = <<0:((1 bsl 30)-1)>>, - {'EXIT',{system_limit,_}} = - (catch <<Large/bits, Large/bits, Large/bits, Large/bits, - Large/bits, Large/bits, Large/bits, Large/bits, - Large/bits>>), + {'EXIT', {system_limit, _}} = (catch bs_add_overflow_signed()), + {'EXIT', {system_limit, _}} = (catch bs_add_overflow_unsigned()), ok end. +bs_add_overflow_signed() -> + %% Produce a large result of bs_add that, if cast to signed int, would + %% overflow into a negative number that fits a smallnum. + Large = <<0:((1 bsl 30)-1)>>, + <<Large/bits, Large/bits, Large/bits, Large/bits, + Large/bits, Large/bits, Large/bits, Large/bits, + Large/bits>>. + +bs_add_overflow_unsigned() -> + %% Produce a large result of bs_add that goes beyond the limit of an + %% unsigned word. This used to succeed but produced an incorrect result + %% where B =:= C! + A = <<0:((1 bsl 32)-8)>>, + B = <<2, 3>>, + C = <<A/binary,1,B/binary>>, + true = byte_size(B) < byte_size(C). + id(I) -> I. memsize() -> diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index b4ec99f902..28be4bfe37 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -418,18 +418,20 @@ make_busy(Node, Time) when is_integer(Time) -> Own = 500, freeze_node(Node, Time+Own), Data = make_busy_data(), + DCtrl = dctrl(Node), %% first make port busy Pid = spawn_link(fun () -> forever(fun () -> - dport_reg_send(Node, - '__noone__', - Data) + dctrl_dop_reg_send(Node, + '__noone__', + Data) end) end), receive after Own -> ok end, until(fun () -> - case process_info(Pid, status) of - {status, suspended} -> true; + case {DCtrl, process_info(Pid, status)} of + {DPrt, {status, suspended}} when is_port(DPrt) -> true; + {DPid, {status, waiting}} when is_pid(DPid) -> true; _ -> false end end), @@ -1703,37 +1705,38 @@ bad_dist_ext_check_msgs([M|Ms]) -> bad_dist_ext_check_msgs(Ms) end. +ensure_dctrl(Node) -> + case dctrl(Node) of + undefined -> + pong = net_adm:ping(Node), + dctrl(Node); + DCtrl -> + DCtrl + end. -dport_reg_send(Node, Name, Msg) -> - DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, - port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_REG_SEND, - self(), - ?COOKIE, - Name}), - dmsg_ext(Msg)]). - - -dport_send(To, Msg) -> +dctrl_send(DPrt, Data) when is_port(DPrt) -> + port_command(DPrt, Data); +dctrl_send(DPid, Data) when is_pid(DPid) -> + Ref = make_ref(), + DPid ! {send, self(), Ref, Data}, + receive {Ref, Res} -> Res end. + +dctrl_dop_reg_send(Node, Name, Msg) -> + dctrl_send(ensure_dctrl(Node), + [dmsg_hdr(), + dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + Name}), + dmsg_ext(Msg)]). + +dctrl_dop_send(To, Msg) -> Node = node(To), - DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, - port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_SEND, - ?COOKIE, - To}), - dmsg_ext(Msg)]). + dctrl_send(ensure_dctrl(Node), + [dmsg_hdr(), + dmsg_ext({?DOP_SEND, ?COOKIE, To}), + dmsg_ext(Msg)]). + send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) -> send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,[]). send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> @@ -1743,7 +1746,7 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> fun () -> Node = node(Victim), pong = net_adm:ping(Node), - DPrt = dport(Node), + DCtrl = dctrl(Node), Bad1 = case WhereToPutSelf of 0 -> Bad; @@ -1756,7 +1759,7 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> [] -> []; _Other -> [dmsg_ext(PayLoad)] end, - port_command(DPrt, DData), + dctrl_send(DCtrl, DData), Parent ! {DData,Done} end), receive @@ -1784,11 +1787,11 @@ send_bad_msgs(BadNode, To, Repeat) when is_atom(BadNode), fun () -> Node = node(To), pong = net_adm:ping(Node), - DPrt = dport(Node), + DCtrl = dctrl(Node), DData = [dmsg_hdr(), dmsg_ext({?DOP_SEND, ?COOKIE, To}), dmsg_bad_atom_cache_ref()], - repeat(fun () -> port_command(DPrt, DData) end, Repeat), + repeat(fun () -> dctrl_send(DCtrl, DData) end, Repeat), Parent ! Done end), receive Done -> ok end. @@ -1810,11 +1813,12 @@ send_bad_ctl(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> replace}), CtlBeginSize = size(Ctl) - size(Replace), <<CtlBegin:CtlBeginSize/binary, Replace/binary>> = Ctl, - port_command(dport(ToNode), - [dmsg_fake_hdr2(), - CtlBegin, - dmsg_bad_atom_cache_ref(), - dmsg_ext({a, message})]), + DCtrl = dctrl(ToNode), + Data = [dmsg_fake_hdr2(), + CtlBegin, + dmsg_bad_atom_cache_ref(), + dmsg_ext({a, message})], + dctrl_send(DCtrl, Data), Parent ! Done end), receive Done -> ok end. @@ -1827,17 +1831,17 @@ send_bad_dhdr(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> spawn_link(BadNode, fun () -> pong = net_adm:ping(ToNode), - port_command(dport(ToNode), dmsg_bad_hdr()), + dctrl_send(dctrl(ToNode), dmsg_bad_hdr()), Parent ! Done end), receive Done -> ok end. -dport(Node) when is_atom(Node) -> +dctrl(Node) when is_atom(Node) -> case catch erts_debug:get_internal_state(available_internal_state) of true -> true; _ -> erts_debug:set_internal_state(available_internal_state, true) end, - erts_debug:get_internal_state({dist_port, Node}). + erts_debug:get_internal_state({dist_ctrl, Node}). dmsg_hdr() -> [131, % Version Magic @@ -1979,7 +1983,7 @@ freeze_node(Node, MS) -> fun () -> erts_debug:set_internal_state(available_internal_state, true), - dport_send(Freezer, DoingIt), + dctrl_dop_send(Freezer, DoingIt), receive after Own -> ok end, erts_debug:set_internal_state(block, MS+Own) end), diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index 5622cce980..d8c5b663e3 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -533,7 +533,7 @@ freeze_node(Node, MS) -> fun () -> erts_debug:set_internal_state(available_internal_state, true), - dport_send(Freezer, DoingIt), + dctrl_dop_send(Freezer, DoingIt), receive after Own -> ok end, erts_debug:set_internal_state(block, MS+Own) end), @@ -544,20 +544,22 @@ make_busy(Node, Time) when is_integer(Time) -> Own = 500, freeze_node(Node, Time+Own), Data = busy_data(), + DCtrl = dctrl(Node), %% first make port busy Pid = spawn_link(fun () -> forever(fun () -> - dport_reg_send(Node, - '__noone__', - Data) + dctrl_dop_reg_send(Node, + '__noone__', + Data) end) end), receive after Own -> ok end, wait_until(fun () -> - case process_info(Pid, status) of - {status, suspended} -> true; - _ -> false - end + case {DCtrl, process_info(Pid, status)} of + {DPrt, {status, suspended}} when is_port(DPrt) -> true; + {DPid, {status, waiting}} when is_pid(DPid) -> true; + _ -> false + end end), %% then dist entry make_busy(Node, [nosuspend], Data), @@ -1048,42 +1050,45 @@ stop_node(Node) -> -define(DOP_DEMONITOR_P, 20). -define(DOP_MONITOR_P_EXIT, 21). -dport_send(To, Msg) -> - Node = node(To), - DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, - port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_SEND, - ?COOKIE, - To}), - dmsg_ext(Msg)]). - -dport_reg_send(Node, Name, Msg) -> - DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, - port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_REG_SEND, - self(), - ?COOKIE, - Name}), - dmsg_ext(Msg)]). - -dport(Node) when is_atom(Node) -> +ensure_dctrl(Node) -> + case dctrl(Node) of + undefined -> + pong = net_adm:ping(Node), + dctrl(Node); + DCtrl -> + DCtrl + end. + +dctrl_send(DPrt, Data) when is_port(DPrt) -> + port_command(DPrt, Data); +dctrl_send(DPid, Data) when is_pid(DPid) -> + Ref = make_ref(), + DPid ! {send, self(), Ref, Data}, + receive {Ref, Res} -> Res end. + +dctrl_dop_send(To, Msg) -> + dctrl_send(ensure_dctrl(node(To)), + [dmsg_hdr(), + dmsg_ext({?DOP_SEND, + ?COOKIE, + To}), + dmsg_ext(Msg)]). + +dctrl_dop_reg_send(Node, Name, Msg) -> + dctrl_send(ensure_dctrl(Node), + [dmsg_hdr(), + dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + Name}), + dmsg_ext(Msg)]). + +dctrl(Node) when is_atom(Node) -> case catch erts_debug:get_internal_state(available_internal_state) of true -> true; _ -> erts_debug:set_internal_state(available_internal_state, true) end, - erts_debug:get_internal_state({dist_port, Node}). + erts_debug:get_internal_state({dist_ctrl, Node}). dmsg_hdr() -> [131, % Version Magic diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl index 01eb1852f6..c9c1867049 100644 --- a/erts/emulator/test/estone_SUITE.erl +++ b/erts/emulator/test/estone_SUITE.erl @@ -20,7 +20,7 @@ -module(estone_SUITE). %% Test functions -export([all/0, suite/0, groups/0, - estone/1, estone_bench/1]). + estone/1, estone_bench/1, pgo/0]). %% Internal exports for EStone tests -export([lists/1, @@ -44,9 +44,9 @@ links/1,lproc/1, run_micro/3,p1/1,ppp/3,macro/2,micros/0]). - --include_lib("common_test/include/ct.hrl"). +-ifndef(PGO). -include_lib("common_test/include/ct_event.hrl"). +-endif. %% EStone defines -define(TOTAL, (3000 * 1000 * 100)). %% 300 secs @@ -85,13 +85,28 @@ estone(Config) when is_list(Config) -> estone_bench(Config) -> DataDir = proplists:get_value(data_dir,Config), L = ?MODULE:macro(?MODULE:micros(),DataDir), - [ct_event:notify( - #event{name = benchmark_data, - data = [{name,proplists:get_value(title,Mark)}, - {value,proplists:get_value(estones,Mark)}]}) - || Mark <- L], + {Total, Stones} = sum_micros(L, 0, 0), + notify([[{title,"ESTONES"}, {estones, Stones}] | L]), L. +-ifndef(PGO). +notify(Marks) -> + [ct_event:notify( + #event{name = benchmark_data, + data = [{name,proplists:get_value(title, Mark)}, + {value,proplists:get_value(estones, Mark)}]}) + || Mark <- Marks]. +-else. +notify(_) -> + ok. +-endif. + +%% The benchmarks to run in order to guide PGO (profile guided optimisation) +pgo() -> + %% We run all benchmarks except the port_io as we don't want to + %% have to build a custom port. + Micros = ?MODULE:micros() -- [micro(port_io)], + ?MODULE:macro(Micros,[]). %% %% Calculate CPU speed diff --git a/erts/emulator/test/iovec_SUITE.erl b/erts/emulator/test/iovec_SUITE.erl new file mode 100644 index 0000000000..a5f605bfff --- /dev/null +++ b/erts/emulator/test/iovec_SUITE.erl @@ -0,0 +1,168 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(iovec_SUITE). + +-export([all/0, suite/0]). + +-export([integer_lists/1, binary_lists/1, empty_lists/1, empty_binary_lists/1, + mixed_lists/1, improper_lists/1, illegal_lists/1, cons_bomb/1, + iolist_to_iovec_idempotence/1, iolist_to_iovec_correctness/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + [integer_lists, binary_lists, empty_lists, empty_binary_lists, mixed_lists, + illegal_lists, improper_lists, cons_bomb, iolist_to_iovec_idempotence, + iolist_to_iovec_correctness]. + +integer_lists(Config) when is_list(Config) -> + Variations = gen_variations([I || I <- lists:seq(1, 255)]), + + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + + ok. + +binary_lists(Config) when is_list(Config) -> + Variations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + ok. + +empty_lists(Config) when is_list(Config) -> + Variations = gen_variations([[] || _ <- lists:seq(1, 256)]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + [] = erlang:iolist_to_iovec([]), + ok. + +empty_binary_lists(Config) when is_list(Config) -> + Variations = gen_variations([<<>> || _ <- lists:seq(1, 8192)]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + [] = erlang:iolist_to_iovec(Variations), + ok. + +mixed_lists(Config) when is_list(Config) -> + Variations = gen_variations([<<>>, lists:seq(1, 40), <<12, 45, 78>>]), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + ok. + +illegal_lists(Config) when is_list(Config) -> + BitStrs = gen_variations(["gurka", <<1:1>>, "gaffel"]), + BadInts = gen_variations(["gurka", 890, "gaffel"]), + Atoms = gen_variations([gurka, "gaffel"]), + BadTails = [["test" | 0], ["gurka", gaffel]], + + Variations = + BitStrs ++ BadInts ++ Atoms ++ BadTails, + + illegality_test(fun erlang:iolist_to_iovec/1, Variations), + + ok. + +improper_lists(Config) when is_list(Config) -> + Variations = [ + [[[[1 | <<2>>] | <<3>>] | <<4>>] | <<5>>], + [[<<"test">>, 3] | <<"improper tail">>], + [1, 2, 3 | <<"improper tail">>] + ], + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + ok. + +cons_bomb(Config) when is_list(Config) -> + IntBase = gen_variations([I || I <- lists:seq(1, 255)]), + BinBase = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), + MixBase = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]), + + Rounds = + case system_mem_size() of + Mem when Mem >= (16 bsl 30) -> 32; + Mem when Mem >= (3 bsl 30) -> 28; + _ -> 20 + end, + + Variations = gen_variations([IntBase, BinBase, MixBase], Rounds), + equivalence_test(fun erlang:iolist_to_iovec/1, Variations), + ok. + +iolist_to_iovec_idempotence(Config) when is_list(Config) -> + IntVariations = gen_variations([I || I <- lists:seq(1, 255)]), + BinVariations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), + MixVariations = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]), + + Variations = [IntVariations, BinVariations, MixVariations], + Optimized = erlang:iolist_to_iovec(Variations), + + true = Optimized =:= erlang:iolist_to_iovec(Optimized), + ok. + +iolist_to_iovec_correctness(Config) when is_list(Config) -> + IntVariations = gen_variations([I || I <- lists:seq(1, 255)]), + BinVariations = gen_variations([<<I:8>> || I <- lists:seq(1, 255)]), + MixVariations = gen_variations([<<12, 45, 78>>, lists:seq(1, 255)]), + + Variations = [IntVariations, BinVariations, MixVariations], + Optimized = erlang:iolist_to_iovec(Variations), + + true = is_iolist_equal(Optimized, Variations), + ok. + +illegality_test(Fun, Variations) -> + [{'EXIT',{badarg, _}} = (catch Fun(Variation)) || Variation <- Variations]. + +equivalence_test(Fun, [Head | _] = Variations) -> + Comparand = Fun(Head), + [is_iolist_equal(Comparand, Fun(Variation)) || Variation <- Variations], + ok. + +is_iolist_equal(A, B) -> + iolist_to_binary(A) =:= iolist_to_binary(B). + +%% Generates a bunch of lists whose contents will be equal to Base repeated a +%% few times. The lists only differ by their structure, so their reduction to +%% a simpler format should yield the same result. +gen_variations(Base) -> + gen_variations(Base, 16). +gen_variations(Base, N) -> + [gen_flat_list(Base, N), + gen_nested_list(Base, N), + gen_nasty_list(Base, N)]. + +gen_flat_list(Base, N) -> + lists:flatten(gen_nested_list(Base, N)). + +gen_nested_list(Base, N) -> + [Base || _ <- lists:seq(1, N)]. + +gen_nasty_list(Base, N) -> + gen_nasty_list_1(gen_nested_list(Base, N), []). +gen_nasty_list_1([], Result) -> + Result; +gen_nasty_list_1([Head | Base], Result) when is_list(Head) -> + gen_nasty_list_1(Base, [[Result], [gen_nasty_list_1(Head, [])]]); +gen_nasty_list_1([Head | Base], Result) -> + gen_nasty_list_1(Base, [[Result], [Head]]). + +system_mem_size() -> + application:ensure_all_started(os_mon), + {Tot,_Used,_} = memsup:get_memory_data(), + Tot. diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.beam b/erts/emulator/test/map_SUITE_data/badmap_17.beam Binary files differindex 277fc34b94..6f79bb8c2c 100644 --- a/erts/emulator/test/map_SUITE_data/badmap_17.beam +++ b/erts/emulator/test/map_SUITE_data/badmap_17.beam diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.erl b/erts/emulator/test/map_SUITE_data/badmap_17.erl index 0ec65e0e33..887fc2e5e3 100644 --- a/erts/emulator/test/map_SUITE_data/badmap_17.erl +++ b/erts/emulator/test/map_SUITE_data/badmap_17.erl @@ -1,7 +1,7 @@ -module(badmap_17). -export([update/1]). -%% Compile this source file with OTP 17. +%% Compile this source file with OTP 17.0. update(Map) -> try @@ -17,10 +17,42 @@ update(Map) -> catch error:{badmap,Map} -> ok - end. + end, + try + update_3(Map), + error(update_did_not_fail) + catch + error:{badmap,Map} -> + ok + end, + ok = update_4(Map), + ok = update_5(Map), + ok. update_1(M) -> M#{a=>42}. update_2(M) -> M#{a:=42}. + +update_3(M) -> + id(M), + M#{a=>42}. + +update_4(M) when M#{a=>b} =:= M -> + did_not_fail; +update_4(_) -> + ok. + +update_5(M) -> + id(M), + case id(true) of + true when M#{a=>b} =:= M -> + did_not_fail; + true -> + ok + end. + +id(I) -> + I. + diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index ef66f0bbfc..223bd7d586 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -61,7 +61,8 @@ nif_internal_hash_salted/1, nif_phash2/1, nif_whereis/1, nif_whereis_parallel/1, - nif_whereis_threaded/1, nif_whereis_proxy/1 + nif_whereis_threaded/1, nif_whereis_proxy/1, + nif_ioq/1 ]). -export([many_args_100/100]). @@ -99,7 +100,8 @@ all() -> nif_internal_hash, nif_internal_hash_salted, nif_phash2, - nif_whereis, nif_whereis_parallel, nif_whereis_threaded]. + nif_whereis, nif_whereis_parallel, nif_whereis_threaded, + nif_ioq]. groups() -> [{G, [], api_repeaters()} || G <- api_groups()] @@ -2952,6 +2954,180 @@ nif_whereis_proxy(Ref) -> {Ref, quit} -> ok end. +nif_ioq(Config) -> + ensure_lib_loaded(Config), + + Script = + [{create, a}, + + %% Test enq of erlang term binary + {enqb, a}, + {enqb, a, 3}, + + %% Test enq of non-erlang term binary + {enqbraw,a}, + {enqbraw,a, 5}, + {peek, a}, + {deq, a, 42}, + + %% Test enqv + {enqv, a, 2, 100}, + {deq, a, all}, + + %% This skips all elements but one in the iolist + {enqv, a, 5, iolist_size(nif_ioq_payload(5)) - 1}, + {peek, a}, + + %% Test to enqueue a bunch of refc binaries + {enqv, a, [nif_ioq_payload(refcbin) || _ <- lists:seq(1,20)], 0}, + + %% Enq stuff to destroy with data in queue + {enqv, a, 2, 100}, + {destroy,a}, + + %% Test destroy of new queue + {create, a}, + {destroy,a} + ], + + nif_ioq_run(Script), + + %% Test that only enif_inspect_as_vec works + Payload = nif_ioq_payload(5), + PayloadBin = iolist_to_binary(Payload), + + [begin + PayloadBin = iolist_to_binary(ioq_nif(inspect,Payload,Stack,Env)), + <<>> = iolist_to_binary(ioq_nif(inspect,[],Stack,Env)) + end || Stack <- [no_stack, use_stack], Env <- [use_env, no_env]], + + %% Test error cases + + Q = ioq_nif(create), + + {'EXIT', {badarg, _}} = (catch ioq_nif(deq, Q, 1)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, 1, 1234)), + + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [atom_in_list], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [make_ref()], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [256], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [-1], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [#{}], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [1 bsl 64], 0)), + {'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [{tuple}], 0)), + + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [atom_in_list], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [make_ref()], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [256], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [-1], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [#{}], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [1 bsl 64], no_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [{tuple}], use_stack)), + {'EXIT', {badarg, _}} = (catch ioq_nif(inspect, <<"binary">>, use_stack)), + + ioq_nif(destroy, Q), + + %% Test that the example in the docs works + ExampleQ = ioq_nif(create), + true = ioq_nif(example, ExampleQ, nif_ioq_payload(5)), + ioq_nif(destroy, ExampleQ), + + ok. + + +nif_ioq_run(Script) -> + nif_ioq_run(Script, #{}). + +nif_ioq_run([{Action, Name}|T], State) + when Action =:= enqb; Action =:= enqbraw -> + nif_ioq_run([{Action, Name, heapbin}|T], State); +nif_ioq_run([{Action, Name, Skip}|T], State) + when Action =:= enqb, is_integer(Skip); + Action =:= enqbraw, is_integer(Skip) -> + nif_ioq_run([{Action, Name, heapbin, Skip}|T], State); +nif_ioq_run([{Action, Name, N}|T], State) + when Action =:= enqv; Action =:= enqb; Action =:= enqbraw -> + nif_ioq_run([{Action, Name, N, 0}|T], State); +nif_ioq_run([{Action, Name, N, Skip}|T], State) + when Action =:= enqv; Action =:= enqb; Action =:= enqbraw -> + + #{ q := IOQ, b := B } = Q = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + %% Sanitize the log output a bit so that it doesn't become too large. + H = {Action, Name, try iolist_size(N) of Sz -> Sz catch _:_ -> N end, Skip}, + ct:log("~p", [H]), + + Data = nif_ioq_payload(N), + ioq_nif(Action, IOQ, Data, Skip), + + <<_:Skip/binary, SkippedData/binary>> = iolist_to_binary(Data), + + true = ioq_nif(size, IOQ) == (iolist_size([B|SkippedData])), + + nif_ioq_run(T, State#{ Name := Q#{ b := [B|SkippedData]}}); +nif_ioq_run([{peek, Name} = H|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + Data = ioq_nif(peek, IOQ, ioq_nif(size, IOQ)), + + true = iolist_to_binary(B) == iolist_to_binary(Data), + nif_ioq_run(T, State); +nif_ioq_run([{deq, Name, all}|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + Size = ioq_nif(size, IOQ), + true = Size == iolist_size(B), + nif_ioq_run([{deq, Name, Size}|T], State); +nif_ioq_run([{deq, Name, N} = H|T], State) -> + #{ q := IOQ, b := B } = Q = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + <<_:N/binary,Remain/binary>> = iolist_to_binary(B), + NewQ = Q#{ b := Remain }, + + Sz = ioq_nif(deq, IOQ, N), + + true = Sz == iolist_size(Remain), + true = ioq_nif(size, IOQ) == iolist_size(Remain), + + nif_ioq_run(T, State#{ Name := NewQ }); +nif_ioq_run([{create, Name} = H|T], State) -> + ct:log("~p", [H]), + nif_ioq_run(T, State#{ Name => #{ q => ioq_nif(create), b => [] } }); +nif_ioq_run([{destroy, Name} = H|T], State) -> + #{ q := IOQ, b := B } = maps:get(Name, State), + true = ioq_nif(size, IOQ) == iolist_size(B), + + ct:log("~p", [H]), + + ioq_nif(destroy, IOQ), + + nif_ioq_run(T, maps:remove(Name, State)); +nif_ioq_run([], State) -> + State. + +nif_ioq_payload(N) when is_integer(N) -> + Tail = if N > 3 -> nif_ioq_payload(N-3); true -> [] end, + Head = element(1, lists:split(N,[nif_ioq_payload(subbin), + nif_ioq_payload(heapbin), + nif_ioq_payload(refcbin) | Tail])), + erlang:iolist_to_iovec(Head); +nif_ioq_payload(subbin) -> + Bin = nif_ioq_payload(refcbin), + Sz = size(Bin) - 1, + <<_:8,SubBin:Sz/binary,_/bits>> = Bin, + SubBin; +nif_ioq_payload(heapbin) -> + <<"a literal heap binary">>; +nif_ioq_payload(refcbin) -> + iolist_to_binary([lists:seq(1,255) || _ <- lists:seq(1,255)]); +nif_ioq_payload(Else) -> + Else. %% The NIFs: lib_version() -> undefined. @@ -3027,6 +3203,10 @@ monitor_process_nif(_,_,_,_) -> ?nif_stub. demonitor_process_nif(_,_) -> ?nif_stub. compare_monitors_nif(_,_) -> ?nif_stub. monitor_frenzy_nif(_,_,_,_) -> ?nif_stub. +ioq_nif(_) -> ?nif_stub. +ioq_nif(_,_) -> ?nif_stub. +ioq_nif(_,_,_) -> ?nif_stub. +ioq_nif(_,_,_,_) -> ?nif_stub. %% whereis whereis_send(_Type,_Name,_Msg) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 307d1c390f..b47d013bd2 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -186,6 +186,12 @@ static ErlNifResourceTypeInit frenzy_rt_init = { static ErlNifResourceType* whereis_resource_type; static void whereis_thread_resource_dtor(ErlNifEnv* env, void* obj); +static ErlNifResourceType* ioq_resource_type; + +static void ioq_resource_dtor(ErlNifEnv* env, void* obj); +struct ioq_resource { + ErlNifIOQueue *q; +}; static int get_pointer(ErlNifEnv* env, ERL_NIF_TERM term, void** pp) { @@ -243,6 +249,10 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) whereis_resource_type = enif_open_resource_type(env, NULL, "nif_SUITE.whereis", whereis_thread_resource_dtor, ERL_NIF_RT_CREATE, NULL); + ioq_resource_type = enif_open_resource_type(env,NULL,"ioq", + ioq_resource_dtor, + ERL_NIF_RT_CREATE, NULL); + atom_false = enif_make_atom(env,"false"); atom_true = enif_make_atom(env,"true"); atom_self = enif_make_atom(env,"self"); @@ -2430,7 +2440,6 @@ static ERL_NIF_TERM format_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg return enif_make_binary(env,&obin); } - static int get_fd(ErlNifEnv* env, ERL_NIF_TERM term, struct fd_resource** rsrc) { if (!enif_get_resource(env, term, fd_resource_type, (void**)rsrc)) { @@ -3158,7 +3167,231 @@ static void frenzy_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid, abort(); } +/*********** testing ioq ************/ + +static void ioq_resource_dtor(ErlNifEnv* env, void* obj) { + +} + +#ifndef __WIN32__ +static int writeiovec(ErlNifEnv *env, ERL_NIF_TERM term, ERL_NIF_TERM *tail, ErlNifIOQueue *q, int fd) { + ErlNifIOVec vec, *iovec = &vec; + SysIOVec *sysiovec; + int saved_errno; + int iovcnt, n; + + if (!enif_inspect_iovec(env, 64, term, tail, &iovec)) + return -2; + + if (enif_ioq_size(q) > 0) { + /* If the I/O queue contains data we enqueue the iovec and then + peek the data to write out of the queue. */ + if (!enif_ioq_enqv(q, iovec, 0)) + return -3; + + sysiovec = enif_ioq_peek(q, &iovcnt); + } else { + /* If the I/O queue is empty we skip the trip through it. */ + iovcnt = iovec->iovcnt; + sysiovec = iovec->iov; + } + + /* Attempt to write the data */ + n = writev(fd, sysiovec, iovcnt); + saved_errno = errno; + + if (enif_ioq_size(q) == 0) { + /* If the I/O queue was initially empty we enqueue any + remaining data into the queue for writing later. */ + if (n >= 0 && !enif_ioq_enqv(q, iovec, n)) + return -3; + } else { + /* Dequeue any data that was written from the queue. */ + if (n > 0 && !enif_ioq_deq(q, n, NULL)) + return -4; + } + + /* return n, which is either number of bytes written or -1 if + some error happened */ + errno = saved_errno; + return n; +} +#endif + +static ERL_NIF_TERM ioq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + struct ioq_resource *ioq; + ERL_NIF_TERM ret; + if (enif_is_identical(argv[0], enif_make_atom(env, "create"))) { + ErlNifIOQueue *q = enif_ioq_create(ERL_NIF_IOQ_NORMAL); + ioq = (struct ioq_resource *)enif_alloc_resource(ioq_resource_type, + sizeof(*ioq)); + ioq->q = q; + ret = enif_make_resource(env, ioq); + enif_release_resource(ioq); + return ret; + } else if (enif_is_identical(argv[0], enif_make_atom(env, "inspect"))) { + ErlNifIOVec vec, *iovec = NULL; + int i, iovcnt; + ERL_NIF_TERM *elems, tail, list; + ErlNifEnv *myenv = NULL; + + if (enif_is_identical(argv[2], enif_make_atom(env, "use_stack"))) + iovec = &vec; + if (enif_is_identical(argv[3], enif_make_atom(env, "use_env"))) + myenv = env; + if (!enif_inspect_iovec(myenv, ~(size_t)0, argv[1], &tail, &iovec)) + return enif_make_badarg(env); + + iovcnt = iovec->iovcnt; + elems = enif_alloc(sizeof(ERL_NIF_TERM) * iovcnt); + + for (i = 0; i < iovcnt; i++) { + ErlNifBinary bin; + if (!enif_alloc_binary(iovec->iov[i].iov_len, &bin)) { + enif_free_iovec(iovec); + enif_free(elems); + return enif_make_badarg(env); + } + memcpy(bin.data, iovec->iov[i].iov_base, iovec->iov[i].iov_len); + elems[i] = enif_make_binary(env, &bin); + } + + if (!myenv) + enif_free_iovec(iovec); + + list = enif_make_list_from_array(env, elems, iovcnt); + enif_free(elems); + return list; + } else { + unsigned skip; + if (!enif_get_resource(env, argv[1], ioq_resource_type, (void**)&ioq) + || !ioq->q) + return enif_make_badarg(env); + + if (enif_is_identical(argv[0], enif_make_atom(env, "example"))) { +#ifndef __WIN32__ + int fd[2], res = 0, cnt = 0, queue_cnt; + ERL_NIF_TERM tail; + char buff[255]; + pipe(fd); + fcntl(fd[0], F_SETFL, fcntl(fd[0], F_GETFL) | O_NONBLOCK); + fcntl(fd[1], F_SETFL, fcntl(fd[1], F_GETFL) | O_NONBLOCK); + + /* Write until the pipe buffer is full, which should result in data + * being queued up. */ + for (res = 0; res >= 0; ) { + cnt += res; + res = writeiovec(env, argv[2], &tail, ioq->q, fd[1]); + } + + /* Flush the queue while reading from the other end of the pipe. */ + tail = enif_make_list(env, 0); + while (enif_ioq_size(ioq->q) > 0) { + res = writeiovec(env, tail, &tail, ioq->q, fd[1]); + if (res < 0 && errno != EAGAIN) { + break; + } else if (res > 0) { + cnt += res; + } + + for (res = 0; res >= 0; ) { + cnt -= res; + res = read(fd[0], buff, sizeof(buff)); + } + } + + close(fd[0]); + close(fd[1]); + + /* Check that we read as much as we wrote */ + if (cnt == 0 && enif_ioq_size(ioq->q) == 0) + return enif_make_atom(env, "true"); + + return enif_make_int(env, cnt); +#else + return enif_make_atom(env, "true"); +#endif + } + if (enif_is_identical(argv[0], enif_make_atom(env, "destroy"))) { + enif_ioq_destroy(ioq->q); + ioq->q = NULL; + return enif_make_atom(env, "false"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqv"))) { + ErlNifIOVec vec, *iovec = &vec; + ERL_NIF_TERM tail; + + if (!enif_get_uint(env, argv[3], &skip)) + return enif_make_badarg(env); + if (!enif_inspect_iovec(env, ~0ul, argv[2], &tail, &iovec)) + return enif_make_badarg(env); + if (!enif_ioq_enqv(ioq->q, iovec, skip)) + return enif_make_badarg(env); + + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqb"))) { + ErlNifBinary bin; + if (!enif_get_uint(env, argv[3], &skip) || + !enif_inspect_binary(env, argv[2], &bin)) + return enif_make_badarg(env); + + if (!enif_ioq_enq_binary(ioq->q, &bin, skip)) + return enif_make_badarg(env); + + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "enqbraw"))) { + ErlNifBinary bin; + ErlNifBinary localbin; + int i; + if (!enif_get_uint(env, argv[3], &skip) || + !enif_inspect_binary(env, argv[2], &bin) || + !enif_alloc_binary(bin.size, &localbin)) + return enif_make_badarg(env); + + memcpy(localbin.data, bin.data, bin.size); + i = enif_ioq_enq_binary(ioq->q, &localbin, skip); + if (!i) + return enif_make_badarg(env); + else + return enif_make_atom(env, "true"); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "peek"))) { + int iovlen, num, i, off = 0; + SysIOVec *iov = enif_ioq_peek(ioq->q, &iovlen); + ErlNifBinary bin; + + if (!enif_get_int(env, argv[2], &num) || !enif_alloc_binary(num, &bin)) + return enif_make_badarg(env); + + for (i = 0; i < iovlen && num > 0; i++) { + int to_copy = num < iov[i].iov_len ? num : iov[i].iov_len; + memcpy(bin.data + off, iov[i].iov_base, to_copy); + num -= to_copy; + off += to_copy; + } + + return enif_make_binary(env, &bin); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "deq"))) { + int num; + size_t sz; + ErlNifUInt64 sz64; + if (!enif_get_int(env, argv[2], &num)) + return enif_make_badarg(env); + + if (!enif_ioq_deq(ioq->q, num, &sz)) + return enif_make_badarg(env); + + sz64 = sz; + + return enif_make_uint64(env, sz64); + } else if (enif_is_identical(argv[0], enif_make_atom(env, "size"))) { + ErlNifUInt64 size = enif_ioq_size(ioq->q); + return enif_make_uint64(env, size); + } + } + + return enif_make_badarg(env); +} static ErlNifFunc nif_funcs[] = { @@ -3255,7 +3488,11 @@ static ErlNifFunc nif_funcs[] = {"whereis_send", 3, whereis_send}, {"whereis_term", 2, whereis_term}, {"whereis_thd_lookup", 2, whereis_thd_lookup}, - {"whereis_thd_result", 1, whereis_thd_result} + {"whereis_thd_result", 1, whereis_thd_result}, + {"ioq_nif", 1, ioq}, + {"ioq_nif", 2, ioq}, + {"ioq_nif", 3, ioq}, + {"ioq_nif", 4, ioq} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,NULL,upgrade,unload) diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index 8e9e3cb05a..be90f929df 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -405,6 +405,7 @@ node_table_gc(Config) when is_list(Config) -> PreKnown = nodes(known), io:format("PreKnown = ~p~n", [PreKnown]), make_node_garbage(0, 200000, 1000, []), + receive after 1000 -> ok end, %% Wait for thread progress... PostKnown = nodes(known), PostAreas = erlang:system_info(allocated_areas), io:format("PostKnown = ~p~n", [PostKnown]), diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index ab0b1a82bd..730a17d7e8 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -159,7 +159,7 @@ suite() -> all() -> [otp_6224, {group, stream}, basic_ping, slow_writes, bad_packet, bad_port_messages, {group, options}, - {group, multiple_packets}, parallell, dying_port, + {group, multiple_packets}, parallell, dying_port, dropped_commands, port_program_with_path, open_input_file_port, open_output_file_port, name1, env, huge_env, bad_env, cd, cd_relative, pipe_limit_env, bad_args, @@ -569,12 +569,14 @@ dropped_commands(Config, Outputv, Cmd) -> [dropped_commands_test(Cmd) || _ <- lists:seq(1, 100)], timer:sleep(100), erl_ddll:unload_driver("echo_drv"), + os:unsetenv("ECHO_DRV_USE_OUTPUTV"), ok. dropped_commands_test(Cmd) -> - Port = erlang:open_port({spawn_driver, "echo_drv"}, [{parallelism, true}]), spawn_monitor( fun() -> + Port = erlang:open_port({spawn_driver, "echo_drv"}, + [{parallelism, true}]), [spawn_link(fun() -> spin(Port, Cmd) end) || _ <- lists:seq(1,8)], timer:sleep(5), port_close(Port), diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 6c01bfd45c..7a396d273c 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -23,8 +23,10 @@ %% Tests the statistics/1 bif. -export([all/0, suite/0, groups/0, + wall_clock_sanity/1, wall_clock_zero_diff/1, wall_clock_update/1, - runtime_zero_diff/1, + runtime_sanity/1, + runtime_zero_diff/1, runtime_update/1, runtime_diff/1, run_queue_one/1, scheduler_wall_time/1, @@ -54,11 +56,23 @@ all() -> groups() -> [{wall_clock, [], - [wall_clock_zero_diff, wall_clock_update]}, + [wall_clock_sanity, wall_clock_zero_diff, wall_clock_update]}, {runtime, [], - [runtime_zero_diff, runtime_update, runtime_diff]}, + [runtime_sanity, runtime_zero_diff, runtime_update, runtime_diff]}, {run_queue, [], [run_queue_one]}]. +wall_clock_sanity(Config) when is_list(Config) -> + erlang:yield(), + {WallClock, _} = statistics(wall_clock), + MT = erlang:monotonic_time(), + Time = erlang:convert_time_unit(MT - erlang:system_info(start_time), + native, millisecond), + io:format("Time=~p WallClock=~p~n", + [Time, WallClock]), + true = WallClock =< Time, + true = Time - 100 =< WallClock, + ok. + %%% Testing statistics(wall_clock). %% Tests that the 'Wall clock since last call' element of the result @@ -102,6 +116,20 @@ wall_clock_update1(0) -> %%% Test statistics(runtime). +runtime_sanity(Config) when is_list(Config) -> + case erlang:system_info(logical_processors_available) of + unknown -> + {skipped, "Don't know available logical processors"}; + LP when is_integer(LP) -> + erlang:yield(), + {RunTime, _} = statistics(runtime), + MT = erlang:monotonic_time(), + Time = erlang:convert_time_unit(MT - erlang:system_info(start_time), + native, millisecond), + io:format("Time=~p RunTime=~p~n", + [Time, RunTime]), + true = RunTime =< Time*LP + end. %% Tests that the difference between the times returned from two consectuitive %% calls to statistics(runtime) is zero. diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index 79b681b4d1..baf41180e0 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -134,6 +134,13 @@ t_element(Config) when is_list(Config) -> {'EXIT', {badarg, _}} = (catch element(1, id(42))), {'EXIT', {badarg, _}} = (catch element(id(1.5), id({a,b}))), + %% Make sure that the loader does not reject the module when + %% huge literal index values are used. + {'EXIT', {badarg, _}} = (catch element((1 bsl 24)-1, id({a,b,c}))), + {'EXIT', {badarg, _}} = (catch element(1 bsl 24, id({a,b,c}))), + {'EXIT', {badarg, _}} = (catch element(1 bsl 32, id({a,b,c}))), + {'EXIT', {badarg, _}} = (catch element(1 bsl 64, id({a,b,c}))), + ok. get_elements([Element|Rest], Tuple, Pos) -> diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 0a30553f71..e55d3eadb5 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -20,13 +20,16 @@ # use strict; use vars qw($BEAM_FORMAT_NUMBER); +use constant COLD => 0; +use constant WARM => 1; +use constant HOT => 2; $BEAM_FORMAT_NUMBER = undef; my $target = \&emulator_output; my $outdir = "."; # Directory for output files. my $verbose = 0; -my $hot = 1; +my $hotness = 1; my $num_file_opcodes = 0; my $wordsize = 32; my %defs; # Defines (from command line). @@ -54,11 +57,6 @@ $pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize 'BEAM_LOOSE_MASK', $WHOLE_WORD]; -# Mapping from packagable arguments to number of packed arguments per -# word. Initialized after the wordsize is known. - -my @args_per_word; - # There are two types of instructions: generic and specific. # The generic instructions are those generated by the Beam compiler. # Corresponding to each generic instruction, there is generally a @@ -91,17 +89,22 @@ my @op_to_name; my @obsolete; -my %macro; -my %macro_flags; +# Instructions and micro instructions implemented in C. +my %c_code; # C code block, location, arguments. +my %c_code_used; # Used or not. + +# Definitions for instructions combined from micro instructions. +my %combined_instrs; -my %hot_code; -my %cold_code; +my @generated_code; # Generated code. +my %sort_order; my @unnumbered_generic; my %unnumbered; my %is_transformed; + # # Pre-processor. # @@ -138,13 +141,15 @@ my %arg_size = ('r' => 0, # x(0) - x register zero 'n' => 0, # NIL (implicit) 'c' => 1, # tagged constant (integer, atom, nil) 's' => 1, # tagged source; any of the above + 'S' => 1, # tagged source register (x or y) 'd' => 1, # tagged destination register (r, x, y) 'f' => 1, # failure label 'j' => 1, # either 'f' or 'p' 'e' => 1, # pointer to export entry 'L' => 0, # label - 'I' => 1, # untagged integer - 't' => 1, # untagged integer -- can be packed + 't' => 1, # untagged integer (12 bits) -- can be packed + 'I' => 1, # untagged integer (32 bits) -- can be packed + 'W' => 1, # untagged integer/pointer (one word) 'b' => 1, # pointer to bif 'A' => 1, # arity value 'P' => 1, # byte offset into tuple or stack @@ -186,16 +191,16 @@ sub define_type_bit { define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'} | $type_bit{'q'}); + define_type_bit('S', $type_bit{'d'}); define_type_bit('j', $type_bit{'f'} | $type_bit{'p'}); # Aliases (for matching purposes). - define_type_bit('I', $type_bit{'u'}); define_type_bit('t', $type_bit{'u'}); + define_type_bit('I', $type_bit{'u'}); + define_type_bit('W', $type_bit{'u'}); define_type_bit('A', $type_bit{'u'}); define_type_bit('L', $type_bit{'u'}); define_type_bit('b', $type_bit{'u'}); - define_type_bit('N', $type_bit{'u'}); - define_type_bit('U', $type_bit{'u'}); define_type_bit('e', $type_bit{'u'}); define_type_bit('P', $type_bit{'u'}); define_type_bit('Q', $type_bit{'u'}); @@ -222,6 +227,12 @@ $match_engine_ops{'TOP_fail'} = 1; sanity("tag '$tag': primitive tags must be named with lowercase letters") unless $tag =~ /^[a-z]$/; } + + foreach my $tag (keys %arg_size) { + defined $type_bit{$tag} or + sanity("the tag '$tag' has a size in %arg_size, " . + "but has no defined bit pattern"); + } } # @@ -240,27 +251,46 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) { die "$0: Bad option: -$_\n"; } +if ($wordsize == 32) { + $defs{'ARCH_32'} = 1; + $defs{'ARCH_64'} = 0; +} elsif ($wordsize == 64) { + $defs{'ARCH_32'} = 0; + $defs{'ARCH_64'} = 1; +} + # # Initialize number of arguments per packed word. # -$args_per_word[2] = 2; -$args_per_word[3] = 3; -$args_per_word[4] = 2; -$args_per_word[5] = 3; -$args_per_word[6] = 3; - if ($wordsize == 64) { $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD]; - $args_per_word[4] = 4; } # # Parse the input files. # +my $in_c_code = ''; +my $c_code_block; +my $c_code_loc; +my @c_args; + while (<>) { my($op_num); + if ($in_c_code) { + if (/^\}/) { + my $name = $in_c_code; + my $block = $c_code_block; + $in_c_code = ''; + $block =~ s/^ //mg; + chomp $block; + $c_code{$name} = [$block,$c_code_loc,@c_args]; + } else { + $c_code_block .= $_; + } + next; + } chomp; if (s/\\$//) { $_ .= <>; @@ -268,6 +298,7 @@ while (<>) { } next if /^\s*$/; next if /^\#/; + next if m@^//@; # # Handle %if. @@ -316,30 +347,16 @@ while (<>) { } # - # Handle %hot/%cold. + # Handle %hot, %warm, and %cold. # if (/^\%hot/) { - $hot = 1; + $hotness = HOT; next; + } elsif (/^\%warm/) { + $hotness = WARM; + next; } elsif (/^\%cold/) { - $hot = 0; - next; - } - - # - # Handle macro definitions. - # - if (/^\%macro:(.*)/) { - my($op, $macro, @flags) = split(' ', $1); - defined($macro) and $macro =~ /^-/ and - error("A macro must not start with a hyphen"); - foreach (@flags) { - /^-/ or error("Flags for macros should start with a hyphen"); - } - error("Macro for '$op' is already defined") - if defined $macro{$op}; - $macro{$op} = $macro; - $macro_flags{$op} = join('', @flags); + $hotness = COLD; next; } @@ -352,6 +369,31 @@ while (<>) { } # + # Handle C code blocks. + # + if (/^(\w[\w.]*)\(([^\)]*)\)\s*{/) { + my $name = $1; + $in_c_code = $name; + $c_code_block = ''; + @c_args = parse_c_args($2); + $c_code_loc = "$ARGV($.)"; + if (defined $c_code{$name}) { + my $where = $c_code{$name}->[1]; + error("$name: already defined at $where"); + } + next; + } + + # + # Handle definition of instructions in terms of + # micro instructions. + # + if (/^(\w+)\s*:=\s*([\w.]+)\s*;\s*$/) { + $combined_instrs{$1} = ["$ARGV($.)",$2]; + next; + } + + # # Parse off the number of the operation. # $op_num = undef; @@ -402,7 +444,7 @@ while (<>) { if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) { error("specific instructions may not be specified for obsolete instructions"); } - save_specific_ops($name, $arity, $hot, @args); + save_specific_ops($name, $arity, $hotness, @args); if (defined $op_num) { error("specific instructions must not be numbered"); } elsif (!defined($gen_arity{$name}) && !defined($unnumbered{$name,$arity})) { @@ -449,6 +491,18 @@ $num_file_opcodes = @gen_opname; &$target(); # +# Ensure that all C code implementations have been used. +# +{ + my(@unused) = grep(!$c_code_used{$_}, keys %c_code); + foreach my $unused (@unused) { + my(undef,$where) = @{$c_code{$unused}}; + warn "$where: $unused is unused\n"; + } + die "\n" if @unused; +} + +# # Produce output needed by the emulator/loader. # @@ -486,6 +540,11 @@ sub emulator_output { print "\n"; # + # Combine micro instruction into instruction blocks. + # + combine_micro_instructions(); + + # # Generate code for specific ops. # my($spec_opnum) = 0; @@ -525,17 +584,15 @@ sub emulator_output { # Call a generator to calculate size and generate macros # for the emulator. # - my($size, $code, $pack) = basic_generator($name, $hot, @args); + my($size, $code, $pack) = + basic_generator($name, 1, '', 0, undef, @args); # # Save the generated $code for later. # if (defined $code) { - if ($hot) { - push(@{$hot_code{$code}}, $instr); - } else { - push(@{$cold_code{$code}}, $instr); - } + $code = "OpCase($instr):\n$code"; + push @generated_code, [$hot,$code,($instr)]; } # @@ -646,7 +703,7 @@ sub emulator_output { print "#if !defined(ARCH_64)\n"; print qq[ #error "64-bit architecture assumed, but ARCH_64 not defined"\n]; print "#endif\n"; - print "#define BEAM_WIDE_MASK 0xFFFFUL\n"; + print "#define BEAM_WIDE_MASK 0xFFFFFFFFUL\n"; print "#define BEAM_LOOSE_MASK 0xFFFFUL\n"; print "#define BEAM_TIGHT_MASK 0xFFFFUL\n"; print "#define BEAM_WIDE_SHIFT 32\n"; @@ -750,13 +807,17 @@ sub emulator_output { $name = "$outdir/beam_hot.h"; open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; comment('C'); - print_code(\%hot_code); + print_code(HOT); - $name = "$outdir/beam_cold.h"; + $name = "$outdir/beam_warm.h"; open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; comment('C'); - print_code(\%cold_code); + print_code(WARM); + $name = "$outdir/beam_cold.h"; + open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + comment('C'); + print_code(COLD); } sub init_item { @@ -784,29 +845,47 @@ sub q { } sub print_code { - my($ref) = @_; - my(%sorted); - my($key, $label); # Loop variables. - - foreach $key (keys %$ref) { - my($sort_key); - my($code) = ''; - foreach $label (@{$ref->{$key}}) { - $code .= "OpCase($label):\n"; - $sort_key = $label; - } - foreach (split("\n", $key)) { - $code .= " $_\n"; - } - $code .= "\n"; - $sorted{$sort_key} = $code; + my($include_hot) = @_; + my %sorted; + + foreach my $ref (@generated_code) { + my($hot,$code,@labels) = @$ref; + next unless $hot == $include_hot; + my($sort_key) = @labels; # Use the first label as sort key. + $sorted{$sort_key} = $code; } foreach (sort keys %sorted) { - print $sorted{$_}; + print_indented_code($sorted{$_}); + } +} + +sub print_indented_code { + my(@code) = @_; + + foreach my $chunk (@code) { + my $indent = 0; + foreach (split "\n", $chunk) { + s/^\s*//; + if (/\}/) { + $indent -= 2; + } + if ($_ eq '') { + print "\n"; + } elsif (/^#/) { + print $_, "\n"; + } else { + print ' ' x $indent, $_, "\n"; + } + if (/\{/) { + $indent += 2; + } + } + print "\n"; } } + # # Produce output needed by the compiler back-end (assembler). # @@ -893,6 +972,18 @@ sub save_specific_ops { } } +sub parse_c_args { + local($_) = @_; + my @res; + + while (s/^(\w[\w\d]*)\s*//) { + push @res, $1; + s/^,\s*// or last; + } + $_ eq '' or error("garbage in argument list: $_"); + @res; +} + sub error { my(@message) = @_; my($where) = $. ? "$ARGV($.): " : ""; @@ -934,58 +1025,209 @@ sub comment { } # -# Basic implementation of instruction in emulator loop -# (assuming no packing). +# Combine micro instruction into instruction blocks. # +sub combine_micro_instructions { + my %groups; + + # Sanity check, normalize micro instructions. + foreach my $instr (keys %combined_instrs) { + my $ref = $combined_instrs{$instr}; + my($def_loc,$def) = @$ref; + my($group,@subs) = split /[.]/, $def; + my $arity = 0; + @subs = map { "$group.$_" } @subs; + foreach my $s (@subs) { + my $code = $c_code{$s}; + defined $code or + error("$def_loc: no definition of $s"); + $c_code_used{$s} = 1; + my(undef,undef,@c_args) = @{$code}; + $arity += scalar(@c_args); + } + push @{$groups{$group}}, [$instr,$arity,@subs]; + } -sub basic_generator { - my($name, $hot, @args) = @_; - my($size) = 0; - my($macro) = ''; - my($flags) = ''; - my(@f); - my(@f_types); - my($fail_type); - my($prefix) = ''; - my($tmp_arg_num) = 1; - my($pack_spec) = ''; - my($var_decls) = ''; - my($i); - my($no_prefetch) = 0; + # Now generate code for each group. + foreach my $group (sort keys %groups) { + my($hotness,$code,@labels) = + combine_instruction_group($group, @{$groups{$group}}); + push @generated_code, [$hotness,$code,@labels]; + } +} - # The following argument types should be included as macro arguments. - my(%incl_arg) = ('c' => 1, - 'i' => 1, - 'a' => 1, - 'A' => 1, - 'N' => 1, - 'U' => 1, - 'I' => 1, - 't' => 1, - 'P' => 1, - 'Q' => 1, - ); +sub combine_instruction_group { + my($group,@in_instrs) = @_; + my $gcode = ''; # Code for the entire group. + my $group_hotness = COLD; + + # Get code for the head of the group (if any). + my $head_name = "$group.head"; + $c_code_used{$head_name} = 1; + my $head_code_ref = $c_code{$head_name}; + if (defined $head_code_ref) { + my($head_code,$where,@c_args) = @{$head_code_ref}; + @c_args and error("$where: no arguments allowed for " . + "head function '$head_name()'"); + $gcode = $head_code . "\n"; + } + + # Variables. + my %offsets; + my @instrs; + my %num_references; + my $group_size = 0; + + # Do basic error checking. Associate operands of instructions + # with the correct micro instructions. Calculate offsets for micro + # instructions. + foreach my $ref_instr (@in_instrs) { + my($specific,$arity,@subs) = @$ref_instr; + my $specific_key = "$specific/$arity"; + my $specific_op_ref = $specific_op{$specific_key}; + error("no $specific_key instruction") + unless defined $specific_op_ref; + foreach my $specific_op (@$specific_op_ref) { + my($name, $hotness, @args) = @{$specific_op}; + $group_hotness = $hotness unless $group_hotness >= $hotness; + my $offset = 0; + my @rest = @args; + my @new_subs; + my $opcase = $specific; + $opcase .= "_" . join '', @args if @args; + foreach my $s (@subs) { + my $code = $c_code{$s}; + my(undef,undef,@c_args) = @{$code}; + my @first; + foreach (0..$#c_args) { + push @first, shift @rest; + } + my($size,undef) = basic_generator($s, 0, '', 0, undef, @first); + $offsets{$s} = $offset + unless defined $offsets{$s} and $offsets{$s} >= $offset; + $offset += $size - 1; + my $label = micro_label($s); + $num_references{$label} = 0; + push @new_subs, [$opcase,$label,$s,$size-1,@first]; + $opcase = ''; + } + $group_size = $offset if $group_size < $offset; + push @instrs, [$specific_key,@new_subs]; + } + } + + # Link the sub instructions for each instructions to each + # other. + my @all_instrs; + foreach my $instr (@instrs) { + my($specific_key,@subs) = @{$instr}; + for (my $i = 0; $i < @subs; $i++) { + my($opcase,$label,$s,$size,@args) = @{$subs[$i]}; + my $next = ''; + (undef,$next) = @{$subs[$i+1]} if $i < $#subs; + $num_references{$next}++ if $next; + my $instr_info = "$opcase:$label:$next:$s:$size:@args"; + push @all_instrs, [$label,$offsets{$s},$instr_info]; + } + } - # Pick up the macro to use and its flags (if any). + my %order_to_instrs; + my %label_to_offset; + my %order_to_offset; + foreach my $instr (@all_instrs) { + my($label,$offset,$instr_info) = @$instr; + my $sort_key = sprintf("%02d.%02d", $offset, $num_references{$label}); + push @{$order_to_instrs{$sort_key}}, $instr_info; + $label_to_offset{$label} = $offset; + $order_to_offset{$sort_key} = $offset; + } + + my(@slots) = sort {$a <=> $b} keys %order_to_instrs; + + # Now generate the code for the entire group. + my $offset = 0; + my @opcase_labels; + for(my $i = 0; $i < @slots; $i++) { + my $key = $slots[$i]; + + # Sort micro-instructions with OpCase before other micro-instructions. + my(@instrs) = @{$order_to_instrs{$key}}; + my $order_func = sub { + my $a_key = ($a =~ /^:/) ? "1$a" : "0$a"; + my $b_key = ($b =~ /^:/) ? "1$b" : "0$b"; + $a_key cmp $b_key; + }; + @instrs = sort $order_func @instrs; + + my %seen; + foreach my $instr (@instrs) { + my($opcase,$label,$next,$s,$size,$args) = split ":", $instr; + my(@first) = split " ", $args; + + my $seen_key = "$label:$next:" . scalar(@first); + next if $opcase eq '' and $seen{$seen_key}; + $seen{$seen_key} = 1; + + if ($opcase ne '') { + $gcode .= "OpCase($opcase):\n"; + push @opcase_labels, $opcase; + } + if ($num_references{$label}) { + $gcode .= "$label:\n"; + } - $macro = $macro{$name} if defined $macro{$name}; - $flags = $macro_flags{$name} if defined $macro_flags{$name}; + my $flags = ''; + my $transfer_to_next = ''; + my $dec = 0; - # - # Add any arguments to be included as macro arguments (for instance, - # 'p' is usually not an argument, except for calls). - # + unless ($i == $#slots) { + $flags = "-no_next"; + my $next_offset = $label_to_offset{$next}; + $dec = $next_offset - ($offset + $size); + $transfer_to_next = "I -= $dec;\n" if $dec; + $transfer_to_next .= "goto $next;\n\n"; + } - while ($flags =~ /-arg_(\w)/g) { - $incl_arg{$1} = 1; - }; + my(undef,$gen_code) = + basic_generator($s, 0, $flags, $offset, + $group_size-$offset-$dec, @first); + $gcode .= $gen_code . $transfer_to_next; + } + $offset = $order_to_offset{$slots[$i+1]} if $i < $#slots; + } + + ($group_hotness,"{\n$gcode\n}\n\n",@opcase_labels); +} + +sub micro_label { + my $label = shift; + $label =~ s/[.]/__/g; + $label; +} + + +# +# Basic implementation of instruction in emulator loop +# (assuming no packing). +# + +sub basic_generator { + my($name,$hot,$extra_comments,$offset,$group_size,@args) = @_; + my $size = 0; + my $flags = ''; + my @f; + my $prefix = ''; + my $tmp_arg_num = 1; + my $pack_spec = ''; + my $var_decls = ''; # - # Pack arguments if requested. + # Pack arguments for hot code with an implementation. # - if ($flags =~ /-pack/ && $hot) { - ($prefix, $pack_spec, @args) = do_pack(@args); + my $c_code_ref = $c_code{$name}; + if ($hot and defined $c_code_ref) { + ($var_decls, $pack_spec, @args) = do_pack(@args); } # @@ -993,244 +1235,436 @@ sub basic_generator { # the macro. # + my $need_block = 0; + my $arg_offset = $offset; foreach (@args) { my($this_size) = $arg_size{$_}; SWITCH: { - /^pack:(\d):(.*)/ and do { push(@f, $2); - push(@f_types, 'packed'); - $this_size = $1; - last SWITCH; - }; - /r/ and do { push(@f, "r(0)"); push(@f_types, $_); last SWITCH }; - /[xy]/ and do { push(@f, "$_" . "b(Arg($size))"); - push(@f_types, $_); - last SWITCH; - }; - /n/ and do { push(@f, "NIL"); push(@f_types, $_); last SWITCH }; - /s/ and do { my($tmp) = "targ$tmp_arg_num"; - $var_decls .= "Eterm $tmp; "; - $tmp_arg_num++; - push(@f, $tmp); - push(@f_types, $_); - $prefix .= "GetR($size, $tmp);\n"; - last SWITCH; }; - /d/ and do { $var_decls .= "Eterm dst; Eterm* dst_ptr; "; - push(@f, "*dst_ptr"); - push(@f_types, $_); - $prefix .= "dst = Arg($size);\n"; - $prefix .= "dst_ptr = REG_TARGET_PTR(dst);\n"; - last SWITCH; - }; - defined($incl_arg{$_}) - and do { push(@f, "Arg($size)"); - push(@f_types, $_); - last SWITCH; - }; - - /[fp]/ and do { $fail_type = $_; last SWITCH }; - - /[eLIFEbASjPowlq]/ and do { last SWITCH; }; + /^packed:d:(\d):(.*)/ and do { + $var_decls .= "Eterm dst = $2;\n" . + "Eterm* dst_ptr = REG_TARGET_PTR(dst);\n"; + push(@f, "*dst_ptr"); + $this_size = $1; + last SWITCH; + }; + /^packed:[a-zA-z]:(\d):(.*)/ and do { + push(@f, $2); + $this_size = $1; + last SWITCH; + }; + /r/ and do { + push(@f, "r(0)"); + last SWITCH; + }; + /[lxyS]/ and do { + push(@f, $_ . "b(" . arg_offset($arg_offset) . ")"); + last SWITCH; + }; + /n/ and do { + push(@f, "NIL"); + last SWITCH; + }; + /s/ and do { + my($tmp) = "targ$tmp_arg_num"; + $var_decls .= "Eterm $tmp;\n"; + $tmp_arg_num++; + push(@f, $tmp); + $prefix .= "GetR($arg_offset, $tmp);\n"; + $need_block = 1; + last SWITCH; + }; + /d/ and do { + $var_decls .= "Eterm dst = " . arg_offset($arg_offset) . ";\n" . + "Eterm* dst_ptr = REG_TARGET_PTR(dst);\n"; + push(@f, "*dst_ptr"); + last SWITCH; + }; + defined $arg_size{$_} and do { + push @f, arg_offset($arg_offset); + last SWITCH; + }; die "$name: The generator can't handle $_, at"; } $size += $this_size; + $arg_offset += $this_size; } # - # Add a fail action macro if requested. + # If the implementation is in beam_emu.c, there is nothing + # more to do. # + unless (defined $c_code_ref) { + return ($size+1, undef, ''); + } - $flags =~ /-fail_action/ and do { - $no_prefetch = 1; - if (!defined $fail_type) { - my($i); - for ($i = 0; $i < @f_types; $i++) { - local($_) = $f_types[$i]; - /[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next }; - } - } elsif ($fail_type eq 'f') { - push(@f, "ClauseFail()"); - } else { - my($i); - for ($i = 0; $i < @f_types; $i++) { - local($_) = $f_types[$i]; - /[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next }; - } - } - }; + $group_size = $size unless defined $group_size; # - # Add a size argument if requested. + # Generate main body of the implementation. # + my($c_code,$where,@c_args) = @{$c_code_ref}; + my %bindings; + $c_code_used{$name} = 1; - $flags =~ /-size/ and do { - push(@f, $size); - }; + if (@f != @c_args) { + error("$where: defining '$name' with ", scalar(@c_args), + " arguments instead of expected ", scalar(@f), " arguments"); + } - # Generate the macro if requested. - my($code); - if (defined $macro{$name}) { - my($macro_code) = "$prefix$macro(" . join(', ', @f) . ");"; - $var_decls .= "BeamInstr tmp_packed1;" - if $macro_code =~ /tmp_packed1/; - $var_decls .= "BeamInstr tmp_packed2;" - if $macro_code =~ /tmp_packed2/; - if ($flags =~ /-nonext/) { - $code = join("\n", - "{ $var_decls", - $macro_code, - "}"); - } elsif ($flags =~ /-goto:(\S*)/) { - my $goto = $1; - $code = join("\n", - "{ $var_decls", - $macro_code, - "I += $size + 1;", - "goto $goto;", - "}"); - } elsif ($no_prefetch) { - $code = join("\n", - "{ $var_decls", - $macro_code, - "Next($size);", - "}", ""); - } else { - $code = join("\n", - "{ $var_decls", - "BeamInstr* next;", - "PreFetch($size, next);", - "$macro_code", - "NextPF($size, next);", - "}", ""); - } + for (my $i = 0; $i < @f; $i++) { + my $var = $c_args[$i]; + $bindings{$var} = $f[$i]; + } + $bindings{'NEXT_INSTRUCTION'} = "I+" . ($group_size+$offset+1); + $c_code = eval { expand_all($c_code, \%bindings) }; + unless (defined $c_code) { + warn $@; + error("... from the body of $name at $where"); + } + my(@comments) = $c_code =~ m@//[|]\s*(.*)@g; + $c_code =~ s@//[|]\s*(.*)\n?@@g; + $flags = "@comments $extra_comments"; + + # + # Generate code for transferring to the next instruction. + # + my $dispatch_next; + my $instr_offset = $group_size + $offset + 1; + + if ($flags =~ /-no_next/) { + $dispatch_next = ""; + } elsif ($flags =~ /-no_prefetch/) { + $dispatch_next = "\nI += $instr_offset;\n" . + "ASSERT(VALID_INSTR(*I));\n" . + "Goto(*I);"; + } else { + $var_decls .= "BeamInstr* _nextpf = " . + "(BeamInstr *) I[$instr_offset];\n"; + $dispatch_next = "\nI += $instr_offset;\n" . + "ASSERT(VALID_INSTR(_nextpf));\n" . + "Goto(_nextpf);"; } - # Return the size and code for the macro (if any). - $size++; - ($size, $code, $pack_spec); + # + # Assemble the complete code for the instruction. + # + my $body = "$c_code$dispatch_next"; + if ($need_block) { + $body = "$prefix\{\n$body\n}"; + } else { + $body = "$prefix$body"; + } + my $code = join("\n", + "{", + "$var_decls$body", + "}", ""); + ($size+1, $code, $pack_spec); +} + +sub arg_offset { + my $offset = shift; + "I[" . ($offset+1) . "]"; +} + +sub expand_all { + my($code,$bindings_ref) = @_; + my %bindings = %{$bindings_ref}; + + # Expand all $Var occurrences. + $code =~ s/[\$](\w[\w\d]*)(?!\()/defined $bindings{$1} ? $bindings{$1} : "\$$1"/ge; + + # Find calls to macros, $name(...), and expand them. + my $res = ""; + while ($code =~ /[\$](\w[\w\d]*)\(/) { + my $macro_name = $1; + my $keep = substr($code, 0, $-[0]); + my $after = substr($code, $+[0]); + + # Keep the special, pre-defined bindings. + my %new_bindings; + foreach my $key (qw(NEXT_INSTRUCTION)) { + $new_bindings{$key} = $bindings{$key}; + } + + my $body; + ($body,$code) = expand_macro($macro_name, $after, \%new_bindings); + $res .= "$keep$body"; + } + + $res . $code; +} + +sub expand_macro { + my($name,$rest,$bindings_ref) = @_; + + my $c_code = $c_code{$name}; + defined $c_code or + error("calling undefined macro '$name'..."); + $c_code_used{$name} = 1; + my ($body,$where,@vars) = @{$c_code}; + + # Separate the arguments into @args; + my @args; + my $level = 1; + my %inc = ('(' => 1, ')' => -1, + '[' => 1, ']' => -1, + '{' => 1, '}' => -1); + my $arg = undef; + while ($rest =~ /([,\(\[\{\}\]\)]|([^,\(\[\{\}\]\)]*))/g) { + my $token = $1; + my $inc = $inc{$token} || 0; + $level += $inc; + if ($level == 0) { + $rest = substr($rest, pos($rest)); + push @args, $arg if defined $arg; + last; + } + if ($token eq ',') { + if ($level == 1) { + push @args, $arg; + $arg = ""; + } + next; + } + $arg .= $token; + } + + # Trim leading whitespace from each argument. + foreach my $arg (@args) { + $arg =~ s/^\s*//; + } + + # Now combine bindings from the parameter names and arguments. + my %bindings = %{$bindings_ref}; + if (@vars != @args) { + error("calling $name with ", scalar(@args), + " arguments instead of expected ", scalar(@vars), " arguments..."); + } + for (my $i = 0; $i < @vars; $i++) { + $bindings{$vars[$i]} = $args[$i]; + } + + $body = eval { expand_all($body, \%bindings) }; + unless (defined $body) { + warn $@; + die "... from the body of $name at $where\n"; + } + $body = "do {\n$body\n} while (0)" + if needs_do_wrapper($body); + ($body,$rest); +} + +# Conservative heuristic to determine whether a do { ... } while(0) +# wrapper is needed. +sub needs_do_wrapper { + local $_ = shift; + + s@^//[|][^\n]*\n@@; + s@^\s*@@s; + s@^/[*].*[*]/\s*@@s; + return 1 if /^(Eterm|Uint|Sint|int|unsigned)/; # Definitely needed. + return 0 if /^do/; + return 0 if /^SET_I/; + return 0 if /^SET_CP/; + return 0 if /^ERTS_NO_FPE_CHECK_INIT/; + return 0 if /^ASSERT/; + return 0 if /^DTRACE/; + return 0 if /^[A-Za-z_]*\s*=/; + return 0 if /^c_p->/; + return 0 if /^[A-Z_]*SWAPOUT/; + return 0 if /^if\s*[(]/; + return 0 if /^goto\b/; + return 1; # Not sure, say that it is needed. } sub do_pack { my(@args) = @_; my($packable_args) = 0; - my @is_packable; # Packability (boolean) for each argument. - my $wide_packing = 0; - my(@orig_args) = @args; + my @bits_needed; # Bits needed for each argument. + + # + # Define the minimum number of bits needed for the packable argument types. + # + my %bits_needed = ('x' => 10, + 'y' => 10, + 'Q' => 10, + 'l' => 10, + 'S' => 16, + 'd' => 16, + 't' => 16); + if ($wordsize == 64) { + $bits_needed{'I'} = 32; + } # - # Count the number of packable arguments. If we encounter any 's' or 'd' - # arguments, packing is not possible. + # Count the number of packable arguments. # - my $packable_types = "xytQ"; foreach my $arg (@args) { - if ($arg =~ /^[$packable_types]/) { + if (defined $bits_needed{$arg}) { $packable_args++; - push @is_packable, 1; - } elsif ($arg =~ /^I/ and $wordsize == 64 and $packable_args < 2) { - $wide_packing = 1; - push @is_packable, 1; - if (++$packable_args == 2) { - # We can only pack two arguments. Turn off packing - # for the rest of the arguments. - $packable_types = "\xFF"; - } - } elsif ($arg =~ /^[sd]/) { - return ('', '', @args); - } elsif ($arg =~ /^[scq]/ and $packable_args > 0) { - # When packing, this operand will be picked up from the - # code array, put onto the packing stack, and later put - # back into a different location in the code. The problem - # is that if this operand is a literal, the original - # location in the code would have been remembered in a - # literal patch. For packing to work, we would have to - # adjust the position in the literal patch. For the - # moment, adding additional instructions to the packing - # engine to handle this does not seem worth it, so we will - # just turn off packing. - return ('', '', @args); + push @bits_needed, $bits_needed{$arg}; } else { - push @is_packable, 0; + push @bits_needed, 0; } } # - # Get out of here if too few or too many arguments. + # Nothing to pack unless there are at least 2 packable arguments. # return ('', '', @args) if $packable_args < 2; - my($size) = 0; - my($pack_prefix) = ''; - my($down) = ''; # Pack commands (towards instruction + # + # Determine how many arguments we should pack into each word. + # + my @args_per_word; + my @need_wide_mask; + my $bits = 0; + my $word = 0; + $args_per_word[0] = 0; + $need_wide_mask[0] = 0; + for (my $i = 0; $i < @args; $i++) { + if ($bits_needed[$i]) { + my $needed = $bits_needed[$i]; + + my $next_word = sub { + $word++; + $args_per_word[$word] = 0; + $need_wide_mask[$word] = 0; + $bits = 0; + }; + + if ($bits+$needed > $wordsize) { # Does not fit. + $next_word->(); + } + if ($args_per_word[$word] == 4) { # Can't handle more than 4 args. + $next_word->(); + } + if ($needed == 32 and $args_per_word[$word] > 1) { + # Must only pack two arguments in this word, and there + # are already at least two arguments here. + $next_word->(); + } + $args_per_word[$word]++; + $bits += $needed; + if ($needed == 32) { + $need_wide_mask[$word]++; + } + if ($need_wide_mask[$word] and $bits > 32) { + # Can only pack two things in a word where one + # item is 32 bits. Force the next item into + # the next word. + $bits = $wordsize; + } + } + } + + # + # Try to balance packing between words. + # + if ($args_per_word[$#args_per_word] == 1) { + if ($args_per_word[$#args_per_word-1] < 3) { + pop @args_per_word; + } else { + $args_per_word[$#args_per_word-1]--; + $args_per_word[$#args_per_word]++; + } + } elsif (@args_per_word == 2 and + $args_per_word[0] == 4 and + $args_per_word[1] == 2) { + $args_per_word[0] = 3; + $args_per_word[1] = 3; + } elsif (@args_per_word == 2 and + $args_per_word[0] == 3 and + $args_per_word[1] == 1) { + $args_per_word[0] = 2; + $args_per_word[1] = 2; + } + + my $size = 0; + my $pack_prefix = ''; + my $down = ''; # Pack commands (towards instruction # beginning). - my($up) = ''; # Pack commands (storing back while + my $up = ''; # Pack commands (storing back while # moving forward). - - my $args_per_word = $args_per_word[$packable_args]; - my @shift; - my @mask; - my @instr; - - if ($wide_packing) { - @shift = ('0', 'BEAM_WIDE_SHIFT'); - @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD); - @instr = ('w', 'i'); - } else { - @shift = @{$pack_shift[$args_per_word]}; - @mask = @{$pack_mask[$args_per_word]}; - @instr = @{$pack_instr[$args_per_word]}; - } + my $did_some_packing = 0; # Nothing packed yet. + + # Skip an unpackable argument. + my $skip_unpackable = sub { + my($arg) = @_; + + if ($arg_size{$arg} and $did_some_packing) { + # Save the argument on the pack engine's stack. + $down = "g${down}"; + $up = "${up}p"; + } else { + # The argument has either zero size (e.g. r(0)), + # or is to the left of the first packed argument + # and will never be accessed. No need to do + # anything. + } + }; # # Now generate the packing instructions. One complication is that # the packing engine works from right-to-left, but we must generate # the instructions from left-to-right because we must calculate # instruction sizes from left-to-right. - # - # XXX Packing 3 't's in one word won't work. Sorry. - - my $did_some_packing = 0; # Nothing packed yet. - my($ap) = 0; # Argument number within word. - my($tmpnum) = 1; # Number of temporary variable. - my($expr) = ''; - for (my $i = 0; $i < @args; $i++) { - my($reg) = $args[$i]; - my($this_size) = $arg_size{$reg}; - if ($is_packable[$i]) { - $this_size = 0; - $did_some_packing = 1; - - if ($ap == 0) { - $pack_prefix .= "tmp_packed$tmpnum = Arg($size);\n"; - $up .= "p"; - $down = "P$down"; - $this_size = 1; - } - $down = "$instr[$ap]$down"; - my($unpack) = make_unpack($tmpnum, $shift[$ap], $mask[$ap]); - $args[$i] = "pack:$this_size:$reg" . "b($unpack)"; + my $arg_num = 0; + for (my $word = 0; $word < @args_per_word; $word++) { + my $ap = 0; # Argument number within word. + my $packed_var = "tmp_packed" . ($word+1); + my $args_per_word = $args_per_word[$word]; + my @shift; + my @mask; + my @instr; + + if ($need_wide_mask[$word]) { + @shift = ('0', 'BEAM_WIDE_SHIFT'); + @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD); + @instr = ('w', 'i'); + } else { + @shift = @{$pack_shift[$args_per_word]}; + @mask = @{$pack_mask[$args_per_word]}; + @instr = @{$pack_instr[$args_per_word]}; + } - if (++$ap == $args_per_word) { - $ap = 0; - $tmpnum++; - } - } elsif ($arg_size{$reg} && $did_some_packing) { - # - # This is an argument that can't be packed. Normally, we must - # save it on the pack engine's stack, unless: - # - # 1. The argument has zero size (e.g. r(0)). Such arguments - # will not be loaded. They disappear. - # 2. If the argument is on the left of the first packed argument, - # the packing engine will never access it (because the engine - # operates from right-to-left). - # + while ($ap < $args_per_word) { + my $reg = $args[$arg_num]; + my $this_size = $arg_size{$reg}; + if ($bits_needed[$arg_num]) { + $this_size = 0; + $did_some_packing = 1; + + if ($ap == 0) { + $pack_prefix .= "Eterm $packed_var = " . + arg_offset($size) . ";\n"; + $up .= "p"; + $down = "P$down"; + $this_size = 1; + } + + $down = "$instr[$ap]$down"; + my $unpack = make_unpack($packed_var, $shift[$ap], $mask[$ap]); + $args[$arg_num] = "packed:$reg:$this_size:$reg" . "b($unpack)"; + + $ap++; + } else { + $skip_unpackable->($reg); + } + $size += $this_size; + $arg_num++; + } + } - $down = "g${down}"; - $up = "${up}p"; - } - $size += $this_size; + # + # Skip any unpackable arguments at the end. + # + while ($arg_num < @args) { + $skip_unpackable->($args[$arg_num]); + $arg_num++; } my $pack_spec = $down . $up; @@ -1238,9 +1672,9 @@ sub do_pack { } sub make_unpack { - my($tmpnum, $shift, $mask) = @_; + my($packed_var, $shift, $mask) = @_; - my($e) = "tmp_packed$tmpnum"; + my $e = $packed_var; $e = "($e>>$shift)" if $shift; $e .= "&$mask" unless $mask eq $WHOLE_WORD; $e; @@ -1286,8 +1720,11 @@ sub parse_transformation { # my @to; - if ($to =~ /^(\w+)\((.*?)\)/) { - my($name, $arglist) = ($1, $2); + if ($to =~ /^(\w+)\((.*?)\)(.*)/) { + my($name, $arglist, $garbage) = ($1, $2, $3); + if ($garbage =~ /\S/) { + error("garbage after call to '$name()'"); + } @to = (compile_transform_function($name, split(/\s*,\s*/, $arglist))); } else { @to = split(/\s*\|\s*/, $to); diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index f05c729eeb..f928163705 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -627,12 +627,14 @@ static void pass_on(pid_t childpid) status("Pty master read; "); #endif if ((len = sf_read(mfd, buf, BUFSIZ)) <= 0) { + int saved_errno = errno; sf_close(rfd); if(wfd) sf_close(wfd); sf_close(mfd); unlink(fifo1); unlink(fifo2); if (len < 0) { + errno = saved_errno; if(errno == EIO) ERROR0(LOG_ERR,"Erlang closed the connection."); else @@ -1342,13 +1344,15 @@ static int sf_open(const char *path, int type, mode_t mode) { return fd; } + static int sf_close(int fd) { int res = 0; - do { res = close(fd); } while(fd < 0 && errno == EINTR); + do { res = close(fd); } while(res < 0 && errno == EINTR); return res; } + /* Extract any control sequences that are ment only for run_erl * and should not be forwarded to the pty. */ diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 58c17dc416..e258ff5480 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 6691749dcb..5416826f19 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 2acb1f1211..1c8d0e626a 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex a959ebaaf2..267b5cb0a8 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 72dd804412..d43fdc454c 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -48,6 +48,12 @@ await_sched_wall_time_modifications/2, gather_gc_info_result/1]). +-export([dist_ctrl_input_handler/2, + dist_ctrl_put_data/2, + dist_ctrl_get_data/1, + dist_ctrl_get_data_notification/1, + dist_get_stat/1]). + -deprecated([now/0]). %% Get rid of autoimports of spawn to avoid clashes with ourselves. @@ -87,6 +93,14 @@ -export_type([prepared_code/0]). +-opaque dist_handle() :: atom(). + +-export_type([dist_handle/0]). + +-type iovec() :: [binary()]. + +-export_type([iovec/0]). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Native code BIF stubs and their types %% (BIF's actually implemented in this module goes last in the file) @@ -124,7 +138,7 @@ has_prepared_code_on_load/1, hibernate/3]). -export([insert_element/3]). -export([integer_to_binary/1, integer_to_list/1]). --export([iolist_size/1, iolist_to_binary/1]). +-export([iolist_size/1, iolist_to_binary/1, iolist_to_iovec/1]). -export([is_alive/0, is_builtin/3, is_process_alive/1, length/1, link/1]). -export([list_to_atom/1, list_to_binary/1]). -export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]). @@ -1079,6 +1093,12 @@ iolist_size(_Item) -> iolist_to_binary(_IoListOrBinary) -> erlang:nif_error(undefined). +%% iolist_to_iovec/1 +-spec erlang:iolist_to_iovec(IoListOrBinary) -> iovec() when + IoListOrBinary :: iolist() | binary(). +iolist_to_iovec(_IoListOrBinary) -> + erlang:nif_error(undefined). + %% is_alive/0 -spec is_alive() -> boolean(). is_alive() -> @@ -1641,7 +1661,7 @@ setnode(_P1, _P2) -> erlang:nif_error(undefined). %% setnode/3 --spec erlang:setnode(P1, P2, P3) -> true when +-spec erlang:setnode(P1, P2, P3) -> dist_handle() when P1 :: atom(), P2 :: port(), P3 :: {term(), term(), term(), term()}. @@ -3204,6 +3224,47 @@ port_get_data(_Port) -> erlang:nif_error(undefined). %% +%% Distribution channel management +%% + +-spec erlang:dist_ctrl_input_handler(DHandle, InputHandler) -> 'ok' when + DHandle :: dist_handle(), + InputHandler :: pid(). + +dist_ctrl_input_handler(_DHandle, _InputHandler) -> + erlang:nif_error(undefined). + +-spec erlang:dist_ctrl_put_data(DHandle, Data) -> 'ok' when + DHandle :: dist_handle(), + Data :: iodata(). + +dist_ctrl_put_data(_DHandle, _Data) -> + erlang:nif_error(undefined). + +-spec erlang:dist_ctrl_get_data(DHandle) -> Data | 'none' when + DHandle :: dist_handle(), + Data :: iodata(). + +dist_ctrl_get_data(_DHandle) -> + erlang:nif_error(undefined). + +-spec erlang:dist_ctrl_get_data_notification(DHandle) -> 'ok' when + DHandle :: dist_handle(). + +dist_ctrl_get_data_notification(_DHandle) -> + erlang:nif_error(undefined). + +-spec erlang:dist_get_stat(DHandle) -> Res when + DHandle :: dist_handle(), + InputPackets :: non_neg_integer(), + OutputPackets :: non_neg_integer(), + PendingOutputPackets :: boolean(), + Res :: {'ok', InputPackets, OutputPackets, PendingOutputPackets}. + +dist_get_stat(_DHandle) -> + erlang:nif_error(undefined). + +%% %% If the emulator wants to perform a distributed command and %% a connection is not established to the actual node the following %% functions are called in order to set up the connection and then diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 26fb1458af..bb1824ecd4 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -61,6 +61,8 @@ -export([trace/3, trace_pattern/3]). +-export([dist_ctrl_put_data/2]). + %% Auto import name clash -export([check_process_code/1]). @@ -461,3 +463,38 @@ trace(_PidSpec, _How, _FlagList) -> FlagList :: [ ]. trace_pattern(_MFA, _MatchSpec, _FlagList) -> erlang:nif_error(undefined). + +-spec dist_ctrl_put_data(DHandle, Data) -> 'ok' when + DHandle :: erlang:dist_handle(), + Data :: iolist(). + +dist_ctrl_put_data(DHandle, IoList) -> + %% + %% Helper for erlang:dist_ctrl_put_data/2 + %% + %% erlang:dist_ctrl_put_data/2 traps to + %% this function if second argument is + %% a list... + %% + try + Binary = erlang:iolist_to_binary(IoList), + %% Restart erlang:dist_ctrl_put_data/2 + %% with the iolist converted to a binary... + erlang:dist_ctrl_put_data(DHandle, Binary) + catch + Class : Reason -> + %% Throw exception as if thrown from + %% erlang:dist_ctrl_put_data/2 ... + RootST = try erlang:error(Reason) + catch + error:Reason -> + case erlang:get_stacktrace() of + [] -> []; + ST -> tl(ST) + end + end, + StackTrace = [{erlang, dist_ctrl_put_data, + [DHandle, IoList], []} + | RootST], + erlang:raise(Class, Reason, StackTrace) + end. diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 1ccf8d599f..34a9f6b8b9 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -200,6 +200,8 @@ boot(BootArgs) -> register(init, self()), process_flag(trap_exit, true), + %% Load the zlib nif + zlib:on_load(), %% Load the tracer nif erl_tracer:on_load(), diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl index 8cd3e39fd7..dca5a42779 100644 --- a/erts/preloaded/src/zlib.erl +++ b/erts/preloaded/src/zlib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,19 +21,29 @@ -module(zlib). -export([open/0,close/1,deflateInit/1,deflateInit/2,deflateInit/6, - deflateSetDictionary/2,deflateReset/1,deflateParams/3, - deflate/2,deflate/3,deflateEnd/1, - inflateInit/1,inflateInit/2, - inflateSetDictionary/2,inflateGetDictionary/1, - inflateSync/1,inflateReset/1,inflate/2,inflateEnd/1, - inflateChunk/1, inflateChunk/2, - setBufSize/2,getBufSize/1, - crc32/1,crc32/2,crc32/3,adler32/2,adler32/3,getQSize/1, - crc32_combine/4,adler32_combine/4, - compress/1,uncompress/1,zip/1,unzip/1, - gzip/1,gunzip/1]). - --export_type([zstream/0, zlevel/0, zwindowbits/0, zmemlevel/0, zstrategy/0]). + deflateSetDictionary/2,deflateReset/1,deflateParams/3, + deflate/2,deflate/3,deflateEnd/1, + inflateInit/1,inflateInit/2, + inflateSetDictionary/2,inflateGetDictionary/1, inflateReset/1, + inflate/2,inflate/3,inflateEnd/1, + inflateChunk/2,inflateChunk/1, + safeInflate/2, + setBufSize/2,getBufSize/1, + crc32/1,crc32/2,crc32/3,adler32/2,adler32/3, + crc32_combine/4,adler32_combine/4, + compress/1,uncompress/1,zip/1,unzip/1, + gzip/1,gunzip/1]). + +-export([on_load/0]). + +%% These are soft-deprecated until OTP 21. +% -deprecated([inflateChunk/1, inflateChunk/2, +% getBufSize/1, setBufSize/2, +% crc32/1,crc32/2,crc32/3,adler32/2,adler32/3, +% crc32_combine/4,adler32_combine/4]). + +-export_type([zstream/0, zflush/0, zlevel/0, zwindowbits/0, zmemlevel/0, + zstrategy/0]). %% flush argument encoding -define(Z_NO_FLUSH, 0). @@ -56,116 +66,76 @@ %% deflate compression method -define(Z_DEFLATED, 8). --define(Z_NULL, 0). - -define(MAX_WBITS, 15). -%% gzip defs (rfc 1952) - --define(ID1, 16#1f). --define(ID2, 16#8b). - --define(FTEXT, 16#01). --define(FHCRC, 16#02). --define(FEXTRA, 16#04). --define(FNAME, 16#08). --define(FCOMMENT, 16#10). --define(RESERVED, 16#E0). - --define(OS_MDDOS, 0). --define(OS_AMIGA, 1). --define(OS_OPENVMS, 2). --define(OS_UNIX, 3). --define(OS_VMCMS, 4). --define(OS_ATARI, 5). --define(OS_OS2, 6). --define(OS_MAC, 7). --define(OS_ZSYS, 8). --define(OS_CPM, 9). --define(OS_TOP20, 10). --define(OS_NTFS, 11). --define(OS_QDOS, 12). --define(OS_ACORN, 13). --define(OS_UNKNOWN,255). - --define(DEFLATE_INIT, 1). --define(DEFLATE_INIT2, 2). --define(DEFLATE_SETDICT, 3). --define(DEFLATE_RESET, 4). --define(DEFLATE_END, 5). --define(DEFLATE_PARAMS, 6). --define(DEFLATE, 7). - --define(INFLATE_INIT, 8). --define(INFLATE_INIT2, 9). --define(INFLATE_SETDICT, 10). --define(INFLATE_GETDICT, 11). --define(INFLATE_SYNC, 12). --define(INFLATE_RESET, 13). --define(INFLATE_END, 14). --define(INFLATE, 15). --define(INFLATE_CHUNK, 26). - --define(CRC32_0, 16). --define(CRC32_1, 17). --define(CRC32_2, 18). - --define(SET_BUFSZ, 19). --define(GET_BUFSZ, 20). --define(GET_QSIZE, 21). - --define(ADLER32_1, 22). --define(ADLER32_2, 23). - --define(CRC32_COMBINE, 24). --define(ADLER32_COMBINE, 25). +%% Chunk sizes are hardcoded on account of them screwing with the +%% predictability of the system. zlib is incapable of trapping so we need to +%% ensure that it never operates on any significant amount of data. +-define(DEFLATE_IN_CHUNKSIZE, 8 bsl 10). +-define(DEFLATE_OUT_CHUNKSIZE, 8 bsl 10). +-define(INFLATE_IN_CHUNKSIZE, 8 bsl 10). +-define(INFLATE_OUT_CHUNKSIZE, 16 bsl 10). %%------------------------------------------------------------------------ -%% Main data types of the file --type zstream() :: port(). +%% Public data types. +-type zstream() :: term(). +-type zflush() :: 'none' | 'sync' | 'full' | 'finish'. -%% Auxiliary data types of the file --type zlevel() :: 'none' | 'default' | 'best_compression' | 'best_speed' - | 0..9. --type zmethod() :: 'deflated'. +-type zlevel() :: + 'none' | 'default' | 'best_compression' | 'best_speed' | 0..9. +-type zstrategy() :: 'default' | 'filtered' | 'huffman_only' | 'rle'. + +-type zmemlevel() :: 1..9. -type zwindowbits() :: -15..-8 | 8..47. --type zmemlevel() :: 1..9. --type zstrategy() :: 'default' | 'filtered' | 'huffman_only' | 'rle'. + +%% Private data types. + +-type zmethod() :: 'deflated'. + +-record(zlib_opts, { + stream :: zstream(), + method :: term(), + input_chunk_size :: integer(), + output_chunk_size :: integer(), + flush :: integer() + }). %%------------------------------------------------------------------------ -%% open a z_stream +on_load() -> + case erlang:load_nif(atom_to_list(?MODULE), 0) of + ok -> ok + end. + -spec open() -> zstream(). open() -> - open_port({spawn, "zlib_drv"}, [binary]). + open_nif(). +open_nif() -> + erlang:nif_error(undef). -%% close and release z_stream -spec close(Z) -> 'ok' when Z :: zstream(). close(Z) -> - try - true = port_close(Z), - receive %In case the caller is the owner and traps exits - {'EXIT',Z,_} -> ok - after 0 -> ok - end - catch _:_ -> erlang:error(badarg) - end. + close_nif(Z). +close_nif(_Z) -> + erlang:nif_error(undef). -spec deflateInit(Z) -> 'ok' when Z :: zstream(). deflateInit(Z) -> - call(Z, ?DEFLATE_INIT, <<?Z_DEFAULT_COMPRESSION:32>>). + deflateInit(Z, default). -spec deflateInit(Z, Level) -> 'ok' when Z :: zstream(), Level :: zlevel(). deflateInit(Z, Level) -> - call(Z, ?DEFLATE_INIT, <<(arg_level(Level)):32>>). + deflateInit_nif(Z, arg_level(Level)). + +deflateInit_nif(_Z, _Level) -> + erlang:nif_error(undef). --spec deflateInit(Z, Level, Method, - WindowBits, MemLevel, Strategy) -> 'ok' when +-spec deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) -> 'ok' when Z :: zstream(), Level :: zlevel(), Method :: zmethod(), @@ -173,31 +143,49 @@ deflateInit(Z, Level) -> MemLevel :: zmemlevel(), Strategy :: zstrategy(). deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) -> - call(Z, ?DEFLATE_INIT2, <<(arg_level(Level)):32, - (arg_method(Method)):32, - (arg_bitsz(WindowBits)):32, - (arg_mem(MemLevel)):32, - (arg_strategy(Strategy)):32>>). + deflateInit_nif(Z, + arg_level(Level), + arg_method(Method), + arg_bitsz(WindowBits), + arg_mem(MemLevel), + arg_strategy(Strategy)). +deflateInit_nif(_Z, _Level, _Method, _WindowBits, _MemLevel, _Strategy) -> + erlang:nif_error(undef). -spec deflateSetDictionary(Z, Dictionary) -> Adler32 when Z :: zstream(), Dictionary :: iodata(), Adler32 :: integer(). deflateSetDictionary(Z, Dictionary) -> - call(Z, ?DEFLATE_SETDICT, Dictionary). + deflateSetDictionary_nif(Z, Dictionary). +deflateSetDictionary_nif(_Z, _Dictionary) -> + erlang:nif_error(undef). -spec deflateReset(Z) -> 'ok' when Z :: zstream(). deflateReset(Z) -> - call(Z, ?DEFLATE_RESET, []). + deflateReset_nif(Z). +deflateReset_nif(_Z) -> + erlang:nif_error(undef). -spec deflateParams(Z, Level, Strategy) -> ok when Z :: zstream(), Level :: zlevel(), Strategy :: zstrategy(). -deflateParams(Z, Level, Strategy) -> - call(Z, ?DEFLATE_PARAMS, <<(arg_level(Level)):32, - (arg_strategy(Strategy)):32>>). +deflateParams(Z, Level0, Strategy0) -> + Level = arg_level(Level0), + Strategy = arg_strategy(Strategy0), + case deflateParams_nif(Z, Level, Strategy) of + buf_error -> + %% We had data left in the pipe; flush everything and stash it away + %% for the next deflate call before trying again. + Output = deflate(Z, <<>>, full), + save_progress(Z, deflate, Output), + deflateParams_nif(Z, Level, Strategy); + Any -> Any + end. +deflateParams_nif(_Z, _Level, _Strategy) -> + erlang:nif_error(undef). -spec deflate(Z, Data) -> Compressed when Z :: zstream(), @@ -209,170 +197,234 @@ deflate(Z, Data) -> -spec deflate(Z, Data, Flush) -> Compressed when Z :: zstream(), Data :: iodata(), - Flush :: none | sync | full | finish, + Flush :: zflush(), Compressed :: iolist(). deflate(Z, Data, Flush) -> - try port_command(Z, Data) of - true -> - _ = call(Z, ?DEFLATE, <<(arg_flush(Flush)):32>>), - collect(Z) - catch - error:_Err -> - flush(Z), - erlang:error(badarg) - end. + Progress = restore_progress(Z, deflate), + enqueue_input(Z, Data), + append_iolist(Progress, dequeue_all_chunks(Z, deflate_opts(Flush))). + +deflate_opts(Flush) -> + #zlib_opts{ + method = fun deflate_nif/4, + input_chunk_size = ?DEFLATE_IN_CHUNKSIZE, + output_chunk_size = ?DEFLATE_OUT_CHUNKSIZE, + flush = arg_flush(Flush) + }. + +deflate_nif(_Z, _InputChSize, _OutputChSize, _Flush) -> + erlang:nif_error(undef). -spec deflateEnd(Z) -> 'ok' when Z :: zstream(). deflateEnd(Z) -> - call(Z, ?DEFLATE_END, []). + deflateEnd_nif(Z). +deflateEnd_nif(_Z) -> + erlang:nif_error(undef). -spec inflateInit(Z) -> 'ok' when Z :: zstream(). inflateInit(Z) -> - call(Z, ?INFLATE_INIT, []). + inflateInit_nif(Z). +inflateInit_nif(_Z) -> + erlang:nif_error(undef). -spec inflateInit(Z, WindowBits) -> 'ok' when Z :: zstream(), WindowBits :: zwindowbits(). -inflateInit(Z, WindowBits) -> - call(Z, ?INFLATE_INIT2, <<(arg_bitsz(WindowBits)):32>>). +inflateInit(Z, WindowBits) -> + inflateInit_nif(Z, WindowBits). +inflateInit_nif(_Z, _WindowBits) -> + erlang:nif_error(undef). -spec inflateSetDictionary(Z, Dictionary) -> 'ok' when Z :: zstream(), Dictionary :: iodata(). -inflateSetDictionary(Z, Dictionary) -> - call(Z, ?INFLATE_SETDICT, Dictionary). +inflateSetDictionary(Z, Dictionary) -> + inflateSetDictionary_nif(Z, Dictionary). +inflateSetDictionary_nif(_Z, _Dictionary) -> + erlang:nif_error(undef). -spec inflateGetDictionary(Z) -> Dictionary when Z :: zstream(), - Dictionary :: iolist(). + Dictionary :: binary(). inflateGetDictionary(Z) -> - _ = call(Z, ?INFLATE_GETDICT, []), - collect(Z). - --spec inflateSync(zstream()) -> 'ok'. -inflateSync(Z) -> - call(Z, ?INFLATE_SYNC, []). + case inflateGetDictionary_nif(Z) of + Dictionary when is_binary(Dictionary) -> + Dictionary; + not_supported -> + erlang:error(enotsup) + end. +inflateGetDictionary_nif(_Z) -> + erlang:nif_error(undef). -spec inflateReset(Z) -> 'ok' when Z :: zstream(). -inflateReset(Z) -> - call(Z, ?INFLATE_RESET, []). +inflateReset(Z) -> + inflateReset_nif(Z). +inflateReset_nif(_Z) -> + erlang:nif_error(undef). -spec inflate(Z, Data) -> Decompressed when Z :: zstream(), Data :: iodata(), Decompressed :: iolist(). inflate(Z, Data) -> - try port_command(Z, Data) of - true -> - _ = call(Z, ?INFLATE, <<?Z_NO_FLUSH:32>>), - collect(Z) - catch - error:_Err -> - flush(Z), - erlang:error(badarg) + inflate(Z, Data, []). + +-spec inflate(Z, Data, Options) -> Decompressed when + Z :: zstream(), + Data :: iodata(), + Options :: list({exception_on_need_dict, boolean()}), + Decompressed :: iolist() | + {need_dictionary, + Adler32 :: integer(), + Output :: iolist()}. +inflate(Z, Data, Options) -> + enqueue_input(Z, Data), + Result = dequeue_all_chunks(Z, inflate_opts()), + case proplist_get_value(Options, exception_on_need_dict, true) of + true -> exception_on_need_dict(Z, Result); + false -> Result end. +inflate_nif(_Z, _InputChSize, _OutputChSize, _Flush) -> + erlang:nif_error(undef). + +inflate_opts() -> + #zlib_opts{ + method = fun inflate_nif/4, + input_chunk_size = ?INFLATE_IN_CHUNKSIZE, + output_chunk_size = ?INFLATE_OUT_CHUNKSIZE, + flush = arg_flush(none) + }. + -spec inflateChunk(Z, Data) -> Decompressed | {more, Decompressed} when Z :: zstream(), Data :: iodata(), Decompressed :: iolist(). inflateChunk(Z, Data) -> - try port_command(Z, Data) of - true -> - inflateChunk(Z) - catch - error:_Err -> - flush(Z), - erlang:error(badarg) - end. + enqueue_input(Z, Data), + inflateChunk(Z). -spec inflateChunk(Z) -> Decompressed | {more, Decompressed} when Z :: zstream(), Decompressed :: iolist(). inflateChunk(Z) -> - Status = call(Z, ?INFLATE_CHUNK, []), - Data = receive - {Z, {data, Bin}} -> - Bin - after 0 -> - [] - end, - - case Status of - Good when (Good == ok) orelse (Good == stream_end) -> - Data; - inflate_has_more -> - {more, Data} - end. + Opts0 = inflate_opts(), + Opts = Opts0#zlib_opts { output_chunk_size = getBufSize(Z) }, + + Result0 = dequeue_next_chunk(Z, Opts), + Result1 = exception_on_need_dict(Z, Result0), + yield_inflateChunk(Z, Result1). + +yield_inflateChunk(_Z, {continue, Output}) -> + {more, lists:flatten(Output)}; +yield_inflateChunk(_Z, {finished, Output}) -> + lists:flatten(Output). + +exception_on_need_dict(Z, {need_dictionary, Adler, Output}) -> + Progress = restore_progress(Z, inflate), + save_progress(Z, inflate, append_iolist(Progress, Output)), + erlang:error({need_dictionary, Adler}); +exception_on_need_dict(Z, {Mark, Output}) -> + Progress = restore_progress(Z, inflate), + {Mark, append_iolist(Progress, Output)}; +exception_on_need_dict(Z, Output) when is_list(Output); is_binary(Output) -> + Progress = restore_progress(Z, inflate), + append_iolist(Progress, Output). + +-spec safeInflate(Z, Data) -> Result when + Z :: zstream(), + Data :: iodata(), + Result :: {continue, Output :: iolist()} | + {finished, Output :: iolist()} | + {need_dictionary, + Adler32 :: integer(), + Output :: iolist()}. +safeInflate(Z, Data) -> + enqueue_input(Z, Data), + dequeue_next_chunk(Z, inflate_opts()). -spec inflateEnd(Z) -> 'ok' when Z :: zstream(). inflateEnd(Z) -> - call(Z, ?INFLATE_END, []). + inflateEnd_nif(Z). +inflateEnd_nif(_Z) -> + erlang:nif_error(undef). -spec setBufSize(Z, Size) -> 'ok' when Z :: zstream(), Size :: non_neg_integer(). -setBufSize(Z, Size) -> - call(Z, ?SET_BUFSZ, <<Size:32>>). +setBufSize(Z, Size) when is_integer(Size), Size > 16, Size < (1 bsl 24) -> + setBufSize_nif(Z, Size); +setBufSize(_Z, _Size) -> + erlang:error(badarg). +setBufSize_nif(_Z, _Size) -> + erlang:nif_error(undef). --spec getBufSize(Z) -> Size when - Z :: zstream(), - Size :: non_neg_integer(). +-spec getBufSize(Z) -> non_neg_integer() when + Z :: zstream(). getBufSize(Z) -> - call(Z, ?GET_BUFSZ, []). + getBufSize_nif(Z). +getBufSize_nif(_Z) -> + erlang:nif_error(undef). -spec crc32(Z) -> CRC when Z :: zstream(), CRC :: integer(). crc32(Z) -> - call(Z, ?CRC32_0, []). + crc32_nif(Z). +crc32_nif(_Z) -> + erlang:nif_error(undef). -spec crc32(Z, Data) -> CRC when Z :: zstream(), Data :: iodata(), CRC :: integer(). -crc32(Z, Data) -> - call(Z, ?CRC32_1, Data). +crc32(Z, Data) when is_reference(Z) -> + erlang:crc32(Data); +crc32(_Z, _Data) -> + erlang:error(badarg). -spec crc32(Z, PrevCRC, Data) -> CRC when Z :: zstream(), PrevCRC :: integer(), Data :: iodata(), CRC :: integer(). -crc32(Z, CRC, Data) -> - call(Z, ?CRC32_2, [<<CRC:32>>, Data]). +crc32(Z, CRC, Data) when is_reference(Z) -> + erlang:crc32(CRC, Data); +crc32(_Z, _CRC, _Data) -> + erlang:error(badarg). + +-spec crc32_combine(Z, CRC1, CRC2, Size2) -> CRC when + Z :: zstream(), + CRC :: integer(), + CRC1 :: integer(), + CRC2 :: integer(), + Size2 :: integer(). +crc32_combine(Z, CRC1, CRC2, Size2) when is_reference(Z) -> + erlang:crc32_combine(CRC1, CRC2, Size2); +crc32_combine(_Z, _CRC1, _CRC2, _Size2) -> + erlang:error(badarg). -spec adler32(Z, Data) -> CheckSum when Z :: zstream(), Data :: iodata(), CheckSum :: integer(). -adler32(Z, Data) -> - call(Z, ?ADLER32_1, Data). +adler32(Z, Data) when is_reference(Z) -> + erlang:adler32(Data); +adler32(_Z, _Data) -> + erlang:error(badarg). -spec adler32(Z, PrevAdler, Data) -> CheckSum when Z :: zstream(), PrevAdler :: integer(), Data :: iodata(), CheckSum :: integer(). -adler32(Z, Adler, Data) when is_integer(Adler) -> - call(Z, ?ADLER32_2, [<<Adler:32>>, Data]); -adler32(_Z, _Adler, _Data) -> - erlang:error(badarg). - --spec crc32_combine(Z, CRC1, CRC2, Size2) -> CRC when - Z :: zstream(), - CRC :: integer(), - CRC1 :: integer(), - CRC2 :: integer(), - Size2 :: integer(). -crc32_combine(Z, CRC1, CRC2, Len2) - when is_integer(CRC1), is_integer(CRC2), is_integer(Len2) -> - call(Z, ?CRC32_COMBINE, <<CRC1:32, CRC2:32, Len2:32>>); -crc32_combine(_Z, _CRC1, _CRC2, _Len2) -> +adler32(Z, Adler, Data) when is_reference(Z) -> + erlang:adler32(Adler, Data); +adler32(_Z, _Adler, _Data) -> erlang:error(badarg). -spec adler32_combine(Z, Adler1, Adler2, Size2) -> Adler when @@ -381,16 +433,11 @@ crc32_combine(_Z, _CRC1, _CRC2, _Len2) -> Adler1 :: integer(), Adler2 :: integer(), Size2 :: integer(). -adler32_combine(Z, Adler1, Adler2, Len2) - when is_integer(Adler1), is_integer(Adler2), is_integer(Len2) -> - call(Z, ?ADLER32_COMBINE, <<Adler1:32, Adler2:32, Len2:32>>); -adler32_combine(_Z, _Adler1, _Adler2, _Len2) -> +adler32_combine(Z, Adler1, Adler2, Size2) when is_reference(Z) -> + erlang:adler32_combine(Adler1, Adler2, Size2); +adler32_combine(_Z, _Adler1, _Adler2, _Size2) -> erlang:error(badarg). --spec getQSize(zstream()) -> non_neg_integer(). -getQSize(Z) -> - call(Z, ?GET_QSIZE, []). - %% compress/uncompress zlib with header -spec compress(Data) -> Compressed when Data :: iodata(), @@ -398,13 +445,13 @@ getQSize(Z) -> compress(Data) -> Z = open(), Bs = try - deflateInit(Z, default), - B = deflate(Z, Data, finish), - deflateEnd(Z), - B - after - close(Z) - end, + deflateInit(Z, default), + B = deflate(Z, Data, finish), + deflateEnd(Z), + B + after + close(Z) + end, iolist_to_binary(Bs). -spec uncompress(Data) -> Decompressed when @@ -416,14 +463,14 @@ uncompress(Data) -> if Size >= 8 -> Z = open(), - Bs = try - inflateInit(Z), - B = inflate(Z, Data), - inflateEnd(Z), - B - after - close(Z) - end, + Bs = try + inflateInit(Z), + B = inflate(Z, Data), + inflateEnd(Z), + B + after + close(Z) + end, iolist_to_binary(Bs); true -> erlang:error(data_error) @@ -440,13 +487,13 @@ uncompress(Data) -> zip(Data) -> Z = open(), Bs = try - deflateInit(Z, default, deflated, -?MAX_WBITS, 8, default), - B = deflate(Z, Data, finish), - deflateEnd(Z), - B - after - close(Z) - end, + deflateInit(Z, default, deflated, -?MAX_WBITS, 8, default), + B = deflate(Z, Data, finish), + deflateEnd(Z), + B + after + close(Z) + end, iolist_to_binary(Bs). -spec unzip(Data) -> Decompressed when @@ -455,28 +502,28 @@ zip(Data) -> unzip(Data) -> Z = open(), Bs = try - inflateInit(Z, -?MAX_WBITS), - B = inflate(Z, Data), - inflateEnd(Z), - B - after - close(Z) - end, + inflateInit(Z, -?MAX_WBITS), + B = inflate(Z, Data), + inflateEnd(Z), + B + after + close(Z) + end, iolist_to_binary(Bs). - + -spec gzip(Data) -> Compressed when Data :: iodata(), Compressed :: binary(). gzip(Data) -> Z = open(), Bs = try - deflateInit(Z, default, deflated, 16+?MAX_WBITS, 8, default), - B = deflate(Z, Data, finish), - deflateEnd(Z), - B - after - close(Z) - end, + deflateInit(Z, default, deflated, 16+?MAX_WBITS, 8, default), + B = deflate(Z, Data, finish), + deflateEnd(Z), + B + after + close(Z) + end, iolist_to_binary(Bs). -spec gunzip(Data) -> Decompressed when @@ -485,92 +532,150 @@ gzip(Data) -> gunzip(Data) -> Z = open(), Bs = try - inflateInit(Z, 16+?MAX_WBITS), - B = inflate(Z, Data), - inflateEnd(Z), - B - after - close(Z) - end, + inflateInit(Z, 16+?MAX_WBITS), + B = inflate(Z, Data), + inflateEnd(Z), + B + after + close(Z) + end, iolist_to_binary(Bs). --spec collect(zstream()) -> iolist(). -collect(Z) -> - collect(Z, []). - --spec collect(zstream(), iolist()) -> iolist(). -collect(Z, Acc) -> - receive - {Z, {data, Bin}} -> - collect(Z, [Bin|Acc]) - after 0 -> - reverse(Acc) +-spec dequeue_all_chunks(Z, Opts) -> Result when + Z :: zstream(), + Opts :: #zlib_opts{}, + Result :: {need_dictionary, integer(), iolist()} | + iolist(). +dequeue_all_chunks(Z, Opts) -> + dequeue_all_chunks_1(Z, Opts, []). +dequeue_all_chunks_1(Z, Opts, Output) -> + case dequeue_next_chunk(Z, Opts) of + {need_dictionary, _, _} = NeedDict -> + NeedDict; + {continue, Chunk} -> + dequeue_all_chunks_1(Z, Opts, append_iolist(Output, Chunk)); + {finished, Chunk} -> + append_iolist(Output, Chunk) end. --spec flush(zstream()) -> 'ok'. -flush(Z) -> - receive - {Z, {data,_}} -> - flush(Z) - after 0 -> - ok +-spec dequeue_next_chunk(Z, Opts) -> Result when + Z :: zstream(), + Opts :: #zlib_opts{}, + Result :: {need_dictionary, integer(), iolist()} | + {continue, iolist()} | + {finished, iolist()}. +dequeue_next_chunk(Z, Opts) -> + Method = Opts#zlib_opts.method, + IChSz = Opts#zlib_opts.input_chunk_size, + OChSz = Opts#zlib_opts.output_chunk_size, + Flush = Opts#zlib_opts.flush, + Method(Z, IChSz, OChSz, Flush). + +-spec append_iolist(IO, D) -> iolist() when + IO :: iodata(), + D :: iodata(). +append_iolist([], D) when is_list(D) -> D; +append_iolist([], D) -> [D]; +append_iolist(IO, []) -> IO; +append_iolist(IO, [D]) -> [IO, D]; +append_iolist(IO, D) -> [IO, D]. + +%% inflate/2 and friends are documented as throwing an error on Z_NEED_DICT +%% rather than simply returning something to that effect, and deflateParams/3 +%% may flush behind the scenes. This requires us to stow away our current +%% progress in the handle and resume from that point on our next call. +%% +%% Generally speaking this is either a refc binary or nothing at all, so it's +%% pretty cheap. + +-spec save_progress(Z, Kind, Output) -> ok when + Z :: zstream(), + Kind :: inflate | deflate, + Output :: iolist(). +save_progress(Z, Kind, Output) -> + ok = setStash_nif(Z, {Kind, Output}). + +-spec restore_progress(Z, Kind) -> iolist() when + Z :: zstream(), + Kind :: inflate | deflate. +restore_progress(Z, Kind) -> + case getStash_nif(Z) of + {ok, {Kind, Output}} -> + ok = clearStash_nif(Z), + Output; + empty -> + [] end. - -arg_flush(none) -> ?Z_NO_FLUSH; + +-spec clearStash_nif(Z) -> ok when + Z :: zstream(). +clearStash_nif(_Z) -> + erlang:nif_error(undef). + +-spec setStash_nif(Z, Term) -> ok when + Z :: zstream(), + Term :: term(). +setStash_nif(_Z, _Term) -> + erlang:nif_error(undef). + +-spec getStash_nif(Z) -> {ok, term()} | empty when + Z :: zstream(). +getStash_nif(_Z) -> + erlang:nif_error(undef). + +%% The 'proplists' module isn't preloaded so we can't rely on its existence. +proplist_get_value([], _Name, DefVal) -> DefVal; +proplist_get_value([{Name, Value} | _Opts], Name, _DefVal) -> Value; +proplist_get_value([_Head | Opts], Name, DefVal) -> + proplist_get_value(Opts, Name, DefVal). + +arg_flush(none) -> ?Z_NO_FLUSH; %% ?Z_PARTIAL_FLUSH is deprecated in zlib -- deliberately not included. -arg_flush(sync) -> ?Z_SYNC_FLUSH; -arg_flush(full) -> ?Z_FULL_FLUSH; -arg_flush(finish) -> ?Z_FINISH; -arg_flush(_) -> erlang:error(badarg). +arg_flush(sync) -> ?Z_SYNC_FLUSH; +arg_flush(full) -> ?Z_FULL_FLUSH; +arg_flush(finish) -> ?Z_FINISH; +arg_flush(_) -> erlang:error(bad_flush_mode). arg_level(none) -> ?Z_NO_COMPRESSION; arg_level(best_speed) -> ?Z_BEST_SPEED; arg_level(best_compression) -> ?Z_BEST_COMPRESSION; arg_level(default) -> ?Z_DEFAULT_COMPRESSION; arg_level(Level) when is_integer(Level), Level >= 0, Level =< 9 -> Level; -arg_level(_) -> erlang:error(badarg). - +arg_level(_) -> erlang:error(bad_compression_level). + arg_strategy(filtered) -> ?Z_FILTERED; arg_strategy(huffman_only) -> ?Z_HUFFMAN_ONLY; arg_strategy(rle) -> ?Z_RLE; arg_strategy(default) -> ?Z_DEFAULT_STRATEGY; -arg_strategy(_) -> erlang:error(badarg). +arg_strategy(_) -> erlang:error(bad_compression_strategy). arg_method(deflated) -> ?Z_DEFLATED; -arg_method(_) -> erlang:error(badarg). +arg_method(_) -> erlang:error(bad_compression_method). -spec arg_bitsz(zwindowbits()) -> zwindowbits(). arg_bitsz(Bits) when is_integer(Bits) andalso - ((8 =< Bits andalso Bits < 48) orelse - (-15 =< Bits andalso Bits =< -8)) -> + ((8 =< Bits andalso Bits < 48) orelse + (-15 =< Bits andalso Bits =< -8)) -> Bits; -arg_bitsz(_) -> erlang:error(badarg). +arg_bitsz(_) -> erlang:error(bad_windowbits). -spec arg_mem(zmemlevel()) -> zmemlevel(). arg_mem(Level) when is_integer(Level), 1 =< Level, Level =< 9 -> Level; -arg_mem(_) -> erlang:error(badarg). - -call(Z, Cmd, Arg) -> - try port_control(Z, Cmd, Arg) of - [0|Res] -> list_to_atom(Res); - [1|Res] -> - flush(Z), - erlang:error(list_to_atom(Res)); - [2,A,B,C,D] -> - (A bsl 24)+(B bsl 16)+(C bsl 8)+D; - [3,A,B,C,D] -> - erlang:error({need_dictionary,(A bsl 24)+(B bsl 16)+(C bsl 8)+D}); - [4, _, _, _, _] -> - inflate_has_more - catch - error:badarg -> %% Rethrow loses port_control from stacktrace. - erlang:error(badarg) - end. +arg_mem(_) -> erlang:error(bad_memlevel). -reverse(X) -> - reverse(X, []). +-spec enqueue_input(Z, IOData) -> ok when + Z :: zstream(), + IOData :: iodata(). +enqueue_input(Z, IOData) -> + enqueue_input_1(Z, erlang:iolist_to_iovec(IOData)). + +enqueue_input_1(_Z, []) -> + ok; +enqueue_input_1(Z, IOVec) -> + case enqueue_nif(Z, IOVec) of + {continue, Remainder} -> enqueue_input_1(Z, Remainder); + ok -> ok + end. -reverse([H|T], Y) -> - reverse(T, [H|Y]); -reverse([], X) -> - X. +enqueue_nif(_Z, _IOVec) -> + erlang:nif_error(undef).
\ No newline at end of file diff --git a/erts/test/system_smoke.spec b/erts/test/system_smoke.spec index 99092c1dab..bcb727b6d9 100644 --- a/erts/test/system_smoke.spec +++ b/erts/test/system_smoke.spec @@ -1,4 +1,3 @@ -{suites,"../system_test",[ethread_SUITE]}. {cases,"../system_test",otp_SUITE, [undefined_functions, deprecated_not_in_obsolete, diff --git a/erts/vsn.mk b/erts/vsn.mk index 59699c6505..8ed3993177 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 9.0.2 +VSN = 9.0.4 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index 03452648bb..5399528271 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -32,6 +32,23 @@ <p>This document describes the changes made to the asn1 application.</p> +<section><title>Asn1 5.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Default values now work in extension for PER, so if you + give the atom <c>asn1_DEFAULT</c> instead of a value it + will become the default value.</p> + <p> + Own Id: OTP-13011 Aux Id: ERIERL-60 </p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 5.0.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 3f1be4febb..aff383479b 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -985,9 +985,11 @@ gen_enc_components_call1(Gen, TopType, [C|Rest], DynamicEnc, Ext) -> Imm1; 'OPTIONAL' -> enc_absent(Gen, Element, [asn1_NOVALUE], Imm1); - {'DEFAULT',Def} -> + {'DEFAULT',Def} when Ext =:= noext -> DefValues = def_values(Type, Def), - enc_absent(Gen, Element, DefValues, Imm1) + enc_absent(Gen, Element, DefValues, Imm1); + {'DEFAULT',_} -> + enc_absent(Gen, Element, [asn1_DEFAULT], Imm1) end, Imm = case Imm2 of [] -> []; diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl index 2ecc9e4bc7..5b5f47dfee 100644 --- a/lib/asn1/src/asn1rtt_per_common.erl +++ b/lib/asn1/src/asn1rtt_per_common.erl @@ -542,6 +542,7 @@ extension_bitmap(_Val, Pos, Limit, Acc) when Pos >= Limit -> extension_bitmap(Val, Pos, Limit, Acc) -> Bit = case element(Pos, Val) of asn1_NOVALUE -> 0; + asn1_DEFAULT -> 0; _ -> 1 end, extension_bitmap(Val, Pos+1, Limit, (Acc bsl 1) bor Bit). diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index f4041fa89b..c38d1c6ebd 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -43,6 +43,7 @@ MODULES= \ testChoTypeRefSet \ testConstraints \ testDef \ + testExtensionDefault \ testOpt \ testSeqDefault \ testSeqExtension \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index f94b4278bf..c61cecca4c 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -147,6 +147,7 @@ groups() -> testImport, testDER, testDEFAULT, + testExtensionDefault, testMvrasn6, testContextSwitchingTypes, testOpenTypeImplicitTag, @@ -444,6 +445,12 @@ testDEFAULT(Config, Rule, Opts) -> testDef:main(Rule), testSeqSetDefaultVal:main(Rule, Opts). +testExtensionDefault(Config) -> + test(Config, fun testExtensionDefault/3). +testExtensionDefault(Config, Rule, Opts) -> + asn1_test_lib:compile_all(["ExtensionDefault"], Config, [Rule|Opts]), + testExtensionDefault:main(Rule). + testMaps(Config) -> test(Config, fun testMaps/3, [{ber,[maps,no_ok_wrapper]}, diff --git a/lib/asn1/test/asn1_SUITE_data/ExtensionDefault.asn1 b/lib/asn1/test/asn1_SUITE_data/ExtensionDefault.asn1 new file mode 100644 index 0000000000..67d9cb6312 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/ExtensionDefault.asn1 @@ -0,0 +1,12 @@ +ExtensionDefault DEFINITIONS AUTOMATIC TAGS ::= + +BEGIN + +Message ::= SEQUENCE { + id INTEGER (0..5), + ..., + priority Priority DEFAULT low +} +Priority ::= ENUMERATED { low(0), high(1), ... } + +END diff --git a/lib/asn1/test/testExtensionDefault.erl b/lib/asn1/test/testExtensionDefault.erl new file mode 100644 index 0000000000..cc50fa95b8 --- /dev/null +++ b/lib/asn1/test/testExtensionDefault.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(testExtensionDefault). + +-export([main/1]). + +main(_Erule) -> + roundtrip('Message', {'Message',1,low}), %Will be explicitly encoded. + roundtrip('Message', {'Message',1,high}), + roundtrip('Message', {'Message',1,asn1_DEFAULT}, {'Message',1,low}), + + map_roundtrip('Message', #{id=>1,priority=>low}), %Will be explicitly encoded. + map_roundtrip('Message', #{id=>1,priority=>high}), + map_roundtrip('Message', #{id=>1}, #{id=>1,priority=>low}), + ok. + +roundtrip(Type, Value) -> + asn1_test_lib:roundtrip('ExtensionDefault', Type, Value). + +roundtrip(Type, Value, Expected) -> + %% asn1_test_lib:roundtrip/3 will invoke map_roundtrip/3, which will + %% not work in this case. Therefore, implement the roundtrip ourselves. + M = 'ExtensionDefault', + {ok,Enc} = M:encode(Type, Value), + {ok,Expected} = M:decode(Type, Enc), + ok. + +map_roundtrip(Type, Value) -> + map_roundtrip(Type, Value, Value). + +map_roundtrip(Type, Value, Expected) -> + M = 'maps_ExtensionDefault', + Enc = M:encode(Type, Value), + Expected = M:decode(Type, Enc), + ok. diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk index ec92d324eb..5900f3037e 100644 --- a/lib/asn1/vsn.mk +++ b/lib/asn1/vsn.mk @@ -1 +1 @@ -ASN1_VSN = 5.0.1 +ASN1_VSN = 5.0.2 diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 19b0ee20fe..a12c0c9101 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -848,7 +848,8 @@ capture_get([ExclCat | ExclCategories]) -> Strs = test_server:capture_get(), CatsStr = [atom_to_list(ExclCat) | [[$| | atom_to_list(EC)] || EC <- ExclCategories]], - {ok,MP} = re:compile("<div class=\"(" ++ lists:flatten(CatsStr) ++ ")\">.*"), + {ok,MP} = re:compile("<div class=\"(" ++ lists:flatten(CatsStr) ++ ")\">.*", + [unicode]), lists:flatmap(fun(Str) -> case re:run(Str, MP) of {match,_} -> []; diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 14d9d381da..b50cddd492 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -1455,7 +1455,7 @@ match_line(Name,Pid,Line,[{prompt,PromptType}|Patterns],FoundPrompt,Term, when PromptType=/=FoundPrompt -> match_line(Name,Pid,Line,Patterns,FoundPrompt,Term,EO,RetTag); match_line(Name,Pid,Line,[{Tag,Pattern}|Patterns],FoundPrompt,Term,EO,RetTag) -> - case re:run(Line,Pattern,[{capture,all,list}]) of + case re:run(Line,Pattern,[{capture,all,list},unicode]) of nomatch -> match_line(Name,Pid,Line,Patterns,FoundPrompt,Term,EO,RetTag); {match,Match} -> @@ -1463,7 +1463,7 @@ match_line(Name,Pid,Line,[{Tag,Pattern}|Patterns],FoundPrompt,Term,EO,RetTag) -> {RetTag,{Tag,Match}} end; match_line(Name,Pid,Line,[Pattern|Patterns],FoundPrompt,Term,EO,RetTag) -> - case re:run(Line,Pattern,[{capture,all,list}]) of + case re:run(Line,Pattern,[{capture,all,list},unicode]) of nomatch -> match_line(Name,Pid,Line,Patterns,FoundPrompt,Term,EO,RetTag); {match,Match} -> @@ -1575,7 +1575,7 @@ split_lines([],Line,Lines) -> match_prompt(Str,Prx) -> match_prompt(Str,Prx,[]). match_prompt(Str,Prx,Acc) -> - case re:run(Str,Prx) of + case re:run(Str,Prx,[unicode]) of nomatch -> noprompt; {match,[{Start,Len}]} -> diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 09839bd35d..bb445bb0d2 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -537,7 +537,7 @@ replace_names_in_elems([],Modified,_Defs) -> replace_names_in_string(Term,Defs=[{Name,Replacement=[Ch|_]}|Ds]) when is_integer(Ch) -> try re:replace(Term,[$'|atom_to_list(Name)]++"'", - Replacement,[{return,list}]) of + Replacement,[{return,list},unicode]) of Term -> % no match, proceed replace_names_in_string(Term,Ds); Term1 -> @@ -569,7 +569,7 @@ replace_names_in_node1(NodeStr,Defs=[{Name,Replacement}|Ds]) -> replace_names_in_node1(NodeStr,Ds); true -> case re:replace(NodeStr,atom_to_list(Name), - ReplStr,[{return,list}]) of + ReplStr,[{return,list},unicode]) of NodeStr -> % no match, proceed replace_names_in_node1(NodeStr,Ds); NodeStr1 -> diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl index a18ff1fd62..c0d7e12721 100644 --- a/lib/common_test/src/test_server_node.erl +++ b/lib/common_test/src/test_server_node.erl @@ -692,7 +692,7 @@ find_rel_suse_2(Rel, RootWc) -> case file:list_dir(RelDir) of {ok,Dirs} -> case lists:filter(fun(Dir) -> - case re:run(Dir, Pat) of + case re:run(Dir, Pat, [unicode]) of nomatch -> false; _ -> true end diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl index 9a26de4774..21f4be22fe 100644 --- a/lib/common_test/src/test_server_sup.erl +++ b/lib/common_test/src/test_server_sup.erl @@ -346,7 +346,7 @@ check_appup_clauses_plausible([], _Direction, _Modules) -> ok; check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules) when is_binary(Re) -> - case re:compile(Re) of + case re:compile(Re,[unicode]) of {ok, _} -> case check_appup_instructions(Instrs, Direction, Modules) of ok -> diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index f3d42a909b..bc335a9eaa 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -32,6 +32,23 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 7.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fail labels on guard BIFs weren't taken into account + during an optimization pass, and a bug in the validation + pass sometimes prevented this from being noticed when a + fault occurred.</p> + <p> + Own Id: OTP-14522 Aux Id: ERIERL-48 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index b736d39f9c..e094c2c320 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -24,7 +24,7 @@ -export([module/2]). -export([bs_clean_saves/1]). -export([clean_labels/1]). --import(lists, [map/2,foldl/3,reverse/1,filter/2]). +-import(lists, [foldl/3,reverse/1,filter/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -118,7 +118,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> clean_labels(Fs0) -> St0 = #st{lmap=[],entry=1,lc=1}, {Fs1,#st{lmap=Lmap0,lc=Lc}} = function_renumber(Fs0, St0, []), - Lmap = gb_trees:from_orddict(ordsets:from_list(Lmap0)), + Lmap = maps:from_list(Lmap0), Fs = function_replace(Fs1, Lmap, []), {Fs,Lc}. @@ -187,7 +187,8 @@ is_record_tuple(_, _, _) -> no. function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> Asm = try - replace(Asm0, [], Dict) + Fb = fun(Old) -> throw({error,{undefined_label,Old}}) end, + beam_utils:replace_labels(Asm0, [], Dict, Fb) catch throw:{error,{undefined_label,Lbl}=Reason} -> io:format("Function ~s/~w refers to undefined label ~w\n", @@ -197,57 +198,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace(Fs, Dict, [{function,Name,Arity,Entry,Asm}|Acc]); function_replace([], _, Acc) -> Acc. -replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) -> - replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D); -replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) -> - replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D); -replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) -> - Vls = map(fun ({f,L}) -> {f,label(L, D)}; - (Other) -> Other - end, Vls0), - Fail = label(Fail0, D), - replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D); -replace([{'try',R,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D); -replace([{'catch',R,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{'catch',R,{f,label(Lbl, D)}}|Acc], D); -replace([{jump,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{jump,{f,label(Lbl, D)}}|Acc], D); -replace([{loop_rec,{f,Lbl},R}|Is], Acc, D) -> - replace(Is, [{loop_rec,{f,label(Lbl, D)},R}|Acc], D); -replace([{loop_rec_end,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{loop_rec_end,{f,label(Lbl, D)}}|Acc], D); -replace([{wait,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{wait,{f,label(Lbl, D)}}|Acc], D); -replace([{wait_timeout,{f,Lbl},To}|Is], Acc, D) -> - replace(Is, [{wait_timeout,{f,label(Lbl, D)},To}|Acc], D); -replace([{bif,Name,{f,Lbl},As,R}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bif,Name,{f,label(Lbl, D)},As,R}|Acc], D); -replace([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{gc_bif,Name,{f,label(Lbl, D)},Live,As,R}|Acc], D); -replace([{call,Ar,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D); -replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) -> - replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D); -replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D); -replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D); -replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D) - when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D); -replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D); -replace([I|Is], Acc, D) -> - replace(Is, [I|Acc], D); -replace([], Acc, _) -> Acc. - -label(Old, D) -> - case gb_trees:lookup(Old, D) of - {value,Val} -> Val; - none -> throw({error,{undefined_label,Old}}) - end. - %%% %%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for %%% new bit syntax matching (introduced in R11B). diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 4365451356..0bcec9ce19 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -71,9 +71,9 @@ %%% %%% jump L2 %%% . . . -%%% L1: %%% L2: ... %%% +%%% and all preceding uses of L1 renamed to L2. %%% If the jump is unreachable, it will be removed according to (1). %%% %%% (5) In @@ -156,41 +156,46 @@ function({function,Name,Arity,CLabel,Asm0}) -> %%% share(Is0) -> - %% We will get more sharing if we never fall through to a label. - Is = eliminate_fallthroughs(Is0, []), - share_1(Is, #{}, [], []). + Is1 = eliminate_fallthroughs(Is0, []), + Is2 = find_fixpoint(fun(Is) -> + share_1(Is, #{}, #{}, [], []) + end, Is1), + reverse(Is2). -share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) -> +share_1([{label,L}=Lbl|Is], Dict0, Lbls0, [_|_]=Seq, Acc) -> case maps:find(Seq, Dict0) of error -> Dict = maps:put(Seq, L, Dict0), - share_1(Is, Dict, [], [Lbl|Seq ++ Acc]); + share_1(Is, Dict, Lbls0, [], [Lbl|Seq ++ Acc]); {ok,Label} -> - share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc]) + Lbls = maps:put(L, Label, Lbls0), + share_1(Is, Dict0, Lbls, [], [Lbl,{jump,{f,Label}}|Acc]) end; -share_1([{func_info,_,_,_}=I|Is], _, [], Acc) -> - reverse(Is, [I|Acc]); -share_1([{'catch',_,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{'try',_,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{try_case,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{catch_end,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([I|Is], Dict, Seq, Acc) -> +share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =/= #{} -> + beam_utils:replace_labels(Acc, Is, Lbls, fun(Old) -> Old end); +share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =:= #{} -> + reverse(Acc, Is); +share_1([{'catch',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{'try',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{try_case,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{catch_end,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([I|Is], Dict, Lbls, Seq, Acc) -> case is_unreachable_after(I) of false -> - share_1(Is, Dict, [I|Seq], Acc); + share_1(Is, Dict, Lbls, [I|Seq], Acc); true -> - share_1(Is, Dict, [I], Acc) + share_1(Is, Dict, Lbls, [I], Acc) end. -clean_non_sharable(Dict) -> +clean_non_sharable(Dict0, Lbls0) -> %% We are passing in or out of a 'catch' or 'try' block. Remove %% sequences that should not be shared over the boundaries of the %% block. Since the end of the sequence must match, the only @@ -198,7 +203,17 @@ clean_non_sharable(Dict) -> %% the 'catch'/'try' block is a sequence that ends with an %% instruction that causes an exception. Any sequence that causes %% an exception must contain a line/1 instruction. - maps:filter(fun(K, _V) -> sharable_with_try(K) end, Dict). + Dict1 = maps:to_list(Dict0), + Lbls1 = maps:to_list(Lbls0), + {Dict2,Lbls2} = foldl(fun({K, V}, {Dict,Lbls}) -> + case sharable_with_try(K) of + true -> + {[{K,V}|Dict],lists:keydelete(V, 2, Lbls)}; + false -> + {Dict,Lbls} + end + end, {[],Lbls1}, Dict1), + {maps:from_list(Dict2),maps:from_list(Lbls2)}. sharable_with_try([{line,_}|_]) -> %% This sequence may cause an exception and may potentially @@ -275,14 +290,15 @@ extract_seq_1(_, _) -> no. -record(st, { entry :: beam_asm:label(), %Entry label (must not be moved). - mlbl :: #{beam_asm:label() := [beam_asm:label()]}, %Moved labels. - labels :: cerl_sets:set() %Set of referenced labels. + replace :: #{beam_asm:label() := beam_asm:label()}, %Labels to replace. + labels :: cerl_sets:set(), %Set of referenced labels. + index :: beam_utils:code_index() | {lazy,[beam_utils:instruction()]} %Index built lazily only if needed }). opt(Is0, CLabel) -> find_fixpoint(fun(Is) -> Lbls = initial_labels(Is), - St = #st{entry=CLabel,mlbl=#{},labels=Lbls}, + St = #st{entry=CLabel,replace=#{},labels=Lbls,index={lazy,Is}}, opt(Is, [], St) end, Is0). @@ -292,7 +308,7 @@ find_fixpoint(OptFun, Is0) -> Is -> find_fixpoint(OptFun, Is) end. -opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) -> +opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) -> %% We have %% Test Label Ops %% jump Label @@ -301,10 +317,34 @@ opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) -> case beam_utils:is_pure_test(I) of false -> %% Test is not pure; we must keep it. - opt(Is, [I|Acc], label_used(Lbl, St)); + opt(Is, [I|Acc0], label_used(Lbl, St0)); true -> %% The test is pure and its failure label is the same %% as in the jump that follows -- thus it is not needed. + %% Check if any of the previous instructions could also be eliminated. + {Acc,St} = opt_useless_loads(Acc0, L, St0), + opt(Is, Acc, St) + end; +opt([{test,_,{f,L}=Lbl,_}=I|[{label,L}|_]=Is], Acc0, St0) -> + %% Similar to the above, except we have a fall-through rather than jump + %% Test Label Ops + %% label Label + case beam_utils:is_pure_test(I) of + false -> + opt(Is, [I|Acc0], label_used(Lbl, St0)); + true -> + {Acc,St} = opt_useless_loads(Acc0, L, St0), + opt(Is, Acc, St) + end; +opt([{test,_,{f,L}=Lbl,_}=I|[{label,L}|_]=Is], Acc0, St0) -> + %% Similar to the above, except we have a fall-through rather than jump + %% Test Label Ops + %% label Label + case beam_utils:is_pure_test(I) of + false -> + opt(Is, [I|Acc0], label_used(Lbl, St0)); + true -> + {Acc,St} = opt_useless_loads(Acc0, L, St0), opt(Is, Acc, St) end; opt([{test,Test0,{f,L}=Lbl,Ops}=I|[{jump,To}|Is]=Is0], Acc, St) -> @@ -326,30 +366,16 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) -> opt(Is, [I|Acc], label_used(Lbl, St)); opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) -> skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); -opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> - case maps:find(Lbl, Mlbl) of - {ok,Lbls} -> - %% Essential to remove the list of labels from the dictionary, - %% since we will rescan the inserted labels. We MUST rescan. - St = St0#st{mlbl=maps:remove(Lbl, Mlbl)}, - insert_labels([Lbl|Lbls], Is, Acc, St); - error -> - opt(Is, [I|Acc], St0) - end; +opt([{label,From}=I,{label,To}|Is], Acc, #st{replace=Replace}=St) -> + opt([I|Is], Acc, St#st{replace=Replace#{To => From}}); opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) -> opt(Is, Acc, St); opt([{jump,{f,Lbl}}|[{label,Lbl}|_]=Is], Acc, St) -> opt(Is, Acc, St); -opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) -> - %% All labels before this jump instruction should now be - %% moved to the location of the jump's target. - {Lbls,Acc} = collect_labels(Acc0, St0), - St = case Lbls of - [] -> St0; - [_|_] -> - Mlbl = maps_append_list(L, Lbls, Mlbl0), - St0#st{mlbl=Mlbl} - end, +opt([{jump,{f,L}=Lbl}=I|Is], Acc0, St0) -> + %% Replace all labels before this jump instruction into the + %% location of the jump's target. + {Acc,St} = collect_labels(Acc0, L, St0), skip_unreachable(Is, [I|Acc], label_used(Lbl, St)); %% Optimization: quickly handle some common instructions that don't %% have any failure labels and where is_unreachable_after(I) =:= false. @@ -369,36 +395,72 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) -> true -> skip_unreachable(Is, [I|Acc], St); false -> opt(Is, [I|Acc], St) end; -opt([], Acc, #st{mlbl=Mlbl}) -> - Code = reverse(Acc), - insert_fc_labels(Code, Mlbl). - -insert_fc_labels([{label,L}=I|Is0], Mlbl) -> - case maps:find(L, Mlbl) of - error -> - [I|insert_fc_labels(Is0, Mlbl)]; - {ok,Lbls} -> - Is = [{label,Lb} || Lb <- Lbls] ++ Is0, - [I|insert_fc_labels(Is, maps:remove(L, Mlbl))] +opt([], Acc, #st{replace=Replace0}) when Replace0 =/= #{} -> + Replace = normalize_replace(maps:to_list(Replace0), Replace0, []), + beam_utils:replace_labels(Acc, [], Replace, fun(Old) -> Old end); +opt([], Acc, #st{replace=Replace}) when Replace =:= #{} -> + reverse(Acc). + +normalize_replace([{From,To0}|Rest], Replace, Acc) -> + case Replace of + #{To0 := To} -> + normalize_replace([{From,To}|Rest], Replace, Acc); + _ -> + normalize_replace(Rest, Replace, [{From,To0}|Acc]) end; -insert_fc_labels([_|_]=Is, _) -> Is. - -maps_append_list(K,Vs,M) -> - case M of - #{K:=Vs0} -> M#{K:=Vs0++Vs}; % same order as dict - _ -> M#{K => Vs} - end. +normalize_replace([], _Replace, Acc) -> + maps:from_list(Acc). + +%% After eliminating a test, it might happen, that a register was only used +%% in this test. Let's check if that was the case and if it was so, we can +%% eliminate the load into the register completely. +opt_useless_loads([{block,_}|_]=Is, L, #st{index={lazy,FIs}}=St) -> + opt_useless_loads(Is, L, St#st{index=beam_utils:index_labels(FIs)}); +opt_useless_loads([{block,Block0}|Is], L, #st{index=Index}=St) -> + case opt_useless_block_loads(Block0, L, Index) of + [] -> + opt_useless_loads(Is, L, St); + [_|_]=Block -> + {[{block,Block}|Is],St} + end; +%% After eliminating the test and useless blocks, it might happen, +%% that the previous test could also be eliminated. +%% It might be that the label was already marked as used, even if ultimately, +%% it never will be - we can't do much about it at that point, though +opt_useless_loads([{test,_,{f,L},_}=I|Is], L, St) -> + case beam_utils:is_pure_test(I) of + false -> + {[I|Is],St}; + true -> + opt_useless_loads(Is, L, St) + end; +opt_useless_loads(Is, _L, St) -> + {Is,St}. + +opt_useless_block_loads([{set,[Dst],_,_}=I|Is], L, Index) -> + BlockJump = [{block,Is},{jump,{f,L}}], + case beam_utils:is_killed(Dst, BlockJump, Index) of + true -> + %% The register is killed and not used, we can remove the load + opt_useless_block_loads(Is, L, Index); + false -> + [I|opt_useless_block_loads(Is, L, Index)] + end; +opt_useless_block_loads([I|Is], L, Index) -> + [I|opt_useless_block_loads(Is, L, Index)]; +opt_useless_block_loads([], _L, _Index) -> + []. -collect_labels(Is, #st{entry=Entry}) -> - collect_labels_1(Is, Entry, []). +collect_labels(Is, Label, #st{entry=Entry,replace=Replace} = St) -> + collect_labels_1(Is, Label, Entry, Replace, St). -collect_labels_1([{label,Entry}|_]=Is, Entry, Acc) -> +collect_labels_1([{label,Entry}|_]=Is, _Label, Entry, Acc, St) -> %% Never move the entry label. - {Acc,Is}; -collect_labels_1([{label,L}|Is], Entry, Acc) -> - collect_labels_1(Is, Entry, [L|Acc]); -collect_labels_1(Is, _Entry, Acc) -> - {Acc,Is}. + {Is,St#st{replace=Acc}}; +collect_labels_1([{label,L}|Is], Label, Entry, Acc, St) -> + collect_labels_1(Is, Label, Entry, Acc#{L => Label}, St); +collect_labels_1(Is, _Label, _Entry, Acc, St) -> + {Is,St#st{replace=Acc}}. %% label_defined(Is, Label) -> true | false. %% Test whether the label Label is defined at the start of the instruction @@ -418,13 +480,6 @@ invert_test(is_eq_exact) -> is_ne_exact; invert_test(is_ne_exact) -> is_eq_exact; invert_test(_) -> not_possible. -insert_labels([L|Ls], Is, [{jump,{f,L}}|Acc], St) -> - insert_labels(Ls, [{label,L}|Is], Acc, St); -insert_labels([L|Ls], Is, Acc, St) -> - insert_labels(Ls, [{label,L}|Is], Acc, St); -insert_labels([], Is, Acc, St) -> - opt(Is, Acc, St). - %% skip_unreachable([Instruction], St). %% Remove all instructions (including definitions of labels %% that have not been referenced yet) up to the next diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 6df5c02334..9436c20b36 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -89,15 +89,37 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> peep([{jump,{f,L}},{label,L}=I|Is], _, Acc) -> %% Sometimes beam_jump has missed this optimization. peep(Is, gb_sets:empty(), [I|Acc]); -peep([{select,Op,R,F,Vls0}|Is], _, Acc) -> +peep([{select,Op,R,F,Vls0}|Is], SeenTests0, Acc0) -> case prune_redundant_values(Vls0, F) of [] -> %% No values left. Must convert to plain jump. I = {jump,F}, - peep(Is, gb_sets:empty(), [I|Acc]); + peep([I|Is], gb_sets:empty(), Acc0); + [{atom,_}=Value,Lbl] when Op =:= select_val -> + %% Single value left. Convert to regular test and pop redundant tests. + Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is], + case Acc0 of + [{test,is_atom,F,[R]}|Acc] -> + peep(Is1, SeenTests0, Acc); + _ -> + peep(Is1, SeenTests0, Acc0) + end; + [{integer,_}=Value,Lbl] when Op =:= select_val -> + %% Single value left. Convert to regular test and pop redundant tests. + Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is], + case Acc0 of + [{test,is_integer,F,[R]}|Acc] -> + peep(Is1, SeenTests0, Acc); + _ -> + peep(Is1, SeenTests0, Acc0) + end; + [Arity,Lbl] when Op =:= select_tuple_arity -> + %% Single value left. Convert to regular test + Is1 = [{test,test_arity,F,[R,Arity]},{jump,Lbl}|Is], + peep(Is1, SeenTests0, Acc0); [_|_]=Vls -> I = {select,Op,R,F,Vls}, - peep(Is, gb_sets:empty(), [I|Acc]) + peep(Is, gb_sets:empty(), [I|Acc0]) end; peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> case beam_utils:is_pure_test(I) of diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index cc6e54ca16..52ed1c7ca0 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -23,14 +23,14 @@ -module(beam_utils). -export([is_killed_block/2,is_killed/3,is_killed_at/3, is_not_used/3, - empty_label_index/0,index_label/3,index_labels/1, + empty_label_index/0,index_label/3,index_labels/1,replace_labels/4, code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2, split_even/1]). -export_type([code_index/0,module_code/0,instruction/0]). --import(lists, [member/2,sort/1,reverse/1,splitwith/2]). +-import(lists, [map/2,member/2,sort/1,reverse/1,splitwith/2]). %% instruction() describes all instructions that are used during optimzation %% (from beam_a to beam_z). @@ -160,6 +160,18 @@ index_label(Lbl, Is0, Acc) -> code_at(L, Ll) -> gb_trees:get(L, Ll). +%% replace_labels(FunctionIs, Tail, ReplaceDb, Fallback) -> FunctionIs. +%% Replace all labels in instructions according to the ReplaceDb. +%% If label is not found the Fallback is called with the label to +%% produce a new one. + +-spec replace_labels([instruction()], + [instruction()], + #{beam_asm:label() => beam_asm:label()}, + fun((beam_asm:label()) -> term())) -> [instruction()]. +replace_labels(Is, Acc, D, Fb) -> + replace_labels_1(Is, Acc, D, Fb). + %% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]} %% Convert a BIF to a test. Fail if not possible. @@ -643,6 +655,58 @@ index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). drop_labels([{label,_}|Is]) -> drop_labels(Is); drop_labels(Is) -> Is. + +replace_labels_1([{test,Test,{f,Lbl},Ops}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Ops}|Acc], D, Fb); +replace_labels_1([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}|Acc], D, Fb); +replace_labels_1([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D, Fb) -> + Vls = map(fun ({f,L}) -> {f,label(L, D, Fb)}; + (Other) -> Other + end, Vls0), + Fail = label(Fail0, D, Fb), + replace_labels_1(Is, [{select,I,R,{f,Fail},Vls}|Acc], D, Fb); +replace_labels_1([{'try',R,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{'try',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{'catch',R,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{'catch',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{jump,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{jump,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{loop_rec,{f,Lbl},R}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{loop_rec,{f,label(Lbl, D, Fb)},R}|Acc], D, Fb); +replace_labels_1([{loop_rec_end,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{loop_rec_end,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{wait,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{wait,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{wait_timeout,{f,Lbl},To}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{wait_timeout,{f,label(Lbl, D, Fb)},To}|Acc], D, Fb); +replace_labels_1([{bif,Name,{f,Lbl},As,R}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{bif,Name,{f,label(Lbl, D, Fb)},As,R}|Acc], D, Fb); +replace_labels_1([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{gc_bif,Name,{f,label(Lbl, D, Fb)},Live,As,R}|Acc], D, Fb); +replace_labels_1([{call,Ar,{f,Lbl}}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{call,Ar,{f,label(Lbl, D, Fb)}}|Acc], D, Fb); +replace_labels_1([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D, Fb) -> + replace_labels_1(Is, [{make_fun2,{f,label(Lbl, D, Fb)},U1,U2,U3}|Acc], D, Fb); +replace_labels_1([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{bs_init,{f,label(Lbl, D, Fb)},Info,Live,Ss,Dst}|Acc], D, Fb); +replace_labels_1([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{bs_put,{f,label(Lbl, D, Fb)},Info,Ss}|Acc], D, Fb); +replace_labels_1([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D, Fb) + when Lbl =/= 0 -> + replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Op,Src,Dst,Live,List}|Acc], D, Fb); +replace_labels_1([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D, Fb) when Lbl =/= 0 -> + replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Src,List}|Acc], D, Fb); +replace_labels_1([I|Is], Acc, D, Fb) -> + replace_labels_1(Is, [I|Acc], D, Fb); +replace_labels_1([], Acc, _, _) -> Acc. + +label(Old, D, Fb) -> + case D of + #{Old := New} -> New; + _ -> Fb(Old) + end. + %% Help functions for combine_heap_needs. combine_alloc_lists(Al1, Al2) -> @@ -789,39 +853,48 @@ live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) -> live_opt([], _, _, Acc) -> Acc. -live_opt_block([{set,Ds,Ss,Op}=I0|Is], Regs0, D, Acc) -> +live_opt_block([{set,Ds,Ss,Op0}|Is], Regs0, D, Acc) -> Regs1 = x_live(Ss, x_dead(Ds, Regs0)), - {I,Regs} = case Op of - {alloc,Live0,Alloc} -> - %% The life-time analysis used by the code generator - %% is sometimes too conservative, so it may be - %% possible to lower the number of live registers - %% based on the exact liveness information. - %% The main benefit is that more optimizations that - %% depend on liveness information (such as the - %% beam_bool and beam_dead passes) may be applied. - Live = live_regs(Regs1), - true = Live =< Live0, %Assertion. - I1 = {set,Ds,Ss,{alloc,Live,Alloc}}, - {I1,live_call(Live)}; - _ -> - {I0,Regs1} - end, + {Op, Regs} = live_opt_block_op(Op0, Regs1, D), + I = {set, Ds, Ss, Op}, + case Ds of - [{x,X}] -> - case (not is_live(X, Regs0)) andalso Op =:= move of - true -> - live_opt_block(Is, Regs0, D, Acc); - false -> - live_opt_block(Is, Regs, D, [I|Acc]) - end; - _ -> - live_opt_block(Is, Regs, D, [I|Acc]) + [{x,X}] -> + case (not is_live(X, Regs0)) andalso Op =:= move of + true -> + live_opt_block(Is, Regs0, D, Acc); + false -> + live_opt_block(Is, Regs, D, [I|Acc]) + end; + _ -> + live_opt_block(Is, Regs, D, [I|Acc]) end; live_opt_block([{'%live',_,_}|Is], Regs, D, Acc) -> live_opt_block(Is, Regs, D, Acc); live_opt_block([], Regs, _, Acc) -> {Acc,Regs}. +live_opt_block_op({alloc,Live0,AllocOp}, Regs0, D) -> + Regs = + case AllocOp of + {Kind, _N, Fail} when Kind =:= gc_bif; Kind =:= put_map -> + live_join_label(Fail, D, Regs0); + _ -> + Regs0 + end, + + %% The life-time analysis used by the code generator is sometimes too + %% conservative, so it may be possible to lower the number of live + %% registers based on the exact liveness information. The main benefit is + %% that more optimizations that depend on liveness information (such as the + %% beam_bool and beam_dead passes) may be applied. + Live = live_regs(Regs), + true = Live =< Live0, + {{alloc,Live,AllocOp}, live_call(Live)}; +live_opt_block_op({bif,_N,Fail} = Op, Regs, D) -> + {Op, live_join_label(Fail, D, Regs)}; +live_opt_block_op(Op, Regs, _D) -> + {Op, Regs}. + live_join_labels([{f,L}|T], D, Regs0) when L =/= 0 -> Regs = gb_trees:get(L, D) bor Regs0, live_join_labels(T, D, Regs); diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index f726625510..00901077d3 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -928,9 +928,9 @@ verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) -> error({unsuitable_bs_start_match2,I}) end. -allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) -> +allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}}=Vst0) -> verify_live(Live, Vst0), - Vst = prune_x_regs(Live, Vst0), + Vst = #vst{current=St} = prune_x_regs(Live, Vst0), Ys = init_regs(Stk, case Zero of true -> initialized; false -> uninitialized @@ -1430,13 +1430,13 @@ merge_types(bool, {atom,A}) -> merge_bool(A); merge_types({atom,A}, bool) -> merge_bool(A); -merge_types(#ms{id=Id,valid=B0,slots=Slots}=M, - #ms{id=Id,valid=B1,slots=Slots}) -> - M#ms{valid=B0 bor B1,slots=Slots}; -merge_types(#ms{}=M, _) -> - M; -merge_types(_, #ms{}=M) -> - M; +merge_types(#ms{id=Id1,valid=B0,slots=Slots}, + #ms{id=Id2,valid=B1,slots=Slots}) -> + Id = if + Id1 =:= Id2 -> Id1; + true -> make_ref() + end, + #ms{id=Id,valid=B0 band B1,slots=Slots}; merge_types(T1, T2) when T1 =/= T2 -> %% Too different. All we know is that the type is a 'term'. term. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index e0cd6da06f..f3f315935a 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -395,10 +395,10 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) -> Op1 = expr(Op0, value, Sub), As1 = expr_list(As0, value, Sub), - case Op1 of - #c_var{} -> + case cerl:is_data(Op1) of + false -> App#c_apply{op=Op1,args=As1}; - _ -> + true -> add_warning(App, invalid_call), Err = #c_call{anno=Anno, module=#c_literal{val=erlang}, @@ -2422,16 +2422,10 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, Outer#c_let{vars=OuterVs,arg=Arg, body=Inner#c_let{vars=InnerVs,arg=OuterBody,body=InnerBody}}; move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, - #c_case{arg=Cexpr0,clauses=[Ca0,Cb0|Cs]}=Case, Sub0) -> - %% Test if there are no more clauses than Ca0 and Cb0, or if - %% Cb0 is guaranteed to match. - TwoClauses = Cs =:= [] orelse - case Cb0 of - #c_clause{pats=[#c_var{}],guard=#c_literal{val=true}} -> true; - _ -> false - end, - case {TwoClauses,is_failing_clause(Ca0),is_failing_clause(Cb0)} of - {true,false,true} -> + #c_case{arg=Cexpr0,clauses=[Ca0|Cs0]}=Case, Sub0) -> + case not is_failing_clause(Ca0) andalso + are_all_failing_clauses(Cs0) of + true -> %% let <Lvars> = case <Case-expr> of %% <Cpats> -> <Clause-body>; %% <OtherCpats> -> erlang:error(...) @@ -2467,8 +2461,8 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, body=Lbody}, Ca = Ca0#c_clause{pats=CaPats,guard=G,body=B}, - Cb = clause(Cb0, Cexpr, value, Sub0), - Case#c_case{arg=Cexpr,clauses=[Ca,Cb]} + Cs = [clause(C, Cexpr, value, Sub0) || C <- Cs0], + Case#c_case{arg=Cexpr,clauses=[Ca|Cs]} catch nomatch -> %% This is not a defeat. The code will eventually @@ -2476,7 +2470,7 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, %% optimizations done in this module. impossible end; - {_,_,_} -> impossible + false -> impossible end; move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) -> @@ -2499,6 +2493,9 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, body=Lbody}}; move_let_into_expr(_Let, _Expr, _Sub) -> impossible. +are_all_failing_clauses(Cs) -> + all(fun is_failing_clause/1, Cs). + is_failing_clause(#c_clause{body=B}) -> will_fail(B). diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 47c1567f10..0ae3289103 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -884,12 +884,19 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, %% calculcated by v3_life is too conservative to be useful for this purpose.) %% 'true' means that the code that follows will definitely not use the context %% again (because it is a block, not guard or matching code); 'false' that we -%% are not sure (there is either a guard, or more matching, either which may -%% reference the context again). - -is_context_unused(#l{ke=Ke}) -> is_context_unused(Ke); -is_context_unused({block,_}) -> true; -is_context_unused(_) -> false. +%% are not sure (there could be more matching). + +is_context_unused(#l{ke=Ke}) -> + is_context_unused(Ke); +is_context_unused({alt,_First,Then}) -> + %% {alt,First,Then} can be used for different purposes. If the Then part + %% is a block, it means that matching has finished and is used for a guard + %% to choose between the matched clauses. + is_context_unused(Then); +is_context_unused({block,_}) -> + true; +is_context_unused(_) -> + false. select_bin_end(#l{ke={val_clause,{bin_end,Ctx},B}}, Ivar, Tf, Bef, St0) -> diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index a3f1bb93fe..710cb050d4 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -260,6 +260,14 @@ otp_8949_b(A, B) -> liveopt(_Config) -> F = liveopt_fun(42, pebkac, user), void = F(42, #alarmInfo{type=sctp,cause=pebkac,origin=user}), + + + A = {#alarmInfo{cause = {abc, def}}, ghi}, + A = liveopt_guard_bif(A), + + B = {#alarmInfo{cause = {abc}}, def}, + {#alarmInfo{cause = {{abc}}}, def} = liveopt_guard_bif(B), + ok. liveopt_fun(Peer, Cause, Origin) -> @@ -271,6 +279,15 @@ liveopt_fun(Peer, Cause, Origin) -> void end. +liveopt_guard_bif({#alarmInfo{cause=F}=R, X}=A) -> + %% ERIERL-48 + if + is_tuple(F), tuple_size(F) == 2 -> A; + true -> + R2 = R#alarmInfo{cause={F}}, + {R2,X} + end. + %% Thanks to QuickCheck. coverage(_Config) -> 42+7 = merchant([[],7,false]), diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 0ec05456ec..1da7f68dab 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -39,7 +39,7 @@ match_string_opt/1,select_on_integer/1, map_and_binary/1,unsafe_branch_caching/1, bad_literals/1,good_literals/1,constant_propagation/1, - parse_xml/1,get_payload/1]). + parse_xml/1,get_payload/1,escape/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -71,7 +71,7 @@ groups() -> match_string_opt,select_on_integer, map_and_binary,unsafe_branch_caching, bad_literals,good_literals,constant_propagation,parse_xml, - get_payload]}]. + get_payload,escape]}]. init_per_suite(Config) -> @@ -1524,6 +1524,21 @@ do_get_payload(ExtHdr) -> <<_:13,_:35>> = ExtHdr#ext_header.ext_hdr_opts, ExtHdrOptions. +escape(_Config) -> + 0 = escape(<<>>, 0), + 1 = escape(<<128>>, 0), + 2 = escape(<<128,255>>, 0), + 42 = escape(<<42>>, 0), + 50 = escape(<<42,8>>, 0), + ok. + +escape(<<Byte, Rest/bits>>, Pos) when Byte >= 127 -> + escape(Rest, Pos + 1); +escape(<<Byte, Rest/bits>>, Pos) -> + escape(Rest, Pos + Byte); +escape(<<_Rest/bits>>, Pos) -> + Pos. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl index f1607cca68..c65ec31593 100644 --- a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl +++ b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl @@ -33,7 +33,7 @@ test() -> {userinfo,nil}, fun() -> nil end}, nil}, - {'query',nil}}}, + {query,nil}}}, {absoluteURI, {scheme,_}, @@ -43,7 +43,7 @@ test() -> {userinfo,nil}, HostportBefore}, nil}, - {'query',nil}}} = URI_Before, + {query,nil}}} = URI_Before, %% ... some funky code ommitted, not relevant ... @@ -55,7 +55,7 @@ test() -> {userinfo,nil}, HostportAfter}, nil}, - {'query',nil}}} = URI_Before, + {query,nil}}} = URI_Before, %% NOTE: I intended to write URI_After instead of URI_Before %% but the accident revealed that when you add the line below, %% it causes internal error in v3_codegen on compilation diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index f8839da42f..0e07e8dd2e 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -28,7 +28,8 @@ map_core_test/1,eval_case/1,bad_boolean_guard/1, bs_shadowed_size_var/1, cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1, - cover_v3_kernel_4/1,cover_v3_kernel_5/1]). + cover_v3_kernel_4/1,cover_v3_kernel_5/1, + non_variable_apply/1]). -include_lib("common_test/include/ct.hrl"). @@ -56,7 +57,8 @@ groups() -> map_core_test,eval_case,bad_boolean_guard, bs_shadowed_size_var, cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3, - cover_v3_kernel_4,cover_v3_kernel_5 + cover_v3_kernel_4,cover_v3_kernel_5, + non_variable_apply ]}]. @@ -90,7 +92,7 @@ end_per_group(_GroupName, Config) -> ?comp(cover_v3_kernel_3). ?comp(cover_v3_kernel_4). ?comp(cover_v3_kernel_5). - +?comp(non_variable_apply). try_it(Mod, Conf) -> Src = filename:join(proplists:get_value(data_dir, Conf), diff --git a/lib/compiler/test/core_SUITE_data/non_variable_apply.core b/lib/compiler/test/core_SUITE_data/non_variable_apply.core new file mode 100644 index 0000000000..d9322cc455 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/non_variable_apply.core @@ -0,0 +1,80 @@ +module 'non_variable_apply' ['module_info'/0, + 'module_info'/1, + 'non_variable_apply'/0] + attributes [] + +'non_variable_apply'/0 = + %% Line 4 + fun () -> + case <> of + <> when 'true' -> + let <OkFun> = + fun (_@c0) -> + %% Line 5 + case _@c0 of + <'ok'> when 'true' -> + 'ok' + ( <_@c1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_@c1}) + -| [{'function_name',{'-non_variable_apply/0-fun-0-',1}}] ) + -| ['compiler_generated'] ) + end + in let <F> = + fun (_@c5,_@c4) -> + %% Line 6 + case <_@c5,_@c4> of + <F,X> when 'true' -> + apply apply 'id'/1 (F) (X) + ( <_@c7,_@c6> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_@c7,_@c6}) + -| [{'function_name',{'-non_variable_apply/0-fun-1-',2}}] ) + -| ['compiler_generated'] ) + end + in %% Line 9 + apply F + (OkFun, 'ok') + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'non_variable_apply',0}}] ) + -| ['compiler_generated'] ) + end +'id'/1 = + %% Line 11 + fun (_@c0) -> + case _@c0 of + <I> when 'true' -> + I + ( <_@c1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_@c1}) + -| [{'function_name',{'id',1}}] ) + -| ['compiler_generated'] ) + end +'module_info'/0 = + fun () -> + case <> of + <> when 'true' -> + call 'erlang':'get_module_info' + ('non_variable_apply') + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'module_info',0}}] ) + -| ['compiler_generated'] ) + end +'module_info'/1 = + fun (_@c0) -> + case _@c0 of + <X> when 'true' -> + call 'erlang':'get_module_info' + ('non_variable_apply', X) + ( <_@c1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_@c1}) + -| [{'function_name',{'module_info',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 0097e28d4d..262967d03d 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -26,7 +26,8 @@ unused_multiple_values_error/1,unused_multiple_values/1, multiple_aliases/1,redundant_boolean_clauses/1, mixed_matching_clauses/1,unnecessary_building/1, - no_no_file/1,configuration/1,supplies/1]). + no_no_file/1,configuration/1,supplies/1, + redundant_stack_frame/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -45,7 +46,8 @@ groups() -> unused_multiple_values_error,unused_multiple_values, multiple_aliases,redundant_boolean_clauses, mixed_matching_clauses,unnecessary_building, - no_no_file,configuration,supplies]}]. + no_no_file,configuration,supplies, + redundant_stack_frame]}]. init_per_suite(Config) -> @@ -527,4 +529,26 @@ supplies(_Config) -> do_supplies(#{1 := Value}) when byte_size(Value), byte_size(kg) -> working. +redundant_stack_frame(_Config) -> + {1,2} = do_redundant_stack_frame(#{x=>1,y=>2}), + {'EXIT',{{badkey,_,x},_}} = (catch do_redundant_stack_frame(#{y=>2})), + {'EXIT',{{badkey,_,y},_}} = (catch do_redundant_stack_frame(#{x=>1})), + ok. + +do_redundant_stack_frame(Map) -> + %% There should not be a stack frame for this function. + X = case Map of + #{x := X0} -> + X0; + #{} -> + erlang:error({badkey, Map, x}) + end, + Y = case Map of + #{y := Y0} -> + Y0; + #{} -> + erlang:error({badkey, Map, y}) + end, + {X, Y}. + id(I) -> I. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 52b2da05f7..c31695be24 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,non_matching_aliases/1, match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1,match_map/1,map_vars_used/1, + selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1,grab_bag/1,literal_binary/1]). -include_lib("common_test/include/ct.hrl"). @@ -38,7 +38,7 @@ groups() -> [{p,[parallel], [pmatch,mixed,aliases,non_matching_aliases, match_in_call,untuplify, - shortcut_boolean,letify_guard,selectify, + shortcut_boolean,letify_guard,selectify,deselectify, underscore,match_map,map_vars_used,coverage, grab_bag,literal_binary]}]. @@ -466,6 +466,66 @@ sel_same_value2(V) when V =:= 42; V =:= 43 -> sel_same_value2(_) -> error. +%% Test deconstruction of select_val instructions in beam_peep into +%% regular tests with just one possible value left. Hitting proper cases +%% in beam_peep relies on unification of labels by beam_jump. + +deselectify(Config) when is_list(Config) -> + one_or_other = desel_tuple_arity({1}), + two = desel_tuple_arity({1,1}), + one_or_other = desel_tuple_arity({1,1,1}), + + one_or_other = dsel_integer(1), + two = dsel_integer(2), + one_or_other = dsel_integer(3), + + one_or_other = dsel_integer_typecheck(1), + two = dsel_integer_typecheck(2), + one_or_other = dsel_integer_typecheck(3), + + one_or_other = dsel_atom(one), + two = dsel_atom(two), + one_or_other = dsel_atom(three), + + one_or_other = dsel_atom_typecheck(one), + two = dsel_atom_typecheck(two), + one_or_other = dsel_atom_typecheck(three). + +desel_tuple_arity(Tuple) when is_tuple(Tuple) -> + case Tuple of + {_} -> one_or_other; + {_,_} -> two; + _ -> one_or_other + end. + +dsel_integer(Val) -> + case Val of + 1 -> one_or_other; + 2 -> two; + _ -> one_or_other + end. + +dsel_integer_typecheck(Val) when is_integer(Val) -> + case Val of + 1 -> one_or_other; + 2 -> two; + _ -> one_or_other + end. + +dsel_atom(Val) -> + case Val of + one -> one_or_other; + two -> two; + _ -> one_or_other + end. + +dsel_atom_typecheck(Val) when is_atom(Val) -> + case Val of + one -> one_or_other; + two -> two; + _ -> one_or_other + end. + underscore(Config) when is_list(Config) -> case Config of [] -> diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 463c264a5f..27ee5a3fb7 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.1 +COMPILER_VSN = 7.1.1 diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 88c7caacb0..8009d62629 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -353,15 +353,15 @@ format_trace(What, Args, P) -> {Called, {Le,Li,M,F,As}} = Args, case Called of extern -> - io_lib:format("++ (~w) <~w> ~w:~w~ts~n", + io_lib:format("++ (~w) <~w> ~w:~tw~ts~n", [Le,Li,M,F,format_args(As, P)]); local -> - io_lib:format("++ (~w) <~w> ~w~ts~n", + io_lib:format("++ (~w) <~w> ~tw~ts~n", [Le,Li,F,format_args(As, P)]) end; call_fun -> {Le,Li,F,As} = Args, - io_lib:format("++ (~w) <~w> ~w~ts~n", + io_lib:format("++ (~w) <~w> ~tw~ts~n", [Le, Li, F, format_args(As, P)]); return -> {Le,Val} = Args, @@ -370,7 +370,7 @@ format_trace(What, Args, P) -> bif -> {Le,Li,M,F,As} = Args, - io_lib:format("++ (~w) <~w> ~w:~w~ts~n", + io_lib:format("++ (~w) <~w> ~w:~tw~ts~n", [Le, Li, M, F, format_args(As, P)]) end. diff --git a/lib/debugger/src/dbg_wx_break_win.erl b/lib/debugger/src/dbg_wx_break_win.erl index 770681510d..10e9272254 100644 --- a/lib/debugger/src/dbg_wx_break_win.erl +++ b/lib/debugger/src/dbg_wx_break_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -159,7 +159,7 @@ create_win(Parent, Pos, Type, Mod, Line) -> %%-------------------------------------------------------------------- update_functions(WinInfo, Funcs) -> Items = lists:map(fun([N, A]) -> - lists:flatten(io_lib:format("~p/~p", [N,A])) + lists:flatten(io_lib:format("~tw/~w", [N,A])) end, Funcs), wxListBox:set(WinInfo#winInfo.listbox, Items), diff --git a/lib/debugger/src/dbg_wx_mon_win.erl b/lib/debugger/src/dbg_wx_mon_win.erl index 9737c9e67f..fcd954454b 100644 --- a/lib/debugger/src/dbg_wx_mon_win.erl +++ b/lib/debugger/src/dbg_wx_mon_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -342,7 +342,7 @@ add_process(WinInfo, Pid, Name, {Mod,Func,Args}, Status, Info) -> Row = (WinInfo#winInfo.row), Name2 = case Name of undefined -> ""; _ -> to_string(Name) end, - FuncS = to_string("~w:~w/~w", [Mod, Func, length(Args)]), + FuncS = to_string("~w:~tw/~w", [Mod, Func, length(Args)]), Info2 = case Info of {} -> ""; _ -> to_string(Info) end, Pid2 = to_string("~p",[Pid]), diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index f4ee30618c..b1e0e03b4c 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -345,11 +345,12 @@ gui_cmd('Back Trace', State) -> P = p(State), lists:foreach( fun({Le, {Mod,Func,Args}}) -> - Str = io_lib:format("~p > ~p:~p"++P++"~n", - [Le, Mod, Func, Args]), + Str = io_lib:format("~p > ~w:~tw~ts\n", + [Le, Mod, Func, format_args(Args, P)]), dbg_wx_trace_win:trace_output(State#state.win,Str); ({Le, {Fun,Args}}) -> - Str = io_lib:format("~p > ~p"++P++"~n", [Le, Fun, Args]), + Str = io_lib:format("~p > ~p~ts~n", + [Le, Fun, format_args(Args, P)]), dbg_wx_trace_win:trace_output(State#state.win,Str); (_) -> ignore end, @@ -539,6 +540,18 @@ add_break(WI, Coords, Type, Mod, Line) -> Win = dbg_wx_trace_win:get_window(WI), dbg_wx_break:start(Win, Coords, Type, Mod, Line). +format_args(As, P) when is_list(As) -> + [$(,format_args1(As, P),$)]; +format_args(A, P) -> + [$/,io_lib:format(P, [A])]. + +format_args1([A], P) -> + [io_lib:format(P, [A])]; +format_args1([A|As], P) -> + [io_lib:format(P, [A]),$,|format_args1(As, P)]; +format_args1([], _) -> + []. + %%--Commands from the interpreter------------------------------------- int_cmd({interpret, Mod}, State) -> diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl index f1298154ab..9f59915476 100644 --- a/lib/debugger/src/dbg_wx_win.erl +++ b/lib/debugger/src/dbg_wx_win.erl @@ -299,7 +299,7 @@ open_help(_Parent, HelpHtmlFile) -> %%-------------------------------------------------------------------- to_string(Atom) when is_atom(Atom) -> - atom_to_list(Atom); + io_lib:format("~tw", [Atom]); to_string(Integer) when is_integer(Integer) -> integer_to_list(Integer); to_string([]) -> ""; diff --git a/lib/debugger/src/i.erl b/lib/debugger/src/i.erl index 2da3e77618..62ce8d0e20 100644 --- a/lib/debugger/src/i.erl +++ b/lib/debugger/src/i.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -307,13 +307,13 @@ ip() -> ip([{Pid,{M,F,A},Status,{}}|Stats]) -> hformat(io_lib:format("~w",[Pid]), - io_lib:format("~p:~p/~p",[M,F,length(A)]), + io_lib:format("~w:~tw/~w",[M,F,length(A)]), io_lib:format("~w",[Status]), ""), ip(Stats); ip([{Pid,{M,F,A},Status,Info}|Stats]) -> hformat(io_lib:format("~w",[Pid]), - io_lib:format("~p:~p/~p",[M,F,length(A)]), + io_lib:format("~w:~tw/~w",[M,F,length(A)]), io_lib:format("~w",[Status]), io_lib:format("~w",[Info])), ip(Stats); @@ -321,7 +321,7 @@ ip([]) -> ok. hformat(A1, A2, A3, A4) -> - format("~-12s ~-21s ~-9s ~-21s~n", [A1,A2,A3,A4]). + format("~-12s ~-21ts ~-9s ~-21s~n", [A1,A2,A3,A4]). %% ------------------------------------------- diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml index 0d2cb6c4df..c26b7aab5e 100644 --- a/lib/dialyzer/doc/src/notes.xml +++ b/lib/dialyzer/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the Dialyzer application.</p> +<section><title>Dialyzer 3.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix a bug where merging PLT:s could lose info. The + bug was introduced in Erlang/OTP 20.0. </p> + <p> + Own Id: OTP-14558 Aux Id: ERIERL-53 </p> + </item> + </list> + </section> + +</section> + <section><title>Dialyzer 3.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index c319acb2fb..1538174d4a 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -498,24 +498,24 @@ call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, true -> %% We do not know which argument(s) caused the failure io_lib:format("will never return since the success typing arguments" - " are ~s\n", [SigArgs]); + " are ~ts\n", [SigArgs]); false -> io_lib:format("will never return since it differs in the ~s argument" - " from the success typing arguments: ~s\n", + " from the success typing arguments: ~ts\n", [PositionString, SigArgs]) end; only_contract -> case (ArgNs =:= []) orelse IsOverloaded of true -> %% We do not know which arguments caused the failure - io_lib:format("breaks the contract ~s\n", [Contract]); + io_lib:format("breaks the contract ~ts\n", [Contract]); false -> - io_lib:format("breaks the contract ~s in the ~s argument\n", + io_lib:format("breaks the contract ~ts in the ~s argument\n", [Contract, PositionString]) end; both -> - io_lib:format("will never return since the success typing is ~s -> ~s" - " and the contract is ~s\n", [SigArgs, SigRet, Contract]) + io_lib:format("will never return since the success typing is ~ts -> ~ts" + " and the contract is ~ts\n", [SigArgs, SigRet, Contract]) end. form_positions(ArgNs) -> @@ -533,9 +533,9 @@ form_positions(ArgNs) -> form_expected_without_opaque([{N, T, TStr}]) -> case erl_types:t_is_opaque(T) of true -> - io_lib:format("an opaque term of type ~s as ", [TStr]); + io_lib:format("an opaque term of type ~ts as ", [TStr]); false -> - io_lib:format("a term of type ~s (with opaque subterms) as ", [TStr]) + io_lib:format("a term of type ~ts (with opaque subterms) as ", [TStr]) end ++ form_position_string([N]) ++ " argument"; form_expected_without_opaque(ExpectedTriples) -> %% TODO: can do much better here {ArgNs, _Ts, _TStrs} = lists:unzip3(ExpectedTriples), @@ -546,8 +546,8 @@ form_expected(ExpectedArgs) -> [T] -> TS = erl_types:t_to_string(T), case erl_types:t_is_opaque(T) of - true -> io_lib:format("an opaque term of type ~s is expected", [TS]); - false -> io_lib:format("a structured term of type ~s is expected", [TS]) + true -> io_lib:format("an opaque term of type ~ts is expected", [TS]); + false -> io_lib:format("a structured term of type ~ts is expected", [TS]) end; [_,_|_] -> "terms of different types are expected in these positions" end. diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl index a456d38e64..80c10183cf 100644 --- a/lib/dialyzer/src/dialyzer_cl_parse.erl +++ b/lib/dialyzer/src/dialyzer_cl_parse.erl @@ -82,7 +82,7 @@ cl(["--get_warnings"|T]) -> cl(["-D"|_]) -> cl_error("No defines specified after -D"); cl(["-D"++Define|T]) -> - Def = re:split(Define, "=", [{return, list}]), + Def = re:split(Define, "=", [{return, list}, unicode]), append_defines(Def), cl(T); cl(["-h"|_]) -> diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 538327d4d1..b4b1872c12 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -1093,7 +1093,7 @@ macro_loop(Options, Win, Box, MacroText, TermText, Frame) -> Fun = fun(X) -> Val = wxControlWithItems:getString(Box,X), - [MacroName|_] = re:split(Val, " ", [{return, list}]), + [MacroName|_] = re:split(Val, " ", [{return, list}, unicode]), list_to_atom(MacroName) end, Delete = [Fun(X) || X <- List], diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 47994fc35b..0fd99bbc04 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -772,6 +772,7 @@ tab_is_disj(K1, T1, T2) -> end. merge_tables(T1, T2) -> + ets:safe_fixtable(T1, true), tab_merge(ets:first(T1), T1, T2). tab_merge('$end_of_table', T1, T2) -> diff --git a/lib/dialyzer/src/typer.erl b/lib/dialyzer/src/typer.erl index bf5484e5f6..16b9c8a94a 100644 --- a/lib/dialyzer/src/typer.erl +++ b/lib/dialyzer/src/typer.erl @@ -74,7 +74,8 @@ -spec start() -> no_return(). start() -> -_ = io:setopts(standard_error, [{encoding,unicode}]), + _ = io:setopts(standard_error, [{encoding,unicode}]), + _ = io:setopts([{encoding,unicode}]), {Args, Analysis} = process_cl_args(), %% io:format("Args: ~p\n", [Args]), %% io:format("Analysis: ~p\n", [Analysis]), @@ -484,12 +485,12 @@ write_typed_file(File, Info) -> write_typed_file(File, Info, NewFileName) -> {ok, Binary} = file:read_file(File), - Chars = binary_to_list(Binary), + Chars = unicode:characters_to_list(Binary), write_typed_file(Chars, NewFileName, Info, 1, []), io:format(" Saved as: ~tp\n", [NewFileName]). write_typed_file(Chars, File, #info{functions = []}, _LNo, _Acc) -> - ok = file:write_file(File, list_to_binary(Chars), [append]); + ok = file:write_file(File, unicode:characters_to_binary(Chars), [append]); write_typed_file([Ch|Chs] = Chars, File, Info, LineNo, Acc) -> [{Line,F,A}|RestFuncs] = Info#info.functions, case Line of @@ -519,7 +520,7 @@ write_typed_file([Ch|Chs] = Chars, File, Info, LineNo, Acc) -> raw_write(F, A, Info, File, Content) -> TypeInfo = get_type_string(F, A, Info, file), ContentList = lists:reverse(Content) ++ TypeInfo ++ "\n", - ContentBin = list_to_binary(ContentList), + ContentBin = unicode:characters_to_binary(ContentList), file:write_file(File, ContentBin, [append]). get_type_string(F, A, Info, Mode) -> @@ -608,7 +609,7 @@ cl(["-D"++Def|Opts]) -> case Def of "" -> fatal_error("no variable name specified after -D"); _ -> - DefPair = process_def_list(re:split(Def, "=", [{return, list}])), + DefPair = process_def_list(re:split(Def, "=", [{return, list}, unicode])), {{def, DefPair}, Opts} end; cl(["-I",Dir|Opts]) -> {{inc, Dir}, Opts}; @@ -697,7 +698,7 @@ get_all_files(#args{files = Fs, files_r = Ds}) -> test_erl_file_exclude_ann(File) -> case is_erl_file(File) of true -> %% Exclude files ending with ".ann.erl" - case re:run(File, "[\.]ann[\.]erl$") of + case re:run(File, "[\.]ann[\.]erl$", [unicode]) of {match, _} -> false; nomatch -> true end; diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args index 1eb8cd455b..1be0ce0d8c 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args @@ -1,5 +1,5 @@ gen_server_incorrect_args.erl:3: Undefined callback function handle_cast/2 (behaviour gen_server) gen_server_incorrect_args.erl:3: Undefined callback function init/1 (behaviour gen_server) -gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer()} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer()} | {'stop',_,_,_}, which is the expected return type for the callback of the gen_server behaviour +gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer() | {'continue',_}} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer() | {'continue',_}} | {'stop',_,_,_}, which is the expected return type for the callback of the gen_server behaviour gen_server_incorrect_args.erl:7: The inferred type for the 2nd argument of handle_call/3 ('boo' | 'foo') is not a supertype of {pid(),_}, which is expected type for this argument in the callback of the gen_server behaviour diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index 4a1a7c25a0..866a82ee3e 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 3.2 +DIALYZER_VSN = 3.2.1 diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 2cbe48ecce..6b84b22eb5 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -397,10 +397,10 @@ from the peer offers it.</p> Note that each tuple communicates one or more AVP values. It is an error to specify duplicate tuples.</p> -<marker id="evaluable"/> +<marker id="eval"/> </item> -<tag><c>evaluable() = {M,F,A} | fun() | [evaluable() | A]</c></tag> +<tag><c>eval() = {M,F,A} | fun() | [eval() | A]</c></tag> <item> <p> An expression that can be evaluated as a function in the following @@ -418,7 +418,7 @@ eval(F) -> </pre> <p> -Applying an <c>&evaluable;</c> +Applying an <c>&eval;</c> <c>E</c> to an argument list <c>A</c> is meant in the sense of <c>eval([E|A])</c>.</p> @@ -484,11 +484,11 @@ Matches only those peers whose Origin-Realm has the specified value, or all peers if the atom <c>any</c>.</p> </item> -<tag><c>{eval, &evaluable;}</c></tag> +<tag><c>{eval, &eval;}</c></tag> <item> <p> Matches only those peers for which the specified -<c>&evaluable;</c> returns +<c>&eval;</c> returns <c>true</c> when applied to the connection's <c>diameter_caps</c> record. Any other return value or exception is equivalent to <c>false</c>.</p> @@ -650,7 +650,7 @@ Result = ResultCode | {capabilities_cb, CB, ResultCode|discard} Caps = #diameter_caps{} Pkt = #diameter_packet{} ResultCode = integer() -CB = &evaluable; +CB = &eval; </pre> <p> @@ -798,15 +798,31 @@ be matched by corresponding &capability; configuration, of </item> <tag> -<marker id="incoming_maxlen"/><c>{incoming_maxlen, 0..16777215}</c></tag> +<marker id="decode_format"/> +<c>{decode_format, record | list | map | none}</c></tag> <item> <p> -Bound on the expected size of incoming Diameter messages. -Messages larger than the specified number of bytes are discarded.</p> +The format of decoded messages and grouped AVPs in the <c>msg</c> field +of diameter_packet records and <c>value</c> field of diameter_avp +records respectively. +If <c>record</c> then a record whose definition is generated from the +dictionary file in question. +If <c>list</c> or <c>map</c> then a <c>[Name | Avps]</c> pair where +<c>Avps</c> is a list of AVP name/values pairs or a map keyed on +AVP names respectively. +If <c>none</c> then the atom-value message name, or <c>undefined</c> +for a Grouped AVP. +See also &codec_message;.</p> <p> -Defaults to <c>16777215</c>, the maximum value of the 24-bit Message -Length field in a Diameter Header.</p> +Defaults to <c>record</c>.</p> + +<note> +<p> +AVPs are decoded into a list of diameter_avp records in <c>avps</c> +field of diameter_packet records independently of +<c>decode_format</c>.</p> +</note> </item> @@ -814,7 +830,7 @@ Length field in a Diameter Header.</p> | node | nodes | [node()] - | evaluable()}</c></tag> + | eval()}</c></tag> <item> <p> The degree to which the service allows multiple transport @@ -825,7 +841,7 @@ at capabilities exchange.</p> If <c>[node()]</c> then a connection is rejected if another already exists on any of the specified nodes. Types <c>false</c>, <c>node</c>, <c>nodes</c> and -&evaluable; are equivalent to +&eval; are equivalent to <c>[]</c>, <c>[node()]</c>, <c>[node()|nodes()]</c> and the evaluated value respectively, evaluation of each expression taking place whenever a new connection is to be established. @@ -840,7 +856,7 @@ by their own peer and watchdog state machines.</p> Defaults to <c>nodes</c>.</p> </item> -<tag><c>{sequence, {H,N} | &evaluable;}</c></tag> +<tag><c>{sequence, {H,N} | &eval;}</c></tag> <item> <p> A constant value <c>H</c> for the topmost <c>32-N</c> bits of @@ -875,7 +891,7 @@ outgoing requests.</p> </warning> </item> -<tag><c>{share_peers, boolean() | [node()] | evaluable()}</c></tag> +<tag><c>{share_peers, boolean() | [node()] | eval()}</c></tag> <item> <p> Nodes to which peer connections established on the local @@ -888,7 +904,7 @@ configured to use them: see <c>use_shared_peers</c> below.</p> If <c>false</c> then peers are not shared. If <c>[node()]</c> then peers are shared with the specified list of nodes. -If <c>evaluable()</c> then peers are shared with the nodes returned +If <c>eval()</c> then peers are shared with the nodes returned by the specified function, evaluated whenever a peer connection becomes available or a remote service requests information about local connections. @@ -914,59 +930,36 @@ of a single Diameter node across multiple Erlang nodes.</p> </note> </item> -<tag><c>{spawn_opt, [term()]}</c></tag> -<item> -<p> -Options list passed to &spawn_opt; when spawning a process for an -incoming Diameter request, unless the transport in question -specifies another value. -Options <c>monitor</c> and <c>link</c> are ignored.</p> - -<p> -Defaults to the empty list.</p> -</item> - <tag> -<marker id="strict_mbit"/><c>{strict_mbit, boolean()}</c></tag> +<marker id="strict_arities"/><c>{strict_arities, boolean() + | encode + | decode}</c></tag> <item> <p> -Whether or not to regard an AVP setting the M-bit as erroneous when -the command grammar in question does not explicitly allow the AVP. -If <c>true</c> then such AVPs are regarded as 5001 errors, -DIAMETER_AVP_UNSUPPORTED. -If <c>false</c> then the M-bit is ignored and policing -it becomes the receiver's responsibility.</p> +Whether or not to require that the number of AVPs in a message or +grouped AVP agree with those specified in the dictionary in question +when passing messages to &man_app; callbacks. +If <c>true</c> then mismatches in an outgoing messages cause message +encoding to fail, while mismatches in an incoming message are reported +as 5005/5009 errors in the errors field of the diameter_packet record +passed to &app_handle_request; or &app_handle_answer; callbacks. +If <c>false</c> then neither error is enforced/detected. +If <c>encode</c> or <c>decode</c> then errors are only +enforced/detected on outgoing or incoming messages respectively.</p> <p> Defaults to <c>true</c>.</p> -<warning> -<p> -RFC 6733 is unclear about the semantics of the M-bit. -One the one hand, the CCF specification in section 3.2 documents AVP -in a command grammar as meaning <em>any</em> arbitrary AVP; on the -other hand, 1.3.4 states that AVPs setting the M-bit cannot be added -to an existing command: the modified command must instead be -placed in a new Diameter application.</p> -<p> -The reason for the latter is presumably interoperability: -allowing arbitrary AVPs setting the M-bit in a command makes its -interpretation implementation-dependent, since there's no -guarantee that all implementations will understand the same set of -arbitrary AVPs in the context of a given command. -However, interpreting <c>AVP</c> in a command grammar as any -AVP, regardless of M-bit, renders 1.3.4 meaningless, since the receiver -can simply ignore any AVP it thinks isn't relevant, regardless of the -sender's intent.</p> +<note> <p> -Beware of confusing mandatory in the sense of the M-bit with mandatory -in the sense of the command grammar. -The former is a semantic requirement: that the receiver understand the -semantics of the AVP in the context in question. -The latter is a syntactic requirement: whether or not the AVP must -occur in the message in question.</p> -</warning> - +Disabling arity checks affects the form of messages at encode/decode. +In particular, decoded AVPs are represented as lists of values, +regardless of the AVP's arity (ie. expected number in the message/AVP +grammar in question), and values are expected to be supplied as lists +at encode. +This differs from the historic decode behaviour of representing AVPs +of arity 1 as bare values, not wrapped in a list.</p> +</note> </item> <tag> @@ -993,7 +986,27 @@ The default value is for backwards compatibility.</p> </item> -<tag><c>{use_shared_peers, boolean() | [node()] | evaluable()}</c></tag> +<tag> +<marker id="traffic_counters"/><c>{traffic_counters, boolean()}</c></tag> +<item> +<p> +Whether or not to count application-specific messages; those for which +&man_app; callbacks take place. +If false then only messages handled by diameter itself are counted: +CER/CEA, DWR/DWA, DPR/DPA.</p> + +<p> +Defaults to <c>true</c>.</p> + +<note> +<p> +Disabling counters is a performance improvement, but means that the +omitted counters are not returned by &service_info;.</p> +</note> + +</item> + +<tag><c>{use_shared_peers, boolean() | [node()] | eval()}</c></tag> <item> <p> Nodes from which communicated peers are made available in @@ -1003,7 +1016,7 @@ the remote candidates list of &app_pick_peer; callbacks.</p> If <c>false</c> then remote peers are not used. If <c>[node()]</c> then only peers from the specified list of nodes are used. -If <c>evaluable()</c> then only peers returned by the specified +If <c>eval()</c> then only peers returned by the specified function are used, evaluated whenever a remote service communicates information about an available peer connection. The value <c>true</c> is equivalent to <c>fun &nodes;</c>. @@ -1028,6 +1041,15 @@ each node from which requests are sent.</p> </warning> </item> +<tag><c>&transport_opt;</c></tag> +<item> +<p> +Any transport option except <c>applications</c> or +<c>capabilities</c>. +Used as defaults for transport configuration, values passed to +&add_transport; overriding values configured on the service.</p> +</item> + </taglist> <marker id="transport_opt"/> @@ -1061,6 +1083,37 @@ implies having to set matching *-Application-Id AVPs in a </item> <tag> +<marker id="avp_dictionaries"/><c>{avp_dictionaries, [module()]}</c></tag> +<item> +<p> +A list of alternate dictionary modules with which to encode/decode +AVPs that are not defined by the dictionary of the application in +question. +At decode, such AVPs are represented as diameter_avp records in the +<c>'AVP'</c> field of a decoded message or Grouped AVP, the first +alternate that succeeds in decoding the AVP setting the record's value +field. +At encode, values in an <c>'AVP'</c> list can be passed as AVP +name/value 2-tuples, and it is an encode error for no alternate to +define the AVP of such a tuple.</p> + +<p> +Defaults to the empty list.</p> + +<note> +<p> +The motivation for alternate dictionaries is RFC 7683, Diameter +Overload Indication Conveyance (DOIC), which defines AVPs to +be piggybacked onto existing application messages rather than defining +an application of its own. +The DOIC dictionary is provided by the diameter application, as module +<c>diameter_gen_doic_rfc7683</c>, but alternate dictionaries can be +used to encode/decode any set of AVPs not known to an application +dictionary.</p> +</note> +</item> + +<tag> <marker id="capabilities"/><c>{capabilities, [&capability;]}</c></tag> <item> <p> @@ -1075,7 +1128,7 @@ TLS is desired over TCP as implemented by &man_tcp;.</p> </item> <tag> -<marker id="capabilities_cb"/><c>{capabilities_cb, &evaluable;}</c></tag> +<marker id="capabilities_cb"/><c>{capabilities_cb, &eval;}</c></tag> <item> <p> Callback invoked upon reception of CER/CEA during capabilities @@ -1169,7 +1222,7 @@ transport.</p> </item> <tag> -<marker id="disconnect_cb"/><c>{disconnect_cb, &evaluable;}</c></tag> +<marker id="disconnect_cb"/><c>{disconnect_cb, &eval;}</c></tag> <item> <p> Callback invoked prior to terminating the transport process of a @@ -1269,6 +1322,19 @@ Defaults to 5000.</p> </item> <tag> +<marker id="incoming_maxlen"/><c>{incoming_maxlen, 0..16777215}</c></tag> +<item> +<p> +Bound on the expected size of incoming Diameter messages. +Messages larger than the specified number of bytes are discarded.</p> + +<p> +Defaults to <c>16777215</c>, the maximum value of the 24-bit Message +Length field in a Diameter Header.</p> + +</item> + +<tag> <marker id="length_errors"/><c>{length_errors, exit|handle|discard}</c></tag> <item> <p> @@ -1326,7 +1392,64 @@ incoming Diameter request. Options <c>monitor</c> and <c>link</c> are ignored.</p> <p> -Defaults to the list configured on the service if not specified.</p> +Defaults to the empty list.</p> +</item> + +<tag> +<marker id="strict_capx"/><c>{strict_capx, boolean()]}</c></tag> +<item> +<p> +Whether or not to enforce the RFC 6733 requirement that any message +before capabilities exchange should close the peer connection. +If false then unexpected messages are discarded.</p> + +<p> +Defaults to true. +Changing this results in non-standard behaviour, but can be useful in +case peers are known to be behave badly.</p> +</item> + +<tag> +<marker id="strict_mbit"/><c>{strict_mbit, boolean()}</c></tag> +<item> +<p> +Whether or not to regard an AVP setting the M-bit as erroneous when +the command grammar in question does not explicitly allow the AVP. +If <c>true</c> then such AVPs are regarded as 5001 errors, +DIAMETER_AVP_UNSUPPORTED. +If <c>false</c> then the M-bit is ignored and policing +it becomes the receiver's responsibility.</p> + +<p> +Defaults to <c>true</c>.</p> + +<warning> +<p> +RFC 6733 is unclear about the semantics of the M-bit. +One the one hand, the CCF specification in section 3.2 documents AVP +in a command grammar as meaning <em>any</em> arbitrary AVP; on the +other hand, 1.3.4 states that AVPs setting the M-bit cannot be added +to an existing command: the modified command must instead be +placed in a new Diameter application.</p> +<p> +The reason for the latter is presumably interoperability: +allowing arbitrary AVPs setting the M-bit in a command makes its +interpretation implementation-dependent, since there's no +guarantee that all implementations will understand the same set of +arbitrary AVPs in the context of a given command. +However, interpreting <c>AVP</c> in a command grammar as any +AVP, regardless of M-bit, renders 1.3.4 meaningless, since the receiver +can simply ignore any AVP it thinks isn't relevant, regardless of the +sender's intent.</p> +<p> +Beware of confusing mandatory in the sense of the M-bit with mandatory +in the sense of the command grammar. +The former is a semantic requirement: that the receiver understand the +semantics of the AVP in the context in question. +The latter is a syntactic requirement: whether or not the AVP must +occur in the message in question.</p> +</warning> + </item> <tag> diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml index dfcd00975b..aa334beb21 100644 --- a/lib/diameter/doc/src/diameter_app.xml +++ b/lib/diameter/doc/src/diameter_app.xml @@ -13,7 +13,8 @@ <header> <copyright> -<year>2011</year><year>2016</year> +<year>2011</year> +<year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -319,7 +320,7 @@ or &peer_down; callback.</p> <v>Action = Send | Discard | {eval_packet, Action, PostF}</v> <v>Send = {send, &packet; | &message;}</v> <v>Discard = {discard, Reason} | discard</v> -<v>PostF = &mod_evaluable;}</v> +<v>PostF = &mod_eval;}</v> </type> <desc> <p> @@ -371,7 +372,7 @@ discarded}</c>.</p> <v>Action = Send | Discard | {eval_packet, Action, PostF}</v> <v>Send = {send, &packet; | &message;}</v> <v>Discard = {discard, Reason} | discard</v> -<v>PostF = &mod_evaluable;}</v> +<v>PostF = &mod_eval;}</v> </type> <desc> <p> @@ -478,7 +479,7 @@ not selected.</p> | {answer_message, 3000..3999|5000..5999} | {protocol_error, 3000..3999}</v> <v>Opt = &mod_call_opt;</v> -<v>PostF = &mod_evaluable;</v> +<v>PostF = &mod_eval;</v> </type> <desc> <p> diff --git a/lib/diameter/doc/src/diameter_codec.xml b/lib/diameter/doc/src/diameter_codec.xml index 0117c1c88a..5124b49484 100644 --- a/lib/diameter/doc/src/diameter_codec.xml +++ b/lib/diameter/doc/src/diameter_codec.xml @@ -4,7 +4,10 @@ '<seealso marker="diameter_dict#MESSAGE_RECORDS">diameter_dict(4)</seealso>'> <!ENTITY types '<seealso marker="diameter_dict#DATA_TYPES">diameter_dict(4)</seealso>'> - <!ENTITY % also SYSTEM "seealso.ent" > + <!ENTITY decode_format + '<seealso marker="diameter#decode_format">decode format</seealso>'> + +<!ENTITY % also SYSTEM "seealso.ent" > <!ENTITY % here SYSTEM "seehere.ent" > %also; %here; @@ -145,7 +148,8 @@ question.</p> <p> The decoded value of an AVP. Will be <c>undefined</c> on decode if the data bytes could -not be decoded or the AVP is unknown. +not be decoded, the AVP is unknown, or if the &decode_format; is +<c>none</c>. The type of a decoded value is as document in &types;.</p> </item> @@ -230,7 +234,8 @@ header.</p> </item> <tag> -<marker id="message"/><c>message() = record() | list()</c></tag> +<marker id="message"/><c>message() = record() + | maybe_improper_list()</c></tag> <item> <p> The representation of a Diameter message as passed to @@ -240,7 +245,10 @@ a message as defined in a dictionary file is encoded as a record with one field for each component AVP. Equivalently, a message can also be encoded as a list whose head is the atom-valued message name (as specified in the relevant dictionary -file) and whose tail is a list of <c>{AvpName, AvpValue}</c> pairs.</p> +file) and whose tail is either a list of AVP name/values +pairs or a map with values keyed on AVP names. +The format at decode is determined by &mod_decode_format;. +Any of the formats is accepted at encode.</p> <p> Another list-valued representation allows a message to be specified @@ -283,15 +291,16 @@ value other than <c>undefined</c>.</p> <item> <p> The incoming/outgoing message. -For an incoming message, a record if the message can be -decoded in a non-relay application, <c>undefined</c> otherwise. +For an incoming message, a term corresponding to the configured +&decode_format; if the message can be decoded in a non-relay +application, <c>undefined</c> otherwise. For an outgoing message, setting a <c>[&header; | &avp;]</c> list is equivalent to setting the <c>header</c> and <c>avps</c> fields to the corresponding values.</p> <warning> <p> -A record-valued <c>msg</c> field does <em>not</em> imply an absence of +A value in the <c>msg</c> field does <em>not</em> imply an absence of decode errors. The <c>errors</c> field should also be examined.</p> </warning> diff --git a/lib/diameter/doc/src/diameter_sctp.xml b/lib/diameter/doc/src/diameter_sctp.xml index 9b6d629f79..c9b74a9ec5 100644 --- a/lib/diameter/doc/src/diameter_sctp.xml +++ b/lib/diameter/doc/src/diameter_sctp.xml @@ -16,7 +16,7 @@ <header> <copyright> <year>2011</year> -<year>2016</year> +<year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -116,7 +116,6 @@ and port respectively.</p> Multiple <c>ip</c> options can be specified for a multihomed peer. If none are specified then the values of <c>Host-IP-Address</c> in the <c>diameter_service</c> record are used. -(In particular, one of these must be specified.) Option <c>port</c> defaults to 3868 for a listening transport and 0 for a connecting transport.</p> diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index 6ca280c52b..1d65d14257 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -170,14 +170,11 @@ that will not be forthcoming, which will eventually cause the RFC 3539 watchdog to take down the connection.</p> <p> -If an <c>ip</c> option is not specified then the first element of a -non-empty <c>Host-IP-Address</c> list in <c>Svc</c> provides the local -IP address. -If neither is specified then the default address selected by &gen_tcp; -is used. -In all cases, the selected address is either returned from -&start; or passed in a <c>connected</c> message over the transport -interface.</p> +The first element of a non-empty <c>Host-IP-Address</c> list in +<c>Svc</c> provides the local IP address if an <c>ip</c> option is not +specified. +The local address is either returned from&start; or passed in a +<c>connected</c> message over the transport interface.</p> </desc> </func> diff --git a/lib/diameter/doc/src/seealso.ent b/lib/diameter/doc/src/seealso.ent index e5c284c6e8..c5a53670d0 100644 --- a/lib/diameter/doc/src/seealso.ent +++ b/lib/diameter/doc/src/seealso.ent @@ -4,7 +4,7 @@ %CopyrightBegin% -Copyright Ericsson AB 2012-2015. All Rights Reserved. +Copyright Ericsson AB 2012-2017. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -53,7 +53,7 @@ significant. <!ENTITY mod_application_opt '<seealso marker="diameter#application_opt">diameter:application_opt()</seealso>'> <!ENTITY mod_call_opt '<seealso marker="diameter#call_opt">diameter:call_opt()</seealso>'> <!ENTITY mod_capability '<seealso marker="diameter#capability">diameter:capability()</seealso>'> -<!ENTITY mod_evaluable '<seealso marker="diameter#evaluable">diameter:evaluable()</seealso>'> +<!ENTITY mod_eval '<seealso marker="diameter#eval">diameter:eval()</seealso>'> <!ENTITY mod_peer_filter '<seealso marker="diameter#peer_filter">diameter:peer_filter()</seealso>'> <!ENTITY mod_service_event '<seealso marker="diameter#service_event">diameter:service_event()</seealso>'> <!ENTITY mod_service_event_info '<seealso marker="diameter#service_event_info">diameter:service_event_info()</seealso>'> @@ -72,6 +72,7 @@ significant. <!ENTITY watchdog_timer '<seealso marker="#watchdog_timer">watchdog_timer</seealso>'> <!ENTITY mod_string_decode '<seealso marker="diameter#service_opt">diameter:service_opt()</seealso> <seealso marker="diameter#string_decode">string_decode</seealso>'> +<!ENTITY mod_decode_format '<seealso marker="diameter#service_opt">diameter:service_opt()</seealso> <seealso marker="diameter#decode_format">decode_format</seealso>'> <!-- diameter_app --> diff --git a/lib/diameter/doc/standard/rfc7683.txt b/lib/diameter/doc/standard/rfc7683.txt new file mode 100644 index 0000000000..ab2392c6c0 --- /dev/null +++ b/lib/diameter/doc/standard/rfc7683.txt @@ -0,0 +1,2355 @@ + + + + + + +Internet Engineering Task Force (IETF) J. Korhonen, Ed. +Request for Comments: 7683 Broadcom Corporation +Category: Standards Track S. Donovan, Ed. +ISSN: 2070-1721 B. Campbell + Oracle + L. Morand + Orange Labs + October 2015 + + + Diameter Overload Indication Conveyance + +Abstract + + This specification defines a base solution for Diameter overload + control, referred to as Diameter Overload Indication Conveyance + (DOIC). + +Status of This Memo + + This is an Internet Standards Track document. + + This document is a product of the Internet Engineering Task Force + (IETF). It represents the consensus of the IETF community. It has + received public review and has been approved for publication by the + Internet Engineering Steering Group (IESG). Further information on + Internet Standards is available in Section 2 of RFC 5741. + + Information about the current status of this document, any errata, + and how to provide feedback on it may be obtained at + http://www.rfc-editor.org/info/rfc7683. + +Copyright Notice + + Copyright (c) 2015 IETF Trust and the persons identified as the + document authors. All rights reserved. + + This document is subject to BCP 78 and the IETF Trust's Legal + Provisions Relating to IETF Documents + (http://trustee.ietf.org/license-info) in effect on the date of + publication of this document. Please review these documents + carefully, as they describe your rights and restrictions with respect + to this document. Code Components extracted from this document must + include Simplified BSD License text as described in Section 4.e of + the Trust Legal Provisions and are provided without warranty as + described in the Simplified BSD License. + + + + + +Korhonen, et al. Standards Track [Page 1] + +RFC 7683 DOIC October 2015 + + +Table of Contents + + 1. Introduction . . . . . . . . . . . . . . . . . . . . . . . . 3 + 2. Terminology and Abbreviations . . . . . . . . . . . . . . . . 3 + 3. Conventions Used in This Document . . . . . . . . . . . . . . 5 + 4. Solution Overview . . . . . . . . . . . . . . . . . . . . . . 5 + 4.1. Piggybacking . . . . . . . . . . . . . . . . . . . . . . 6 + 4.2. DOIC Capability Announcement . . . . . . . . . . . . . . 7 + 4.3. DOIC Overload Condition Reporting . . . . . . . . . . . . 9 + 4.4. DOIC Extensibility . . . . . . . . . . . . . . . . . . . 11 + 4.5. Simplified Example Architecture . . . . . . . . . . . . . 12 + 5. Solution Procedures . . . . . . . . . . . . . . . . . . . . . 12 + 5.1. Capability Announcement . . . . . . . . . . . . . . . . . 12 + 5.1.1. Reacting Node Behavior . . . . . . . . . . . . . . . 13 + 5.1.2. Reporting Node Behavior . . . . . . . . . . . . . . . 13 + 5.1.3. Agent Behavior . . . . . . . . . . . . . . . . . . . 14 + 5.2. Overload Report Processing . . . . . . . . . . . . . . . 15 + 5.2.1. Overload Control State . . . . . . . . . . . . . . . 15 + 5.2.2. Reacting Node Behavior . . . . . . . . . . . . . . . 19 + 5.2.3. Reporting Node Behavior . . . . . . . . . . . . . . . 20 + 5.3. Protocol Extensibility . . . . . . . . . . . . . . . . . 22 + 6. Loss Algorithm . . . . . . . . . . . . . . . . . . . . . . . 23 + 6.1. Overview . . . . . . . . . . . . . . . . . . . . . . . . 23 + 6.2. Reporting Node Behavior . . . . . . . . . . . . . . . . . 24 + 6.3. Reacting Node Behavior . . . . . . . . . . . . . . . . . 24 + 7. Attribute Value Pairs . . . . . . . . . . . . . . . . . . . . 25 + 7.1. OC-Supported-Features AVP . . . . . . . . . . . . . . . . 25 + 7.2. OC-Feature-Vector AVP . . . . . . . . . . . . . . . . . . 25 + 7.3. OC-OLR AVP . . . . . . . . . . . . . . . . . . . . . . . 26 + 7.4. OC-Sequence-Number AVP . . . . . . . . . . . . . . . . . 26 + 7.5. OC-Validity-Duration AVP . . . . . . . . . . . . . . . . 26 + 7.6. OC-Report-Type AVP . . . . . . . . . . . . . . . . . . . 27 + 7.7. OC-Reduction-Percentage AVP . . . . . . . . . . . . . . . 27 + 7.8. AVP Flag Rules . . . . . . . . . . . . . . . . . . . . . 28 + 8. Error Response Codes . . . . . . . . . . . . . . . . . . . . 28 + 9. IANA Considerations . . . . . . . . . . . . . . . . . . . . . 29 + 9.1. AVP Codes . . . . . . . . . . . . . . . . . . . . . . . . 29 + 9.2. New Registries . . . . . . . . . . . . . . . . . . . . . 29 + 10. Security Considerations . . . . . . . . . . . . . . . . . . . 30 + 10.1. Potential Threat Modes . . . . . . . . . . . . . . . . . 30 + 10.2. Denial-of-Service Attacks . . . . . . . . . . . . . . . 31 + 10.3. Noncompliant Nodes . . . . . . . . . . . . . . . . . . . 32 + 10.4. End-to-End Security Issues . . . . . . . . . . . . . . . 32 + 11. References . . . . . . . . . . . . . . . . . . . . . . . . . 34 + 11.1. Normative References . . . . . . . . . . . . . . . . . . 34 + 11.2. Informative References . . . . . . . . . . . . . . . . . 34 + + + + + +Korhonen, et al. Standards Track [Page 2] + +RFC 7683 DOIC October 2015 + + + Appendix A. Issues Left for Future Specifications . . . . . . . 35 + A.1. Additional Traffic Abatement Algorithms . . . . . . . . . 35 + A.2. Agent Overload . . . . . . . . . . . . . . . . . . . . . 35 + A.3. New Error Diagnostic AVP . . . . . . . . . . . . . . . . 35 + Appendix B. Deployment Considerations . . . . . . . . . . . . . 35 + Appendix C. Considerations for Applications Integrating the DOIC + Solution . . . . . . . . . . . . . . . . . . . . . . 36 + C.1. Application Classification . . . . . . . . . . . . . . . 36 + C.2. Implications of Application Type Overload . . . . . . . . 37 + C.3. Request Transaction Classification . . . . . . . . . . . 38 + C.4. Request Type Overload Implications . . . . . . . . . . . 39 + Contributors . . . . . . . . . . . . . . . . . . . . . . . . . . 41 + Authors' Addresses . . . . . . . . . . . . . . . . . . . . . . . 42 + +1. Introduction + + This specification defines a base solution for Diameter overload + control, referred to as Diameter Overload Indication Conveyance + (DOIC), based on the requirements identified in [RFC7068]. + + This specification addresses Diameter overload control between + Diameter nodes that support the DOIC solution. The solution, which + is designed to apply to existing and future Diameter applications, + requires no changes to the Diameter base protocol [RFC6733] and is + deployable in environments where some Diameter nodes do not implement + the Diameter overload control solution defined in this specification. + + A new application specification can incorporate the overload control + mechanism specified in this document by making it mandatory to + implement for the application and referencing this specification + normatively. It is the responsibility of the Diameter application + designers to define how overload control mechanisms work on that + application. + + Note that the overload control solution defined in this specification + does not address all the requirements listed in [RFC7068]. A number + of features related to overload control are left for future + specifications. See Appendix A for a list of extensions that are + currently being considered. + +2. Terminology and Abbreviations + + Abatement + + Reaction to receipt of an overload report resulting in a reduction + in traffic sent to the reporting node. Abatement actions include + diversion and throttling. + + + + +Korhonen, et al. Standards Track [Page 3] + +RFC 7683 DOIC October 2015 + + + Abatement Algorithm + + An extensible method requested by reporting nodes and used by + reacting nodes to reduce the amount of traffic sent during an + occurrence of overload control. + + Diversion + + An overload abatement treatment where the reacting node selects + alternate destinations or paths for requests. + + Host-Routed Requests + + Requests that a reacting node knows will be served by a particular + host, either due to the presence of a Destination-Host Attribute + Value Pair (AVP) or by some other local knowledge on the part of + the reacting node. + + Overload Control State (OCS) + + Internal state maintained by a reporting or reacting node + describing occurrences of overload control. + + Overload Report (OLR) + + Overload control information for a particular overload occurrence + sent by a reporting node. + + Reacting Node + + A Diameter node that acts upon an overload report. + + Realm-Routed Requests + + Requests sent by a reacting node where the reacting node does not + know to which host the request will be routed. + + Reporting Node + + A Diameter node that generates an overload report. (This may or + may not be the overloaded node.) + + + + + + + + + + +Korhonen, et al. Standards Track [Page 4] + +RFC 7683 DOIC October 2015 + + + Throttling + + An abatement treatment that limits the number of requests sent by + the reacting node. Throttling can include a Diameter Client + choosing to not send requests, or a Diameter Agent or Server + rejecting requests with appropriate error responses. In both + cases, the result of the throttling is a permanent rejection of + the transaction. + +3. Conventions Used in This Document + + The key words "MUST", "MUST NOT", "REQUIRED", "SHALL", "SHALL NOT", + "SHOULD", "SHOULD NOT", "RECOMMENDED", "MAY", and "OPTIONAL" in this + document are to be interpreted as described in RFC 2119 [RFC2119]. + + The interpretation from RFC 2119 [RFC2119] does not apply for the + above listed words when they are not used in all caps. + +4. Solution Overview + + The Diameter Overload Information Conveyance (DOIC) solution allows + Diameter nodes to request that other Diameter nodes perform overload + abatement actions, that is, actions to reduce the load offered to the + overloaded node or realm. + + A Diameter node that supports DOIC is known as a "DOIC node". Any + Diameter node can act as a DOIC node, including Diameter Clients, + Diameter Servers, and Diameter Agents. DOIC nodes are further + divided into "Reporting Nodes" and "Reacting Nodes." A reporting + node requests overload abatement by sending Overload Reports (OLRs). + + A reacting node acts upon OLRs and performs whatever actions are + needed to fulfill the abatement requests included in the OLRs. A + reporting node may report overload on its own behalf or on behalf of + other nodes. Likewise, a reacting node may perform overload + abatement on its own behalf or on behalf of other nodes. + + A Diameter node's role as a DOIC node is independent of its Diameter + role. For example, Diameter Agents may act as DOIC nodes, even + though they are not endpoints in the Diameter sense. Since Diameter + enables bidirectional applications, where Diameter Servers can send + requests towards Diameter Clients, a given Diameter node can + simultaneously act as both a reporting node and a reacting node. + + Likewise, a Diameter Agent may act as a reacting node from the + perspective of upstream nodes, and a reporting node from the + perspective of downstream nodes. + + + + +Korhonen, et al. Standards Track [Page 5] + +RFC 7683 DOIC October 2015 + + + DOIC nodes do not generate new messages to carry DOIC-related + information. Rather, they "piggyback" DOIC information over existing + Diameter messages by inserting new AVPs into existing Diameter + requests and responses. Nodes indicate support for DOIC, and any + needed DOIC parameters, by inserting an OC-Supported-Features AVP + (Section 7.1) into existing requests and responses. Reporting nodes + send OLRs by inserting OC-OLR AVPs (Section 7.3). + + A given OLR applies to the Diameter realm and application of the + Diameter message that carries it. If a reporting node supports more + than one realm and/or application, it reports independently for each + combination of realm and application. Similarly, the OC-Supported- + Features AVP applies to the realm and application of the enclosing + message. This implies that a node may support DOIC for one + application and/or realm, but not another, and may indicate different + DOIC parameters for each application and realm for which it supports + DOIC. + + Reacting nodes perform overload abatement according to an agreed-upon + abatement algorithm. An abatement algorithm defines the meaning of + some of the parameters of an OLR and the procedures required for + overload abatement. An overload abatement algorithm separates + Diameter requests into two sets. The first set contains the requests + that are to undergo overload abatement treatment of either throttling + or diversion. The second set contains the requests that are to be + given normal routing treatment. This document specifies a single + "must-support" algorithm, namely, the "loss" algorithm (Section 6). + Future specifications may introduce new algorithms. + + Overload conditions may vary in scope. For example, a single + Diameter node may be overloaded, in which case, reacting nodes may + attempt to send requests to other destinations. On the other hand, + an entire Diameter realm may be overloaded, in which case, such + attempts would do harm. DOIC OLRs have a concept of "report type" + (Section 7.6), where the type defines such behaviors. Report types + are extensible. This document defines report types for overload of a + specific host and for overload of an entire realm. + + DOIC works through non-supporting Diameter Agents that properly pass + unknown AVPs unchanged. + +4.1. Piggybacking + + There is no new Diameter application defined to carry overload- + related AVPs. The overload control AVPs defined in this + specification have been designed to be piggybacked on top of existing + + + + + +Korhonen, et al. Standards Track [Page 6] + +RFC 7683 DOIC October 2015 + + + application messages. This is made possible by adding the optional + overload control AVPs OC-OLR and OC-Supported-Features into existing + commands. + + Reacting nodes indicate support for DOIC by including the + OC-Supported-Features AVP in all request messages originated or + relayed by the reacting node. + + Reporting nodes indicate support for DOIC by including the + OC-Supported-Features AVP in all answer messages that are originated + or relayed by the reporting node and that are in response to a + request that contained the OC-Supported-Features AVP. Reporting + nodes may include overload reports using the OC-OLR AVP in answer + messages. + + Note that the overload control solution does not have fixed server + and client roles. The DOIC node role is determined based on the + message type: whether the message is a request (i.e., sent by a + "reacting node") or an answer (i.e., sent by a "reporting node"). + Therefore, in a typical client-server deployment, the Diameter Client + may report its overload condition to the Diameter Server for any + Diameter-Server-initiated message exchange. An example of such is + the Diameter Server requesting a re-authentication from a Diameter + Client. + +4.2. DOIC Capability Announcement + + The DOIC solution supports the ability for Diameter nodes to + determine if other nodes in the path of a request support the + solution. This capability is referred to as DOIC Capability + Announcement (DCA) and is separate from the Diameter Capability + Exchange. + + The DCA mechanism uses the OC-Supported-Features AVPs to indicate the + Diameter overload features supported. + + The first node in the path of a Diameter request that supports the + DOIC solution inserts the OC-Supported-Features AVP in the request + message. + + The individual features supported by the DOIC nodes are indicated in + the OC-Feature-Vector AVP. Any semantics associated with the + features will be defined in extension specifications that introduce + the features. + + Note: As discussed elsewhere in the document, agents in the path + of the request can modify the OC-Supported-Features AVP. + + + + +Korhonen, et al. Standards Track [Page 7] + +RFC 7683 DOIC October 2015 + + + Note: The DOIC solution must support deployments where Diameter + Clients and/or Diameter Servers do not support the DOIC solution. + In this scenario, Diameter Agents that support the DOIC solution + may handle overload abatement for the non-supporting Diameter + nodes. In this case, the DOIC agent will insert the OC-Supported- + Features AVP in requests that do not already contain one, telling + the reporting node that there is a DOIC node that will handle + overload abatement. For transactions where there was an + OC-Supporting-Features AVP in the request, the agent will insert + the OC-Supported-Features AVP in answers, telling the reacting + node that there is a reporting node. + + The OC-Feature-Vector AVP will always contain an indication of + support for the loss overload abatement algorithm defined in this + specification (see Section 6). This ensures that a reporting node + always supports at least one of the advertised abatement algorithms + received in a request messages. + + The reporting node inserts the OC-Supported-Features AVP in all + answer messages to requests that contained the OC-Supported-Features + AVP. The contents of the reporting node's OC-Supported-Features AVP + indicate the set of Diameter overload features supported by the + reporting node. This specification defines one exception -- the + reporting node only includes an indication of support for one + overload abatement algorithm, independent of the number of overload + abatement algorithms actually supported by the reacting node. The + overload abatement algorithm indicated is the algorithm that the + reporting node intends to use should it enter an overload condition. + Reacting nodes can use the indicated overload abatement algorithm to + prepare for possible overload reports and must use the indicated + overload abatement algorithm if traffic reduction is actually + requested. + + Note that the loss algorithm defined in this document is a + stateless abatement algorithm. As a result, it does not require + any actions by reacting nodes prior to the receipt of an overload + report. Stateful abatement algorithms that base the abatement + logic on a history of request messages sent might require reacting + nodes to maintain state in advance of receiving an overload report + to ensure that the overload reports can be properly handled. + + While it should only be done in exceptional circumstances and not + during an active occurrence of overload, a reacting node that wishes + to transition to a different abatement algorithm can stop advertising + support for the algorithm indicated by the reporting node, as long as + support for the loss algorithm is always advertised. + + + + + +Korhonen, et al. Standards Track [Page 8] + +RFC 7683 DOIC October 2015 + + + The DCA mechanism must also allow the scenario where the set of + features supported by the sender of a request and by agents in the + path of a request differ. In this case, the agent can update the + OC-Supported-Features AVP to reflect the mixture of the two sets of + supported features. + + Note: The logic to determine if the content of the OC-Supported- + Features AVP should be changed is out of scope for this document, + as is the logic to determine the content of a modified + OC-Supported-Features AVP. These are left to implementation + decisions. Care must be taken not to introduce interoperability + issues for downstream or upstream DOIC nodes. As such, the agent + must act as a fully compliant reporting node to the downstream + reacting node and as a fully compliant reacting node to the + upstream reporting node. + +4.3. DOIC Overload Condition Reporting + + As with DOIC capability announcement, overload condition reporting + uses new AVPs (Section 7.3) to indicate an overload condition. + + The OC-OLR AVP is referred to as an overload report. The OC-OLR AVP + includes the type of report, a sequence number, the length of time + that the report is valid, and AVPs specific to the abatement + algorithm. + + Two types of overload reports are defined in this document: host + reports and realm reports. + + A report of type "HOST_REPORT" is sent to indicate the overload of a + specific host, identified by the Origin-Host AVP of the message + containing the OLR, for the Application-ID indicated in the + transaction. When receiving an OLR of type "HOST_REPORT", a reacting + node applies overload abatement treatment to the host-routed requests + identified by the overload abatement algorithm (as defined in + Section 2) sent for this application to the overloaded host. + + A report of type "REALM_REPORT" is sent to indicate the overload of a + realm for the Application-ID indicated in the transaction. The + overloaded realm is identified by the Destination-Realm AVP of the + message containing the OLR. When receiving an OLR of type + "REALM_REPORT", a reacting node applies overload abatement treatment + to realm-routed requests identified by the overload abatement + algorithm (as defined in Section 2) sent for this application to the + overloaded realm. + + + + + + +Korhonen, et al. Standards Track [Page 9] + +RFC 7683 DOIC October 2015 + + + This document assumes that there is a single source for realm reports + for a given realm, or that if multiple nodes can send realm reports, + that each such node has full knowledge of the overload state of the + entire realm. A reacting node cannot distinguish between receiving + realm reports from a single node or from multiple nodes. + + Note: Known issues exist if there are multiple sources for + overload reports that apply to the same Diameter entity. Reacting + nodes have no way of determining the source and, as such, will + treat them as coming from a single source. Variance in sequence + numbers between the two sources can then cause incorrect overload + abatement treatment to be applied for indeterminate periods of + time. + + Reporting nodes are responsible for determining the need for a + reduction of traffic. The method for making this determination is + implementation specific and depends on the type of overload report + being generated. A host report might be generated by tracking use of + resources required by the host to handle transactions for the + Diameter application. A realm report generally impacts the traffic + sent to multiple hosts and, as such, requires tracking the capacity + of all servers able to handle realm-routed requests for the + application and realm. + + Once a reporting node determines the need for a reduction in traffic, + it uses the DOIC-defined AVPs to report on the condition. These AVPs + are included in answer messages sent or relayed by the reporting + node. The reporting node indicates the overload abatement algorithm + that is to be used to handle the traffic reduction in the + OC-Supported-Features AVP. The OC-OLR AVP is used to communicate + information about the requested reduction. + + Reacting nodes, upon receipt of an overload report, apply the + overload abatement algorithm to traffic impacted by the overload + report. The method used to determine the requests that are to + receive overload abatement treatment is dependent on the abatement + algorithm. The loss abatement algorithm is defined in this document + (Section 6). Other abatement algorithms can be defined in extensions + to the DOIC solution. + + Two types of overload abatement treatment are defined, diversion and + throttling. Reacting nodes are responsible for determining which + treatment is appropriate for individual requests. + + As the conditions that lead to the generation of the overload report + change, the reporting node can send new overload reports requesting + greater reduction if the condition gets worse or less reduction if + the condition improves. The reporting node sends an overload report + + + +Korhonen, et al. Standards Track [Page 10] + +RFC 7683 DOIC October 2015 + + + with a duration of zero to indicate that the overload condition has + ended and abatement is no longer needed. + + The reacting node also determines when the overload report expires + based on the OC-Validity-Duration AVP in the overload report and + stops applying the abatement algorithm when the report expires. + + Note that erroneous overload reports can be used for DoS attacks. + This includes the ability to indicate that a significant reduction in + traffic, up to and including a request for no traffic, should be sent + to a reporting node. As such, care should be taken to verify the + sender of overload reports. + +4.4. DOIC Extensibility + + The DOIC solution is designed to be extensible. This extensibility + is based on existing Diameter-based extensibility mechanisms, along + with the DOIC capability announcement mechanism. + + There are multiple categories of extensions that are expected. This + includes the definition of new overload abatement algorithms, the + definition of new report types, and the definition of new scopes of + messages impacted by an overload report. + + A DOIC node communicates supported features by including them in the + OC-Feature-Vector AVP, as a sub-AVP of OC-Supported-Features. Any + non-backwards-compatible DOIC extensions define new values for the + OC-Feature-Vector AVP. DOIC extensions also have the ability to add + new AVPs to the OC-Supported-Features AVP, if additional information + about the new feature is required. + + Overload reports can also be extended by adding new sub-AVPs to the + OC-OLR AVP, allowing reporting nodes to communicate additional + information about handling an overload condition. + + If necessary, new extensions can also define new AVPs that are not + part of the OC-Supported-Features and OC-OLR group AVPs. It is, + however, recommended that DOIC extensions use the OC-Supported- + Features AVP and OC-OLR AVP to carry all DOIC-related AVPs. + + + + + + + + + + + + +Korhonen, et al. Standards Track [Page 11] + +RFC 7683 DOIC October 2015 + + +4.5. Simplified Example Architecture + + Figure 1 illustrates the simplified architecture for Diameter + overload information conveyance. + + Realm X Same or other Realms + <--------------------------------------> <----------------------> + + + +--------+ : (optional) : + |Diameter| : : + |Server A|--+ .--. : +--------+ : .--. + +--------+ | _( `. : |Diameter| : _( `. +--------+ + +--( )--:-| Agent |-:--( )--|Diameter| + +--------+ | ( ` . ) ) : +--------+ : ( ` . ) ) | Client | + |Diameter|--+ `--(___.-' : : `--(___.-' +--------+ + |Server B| : : + +--------+ : : + + End-to-end Overload Indication + 1) <-----------------------------------------------> + Diameter Application Y + + Overload Indication A Overload Indication A' + 2) <----------------------> <----------------------> + Diameter Application Y Diameter Application Y + + Figure 1: Simplified Architecture Choices for Overload Indication + Delivery + + In Figure 1, the Diameter overload indication can be conveyed (1) + end-to-end between servers and clients or (2) between servers and the + Diameter Agent inside the realm and then between the Diameter Agent + and the clients. + +5. Solution Procedures + + This section outlines the normative behavior for the DOIC solution. + +5.1. Capability Announcement + + This section defines DOIC Capability Announcement (DCA) behavior. + + Note: This specification assumes that changes in DOIC node + capabilities are relatively rare events that occur as a result of + administrative action. Reacting nodes ought to minimize changes + that force the reporting node to change the features being used, + especially during active overload conditions. But even if + + + +Korhonen, et al. Standards Track [Page 12] + +RFC 7683 DOIC October 2015 + + + reacting nodes avoid such changes, reporting nodes still have to + be prepared for them to occur. For example, differing + capabilities between multiple reacting nodes may still force a + reporting node to select different features on a per-transaction + basis. + +5.1.1. Reacting Node Behavior + + A reacting node MUST include the OC-Supported-Features AVP in all + requests. It MAY include the OC-Feature-Vector AVP, as a sub-AVP of + OC-Supported-Features. If it does so, it MUST indicate support for + the "loss" algorithm. If the reacting node is configured to support + features (including other algorithms) in addition to the loss + algorithm, it MUST indicate such support in an OC-Feature-Vector AVP. + + An OC-Supported-Features AVP in answer messages indicates there is a + reporting node for the transaction. The reacting node MAY take + action, for example, creating state for some stateful abatement + algorithm, based on the features indicated in the OC-Feature-Vector + AVP. + + Note: The loss abatement algorithm does not require stateful + behavior when there is no active overload report. + + Reacting nodes need to be prepared for the reporting node to change + selected algorithms. This can happen at any time, including when the + reporting node has sent an active overload report. The reacting node + can minimize the potential for changes by modifying the advertised + abatement algorithms sent to an overloaded reporting node to the + currently selected algorithm and loss (or just loss if it is the + currently selected algorithm). This has the effect of limiting the + potential change in abatement algorithm from the currently selected + algorithm to loss, avoiding changes to more complex abatement + algorithms that require state to operate properly. + +5.1.2. Reporting Node Behavior + + Upon receipt of a request message, a reporting node determines if + there is a reacting node for the transaction based on the presence of + the OC-Supported-Features AVP in the request message. + + If the request message contains an OC-Supported-Features AVP, then a + reporting node MUST include the OC-Supported-Features AVP in the + answer message for that transaction. + + Note: Capability announcement is done on a per-transaction basis. + The reporting node cannot assume that the capabilities announced + by a reacting node will be the same between transactions. + + + +Korhonen, et al. Standards Track [Page 13] + +RFC 7683 DOIC October 2015 + + + A reporting node MUST NOT include the OC-Supported-Features AVP, + OC-OLR AVP, or any other overload control AVPs defined in extension + documents in response messages for transactions where the request + message does not include the OC-Supported-Features AVP. Lack of the + OC-Supported-Features AVP in the request message indicates that there + is no reacting node for the transaction. + + A reporting node knows what overload control functionality is + supported by the reacting node based on the content or absence of the + OC-Feature-Vector AVP within the OC-Supported-Features AVP in the + request message. + + A reporting node MUST select a single abatement algorithm in the + OC-Feature-Vector AVP. The abatement algorithm selected MUST + indicate the abatement algorithm the reporting node wants the + reacting node to use when the reporting node enters an overload + condition. + + The abatement algorithm selected MUST be from the set of abatement + algorithms contained in the request message's OC-Feature-Vector AVP. + + A reporting node that selects the loss algorithm may do so by + including the OC-Feature-Vector AVP with an explicit indication of + the loss algorithm, or it MAY omit the OC-Feature-Vector AVP. If it + selects a different algorithm, it MUST include the OC-Feature-Vector + AVP with an explicit indication of the selected algorithm. + + The reporting node SHOULD indicate support for other DOIC features + defined in extension documents that it supports and that apply to the + transaction. It does so using the OC-Feature-Vector AVP. + + Note: Not all DOIC features will apply to all Diameter + applications or deployment scenarios. The features included in + the OC-Feature-Vector AVP are based on local policy of the + reporting node. + +5.1.3. Agent Behavior + + Diameter Agents that support DOIC can ensure that all messages + relayed by the agent contain the OC-Supported-Features AVP. + + A Diameter Agent MAY take on reacting node behavior for Diameter + endpoints that do not support the DOIC solution. A Diameter Agent + detects that a Diameter endpoint does not support DOIC reacting node + behavior when there is no OC-Supported-Features AVP in a request + message. + + + + + +Korhonen, et al. Standards Track [Page 14] + +RFC 7683 DOIC October 2015 + + + For a Diameter Agent to be a reacting node for a non-supporting + Diameter endpoint, the Diameter Agent MUST include the OC-Supported- + Features AVP in request messages it relays that do not contain the + OC-Supported-Features AVP. + + A Diameter Agent MAY take on reporting node behavior for Diameter + endpoints that do not support the DOIC solution. The Diameter Agent + MUST have visibility to all traffic destined for the non-supporting + host in order to become the reporting node for the Diameter endpoint. + A Diameter Agent detects that a Diameter endpoint does not support + DOIC reporting node behavior when there is no OC-Supported-Features + AVP in an answer message for a transaction that contained the + OC-Supported-Features AVP in the request message. + + If a request already has the OC-Supported-Features AVP, a Diameter + Agent MAY modify it to reflect the features appropriate for the + transaction. Otherwise, the agent relays the OC-Supported-Features + AVP without change. + + Example: If the agent supports a superset of the features reported + by the reacting node, then the agent might choose, based on local + policy, to advertise that superset of features to the reporting + node. + + If the Diameter Agent changes the OC-Supported-Features AVP in a + request message, then it is likely it will also need to modify the + OC-Supported-Features AVP in the answer message for the transaction. + A Diameter Agent MAY modify the OC-Supported-Features AVP carried in + answer messages. + + When making changes to the OC-Supported-Features or OC-OLR AVPs, the + Diameter Agent needs to ensure consistency in its behavior with both + upstream and downstream DOIC nodes. + +5.2. Overload Report Processing + +5.2.1. Overload Control State + + Both reacting and reporting nodes maintain Overload Control State + (OCS) for active overload conditions. The following sections define + behavior associated with that OCS. + + The contents of the OCS in the reporting node and in the reacting + node represent logical constructs. The actual internal physical + structure of the state included in the OCS is an implementation + decision. + + + + + +Korhonen, et al. Standards Track [Page 15] + +RFC 7683 DOIC October 2015 + + +5.2.1.1. Overload Control State for Reacting Nodes + + A reacting node maintains the following OCS per supported Diameter + application: + + o a host-type OCS entry for each Destination-Host to which it sends + host-type requests and + + o a realm-type OCS entry for each Destination-Realm to which it + sends realm-type requests. + + A host-type OCS entry is identified by the pair of Application-ID and + the node's DiameterIdentity. + + A realm-type OCS entry is identified by the pair of Application-ID + and realm. + + The host-type and realm-type OCS entries include the following + information (the actual information stored is an implementation + decision): + + o Sequence number (as received in OC-OLR; see Section 7.3) + + o Time of expiry (derived from OC-Validity-Duration AVP received in + the OC-OLR AVP and time of reception of the message carrying + OC-OLR AVP) + + o Selected abatement algorithm (as received in the OC-Supported- + Features AVP) + + o Input data that is abatement algorithm specific (as received in + the OC-OLR AVP -- for example, OC-Reduction-Percentage for the + loss abatement algorithm) + +5.2.1.2. Overload Control State for Reporting Nodes + + A reporting node maintains OCS entries per supported Diameter + application, per supported (and eventually selected) abatement + algorithm, and per report type. + + An OCS entry is identified by the tuple of Application-ID, report + type, and abatement algorithm, and it includes the following + information (the actual information stored is an implementation + decision): + + o Sequence number + + o Validity duration + + + +Korhonen, et al. Standards Track [Page 16] + +RFC 7683 DOIC October 2015 + + + o Expiration time + + o Input data that is algorithm specific (for example, the reduction + percentage for the loss abatement algorithm) + +5.2.1.3. Reacting Node's Maintenance of Overload Control State + + When a reacting node receives an OC-OLR AVP, it MUST determine if it + is for an existing or new overload condition. + + Note: For the remainder of this section, the term "OLR" refers to + the combination of the contents of the received OC-OLR AVP and the + abatement algorithm indicated in the received OC-Supported- + Features AVP. + + When receiving an answer message with multiple OLRs of different + supported report types, a reacting node MUST process each received + OLR. + + The OLR is for an existing overload condition if a reacting node has + an OCS that matches the received OLR. + + For a host report, this means it matches the Application-ID and the + host's DiameterIdentity in an existing host OCS entry. + + For a realm report, this means it matches the Application-ID and the + realm in an existing realm OCS entry. + + If the OLR is for an existing overload condition, then a reacting + node MUST determine if the OLR is a retransmission or an update to + the existing OLR. + + If the sequence number for the received OLR is greater than the + sequence number stored in the matching OCS entry, then a reacting + node MUST update the matching OCS entry. + + If the sequence number for the received OLR is less than or equal to + the sequence number in the matching OCS entry, then a reacting node + MUST silently ignore the received OLR. The matching OCS MUST NOT be + updated in this case. + + If the reacting node determines that the sequence number has rolled + over, then the reacting node MUST update the matching OCS entry. + This can be determined by recognizing that the number has changed + from a value within 1% of the maximum value in the OC-Sequence-Number + AVP to a value within 1% of the minimum value in the OC-Sequence- + Number AVP. + + + + +Korhonen, et al. Standards Track [Page 17] + +RFC 7683 DOIC October 2015 + + + If the received OLR is for a new overload condition, then a reacting + node MUST generate a new OCS entry for the overload condition. + + For a host report, this means a reacting node creates an OCS entry + with the Application-ID in the received message and DiameterIdentity + of the Origin-Host in the received message. + + Note: This solution assumes that the Origin-Host AVP in the answer + message included by the reporting node is not changed along the + path to the reacting node. + + For a realm report, this means a reacting node creates an OCS entry + with the Application-ID in the received message and realm of the + Origin-Realm in the received message. + + If the received OLR contains a validity duration of zero ("0"), then + a reacting node MUST update the OCS entry as being expired. + + Note: It is not necessarily appropriate to delete the OCS entry, + as the recommended behavior is that the reacting node slowly + returns to full traffic when ending an overload abatement period. + + The reacting node does not delete an OCS when receiving an answer + message that does not contain an OC-OLR AVP (i.e., absence of OLR + means "no change"). + +5.2.1.4. Reporting Node's Maintenance of Overload Control State + + A reporting node SHOULD create a new OCS entry when entering an + overload condition. + + Note: If a reporting node knows through absence of the + OC-Supported-Features AVP in received messages that there are no + reacting nodes supporting DOIC, then the reporting node can choose + to not create OCS entries. + + When generating a new OCS entry, the sequence number SHOULD be set to + zero ("0"). + + When generating sequence numbers for new overload conditions, the new + sequence number MUST be greater than any sequence number in an active + (unexpired) overload report for the same application and report type + previously sent by the reporting node. This property MUST hold over + a reboot of the reporting node. + + + + + + + +Korhonen, et al. Standards Track [Page 18] + +RFC 7683 DOIC October 2015 + + + Note: One way of addressing this over a reboot of a reporting node + is to use a timestamp for the first overload condition that occurs + after the report and to start using sequences beginning with zero + for subsequent overload conditions. + + A reporting node MUST update an OCS entry when it needs to adjust the + validity duration of the overload condition at reacting nodes. + + Example: If a reporting node wishes to instruct reacting nodes to + continue overload abatement for a longer period of time than + originally communicated. This also applies if the reporting node + wishes to shorten the period of time that overload abatement is to + continue. + + A reporting node MUST update an OCS entry when it wishes to adjust + any parameters specific to the abatement algorithm, including, for + example, the reduction percentage used for the loss abatement + algorithm. + + Example: If a reporting node wishes to change the reduction + percentage either higher (if the overload condition has worsened) + or lower (if the overload condition has improved), then the + reporting node would update the appropriate OCS entry. + + A reporting node MUST increment the sequence number associated with + the OCS entry anytime the contents of the OCS entry are changed. + This will result in a new sequence number being sent to reacting + nodes, instructing them to process the OC-OLR AVP. + + A reporting node SHOULD update an OCS entry with a validity duration + of zero ("0") when the overload condition ends. + + Note: If a reporting node knows that the OCS entries in the + reacting nodes are near expiration, then the reporting node might + decide not to send an OLR with a validity duration of zero. + + A reporting node MUST keep an OCS entry with a validity duration of + zero ("0") for a period of time long enough to ensure that any + unexpired reacting node's OCS entry created as a result of the + overload condition in the reporting node is deleted. + +5.2.2. Reacting Node Behavior + + When a reacting node sends a request, it MUST determine if that + request matches an active OCS. + + + + + + +Korhonen, et al. Standards Track [Page 19] + +RFC 7683 DOIC October 2015 + + + If the request matches an active OCS, then the reacting node MUST use + the overload abatement algorithm indicated in the OCS to determine if + the request is to receive overload abatement treatment. + + For the loss abatement algorithm defined in this specification, see + Section 6 for the overload abatement algorithm logic applied. + + If the overload abatement algorithm selects the request for overload + abatement treatment, then the reacting node MUST apply overload + abatement treatment on the request. The abatement treatment applied + depends on the context of the request. + + If diversion abatement treatment is possible (i.e., a different path + for the request can be selected where the overloaded node is not part + of the different path), then the reacting node SHOULD apply diversion + abatement treatment to the request. The reacting node MUST apply + throttling abatement treatment to requests identified for abatement + treatment when diversion treatment is not possible or was not + applied. + + Note: This only addresses the case where there are two defined + abatement treatments, diversion and throttling. Any extension + that defines a new abatement treatment must also define its + interaction with existing treatments. + + If the overload abatement treatment results in throttling of the + request and if the reacting node is an agent, then the agent MUST + send an appropriate error as defined in Section 8. + + Diameter endpoints that throttle requests need to do so according to + the rules of the client application. Those rules will vary by + application and are beyond the scope of this document. + + In the case that the OCS entry indicated no traffic was to be sent to + the overloaded entity and the validity duration expires, then + overload abatement associated with the overload report MUST be ended + in a controlled fashion. + +5.2.3. Reporting Node Behavior + + If there is an active OCS entry, then a reporting node SHOULD include + the OC-OLR AVP in all answers to requests that contain the + OC-Supported-Features AVP and that match the active OCS entry. + + Note: A request matches 1) if the Application-ID in the request + matches the Application-ID in any active OCS entry and 2) if the + report type in the OCS entry matches a report type supported by + the reporting node as indicated in the OC-Supported-Features AVP. + + + +Korhonen, et al. Standards Track [Page 20] + +RFC 7683 DOIC October 2015 + + + The contents of the OC-OLR AVP depend on the selected algorithm. + + A reporting node MAY choose to not resend an overload report to a + reacting node if it can guarantee that this overload report is + already active in the reacting node. + + Note: In some cases (e.g., when there are one or more agents in + the path between reporting and reacting nodes, or when overload + reports are discarded by reacting nodes), a reporting node may not + be able to guarantee that the reacting node has received the + report. + + A reporting node MUST NOT send overload reports of a type that has + not been advertised as supported by the reacting node. + + Note: A reacting node implicitly advertises support for the host + and realm report types by including the OC-Supported-Features AVP + in the request. Support for other report types will be explicitly + indicated by new feature bits in the OC-Feature-Vector AVP. + + A reporting node SHOULD explicitly indicate the end of an overload + occurrence by sending a new OLR with OC-Validity-Duration set to a + value of zero ("0"). The reporting node SHOULD ensure that all + reacting nodes receive the updated overload report. + + A reporting node MAY rely on the OC-Validity-Duration AVP values for + the implicit cleanup of overload control state on the reacting node. + + Note: All OLRs sent have an expiration time calculated by adding + the validity duration contained in the OLR to the time the message + was sent. Transit time for the OLR can be safely ignored. The + reporting node can ensure that all reacting nodes have received + the OLR by continuing to send it in answer messages until the + expiration time for all OLRs sent for that overload condition have + expired. + + When a reporting node sends an OLR, it effectively delegates any + necessary throttling to downstream nodes. If the reporting node also + locally throttles the same set of messages, the overall number of + throttled requests may be higher than intended. Therefore, before + applying local message throttling, a reporting node needs to check if + these messages match existing OCS entries, indicating that these + messages have survived throttling applied by downstream nodes that + have received the related OLR. + + However, even if the set of messages match existing OCS entries, the + reporting node can still apply other abatement methods such as + diversion. The reporting node might also need to throttle requests + + + +Korhonen, et al. Standards Track [Page 21] + +RFC 7683 DOIC October 2015 + + + for reasons other than overload. For example, an agent or server + might have a configured rate limit for each client and might throttle + requests that exceed that limit, even if such requests had already + been candidates for throttling by downstream nodes. The reporting + node also has the option to send new OLRs requesting greater + reductions in traffic, reducing the need for local throttling. + + A reporting node SHOULD decrease requested overload abatement + treatment in a controlled fashion to avoid oscillations in traffic. + + Example: A reporting node might wait some period of time after + overload ends before terminating the OLR, or it might send a + series of OLRs indicating progressively less overload severity. + +5.3. Protocol Extensibility + + The DOIC solution can be extended. Types of potential extensions + include new traffic abatement algorithms, new report types, or other + new functionality. + + When defining a new extension that requires new normative behavior, + the specification must define a new feature for the OC-Feature-Vector + AVP. This feature bit is used to communicate support for the new + feature. + + The extension may define new AVPs for use in the DOIC Capability + Announcement and for use in DOIC overload reporting. These new AVPs + SHOULD be defined to be extensions to the OC-Supported-Features or + OC-OLR AVPs defined in this document. + + The Grouped AVP extension mechanisms defined in [RFC6733] apply. + This allows, for example, defining a new feature that is mandatory to + be understood even when piggybacked on an existing application. + + When defining new report type values, the corresponding specification + must define the semantics of the new report types and how they affect + the OC-OLR AVP handling. + + The OC-Supported-Feature and OC-OLR AVPs can be expanded with + optional sub-AVPs only if a legacy DOIC implementation can safely + ignore them without breaking backward compatibility for the given + OC-Report-Type AVP value. Any new sub-AVPs must not require that the + M-bit be set. + + Documents that introduce new report types must describe any + limitations on their use across non-supporting agents. + + + + + +Korhonen, et al. Standards Track [Page 22] + +RFC 7683 DOIC October 2015 + + + As with any Diameter specification, RFC 6733 requires all new AVPs to + be registered with IANA. See Section 9 for the required procedures. + New features (feature bits in the OC-Feature-Vector AVP) and report + types (in the OC-Report-Type AVP) MUST be registered with IANA. + +6. Loss Algorithm + + This section documents the Diameter overload loss abatement + algorithm. + +6.1. Overview + + The DOIC specification supports the ability for multiple overload + abatement algorithms to be specified. The abatement algorithm used + for any instance of overload is determined by the DOIC Capability + Announcement process documented in Section 5.1. + + The loss algorithm described in this section is the default algorithm + that must be supported by all Diameter nodes that support DOIC. + + The loss algorithm is designed to be a straightforward and stateless + overload abatement algorithm. It is used by reporting nodes to + request a percentage reduction in the amount of traffic sent. The + traffic impacted by the requested reduction depends on the type of + overload report. + + Reporting nodes request the stateless reduction of the number of + requests by an indicated percentage. This percentage reduction is in + comparison to the number of messages the node otherwise would send, + regardless of how many requests the node might have sent in the past. + + From a conceptual level, the logic at the reacting node could be + outlined as follows. + + 1. An overload report is received, and the associated OCS is either + saved or updated (if required) by the reacting node. + + 2. A new Diameter request is generated by the application running on + the reacting node. + + 3. The reacting node determines that an active overload report + applies to the request, as indicated by the corresponding OCS + entry. + + 4. The reacting node determines if overload abatement treatment + should be applied to the request. One approach that could be + taken for each request is to select a uniformly selected random + number between 1 and 100. If the random number is less than or + + + +Korhonen, et al. Standards Track [Page 23] + +RFC 7683 DOIC October 2015 + + + equal to the indicated reduction percentage, then the request is + given abatement treatment; otherwise, the request is given normal + routing treatment. + +6.2. Reporting Node Behavior + + The method a reporting node uses to determine the amount of traffic + reduction required to address an overload condition is an + implementation decision. + + When a reporting node that has selected the loss abatement algorithm + determines the need to request a reduction in traffic, it includes an + OC-OLR AVP in answer messages as described in Section 5.2.3. + + When sending the OC-OLR AVP, the reporting node MUST indicate a + percentage reduction in the OC-Reduction-Percentage AVP. + + The reporting node MAY change the reduction percentage in subsequent + overload reports. When doing so, the reporting node must conform to + overload report handling specified in Section 5.2.3. + +6.3. Reacting Node Behavior + + The method a reacting node uses to determine which request messages + are given abatement treatment is an implementation decision. + + When receiving an OC-OLR in an answer message where the algorithm + indicated in the OC-Supported-Features AVP is the loss algorithm, the + reacting node MUST apply abatement treatment to the requested + percentage of request messages sent. + + Note: The loss algorithm is a stateless algorithm. As a result, + the reacting node does not guarantee that there will be an + absolute reduction in traffic sent. Rather, it guarantees that + the requested percentage of new requests will be given abatement + treatment. + + If the reacting node comes out of the 100% traffic reduction + (meaning, it has received an OLR indicating that no traffic should be + sent, as a result of the overload report timing out), the reacting + node sending the traffic SHOULD be conservative and, for example, + first send "probe" messages to learn the overload condition of the + overloaded node before converging to any traffic amount/rate decided + by the sender. Similar concerns apply in all cases when the overload + report times out, unless the previous overload report stated 0% + reduction. + + + + + +Korhonen, et al. Standards Track [Page 24] + +RFC 7683 DOIC October 2015 + + + Note: The goal of this behavior is to reduce the probability of + overload condition thrashing where an immediate transition from + 100% reduction to 0% reduction results in the reporting node + moving quickly back into an overload condition. + +7. Attribute Value Pairs + + This section describes the encoding and semantics of the Diameter + Overload Indication Attribute Value Pairs (AVPs) defined in this + document. + + Refer to Section 4 of [RFC6733] for more information on AVPs and AVP + data types. + +7.1. OC-Supported-Features AVP + + The OC-Supported-Features AVP (AVP Code 621) is of type Grouped and + serves two purposes. First, it announces a node's support for the + DOIC solution in general. Second, it contains the description of the + supported DOIC features of the sending node. The OC-Supported- + Features AVP MUST be included in every Diameter request message a + DOIC supporting node sends. + + OC-Supported-Features ::= < AVP Header: 621 > + [ OC-Feature-Vector ] + * [ AVP ] + +7.2. OC-Feature-Vector AVP + + The OC-Feature-Vector AVP (AVP Code 622) is of type Unsigned64 and + contains a 64-bit flags field of announced capabilities of a DOIC + node. The value of zero (0) is reserved. + + The OC-Feature-Vector sub-AVP is used to announce the DOIC features + supported by the DOIC node, in the form of a flag-bits field in which + each bit announces one feature or capability supported by the node. + The absence of the OC-Feature-Vector AVP in request messages + indicates that only the default traffic abatement algorithm described + in this specification is supported. The absence of the OC-Feature- + Vector AVP in answer messages indicates that the default traffic + abatement algorithm described in this specification is selected + (while other traffic abatement algorithms may be supported), and no + features other than abatement algorithms are supported. + + + + + + + + +Korhonen, et al. Standards Track [Page 25] + +RFC 7683 DOIC October 2015 + + + The following capability is defined in this document: + + OLR_DEFAULT_ALGO (0x0000000000000001) + + When this flag is set by the a DOIC reacting node, it means that + the default traffic abatement (loss) algorithm is supported. When + this flag is set by a DOIC reporting node, it means that the loss + algorithm will be used for requested overload abatement. + +7.3. OC-OLR AVP + + The OC-OLR AVP (AVP Code 623) is of type Grouped and contains the + information necessary to convey an overload report on an overload + condition at the reporting node. The application the OC-OLR AVP + applies to is identified by the Application-ID found in the Diameter + message header. The host or realm the OC-OLR AVP concerns is + determined from the Origin-Host AVP and/or Origin-Realm AVP found in + the encapsulating Diameter command. The OC-OLR AVP is intended to be + sent only by a reporting node. + + OC-OLR ::= < AVP Header: 623 > + < OC-Sequence-Number > + < OC-Report-Type > + [ OC-Reduction-Percentage ] + [ OC-Validity-Duration ] + * [ AVP ] + +7.4. OC-Sequence-Number AVP + + The OC-Sequence-Number AVP (AVP Code 624) is of type Unsigned64. Its + usage in the context of overload control is described in Section 5.2. + + From the functionality point of view, the OC-Sequence-Number AVP is + used as a nonvolatile increasing counter for a sequence of overload + reports between two DOIC nodes for the same overload occurrence. + Sequence numbers are treated in a unidirectional manner, i.e., two + sequence numbers in each direction between two DOIC nodes are not + related or correlated. + +7.5. OC-Validity-Duration AVP + + The OC-Validity-Duration AVP (AVP Code 625) is of type Unsigned32 and + indicates in seconds the validity time of the overload report. The + number of seconds is measured after reception of the first OC-OLR AVP + with a given value of OC-Sequence-Number AVP. The default value for + the OC-Validity-Duration AVP is 30 seconds. When the OC-Validity- + Duration AVP is not present in the OC-OLR AVP, the default value + applies. The maximum value for the OC-Validity-Duration AVP is + + + +Korhonen, et al. Standards Track [Page 26] + +RFC 7683 DOIC October 2015 + + + 86,400 seconds (24 hours). If the value received in the OC-Validity- + Duration is greater than the maximum value, then the default value + applies. + +7.6. OC-Report-Type AVP + + The OC-Report-Type AVP (AVP Code 626) is of type Enumerated. The + value of the AVP describes what the overload report concerns. The + following values are initially defined: + + HOST_REPORT 0 + The overload report is for a host. Overload abatement treatment + applies to host-routed requests. + + REALM_REPORT 1 + The overload report is for a realm. Overload abatement treatment + applies to realm-routed requests. + + The values 2-4294967295 are unassigned. + +7.7. OC-Reduction-Percentage AVP + + The OC-Reduction-Percentage AVP (AVP Code 627) is of type Unsigned32 + and describes the percentage of the traffic that the sender is + requested to reduce, compared to what it otherwise would send. The + OC-Reduction-Percentage AVP applies to the default (loss) algorithm + specified in this specification. However, the AVP can be reused for + future abatement algorithms, if its semantics fit into the new + algorithm. + + The value of the Reduction-Percentage AVP is between zero (0) and one + hundred (100). Values greater than 100 are ignored. The value of + 100 means that all traffic is to be throttled, i.e., the reporting + node is under a severe load and ceases to process any new messages. + The value of 0 means that the reporting node is in a stable state and + has no need for the reacting node to apply any traffic abatement. + + + + + + + + + + + + + + + +Korhonen, et al. Standards Track [Page 27] + +RFC 7683 DOIC October 2015 + + +7.8. AVP Flag Rules + + +---------+ + |AVP flag | + |rules | + +----+----+ + AVP Section | |MUST| + Attribute Name Code Defined Value Type |MUST| NOT| + +--------------------------------------------------+----+----+ + |OC-Supported-Features 621 7.1 Grouped | | V | + +--------------------------------------------------+----+----+ + |OC-Feature-Vector 622 7.2 Unsigned64 | | V | + +--------------------------------------------------+----+----+ + |OC-OLR 623 7.3 Grouped | | V | + +--------------------------------------------------+----+----+ + |OC-Sequence-Number 624 7.4 Unsigned64 | | V | + +--------------------------------------------------+----+----+ + |OC-Validity-Duration 625 7.5 Unsigned32 | | V | + +--------------------------------------------------+----+----+ + |OC-Report-Type 626 7.6 Enumerated | | V | + +--------------------------------------------------+----+----+ + |OC-Reduction | | | + | -Percentage 627 7.7 Unsigned32 | | V | + +--------------------------------------------------+----+----+ + + As described in the Diameter base protocol [RFC6733], the M-bit usage + for a given AVP in a given command may be defined by the application. + +8. Error Response Codes + + When a DOIC node rejects a Diameter request due to overload, the DOIC + node MUST select an appropriate error response code. This + determination is made based on the probability of the request + succeeding if retried on a different path. + + Note: This only applies for DOIC nodes that are not the originator + of the request. + + A reporting node rejecting a Diameter request due to an overload + condition SHOULD send a DIAMETER_TOO_BUSY error response, if it can + assume that the same request may succeed on a different path. + + If a reporting node knows or assumes that the same request will not + succeed on a different path, the DIAMETER_UNABLE_TO_COMPLY error + response SHOULD be used. Retrying would consume valuable resources + during an occurrence of overload. + + + + + +Korhonen, et al. Standards Track [Page 28] + +RFC 7683 DOIC October 2015 + + + For instance, if the request arrived at the reporting node without + a Destination-Host AVP, then the reporting node might determine + that there is an alternative Diameter node that could successfully + process the request and that retrying the transaction would not + negatively impact the reporting node. DIAMETER_TOO_BUSY would be + sent in this case. + + If the request arrived at the reporting node with a Destination- + Host AVP populated with its own Diameter identity, then the + reporting node can assume that retrying the request would result + in it coming to the same reporting node. + DIAMETER_UNABLE_TO_COMPLY would be sent in this case. + + A second example is when an agent that supports the DOIC solution + is performing the role of a reacting node for a non-supporting + client. Requests that are rejected as a result of DOIC throttling + by the agent in this scenario would generally be rejected with a + DIAMETER_UNABLE_TO_COMPLY response code. + +9. IANA Considerations + +9.1. AVP Codes + + New AVPs defined by this specification are listed in Section 7. All + AVP codes are allocated from the "AVP Codes" sub-registry under the + "Authentication, Authorization, and Accounting (AAA) Parameters" + registry. + +9.2. New Registries + + Two new registries have been created in the "AVP Specific Values" + sub-registry under the "Authentication, Authorization, and Accounting + (AAA) Parameters" registry. + + A new "OC-Feature-Vector AVP Values (code 622)" registry has been + created. This registry contains the following: + + Feature Vector Value Name + + Feature Vector Value + + Specification defining the new value + + See Section 7.2 for the initial Feature Vector Value in the registry. + This specification defines the value. New values can be added to the + registry using the Specification Required policy [RFC5226]. + + + + + +Korhonen, et al. Standards Track [Page 29] + +RFC 7683 DOIC October 2015 + + + A new "OC-Report-Type AVP Values (code 626)" registry has been + created. This registry contains the following: + + Report Type Value Name + + Report Type Value + + Specification defining the new value + + See Section 7.6 for the initial assignment in the registry. New + types can be added using the Specification Required policy [RFC5226]. + +10. Security Considerations + + DOIC gives Diameter nodes the ability to request that downstream + nodes send fewer Diameter requests. Nodes do this by exchanging + overload reports that directly effect this reduction. This exchange + is potentially subject to multiple methods of attack and has the + potential to be used as a denial-of-service (DoS) attack vector. For + instance, a series of injected realm OLRs with a requested reduction + percentage of 100% could be used to completely eliminate any traffic + from being sent to that realm. + + Overload reports may contain information about the topology and + current status of a Diameter network. This information is + potentially sensitive. Network operators may wish to control + disclosure of overload reports to unauthorized parties to avoid their + use for competitive intelligence or to target attacks. + + Diameter does not include features to provide end-to-end + authentication, integrity protection, or confidentiality. This may + cause complications when sending overload reports between non- + adjacent nodes. + +10.1. Potential Threat Modes + + The Diameter protocol involves transactions in the form of requests + and answers exchanged between clients and servers. These clients and + servers may be peers, that is, they may share a direct transport + (e.g., TCP or SCTP) connection, or the messages may traverse one or + more intermediaries, known as Diameter Agents. Diameter nodes use + TLS, DTLS, or IPsec to authenticate peers and to provide + confidentiality and integrity protection of traffic between peers. + Nodes can make authorization decisions based on the peer identities + authenticated at the transport layer. + + + + + + +Korhonen, et al. Standards Track [Page 30] + +RFC 7683 DOIC October 2015 + + + When agents are involved, this presents an effectively transitive + trust model. That is, a Diameter client or server can authorize an + agent for certain actions, but it must trust that agent to make + appropriate authorization decisions about its peers, and so on. + Since confidentiality and integrity protection occur at the transport + layer, agents can read, and perhaps modify, any part of a Diameter + message, including an overload report. + + There are several ways an attacker might attempt to exploit the + overload control mechanism. An unauthorized third party might inject + an overload report into the network. If this third party is upstream + of an agent, and that agent fails to apply proper authorization + policies, downstream nodes may mistakenly trust the report. This + attack is at least partially mitigated by the assumption that nodes + include overload reports in Diameter answers but not in requests. + This requires an attacker to have knowledge of the original request + in order to construct an answer. Such an answer would also need to + arrive at a Diameter node via a protected transport connection. + Therefore, implementations MUST validate that an answer containing an + overload report is a properly constructed response to a pending + request prior to acting on the overload report, and that the answer + was received via an appropriate transport connection. + + A similar attack involves a compromised but otherwise authorized node + that sends an inappropriate overload report. For example, a server + for the realm "example.com" might send an overload report indicating + that a competitor's realm "example.net" is overloaded. If other + nodes act on the report, they may falsely believe that "example.net" + is overloaded, effectively reducing that realm's capacity. + Therefore, it's critical that nodes validate that an overload report + received from a peer actually falls within that peer's responsibility + before acting on the report or forwarding the report to other peers. + For example, an overload report from a peer that applies to a realm + not handled by that peer is suspect. This may require out-of-band, + non-Diameter agreements and/or mechanisms. + + This attack is partially mitigated by the fact that the + application, as well as host and realm, for a given OLR is + determined implicitly by respective AVPs in the enclosing answer. + If a reporting node modifies any of those AVPs, the enclosing + transaction will also be affected. + +10.2. Denial-of-Service Attacks + + Diameter overload reports, especially realm reports, can cause a node + to cease sending some or all Diameter requests for an extended + period. This makes them a tempting vector for DoS attacks. + Furthermore, since Diameter is almost always used in support of other + + + +Korhonen, et al. Standards Track [Page 31] + +RFC 7683 DOIC October 2015 + + + protocols, a DoS attack on Diameter is likely to impact those + protocols as well. In the worst case, where the Diameter application + is being used for access control into an IP network, a coordinated + DoS attack could result in the blockage of all traffic into that + network. Therefore, Diameter nodes MUST NOT honor or forward OLRs + received from peers that are not trusted to send them. + + An attacker might use the information in an OLR to assist in DoS + attacks. For example, an attacker could use information about + current overload conditions to time an attack for maximum effect, or + use subsequent overload reports as a feedback mechanism to learn the + results of a previous or ongoing attack. Operators need the ability + to ensure that OLRs are not leaked to untrusted parties. + +10.3. Noncompliant Nodes + + In the absence of an overload control mechanism, Diameter nodes need + to implement strategies to protect themselves from floods of + requests, and to make sure that a disproportionate load from one + source does not prevent other sources from receiving service. For + example, a Diameter server might throttle a certain percentage of + requests from sources that exceed certain limits. Overload control + can be thought of as an optimization for such strategies, where + downstream nodes never send the excess requests in the first place. + However, the presence of an overload control mechanism does not + remove the need for these other protection strategies. + + When a Diameter node sends an overload report, it cannot assume that + all nodes will comply, even if they indicate support for DOIC. A + noncompliant node might continue to send requests with no reduction + in load. Such noncompliance could be done accidentally or + maliciously to gain an unfair advantage over compliant nodes. + Requirement 28 in [RFC7068] indicates that the overload control + solution cannot assume that all Diameter nodes in a network are + trusted. It also requires that malicious nodes not be allowed to + take advantage of the overload control mechanism to get more than + their fair share of service. + +10.4. End-to-End Security Issues + + The lack of end-to-end integrity features makes it difficult to + establish trust in overload reports received from non-adjacent nodes. + Any agents in the message path may insert or modify overload reports. + Nodes must trust that their adjacent peers perform proper checks on + overload reports from their peers, and so on, creating a transitive- + trust requirement extending for potentially long chains of nodes. + Network operators must determine if this transitive trust requirement + is acceptable for their deployments. Nodes supporting Diameter + + + +Korhonen, et al. Standards Track [Page 32] + +RFC 7683 DOIC October 2015 + + + overload control MUST give operators the ability to select which + peers are trusted to deliver overload reports and whether they are + trusted to forward overload reports from non-adjacent nodes. DOIC + nodes MUST strip DOIC AVPs from messages received from peers that are + not trusted for DOIC purposes. + + The lack of end-to-end confidentiality protection means that any + Diameter Agent in the path of an overload report can view the + contents of that report. In addition to the requirement to select + which peers are trusted to send overload reports, operators MUST be + able to select which peers are authorized to receive reports. A node + MUST NOT send an overload report to a peer not authorized to receive + it. Furthermore, an agent MUST remove any overload reports that + might have been inserted by other nodes before forwarding a Diameter + message to a peer that is not authorized to receive overload reports. + + A DOIC node cannot always automatically detect that a peer also + supports DOIC. For example, a node might have a peer that is a + non-supporting agent. If nodes on the other side of that agent + send OC-Supported-Features AVPs, the agent is likely to forward + them as unknown AVPs. Messages received across the non-supporting + agent may be indistinguishable from messages received across a + DOIC supporting agent, giving the false impression that the non- + supporting agent actually supports DOIC. This complicates the + transitive-trust nature of DOIC. Operators need to be careful to + avoid situations where a non-supporting agent is mistakenly + trusted to enforce DOIC-related authorization policies. + + It is expected that work on end-to-end Diameter security might make + it easier to establish trust in non-adjacent nodes for overload + control purposes. Readers should be reminded, however, that the + overload control mechanism allows Diameter Agents to modify AVPs in, + or insert additional AVPs into, existing messages that are originated + by other nodes. If end-to-end security is enabled, there is a risk + that such modification could violate integrity protection. The + details of using any future Diameter end-to-end security mechanism + with overload control will require careful consideration, and are + beyond the scope of this document. + + + + + + + + + + + + + +Korhonen, et al. Standards Track [Page 33] + +RFC 7683 DOIC October 2015 + + +11. References + +11.1. Normative References + + [RFC2119] Bradner, S., "Key words for use in RFCs to Indicate + Requirement Levels", BCP 14, RFC 2119, + DOI 10.17487/RFC2119, March 1997, + <http://www.rfc-editor.org/info/rfc2119>. + + [RFC5226] Narten, T. and H. Alvestrand, "Guidelines for Writing an + IANA Considerations Section in RFCs", BCP 26, RFC 5226, + DOI 10.17487/RFC5226, May 2008, + <http://www.rfc-editor.org/info/rfc5226>. + + [RFC6733] Fajardo, V., Ed., Arkko, J., Loughney, J., and G. Zorn, + Ed., "Diameter Base Protocol", RFC 6733, + DOI 10.17487/RFC6733, October 2012, + <http://www.rfc-editor.org/info/rfc6733>. + +11.2. Informative References + + [Cx] 3GPP, "Cx and Dx interfaces based on the Diameter + protocol; Protocol details", 3GPP TS 29.229 12.7.0, + September 2015. + + [PCC] 3GPP, "Policy and charging control architecture", 3GPP + TS 23.203 12.10.0, September 2015. + + [RFC4006] Hakala, H., Mattila, L., Koskinen, J-P., Stura, M., and J. + Loughney, "Diameter Credit-Control Application", RFC 4006, + DOI 10.17487/RFC4006, August 2005, + <http://www.rfc-editor.org/info/rfc4006>. + + [RFC7068] McMurry, E. and B. Campbell, "Diameter Overload Control + Requirements", RFC 7068, DOI 10.17487/RFC7068, November + 2013, <http://www.rfc-editor.org/info/rfc7068>. + + [S13] 3GPP, "Evolved Packet System (EPS); Mobility Management + Entity (MME) and Serving GPRS Support Node (SGSN) related + interfaces based on Diameter protocol", 3GPP TS 29.272 + 12.8.0, September 2015. + + + + + + + + + + +Korhonen, et al. Standards Track [Page 34] + +RFC 7683 DOIC October 2015 + + +Appendix A. Issues Left for Future Specifications + + The base solution for overload control does not cover all possible + use cases. A number of solution aspects were intentionally left for + future specification and protocol work. The following subsections + define some of the potential extensions to the DOIC solution. + +A.1. Additional Traffic Abatement Algorithms + + This specification describes only means for a simple loss-based + algorithm. Future algorithms can be added using the designed + solution extension mechanism. The new algorithms need to be + registered with IANA. See Sections 7.2 and 9 for the required IANA + steps. + +A.2. Agent Overload + + This specification focuses on Diameter endpoint (server or client) + overload. A separate extension will be required to outline the + handling of the case of agent overload. + +A.3. New Error Diagnostic AVP + + This specification indicates the use of existing error messages when + nodes reject requests due to overload. There is an expectation that + additional error codes or AVPs will be defined in a separate + specification to indicate that overload was the reason for the + rejection of the message. + +Appendix B. Deployment Considerations + + Non-supporting Agents + + Due to the way that realm-routed requests are handled in Diameter + networks with the server selection for the request done by an + agent, network operators should enable DOIC at agents that perform + server selection first. + + Topology-Hiding Interactions + + There exist proxies that implement what is referred to as Topology + Hiding. This can include cases where the agent modifies the + Origin-Host in answer messages. The behavior of the DOIC solution + is not well understood when this happens. As such, the DOIC + solution does not address this scenario. + + + + + + +Korhonen, et al. Standards Track [Page 35] + +RFC 7683 DOIC October 2015 + + + Inter-Realm/Administrative Domain Considerations + + There are likely to be special considerations for handling DOIC + signaling across administrative boundaries. This includes + considerations for whether or not information included in the DOIC + signaling should be sent across those boundaries. In addition, + consideration should be taken as to whether or not a reacting node + in one realm can be trusted to implement the requested overload + abatement handling for overload reports received from a separately + administered realm. + +Appendix C. Considerations for Applications Integrating the DOIC + Solution + + This section outlines considerations to be taken into account when + integrating the DOIC solution into Diameter applications. + +C.1. Application Classification + + The following is a classification of Diameter applications and + request types. This discussion is meant to document factors that + play into decisions made by the Diameter entity responsible for + handling overload reports. + + Section 8.1 of [RFC6733] defines two state machines that imply two + types of applications, session-less and session-based applications. + The primary difference between these types of applications is the + lifetime of Session-Ids. + + For session-based applications, the Session-Id is used to tie + multiple requests into a single session. + + The Credit-Control application defined in [RFC4006] is an example of + a Diameter session-based application. + + In session-less applications, the lifetime of the Session-Id is a + single Diameter transaction, i.e., the session is implicitly + terminated after a single Diameter transaction and a new Session-Id + is generated for each Diameter request. + + + + + + + + + + + + +Korhonen, et al. Standards Track [Page 36] + +RFC 7683 DOIC October 2015 + + + For the purposes of this discussion, session-less applications are + further divided into two types of applications: + + Stateless Applications: + + Requests within a stateless application have no relationship to + each other. The 3GPP-defined S13 application is an example of a + stateless application [S13], where only a Diameter command is + defined between a client and a server and no state is maintained + between two consecutive transactions. + + Pseudo-Session Applications: + + Applications that do not rely on the Session-Id AVP for + correlation of application messages related to the same session + but use other session-related information in the Diameter requests + for this purpose. The 3GPP-defined Cx application [Cx] is an + example of a pseudo-session application. + + The handling of overload reports must take the type of application + into consideration, as discussed in Appendix C.2. + +C.2. Implications of Application Type Overload + + This section discusses considerations for mitigating overload + reported by a Diameter entity. This discussion focuses on the type + of application. Appendix C.3 discusses considerations for handling + various request types when the target server is known to be in an + overloaded state. + + These discussions assume that the strategy for mitigating the + reported overload is to reduce the overall workload sent to the + overloaded entity. The concept of applying overload treatment to + requests targeted for an overloaded Diameter entity is inherent to + this discussion. The method used to reduce offered load is not + specified here, but it could include routing requests to another + Diameter entity known to be able to handle them, or it could mean + rejecting certain requests. For a Diameter Agent, rejecting requests + will usually mean generating appropriate Diameter error responses. + For a Diameter client, rejecting requests will depend upon the + application. For example, it could mean giving an indication to the + entity requesting the Diameter service that the network is busy and + to try again later. + + + + + + + + +Korhonen, et al. Standards Track [Page 37] + +RFC 7683 DOIC October 2015 + + + Stateless Applications: + + By definition, there is no relationship between individual + requests in a stateless application. As a result, when a request + is sent or relayed to an overloaded Diameter entity -- either a + Diameter Server or a Diameter Agent -- the sending or relaying + entity can choose to apply the overload treatment to any request + targeted for the overloaded entity. + + Pseudo-session Applications: + + For pseudo-session applications, there is an implied ordering of + requests. As a result, decisions about which requests towards an + overloaded entity to reject could take the command code of the + request into consideration. This generally means that + transactions later in the sequence of transactions should be given + more favorable treatment than messages earlier in the sequence. + This is because more work has already been done by the Diameter + network for those transactions that occur later in the sequence. + Rejecting them could result in increasing the load on the network + as the transactions earlier in the sequence might also need to be + repeated. + + Session-Based Applications: + + Overload handling for session-based applications must take into + consideration the work load associated with setting up and + maintaining a session. As such, the entity sending requests + towards an overloaded Diameter entity for a session-based + application might tend to reject new session requests prior to + rejecting intra-session requests. In addition, session-ending + requests might be given a lower probability of being rejected, as + rejecting session-ending requests could result in session status + being out of sync between the Diameter clients and servers. + Application designers that would decide to reject mid-session + requests will need to consider whether the rejection invalidates + the session and any resulting session cleanup procedures. + +C.3. Request Transaction Classification + + Independent Request: + + An independent request is not correlated to any other requests, + and, as such, the lifetime of the Session-Id is constrained to an + individual transaction. + + + + + + +Korhonen, et al. Standards Track [Page 38] + +RFC 7683 DOIC October 2015 + + + Session-Initiating Request: + + A session-initiating request is the initial message that + establishes a Diameter session. The ACR message defined in + [RFC6733] is an example of a session-initiating request. + + Correlated Session-Initiating Request: + + There are cases when multiple session-initiated requests must be + correlated and managed by the same Diameter server. It is notably + the case in the 3GPP Policy and Charging Control (PCC) + architecture [PCC], where multiple apparently independent Diameter + application sessions are actually correlated and must be handled + by the same Diameter server. + + Intra-session Request: + + An intra-session request is a request that uses the same Session- + Id as the one used in a previous request. An intra-session + request generally needs to be delivered to the server that handled + the session-creating request for the session. The STR message + defined in [RFC6733] is an example of an intra-session request. + + Pseudo-session Requests: + + Pseudo-session requests are independent requests and do not use + the same Session-Id but are correlated by other session-related + information contained in the request. There exist Diameter + applications that define an expected ordering of transactions. + This sequencing of independent transactions results in a pseudo- + session. The AIR, MAR, and SAR requests in the 3GPP-defined Cx + [Cx] application are examples of pseudo-session requests. + +C.4. Request Type Overload Implications + + The request classes identified in Appendix C.3 have implications on + decisions about which requests should be throttled first. The + following list of request treatments regarding throttling is provided + as guidelines for application designers when implementing the + Diameter overload control mechanism described in this document. The + exact behavior regarding throttling is a matter of local policy, + unless specifically defined for the application. + + Independent Requests: + + Independent requests can generally be given equal treatment when + making throttling decisions, unless otherwise indicated by + application requirements or local policy. + + + +Korhonen, et al. Standards Track [Page 39] + +RFC 7683 DOIC October 2015 + + + Session-Initiating Requests: + + Session-initiating requests often represent more work than + independent or intra-session requests. Moreover, session- + initiating requests are typically followed by other session- + related requests. Since the main objective of overload control is + to reduce the total number of requests sent to the overloaded + entity, throttling decisions might favor allowing intra-session + requests over session-initiating requests. In the absence of + local policies or application-specific requirements to the + contrary, individual session-initiating requests can be given + equal treatment when making throttling decisions. + + Correlated Session-Initiating Requests: + + A request that results in a new binding; where the binding is used + for routing of subsequent session-initiating requests to the same + server, it represents more work load than other requests. As + such, these requests might be throttled more frequently than other + request types. + + Pseudo-session Requests: + + Throttling decisions for pseudo-session requests can take into + consideration where individual requests fit into the overall + sequence of requests within the pseudo-session. Requests that are + earlier in the sequence might be throttled more aggressively than + requests that occur later in the sequence. + + Intra-session Requests: + + There are two types of intra-sessions requests, requests that + terminate a session and the remainder of intra-session requests. + Implementers and operators may choose to throttle session- + terminating requests less aggressively in order to gracefully + terminate sessions, allow cleanup of the related resources (e.g., + session state), and avoid the need for additional intra-session + requests. Favoring session termination requests may reduce the + session management impact on the overloaded entity. The default + handling of other intra-session requests might be to treat them + equally when making throttling decisions. There might also be + application-level considerations whether some request types are + favored over others. + + + + + + + + +Korhonen, et al. Standards Track [Page 40] + +RFC 7683 DOIC October 2015 + + +Contributors + + The following people contributed substantial ideas, feedback, and + discussion to this document: + + o Eric McMurry + + o Hannes Tschofenig + + o Ulrich Wiehe + + o Jean-Jacques Trottin + + o Maria Cruz Bartolome + + o Martin Dolly + + o Nirav Salot + + o Susan Shishufeng + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Korhonen, et al. Standards Track [Page 41] + +RFC 7683 DOIC October 2015 + + +Authors' Addresses + + Jouni Korhonen (editor) + Broadcom Corporation + 3151 Zanker Road + San Jose, CA 95134 + United States + + Email: [email protected] + + + Steve Donovan (editor) + Oracle + 7460 Warren Parkway + Frisco, Texas 75034 + United States + + Email: [email protected] + + + Ben Campbell + Oracle + 7460 Warren Parkway + Frisco, Texas 75034 + United States + + Email: [email protected] + + + Lionel Morand + Orange Labs + 38/40 rue du General Leclerc + Issy-Les-Moulineaux Cedex 9 92794 + France + + Phone: +33145296257 + Email: [email protected] + + + + + + + + + + + + + + +Korhonen, et al. Standards Track [Page 42] + diff --git a/lib/diameter/examples/code/client.erl b/lib/diameter/examples/code/client.erl index 6fb90b1c09..0864919cdd 100644 --- a/lib/diameter/examples/code/client.erl +++ b/lib/diameter/examples/code/client.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -39,7 +39,6 @@ -module(client). -include_lib("diameter/include/diameter.hrl"). --include_lib("diameter/include/diameter_gen_base_rfc6733.hrl"). -export([start/1, %% start a service start/2, %% @@ -71,6 +70,7 @@ {'Product-Name', "Client"}, {'Auth-Application-Id', [0]}, {string_decode, false}, + {decode_format, map}, {application, [{alias, common}, {dictionary, diameter_gen_base_rfc6733}, {module, client_cb}]}]). @@ -108,9 +108,9 @@ connect(T) -> call(Name) -> SId = diameter:session_id(?L(Name)), - RAR = #diameter_base_RAR{'Session-Id' = SId, - 'Auth-Application-Id' = 0, - 'Re-Auth-Request-Type' = 0}, + RAR = ['RAR' | #{'Session-Id' => SId, + 'Auth-Application-Id' => 0, + 'Re-Auth-Request-Type' => 0}], diameter:call(Name, common, RAR, []). call() -> diff --git a/lib/diameter/examples/code/client_cb.erl b/lib/diameter/examples/code/client_cb.erl index ed1d3b9b7b..af2d4d6da7 100644 --- a/lib/diameter/examples/code/client_cb.erl +++ b/lib/diameter/examples/code/client_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -55,21 +55,18 @@ prepare_request(#diameter_packet{msg = ['RAR' = T | Avps]}, _, {_, Caps}) -> origin_realm = {OR, DR}} = Caps, - {send, [T, {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Host', DH}, - {'Destination-Realm', DR} - | Avps]}; - -prepare_request(#diameter_packet{msg = Rec}, _, {_, Caps}) -> - #diameter_caps{origin_host = {OH, DH}, - origin_realm = {OR, DR}} - = Caps, - - {send, Rec#diameter_base_RAR{'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Destination-Host' = DH, - 'Destination-Realm' = DR}}. + {send, [T | if is_map(Avps) -> + Avps#{'Origin-Host' => OH, + 'Origin-Realm' => OR, + 'Destination-Host' => DH, + 'Destination-Realm' => DR}; + is_list(Avps) -> + [{'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Host', DH}, + {'Destination-Realm', DR} + | Avps] + end]}. %% prepare_retransmit/3 diff --git a/lib/diameter/examples/code/node.erl b/lib/diameter/examples/code/node.erl index 246be4194b..fc5830f8e2 100644 --- a/lib/diameter/examples/code/node.erl +++ b/lib/diameter/examples/code/node.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,6 +30,8 @@ connect/2, stop/1]). +-export([message/3]). + -type protocol() :: tcp | sctp. @@ -128,6 +130,8 @@ stop(Name) -> server_opts({T, Addr, Port}) -> [{transport_module, tmod(T)}, {transport_config, [{reuseaddr, true}, + {sender, true}, + {message_cb, [fun ?MODULE:message/3, 0]}, {ip, addr(Addr)}, {port, Port}]}]; @@ -173,3 +177,26 @@ addr(loopback) -> {127,0,0,1}; addr(A) -> A. + +%% --------------------------------------------------------------------------- + +%% message/3 +%% +%% Simple message callback that limits the number of concurrent +%% requests on the peer connection in question. + +%% Incoming request. +message(recv, <<_:32, 1:1, _/bits>> = Bin, N) -> + [Bin, N < 32, fun ?MODULE:message/3, N+1]; + +%% Outgoing request. +message(ack, <<_:32, 1:1, _/bits>>, _) -> + []; + +%% Incoming answer or request discarded. +message(ack, _, N) -> + [N =< 32, fun ?MODULE:message/3, N-1]; + +%% Outgoing message or incoming answer. +message(_, Bin, _) -> + [Bin]. diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index fb6370fe54..548763ec7d 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -26,13 +26,13 @@ %% encode_avps/3 -encode_avps(Name, Vals, Opts) -> - diameter_gen:encode_avps(Name, Vals, Opts#{module => ?MODULE}). +encode_avps(Name, Avps, Opts) -> + diameter_gen:encode_avps(Name, Avps, Opts#{module => ?MODULE}). %% decode_avps/2 -decode_avps(Name, Recs, Opts) -> - diameter_gen:decode_avps(Name, Recs, Opts#{module => ?MODULE}). +decode_avps(Name, Avps, Opts) -> + diameter_gen:decode_avps(Name, Avps, Opts#{module => ?MODULE}). %% avp/5 diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 6bf748a727..3af856f63e 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2016. All Rights Reserved. +# Copyright Ericsson AB 2010-2017. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -274,9 +274,7 @@ gen/diameter_gen_base_accounting.erl gen/diameter_gen_base_accounting.hrl: \ gen/diameter_gen_acct_rfc6733.erl gen/diameter_gen_acct_rfc6733.hrl: \ $(EBIN)/diameter_gen_base_rfc6733.$(EMULATOR) -gen/diameter_gen_relay.erl gen/diameter_gen_relay.hrl \ -gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl \ -gen/diameter_gen_base_rfc6733.erl gen/diameter_gen_base_rfc6733.hrl: \ +$(DICT_ERLS) $(DICT_HRLS): \ $(COMPILER_MODULES:%=$(EBIN)/%.$(EMULATOR)) $(DICT_MODULES:gen/%=$(EBIN)/%.$(EMULATOR)): \ diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index bd92e16fba..b90b794611 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -46,7 +46,10 @@ -export([start/0, stop/0]). --export_type([evaluable/0, +-export_type([eval/0, + evaluable/0, %% deprecated + decode_format/0, + strict_arities/0, restriction/0, message_length/0, remotes/0, @@ -299,7 +302,7 @@ call(SvcName, App, Message) -> | realm | {host, any|'DiameterIdentity'()} | {realm, any|'DiameterIdentity'()} - | {eval, evaluable()} + | {eval, eval()} | {neg, peer_filter()} | {all, [peer_filter()]} | {any, [peer_filter()]}. @@ -307,10 +310,13 @@ call(SvcName, App, Message) -> -opaque peer_ref() :: pid(). --type evaluable() +-type eval() :: {module(), atom(), list()} | fun() - | maybe_improper_list(evaluable(), list()). + | maybe_improper_list(eval(), list()). + +-type evaluable() + :: eval(). -type sequence() :: {'Unsigned32'(), 0..32}. @@ -320,29 +326,61 @@ call(SvcName, App, Message) -> | node | nodes | [node()] - | evaluable(). + | eval(). -type remotes() :: boolean() | [node()] - | evaluable(). + | eval(). -type message_length() :: 0..16#FFFFFF. +-type decode_format() + :: record + | list + | map + | none + | record_from_map. + +-type strict_arities() + :: false + | encode + | decode. + +%% Options common to both start_service/2 and add_transport/2. + +-type common_opt() + :: {pool_size, pos_integer()} + | {capabilities_cb, eval()} + | {capx_timeout, 'Unsigned32'()} + | {strict_capx, boolean()} + | {strict_mbit, boolean()} + | {avp_dictionaries, [module()]} + | {disconnect_cb, eval()} + | {dpr_timeout, 'Unsigned32'()} + | {dpa_timeout, 'Unsigned32'()} + | {incoming_maxlen, message_length()} + | {length_errors, exit | handle | discard} + | {connect_timer, 'Unsigned32'()} + | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} + | {watchdog_config, [{okay|suspect, non_neg_integer()}]} + | {spawn_opt, list()}. + %% Options passed to start_service/2 -type service_opt() :: capability() | {application, [application_opt()]} | {restrict_connections, restriction()} - | {sequence, sequence() | evaluable()} + | {sequence, sequence() | eval()} | {share_peers, remotes()} + | {decode_format, decode_format()} + | {traffic_counters, boolean()} | {string_decode, boolean()} - | {strict_mbit, boolean()} - | {incoming_maxlen, message_length()} + | {strict_arities, true | strict_arities()} | {use_shared_peers, remotes()} - | {spawn_opt, list()}. + | common_opt(). -type application_opt() :: {alias, app_alias()} @@ -372,20 +410,9 @@ call(SvcName, App, Message) -> :: {transport_module, atom()} | {transport_config, any()} | {transport_config, any(), 'Unsigned32'() | infinity} - | {pool_size, pos_integer()} | {applications, [app_alias()]} | {capabilities, [capability()]} - | {capabilities_cb, evaluable()} - | {capx_timeout, 'Unsigned32'()} - | {capx_strictness, boolean()} - | {disconnect_cb, evaluable()} - | {dpr_timeout, 'Unsigned32'()} - | {dpa_timeout, 'Unsigned32'()} - | {length_errors, exit | handle | discard} - | {connect_timer, 'Unsigned32'()} - | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} - | {watchdog_config, [{okay|suspect, non_neg_integer()}]} - | {spawn_opt, list()} + | common_opt() | {private, any()}. %% Predicate passed to remove_transport/2 diff --git a/lib/diameter/src/base/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl index f9cdc66c70..d04a416bef 100644 --- a/lib/diameter/src/base/diameter_callback.erl +++ b/lib/diameter/src/base/diameter_callback.erl @@ -26,16 +26,16 @@ %% as the Diameter application callback in question. The record has %% one field for each callback function as well as 'default' and %% 'extra' fields. A function-specific field can be set to a -%% diameter:evaluable() in order to redirect the callback +%% diameter:eval() in order to redirect the callback %% corresponding to that field, or to 'false' to request the default %% callback implemented in this module. If neither of these fields are %% set then the 'default' field determines the form of the callback: a %% module name results in the usual callback as if the module had been -%% configured directly as the callback module, a diameter_evaluable() +%% configured directly as the callback module, a diameter_eval() %% in a callback applied to the atom-valued callback name and argument %% list. For all callbacks not to this module, the 'extra' field is a %% list of additional arguments, following arguments supplied by -%% diameter but preceding those of the diameter:evaluable() being +%% diameter but preceding those of the diameter:eval() being %% applied. %% %% For example, the following config to diameter:start_service/2, in diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index 82fa796e69..2dd2c906a2 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -29,7 +29,7 @@ msg_name/2, msg_id/1]). -%% Towards generated encoders (from diameter_gen.hrl). +%% towards diameter_gen -export([pack_data/2, pack_avp/2]). @@ -110,7 +110,7 @@ encode(Mod, Opts, Msg) -> enc(_, Opts, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> - try encode_avps(reorder(As), Opts) of + try encode_avps(As, Opts) of Avps -> Bin = list_to_binary(Avps), Len = 20 + size(Bin), @@ -206,51 +206,12 @@ values(Avps) -> %% Message as a list of #diameter_avp{} ... encode_avps(_, _, [#diameter_avp{} | _] = Avps, Opts) -> - encode_avps(reorder(Avps), Opts); + encode_avps(Avps, Opts); %% ... or as a tuple list or record. encode_avps(Mod, MsgName, Values, Opts) -> Mod:encode_avps(MsgName, Values, Opts). -%% reorder/1 -%% -%% Reorder AVPs for the relay case using the index field of -%% diameter_avp records. Decode populates this field in collect_avps -%% and presents AVPs in reverse order. A relay then sends the reversed -%% list with a Route-Record AVP prepended. The goal here is just to do -%% lists:reverse/1 in Grouped AVPs and the outer list, but only in the -%% case there are indexed AVPs at all, so as not to reverse lists that -%% have been explicilty sent (unindexed, in the desired order) as a -%% diameter_avp list. The effect is the same as lists:keysort/2, but -%% only on the cases we expect, not a general sort. - -reorder(Avps) -> - case reorder(Avps, []) of - false -> - Avps; - Sorted -> - Sorted - end. - -%% reorder/3 - -%% In case someone has reversed the list already. (Not likely.) -reorder([#diameter_avp{index = 0} | _] = Avps, Acc) -> - Avps ++ Acc; - -%% Assume indexed AVPs are in reverse order. -reorder([#diameter_avp{index = N} = A | Avps], Acc) - when is_integer(N) -> - lists:reverse(Avps, [A | Acc]); - -%% An unindexed AVP. -reorder([H | T], Acc) -> - reorder(T, [H | Acc]); - -%% No indexed members. -reorder([], _) -> - false. - %% encode_avps/2 encode_avps(Avps, Opts) -> @@ -287,7 +248,8 @@ rec2msg(Mod, Rec) -> %% longer *the* decode. decode(Mod, Pkt) -> - Opts = #{string_decode => true, + Opts = #{decode_format => record, + string_decode => true, strict_mbit => true, rfc => 6733}, decode(Mod, Opts, Pkt). @@ -326,13 +288,7 @@ decode(Mod, AppMod, Opts, Pkt) -> %% Relay application: just extract the avp's without any decoding of %% their data since we don't know the application in question. decode(?APP_ID_RELAY, _, _, _, #diameter_packet{} = Pkt) -> - case collect_avps(Pkt) of - {E, As} -> - Pkt#diameter_packet{avps = As, - errors = [E]}; - As -> - Pkt#diameter_packet{avps = As} - end; + collect_avps(Pkt); %% Otherwise decode using the dictionary. decode(_, Mod, AppMod, Opts, #diameter_packet{header = Hdr} = Pkt) -> @@ -341,44 +297,50 @@ decode(_, Mod, AppMod, Opts, #diameter_packet{header = Hdr} = Pkt) -> is_error = IsError} = Hdr, - MsgName = if IsError andalso not IsRequest -> + MsgName = if IsError, not IsRequest -> 'answer-message'; true -> Mod:msg_name(CmdCode, IsRequest) end, - decode_avps(MsgName, Mod, AppMod, Opts, Pkt, collect_avps(Pkt)); + decode_avps(MsgName, Mod, AppMod, Opts, Pkt); decode(Id, Mod, AppMod, Opts, Bin) when is_binary(Bin) -> decode(Id, Mod, AppMod, Opts, #diameter_packet{header = decode_header(Bin), bin = Bin}). -%% decode_avps/6 - -decode_avps(MsgName, Mod, AppMod, Opts, Pkt, {E, Avps}) -> - ?LOG(invalid_avp_length, Pkt#diameter_packet.header), - #diameter_packet{errors = Failed} - = P - = decode_avps(MsgName, Mod, AppMod, Opts, Pkt, Avps), - P#diameter_packet{errors = [E | Failed]}; +%% decode_avps/5 -decode_avps('', _, _, _, Pkt, Avps) -> %% unknown message ... - ?LOG(unknown_message, Pkt#diameter_packet.header), - Pkt#diameter_packet{avps = lists:reverse(Avps), - errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED +decode_avps('', _, _, _, #diameter_packet{header = H, %% unknown message + bin = Bin} + = Pkt) -> + ?LOG(unknown_message, H), + Pkt#diameter_packet{avps = collect_avps(Bin), + errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED %% msg = undefined identifies this case. -decode_avps(MsgName, Mod, AppMod, Opts, Pkt, Avps) -> %% ... or not +decode_avps(MsgName, Mod, AppMod, Opts, #diameter_packet{bin = Bin} = Pkt) -> + {_, Avps} = split_binary(Bin, 20), {Rec, As, Errors} = Mod:decode_avps(MsgName, Avps, - Opts#{dictionary => AppMod, + Opts#{app_dictionary => AppMod, failed_avp => false}), ?LOGC([] /= Errors, decode_errors, Pkt#diameter_packet.header), - Pkt#diameter_packet{msg = Rec, + Pkt#diameter_packet{msg = reformat(MsgName, Rec, Opts), errors = Errors, avps = As}. +%% reformat/3 + +reformat(MsgName, Avps, #{decode_format := T}) + when T == map; + T == list -> + [MsgName | Avps]; + +reformat(_, Msg, _) -> + Msg. + %%% --------------------------------------------------------------------------- %%% # decode_header/1 %%% --------------------------------------------------------------------------- @@ -515,24 +477,21 @@ msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/binary>>) -> %%% # collect_avps/1 %%% --------------------------------------------------------------------------- -%% Note that the returned list of AVP's is reversed relative to their -%% order in the binary. Note also that grouped avp's aren't unraveled, -%% only those at the top level. +%% This is only used for the relay decode. Note that grouped avp's +%% aren't unraveled, only those at the top level. --spec collect_avps(#diameter_packet{} | binary()) - -> [Avp] - | {Error, [Avp]} - when Avp :: #diameter_avp{}, - Error :: {5014, #diameter_avp{}}. +-spec collect_avps(#diameter_packet{}) + -> #diameter_packet{}; + (binary()) + -> [#diameter_avp{}]. -collect_avps(#diameter_packet{bin = <<_:20/binary, Avps/binary>>}) -> - collect_avps(Avps, 0, []); +collect_avps(#diameter_packet{bin = Bin} = Pkt) -> + Pkt#diameter_packet{avps = collect_avps(Bin)}; -collect_avps(Bin) - when is_binary(Bin) -> - collect_avps(Bin, 0, []). +collect_avps(<<_:20/binary, Avps/binary>>) -> + collect(Avps). -%% collect_avps/3 +%% collect/1 %% 0 1 2 3 %% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 @@ -546,66 +505,48 @@ collect_avps(Bin) %% | Data ... %% +-+-+-+-+-+-+-+-+ -collect_avps(<<Code:32, V:1, M:1, P:1, _:5, Len:24, I:V/unit:32, Rest/binary>>, - N, - Acc) -> - collect_avps(Code, - if 1 == V -> I; 0 == V -> undefined end, - 1 == M, - 1 == P, - Len - 8 - V*4, %% Might be negative, which ensures - ?PAD(Len), %% failure of the Data match below. - Rest, - N, - Acc); - -collect_avps(<<>>, _, Acc) -> - Acc; +collect(<<Code:32, V:1, M:1, P:1, _:5, Len:24, I:V/unit:32, Rest/binary>>) -> + collect(Rest, + Code, + if 1 == V -> I; 0 == V -> undefined end, + Len - 8 - V*4, %% Might be negative, which ensures + ?PAD(Len), %% failure of the match below. + 1 == M, + 1 == P); + +collect(<<>>) -> + []; %% Header is truncated. pack_avp/1 will pad this at encode if sent in %% a Failed-AVP. -collect_avps(Bin, _, Acc) -> - {{5014, #diameter_avp{data = Bin}}, Acc}. +collect(Bin) -> + [#diameter_avp{data = {5014, Bin}}]. -%% collect_avps/9 +%% collect/7 -%% Duplicate the diameter_avp creation in each branch below to avoid -%% modifying the record, which profiling has shown to be a relatively -%% costly part of building the list. - -collect_avps(Code, VendorId, M, P, Len, Pad, Rest, N, Acc) -> - case Rest of - <<Data:Len/binary, _:Pad/binary, T/binary>> -> +collect(Bin, Code, Vid, DataLen, Pad, M, P) -> + case Bin of + <<Data:DataLen/binary, _:Pad/binary, Rest/binary>> -> Avp = #diameter_avp{code = Code, - vendor_id = VendorId, + vendor_id = Vid, is_mandatory = M, need_encryption = P, - data = Data, - index = N}, - collect_avps(T, N+1, [Avp | Acc]); + data = Data}, + [Avp | collect(Rest)]; _ -> %% Length in header points past the end of the message, or - %% doesn't span the header. As stated in the 6733 text - %% above, it's sufficient to return a zero-filled minimal - %% payload if this is a request. Do this (in cases that we - %% know the type) by inducing a decode failure and letting - %% the dictionary's decode (in diameter_gen) deal with it. - %% - %% Note that the extra bit can only occur in the trailing - %% AVP of a message or Grouped AVP, since a faulty AVP - %% Length is otherwise indistinguishable from a correct - %% one here, as we don't know the types of the AVPs being - %% extracted. - Avp = #diameter_avp{code = Code, - vendor_id = VendorId, - is_mandatory = M, - need_encryption = P, - data = {5014, Rest}, - index = N}, - [Avp | Acc] + %% doesn't span the header. Note that an length error can + %% only occur in the trailing AVP of a message or Grouped + %% AVP, since a faulty AVP Length is otherwise + %% indistinguishable from a correct one here, as we don't + %% know the types of the AVPs being extracted. + [#diameter_avp{code = Code, + vendor_id = Vid, + is_mandatory = M, + need_encryption = P, + data = {5014, Bin}}] end. - %% 3588: %% %% DIAMETER_INVALID_AVP_LENGTH 5014 @@ -673,8 +614,8 @@ pack_avp(#diameter_avp{data = {T, {Type, Value}}}, Opts) -> pack_avp(#diameter_avp{data = {T, Data}}, _) -> pack_data(T, Data); -pack_avp(#diameter_avp{data = {Dict, Name, Data}}, Opts) -> - pack_data(Dict:avp_header(Name), Dict:avp(encode, Data, Name, Opts)); +pack_avp(#diameter_avp{data = {Dict, Name, Value}}, Opts) -> + pack_data(Dict:avp_header(Name), Dict:avp(encode, Value, Name, Opts)); %% ... with a truncated header ... pack_avp(#diameter_avp{code = undefined, data = B}, _) diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index 34018ae6d3..90a9282349 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -102,9 +102,6 @@ -record(monitor, {mref = make_ref() :: reference(), service}). %% name -%% The default sequence mask. --define(NOMASK, {0,32}). - %% Time to lay low before restarting a dead service. -define(RESTART_SLEEP, 2000). @@ -560,87 +557,186 @@ add(SvcName, Type, Opts0) -> end. transport_opts(Opts) -> - lists:map(fun topt/1, Opts). + [setopt(transport, T) || T <- Opts]. + +%% setopt/2 -topt(T) -> - case opt(T) of +setopt(K, T) -> + case opt(K, T) of {value, X} -> X; true -> T; false -> - ?THROW({invalid, T}) + ?THROW({invalid, T}); + {error, Reason} -> + ?THROW({invalid, T, Reason}) end. -opt({transport_module, M}) -> +%% opt/2 + +opt(_, {incoming_maxlen, N}) -> + is_integer(N) andalso 0 =< N andalso N < 1 bsl 24; + +opt(service, {K, B}) + when K == string_decode; + K == traffic_counters -> + is_boolean(B); + +opt(service, {K, false}) + when K == share_peers; + K == use_shared_peers; + K == monitor; + K == restrict_connections; + K == strict_arities -> + true; + +opt(service, {K, true}) + when K == share_peers; + K == use_shared_peers; + K == strict_arities -> + true; + +opt(service, {decode_format, T}) + when T == record; + T == list; + T == map; + T == none; + T == record_from_map -> + true; + +opt(service, {strict_arities, T}) + when T == encode; + T == decode -> + true; + +opt(service, {restrict_connections, T}) + when T == node; + T == nodes -> + true; + +opt(service, {K, T}) + when (K == share_peers + orelse K == use_shared_peers + orelse K == restrict_connections), ([] == T + orelse is_atom(hd(T))) -> + true; + +opt(service, {monitor, P}) -> + is_pid(P); + +opt(service, {K, F}) + when K == restrict_connections; + K == share_peers; + K == use_shared_peers -> + try diameter_lib:eval(F) of %% but no guarantee that it won't fail later + Nodes -> + is_list(Nodes) orelse {error, Nodes} + catch + E:R -> + {error, {E, R, ?STACK}} + end; + +opt(service, {sequence, {H,N}}) -> + 0 =< N andalso N =< 32 + andalso is_integer(H) + andalso 0 =< H + andalso 0 == H bsr (32-N); + +opt(service = S, {sequence = K, F}) -> + try diameter_lib:eval(F) of + {_,_} = T -> + KT = {K,T}, + opt(S, KT) andalso {value, KT}; + V -> + {error, V} + catch + E:R -> + {error, {E, R, ?STACK}} + end; + +opt(transport, {transport_module, M}) -> is_atom(M); -opt({transport_config, _, Tmo}) -> +opt(transport, {transport_config, _, Tmo}) -> ?IS_UINT32(Tmo) orelse Tmo == infinity; -opt({applications, As}) -> +opt(transport, {applications, As}) -> is_list(As); -opt({capabilities, Os}) -> - is_list(Os) andalso ok == encode_CER(Os); +opt(transport, {capabilities, Os}) -> + is_list(Os) andalso try ok = encode_CER(Os), true + catch ?FAILURE(No) -> {error, No} + end; -opt({K, Tmo}) +opt(_, {K, Tmo}) when K == capx_timeout; K == dpr_timeout; K == dpa_timeout -> ?IS_UINT32(Tmo); -opt({capx_strictness, B}) -> +opt(_, {capx_strictness, B}) -> + is_boolean(B) andalso {value, {strict_capx, B}}; +opt(_, {K, B}) + when K == strict_capx; + K == strict_mbit -> is_boolean(B); -opt({length_errors, T}) -> +opt(_, {avp_dictionaries, Mods}) -> + is_list(Mods) andalso lists:all(fun erlang:is_atom/1, Mods); + +opt(_, {length_errors, T}) -> lists:member(T, [exit, handle, discard]); -opt({K, Tmo}) - when K == reconnect_timer; %% deprecated - K == connect_timer -> +opt(transport, {reconnect_timer, Tmo}) -> %% deprecated + ?IS_UINT32(Tmo) andalso {value, {connect_timer, Tmo}}; +opt(_, {connect_timer, Tmo}) -> ?IS_UINT32(Tmo); -opt({watchdog_timer, {M,F,A}}) +opt(_, {watchdog_timer, {M,F,A}}) when is_atom(M), is_atom(F), is_list(A) -> true; -opt({watchdog_timer, Tmo}) -> +opt(_, {watchdog_timer, Tmo}) -> ?IS_UINT32(Tmo); -opt({watchdog_config, L}) -> - is_list(L) andalso lists:all(fun wdopt/1, L); +opt(_, {watchdog_config, L}) -> + is_list(L) andalso lists:all(fun wd/1, L); -opt({spawn_opt, {M,F,A}}) +opt(_, {spawn_opt, {M,F,A}}) when is_atom(M), is_atom(F), is_list(A) -> true; -opt({spawn_opt = K, Opts}) -> +opt(_, {spawn_opt = K, Opts}) -> if is_list(Opts) -> {value, {K, spawn_opts(Opts)}}; true -> false end; -opt({pool_size, N}) -> +opt(_, {pool_size, N}) -> is_integer(N) andalso 0 < N; -%% Options that we can't validate. -opt({K, _}) +%% Options we can't validate. +opt(_, {K, _}) + when K == disconnect_cb; + K == capabilities_cb -> + true; +opt(transport, {K, _}) when K == transport_config; - K == capabilities_cb; - K == disconnect_cb; K == private -> true; -%% Anything else, which is ignored by us. This makes options sensitive -%% to spelling mistakes but arbitrary options are passed by some users -%% as a way to identify transports. (That is, can't just do away with -%% it.) -opt(_) -> - true. +%% Anything else, which is ignored in transport config. This makes +%% options sensitive to spelling mistakes, but arbitrary options are +%% passed by some users as a way to identify transports so can't just +%% do away with it. +opt(K, _) -> + K == transport. + +%% wd/1 -wdopt({K,N}) -> +wd({K,N}) -> (K == okay orelse K == suspect) andalso is_integer(N) andalso 0 =< N; -wdopt(_) -> +wd(_) -> false. %% start_transport/2 @@ -705,16 +801,7 @@ make_config(SvcName, Opts) -> ok = encode_CER(CapOpts), - SvcOpts = make_opts((Opts -- AppOpts) -- CapOpts, - [{false, share_peers}, - {false, use_shared_peers}, - {false, monitor}, - {?NOMASK, sequence}, - {nodes, restrict_connections}, - {16#FFFFFF, incoming_maxlen}, - {true, strict_mbit}, - {true, string_decode}, - {[], spawn_opt}]), + SvcOpts = service_opts((Opts -- AppOpts) -- CapOpts), D = proplists:get_value(string_decode, SvcOpts, true), @@ -728,98 +815,22 @@ binary_caps(Caps, true) -> binary_caps(Caps, false) -> diameter_capx:binary_caps(Caps). -%% make_opts/2 - -make_opts(Opts, Defs) -> - Known = [{K, get_opt(K, Opts, D)} || {D,K} <- Defs], - Unknown = Opts -- Known, - - [] == Unknown orelse ?THROW({invalid, hd(Unknown)}), +%% service_opts/1 - [{K, opt(K,V)} || {K,V} <- Known]. - -opt(incoming_maxlen, N) - when 0 =< N, N < 1 bsl 24 -> - N; - -opt(spawn_opt, {M,F,A} = T) - when is_atom(M), is_atom(F), is_list(A) -> - T; - -opt(spawn_opt, L) - when is_list(L) -> - spawn_opts(L); - -opt(K, false = B) - when K == share_peers; - K == use_shared_peers; - K == monitor; - K == restrict_connections; - K == strict_mbit; - K == string_decode -> - B; - -opt(K, true = B) - when K == share_peers; - K == use_shared_peers; - K == strict_mbit; - K == string_decode -> - B; - -opt(restrict_connections, T) - when T == node; - T == nodes -> - T; - -opt(K, T) - when (K == share_peers - orelse K == use_shared_peers - orelse K == restrict_connections), ([] == T - orelse is_atom(hd(T))) -> - T; - -opt(monitor, P) - when is_pid(P) -> - P; - -opt(K, F) - when K == restrict_connections; - K == share_peers; - K == use_shared_peers -> - try diameter_lib:eval(F) of %% but no guarantee that it won't fail later - Nodes when is_list(Nodes) -> - F; - V -> - ?THROW({value, {K,V}}) - catch - E:R -> - ?THROW({value, {K, E, R, ?STACK}}) - end; - -opt(sequence, {_,_} = T) -> - sequence(T); - -opt(sequence = K, F) -> - try diameter_lib:eval(F) of - T -> sequence(T) - catch - E:R -> - ?THROW({value, {K, E, R, ?STACK}}) - end; - -opt(K, _) -> - ?THROW({value, K}). +service_opts(Opts) -> + Res = [setopt(service, T) || T <- Opts], + Keys = sets:to_list(sets:from_list([K || {K,_} <- Res])), %% unique + Dups = lists:foldl(fun(K,A) -> lists:keydelete(K, 1, A) end, Res, Keys), + [] == Dups orelse ?THROW({duplicate, Dups}), + Res. +%% Reject duplicates on a service, but not on a transport. There's no +%% particular reason for the inconsistency, but the historic behaviour +%% ignores all but the first of a transport_opt(), and there's no real +%% reason to change it. spawn_opts(L) -> [T || T <- L, T /= link, T /= monitor]. -sequence({H,N} = T) - when 0 =< N, N =< 32, 0 =< H, 0 == H bsr (32-N) -> - T; - -sequence(_) -> - ?THROW({value, sequence}). - make_caps(Caps, Opts) -> case diameter_capx:make_caps(Caps, Opts) of {ok, T} -> diff --git a/lib/diameter/src/base/diameter_gen.erl b/lib/diameter/src/base/diameter_gen.erl index e832832876..6add06ea38 100644 --- a/lib/diameter/src/base/diameter_gen.erl +++ b/lib/diameter/src/base/diameter_gen.erl @@ -26,6 +26,14 @@ -module(diameter_gen). +-compile({inline, [incr/8, + incr/4, + field/1, + setopts/4, + avp_arity/5, + set_failed/2, + set_strict/3]}). + -export([encode_avps/3, decode_avps/3, grouped_avp/4, @@ -37,7 +45,7 @@ -define(THROW(T), throw({?MODULE, T})). -type parent_name() :: atom(). %% parent = Message or AVP --type parent_record() :: tuple(). %% +-type parent_record() :: tuple() | avp_values() | map(). -type avp_name() :: atom(). -type avp_record() :: tuple(). -type avp_values() :: [{avp_name(), term()}]. @@ -46,17 +54,21 @@ -type grouped_avp() :: nonempty_improper_list(#diameter_avp{}, [avp()]). -type avp() :: non_grouped_avp() | grouped_avp(). +%% The arbitrary arity returned from dictionary avp_arity functions. +-define(ANY, {0, '*'}). + %% --------------------------------------------------------------------------- %% # encode_avps/3 %% --------------------------------------------------------------------------- --spec encode_avps(parent_name(), parent_record() | avp_values(), map()) +-spec encode_avps(parent_name(), parent_record(), map()) -> iolist() | no_return(). encode_avps(Name, Vals, #{module := Mod} = Opts) -> + Strict = mget(strict_arities, Opts, encode), try - encode(Name, Vals, Opts, Mod) + encode(Name, Vals, Opts, Strict, Mod) catch throw: {?MODULE, Reason} -> diameter_lib:log({encode, error}, @@ -73,128 +85,340 @@ encode_avps(Name, Vals, #{module := Mod} = Opts) -> erlang:error({encode_failure, Reason, Name, Stack}) end. -%% encode/4 +%% encode/5 -encode(Name, Vals, #{ordered_encode := false} = Opts, Mod) +encode(Name, Vals, Opts, Strict, Mod) when is_list(Vals) -> - lists:map(fun({F,V}) -> encode(Name, F, V, Opts, Mod) end, Vals); + case Opts of + #{ordered_encode := false} -> + lists:map(fun({F,V}) -> encode(Name, F, V, Opts, Strict, Mod) end, + Vals); + _ -> + Rec = Mod:'#set-'(Vals, newrec(Mod, Name)), + encode(Name, Rec, Opts, Strict, Mod) + end; -encode(Name, Vals, Opts, Mod) - when is_list(Vals) -> - encode(Name, Mod:'#set-'(Vals, newrec(Mod, Name)), Opts, Mod); +encode(Name, Map, Opts, Strict, Mod) + when is_map(Map) -> + [enc(F, A, V, Opts, Strict, Mod) || {F,A} <- Mod:avp_arity(Name), + V <- [mget(F, Map, undefined)]]; -encode(Name, Rec, Opts, Mod) -> - [encode(Name, F, V, Opts, Mod) || {F,V} <- Mod:'#get-'(Rec)]. +encode(Name, Rec, Opts, Strict, Mod) -> + [encode(Name, F, V, Opts, Strict, Mod) || {F,V} <- Mod:'#get-'(Rec)]. -%% encode/5 +%% encode/6 + +encode(_, AvpName, Values, Opts, Strict, Mod) + when Strict /= encode -> + enc(AvpName, ?ANY, Values, Opts, Strict, Mod); -encode(Name, AvpName, Values, Opts, Mod) -> - enc(Name, AvpName, Mod:avp_arity(Name, AvpName), Values, Opts, Mod). +encode(Name, AvpName, Values, Opts, Strict, Mod) -> + Arity = Mod:avp_arity(Name, AvpName), + enc(AvpName, Arity, Values, Opts, Strict, Mod). %% enc/6 -enc(_, AvpName, 1, undefined, _, _) -> +enc(AvpName, Arity, Values, Opts, Strict, Mod) + when Strict /= encode, Arity /= ?ANY -> + enc(AvpName, ?ANY, Values, Opts, Strict, Mod); + +enc(AvpName, 1, undefined, _, _, _) -> ?THROW([mandatory_avp_missing, AvpName]); -enc(Name, AvpName, 1, Value, Opts, Mod) -> - enc(Name, AvpName, [Value], Opts, Mod); +enc(AvpName, 1, Value, Opts, _, Mod) -> + H = avp_header(AvpName, Mod), + enc(AvpName, H, Value, Opts, Mod); -enc(_, _, {0,_}, [], _, _) -> +enc(_, {0,_}, [], _, _, _) -> []; -enc(_, AvpName, _, T, _, _) - when not is_list(T) -> - ?THROW([repeated_avp_as_non_list, AvpName, T]); +enc(_, _, undefined, _, _, _) -> + []; + +%% Be forgiving when a list of values is expected. If the value itself +%% is a list then the user has to wrap it to avoid each member from +%% being interpreted as an individual AVP value. +enc(AvpName, Arity, V, Opts, Strict, Mod) + when not is_list(V) -> + enc(AvpName, Arity, [V], Opts, Strict, Mod); + +enc(AvpName, {Min, Max}, Values, Opts, Strict, Mod) -> + H = avp_header(AvpName, Mod), + enc(AvpName, H, Min, 0, Max, Values, Opts, Strict, Mod). -enc(_, AvpName, {Min, _}, L, _, _) - when length(L) < Min -> - ?THROW([repeated_avp_insufficient_arity, AvpName, Min, L]); +%% enc/9 -enc(_, AvpName, {_, Max}, L, _, _) - when Max < length(L) -> - ?THROW([repeated_avp_excessive_arity, AvpName, Max, L]); +enc(AvpName, H, Min, N, Max, Vs, Opts, Strict, Mod) + when Strict /= encode; + Max == '*', Min =< N -> + [enc(AvpName, H, V, Opts, Mod) || V <- Vs]; + +enc(AvpName, _, Min, N, _, [], _, _, _) + when N < Min -> + ?THROW([repeated_avp_insufficient_arity, AvpName, Min, N]); + +enc(_, _, _, _, _, [], _, _, _) -> + []; -enc(Name, AvpName, _, Values, Opts, Mod) -> - enc(Name, AvpName, Values, Opts, Mod). +enc(AvpName, _, _, N, Max, _, _, _, _) + when Max =< N -> + ?THROW([repeated_avp_excessive_arity, AvpName, Max]); + +enc(AvpName, H, Min, N, Max, [V|Vs], Opts, Strict, Mod) -> + [enc(AvpName, H, V, Opts, Mod) + | enc(AvpName, H, Min, N+1, Max, Vs, Opts, Strict, Mod)]. + +%% avp_header/2 + +avp_header('AVP', _) -> + false; + +avp_header(AvpName, Mod) -> + {_,_,_} = Mod:avp_header(AvpName). %% enc/5 -enc(Name, 'AVP', Values, Opts, Mod) -> - [enc_AVP(Name, A, Opts, Mod) || A <- Values]; +enc('AVP', false, Value, Opts, Mod) -> + enc_AVP(Value, Opts, Mod); -enc(_, AvpName, Values, Opts, Mod) -> - enc(AvpName, Values, Opts, Mod). +enc(AvpName, Hdr, Value, Opts, Mod) -> + enc1(AvpName, Hdr, Value, Opts, Mod). -%% enc/4 +%% enc1/5 -enc(AvpName, Values, Opts, Mod) -> - H = Mod:avp_header(AvpName), - [diameter_codec:pack_data(H, Mod:avp(encode, V, AvpName, Opts)) - || V <- Values]. +enc1(AvpName, {_,_,_} = Hdr, Value, Opts, Mod) -> + diameter_codec:pack_data(Hdr, Mod:avp(encode, Value, AvpName, Opts)). -%% enc_AVP/4 +%% enc1/6 + +enc1(AvpName, {_,_,_} = Hdr, Value, Opts, Mod, Dict) -> + diameter_codec:pack_data(Hdr, avp(encode, Value, AvpName, Opts, Mod, Dict)). + +%% enc_AVP/3 %% No value: assume AVP data is already encoded. The normal case will %% be when this is passed back from #diameter_packet.errors as a %% consequence of a failed decode. Any AVP can be encoded this way %% however, which side-steps any arity checks for known AVP's and %% could potentially encode something unfortunate. -enc_AVP(_, #diameter_avp{value = undefined} = A, Opts, _) -> +enc_AVP(#diameter_avp{value = undefined} = A, Opts, _) -> diameter_codec:pack_avp(A, Opts); -%% Missing name for value encode. -enc_AVP(_, #diameter_avp{name = N, value = V}, _, _) - when N == undefined; - N == 'AVP' -> - ?THROW([value_with_nameless_avp, N, V]); +%% Encode a name/value pair using an alternate dictionary if need be ... +enc_AVP(#diameter_avp{name = AvpName, value = Value}, Opts, Mod) -> + enc_AVP(AvpName, Value, Opts, Mod); +enc_AVP({AvpName, Value}, Opts, Mod) -> + enc_AVP(AvpName, Value, Opts, Mod); + +%% ... or with a specified dictionary. +enc_AVP({Dict, AvpName, Value}, Opts, Mod) -> + enc1(AvpName, Dict:avp_header(AvpName), Value, Opts, Mod, Dict). -%% Or not. Ensure that 'AVP' is the appropriate field. Note that if we -%% don't know this AVP at all then the encode will fail. -enc_AVP(Name, #diameter_avp{name = AvpName, value = Data}, Opts, Mod) -> - 0 == Mod:avp_arity(Name, AvpName) - orelse ?THROW([known_avp_as_AVP, Name, AvpName, Data]), - enc(AvpName, [Data], Opts, Mod); +%% Don't guard against anything being sent as a generic 'AVP', which +%% allows arity restrictions to be abused. -%% The backdoor ... -enc_AVP(_, {AvpName, Value}, Opts, Mod) -> - enc(AvpName, [Value], Opts, Mod); +%% enc_AVP/4 -%% ... and the side door. -enc_AVP(_Name, {_Dict, _AvpName, _Data} = T, Opts, _) -> - diameter_codec:pack_avp(#diameter_avp{data = T}, Opts). +enc_AVP(AvpName, Value, Opts, Mod) -> + try Mod:avp_header(AvpName) of + H -> + enc1(AvpName, H, Value, Opts, Mod) + catch + error: _ -> + Dicts = mget(avp_dictionaries, Opts, []), + enc_AVP(Dicts, AvpName, Value, Opts, Mod) + end. + +%% enc_AVP/5 + +enc_AVP([Dict | Rest], AvpName, Value, Opts, Mod) -> + try Dict:avp_header(AvpName) of + H -> + enc1(AvpName, H, Value, Opts, Mod, Dict) + catch + error: _ -> + enc_AVP(Rest, AvpName, Value, Opts, Mod) + end; + +enc_AVP([], AvpName, _, _, _) -> + ?THROW([no_dictionary, AvpName]). %% --------------------------------------------------------------------------- %% # decode_avps/3 %% --------------------------------------------------------------------------- --spec decode_avps(parent_name(), [#diameter_avp{}], map()) - -> {parent_record(), [avp()], Failed} +-spec decode_avps(parent_name(), binary(), map()) + -> {parent_record() | parent_name(), [avp()], Failed} when Failed :: [{5000..5999, #diameter_avp{}}]. -decode_avps(Name, Recs, #{module := Mod} = Opts) -> - {Avps, {Rec, Failed}} - = mapfoldl(fun(T,A) -> decode(Name, Opts, Mod, T, A) end, - {newrec(Mod, Name), []}, - Recs), - {Rec, Avps, Failed ++ missing(Rec, Name, Failed, Opts, Mod)}. -%% Append 5005 errors so that errors are reported in the order +decode_avps(Name, Bin, #{module := Mod, decode_format := Fmt} = Opts) -> + Strict = mget(strict_arities, Opts, decode), + [AM, Avps, Failed | Rec] + = decode(Bin, Name, Mod, Fmt, Strict, Opts, 0, #{}), + %% AM counts the number of top-level AVPs, which missing/5 then + %% uses when appending 5005 errors. + {reformat(Name, Rec, Strict, Mod, Fmt), + Avps, + Failed ++ missing(Name, Strict, Mod, Opts, AM)}. + +%% Append arity errors so that errors are reported in the order %% encountered. Failed-AVP should typically contain the first -%% encountered error accordg to the RFC. +%% error encountered. + +%% decode/8 + +decode(<<Code:32, V:1, M:1, P:1, _:5, Len:24, I:V/unit:32, Rest/binary>>, + Name, + Mod, + Fmt, + Strict, + Opts, + Idx, + AM) -> + decode(Rest, + Code, + if 1 == V -> I; true -> undefined end, + Len - 8 - 4*V, %% possibly negative, causing case match to fail + (4 - (Len rem 4)) rem 4, + 1 == M, + 1 == P, + Name, + Mod, + Fmt, + Strict, + Opts, + Idx, + AM); + +decode(<<>>, Name, Mod, Fmt, Strict, _, _, AM) -> + [AM, [], [] | newrec(Fmt, Mod, Name, Strict)]; + +decode(Bin, Name, Mod, Fmt, Strict, _, Idx, AM) -> + Avp = #diameter_avp{data = Bin, index = Idx}, + [AM, [Avp], [{5014, Avp}] | newrec(Fmt, Mod, Name, Strict)]. + +%% decode/14 + +decode(Bin, Code, Vid, DataLen, Pad, M, P, Name, Mod, Fmt, Strict, Opts0, + Idx, AM0) -> + case Bin of + <<Data:DataLen/binary, _:Pad/binary, T/binary>> -> + {NameT, Field, Arity, {I, AM}} + = incr(Name, Code, Vid, M, Mod, Strict, Opts0, AM0), + + Opts = setopts(NameT, Name, M, Opts0), + %% Not AvpName or else a failed Failed-AVP + %% decode is packed into 'AVP'. + + Avp = #diameter_avp{code = Code, + vendor_id = Vid, + is_mandatory = M, + need_encryption = P, + data = Data, + name = name(NameT), + type = type(NameT), + index = Idx}, + + Dec = dec(Data, Name, NameT, Mod, Fmt, Opts, Avp), + Acc = decode(T, Name, Mod, Fmt, Strict, Opts, Idx+1, AM),%% recurse + acc(Acc, Dec, I, Field, Arity, Strict, Mod, Opts); + _ -> + {NameT, _Field, _Arity, {_, AM}} + = incr(Name, Code, Vid, M, Mod, Strict, Opts0, AM0), + + Avp = #diameter_avp{code = Code, + vendor_id = Vid, + is_mandatory = M, + need_encryption = P, + data = Bin, + name = name(NameT), + type = type(NameT), + index = Idx}, + + [AM, [Avp], [{5014, Avp}] | newrec(Fmt, Mod, Name, Strict)] + end. + +%% incr/8 + +incr(Name, Code, Vid, M, Mod, Strict, Opts, AM0) -> + NameT = Mod:avp_name(Code, Vid), %% {AvpName, Type} | 'AVP' + Field = field(NameT), %% AvpName | 'AVP' + Arity = avp_arity(Name, Field, Mod, Opts, M), + if 0 == Arity, 'AVP' /= Field -> + A = pack_arity(Name, Field, Opts, Mod, M), + {NameT, 'AVP', A, incr('AVP', A, Strict, AM0)}; + true -> + {NameT, Field, Arity, incr(Field, Arity, Strict, AM0)} + end. -%% mapfoldl/3 +%% Data is a truncated header if command_code = undefined, otherwise +%% payload bytes. The former is padded to the length of a header if +%% the AVP reaches an outgoing encode. %% -%% Like lists:mapfoldl/3, but don't reverse the list. +%% RFC 6733 says that an AVP returned with 5014 can contain a minimal +%% payload for the AVP's type, but don't always know the type. -mapfoldl(F, Acc, List) -> - mapfoldl(F, Acc, List, []). +setopts('AVP', _, _, Opts) -> + Opts; -mapfoldl(F, Acc0, [T|Rest], List) -> - {B, Acc} = F(T, Acc0), - mapfoldl(F, Acc, Rest, [B|List]); -mapfoldl(_, Acc, [], List) -> - {List, Acc}. +setopts({_, Type}, Name, M, Opts) -> + set_failed(Name, set_strict(Type, M, Opts)). -%% 3588: +%% incr/4 + +incr(_, A, SA, AM) + when A == ?ANY; + A == 0; + SA /= decode -> + {undefined, AM}; + +incr(AvpName, _, _, AM) -> + case AM of + #{AvpName := N} -> + {N, AM#{AvpName => N+1}}; + _ -> + {0, AM#{AvpName => 1}} + end. + +%% mget/3 +%% +%% Measurably faster than maps:get/3. + +mget(Key, Map, Def) -> + case Map of + #{Key := V} -> + V; + _ -> + Def + end. + +%% name/1 + +name({Name, _}) -> + Name; +name(_) -> + undefined. + +%% type/1 + +type({_, Type}) -> + Type; +type(_) -> + undefined. + +%% missing/5 + +missing(Name, decode, Mod, Opts, AM) -> + [{5005, empty_avp(N, Opts, Mod)} || {N,A} <- Mod:avp_arity(Name), + N /= 'AVP', + Mn <- [min_arity(A)], + 0 < Mn, + mget(N, AM, 0) < Mn]; + +missing(_, _, _, _, _) -> + []. + +%% 3588/6733: %% %% DIAMETER_MISSING_AVP 5005 %% The request did not contain an AVP that is required by the Command @@ -204,57 +428,20 @@ mapfoldl(_, Acc, [], List) -> %% Vendor-Id if applicable. The value field of the missing AVP %% should be of correct minimum length and contain zeros. -missing(Rec, Name, Failed, Opts, Mod) -> - Avps = lists:foldl(fun({_, #diameter_avp{code = C, vendor_id = V}}, A) -> - maps:put({C,V}, true, A) - end, - maps:new(), - Failed), - missing(Mod:avp_arity(Name), tl(tuple_to_list(Rec)), Avps, Opts, Mod, []). - -missing([{Name, Arity} | As], [Value | Vs], Avps, Opts, Mod, Acc) -> - missing(As, - Vs, - Avps, - Opts, - Mod, - case - [H || missing_arity(Arity, Value), - {C,_,V} = H <- [Mod:avp_header(Name)], - not maps:is_key({C,V}, Avps)] - of - [H] -> - [{5005, empty_avp(Name, H, Opts, Mod)} | Acc]; - [] -> - Acc - end); - -missing([], [], _, _, _, Acc) -> - Acc. - -%% Maximum arities have already been checked in building the record. - -missing_arity(1, V) -> - V == undefined; -missing_arity({0, _}, _) -> - false; -missing_arity({1, _}, L) -> - [] == L; -missing_arity({Min, _}, L) -> - not has_prefix(Min, L). - -%% Compare a non-negative integer and the length of a list without -%% computing the length. -has_prefix(0, _) -> - true; -has_prefix(_, []) -> - false; -has_prefix(N, [_|L]) -> - has_prefix(N-1, L). +%% min_arity/1 -%% empty_avp/4 +min_arity(1) -> + 1; +min_arity({Mn,_}) -> + Mn. -empty_avp(Name, {Code, Flags, VId}, Opts, Mod) -> +%% empty_avp/3 + +empty_avp('AVP', _, _) -> + #diameter_avp{data = <<0:64>>}; + +empty_avp(Name, Opts, Mod) -> + {Code, Flags, VId} = Mod:avp_header(Name), {Name, Type} = Mod:avp_name(Code, VId), #diameter_avp{name = Name, code = Code, @@ -273,21 +460,22 @@ empty_avp(Name, {Code, Flags, VId}, Opts, Mod) -> %% specific errors that can be described by this AVP are described in %% the following section. -%% decode/5 +%% field/1 -decode(Name, - Opts, - Mod, - #diameter_avp{code = Code, vendor_id = Vid} - = Avp, - Acc) -> - decode(Name, Opts, Mod, Mod:avp_name(Code, Vid), Avp, Acc). +field({AvpName, _}) -> + AvpName; +field(_) -> + 'AVP'. + +%% dec/7 + +%% AVP not in dictionary: try an alternate. -%% decode/6 +dec(_, _, 'AVP', _Mod, none, _, Avp) -> %% none decode is no-op + Avp; -%% AVP not in dictionary. -decode(Name, Opts, Mod, 'AVP', Avp, Acc) -> - decode_AVP(Name, Avp, Opts, Mod, Acc); +dec(Data, Name, 'AVP', Mod, Fmt, Opts, Avp) -> + dec_AVP(dicts(Mod, Opts), Data, Name, Mod, Fmt, Opts, Avp); %% 6733, 4.4: %% @@ -336,130 +524,130 @@ decode(Name, Opts, Mod, 'AVP', Avp, Acc) -> %% defined the RFC's "unrecognized", which is slightly stronger than %% "not defined".) -decode(Name, Opts0, Mod, {AvpName, Type}, Avp, Acc) -> - #diameter_avp{data = Data, is_mandatory = M} - = Avp, +dec(Data, Name, {AvpName, Type}, Mod, Fmt, Opts, Avp) -> + #{app_dictionary := AppMod, failed_avp := Failed} + = Opts, - %% Whether or not to ignore an M-bit on an encapsulated AVP, or on - %% all AVPs with the service_opt() strict_mbit. - Opts1 = set_strict(Type, M, Opts0), + %% Reset the dictionary for best-effort decode of Failed-AVP. + Dict = if Failed -> AppMod; + true -> Mod + end, - %% Whether or not we're decoding within Failed-AVP and should - %% ignore decode errors. - #{dictionary := AppMod, failed_avp := Failed} - = Opts - = set_failed(Name, Opts1), %% Not AvpName or else a failed Failed-AVP - %% decode is packed into 'AVP'. + dec(Data, Name, AvpName, Type, Mod, Dict, Fmt, Failed, Opts, Avp). - %% Reset the dictionary for best-effort decode of Failed-AVP. - DecMod = if Failed -> - AppMod; - true -> - Mod - end, - - %% On decode, a Grouped AVP is represented as a #diameter_avp{} - %% list with AVP as head and component AVPs as tail. On encode, - %% data can be a list of component AVPs. - - try avp_decode(Data, AvpName, Opts, DecMod, Mod) of - {Rec, As} when Type == 'Grouped' -> - A = Avp#diameter_avp{name = AvpName, - value = Rec, - type = Type}, - {[A|As], pack_avp(Name, A, Opts, Mod, Acc)}; +%% dicts/2 - V when Type /= 'Grouped' -> - A = Avp#diameter_avp{name = AvpName, - value = V, - type = Type}, - {A, pack_avp(Name, A, Opts, Mod, Acc)} - catch - throw: {?MODULE, {grouped, Error, ComponentAvps}} -> - decode_error(Name, - Error, - ComponentAvps, - Opts, - Mod, - Avp#diameter_avp{name = AvpName, - data = trim(Avp#diameter_avp.data), - type = Type}, - Acc); +dicts(Mod, #{app_dictionary := Mod, avp_dictionaries := Dicts}) -> + Dicts; + +dicts(_, #{app_dictionary := Dict, avp_dictionaries := Dicts}) -> + [Dict | Dicts]; +dicts(Mod, #{app_dictionary := Mod}) -> + []; + +dicts(_, #{app_dictionary := Dict}) -> + [Dict]. + +%% dec/10 + +dec(Data, Name, AvpName, Type, Mod, Dict, Fmt, Failed, Opts, Avp) -> + try avp(decode, Data, AvpName, Opts, Mod, Dict) of + V -> + set(Type, Fmt, Avp, V) + catch + throw: {?MODULE, T} -> + decode_error(Failed, Fmt, T, Avp); error: Reason -> - decode_error(Name, - Reason, - Opts, - Mod, - Avp#diameter_avp{name = AvpName, - data = trim(Avp#diameter_avp.data), - type = Type}, - Acc) + decode_error(Failed, Reason, Name, Mod, Opts, Avp) end. -%% avp_decode/5 +%% dec_AVP/7 -avp_decode(Data, AvpName, Opts, Mod, Mod) -> - Mod:avp(decode, Data, AvpName, Opts); +dec_AVP([], _, _, _, _, _, Avp) -> + Avp; -avp_decode(Data, AvpName, Opts, Mod, _) -> - Mod:avp(decode, Data, AvpName, Opts, Mod). +dec_AVP(Dicts, Data, Name, Mod, Fmt, Opts, #diameter_avp{code = Code, + vendor_id = Vid} + = Avp) -> + dec_AVP(Dicts, Data, Name, Mod, Fmt, Opts, Code, Vid, Avp). -%% trim/1 +%% dec_AVP/9 %% -%% Remove any extra bit that was added in diameter_codec to induce a -%% 5014 error. +%% Try to decode an AVP in the first alternate dictionary that defines +%% it. + +dec_AVP([Dict | Rest], Data, Name, Mod, Fmt, Opts, Code, Vid, Avp) -> + case Dict:avp_name(Code, Vid) of + {AvpName, Type} -> + A = Avp#diameter_avp{name = AvpName, + type = Type}, + #{failed_avp := Failed} = Opts, + dec(Data, Name, AvpName, Type, Mod, Dict, Fmt, Failed, Opts, A); + _ -> + dec_AVP(Rest, Data, Name, Mod, Fmt, Opts, Code, Vid, Avp) + end; -trim(#diameter_avp{data = Data} = Avp) -> - Avp#diameter_avp{data = trim(Data)}; +dec_AVP([], _, _, _, _, _, _, _, Avp) -> + Avp. -trim({5014, Bin}) -> - Bin; +%% set/4 +%% +%% A Grouped AVP is represented as a #diameter_avp{} list with AVP +%% as head and component AVPs as tail. -trim(Avps) - when is_list(Avps) -> - lists:map(fun trim/1, Avps); +set('Grouped', none, Avp, V) -> + {_Rec, As} = V, + [Avp | As]; -trim(Avp) -> - Avp. +set('Grouped', _, Avp, V) -> + {Rec, As} = V, + [Avp#diameter_avp{value = Rec} | As]; -%% decode_error/7 +set(_, _, Avp, V) -> + Avp#diameter_avp{value = V}. -decode_error(Name, [_ | Rec], _, #{failed_avp := true} = Opts, Mod, Avp, Acc) -> - decode_AVP(Name, Avp#diameter_avp{value = Rec}, Opts, Mod, Acc); +%% decode_error/4 +%% +%% Error when decoding a grouped AVP. -decode_error(Name, _, _, #{failed_avp := true} = Opts, Mod, Avp, Acc) -> - decode_AVP(Name, Avp, Opts, Mod, Acc); +decode_error(true, none, _, Avp) -> + Avp; -decode_error(_, [Error | _], ComponentAvps, _, _, Avp, Acc) -> - decode_error(Error, Avp, Acc, ComponentAvps); +decode_error(true, _, {Rec, _, _}, Avp) -> + Avp#diameter_avp{value = Rec}; -decode_error(_, Error, ComponentAvps, _, _, Avp, Acc) -> - decode_error(Error, Avp, Acc, ComponentAvps). +decode_error(false, _, {_, ComponentAvps, [{RC,A} | _]}, Avp) -> + {RC, [Avp | ComponentAvps], Avp#diameter_avp{data = [A]}}. -%% decode_error/5 +%% decode_error/6 +%% +%% Error when decoding a non-grouped AVP. -decode_error(Name, _Reason, #{failed_avp := true} = Opts, Mod, Avp, Acc) -> - decode_AVP(Name, Avp, Opts, Mod, Acc); +decode_error(true, _, _, _, _, Avp) -> + Avp; -decode_error(Name, Reason, Opts, Mod, Avp, {Rec, Failed}) -> +decode_error(false, Reason, Name, Mod, Opts, Avp) -> Stack = diameter_lib:get_stacktrace(), diameter_lib:log(decode_error, ?MODULE, ?LINE, {Reason, Name, Avp#diameter_avp.name, Mod, Stack}), - {Avp, {Rec, [rc(Reason, Avp, Opts, Mod) | Failed]}}. + rc(Reason, Avp, Opts, Mod). -%% decode_error/4 +%% avp/6 -decode_error({RC, ErrorData}, Avp, {Rec, Failed}, ComponentAvps) -> - E = Avp#diameter_avp{data = [ErrorData]}, - {[Avp | trim(ComponentAvps)], {Rec, [{RC, E} | Failed]}}. +avp(T, Data, AvpName, Opts, Mod, Mod) -> + Mod:avp(T, Data, AvpName, Opts); -%% set_strict/3 +avp(T, Data, AvpName, Opts, _, Mod) -> + Mod:avp(T, Data, AvpName, Opts#{module := Mod}). +%% set_strict/3 +%% %% Set false as soon as we see a Grouped AVP that doesn't set the %% M-bit, to ignore the M-bit on an encapsulated AVP. + set_strict('Grouped', false = M, #{strict_mbit := true} = Opts) -> Opts#{strict_mbit := M}; set_strict(_, _, Opts) -> @@ -476,185 +664,207 @@ set_failed('Failed-AVP', #{failed_avp := false} = Opts) -> set_failed(_, Opts) -> Opts. -%% decode_AVP/5 -%% -%% Don't know this AVP: see if it can be packed in an 'AVP' field -%% undecoded. Note that the type field is 'undefined' in this case. - -decode_AVP(Name, Avp, Opts, Mod, Acc) -> - {trim(Avp), pack_AVP(Name, Avp, Opts, Mod, Acc)}. - -%% rc/2 - -%% diameter_types will raise an error of this form to communicate -%% DIAMETER_INVALID_AVP_LENGTH (5014). A module specified to a -%% @custom_types tag in a dictionary file can also raise an error of -%% this form. -rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = Avp, Opts, Mod) -> - {RC, Avp#diameter_avp{data = Mod:empty_value(AvpName, Opts)}}; +%% acc/8 + +acc([AM | Acc], As, I, Field, Arity, Strict, Mod, Opts) -> + [AM | acc1(Acc, As, I, Field, Arity, Strict, Mod, Opts)]. + +%% acc1/8 + +%% Faulty AVP, not grouped. +acc1(Acc, {_RC, Avp} = E, _, _, _, _, _, _) -> + [Avps, Failed | Rec] = Acc, + [[Avp | Avps], [E | Failed] | Rec]; + +%% Faulty component in grouped AVP. +acc1(Acc, {RC, As, Avp}, _, _, _, _, _, _) -> + [Avps, Failed | Rec] = Acc, + [[As | Avps], [{RC, Avp} | Failed] | Rec]; + +%% Grouped AVP ... +acc1([Avps | Acc], [Avp|_] = As, I, Field, Arity, Strict, Mod, Opts) -> + [[As|Avps] | acc2(Acc, Avp, I, Field, Arity, Strict, Mod, Opts)]; + +%% ... or not. +acc1([Avps | Acc], Avp, I, Field, Arity, Strict, Mod, Opts) -> + [[Avp|Avps] | acc2(Acc, Avp, I, Field, Arity, Strict, Mod, Opts)]. + +%% The component list of a Grouped AVP is discarded when packing into +%% the record (or equivalent): the values in an 'AVP' field are +%% diameter_avp records, not a list of records in the Grouped case, +%% and the decode into the value field is best-effort. The reason is +%% history more than logic: it would probably have made more sense to +%% retain the same structure as in diameter_packet.avps, but an 'AVP' +%% list has always been flat. + +%% acc2/8 + +%% No errors, but nowhere to pack. +acc2(Acc, Avp, _, 'AVP', 0, _, _, _) -> + [Failed | Rec] = Acc, + [[{rc(Avp), Avp} | Failed] | Rec]; + +%% Relaxed arities. +acc2(Acc, Avp, _, Field, Arity, Strict, Mod, _) + when Strict /= decode -> + pack(Arity, Field, Avp, Mod, Acc); + +%% No maximum arity. +acc2(Acc, Avp, _, Field, {_,'*'} = Arity, _, Mod, _) -> + pack(Arity, Field, Avp, Mod, Acc); + +%% Or check. +acc2(Acc, Avp, I, Field, Arity, _, Mod, _) -> + Mx = max_arity(Arity), + if Mx =< I -> + [Failed | Rec] = Acc, + [[{5009, Avp} | Failed] | Rec]; + true -> + pack(Arity, Field, Avp, Mod, Acc) + end. -%% 3588: +%% 3588/6733: %% -%% DIAMETER_INVALID_AVP_VALUE 5004 -%% The request contained an AVP with an invalid value in its data -%% portion. A Diameter message indicating this error MUST include -%% the offending AVPs within a Failed-AVP AVP. -rc(_, Avp, _, _) -> - {5004, Avp}. - -%% pack_avp/5 - -pack_avp(Name, #diameter_avp{name = AvpName} = Avp, Opts, Mod, Acc) -> - pack_avp(Name, Mod:avp_arity(Name, AvpName), Avp, Opts, Mod, Acc). +%% DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009 +%% A message was received that included an AVP that appeared more +%% often than permitted in the message definition. The Failed-AVP +%% AVP MUST be included and contain a copy of the first instance of +%% the offending AVP that exceeded the maximum number of occurrences -%% pack_avp/6 +%% max_arity/1 -pack_avp(Name, 0, Avp, Opts, Mod, Acc) -> - pack_AVP(Name, Avp, Opts, Mod, Acc); +max_arity(1) -> + 1; +max_arity({_,Mx}) -> + Mx. -pack_avp(_, Arity, #diameter_avp{name = AvpName} = Avp, _Opts, Mod, Acc) -> - pack(Arity, AvpName, Avp, Mod, Acc). +%% rc/1 -%% pack_AVP/5 +rc(#diameter_avp{is_mandatory = M}) -> + if M -> 5001; true -> 5008 end. -%% Length failure was induced because of a header/payload length -%% mismatch. The AVP Length is reset to match the received data if -%% this AVP is encoded in an answer message, since the length is -%% computed. +%% 3588: %% -%% Data is a truncated header if command_code = undefined, otherwise -%% payload bytes. The former is padded to the length of a header if -%% the AVP reaches an outgoing encode in diameter_codec. +%% DIAMETER_AVP_UNSUPPORTED 5001 +%% The peer received a message that contained an AVP that is not +%% recognized or supported and was marked with the Mandatory bit. A +%% Diameter message with this error MUST contain one or more Failed- +%% AVP AVP containing the AVPs that caused the failure. %% -%% RFC 6733 says that an AVP returned with 5014 can contain a minimal -%% payload for the AVP's type, but in this case we don't know the -%% type. - -pack_AVP(_, #diameter_avp{data = {5014 = RC, Data}} = Avp, _, _, Acc) -> - {Rec, Failed} = Acc, - {Rec, [{RC, Avp#diameter_avp{data = Data}} | Failed]}; - -pack_AVP(Name, Avp, Opts, Mod, Acc) -> - pack_arity(Name, pack_arity(Name, Opts, Mod, Avp), Avp, Mod, Acc). +%% DIAMETER_AVP_NOT_ALLOWED 5008 +%% A message was received with an AVP that MUST NOT be present. The +%% Failed-AVP AVP MUST be included and contain a copy of the +%% offending AVP. %% pack_arity/5 -pack_arity(_, 0, #diameter_avp{is_mandatory = M} = Avp, _, Acc) -> - {Rec, Failed} = Acc, - {Rec, [{if M -> 5001; true -> 5008 end, Avp} | Failed]}; - -pack_arity(_, Arity, Avp, Mod, Acc) -> - pack(Arity, 'AVP', Avp, Mod, Acc). - %% Give Failed-AVP special treatment since (1) it'll contain any %% unrecognized mandatory AVP's and (2) the RFC 3588 grammar failed to %% allow for Failed-AVP in an answer-message. -pack_arity(Name, - #{strict_mbit := Strict, - failed_avp := Failed}, - Mod, - #diameter_avp{is_mandatory = M, - name = AvpName}) -> +pack_arity(Name, AvpName, _, Mod, M) + when Name == 'Failed-AVP'; + Name == 'answer-message', AvpName == 'Failed-AVP'; + not M -> + Mod:avp_arity(Name, 'AVP'); +%% Not testing just Name /= 'Failed-AVP' means we're changing the +%% packing of AVPs nested within Failed-AVP, but the point of +%% ignoring errors within Failed-AVP is to decode as much as +%% possible, and failing because a mandatory AVP couldn't be +%% packed into a dedicated field defeats that point. - %% Not testing just Name /= 'Failed-AVP' means we're changing the - %% packing of AVPs nested within Failed-AVP, but the point of - %% ignoring errors within Failed-AVP is to decode as much as - %% possible, and failing because a mandatory AVP couldn't be - %% packed into a dedicated field defeats that point. +pack_arity(Name, _, #{strict_mbit := Strict, failed_avp := Failed}, Mod, _) + when not Strict; + Failed -> + Mod:avp_arity(Name, 'AVP'); - if Failed == true; - Name == 'Failed-AVP'; - Name == 'answer-message', AvpName == 'Failed-AVP'; - not M; - not Strict -> - Mod:avp_arity(Name, 'AVP'); - true -> - 0 - end. +pack_arity(_, _, _, _, _) -> + 0. + +%% avp_arity/5 + +avp_arity(Name, 'AVP' = AvpName, Mod, Opts, M) -> + pack_arity(Name, AvpName, Opts, Mod, M); + +avp_arity(Name, AvpName, Mod, _, _) -> + Mod:avp_arity(Name, AvpName). + +%% rc/4 + +%% Length error communicated from diameter_types or a +%% @custom_types/@codecs module. +rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = A, Opts, Mod) -> + {RC, A#diameter_avp{data = Mod:empty_value(AvpName, Opts)}}; %% 3588: %% -%% DIAMETER_AVP_UNSUPPORTED 5001 -%% The peer received a message that contained an AVP that is not -%% recognized or supported and was marked with the Mandatory bit. A -%% Diameter message with this error MUST contain one or more Failed- -%% AVP AVP containing the AVPs that caused the failure. -%% -%% DIAMETER_AVP_NOT_ALLOWED 5008 -%% A message was received with an AVP that MUST NOT be present. The -%% Failed-AVP AVP MUST be included and contain a copy of the -%% offending AVP. +%% DIAMETER_INVALID_AVP_VALUE 5004 +%% The request contained an AVP with an invalid value in its data +%% portion. A Diameter message indicating this error MUST include +%% the offending AVPs within a Failed-AVP AVP. +rc(_, Avp, _, _) -> + {5004, Avp}. %% pack/5 -pack(Arity, FieldName, Avp, Mod, {Rec, _} = Acc) -> - pack(Mod:'#get-'(FieldName, Rec), Arity, FieldName, Avp, Mod, Acc). +pack(Arity, F, Avp, Mod, [Failed | Rec]) -> + [Failed | set(Arity, F, value(F, Avp), Mod, Rec)]. -%% pack/6 +%% set/5 -pack(undefined, 1, 'AVP' = F, Avp, Mod, {Rec, Failed}) -> %% unlikely - {Mod:'#set-'({F, Avp}, Rec), Failed}; +set(_, _, _, _, None) + when is_atom(None) -> + None; -pack(undefined, 1, F, #diameter_avp{value = V}, Mod, {Rec, Failed}) -> - {Mod:'#set-'({F, V}, Rec), Failed}; +set(1, F, Value, _, Map) + when is_map(Map) -> + Map#{F => Value}; -%% 3588: -%% -%% DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009 -%% A message was received that included an AVP that appeared more -%% often than permitted in the message definition. The Failed-AVP -%% AVP MUST be included and contain a copy of the first instance of -%% the offending AVP that exceeded the maximum number of occurrences -%% +set(_, F, V, _, Map) + when is_map(Map) -> + maps:update_with(F, fun(Vs) -> [V|Vs] end, [V], Map); -pack(_, 1, _, Avp, _, {Rec, Failed}) -> - {Rec, [{5009, Avp} | Failed]}; - -pack(L, {_, Max}, F, Avp, Mod, {Rec, Failed}) -> - case '*' /= Max andalso has_prefix(Max+1, L) of - true -> - {Rec, [{5009, Avp} | Failed]}; - false when F == 'AVP' -> - {Mod:'#set-'({F, [Avp | L]}, Rec), Failed}; - false -> - {Mod:'#set-'({F, [Avp#diameter_avp.value | L]}, Rec), Failed} - end. +set(1, F, Value, Mod, Rec) -> + Mod:'#set-'({F, Value}, Rec); + +set(_, F, V, Mod, Rec) -> + Vs = Mod:'#get-'(F, Rec), + Mod:'#set-'({F, [V|Vs]}, Rec). + +%% value/2 + +value('AVP', Avp) -> + Avp; + +value(_, #diameter_avp{value = V}) -> + V. %% --------------------------------------------------------------------------- %% # grouped_avp/3 %% --------------------------------------------------------------------------- --spec grouped_avp(decode, avp_name(), binary() | {5014, binary()}, term()) +%% Note that Grouped is the only AVP type that doesn't just return a +%% decoded value, also returning the list of component diameter_avp +%% records. + +-spec grouped_avp(decode, avp_name(), binary(), term()) -> {avp_record(), [avp()]}; (encode, avp_name(), avp_record() | avp_values(), term()) -> iolist() | no_return(). -%% Length error induced by diameter_codec:collect_avps/1: the AVP -%% length in the header was too short (insufficient for the extracted -%% header) or too long (past the end of the message). An empty payload -%% is sufficient according to the RFC text for 5014. -grouped_avp(decode, _Name, {5014 = RC, _Bin}, _) -> - ?THROW({grouped, {RC, []}, []}); - -grouped_avp(decode, Name, Data, Opts) -> - grouped_decode(Name, diameter_codec:collect_avps(Data), Opts); +%% An error in decoding a component AVP throws the first faulty +%% component, which a catch wraps in the Grouped AVP in question. A +%% partially decoded record is only used when ignoring errors in +%% Failed-AVP. +grouped_avp(decode, Name, Bin, Opts) -> + {Rec, Avps, Es} = T = decode_avps(Name, Bin, Opts), + [] == Es orelse ?THROW(T), + {Rec, Avps}; grouped_avp(encode, Name, Data, Opts) -> encode_avps(Name, Data, Opts). -%% grouped_decode/2 -%% -%% Note that Grouped is the only AVP type that doesn't just return a -%% decoded value, also returning the list of component diameter_avp -%% records. - -%% Length error in trailing component AVP. -grouped_decode(_Name, {Error, Acc}, _) -> - {5014, Avp} = Error, - ?THROW({grouped, Error, [Avp | Acc]}); - %% 7.5. Failed-AVP AVP %% In the case where the offending AVP is embedded within a Grouped AVP, @@ -665,15 +875,6 @@ grouped_decode(_Name, {Error, Acc}, _) -> %% to the single offending AVP. This enables the recipient to detect %% the location of the offending AVP when embedded in a group. -%% An error in decoding a component AVP throws the first faulty -%% component, which the catch in d/3 wraps in the Grouped AVP in -%% question. A partially decoded record is only used when ignoring -%% errors in Failed-AVP. -grouped_decode(Name, ComponentAvps, Opts) -> - {Rec, Avps, Es} = decode_avps(Name, ComponentAvps, Opts), - [] == Es orelse ?THROW({grouped, [{_,_} = hd(Es) | Rec], Avps}), - {Rec, Avps}. - %% --------------------------------------------------------------------------- %% # empty_group/2 %% --------------------------------------------------------------------------- @@ -705,5 +906,45 @@ empty(Name, #{module := Mod} = Opts) -> %% ------------------------------------------------------------------------------ +%% newrec/4 + +newrec(none, _, Name, _) -> + Name; + +newrec(record, Mod, Name, T) + when T /= decode -> + RecName = Mod:name2rec(Name), + Sz = Mod:'#info-'(RecName, size), + erlang:make_tuple(Sz, [], [{1, RecName}]); + +newrec(record, Mod, Name, _) -> + newrec(Mod, Name); + +newrec(_, _, _, _) -> + #{}. + +%% newrec/2 + newrec(Mod, Name) -> Mod:'#new-'(Mod:name2rec(Name)). + +%% reformat/5 + +reformat(Name, Map, _Strict, Mod, list) -> + [{F,V} || {F,_} <- Mod:avp_arity(Name), #{F := V} <- [Map]]; + +reformat(Name, Map, Strict, Mod, record_from_map) -> + RecName = Mod:name2rec(Name), + list_to_tuple([RecName | [mget(F, Map, def(A, Strict)) + || {F,A} <- Mod:avp_arity(Name)]]); + +reformat(_, Rec, _, _, _) -> + Rec. + +%% def/2 + +def(1, decode) -> + undefined; + +def(_, _) -> + []. diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl index 8792e97621..1c1ea42cb5 100644 --- a/lib/diameter/src/base/diameter_lib.erl +++ b/lib/diameter/src/base/diameter_lib.erl @@ -283,7 +283,7 @@ ip(T) %% Or not: convert from '.'/':'-separated decimal/hex. ip(Addr) -> - {ok, A} = inet_parse:address(Addr), %% documented in inet(3) + {ok, A} = inet:parse_address(Addr), A. %% --------------------------------------------------------------------------- diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl index 2759f17e64..4cb5a57a54 100644 --- a/lib/diameter/src/base/diameter_peer.erl +++ b/lib/diameter/src/base/diameter_peer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -202,10 +202,10 @@ match1(Addr, Match) -> match(Addr, {ok, A}, _) -> Addr == A; match(Addr, {error, _}, RE) -> - match == re:run(inet_parse:ntoa(Addr), RE, [{capture, none}]). + match == re:run(inet:ntoa(Addr), RE, [{capture, none}, caseless]). addr([_|_] = A) -> - inet_parse:address(A); + inet:parse_address(A); addr(A) -> {ok, A}. diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 1b0dc417e5..d99f11a697 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -128,7 +128,8 @@ %% outgoing DPR; boolean says whether or not %% the request was sent explicitly with %% diameter:call/4. - codec :: #{string_decode := boolean(), + codec :: #{decode_format := diameter:decode_format(), + string_decode := boolean(), strict_mbit := boolean(), rfc := 3588 | 6733, ordered_encode := false}, @@ -237,7 +238,7 @@ i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) -> proplists:get_value(dpa_timeout, Opts, ?DPA_TIMEOUT)}), Tmo = proplists:get_value(capx_timeout, Opts, ?CAPX_TIMEOUT), - Strictness = proplists:get_value(capx_strictness, Opts, true), + Strict = proplists:get_value(strict_capx, Opts, true), LengthErr = proplists:get_value(length_errors, Opts, exit), {TPid, Addrs} = start_transport(T, Rest, Svc), @@ -251,9 +252,10 @@ i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) -> mode = M, service = svc(Svc, Addrs), length_errors = LengthErr, - strict = Strictness, + strict = Strict, incoming_maxlen = Maxlen, - codec = maps:with([string_decode, + codec = maps:with([decode_format, + string_decode, strict_mbit, rfc, ordered_encode], @@ -542,11 +544,11 @@ put_route(Pid) -> MRef = monitor(process, Pid), put(Pid, MRef). -%% get_route/2 +%% get_route/3 -%% incoming answer -get_route(_, #diameter_packet{header = #diameter_header{is_request = false}} - = Pkt) -> +%% Incoming answer. +get_route(_, _, #diameter_packet{header = #diameter_header{is_request = false}} + = Pkt) -> Seqs = diameter_codec:sequence_numbers(Pkt), case erase(Seqs) of {Pid, Ref, MRef} -> @@ -557,8 +559,14 @@ get_route(_, #diameter_packet{header = #diameter_header{is_request = false}} false end; -%% incoming request -get_route(Ack, _) -> +%% Requests answered here ... +get_route(_, N, _) + when N == 'CER'; + N == 'DPR' -> + false; + +%% ... or not. +get_route(Ack, _, _) -> Ack. %% erase_route/1 @@ -649,10 +657,6 @@ encode(Rec, Opts, Dict) -> %% incoming/2 -incoming({recv = T, Name, Pkt}, #state{parent = Pid, ack = Ack} = S) -> - Pid ! {T, self(), get_route(Ack, Pkt), Name, Pkt}, - rcv(Name, Pkt, S); - incoming(#diameter_header{is_request = R}, #state{transport = TPid, ack = Ack}) -> R andalso Ack andalso send(TPid, false), @@ -670,98 +674,97 @@ incoming(T, _) -> %% recv/2 -recv(#diameter_packet{header = #diameter_header{} = Hdr} - = Pkt, - #state{dictionary = Dict0} - = S) -> - recv1(diameter_codec:msg_name(Dict0, Hdr), Pkt, S); - -recv(#diameter_packet{header = undefined, - bin = Bin} - = Pkt, - S) -> - recv(diameter_codec:decode_header(Bin), Pkt, S); +recv(#diameter_packet{bin = Bin} = Pkt, S) -> + recv(Bin, Pkt, S); recv(Bin, S) -> - recv(#diameter_packet{bin = Bin}, S). + recv(Bin, Bin, S). + +%% recv/3 + +recv(Bin, Msg, S) -> + recv(diameter_codec:decode_header(Bin), Bin, Msg, S). -%% recv1/3 +%% recv/4 -recv1(_, - #diameter_packet{header = H, bin = Bin}, - #state{incoming_maxlen = M}) +recv(false, Bin, _, #state{length_errors = E}) -> + invalid(E, truncated_header, Bin), + Bin; + +recv(#diameter_header{length = Len} = H, Bin, Msg, #state{length_errors = E, + incoming_maxlen = M, + dictionary = Dict0} + = S) + when E == handle; + 0 == Len rem 4, bit_size(Bin) == 8*Len, size(Bin) =< M -> + recv1(diameter_codec:msg_name(Dict0, H), H, Msg, S); + +recv(H, Bin, _, #state{incoming_maxlen = M}) when M < size(Bin) -> invalid(false, incoming_maxlen_exceeded, {size(Bin), H}), H; +recv(H, Bin, _, #state{length_errors = E}) -> + T = {size(Bin), bit_size(Bin) rem 8, H}, + invalid(E, message_length_mismatch, T), + H. + +%% recv1/4 + %% Ignore anything but an expected CER/CEA if so configured. This is %% non-standard behaviour. -recv1(Name, #diameter_packet{header = H}, #state{state = {'Wait-CEA', _, _}, - strict = false}) +recv1(Name, H, _, #state{state = {'Wait-CEA', _, _}, + strict = false}) when Name /= 'CEA' -> H; -recv1(Name, #diameter_packet{header = H}, #state{state = recv_CER, - strict = false}) +recv1(Name, H, _, #state{state = recv_CER, + strict = false}) when Name /= 'CER' -> H; %% Incoming request after outgoing DPR: discard. Don't discard DPR, so %% both ends don't do so when sending simultaneously. -recv1(Name, - #diameter_packet{header = #diameter_header{is_request = true} = H}, - #state{dpr = {_,_,_}}) +recv1(Name, #diameter_header{is_request = true} = H, _, #state{dpr = {_,_,_}}) when Name /= 'DPR' -> invalid(false, recv_after_outgoing_dpr, H), H; %% Incoming request after incoming DPR: discard. -recv1(_, - #diameter_packet{header = #diameter_header{is_request = true} = H}, - #state{dpr = true}) -> +recv1(_, #diameter_header{is_request = true} = H, _, #state{dpr = true}) -> invalid(false, recv_after_incoming_dpr, H), H; %% DPA with identifier mismatch, or in response to a DPR initiated by %% the service. -recv1('DPA' = N, - #diameter_packet{header = #diameter_header{hop_by_hop_id = Hid, - end_to_end_id = Eid}} - = Pkt, - #state{dpr = {X,H,E}} +recv1('DPA' = Name, + #diameter_header{hop_by_hop_id = Hid, end_to_end_id = Eid} + = H, + Msg, + #state{dpr = {X,HI,EI}} = S) - when H /= Hid; - E /= Eid; + when HI /= Hid; + EI /= Eid; not X -> - rcv(N, Pkt, S); + Pkt = pkt(H, Msg), + handle(Name, Pkt, S); -%% Any other message with a header and no length errors: send to the -%% parent. -recv1(Name, Pkt, #state{}) -> - {recv, Name, Pkt}. +%% Any other message with a header and no length errors. +recv1(Name, H, Msg, #state{parent = Pid, ack = Ack} = S) -> + Pkt = pkt(H, Msg), + Pid ! {recv, self(), get_route(Ack, Name, Pkt), Name, Pkt}, + handle(Name, Pkt, S). -%% recv/3 +%% pkt/2 -recv(#diameter_header{length = Len} - = H, - #diameter_packet{bin = Bin} - = Pkt, - #state{length_errors = E} - = S) - when E == handle; - 0 == Len rem 4, bit_size(Bin) == 8*Len -> - recv(Pkt#diameter_packet{header = H}, S); +pkt(H, Bin) + when is_binary(Bin) -> + #diameter_packet{header = H, + bin = Bin}; -recv(#diameter_header{} - = H, - #diameter_packet{bin = Bin}, - #state{length_errors = E}) -> - T = {size(Bin), bit_size(Bin) rem 8, H}, - invalid(E, message_length_mismatch, T), - Bin; +pkt(H, Pkt) -> + Pkt#diameter_packet{header = H}. -recv(false, #diameter_packet{bin = Bin}, #state{length_errors = E}) -> - invalid(E, truncated_header, Bin), - Bin. +%% invalid/3 %% Note that counters here only count discarded messages. invalid(E, Reason, T) -> @@ -770,39 +773,39 @@ invalid(E, Reason, T) -> ?LOG(Reason, T), ok. -%% rcv/3 +%% handle/3 %% Incoming CEA. -rcv('CEA' = N, - #diameter_packet{header = #diameter_header{end_to_end_id = Eid, - hop_by_hop_id = Hid}} - = Pkt, - #state{state = {'Wait-CEA', Hid, Eid}} - = S) -> +handle('CEA' = N, + #diameter_packet{header = #diameter_header{end_to_end_id = Eid, + hop_by_hop_id = Hid}} + = Pkt, + #state{state = {'Wait-CEA', Hid, Eid}} + = S) -> ?LOG(recv, N), handle_CEA(Pkt, S); %% Incoming CER -rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> +handle('CER' = N, Pkt, #state{state = recv_CER} = S) -> handle_request(N, Pkt, S); %% Anything but CER/CEA in a non-Open state is an error, as is %% CER/CEA in anything but recv_CER/Wait-CEA. -rcv(Name, _, #state{state = PS}) +handle(Name, _, #state{state = PS}) when PS /= 'Open'; Name == 'CER'; Name == 'CEA' -> {stop, {Name, PS}}; -rcv('DPR' = N, Pkt, S) -> +handle('DPR' = N, Pkt, S) -> handle_request(N, Pkt, S); %% DPA in response to DPR, with the expected identifiers. -rcv('DPA' = N, - #diameter_packet{header = #diameter_header{end_to_end_id = Eid, - hop_by_hop_id = Hid} - = H} - = Pkt, +handle('DPA' = N, + #diameter_packet{header = #diameter_header{end_to_end_id = Eid, + hop_by_hop_id = Hid} + = H} + = Pkt, #state{dictionary = Dict0, transport = TPid, dpr = {X, Hid, Eid}, @@ -813,7 +816,8 @@ rcv('DPA' = N, %% service: explicit DPR is counted in the same way %% as other explicitly sent requests. incr(recv, H, Dict0), - incr_rc(recv, diameter_codec:decode(Dict0, Opts, Pkt), Dict0) + {_, RecPkt} = decode(Dict0, Opts, Pkt), + incr_rc(recv, RecPkt, Dict0) end, diameter_peer:close(TPid), {stop, N}; @@ -821,13 +825,13 @@ rcv('DPA' = N, %% Ignore an unsolicited DPA in particular. Note that dpa_timeout %% deals with the case in which the peer sends the wrong identifiers %% in DPA. -rcv('DPA' = N, #diameter_packet{header = H}, _) -> +handle('DPA' = N, #diameter_packet{header = H}, _) -> ?LOG(ignored, N), %% Note that these aren't counted in the normal recv counter. diameter_stats:incr({diameter_codec:msg_id(H), recv, ignored}), ok; -rcv(_, _, _) -> +handle(_, _, _) -> ok. %% incr/3 @@ -917,21 +921,30 @@ handle_request(Name, = S) -> ?LOG(recv, Name), incr(recv, H, Dict0), - send_answer(Name, diameter_codec:decode(Dict0, Opts, Pkt), S). + send_answer(Name, decode(Dict0, Opts, Pkt), S). + +%% decode/3 +%% +%% Decode the message as record for diameter_capx, and in the +%% configured format for events. + +decode(Dict0, Opts, Pkt) -> + {diameter_codec:decode(Dict0, Opts, Pkt), + diameter_codec:decode(Dict0, Opts#{decode_format := record}, Pkt)}. %% send_answer/3 -send_answer(Type, ReqPkt, #state{transport = TPid, - dictionary = Dict, - codec = Opts} - = S) -> - incr_error(recv, ReqPkt, Dict), +send_answer(Type, {DecPkt, RecPkt}, #state{transport = TPid, + dictionary = Dict, + codec = Opts} + = S) -> + incr_error(recv, RecPkt, Dict), #diameter_packet{header = H, transport_data = TD} - = ReqPkt, + = RecPkt, - {Msg, PostF} = build_answer(Type, ReqPkt, S), + {Msg, PostF} = build_answer(Type, DecPkt, RecPkt, S), %% An answer message clears the R and T flags and retains the P %% flag. The E flag is set at encode. @@ -959,15 +972,15 @@ eval([F|A], S) -> eval(T, _) -> close(T). -%% build_answer/3 +%% build_answer/4 build_answer('CER', + DecPkt, #diameter_packet{msg = CER, header = #diameter_header{version = ?DIAMETER_VERSION, is_error = false}, - errors = []} - = Pkt, + errors = []}, #state{dictionary = Dict0} = S) -> {SupportedApps, RCaps, CEA} = recv_CER(CER, S), @@ -985,25 +998,25 @@ build_answer('CER', orelse ?THROW(4003), %% DIAMETER_ELECTION_LOST caps_cb(Caps) of - N -> {cea(CEA, N, Dict0), [fun open/5, Pkt, + N -> {cea(CEA, N, Dict0), [fun open/5, DecPkt, SupportedApps, Caps, {accept, inband_security(IS)}]} catch ?FAILURE(Reason) -> - rejected(Reason, {'CER', Reason, Caps, Pkt}, S) + rejected(Reason, {'CER', Reason, Caps, DecPkt}, S) end; %% The error checks below are similar to those in diameter_traffic for %% other messages. Should factor out the commonality. build_answer(Type, + DecPkt, #diameter_packet{header = H, - errors = Es} - = Pkt, + errors = Es}, S) -> {RC, FailedAVP} = result_code(Type, H, Es), - {answer(Type, RC, FailedAVP, S), post(Type, RC, Pkt, S)}. + {answer(Type, RC, FailedAVP, S), post(Type, RC, DecPkt, S)}. inband_security([]) -> ?NO_INBAND_SECURITY; @@ -1175,12 +1188,10 @@ handle_CEA(#diameter_packet{header = H} = S) -> incr(recv, H, Dict0), - #diameter_packet{} - = DPkt - = diameter_codec:decode(Dict0, Opts, Pkt), + {DecPkt, RecPkt} = decode(Dict0, Opts, Pkt), - RC = result_code(incr_rc(recv, DPkt, Dict0)), - {SApps, IS, RCaps} = recv_CEA(DPkt, S), + RC = result_code(incr_rc(recv, RecPkt, Dict0)), + {SApps, IS, RCaps} = recv_CEA(RecPkt, S), #diameter_caps{origin_host = {OH, DH}} = Caps @@ -1203,9 +1214,9 @@ handle_CEA(#diameter_packet{header = H} orelse ?THROW(election_lost), caps_cb(Caps) of - _ -> open(DPkt, SApps, Caps, {connect, hd([_] = IS)}, S) + _ -> open(DecPkt, SApps, Caps, {connect, hd([_] = IS)}, S) catch - ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DPkt}) + ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DecPkt}) 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 diff --git a/lib/diameter/src/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl index 97e74657bd..bd5db54a5c 100644 --- a/lib/diameter/src/base/diameter_reg.erl +++ b/lib/diameter/src/base/diameter_reg.erl @@ -19,10 +19,11 @@ %% %% -%% The module implements a simple term -> pid registry. +%% A simple term -> pid registry. %% -module(diameter_reg). + -behaviour(gen_server). -export([add/1, @@ -57,18 +58,18 @@ -type key() :: term(). -type from() :: {pid(), term()}. +-type rcvr() :: [pid() | term()] %% subscribe + | from(). %% wait -type pattern() :: term(). -record(state, {id = diameter_lib:now(), - receivers = dict:new() - :: dict:dict(pattern(), [[pid() | term()]%% subscribe - | from()]), %% wait + notify = #{} :: #{pattern() => [rcvr()]}, monitors = sets:new() :: sets:set(pid())}). %% The ?TABLE bag contains the Key -> Pid mapping, as {Key, Pid} %% tuples. Each pid is stored in the monitors set to ensure only one %% monitor for each pid: more are harmless, but unnecessary. A pattern -%% is added to receivers a result of calls to wait/1 or subscribe/2: +%% is added to notify a result of calls to wait/1 or subscribe/2: %% changes to ?TABLE causes processes to be notified as required. %% =========================================================================== @@ -156,7 +157,7 @@ wait(Pat) -> %% # subscribe(Pat, T) %% %% Like match/1, but additionally receive messages of the form -%% {T, add|remove, {term(), pid()} when associations are added +%% {T, add|remove, {term(), pid()}} when associations are added %% or removed. %% =========================================================================== @@ -186,15 +187,12 @@ uptime() -> -> [{pid(), [key()]}]. pids() -> - to_list(fun swap/1). - -to_list(Fun) -> - ets:foldl(fun(T,D) -> append(Fun(T), D) end, orddict:new(), ?TABLE). + append(ets:select(?TABLE, [{{'$1','$2'}, [], [{{'$2', '$1'}}]}])). -append({K,V}, Dict) -> - orddict:append(K, V, Dict). - -id(T) -> T. +append(Pairs) -> + dict:to_list(lists:foldl(fun({K,V}, D) -> dict:append(K, V, D) end, + dict:new(), + Pairs)). %% terms/0 @@ -202,9 +200,7 @@ id(T) -> T. -> [{key(), [pid()]}]. terms() -> - to_list(fun id/1). - -swap({X,Y}) -> {Y,X}. + append(ets:tab2list(?TABLE)). %% subs/0 @@ -212,31 +208,19 @@ swap({X,Y}) -> {Y,X}. -> [{pattern(), [{pid(), term()}]}]. subs() -> - #state{receivers = RD} = state(), - dict:fold(fun sub/3, orddict:new(), RD). - -sub(Pat, Ps, Dict) -> - lists:foldl(fun([P|T], D) -> orddict:append(Pat, {P,T}, D); - (_, D) -> D - end, - Dict, - Ps). + #state{notify = Dict} = state(), + [{K, Ts} || {K,Ps} <- maps:to_list(Dict), + Ts <- [[{P,T} || [P|T] <- Ps]]]. %% waits/0 -spec waits() - -> [{pattern(), [{from(), term()}]}]. + -> [{pattern(), [from()]}]. waits() -> - #state{receivers = RD} = state(), - dict:fold(fun wait/3, orddict:new(), RD). - -wait(Pat, Ps, Dict) -> - lists:foldl(fun({_,_} = F, D) -> orddict:append(Pat, F, D); - (_, D) -> D - end, - Dict, - Ps). + #state{notify = Dict} = state(), + [{K, Ts} || {K,Ps} <- maps:to_list(Dict), + Ts <- [[T || {_,_} = T <- Ps]]]. %% ---------------------------------------------------------- %% # init/1 @@ -250,33 +234,28 @@ init(_) -> %% # handle_call/3 %% ---------------------------------------------------------- -handle_call({add, Uniq, Key}, {Pid, _}, S0) -> +handle_call({add, Uniq, Key}, {Pid, _}, S) -> Rec = {Key, Pid}, - S1 = flush(Uniq, Rec, S0), + NS = flush(Uniq, Rec, S), %% before insert {Res, New} = insert(Uniq, Rec), - {Recvs, S} = add(New, Rec, S1), - notify(Recvs, Rec), - {reply, Res, S}; + {reply, Res, notify(add, New andalso Rec, NS)}; handle_call({remove, Key}, {Pid, _}, S) -> Rec = {Key, Pid}, - Recvs = delete([Rec], S), ets:delete_object(?TABLE, Rec), - notify(Recvs, remove), - {reply, true, S}; + {reply, true, notify(remove, Rec, S)}; -handle_call({wait, Pat}, {Pid, _} = From, #state{receivers = RD} = S) -> +handle_call({wait, Pat}, {Pid, _} = From, S) -> NS = add_monitor(Pid, S), case match(Pat) of - [_|_] = L -> - {reply, L, NS}; + [_|_] = Recs -> + {reply, Recs, NS}; [] -> - {noreply, NS#state{receivers = dict:append(Pat, From, RD)}} + {noreply, queue(Pat, From, NS)} end; -handle_call({subscribe, Pat, T}, {Pid, _}, #state{receivers = RD} = S) -> - NS = add_monitor(Pid, S), - {reply, match(Pat), NS#state{receivers = dict:append(Pat, [Pid | T], RD)}}; +handle_call({subscribe, Pat, T}, {Pid, _}, S) -> + {reply, match(Pat), queue(Pat, [Pid | T], add_monitor(Pid, S))}; handle_call(state, _, S) -> {reply, S, S}; @@ -332,106 +311,60 @@ insert(true, Rec) -> B = ets:insert_new(?TABLE, Rec), %% entry inserted? {B, B}. -%% add/3 - +%% add_monitor/2 +%% %% Only add a single monitor for any given process, since there's no %% use to more. -add(true, {_Key, Pid} = Rec, S) -> - NS = add_monitor(Pid, S), - {Recvs, RD} = add(Rec, NS), - {Recvs, S#state{receivers = RD}}; - -add(false = No, _, S) -> - {No, S}. - -%% add/2 - -%% Notify processes whose patterns match the inserted key. -add({_Key, Pid} = Rec, #state{receivers = RD}) -> - dict:fold(fun(Pt, Ps, A) -> - add(lists:member(Rec, match(Pt, Pid)), Pt, Ps, Rec, A) - end, - {sets:new(), RD}, - RD). - -%% add/5 - -add(true, Pat, Recvs, {_,_} = Rec, {Set, Dict}) -> - {lists:foldl(fun sets:add_element/2, Set, Recvs), - remove(fun erlang:is_list/1, Pat, Recvs, Dict)}; -add(false, _, _, _, Acc) -> - Acc. +add_monitor(Pid, #state{monitors = Ps} = S) -> + case sets:is_element(Pid, Ps) of + false -> + monitor(process, Pid), + S#state{monitors = sets:add_element(Pid, Ps)}; + true -> + S + end. -%% add_monitor/2 - -add_monitor(Pid, #state{monitors = MS} = S) -> - add_monitor(sets:is_element(Pid, MS), Pid, S). - -%% add_monitor/3 - -add_monitor(false, Pid, #state{monitors = MS} = S) -> - monitor(process, Pid), - S#state{monitors = sets:add_element(Pid, MS)}; - -add_monitor(true, _, S) -> - S. - -%% delete/2 - -delete(Recs, #state{receivers = RD}) -> - lists:foldl(fun(R,S) -> delete(R, RD, S) end, sets:new(), Recs). +%% notify/3 -%% delete/3 +notify(_, false, S) -> + S; -delete({_Key, Pid} = Rec, RD, Set) -> - dict:fold(fun(Pt, Ps, S) -> - delete(lists:member(Rec, match(Pt, Pid)), Rec, Ps, S) - end, - Set, - RD). +notify(Op, {_,_} = Rec, #state{notify = Dict} = S) -> + S#state{notify = maps:fold(fun(P,Rs,D) -> notify(Op, Rec, P, Rs, D) end, + Dict, + Dict)}. -%% delete/4 +%% notify/5 -%% Entry matches a pattern ... -delete(true, Rec, Recvs, Set) -> - lists:foldl(fun(R,S) -> sets:add_element({R, Rec}, S) end, - Set, - Recvs); - -%% ... or not. -delete(false, _, _, Set) -> - Set. - -%% notify/2 - -notify(false = No, _) -> - No; - -notify(Recvs, remove = Op) -> - sets:fold(fun({P,R}, N) -> send(P, R, Op), N+1 end, 0, Recvs); - -notify(Recvs, {_,_} = Rec) -> - sets:fold(fun(P,N) -> send(P, Rec, add), N+1 end, 0, Recvs). +notify(Op, {_, Pid} = Rec, Pat, Rcvrs, Dict) -> + case lists:member(Rec, match(Pat, Pid)) of + true -> + reset(Pat, Dict, [P || P <- Rcvrs, send(P, Op, Rec)]); + false -> + Dict + end. %% send/3 -%% No processes waiting on remove, by construction: they've either -%% received notification at add or aren't waiting. -send([Pid | T], Rec, Op) -> - Pid ! {T, Op, Rec}; +send([Pid | T], Op, Rec) -> + Pid ! {T, Op, Rec}, + true; -send({_,_} = From, Rec, add) -> - gen_server:reply(From, [Rec]). +%% No processes wait on remove: they receive notification immediately +%% or at add, by construction. +send({_,_} = From, add, Rec) -> + gen_server:reply(From, [Rec]), + false. %% down/2 -down(Pid, #state{monitors = MS} = S) -> - NS = flush(Pid, S), - Recvs = delete(match('_', Pid), NS), +down(Pid, #state{monitors = Ps} = S) -> + Recs = match('_', Pid), ets:match_delete(?TABLE, {'_', Pid}), - notify(Recvs, remove), - NS#state{monitors = sets:del_element(Pid, MS)}. + lists:foldl(fun(R,NS) -> notify(remove, R, NS) end, + flush(Pid, S#state{monitors = sets:del_element(Pid, Ps)}), + Recs). %% flush/3 @@ -452,16 +385,15 @@ flush(false, _, S) -> %% flush/2 %% Process has died and should no longer receive messages/replies. -flush(Pid, #state{receivers = RD} = S) - when is_pid(Pid) -> - S#state{receivers = dict:fold(fun(Pt,Ps,D) -> flush(Pid, Pt, Ps, D) end, - RD, - RD)}. +flush(Pid, #state{notify = Dict} = S) -> + S#state{notify = maps:fold(fun(P,Rs,D) -> flush(Pid, P, Rs, D) end, + Dict, + Dict)}. %% flush/4 -flush(Pid, Pat, Recvs, Dict) -> - remove(fun(T) -> Pid /= head(T) end, Pat, Recvs, Dict). +flush(Pid, Pat, Rcvrs, Dict) -> + reset(Pat, Dict, [T || T <- Rcvrs, Pid /= head(T)]). %% head/1 @@ -471,15 +403,18 @@ head([P|_]) -> head({P,_}) -> P. -%% remove/4 +%% reset/3 + +reset(Key, Map, []) -> + maps:remove(Key, Map); + +reset(Key, Map, List) -> + maps:put(Key, List, Map). + +%% queue/3 -remove(Pred, Key, Values, Dict) -> - case lists:filter(Pred, Values) of - [] -> - dict:erase(Key, Dict); - Rest -> - dict:store(Key, Rest, Dict) - end. +queue(Pat, Rcvr, #state{notify = Dict} = S) -> + S#state{notify = maps:put(Pat, [Rcvr | maps:get(Pat, Dict, [])], Dict)}. %% call/1 diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index a976a8b998..31dd92f878 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -112,8 +112,24 @@ use_shared_peers := diameter:remotes(),%% use from restrict_connections := diameter:restriction(), incoming_maxlen := diameter:message_length(), + strict_arities => diameter:strict_arities(), strict_mbit := boolean(), + decode_format := diameter:decode_format(), + avp_dictionaries => nonempty_list(module()), + traffic_counters := boolean(), string_decode := boolean(), + capabilities_cb => diameter:evaluable(), + pool_size => pos_integer(), + capx_timeout => diameter:'Unsigned32'(), + strict_capx => boolean(), + disconnect_cb => diameter:evaluable(), + dpr_timeout => diameter:'Unsigned32'(), + dpa_timeout => diameter:'Unsigned32'(), + length_errors => exit | handle | discard, + connect_timer => diameter:'Unsigned32'(), + watchdog_timer => diameter:'Unsigned32'() + | {module(), atom(), list()}, + watchdog_config => [{okay|suspect, non_neg_integer()}], spawn_opt := list() | {module(), atom(), list()}}}). %% Record representing an RFC 3539 watchdog process implemented by @@ -514,6 +530,13 @@ transition({tc_timeout, T}, S) -> tc_timeout(T, S), ok; +transition({nodeup, Node, _}, S) -> + nodeup(Node, S), + ok; + +transition({nodedown, _Node, _}, _) -> + ok; + transition(Req, S) -> unexpected(handle_info, [Req], S), ok. @@ -679,12 +702,15 @@ i(SvcName) -> cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts}, {false, Acc}) -> lists:foreach(fun init_mod/1, Apps), + #{monitor := M} + = SvcOpts + = service_opts(Opts), S = #state{service_name = SvcName, service = Rec#diameter_service{pid = self()}, local = init_peers(), remote = init_peers(), - monitor = mref(get_value(monitor, Opts)), - options = service_options(lists:keydelete(monitor, 1, Opts))}, + monitor = mref(M), + options = maps:remove(monitor, SvcOpts)}, {S, Acc}; cfg_acc({_Ref, Type, _Opts} = T, {S, Acc}) @@ -699,8 +725,29 @@ init_peers() -> %% Alias, %% TPid} -service_options(Opts) -> - maps:from_list(Opts). +service_opts(Opts) -> + remove([{strict_arities, true}, + {avp_dictionaries, []}], + maps:merge(maps:from_list([{monitor, false} | def_opts()]), + maps:from_list(Opts))). + +remove(List, Map) -> + maps:filter(fun(K,V) -> not lists:member({K,V}, List) end, + Map). + +def_opts() -> %% defaults on the service map + [{share_peers, false}, + {use_shared_peers, false}, + {sequence, {0,32}}, + {restrict_connections, nodes}, + {incoming_maxlen, 16#FFFFFF}, + {strict_arities, true}, + {strict_mbit, true}, + {decode_format, record}, + {avp_dictionaries, []}, + {traffic_counters, true}, + {string_decode, true}, + {spawn_opt, []}]. mref(false = No) -> No; @@ -709,6 +756,8 @@ mref(P) -> init_shared(#state{options = #{use_shared_peers := T}, service_name = Svc}) -> + T == false orelse net_kernel:monitor_nodes(true, [{node_type, visible}, + nodedown_reason]), notify(T, Svc, {service, self()}). init_mod(#diameter_app{alias = Alias, @@ -718,16 +767,17 @@ init_mod(#diameter_app{alias = Alias, start_fsm({Ref, Type, Opts}, S) -> start(Ref, {Type, Opts}, S). -get_value(Key, Vs) -> - {_, V} = lists:keyfind(Key, 1, Vs), - V. - notify(Share, SvcName, T) -> Nodes = remotes(Share), [] /= Nodes andalso diameter_peer:notify(Nodes, SvcName, T). %% Test for the empty list for upgrade reasons: there's no %% diameter_peer:notify/3 in old code. +nodeup(Node, #state{options = #{share_peers := SP}, + service_name = SvcName}) -> + lists:member(Node, remotes(SP)) + andalso diameter_peer:notify([Node], SvcName, {service, self()}). + remotes(false) -> []; @@ -806,7 +856,7 @@ start(Ref, Type, Opts, State) -> start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT, local = {PeerT, _, _}, options = #{string_decode := SD} - = SvcOpts0, + = SvcOpts, service_name = SvcName, service = Svc0}) when Type == connect; @@ -815,12 +865,12 @@ start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT, = Svc1 = merge_service(Opts, Svc0), Svc = binary_caps(Svc1, SD), - SvcOpts = merge_options(Opts, SvcOpts0), - RecvData = diameter_traffic:make_recvdata([SvcName, PeerT, Apps, SvcOpts]), - T = {Opts, SvcOpts, RecvData, Svc}, + {SOpts, TOpts} = merge_opts(SvcOpts, Opts), + RecvData = diameter_traffic:make_recvdata([SvcName, PeerT, Apps, SOpts]), + T = {TOpts, SOpts, RecvData, Svc}, Rec = #watchdog{type = Type, ref = Ref, - options = Opts}, + options = TOpts}, diameter_lib:fold_n(fun(_,A) -> [wd(Type, Ref, T, WatchdogT, Rec) | A] @@ -828,10 +878,14 @@ start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT, [], N). -merge_options(Opts, SvcOpts) -> - Keys = maps:keys(SvcOpts), - Map = maps:from_list([KV || {K,_} = KV <- Opts, lists:member(K, Keys)]), - maps:merge(SvcOpts, Map). +merge_opts(SvcOpts, Opts) -> + Keys = [K || {K,_} <- def_opts()], + SO = [T || {K,_} = T <- Opts, lists:member(K, Keys)], + TO = Opts -- SO, + {maps:merge(maps:with(Keys, SvcOpts), maps:from_list(SO)), + TO ++ [T || {K,_} = T <- maps:to_list(SvcOpts), + not lists:member(K, Keys), + not lists:keymember(K, 1, Opts)]}. binary_caps(Svc, true) -> Svc; @@ -1400,9 +1454,15 @@ is_remote(Pid, T) -> %% # remote_peer_up/4 %% --------------------------------------------------------------------------- -remote_peer_up(TPid, Aliases, Caps, #state{options = #{use_shared_peers := T}} +remote_peer_up(TPid, Aliases, Caps, #state{options = #{use_shared_peers := T}, + remote = {PeerT, _, _}} = S) -> - is_remote(TPid, T) andalso rpu(TPid, Aliases, Caps, S). + is_remote(TPid, T) + andalso not ets:member(PeerT, TPid) + andalso rpu(TPid, Aliases, Caps, S). + +%% Notification can be duplicate since remote nodes push and the local +%% node pulls. rpu(TPid, Aliases, Caps, #state{service = Svc, remote = RT}) -> #diameter_service{applications = Apps} = Svc, @@ -1412,6 +1472,7 @@ rpu(TPid, Aliases, Caps, #state{service = Svc, remote = RT}) -> rpu(_, [] = No, _, _) -> No; + rpu(TPid, Aliases, Caps, {PeerT, _, _} = RT) -> monitor(process, TPid), ets:insert(PeerT, #peer{pid = TPid, diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 85378babea..f510f40a17 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -70,13 +70,17 @@ timeout = 5000 :: 0..16#FFFFFFFF, %% for outgoing requests detach = false :: boolean()}). -%% Term passed back to receive_message/6 with every incoming message. +%% Term passed back to receive_message/5 with every incoming message. -record(recvdata, {peerT :: ets:tid(), service_name :: diameter:service_name(), apps :: [#diameter_app{}], sequence :: diameter:sequence(), - codec :: #{string_decode := boolean(), + counters :: boolean(), + codec :: #{decode_format := diameter:decode_format(), + avp_dictionaries => nonempty_list(module()), + string_decode := boolean(), + strict_arities => diameter:strict_arities(), strict_mbit := boolean(), incoming_maxlen := diameter:message_length()}}). %% Note that incoming_maxlen is currently handled in diameter_peer_fsm, @@ -89,6 +93,7 @@ caller :: pid() | undefined, %% calling process handler :: pid(), %% request process peer :: undefined | {pid(), #diameter_caps{}}, + caps :: undefined, %% no longer used packet :: #diameter_packet{} | undefined}). %% of request %% --------------------------------------------------------------------------- @@ -96,13 +101,17 @@ %% --------------------------------------------------------------------------- make_recvdata([SvcName, PeerT, Apps, SvcOpts | _]) -> - #{sequence := {_,_} = Mask, spawn_opt := Opts} + #{sequence := {_,_} = Mask, spawn_opt := Opts, traffic_counters := B} = SvcOpts, {Opts, #recvdata{service_name = SvcName, peerT = PeerT, apps = Apps, sequence = Mask, - codec = maps:with([string_decode, + counters = B, + codec = maps:with([decode_format, + avp_dictionaries, + string_decode, + strict_arities, strict_mbit, ordered_encode, incoming_maxlen], @@ -182,7 +191,7 @@ incr_error(Dir, Id, TPid) -> %% --------------------------------------------------------------------------- -spec incr_rc(send|recv, Pkt, TPid, DictT) - -> {Counter, non_neg_integer()} + -> Counter | Reason when Pkt :: #diameter_packet{}, TPid :: pid(), @@ -193,18 +202,26 @@ incr_error(Dir, Id, TPid) -> | {'Experimental-Result', integer(), integer()}, Reason :: atom(). -incr_rc(Dir, Pkt, TPid, {_, AppDict, _} = DictT) -> - try - incr_result(Dir, Pkt, TPid, DictT) +incr_rc(Dir, Pkt, TPid, {MsgDict, AppDict, Dict0}) -> + incr_rc(Dir, Pkt, TPid, MsgDict, AppDict, Dict0); + +incr_rc(Dir, Pkt, TPid, Dict0) -> + incr_rc(Dir, Pkt, TPid, Dict0, Dict0, Dict0). + +%% incr_rc/6 + +incr_rc(Dir, Pkt, TPid, MsgDict, AppDict, Dict0) -> + try get_result(Dir, MsgDict, Dict0, Pkt) of + false -> + unknown; + Avp -> + incr_result(Dir, Avp, Pkt, TPid, AppDict) catch exit: {E,_} when E == no_result_code; E == invalid_error_bit -> incr(TPid, {msg_id(Pkt#diameter_packet.header, AppDict), Dir, E}), E - end; - -incr_rc(Dir, Pkt, TPid, Dict0) -> - incr_rc(Dir, Pkt, TPid, {Dict0, Dict0, Dict0}). + end. %% --------------------------------------------------------------------------- %% receive_message/5 @@ -216,13 +233,13 @@ incr_rc(Dir, Pkt, TPid, Dict0) -> -> pid() %% request handler | boolean() %% answer, known request or not | discard %% request discarded by MFA - when Route :: {Handler, RequestRef, Seqs} + when Route :: {Handler, RequestRef, TPid} | Ack, RecvData :: {[SpawnOpt], #recvdata{}}, SpawnOpt :: term(), Handler :: pid(), RequestRef :: reference(), - Seqs :: {0..16#FFFFFFFF, 0..16#FFFFFFFF}, + TPid :: pid(), Ack :: boolean(). receive_message(TPid, Route, Pkt, Dict0, RecvData) -> @@ -303,14 +320,15 @@ recv_request(Ack, = Pkt, Dict0, #recvdata{peerT = PeerT, - apps = Apps} + apps = Apps, + counters = Count} = RecvData) -> Ack andalso (TPid ! {handler, self()}), case diameter_service:find_incoming_app(PeerT, TPid, Id, Apps) of {#diameter_app{id = Aid, dictionary = AppDict} = App, Caps} -> - incr(recv, Pkt, TPid, AppDict), + Count andalso incr(recv, Pkt, TPid, AppDict), DecPkt = decode(Aid, AppDict, RecvData, Pkt), - incr_error(recv, DecPkt, TPid, AppDict), + Count andalso incr_error(recv, DecPkt, TPid, AppDict), send_A(recv_R(App, TPid, Dict0, Caps, RecvData, DecPkt), TPid, App, @@ -323,9 +341,7 @@ recv_request(Ack, %% A request was sent for an application that is not %% supported. RC = 3007, - Es = Pkt#diameter_packet.errors, - DecPkt = Pkt#diameter_packet{avps = collect_avps(Pkt), - errors = [RC | Es]}, + DecPkt = diameter_codec:collect_avps(Pkt), send_answer(answer_message(RC, Dict0, Caps, DecPkt), TPid, Dict0, @@ -338,17 +354,11 @@ recv_request(Ack, No end. +%% decode/4 + decode(Id, Dict, #recvdata{codec = Opts}, Pkt) -> errors(Id, diameter_codec:decode(Id, Dict, Opts, Pkt)). -collect_avps(Pkt) -> - case diameter_codec:collect_avps(Pkt) of - {_Error, Avps} -> - Avps; - Avps -> - Avps - end. - %% send_A/7 send_A([T | Fs], TPid, App, Dict0, RecvData, DecPkt, Caps) -> @@ -541,6 +551,7 @@ send_A({call, Opts}, TPid, App, Dict0, RecvData, Pkt, Caps, Fs) -> MsgDict, AppDict, Dict0, + RecvData#recvdata.counters, Fs); RC -> send_answer(answer_message(RC, Dict0, Caps, Pkt), @@ -584,14 +595,22 @@ send_answer(Ans, TPid, MsgDict, AppDict, Dict0, RecvData, DecPkt, Fs) -> TPid, RecvData#recvdata.codec, make_answer_packet(Ans, DecPkt, MsgDict, Dict0)), - send_answer(Pkt, TPid, MsgDict, AppDict, Dict0, Fs). + send_answer(Pkt, + TPid, + MsgDict, + AppDict, + Dict0, + RecvData#recvdata.counters, + Fs). -%% send_answer/6 +%% send_answer/7 -send_answer(Pkt, TPid, MsgDict, AppDict, Dict0, [EvalPktFs | EvalFs]) -> +send_answer(Pkt, TPid, MsgDict, AppDict, Dict0, Count, [EvalPktFs | EvalFs]) -> eval_packet(Pkt, EvalPktFs), - incr(send, Pkt, TPid, AppDict), - incr_rc(send, Pkt, TPid, {MsgDict, AppDict, Dict0}), %% count outgoing + Count andalso begin + incr(send, Pkt, TPid, AppDict), + incr_rc(send, Pkt, TPid, MsgDict, AppDict, Dict0) + end, send(TPid, z(Pkt), _Route = self()), lists:foreach(fun diameter_lib:eval/1, EvalFs). @@ -619,7 +638,7 @@ is_answer_message(#diameter_packet{msg = Msg}, Dict0) -> is_answer_message([#diameter_header{is_request = R, is_error = E} | _], _) -> E andalso not R; -%% Message sent as a tagged avp/value list. +%% Message sent as a map or tagged avp/value list. is_answer_message([Name | _], _) -> Name == 'answer-message'; @@ -867,7 +886,10 @@ reset(Msg, [RC | Avps], Dict) -> %% set/3 -%% Reply as name and tuple list ... +%% Reply as name/values list ... +set([Name|As], Avps, _) + when is_map(As) -> + [Name | maps:merge(As, maps:from_list(Avps))]; set([_|_] = Ans, Avps, _) -> Ans ++ Avps; %% Values nearer tail take precedence. @@ -900,33 +922,44 @@ failed_avp(_, [] = No, _) -> failed_avp(Msg, [_|_] = Avps, Dict) -> [failed(Msg, [{'AVP', Avps}], Dict)]. -%% Reply as name and tuple list ... -failed([MsgName | Values], FailedAvp, Dict) -> - RecName = Dict:msg2rec(MsgName), +%% failed/3 + +failed(Msg, FailedAvp, Dict) -> + RecName = msg2rec(Msg, Dict), try - Dict:'#info-'(RecName, {index, 'Failed-AVP'}), + Dict:'#info-'(RecName, {index, 'Failed-AVP'}), %% assert existence {'Failed-AVP', [FailedAvp]} catch error: _ -> - Avps = proplists:get_value('AVP', Values, []), + Avps = values(Msg, 'AVP', Dict), A = #diameter_avp{name = 'Failed-AVP', value = FailedAvp}, {'AVP', [A|Avps]} + end. + +%% msg2rec/2 + +%% Message as name/values list ... +msg2rec([MsgName | _], Dict) -> + Dict:msg2rec(MsgName); + +%% ... or record. +msg2rec(Rec, _) -> + element(1, Rec). + +%% values/2 + +%% Message as name/values list ... +values([_ | Avps], F, _) -> + if is_map(Avps) -> + maps:get(F, Avps, []); + is_list(Avps) -> + proplists:get_value(F, Avps, []) end; %% ... or record. -failed(Rec, FailedAvp, Dict) -> - try - RecName = element(1, Rec), - Dict:'#info-'(RecName, {index, 'Failed-AVP'}), - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = Dict:'#get-'('AVP', Rec), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end. +values(Rec, F, Dict) -> + Dict:'#get-'(F, Rec). %% 3. Diameter Header %% @@ -1003,15 +1036,15 @@ answer_message(RC, origin_realm = {OR,_}}, #diameter_packet{avps = Avps, errors = Es}) -> - {Code, _, Vid} = Dict0:avp_header('Session-Id'), ['answer-message', {'Origin-Host', OH}, {'Origin-Realm', OR}, - {'Result-Code', RC}] - ++ session_id(Code, Vid, Avps) - ++ failed_avp(RC, Es). + {'Result-Code', RC} + | session_id(Dict0, Avps) + ++ failed_avp(RC, Es) + ++ proxy_info(Dict0, Avps)]. -session_id(Code, Vid, Avps) - when is_list(Avps) -> +session_id(Dict0, Avps) -> + {Code, _, Vid} = Dict0:avp_header('Session-Id'), try #diameter_avp{data = Bin} = find_avp(Code, Vid, Avps), [{'Session-Id', [Bin]}] @@ -1029,6 +1062,14 @@ failed_avp(RC, [_ | Es]) -> failed_avp(_, [] = No) -> No. +proxy_info(Dict0, Avps) -> + {Code, _, Vid} = Dict0:avp_header('Proxy-Info'), + [{'AVP', [A#diameter_avp{value = undefined} + || [#diameter_avp{code = C, vendor_id = I} = A | _] + <- Avps, + C == Code, + I == Vid]}]. + %% find_avp/3 %% Grouped ... @@ -1102,48 +1143,31 @@ find_avp(Code, VId, [_ | Avps]) -> %% Message sent as a header/avps list. incr_result(send = Dir, - #diameter_packet{msg = [#diameter_header{} = H | _]} - = Pkt, + Avp, + #diameter_packet{msg = [#diameter_header{} = H | _]}, TPid, - DictT) -> - incr_res(Dir, Pkt#diameter_packet{header = H}, TPid, DictT); - -%% Outgoing message as binary: don't count. (Sending binaries is only -%% partially supported.) -incr_result(send, #diameter_packet{header = undefined = No}, _, _) -> - No; + AppDict) -> + incr_result(Dir, Avp, H, [], TPid, AppDict); %% Incoming or outgoing. Outgoing with encode errors never gets here %% since encode fails. -incr_result(Dir, Pkt, TPid, DictT) -> - incr_res(Dir, Pkt, TPid, DictT). - -incr_res(Dir, - #diameter_packet{header = #diameter_header{is_error = E} - = Hdr, - errors = Es} - = Pkt, - TPid, - DictT) -> - {MsgDict, AppDict, Dict0} = DictT, +incr_result(Dir, Avp, Pkt, TPid, AppDict) -> + #diameter_packet{header = H, errors = Es} + = Pkt, + incr_result(Dir, Avp, H, Es, TPid, AppDict). + +%% incr_result/6 +incr_result(Dir, Avp, Hdr, Es, TPid, AppDict) -> Id = msg_id(Hdr, AppDict), %% Could be {relay, 0}, in which case the R-bit is redundant since %% only answers are being counted. Let it be however, so that the %% same tuple is in both send/recv and result code counters. %% Count incoming decode errors. - recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, AppDict), - - %% Exit on a missing result code. - T = rc_counter(MsgDict, Dir, Pkt), - T == false andalso ?LOGX(no_result_code, {MsgDict, Dir, Hdr}), - {Ctr, RC, Avp} = T, - - %% Or on an inappropriate value. - is_result(RC, E, Dict0) - orelse ?LOGX(invalid_error_bit, {MsgDict, Dir, Hdr, Avp}), + send == Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, AppDict), + Ctr = rcc(Avp), incr(TPid, {Id, Dir, Ctr}), Ctr. @@ -1188,7 +1212,50 @@ is_result(RC, true, _) -> incr(TPid, Counter) -> diameter_stats:incr(Counter, TPid, 1). -%% rc_counter/3 +%% rcc/1 + +rcc(#diameter_avp{name = 'Result-Code' = Name, value = V}) -> + {Name, head(V)}; + +rcc(#diameter_avp{name = 'Experimental-Result', value = V}) -> + head(V). + +%% head/1 + +head([V|_]) -> + V; +head(V) -> + V. + +%% rcv/1 + +rcv(#diameter_avp{name = N, value = V}) -> + rcv(N, head(V)). + +%% rcv/2 + +rcv('Experimental-Result', {_,_,N}) -> + N; + +rcv('Result-Code', N) -> + N. + +%% get_result/4 + +%% Message sent as binary: no checks or counting. +get_result(_, _, _, #diameter_packet{header = undefined}) -> + false; + +get_result(Dir, MsgDict, Dict0, Pkt) -> + Avp = get_result(MsgDict, msg(Dir, Pkt)), + Hdr = Pkt#diameter_packet.header, + %% Exit on a missing result code or inappropriate value. + Avp == false + andalso ?LOGX(no_result_code, {MsgDict, Dir, Hdr}), + E = Hdr#diameter_header.is_error, + is_result(rcv(Avp), E, Dict0) + orelse ?LOGX(invalid_error_bit, {MsgDict, Dir, Hdr, Avp}), + Avp. %% RFC 3588, 7.6: %% @@ -1196,46 +1263,29 @@ incr(TPid, Counter) -> %% applications MUST include either one Result-Code AVP or one %% Experimental-Result AVP. -rc_counter(Dict, Dir, #diameter_packet{header = H, - avps = As, - msg = Msg}) +%% msg/2 + +msg(Dir, #diameter_packet{header = H, + avps = As, + msg = Msg}) when Dir == recv; %% decoded incoming Msg == undefined -> %% relayed outgoing - rc_counter(Dict, [H|As]); - -rc_counter(Dict, _, #diameter_packet{msg = Msg}) -> - rc_counter(Dict, Msg). - -rc_counter(Dict, Msg) -> - rcc(get_result(Dict, Msg)). - -rcc(#diameter_avp{name = 'Result-Code' = Name, value = N} = A) - when is_integer(N) -> - {{Name, N}, N, A}; - -rcc(#diameter_avp{name = 'Result-Code' = Name, value = [N|_]} = A) - when is_integer(N) -> - {{Name, N}, N, A}; + [H|As]; -rcc(#diameter_avp{name = 'Experimental-Result', value = {_,_,N} = T} = A) - when is_integer(N) -> - {T, N, A}; - -rcc(#diameter_avp{name = 'Experimental-Result', value = [{_,_,N} = T|_]} = A) - when is_integer(N) -> - {T, N, A}; - -rcc(_) -> - false. +msg(_, #diameter_packet{msg = Msg}) -> + Msg. %% get_result/2 get_result(Dict, Msg) -> try [throw(A) || N <- ['Result-Code', 'Experimental-Result'], - #diameter_avp{} = A <- [get_avp(Dict, N, Msg)]] + #diameter_avp{} = A <- [get_avp(Dict, N, Msg)], + is_integer(catch rcv(A))], + false catch - #diameter_avp{} = A -> A + #diameter_avp{} = A -> + A end. x(T) -> @@ -1359,7 +1409,7 @@ make_opts([T | _], _, _, _, _, _) -> send_request({{TPid, _Caps} = TC, App} = Transport, - #{sequence := Mask} + #{sequence := Mask, traffic_counters := Count} = SvcOpts, Msg0, CallOpts, @@ -1375,9 +1425,15 @@ send_request({{TPid, _Caps} = TC, App} SvcOpts, ReqPkt), eval_packet(EncPkt, Fs), - T = send_R(ReqPkt, EncPkt, Transport, CallOpts, Caller, SvcName), + T = send_R(ReqPkt, + EncPkt, + Transport, + CallOpts, + Caller, + Count, + SvcName), Ans = recv_answer(SvcName, App, CallOpts, T), - handle_answer(SvcName, SvcOpts, App, Ans); + handle_answer(SvcName, Count, SvcOpts, App, Ans); {discard, Reason} -> {error, Reason}; discard -> @@ -1520,6 +1576,7 @@ send_R(ReqPkt, {{TPid, _Caps} = TC, #diameter_app{dictionary = AppDict}}, #options{timeout = Timeout}, {Pid, Ref}, + Count, SvcName) -> Req = #request{ref = Ref, caller = Pid, @@ -1527,7 +1584,7 @@ send_R(ReqPkt, peer = TC, packet = ReqPkt}, - incr(send, EncPkt, TPid, AppDict), + Count andalso incr(send, EncPkt, TPid, AppDict), {TRef, MRef} = zend_requezt(TPid, EncPkt, Req, SvcName, Timeout), Pid ! Ref, %% tell caller a send has been attempted {TRef, MRef, Req}. @@ -1559,15 +1616,16 @@ failover(SvcName, App, Req, CallOpts) -> CallOpts, SvcName). -%% handle_answer/4 +%% handle_answer/5 -handle_answer(SvcName, _, App, {error, Req, Reason}) -> +handle_answer(SvcName, _, _, App, {error, Req, Reason}) -> #request{packet = Pkt, peer = {_TPid, _Caps} = TC} = Req, cb(App, handle_error, [Reason, msg(Pkt), SvcName, TC]); handle_answer(SvcName, + Count, SvcOpts, #diameter_app{id = Id, dictionary = AppDict, @@ -1581,43 +1639,50 @@ handle_answer(SvcName, #request{peer = {TPid, _}} = Req, - incr(recv, DecPkt, TPid, AppDict), - - AnsPkt = try - incr_result(recv, DecPkt, TPid, {MsgDict, AppDict, Dict0}) - of - _ -> DecPkt - catch - exit: {no_result_code, _} -> - %% RFC 6733 requires one of Result-Code or - %% Experimental-Result, but the decode will have - %% detected a missing AVP. If both are optional in - %% the dictionary then this isn't a decode error: - %% just continue on. - DecPkt; - exit: {invalid_error_bit, {_, _, _, Avp}} -> - #diameter_packet{errors = Es} - = DecPkt, - E = {5004, Avp}, - DecPkt#diameter_packet{errors = [E|Es]} - end, - - handle_answer(AnsPkt, SvcName, App, AE, Req). + answer(answer(DecPkt, TPid, MsgDict, AppDict, Dict0, Count), + SvcName, + App, + AE, + Req). + +%% answer/6 + +answer(DecPkt, TPid, MsgDict, AppDict, Dict0, Count) -> + Count andalso incr(recv, DecPkt, TPid, AppDict), + try get_result(recv, MsgDict, Dict0, DecPkt) of + Avp -> + Count andalso false /= Avp + andalso incr_result(recv, Avp, DecPkt, TPid, AppDict), + DecPkt + catch + exit: {no_result_code, _} -> + %% RFC 6733 requires one of Result-Code or + %% Experimental-Result, but the decode will have + %% detected a missing AVP. If both are optional in + %% the dictionary then this isn't a decode error: + %% just continue on. + DecPkt; + exit: {invalid_error_bit, {_, _, _, Avp}} -> + #diameter_packet{errors = Es} + = DecPkt, + E = {5004, Avp}, + DecPkt#diameter_packet{errors = [E|Es]} + end. -%% handle_answer/5 +%% answer/5 -handle_answer(#diameter_packet{errors = Es} - = Pkt, - SvcName, - App, - AE, - #request{peer = {_TPid, _Caps} = TC, - packet = P}) +answer(#diameter_packet{errors = Es} + = Pkt, + SvcName, + App, + AE, + #request{peer = {_TPid, _Caps} = TC, + packet = P}) when callback == AE; [] == Es -> cb(App, handle_answer, [Pkt, msg(P), SvcName, TC]); -handle_answer(#diameter_packet{header = H}, SvcName, _, AE, _) -> +answer(#diameter_packet{header = H}, SvcName, _, AE, _) -> handle_error(H, SvcName, AE). %% handle_error/3 @@ -1830,10 +1895,8 @@ get_destination(Dict, Msg) -> [str(get_avp_value(Dict, D, Msg)) || D <- ['Destination-Realm', 'Destination-Host']]. -%% This is not entirely correct. The avp could have an arity 1, in -%% which case an empty list is a DiameterIdentity of length 0 rather -%% than the list of no values we treat it as by mapping to undefined. -%% This behaviour is documented. +%% A DiameterIdentity has length at least one, so an empty list is not +%% a Realm/Host. str([]) -> undefined; str(T) -> @@ -1841,16 +1904,12 @@ str(T) -> %% get_avp/3 %% -%% Find an AVP in a message of one of three forms: -%% -%% - a message record (as generated from a .dia spec) or -%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. -%% - a list of a #diameter_header{} followed by #diameter_avp{} records, -%% -%% In the first two forms a dictionary module is used at encode to -%% identify the type of the AVP and its arity in the message in -%% question. The third form allows messages to be sent as is, without -%% a dictionary, which is needed in the case of relay agents, for one. +%% Find an AVP in a message in one of the decoded formats, or as a +%% header/avps list. There are only four AVPs that are extracted here: +%% Result-Code and Experimental-Result in order when constructing +%% counter keys, and Destination-Host/Realm when selecting a next-hop +%% peer. Experimental-Result is the only of type Grouped, and is given +%% special treatment in order to return the value as a record. %% Messages will be header/avps list as a relay and the only AVP's we %% look for are in the common dictionary. This is required since the @@ -1859,37 +1918,58 @@ str(T) -> get_avp(?RELAY, Name, Msg) -> get_avp(?BASE, Name, Msg); -%% Message as a header/avps list. +%% Message as header/avps list. get_avp(Dict, Name, [#diameter_header{} | Avps]) -> try - {Code, _, VId} = Dict:avp_header(Name), - find_avp(Code, VId, Avps) - of - A -> - (avp_decode(Dict, Name, ungroup(A)))#diameter_avp{name = Name} + {Code, _, Vid} = Dict:avp_header(Name), + A = find_avp(Code, Vid, Avps), + avp_decode(Dict, Name, ungroup(A)) catch error: _ -> undefined end; -%% Outgoing message as a name/values list. +%% Message as name/values list ... get_avp(_, Name, [_MsgName | Avps]) -> - case lists:keyfind(Name, 1, Avps) of + case find(Name, Avps) of {_, V} -> - #diameter_avp{name = Name, value = V}; + #diameter_avp{name = Name, value = value(Name, V)}; _ -> undefined end; -%% Message is typically a record but not necessarily. +%% ... or record. get_avp(Dict, Name, Rec) -> - try - #diameter_avp{name = Name, value = Dict:'#get-'(Name, Rec)} + try Dict:'#get-'(Name, Rec) of + V -> + #diameter_avp{name = Name, value = value(Name, V)} catch error:_ -> undefined end. +value('Experimental-Result' = N, #{'Vendor-Id' := Vid, + 'Experimental-Result-Code' := RC}) -> + {N, Vid, RC}; +value('Experimental-Result' = N, [{'Experimental-Result-Code', RC}, + {'Vendor-Id', Vid}]) -> + {N, Vid, RC}; +value('Experimental-Result' = N, [{'Vendor-Id', Vid}, + {'Experimental-Result-Code', RC}]) -> + {N, Vid, RC}; +value(_, V) -> + V. + +%% find/2 + +find(Key, Map) + when is_map(Map) -> + maps:find(Key, Map); + +find(Key, List) + when is_list(List) -> + lists:keyfind(Key, 1, List). + %% get_avp_value/3 get_avp_value(Dict, Name, Msg) -> @@ -1909,18 +1989,25 @@ ungroup(Avp) -> %% avp_decode/3 +%% Ensure Experimental-Result is decoded as record, since this format +%% is used for counter keys. +avp_decode(Dict, 'Experimental-Result' = N, #diameter_avp{data = Bin} + = Avp) + when is_binary(Bin) -> + {V,_} = Dict:avp(decode, Bin, N, decode_opts(Dict)), + Avp#diameter_avp{name = N, value = V}; + avp_decode(Dict, Name, #diameter_avp{value = undefined, data = Bin} - = Avp) -> - try Dict:avp(decode, Bin, Name, decode_opts(Dict)) of - V -> - Avp#diameter_avp{value = V} - catch - error:_ -> - Avp - end; -avp_decode(_, _, #diameter_avp{} = Avp) -> - Avp. + = Avp) + when is_binary(Bin) -> + V = Dict:avp(decode, Bin, Name, decode_opts(Dict)), + Avp#diameter_avp{name = Name, value = V}; + +avp_decode(_, Name, #diameter_avp{} = Avp) -> + Avp#diameter_avp{name = Name}. + +%% cb/3 cb(#diameter_app{module = [_|_] = M}, F, A) -> eval(M, F, A). @@ -1933,7 +2020,9 @@ choose(false, _, X) -> X. %% Decode options sufficient for AVP extraction. decode_opts(Dict) -> - #{string_decode => false, + #{decode_format => record, + string_decode => false, strict_mbit => false, failed_avp => false, - dictionary => Dict}. + module => Dict, + app_dictionary => Dict}. diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index a63425d92a..43623334a9 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -72,12 +72,11 @@ restrict := boolean(), suspect := non_neg_integer(), %% OKAY -> SUSPECT okay := non_neg_integer()}, %% REOPEN -> OKAY - codec :: #{string_decode := false, + codec :: #{decode_format := none, + string_decode := false, strict_mbit := boolean(), - failed_avp := false, rfc := 3588 | 6733, - ordered_encode := false, - incoming_maxlen := diameter:message_length()}, + ordered_encode := false}, shutdown = false :: boolean()}). %% --------------------------------------------------------------------------- @@ -135,13 +134,6 @@ i({Ack, T, Pid, {Opts, putr(restart, {T, Opts, Svc, SvcOpts}), %% save seeing it in trace putr(dwr, dwr(Caps)), %% Nodes = restrict_nodes(Restrict), - CodecKeys = [string_decode, - strict_mbit, - incoming_maxlen, - spawn_opt, - rfc, - ordered_encode], - #watchdog{parent = Pid, transport = start(T, Opts, SvcOpts, Nodes, Dict0, Svc), tw = proplists:get_value(watchdog_timer, @@ -149,14 +141,23 @@ i({Ack, T, Pid, {Opts, ?DEFAULT_TW_INIT), receive_data = RecvData, dictionary = Dict0, - config = - maps:without(CodecKeys, - config(SvcOpts#{restrict => restrict(Nodes), - suspect => 1, - okay => 3}, - Opts)), - codec = maps:with(CodecKeys, SvcOpts#{string_decode := false, - ordered_encode => false})}. + config = maps:with([sequence, + restrict_connections, + restrict, + suspect, + okay], + config(SvcOpts#{restrict => restrict(Nodes), + suspect => 1, + okay => 3}, + Opts)), + codec = maps:with([decode_format, + strict_mbit, + string_decode, + rfc, + ordered_encode], + SvcOpts#{decode_format := none, + string_decode := false, + ordered_encode => false})}. wait(Ref, Pid) -> receive diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index f56e4a5249..4e6fe32d69 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -21,15 +21,14 @@ -module(diameter_codegen). %% -%% This module generates erl/hrl files for encode/decode modules -%% from the orddict parsed from a dictionary file (.dia) by -%% diameter_dict_util. The generated code is simple (one-liners), -%% the generated functions being called by code included iin the -%% generated modules from diameter_gen.hrl. The orddict itself is -%% returned by dict/0 in the generated module and diameter_dict_util -%% calls this function when importing dictionaries as a consequence -%% of @inherits sections. That is, @inherits introduces a dependency -%% on the beam file of another dictionary. +%% This module generates erl/hrl files for encode/decode modules from +%% the orddict parsed from a dictionary file by diameter_dict_util. +%% The generated code is simple (one-liners), and is called from +%% diameter_gen. The orddict itself is returned by dict/0 in the +%% generated module and diameter_dict_util calls this function when +%% importing dictionaries as a consequence of @inherits sections. That +%% is, @inherits introduces a dependency on the beam file of another +%% dictionary. %% -export([from_dict/4, diff --git a/lib/diameter/src/compiler/diameter_dict_util.erl b/lib/diameter/src/compiler/diameter_dict_util.erl index f9f2b02e94..7b53e51cb6 100644 --- a/lib/diameter/src/compiler/diameter_dict_util.erl +++ b/lib/diameter/src/compiler/diameter_dict_util.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -923,7 +923,7 @@ xa([D|_] = Ds, [[Qual, D, {_, Line, AvpName}] | Avps], Dict, Key, Name) -> store_new({Key, {Name, AvpName}}, [Line, Qual, D], Dict, - [Name, Line], + [AvpName, Line], avp_already_referenced), Key, Name); diff --git a/lib/diameter/src/compiler/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl index 9a0cb6baf2..143dede037 100644 --- a/lib/diameter/src/compiler/diameter_exprecs.erl +++ b/lib/diameter/src/compiler/diameter_exprecs.erl @@ -110,9 +110,9 @@ %% parse_transform/2 parse_transform(Forms, _Options) -> - Rs = [R || {attribute, _, record, R} <- Forms], - Es = lists:append([E || {attribute, _, export_records, E} <- Forms]), {H,T} = lists:splitwith(fun is_head/1, Forms), + Rs = [R || {attribute, _, record, R} <- H], + Es = lists:append([E || {attribute, _, export_records, E} <- H]), H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T. is_head(T) -> diff --git a/lib/diameter/src/dict/doic_rfc7683.dia b/lib/diameter/src/dict/doic_rfc7683.dia new file mode 100644 index 0000000000..2b7804115e --- /dev/null +++ b/lib/diameter/src/dict/doic_rfc7683.dia @@ -0,0 +1,50 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2017. All Rights Reserved. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; %CopyrightEnd% +;; + +@name diameter_gen_doic_rfc7683 +@prefix diameter_doic + +@avp_types + + OC-Supported-Features 621 Grouped - + OC-Feature-Vector 622 Unsigned64 - + OC-OLR 623 Grouped - + OC-Sequence-Number 624 Unsigned64 - + OC-Validity-Duration 625 Unsigned32 - + OC-Report-Type 626 Enumerated - + OC-Reduction-Percentage 627 Unsigned32 - + +@enum OC-Report-Type + + HOST_REPORT 0 + REALM_REPORT 1 + +@grouped + + OC-Supported-Features ::= < AVP Header: 621 > + [ OC-Feature-Vector ] + * [ AVP ] + + OC-OLR ::= < AVP Header: 623 > + < OC-Sequence-Number > + < OC-Report-Type > + [ OC-Reduction-Percentage ] + [ OC-Validity-Duration ] + * [ AVP ] diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk index bb3b234d20..bb86de016a 100644 --- a/lib/diameter/src/modules.mk +++ b/lib/diameter/src/modules.mk @@ -24,6 +24,7 @@ DICTS = \ base_rfc6733 \ base_accounting \ acct_rfc6733 \ + doic_rfc7683 \ relay # The yecc grammar for the dictionary parser. diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 6a9f1f940b..4eb3379d59 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -79,7 +79,7 @@ -type option() :: {sender, boolean()} | sender | {packet, boolean() | raw} - | {message_cb, false | diameter:evaluable()}. + | {message_cb, false | diameter:eval()}. -type uint() :: non_neg_integer(). @@ -102,9 +102,10 @@ streams :: {uint(), uint()} %% {InStream, OutStream} counts | undefined, os = 0 :: uint(), %% next output stream + rotate = 1 :: boolean() | 0 | 1, %% rotate os? packet = true :: boolean() %% legacy transport_data? | raw, - message_cb = false :: false | diameter:evaluable(), + message_cb = false :: false | diameter:eval(), send = false :: pid() | boolean()}). %% sending process %% Monitor process state. @@ -112,7 +113,7 @@ {transport :: pid(), ack = false :: boolean(), socket :: gen_sctp:sctp_socket(), - assoc_id :: gen_sctp:assoc_id()}). %% next output stream + assoc_id :: gen_sctp:assoc_id()}). %% Listener process state. -record(listener, @@ -120,7 +121,7 @@ socket :: gen_sctp:sctp_socket(), service :: pid(), %% service process pending = {0, queue:new()}, - opts :: [[match()] | boolean() | diameter:evaluable()]}). + opts :: [[match()] | boolean() | diameter:eval()]}). %% Field pending implements two queues: the first of transport-to-be %% processes to which an association has been assigned but for which %% diameter hasn't yet spawned a transport process, a short-lived @@ -156,12 +157,7 @@ start(T, Svc, Opts) = Svc, diameter_sctp_sup:start(), %% start supervisors on demand Addrs = Caps#diameter_caps.host_ip_address, - s(T, Addrs, Pid, lists:map(fun ip/1, Opts)). - -ip({ifaddr, A}) -> - {ip, A}; -ip(T) -> - T. + s(T, Addrs, Pid, Opts). %% A listener spawns transports either as a consequence of this call %% when there is not yet an association to assign it, or at comm_up on @@ -354,23 +350,35 @@ l([], Ref, T) -> %% open/3 open(Addrs, Opts, PortNr) -> - {LAs, Os} = addrs(Addrs, Opts), - {LAs, case gen_sctp:open(gen_opts(portnr(Os, PortNr))) of - {ok, Sock} -> - Sock; - {error, Reason} -> - x({open, Reason}) - end}. + case gen_sctp:open(gen_opts(portnr(addrs(Addrs, Opts), PortNr))) of + {ok, Sock} -> + {addrs(Sock), Sock}; + {error, Reason} -> + x({open, Reason}) + end. addrs(Addrs, Opts) -> - case proplists:split(Opts, [ip]) of - {[[]], _} -> - {Addrs, Opts ++ [{ip, A} || A <- Addrs]}; - {[As], Os} -> - LAs = [diameter_lib:ipaddr(A) || {ip, A} <- As], - {LAs, Os ++ [{ip, A} || A <- LAs]} + case lists:mapfoldl(fun ipaddr/2, false, Opts) of + {Os, true} -> + Os; + {_, false} -> + Opts ++ [{ip, A} || A <- Addrs] end. +ipaddr({K,A}, _) + when K == ifaddr; + K == ip -> + {{ip, ipaddr(A)}, true}; +ipaddr(T, B) -> + {T, B}. + +ipaddr(A) + when A == loopback; + A == any -> + A; +ipaddr(A) -> + diameter_lib:ipaddr(A). + portnr(Opts, PortNr) -> case proplists:get_value(port, Opts) of undefined -> @@ -379,6 +387,14 @@ portnr(Opts, PortNr) -> Opts end. +addrs(Sock) -> + case inet:socknames(Sock) of + {ok, As} -> + [A || {A,_} <- As]; + {error, Reason} -> + x({socknames, Reason}) + end. + %% x/1 x(Reason) -> @@ -565,7 +581,7 @@ transition(Msg, S) %% Deferred actions from a message_cb. transition({actions, Dir, Acts}, S) -> - actions(Acts, Dir, S); + setopts(ok, actions(Acts, Dir, S)); %% Request to close the transport connection. transition({diameter, {close, Pid}}, #transport{parent = Pid}) -> @@ -677,11 +693,16 @@ send(#diameter_packet{transport_data = {outstream, SId}} = S) -> send(SId rem OS, Msg, S); -%% ... or not: rotate through all streams. -send(Msg, #transport{streams = {_, OS}, +%% ... or not: rotate when sending on multiple streams ... +send(Msg, #transport{rotate = true, + streams = {_, OS}, os = N} = S) -> - send(N, Msg, S#transport{os = (N + 1) rem OS}). + send(N, Msg, S#transport{os = (N + 1) rem OS}); + +%% ... or send on the only stream available. +send(Msg, S) -> + send(0, Msg, S). %% send/3 @@ -749,7 +770,7 @@ recv({[#sctp_sndrcvinfo{assoc_id = Id}], _Bin} %% Inbound Diameter message. recv({[#sctp_sndrcvinfo{}], Bin} = Msg, S) when is_binary(Bin) -> - message(recv, Msg, S); + message(recv, Msg, recv(S)); recv({_, #sctp_shutdown_event{}}, _) -> stop; @@ -769,6 +790,25 @@ recv({_, #sctp_paddr_change{}}, _) -> recv({_, #sctp_pdapi_event{}}, _) -> ok. +%% recv/1 +%% +%% Start sending unordered after the second reception, so that an +%% outgoing CER/CEA will arrive at the peer before another request. + +recv(#transport{rotate = B} = S) + when is_boolean(B) -> + S; + +recv(#transport{rotate = 0, streams = {_,N}, socket = Sock} = S) -> + ok = inet:setopts(Sock, [{sctp_default_send_param, + #sctp_sndrcvinfo{flags = [unordered]}}]), + S#transport{rotate = 1 < N}; + +recv(#transport{rotate = N} = S) -> + S#transport{rotate = N-1}. + +%% publish/4 + publish(T, Ref, Id, Sock) -> true = diameter_reg:add_new({?MODULE, T, {Ref, {Id, Sock}}}), putr(?INFO_KEY, {gen_sctp, Sock}). %% for info/1 diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index a2f393d5d4..a8639baa11 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -87,8 +87,7 @@ module :: module() | undefined}). -type length() :: 0..16#FFFFFF. %% message length from Diameter header --type size() :: non_neg_integer(). %% accumulated binary size --type frag() :: {length(), size(), binary(), list(binary())} +-type frag() :: maybe_improper_list(length(), binary()) | binary(). -type connect_option() :: {raddr, inet:ip_address()} @@ -111,7 +110,7 @@ -type option() :: {port, non_neg_integer()} | {sender, boolean()} | sender - | {message_cb, false | diameter:evaluable()} + | {message_cb, false | diameter:eval()} | {fragment_timer, 0..16#FFFFFFFF}. %% Accepting/connecting transport process state. @@ -126,7 +125,7 @@ timeout :: infinity | 0..16#FFFFFFFF, %% fragment timeout tref = false :: false | reference(), %% fragment timer reference flush = false :: boolean(), %% flush fragment at timeout? - message_cb :: false | diameter:evaluable(), + message_cb :: false | diameter:eval(), send :: pid() | false}). %% sending process %% The usual transport using gen_tcp can be replaced by anything @@ -143,8 +142,7 @@ -> {ok, pid(), [inet:ip_address()]} when Ref :: diameter:transport_ref(); ({connect, Ref}, #diameter_service{}, [connect_option()]) - -> {ok, pid(), [inet:ip_address()]} - | {ok, pid()} + -> {ok, pid()} when Ref :: diameter:transport_ref(). start({T, Ref}, Svc, Opts) -> @@ -259,22 +257,14 @@ i(#monitor{parent = Pid, transport = TPid} = S) -> i({listen, Ref, {Mod, Opts, Addrs}}) -> [_] = diameter_config:subscribe(Ref, transport), %% assert existence - {[LA, LP], Rest} = proplists:split(Opts, [ip, port]), - LAddrOpt = get_addr(LA, Addrs), - LPort = get_port(LP), - {ok, LSock} = Mod:listen(LPort, gen_opts(LAddrOpt, Rest)), - LAddr = laddr(LAddrOpt, Mod, LSock), + {[LP], Rest} = proplists:split(Opts, [port]), + {ok, LSock} = Mod:listen(get_port(LP), gen_opts(Addrs, Rest)), + {ok, {LAddr, _}} = sockname(Mod, LSock), true = diameter_reg:add_new({?MODULE, listener, {Ref, {LAddr, LSock}}}), proc_lib:init_ack({ok, self(), {LAddr, LSock}}), #listener{socket = LSock, module = Mod}. -laddr([], Mod, Sock) -> - {ok, {Addr, _Port}} = sockname(Mod, Sock), - Addr; -laddr([{ip, Addr}], _, _) -> - Addr. - ssl_opts([]) -> false; ssl_opts([{ssl_options, true}]) -> @@ -309,24 +299,16 @@ init(accept = T, Ref, Mod, Pid, Opts, Addrs, SvcPid) -> Sock; init(connect = T, Ref, Mod, Pid, Opts, Addrs, _SvcPid) -> - {[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]), - LAddrOpt = get_addr(LA, Addrs), + {[RA, RP], Rest} = proplists:split(Opts, [raddr, rport]), RAddr = get_addr(RA), RPort = get_port(RP), - proc_lib:init_ack(init_rc(LAddrOpt)), - Sock = ok(connect(Mod, RAddr, RPort, gen_opts(LAddrOpt, Rest))), + proc_lib:init_ack({ok, self()}), + Sock = ok(connect(Mod, RAddr, RPort, gen_opts(Addrs, Rest))), publish(Mod, T, Ref, Sock), - up(Pid, {RAddr, RPort}, LAddrOpt, Mod, Sock), + up(Pid, {RAddr, RPort}, Mod, Sock), Sock. -init_rc([{ip, Addr}]) -> - {ok, self(), [Addr]}; -init_rc([]) -> - {ok, self()}. - -up(Pid, Remote, [{ip, _Addr}], _, _) -> - diameter_peer:up(Pid, Remote); -up(Pid, Remote, [], Mod, Sock) -> +up(Pid, Remote, Mod, Sock) -> {Addr, _Port} = ok(sockname(Mod, Sock)), diameter_peer:up(Pid, Remote, [Addr]). @@ -383,25 +365,41 @@ l([{{?MODULE, listener, {_, AS}}, LPid}], _, _) -> l([], Ref, T) -> diameter_tcp_sup:start_child({listen, Ref, T}). -%% get_addr/1 +%% addrs/2 +%% +%% Take the first address from the service if several are specified +%% and not address is configured. + +addrs(Addrs, Opts) -> + case lists:mapfoldr(fun ipaddr/2, [], Opts) of + {Os, [_]} -> + Os; + {_, []} -> + Opts ++ [{ip, A} || [A|_] <- [Addrs]]; + {_, As} -> + ?ERROR({invalid_addrs, As, Addrs}) + end. -get_addr(As) -> - diameter_lib:ipaddr(addr(As, [])). +ipaddr({K,A}, As) + when K == ifaddr; + K == ip -> + {{ip, ipaddr(A)}, [A | As]}; +ipaddr(T, B) -> + {T, B}. -%% get_addr/2 +ipaddr(A) + when A == loopback; + A == any -> + A; +ipaddr(A) -> + diameter_lib:ipaddr(A). -get_addr([], []) -> - []; -get_addr(As, Def) -> - [{ip, diameter_lib:ipaddr(addr(As, Def))}]. +%% get_addr/1 -%% Take the first address from the service if several are unspecified. -addr([], [Addr | _]) -> - Addr; -addr([{_, Addr}], _) -> - Addr; -addr(As, Addrs) -> - ?ERROR({invalid_addrs, As, Addrs}). +get_addr([{_, Addr}]) -> + diameter_lib:ipaddr(Addr); +get_addr(Addrs) -> + ?ERROR({invalid_addrs, Addrs}). %% get_port/1 @@ -414,10 +412,15 @@ get_port(Ps) -> %% gen_opts/2 -gen_opts(LAddrOpt, Opts) -> +gen_opts(Addrs, Opts) -> + gen_opts(addrs(Addrs, Opts)). + +%% gen_opts/1 + +gen_opts(Opts) -> {L,_} = proplists:split(Opts, [binary, packet, active]), [[],[],[]] == L orelse ?ERROR({reserved_options, Opts}), - [binary, {packet, 0}, {active, false}] ++ LAddrOpt ++ Opts. + [binary, {packet, 0}, {active, false} | Opts]. %% --------------------------------------------------------------------------- %% # ports/1 @@ -599,11 +602,12 @@ t(T,S) -> %% Incoming packets. transition({P, Sock, Bin}, #transport{socket = Sock, - ssl = B} + ssl = B, + frag = Frag} = S) when P == ssl, true == B; P == tcp -> - recv(Bin, S#transport{active = false}); + recv(acc(Frag, Bin), S); %% Capabilties exchange has decided on whether or not to run over TLS. transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid} @@ -640,7 +644,7 @@ transition(Msg, S) %% Deferred actions from a message_cb. transition({actions, Dir, Acts}, S) -> - actions(Acts, Dir, S); + setopts(actions(Acts, Dir, S)); %% Request to close the transport connection. transition({diameter, {close, Pid}}, #transport{parent = Pid, @@ -720,86 +724,77 @@ tls(accept, Sock, Opts) -> %% using Nagle. %% Receive packets until a full message is received, -recv(Bin, #transport{frag = Head} = S) -> - case rcv(Head, Bin) of - {Msg, B} -> %% have a complete message ... - message(recv, Msg, S#transport{frag = B}); - Frag -> %% read more on the socket - start_fragment_timer(setopts(S#transport{frag = Frag, - flush = false})) - end. -%% rcv/2 +recv({Msg, Rest}, S) -> %% have a complete message ... + recv(acc(Rest), message(recv, Msg, S)); + +recv(Frag, #transport{recv = B, + socket = Sock, + module = M} + = S) -> %% or not + B andalso setopts(M, Sock), + start_fragment_timer(S#transport{frag = Frag, + flush = false, + active = B}). -%% No previous fragment. -rcv(<<>>, Bin) -> - rcv(Bin); +%% acc/2 -%% Not even the first four bytes of the header. -rcv(Head, Bin) - when is_binary(Head) -> - rcv(<<Head/binary, Bin/binary>>); +%% Know how many bytes to extract. +acc([Len | Acc], Bin) -> + acc1(Len, <<Acc/binary, Bin/binary>>); -%% Or enough to know how many bytes to extract. -rcv({Len, N, Head, Acc}, Bin) -> - rcv(Len, N + size(Bin), Head, [Bin | Acc]). +%% Or not. +acc(Head, Bin) -> + acc(<<Head/binary, Bin/binary>>). -%% rcv/4 +%% acc1/3 %% Extract a message for which we have all bytes. -rcv(Len, N, Head, Acc) - when Len =< N -> - recv1(Len, bin(Head, Acc)); +acc1(Len, Bin) + when Len =< byte_size(Bin) -> + split_binary(Bin, Len); %% Wait for more packets. -rcv(Len, N, Head, Acc) -> - {Len, N, Head, Acc}. - -%% rcv/1 - -%% Nothing left. -rcv(<<>> = Bin) -> - Bin; - -%% The Message Length isn't even sufficient for a header. Chances are -%% things will go south from here but if we're lucky then the bytes we -%% have extend to an intended message boundary and we can recover by -%% simply receiving them. Make it so. -rcv(<<_:1/binary, Len:24, _/binary>> = Bin) - when Len < 20 -> - {Bin, <<>>}; - -%% Enough bytes to extract a message. -rcv(<<_:1/binary, Len:24, _/binary>> = Bin) - when Len =< size(Bin) -> - recv1(Len, Bin); - -%% Or not: wait for more packets. -rcv(<<_:1/binary, Len:24, _/binary>> = Head) -> - {Len, size(Head), Head, []}; +acc1(Len, Bin) -> + [Len | Bin]. + +%% acc/1 + +%% Don't match on Bin since this results in it being copied at the +%% next append according to the Efficiency Guide. This is also the +%% reason that the Len is extracted and maintained when accumulating +%% messages. The simplest implementation is just to accumulate a +%% binary and match <<_, Len:24, _/binary>> each time the length is +%% required, but the performance of this decays quadratically with the +%% message length, since the binary is then copied with each append of +%% additional bytes from gen_tcp. + +acc(Bin) + when 3 < byte_size(Bin) -> + {Head, _} = split_binary(Bin, 4), + [_,A,B,C] = binary_to_list(Head), + Len = (A bsl 16) bor (B bsl 8) bor C, + if Len < 20 -> + %% Message length isn't sufficient for a Diameter Header. + %% Chances are things will go south from here but if we're + %% lucky then the bytes we have extend to an intended + %% message boundary and we can recover by simply receiving + %% them. Make it so. + {Bin, <<>>}; + true -> + acc1(Len, Bin) + end; %% Not even 4 bytes yet. -rcv(Head) -> - Head. - -%% recv1/2 - -recv1(Len, Bin) -> - <<Msg:Len/binary, Rest/binary>> = Bin, - {Msg, Rest}. - -%% bin/2 - -bin(Head, Acc) -> - list_to_binary([Head | lists:reverse(Acc)]). +acc(Bin) -> + Bin. %% bin/1 -bin({_, _, Head, Acc}) -> - bin(Head, Acc); +bin([_ | Bin]) -> + Bin; -bin(Bin) - when is_binary(Bin) -> +bin(Bin) -> Bin. %% flush/1 @@ -911,14 +906,20 @@ setopts(#transport{socket = Sock, module = M} = S) when B, not A -> - case setopts(M, Sock, [{active, once}]) of - ok -> S#transport{active = true}; - X -> x({setopts, Sock, M, X}) %% possibly on peer disconnect - end; + setopts(M, Sock), + S#transport{active = true}; setopts(S) -> S. +%% setopts/2 + +setopts(M, Sock) -> + case setopts(M, Sock, [{active, once}]) of + ok -> ok; + X -> x({setopts, Sock, M, X}) %% possibly on peer disconnect + end. + %% portnr/2 portnr(gen_tcp, Sock) -> @@ -988,7 +989,7 @@ message(ack, _, #transport{message_cb = false} = S) -> S; message(Dir, Msg, #transport{message_cb = CB} = S) -> - recv(<<>>, actions(cb(CB, Dir, Msg), Dir, S)). + setopts(actions(cb(CB, Dir, Msg), Dir, S)). %% actions/3 diff --git a/lib/diameter/test/diameter_codec_SUITE.erl b/lib/diameter/test/diameter_codec_SUITE.erl index 9f08f49f9f..17112794e4 100644 --- a/lib/diameter/test/diameter_codec_SUITE.erl +++ b/lib/diameter/test/diameter_codec_SUITE.erl @@ -291,7 +291,8 @@ recode(Msg, Dict) -> recode(#diameter_packet{msg = Msg}, Dict). opts(Mod) -> - #{dictionary => Mod, + #{app_dictionary => Mod, + decode_format => record, string_decode => false, strict_mbit => true, rfc => 6733, diff --git a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl index 700910878c..c6bba75f09 100644 --- a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl +++ b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl @@ -77,7 +77,8 @@ dec('BR', #diameter_packet ok. opts(Mod) -> - #{dictionary => Mod, + #{app_dictionary => Mod, + decode_format => record, string_decode => true, strict_mbit => true, rfc => 6733, diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index b548f85cb8..70e910ffa6 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -44,7 +44,8 @@ base() -> [] = run([[fun base/1, T] || T <- [zero, decode]]). gen(Mod) -> - Fs = [{Mod, F, []} || F <- [name, id, vendor_id, vendor_name]], + Fs = [{Mod, F, []} || Mod /= diameter_gen_doic_rfc7683, + F <- [name, id, vendor_id, vendor_name]], [] = run(Fs ++ [[fun gen/2, Mod, T] || T <- [messages, command_codes, avp_types, @@ -216,10 +217,11 @@ avp(Mod, encode = X, V, Name, _) -> opts(Mod) -> (opts())#{module => Mod, - dictionary => Mod}. + app_dictionary => Mod}. opts() -> - #{string_decode => true, + #{decode_format => record, + string_decode => true, strict_mbit => true, rfc => 6733, failed_avp => false}. diff --git a/lib/diameter/test/diameter_event_SUITE.erl b/lib/diameter/test/diameter_event_SUITE.erl index 57d3427037..a291dde6be 100644 --- a/lib/diameter/test/diameter_event_SUITE.erl +++ b/lib/diameter/test/diameter_event_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2016. All Rights Reserved. +%% Copyright Ericsson AB 2013-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -63,7 +63,8 @@ {'Host-IP-Address', [?ADDR]}, {'Vendor-Id', 12345}, {'Product-Name', "OTP/diameter"}, - {'Acct-Application-Id', [D:id() || D <- Dicts]} + {'Acct-Application-Id', [D:id() || D <- Dicts]}, + {decode_format, map} | [{application, [{dictionary, D}, {module, #diameter_callback{}}]} || D <- Dicts]]). @@ -111,7 +112,8 @@ up(Config) -> {Svc, Ref} = connect(Config, [{connect_timer, 5000}, {watchdog_timer, 15000}]), start = event(Svc), - {up, Ref, {TPid, Caps}, Cfg, #diameter_packet{}} = event(Svc), + {up, Ref, {TPid, Caps}, Cfg, #diameter_packet{msg = M}} = event(Svc), + ['CEA' | #{}] = M, %% assert {watchdog, Ref, _, {initial, okay}, _} = event(Svc), %% Kill the transport process and see that the connection is %% reestablished after a watchdog timeout, not after connect_timer @@ -131,8 +133,9 @@ down(Config) -> {connect_timer, 5000}, {watchdog_timer, 20000}]), start = event(Svc), - {closed, Ref, {'CEA', ?NO_COMMON_APP, _, #diameter_packet{}}, _} + {closed, Ref, {'CEA', ?NO_COMMON_APP, _, #diameter_packet{msg = M}}, _} = event(Svc), + ['CEA' | #{}] = M, %% assert {reconnect, Ref, _} = event(Svc, 4000, 10000). %% Connect with matching capabilities but have the server delay its diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl index eb99f10fe6..ee44ed8dc9 100644 --- a/lib/diameter/test/diameter_examples_SUITE.erl +++ b/lib/diameter/test/diameter_examples_SUITE.erl @@ -344,7 +344,7 @@ top(Dir, LibDir) -> start({server, Prot}) -> ok = diameter:start(), ok = server:start(), - {ok, Ref} = server:listen(Prot), + {ok, Ref} = server:listen({Prot, any, 3868}), [_] = ?util:lport(Prot, Ref), ok; @@ -352,7 +352,7 @@ start({client = Svc, Prot}) -> ok = diameter:start(), true = diameter:subscribe(Svc), ok = client:start(), - {ok, Ref} = client:connect(Prot), + {ok, Ref} = client:connect({Prot, loopback, loopback, 3868}), receive #diameter_event{info = {up, Ref, _, _, _}} -> ok end; start(Config) -> diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 84b41f14b7..ffb4a508cd 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -20,6 +20,7 @@ %% %% Tests of traffic between two Diameter nodes, one client, one server. +%% The traffic isn't meant to be sensible, just to exercise code. %% -module(diameter_traffic_SUITE). @@ -27,15 +28,18 @@ -export([suite/0, all/0, groups/0, + init_per_suite/0, init_per_suite/1, end_per_suite/1, + init_per_group/1, init_per_group/2, end_per_group/2, init_per_testcase/2, end_per_testcase/2]). %% testcases --export([start/1, +-export([rfc4005/1, + start/1, start_services/1, add_transports/1, result_codes/1, @@ -46,6 +50,7 @@ send_protocol_error/1, send_experimental_result/1, send_arbitrary/1, + send_proxy_info/1, send_unknown/1, send_unknown_short/1, send_unknown_mandatory/1, @@ -63,6 +68,7 @@ send_invalid_reject/1, send_unexpected_mandatory_decode/1, send_unexpected_mandatory/1, + send_too_many/1, send_long/1, send_maxlen/1, send_nopeer/1, @@ -98,18 +104,20 @@ stop/1]). %% diameter callbacks --export([peer_up/3, - peer_down/3, - pick_peer/6, pick_peer/7, - prepare_request/5, prepare_request/6, - prepare_retransmit/5, - handle_answer/6, handle_answer/7, - handle_error/6, - handle_request/3]). +-export([peer_up/4, + peer_down/4, + pick_peer/7, pick_peer/8, + prepare_request/6, prepare_request/7, + prepare_retransmit/6, + handle_answer/7, handle_answer/8, + handle_error/7, + handle_request/4]). %% diameter_{tcp,sctp} callbacks -export([message/3]). +-include_lib("kernel/include/inet_sctp.hrl"). + -include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). -include("diameter_gen_base_accounting.hrl"). @@ -119,13 +127,22 @@ %% =========================================================================== +%% Fraction of shuffle/parallel groups to randomly skip. +-define(SKIP, 0.25). + +%% Positive number of testcases from which to select (randomly) from +%% tc(), the list of testcases to run, or [] to run all. The random +%% selection is to limit the time it takes for the suite to run. +-define(LIMIT, #{tcp => 42, sctp => 5}). + -define(util, diameter_util). -define(A, list_to_atom). -define(L, atom_to_list). +-define(B, iolist_to_binary). %% Don't use is_record/2 since dictionary hrl's aren't included. -%% (Since they define conflicting reqcords with the same names.) +%% (Since they define conflicting records with the same names.) -define(is_record(Rec, Name), (Name == element(1, Rec))). -define(ADDR, {127,0,0,1}). @@ -138,14 +155,14 @@ %% Sequence mask for End-to-End and Hop-by-Hop identifiers. -define(CLIENT_MASK, {1,26}). %% 1 in top 6 bits -%% How to construct messages, as record or list. --define(ENCODINGS, [list, record]). +%% How to construct outgoing messages. +-define(ENCODINGS, [list, record, map]). -%% How to send answers, in a diameter_packet or not. --define(CONTAINERS, [pkt, msg]). +%% How to decode incoming messages. +-define(DECODINGS, [record, none, map, list, record_from_map]). -%% Which common dictionary to use in the clients. --define(RFCS, [rfc3588, rfc6733]). +%% Which dictionary to use in the clients. +-define(RFCS, [rfc3588, rfc6733, rfc4005]). %% Whether to decode stringish Diameter types to strings, or leave %% them as binary. @@ -163,13 +180,12 @@ -record(group, {transport, strings, + encoding, client_service, - client_encoding, - client_dict0, + client_dict, client_sender, server_service, - server_encoding, - server_container, + server_decoding, server_sender, server_throttle}). @@ -182,34 +198,37 @@ %% A common match when receiving answers in a client. -define(answer_message(SessionId, ResultCode), - ['answer-message', - {'Session-Id', SessionId}, - {'Origin-Host', _}, - {'Origin-Realm', _}, - {'Result-Code', ResultCode} - | _]). + ['answer-message' | #{'Session-Id' := SessionId, + 'Origin-Host' := _, + 'Origin-Realm' := _, + 'Result-Code' := ResultCode}]). -define(answer_message(ResultCode), - ?answer_message(_, ResultCode)). + ['answer-message' | #{'Origin-Host' := _, + 'Origin-Realm' := _, + 'Result-Code' := ResultCode}]). %% Config for diameter:start_service/2. --define(SERVICE(Name, Decode), +-define(SERVICE(Name, Grp), [{'Origin-Host', Name ++ "." ++ ?REALM}, {'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]}, + {'Auth-Application-Id', [0]}, %% common messages + {'Acct-Application-Id', [3]}, %% base accounting {restrict_connections, false}, - {string_decode, Decode}, + {string_decode, Grp#group.strings}, + {avp_dictionaries, [diameter_gen_doic_rfc7683]}, {incoming_maxlen, 1 bsl 21} | [{application, [{dictionary, D}, - {module, ?MODULE}, + {module, [?MODULE, Grp]}, {answer_errors, callback}]} || D <- [diameter_gen_base_rfc3588, diameter_gen_base_accounting, diameter_gen_base_rfc6733, - diameter_gen_acct_rfc6733]]]). + diameter_gen_acct_rfc6733, + nas4005], + D /= nas4005 orelse have_nas()]]). -define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). @@ -227,6 +246,8 @@ ?'DIAMETER_BASE_RESULT-CODE_AVP_UNSUPPORTED'). -define(UNSUPPORTED_VERSION, ?'DIAMETER_BASE_RESULT-CODE_UNSUPPORTED_VERSION'). +-define(TOO_MANY, + ?'DIAMETER_BASE_RESULT-CODE_AVP_OCCURS_TOO_MANY_TIMES'). -define(REALM_NOT_SERVED, ?'DIAMETER_BASE_RESULT-CODE_REALM_NOT_SERVED'). -define(UNABLE_TO_DELIVER, @@ -254,64 +275,75 @@ suite() -> [{timetrap, {seconds, 10}}]. all() -> - [start, result_codes, {group, traffic}, empty, stop]. + [rfc4005, start, result_codes, {group, traffic}, empty, stop]. +%% Redefine this to run one or more groups for debugging purposes. +-define(GROUPS, []). +%-define(GROUPS, [[tcp,rfc6733,record,map,false,false,false,false]]). + +%% Issues with gen_sctp sporadically cause huge numbers of failed +%% testcases when running testcases in parallel. groups() -> - [{P, [P], Ts} || Ts <- [tc(tc())], P <- [shuffle, parallel]] + Names = names(), + [{P, [P], Ts} || Ts <- [tc()], P <- [shuffle, parallel]] ++ - [{?util:name([T,R,D,A,C,S,SS,ST,CS]), - [], - [{group, if S -> shuffle; not S -> parallel end}]} - || T <- ?TRANSPORTS, - R <- ?ENCODINGS, - D <- ?RFCS, - A <- ?ENCODINGS, - C <- ?CONTAINERS, - S <- ?STRING_DECODES, - SS <- ?SENDERS, - ST <- ?CALLBACKS, - CS <- ?SENDERS] + [{?util:name(N), [], [{group, if T == sctp; S -> shuffle; + true -> parallel end}]} + || [T,_,_,_,S|_] = N <- Names] ++ - [{T, [], groups([[T,R,D,A,C,S,SS,ST,CS] - || R <- ?ENCODINGS, - D <- ?RFCS, - A <- ?ENCODINGS, - C <- ?CONTAINERS, - S <- ?STRING_DECODES, - SS <- ?SENDERS, - ST <- ?CALLBACKS, - CS <- ?SENDERS, - SS orelse CS])} %% avoid deadlock + [{T, [], [{group, ?util:name(N)} || N <- names(Names, ?GROUPS), + T == hd(N)]} || T <- ?TRANSPORTS] ++ [{traffic, [], [{group, T} || T <- ?TRANSPORTS]}]. -%groups(_) -> %% debug -% Name = [sctp,record,rfc6733,record,pkt,false,false,false,false], -% [{group, ?util:name(Name)}]; -groups(Names) -> - [{group, ?util:name(L)} || L <- Names]. +names() -> + [[T,R,E,D,S,ST,SS,CS] || T <- ?TRANSPORTS, + R <- ?RFCS, + E <- ?ENCODINGS, + D <- ?DECODINGS, + S <- ?STRING_DECODES, + ST <- ?CALLBACKS, + SS <- ?SENDERS, + CS <- ?SENDERS]. + +names(Names, []) -> + [N || N <- Names, + [CS,SS|_] <- [lists:reverse(N)], + SS orelse CS]; %% avoid deadlock -%tc([N|_]) -> %% debug -% [N]; -tc(L) -> - L. +names(_, Names) -> + Names. %% -------------------- +init_per_suite() -> + [{timetrap, {seconds, 60}}]. + init_per_suite(Config) -> - [{sctp, ?util:have_sctp()} | Config]. + [{rfc4005, compile_and_load()}, {sctp, ?util:have_sctp()} | Config]. end_per_suite(_Config) -> + code:delete(nas4005), + code:purge(nas4005), ok. %% -------------------- +init_per_group(_) -> + [{timetrap, {seconds, 30}}]. + init_per_group(Name, Config) when Name == shuffle; Name == parallel -> - start_services(Config), - add_transports(Config); + case rand:uniform() < ?SKIP of + true -> + {skip, random}; + false -> + start_services(Config), + add_transports(Config), + replace({sleep, Name == parallel}, Config) + end; init_per_group(sctp = Name, Config) -> {_, Sctp} = lists:keyfind(Name, 1, Config), @@ -322,24 +354,22 @@ init_per_group(sctp = Name, Config) -> end; init_per_group(Name, Config) -> + Nas = proplists:get_value(rfc4005, Config, false), case ?util:name(Name) of - [T,R,D,A,C,S,SS,ST,CS] -> + [_,R,_,_,_,_,_,_] when R == rfc4005, true /= Nas -> + {skip, rfc4005}; + [T,R,E,D,S,ST,SS,CS] -> G = #group{transport = T, strings = S, + encoding = E, client_service = [$C|?util:unique_string()], - client_encoding = R, - client_dict0 = dict0(D), + client_dict = appdict(R), client_sender = CS, server_service = [$S|?util:unique_string()], - server_encoding = A, - server_container = C, + server_decoding = D, server_sender = SS, server_throttle = ST}, - %% Limit the number of testcase, since the number of - %% groups is large. - All = ?util:scramble(tc()), - TCs = lists:sublist(All, rand:uniform(32)), - [{group, G}, {runlist, TCs} | Config]; + replace([{group, G}, {runlist, select(T)}], Config); _ -> Config end. @@ -353,8 +383,26 @@ end_per_group(Name, Config) end_per_group(_, _) -> ok. +select(T) -> + try maps:get(T, ?LIMIT) of + N -> + lists:sublist(?util:scramble(tc()), max(5, rand:uniform(N))) + catch + error:_ -> ?LIMIT + end. + %% -------------------- +%% Work around common_test accumulating Config improperly, causing +%% testcases to get Config from groups and suites they're not in. +init_per_testcase(N, Config) + when N == rfc4005; + N == start; + N == result_codes; + N == empty; + N == stop -> + Config; + %% Skip testcases that can reasonably fail under SCTP. init_per_testcase(Name, Config) -> TCs = proplists:get_value(runlist, Config, []), @@ -368,12 +416,26 @@ init_per_testcase(Name, Config) -> _ when not Run -> {skip, random}; _ -> + proplists:get_value(sleep, Config, false) + andalso timer:sleep(rand:uniform(200)), [{testcase, Name} | Config] end. end_per_testcase(_, _) -> ok. +%% replace/2 +%% +%% Work around common_test running init functions inappropriately, and +%% this accumulating more config than expected. + +replace(Pairs, Config) + when is_list(Pairs) -> + lists:foldl(fun replace/2, Config, Pairs); + +replace({Key, _} = T, Config) -> + [T | lists:keydelete(Key, 1, Config)]. + %% -------------------- %% Testcases to run when services are started and connections @@ -386,6 +448,7 @@ tc() -> send_protocol_error, send_experimental_result, send_arbitrary, + send_proxy_info, send_unknown, send_unknown_short, send_unknown_mandatory, @@ -403,6 +466,7 @@ tc() -> send_invalid_reject, send_unexpected_mandatory_decode, send_unexpected_mandatory, + send_too_many, send_long, send_maxlen, send_nopeer, @@ -440,16 +504,26 @@ start(_Config) -> ok = diameter:start(). start_services(Config) -> - #group{strings = S, - client_service = CN, - server_service = SN} + #group{client_service = CN, + server_service = SN, + server_decoding = SD} + = Grp = group(Config), - ok = diameter:start_service(SN, ?SERVICE(SN, S)), - ok = diameter:start_service(CN, [{sequence, ?CLIENT_MASK} - | ?SERVICE(CN, S)]). + ok = diameter:start_service(SN, [{traffic_counters, bool()}, + {decode_format, SD} + | ?SERVICE(SN, Grp)]), + ok = diameter:start_service(CN, [{traffic_counters, bool()}, + {sequence, ?CLIENT_MASK}, + {decode_format, map}, + {strict_arities, decode} + | ?SERVICE(CN, Grp)]). + +bool() -> + 0.5 =< rand:uniform(). add_transports(Config) -> #group{transport = T, + encoding = E, client_service = CN, client_sender = CS, server_service = SN, @@ -459,30 +533,54 @@ add_transports(Config) -> LRef = ?util:listen(SN, [T, {sender, SS}, - {message_cb, ST andalso {?MODULE, message, [4]}} + {message_cb, ST andalso {?MODULE, message, [0]}} | [{packet, hd(?util:scramble([false, raw]))} || T == sctp andalso CS]], [{capabilities_cb, fun capx/2}, - {pool_size, 8}, - {applications, apps(rfc3588)}] + {pool_size, 8} + | server_apps()] ++ [{spawn_opt, {erlang, spawn, []}} || CS]), Cs = [?util:connect(CN, - [T, {sender, CS}], + [T, {sender, CS} | client_opts(T)], LRef, - [{id, Id}, - {capabilities, [{'Origin-State-Id', origin(Id)}]}, - {applications, apps(D)}]) - || A <- ?ENCODINGS, - C <- ?CONTAINERS, - D <- ?RFCS, - Id <- [{A,C}]], - %% The server uses the client's Origin-State-Id to decide how to - %% answer. + [{id, Id} + | client_apps(R, [{'Origin-State-Id', origin(Id)}])]) + || D <- ?DECODINGS, %% for multiple candidate peers + R <- ?RFCS, + R /= rfc4005 orelse have_nas(), + Id <- [{D,E}]], ?util:write_priv(Config, "transport", [LRef | Cs]). -apps(D0) -> - D = dict0(D0), - [acct(D), D]. +client_opts(tcp) -> + []; +client_opts(sctp) -> + [{sctp_initmsg, #sctp_initmsg{num_ostreams = N, + max_instreams = 5}} + || N <- [rand:uniform(8)], + N =< 6]. + +server_apps() -> + B = have_nas(), + [{applications, [diameter_gen_base_rfc3588, + diameter_gen_base_accounting] + ++ [nas4005 || B]}, + {capabilities, [{'Auth-Application-Id', [0] ++ [1 || B]}, %% common, NAS + {'Acct-Application-Id', [3]}]}]. %% accounting + +client_apps(D, Caps) -> + if D == rfc4005 -> + [{applications, [nas4005]}, + {capabilities, [{'Auth-Application-Id', [1]}, %% NAS + {'Acct-Application-Id', []} + | Caps]}]; + true -> + D0 = dict0(D), + [{applications, [acct(D0), D0]}, + {capabilities, Caps}] + end. + +have_nas() -> + false /= code:is_loaded(nas4005). remove_transports(Config) -> #group{client_service = CN, @@ -515,9 +613,16 @@ capx(_, #diameter_caps{origin_host = {OH,DH}}) -> %% =========================================================================== +%% Fail only this testcase if the RFC 4005 dictionary hasn't been +%% successfully compiled and loaded. +rfc4005(Config) -> + true = proplists:get_value(rfc4005, Config). + %% Ensure that result codes have the expected values. result_codes(_Config) -> - {2001, 3001, 3002, 3003, 3004, 3007, 3008, 3009, 5001, 5011, 5014} + {2001, + 3001, 3002, 3003, 3004, 3007, 3008, 3009, + 5001, 5009, 5011, 5014} = {?SUCCESS, ?COMMAND_UNSUPPORTED, ?UNABLE_TO_DELIVER, @@ -527,6 +632,7 @@ result_codes(_Config) -> ?INVALID_HDR_BITS, ?INVALID_AVP_BITS, ?AVP_UNSUPPORTED, + ?TOO_MANY, ?UNSUPPORTED_VERSION, ?INVALID_AVP_LENGTH}. @@ -534,8 +640,8 @@ result_codes(_Config) -> send_ok(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 1}], - - ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['ACA' | #{'Result-Code' := ?SUCCESS, + 'Session-Id' := _}] = call(Config, Req). %% Send an accounting ACR that the server answers badly to. @@ -551,7 +657,8 @@ send_eval(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 3}], - ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['ACA' | #{'Result-Code' := ?SUCCESS, + 'Session-Id' := _}] = call(Config, Req). %% Send an accounting ACR that the server tries to answer with an @@ -564,20 +671,87 @@ send_bad_answer(Config) -> = call(Config, Req). %% Send an ACR that the server callback answers explicitly with a -%% protocol error. +%% protocol error and some AVPs to check the decoding of. send_protocol_error(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 4}], - ?answer_message(?TOO_BUSY) - = call(Config, Req). + ['answer-message' | #{'Result-Code' := ?TOO_BUSY, + 'AVP' := [OLR | _]} = Avps] + = call(Config, Req), + + #diameter_avp{name = 'OC-OLR', + value = #{'OC-Sequence-Number' := 1, + 'OC-Report-Type' := 0, %% HOST_REPORT + 'OC-Reduction-Percentage' := [25], + 'OC-Validity-Duration' := [60], + 'AVP' := [OSF]}} + = OLR, + #diameter_avp{name = 'OC-Supported-Features', + value = #{} = Fs} + = OSF, + 0 = maps:size(Fs), + + #group{client_dict = D} = group(Config), + + if D == nas4005 -> + error = maps:find('Failed-AVP', Avps), + #{'AVP' := [_,Failed]} + = Avps, + #diameter_avp{name = 'Failed-AVP', + value = #{'AVP' := [NP,FR,AP]}} + = Failed, + #diameter_avp{name = 'NAS-Port', + value = 44} + = NP, + #diameter_avp{name = 'Firmware-Revision', + value = 12} + = FR, + #diameter_avp{name = 'Auth-Grace-Period', + value = 13} + = AP; + + D == diameter_gen_base_rfc3588; + D == diameter_gen_basr_accounting -> + error = maps:find('Failed-AVP', Avps), + #{'AVP' := [_,Failed]} + = Avps, + + #diameter_avp{name = 'Failed-AVP', + value = #{'AVP' := [NP,FR,AP]}} + = Failed, + #diameter_avp{name = undefined, + value = undefined} + = NP, + #diameter_avp{name = 'Firmware-Revision', + value = 12} + = FR, + #diameter_avp{name = 'Auth-Grace-Period', + value = 13} + = AP; + + D == diameter_gen_base_rfc6733; + D == diameter_gen_acct_rfc6733 -> + #{'Failed-AVP' := [#{'AVP' := [NP,FR,AP]}], + 'AVP' := [_]} + = Avps, + #diameter_avp{name = undefined, + value = undefined} + = NP, + #diameter_avp{name = 'Firmware-Revision', + value = 12} + = FR, + #diameter_avp{name = 'Auth-Grace-Period', + value = 13} + = AP + end. %% Send a 3xxx Experimental-Result in an answer not setting the E-bit %% and missing a Result-Code. send_experimental_result(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 5}], - ['ACA', {'Session-Id', _} | _] + ['ACA' | #{'Session-Id' := _}] = call(Config, Req). %% Send an ASR with an arbitrary non-mandatory AVP and expect success @@ -585,24 +759,37 @@ send_experimental_result(Config) -> send_arbitrary(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name', value = "XXX"}]}], - ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps] + ['ASA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS, + 'AVP' := [#diameter_avp{name = 'Product-Name', + value = V}]}] = call(Config, Req), - {'AVP', [#diameter_avp{name = 'Product-Name', - value = V}]} - = lists:last(Avps), "XXX" = string(V, Config). +%% Send Proxy-Info in an ASR that the peer answers with 3xxx, and +%% ensure that the AVP is returned. +send_proxy_info(Config) -> + H0 = ?B(?util:unique_string()), + S0 = ?B(?util:unique_string()), + Req = ['ASR', {'Proxy-Info', #{'Proxy-Host' => H0, + 'Proxy-State' => S0}}], + ['answer-message' | #{'Result-Code' := 3999, + 'Proxy-Info' := [#{'Proxy-Host' := H, + 'Proxy-State' := S}]}] + = call(Config, Req), + [H0, S0] = [?B(X) || X <- [H,S]]. + %% Send an unknown AVP (to some client) and check that it comes back. send_unknown(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = false, data = <<17>>}]}], - ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps] - = call(Config, Req), - {'AVP', [#diameter_avp{code = 999, - is_mandatory = false, - data = <<17>>}]} - = lists:last(Avps). + ['ASA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS, + 'AVP' := [#diameter_avp{code = 999, + is_mandatory = false, + data = <<17>>}]}] + = call(Config, Req). %% Ditto, and point the AVP length past the end of the message. Expect %% 5014. @@ -613,28 +800,28 @@ send_unknown_short(Config, M, RC) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = M, data = <<17>>}]}], - ['ASA', {'Session-Id', _}, {'Result-Code', RC} | Avps] + ['ASA' | #{'Session-Id' := _, + 'Result-Code' := RC, + 'Failed-AVP' := [#{'AVP' := [Avp]}]}] = call(Config, Req), - [#'diameter_base_Failed-AVP'{'AVP' = As}] - = proplists:get_value('Failed-AVP', Avps), - [#diameter_avp{code = 999, - is_mandatory = M, - data = <<17, _/binary>>}] %% extra bits from padding - = As. + #diameter_avp{code = 999, + is_mandatory = M, + data = <<17, _/binary>>} %% extra bits from padding + = Avp. %% Ditto but set the M flag. send_unknown_mandatory(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = true, data = <<17>>}]}], - ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] + ['ASA' | #{'Session-Id' := _, + 'Result-Code' := ?AVP_UNSUPPORTED, + 'Failed-AVP' := [#{'AVP' := [Avp]}]}] = call(Config, Req), - [#'diameter_base_Failed-AVP'{'AVP' = As}] - = proplists:get_value('Failed-AVP', Avps), - [#diameter_avp{code = 999, - is_mandatory = true, - data = <<17>>}] - = As. + #diameter_avp{code = 999, + is_mandatory = true, + data = <<17>>} + = Avp. %% Ditto, and point the AVP length past the end of the message. Expect %% 5014 instead of 5001. @@ -647,15 +834,27 @@ send_unexpected_mandatory_decode(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 27, %% Session-Timeout is_mandatory = true, data = <<12:32>>}]}], - ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] + ['ASA' | #{'Session-Id' := _, + 'Result-Code' := ?AVP_UNSUPPORTED, + 'Failed-AVP' := [#{'AVP' := [Avp]}]}] = call(Config, Req), - [#'diameter_base_Failed-AVP'{'AVP' = As}] - = proplists:get_value('Failed-AVP', Avps), - [#diameter_avp{code = 27, - is_mandatory = true, - value = 12, - data = <<12:32>>}] - = As. + #diameter_avp{code = 27, + is_mandatory = true, + value = 12, + data = <<12:32>>} + = Avp. + +%% Try to two Auth-Application-Id in ASR expect 5009. +send_too_many(Config) -> + Req = ['ASR', {'Auth-Application-Id', [?APP_ID, 44]}], + + ['ASA' | #{'Session-Id' := _, + 'Result-Code' := ?TOO_MANY, + 'Failed-AVP' := [#{'AVP' := [Avp]}]}] + = call(Config, Req), + #diameter_avp{name = 'Auth-Application-Id', + value = 44} + = Avp. %% Send an containing a faulty Grouped AVP (empty Proxy-Host in %% Proxy-Info) and expect that only the faulty AVP is sent in @@ -665,16 +864,13 @@ send_unexpected_mandatory_decode(Config) -> send_grouped_error(Config) -> Req = ['ASR', {'Proxy-Info', [[{'Proxy-Host', "abcd"}, {'Proxy-State', ""}]]}], - ['ASA', {'Session-Id', _}, {'Result-Code', ?INVALID_AVP_LENGTH} | Avps] + ['ASA' | #{'Session-Id' := _, + 'Result-Code' := ?INVALID_AVP_LENGTH, + 'Failed-AVP' := [#{'AVP' := [Avp]}]}] = call(Config, Req), - [#'diameter_base_Failed-AVP'{'AVP' = As}] - = proplists:get_value('Failed-AVP', Avps), - [#diameter_avp{name = 'Proxy-Info', - value = #'diameter_base_Proxy-Info' - {'Proxy-Host' = Empty, - 'Proxy-State' = undefined}}] - = As, - <<0>> = iolist_to_binary(Empty). + #diameter_avp{name = 'Proxy-Info', value = #{'Proxy-Host' := H}} + = Avp, + <<0>> = ?B(H). %% Send an STR that the server ignores. send_noreply(Config) -> @@ -702,7 +898,8 @@ send_error_bit(Config) -> %% Send a bad version and check that we get 5011. send_unsupported_version(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', {'Session-Id', _}, {'Result-Code', ?UNSUPPORTED_VERSION} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?UNSUPPORTED_VERSION}] = call(Config, Req). %% Send a request containing an AVP length > data size. @@ -722,16 +919,11 @@ send_zero_avp_length(Config) -> send_invalid_avp_length(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', {'Session-Id', _}, - {'Result-Code', ?INVALID_AVP_LENGTH}, - {'Origin-Host', _}, - {'Origin-Realm', _}, - {'User-Name', _}, - {'Class', _}, - {'Error-Message', _}, - {'Error-Reporting-Host', _}, - {'Failed-AVP', [#'diameter_base_Failed-AVP'{'AVP' = [_]}]} - | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?INVALID_AVP_LENGTH, + 'Origin-Host' := _, + 'Origin-Realm' := _, + 'Failed-AVP' := [#{'AVP' := [_]}]}] = call(Config, Req). %% Send a request containing 5xxx errors that the server rejects with @@ -747,14 +939,16 @@ send_invalid_reject(Config) -> send_unexpected_mandatory(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?AVP_UNSUPPORTED}] = call(Config, Req). %% Send something long that will be fragmented by TCP. send_long(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'User-Name', [binary:copy(<<$X>>, 1 bsl 20)]}], - ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS}] = call(Config, Req). %% Send something longer than the configure incoming_maxlen. @@ -797,7 +991,8 @@ send_any_2(Config) -> send_all_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM), - ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS}] = call(Config, Req, [{filter, {all, [{host, any}, {realm, Realm}]}}]). send_all_2(Config) -> @@ -826,13 +1021,13 @@ send_detach(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Ref = make_ref(), ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]), - Ans = receive {Ref, T} -> T end, - ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] - = Ans. + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS}] + = receive {Ref, T} -> T end. %% Send a request which can't be encoded and expect {error, encode}. send_encode_error(Config) -> - {error, encode} = call(Config, ['STR']). %% No Termination-Cause + {error, encode} = call(Config, ['STR', {'Termination-Cause', huh}]). %% Send with filtering and expect success. send_destination_1(Config) -> @@ -840,25 +1035,27 @@ send_destination_1(Config) -> = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(SN, ?REALM)]}], - ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS}] = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS}] = call(Config, Req, [{filter, {all, [host, realm]}}]). %% Send with filtering on and expect failure when specifying an %% unknown host or realm. send_destination_3(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Realm', "unknown.org"}], + {'Destination-Realm', <<"unknown.org">>}], {error, no_connection} = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_4(Config) -> #group{server_service = SN} = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(SN, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, ["unknown.org"])]}], {error, no_connection} = call(Config, Req, [{filter, {all, [host, realm]}}]). @@ -866,7 +1063,7 @@ send_destination_4(Config) -> %% an unknown host or realm. send_destination_5(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Realm', "unknown.org"}], + {'Destination-Realm', [<<"unknown.org">>]}], ?answer_message(?REALM_NOT_SERVED) = call(Config, Req). send_destination_6(Config) -> @@ -908,7 +1105,8 @@ send_bad_filter(Config, F) -> %% Specify multiple filter options and expect them be conjunctive. send_multiple_filters_1(Config) -> Fun = fun(#diameter_caps{}) -> true end, - ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS}] = send_multiple_filters(Config, [host, {eval, Fun}]). send_multiple_filters_2(Config) -> E = {erlang, is_tuple, []}, @@ -919,7 +1117,8 @@ send_multiple_filters_3(Config) -> E2 = {erlang, is_tuple, []}, E3 = {erlang, is_record, [diameter_caps]}, E4 = [{erlang, is_record, []}, diameter_caps], - ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS}] = send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]). send_multiple_filters(Config, Fs) -> @@ -930,7 +1129,8 @@ send_multiple_filters(Config, Fs) -> %% only the return value from the prepare_request callback being %% significant. send_anything(Config) -> - ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] + ['STA' | #{'Session-Id' := _, + 'Result-Code' := ?SUCCESS}] = call(Config, anything). %% =========================================================================== @@ -954,58 +1154,137 @@ call(Config, Req) -> call(Config, Req, Opts) -> Name = proplists:get_value(testcase, Config), - #group{client_service = CN, - client_encoding = ReqEncoding, - client_dict0 = Dict0} - = Group + #group{encoding = Enc, + client_service = CN, + client_dict = Dict0} = group(Config), diameter:call(CN, dict(Req, Dict0), - msg(Req, ReqEncoding, Dict0), - [{extra, [{Name, Group}, diameter_lib:now()]} | Opts]). + msg(Req, Enc, Dict0), + [{extra, [Name, diameter_lib:now()]} | Opts]). -origin({A,C}) -> - 2*codec(A) + container(C); +origin({D,E}) -> + 4*decode(D) + encode(E); origin(N) -> - {codec(N band 2), container(N rem 2)}. - -%% Map booleans, but the readable atoms are part of (constructed) -%% group names, so it's good that they're readable. - -codec(record) -> 0; -codec(list) -> 1; -codec(0) -> record; -codec(_) -> list. - -container(pkt) -> 0; -container(msg) -> 1; -container(0) -> pkt; -container(_) -> msg. + {decode(N bsr 2), encode(N rem 4)}. + +%% Map atoms. The atoms are part of (constructed) group names, so it's +%% good that they're readable. + +decode(record) -> 0; +decode(list) -> 1; +decode(map) -> 2; +decode(none) -> 3; +decode(record_from_map) -> 4; +decode(0) -> record; +decode(1) -> list; +decode(2) -> map; +decode(3) -> none; +decode(4) -> record_from_map. + +encode(record) -> 0; +encode(list) -> 1; +encode(map) -> 2; +encode(0) -> record; +encode(1) -> list; +encode(2) -> map. msg([H|_] = Msg, record = E, diameter_gen_base_rfc3588) when H == 'ACR'; H == 'ACA' -> msg(Msg, E, diameter_gen_base_accounting); + msg([H|_] = Msg, record = E, diameter_gen_base_rfc6733) when H == 'ACR'; H == 'ACA' -> msg(Msg, E, diameter_gen_acct_rfc6733); + msg([H|T], record, Dict) -> Dict:'#new-'(Dict:msg2rec(H), T); + +msg([H|As], map, _) + when is_list(As) -> + [H | maps:from_list(As)]; + msg(Msg, _, _) -> Msg. +to_map(#diameter_packet{msg = [_MsgName | Avps] = Msg}, + #group{server_decoding = map}) + when is_map(Avps) -> + Msg; + +to_map(#diameter_packet{msg = [MsgName | Avps]}, + #group{server_decoding = list}) -> + [MsgName | maps:from_list(Avps)]; + +to_map(#diameter_packet{header = H, msg = Rec}, + #group{server_decoding = D}) + when D == record; + D == record_from_map -> + rec_to_map(Rec, dict(H)); + +%% No record decode: do it ourselves. +to_map(#diameter_packet{header = H, + msg = Name, + bin = Bin}, + #group{server_decoding = none, + strings = B}) -> + Opts = #{decode_format => map, + string_decode => B, + avp_dictionaries => [diameter_gen_doic_rfc7683], + strict_mbit => true, + rfc => 6733}, + #diameter_packet{msg = [MsgName | _Map] = Msg} + = diameter_codec:decode(dict(H), Opts, Bin), + {MsgName, _} = {Name, Msg}, %% assert + Msg. + +dict(#diameter_header{application_id = Id, + cmd_code = Code}) -> + if Id == 1 -> + nas4005; + Code == 271 -> + diameter_gen_base_accounting; + true -> + diameter_gen_base_rfc3588 + end. + +rec_to_map(Rec, Dict) -> + [R | Vs] = Dict:'#get-'(Rec), + [Dict:rec2msg(R) | maps:from_list([T || {_,V} = T <- Vs, + V /= undefined, + V /= []])]. + +appdict(rfc4005) -> + nas4005; +appdict(D) -> + dict0(D). + dict0(D) -> ?A("diameter_gen_base_" ++ ?L(D)). -dict(Msg, Dict0) - when 'ACR' == hd(Msg); - 'ACA' == hd(Msg); - ?is_record(Msg, diameter_base_accounting_ACR); - ?is_record(Msg, diameter_base_accounting_ACA) -> +dict(Msg, Dict) -> + d(name(Msg), Dict). + +d(N, nas4005 = D) -> + if N == {list, 'answer-message'}; + N == {map, 'answer-message'}; + N == {record, 'diameter_base_answer-message'} -> + diameter_gen_base_rfc3588; + true -> + D + end; +d(N, Dict0) + when N == {list, 'ACR'}; + N == {list, 'ACA'}; + N == {map, 'ACR'}; + N == {map, 'ACA'}; + N == {record, diameter_base_accounting_ACR}; + N == {record, diameter_base_accounting_ACA} -> acct(Dict0); -dict(_, Dict0) -> +d(_, Dict0) -> Dict0. acct(diameter_gen_base_rfc3588) -> @@ -1014,53 +1293,60 @@ acct(diameter_gen_base_rfc6733) -> diameter_gen_acct_rfc6733. %% Set only values that aren't already. -set(_, [H|T], Vs) -> - [H | Vs ++ T]; -set(#group{client_dict0 = Dict0} = _Group, Rec, Vs) -> + +set(_, [N | As], Vs) -> + [N | if is_map(As) -> + maps:merge(maps:from_list(Vs), As); + is_list(As) -> + Vs ++ As + end]; + +set(#group{client_dict = Dict0} = _Group, Rec, Vs) -> Dict = dict(Rec, Dict0), lists:foldl(fun({F,_} = FV, A) -> - set(Dict, Dict:'#get-'(F, A), FV, A) + reset(Dict, Dict:'#get-'(F, A), FV, A) end, Rec, Vs). -set(Dict, E, FV, Rec) +reset(Dict, E, FV, Rec) when E == undefined; E == [] -> Dict:'#set-'(FV, Rec); -set(_, _, _, Rec) -> + +reset(_, _, _, Rec) -> Rec. %% =========================================================================== %% diameter callbacks -%% peer_up/3 +%% peer_up/4 -peer_up(_SvcName, _Peer, State) -> +peer_up(_SvcName, _Peer, State, _Group) -> State. %% peer_down/3 -peer_down(_SvcName, _Peer, State) -> +peer_down(_SvcName, _Peer, State, _Group) -> State. -%% pick_peer/6-7 +%% pick_peer/7-8 -pick_peer(Peers, _, [$C|_], _State, {Name, Group}, _) +pick_peer(Peers, _, [$C|_], _State, Group, Name, _) when Name /= send_detach -> find(Group, Peers). -pick_peer(_Peers, _, [$C|_], _State, {send_nopeer, _}, _, ?EXTRA) -> +pick_peer(_Peers, _, [$C|_], _State, _Group, send_nopeer, _, ?EXTRA) -> false; -pick_peer(Peers, _, [$C|_], _State, {send_detach, Group}, _, {_,_}) -> +pick_peer(Peers, _, [$C|_], _State, Group, send_detach, _, {_,_}) -> find(Group, Peers). -find(#group{client_service = CN, - server_encoding = A, - server_container = C}, +find(#group{encoding = E, + client_service = CN, + server_decoding = D}, [_|_] = Peers) -> - Id = {A,C}, + Id = {D,E}, [P] = [P || P <- Peers, id(Id, P, CN)], {ok, P}. @@ -1069,15 +1355,15 @@ id(Id, {Pid, _Caps}, SvcName) -> = diameter:service_info(SvcName, Pid), lists:member({id, Id}, Opts). -%% prepare_request/5-6 +%% prepare_request/6-7 -prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, {send_discard, _}, _) -> +prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, _, send_discard, _) -> {discard, unprepared}; -prepare_request(Pkt, [$C|_], {_Ref, Caps}, {Name, Group}, _) -> +prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, Name, _) -> {send, prepare(Pkt, Caps, Name, Group)}. -prepare_request(Pkt, [$C|_], {_Ref, Caps}, {send_detach, Group}, _, _) -> +prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, send_detach, _, _) -> {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}. log(#diameter_packet{bin = Bin} = P, T) @@ -1086,7 +1372,7 @@ log(#diameter_packet{bin = Bin} = P, T) %% prepare/4 -prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) +prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group) when N == send_unknown_short_mandatory; N == send_unknown_short -> Req = prepare(Pkt, Caps, Group), @@ -1106,7 +1392,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) <<H:Offset/binary, Len:24, T/binary>> = Bin, E#diameter_packet{bin = <<H/binary, (Len+9):24, T/binary>>}; -prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) +prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group) when N == send_long_avp_length; N == send_short_avp_length; N == send_zero_avp_length -> @@ -1132,7 +1418,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) T/binary, Hdr/binary, AL:24, Data/binary>>}; -prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) +prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group) when N == send_invalid_avp_length; N == send_invalid_reject -> Req = prepare(Pkt, Caps, Group), @@ -1147,7 +1433,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) <<V, L:24, H/binary>> = H0, %% assert E#diameter_packet{bin = <<V, (L+4):24, H/binary, 16:24, 0:32, T/binary>>}; -prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0} +prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict = Dict0} = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<V, Len:24, T/binary>>} @@ -1157,7 +1443,7 @@ prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0} Avp = <<Code:32, Flags, 8:24>>, E#diameter_packet{bin = <<V, (Len+8):24, T/binary, Avp/binary>>}; -prepare(Pkt, Caps, send_grouped_error, #group{client_dict0 = Dict0} +prepare(Pkt, Caps, send_grouped_error, #group{client_dict = Dict0} = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = Bin} @@ -1189,14 +1475,14 @@ prepare(Pkt, Caps, send_grouped_error, #group{client_dict0 = Dict0} Payload/binary, T/binary>>}; -prepare(Pkt, Caps, send_unsupported, #group{client_dict0 = Dict0} = Group) -> +prepare(Pkt, Caps, send_unsupported, #group{client_dict = Dict0} = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>} = E = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), E#diameter_packet{bin = <<H/binary, 42:24, T/binary>>}; -prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0} +prepare(Pkt, Caps, send_unsupported_app, #group{client_dict = Dict0} = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>} @@ -1223,93 +1509,120 @@ prepare(Pkt, Caps, _Name, Group) -> %% prepare/3 -prepare(#diameter_packet{msg = Req}, Caps, Group) - when ?is_record(Req, diameter_base_accounting_ACR); - 'ACR' == hd(Req) -> +prepare(#diameter_packet{msg = Req} = Pkt, Caps, Group) -> + set(name(Req), Pkt, Caps, Group). + +%% set/4 + +set(N, #diameter_packet{msg = Req}, Caps, Group) + when N == {record, diameter_base_accounting_ACR}; + N == {record, nas_ACR}; + N == {map, 'ACR'}; + N == {list, 'ACR'} -> #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, DR}} = Caps, - set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Realm', DR}]); + set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]}, + {'Origin-Host', [OH]}, + {'Origin-Realm', [OR]}, + {'Destination-Realm', [DR]}]); -prepare(#diameter_packet{msg = Req}, Caps, Group) - when ?is_record(Req, diameter_base_ASR); - 'ASR' == hd(Req) -> +set(N, #diameter_packet{msg = Req}, Caps, Group) + when N == {record, diameter_base_ASR}; + N == {record, nas_ASR}; + N == {map, 'ASR'}; + N == {list, 'ASR'} -> #diameter_caps{origin_host = {OH, DH}, origin_realm = {OR, DR}} = Caps, - set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Host', DH}, - {'Destination-Realm', DR}, + set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]}, + {'Origin-Host', [OH]}, + {'Origin-Realm', [OR]}, + {'Destination-Host', [DH]}, + {'Destination-Realm', [DR]}, {'Auth-Application-Id', ?APP_ID}]); -prepare(#diameter_packet{msg = Req}, Caps, Group) - when ?is_record(Req, diameter_base_STR); - 'STR' == hd(Req) -> +set(N, #diameter_packet{msg = Req}, Caps, Group) + when N == {record, diameter_base_STR}; + N == {record, nas_STR}; + N == {map, 'STR'}; + N == {list, 'STR'} -> #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, DR}} = Caps, - set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Realm', DR}, + set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]}, + {'Origin-Host', [OH]}, + {'Origin-Realm', [OR]}, + {'Destination-Realm', [DR]}, {'Auth-Application-Id', ?APP_ID}]); -prepare(#diameter_packet{msg = Req}, Caps, Group) - when ?is_record(Req, diameter_base_RAR); - 'RAR' == hd(Req) -> +set(N, #diameter_packet{msg = Req}, Caps, Group) + when N == {record, diameter_base_RAR}; + N == {record, nas_RAR}; + N == {map, 'RAR'}; + N == {list, 'RAR'} -> #diameter_caps{origin_host = {OH, DH}, origin_realm = {OR, DR}} = Caps, - set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Host', DH}, - {'Destination-Realm', DR}, + set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]}, + {'Origin-Host', [OH]}, + {'Origin-Realm', [OR]}, + {'Destination-Host', [DH]}, + {'Destination-Realm', [DR]}, {'Auth-Application-Id', ?APP_ID}]). -%% prepare_retransmit/5 +%% name/1 + +name([H|#{}]) -> + {map, H}; + +name([H|_]) -> + {list, H}; -prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) -> +name(Rec) -> + try + {record, element(1, Rec)} + catch + error: badarg -> + false + end. + +%% prepare_retransmit/6 + +prepare_retransmit(_Pkt, false, _Peer, _Group, _Name, _) -> discard. -%% handle_answer/6-7 +%% handle_answer/7-8 -handle_answer(Pkt, Req, [$C|_], Peer, {Name, Group}, _) -> +handle_answer(Pkt, Req, [$C|_], Peer, Group, Name, _) -> answer(Pkt, Req, Peer, Name, Group). -handle_answer(Pkt, Req, [$C|_], Peer, {send_detach = Name, Group}, _, X) -> +handle_answer(Pkt, Req, [$C|_], Peer, Group, send_detach = Name, _, X) -> {Pid, Ref} = X, Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}. -answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) -> +answer(Pkt, Req, _Peer, Name, #group{client_dict = Dict0}) -> #diameter_packet{header = H, msg = Ans, errors = Es} = Pkt, ApplId = app(Req, Name, Dict0), #diameter_header{application_id = ApplId} = H, %% assert - Dict = dict(Ans, Dict0), - [R | Vs] = Dict:'#get-'(answer(Ans, Es, Name)), - [Dict:rec2msg(R) | Vs]. + answer(Ans, Es, Name). %% Missing Result-Code and inappropriate Experimental-Result-Code. -answer(Rec, Es, send_experimental_result) -> +answer(Ans, Es, send_experimental_result) -> [{5004, #diameter_avp{name = 'Experimental-Result'}}, {5005, #diameter_avp{name = 'Result-Code'}}] = Es, - Rec; + Ans; %% An inappropriate E-bit results in a decode error ... -answer(Rec, Es, send_bad_answer) -> +answer(Ans, Es, send_bad_answer) -> [{5004, #diameter_avp{name = 'Result-Code'}} | _] = Es, - Rec; + Ans; %% ... while other errors are reflected in Failed-AVP. -answer(Rec, [], _) -> - Rec. +answer(Ans, [], _) -> + Ans. app(_, send_unsupported_app, _) -> ?BAD_APP; @@ -1317,25 +1630,29 @@ app(Req, _, Dict0) -> Dict = dict(Req, Dict0), Dict:id(). -%% handle_error/6 +%% handle_error/7 -handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, Time) -> +handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, _, Time) -> Now = diameter_lib:now(), {Reason, {diameter_lib:timestamp(Time), diameter_lib:timestamp(Now), diameter_lib:micro_diff(Now, Time)}}; -handle_error(Reason, _Req, [$C|_], _Peer, _, _Time) -> +handle_error(Reason, _Req, [$C|_], _Peer, _, _, _Time) -> {error, Reason}. -%% handle_request/3 +%% handle_request/4 %% Note that diameter will set Result-Code and Failed-AVPs if %% #diameter_packet.errors is non-null. -handle_request(#diameter_packet{header = H, msg = M, avps = As}, +handle_request(#diameter_packet{header = H, avps = As} + = Pkt, _, - {_Ref, Caps}) -> + {_Ref, Caps}, + #group{encoding = E, + server_decoding = D} + = Grp) -> #diameter_header{end_to_end_id = EI, hop_by_hop_id = HI} = H, @@ -1343,24 +1660,62 @@ handle_request(#diameter_packet{header = H, msg = M, avps = As}, V = EI bsr B, %% assert V = HI bsr B, %% #diameter_caps{origin_state_id = {_,[Id]}} = Caps, - answer(origin(Id), request(M, [H|As], Caps)). + {D,E} = T = origin(Id), %% assert + wrap(T, H, request(to_map(Pkt, Grp), [H|As], Caps)). + +wrap(Id, H, {Tag, Action, Post}) -> + {Tag, wrap(Id, H, Action), Post}; -answer(T, {Tag, Action, Post}) -> - {Tag, answer(T, Action), Post}; -answer(_, {reply, [#diameter_header{} | _]} = T) -> +wrap(_, _, {reply, [#diameter_header{} | _]} = T) -> T; -answer({A,C}, {reply, Ans}) -> - answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)}); -answer(pkt, {reply, Ans}) - when not is_record(Ans, diameter_packet) -> - {reply, #diameter_packet{msg = Ans}}; -answer(_, T) -> + +wrap({_,E}, H, {reply, Ans}) -> + Msg = base_to_nas(msg(Ans, E, diameter_gen_base_rfc3588), H), + {reply, wrap(Msg)}; + +wrap(_, _, T) -> T. +%% Randomly wrap the answer in a diameter_packet. + +wrap(#diameter_packet{} = Pkt) -> + Pkt; + +wrap(Msg) -> + case rand:uniform(2) of + 1 -> #diameter_packet{msg = Msg}; + 2 -> Msg + end. + +%% base_to_nas/2 + +base_to_nas(#diameter_packet{msg = Msg} = Pkt, H) -> + Pkt#diameter_packet{msg = base_to_nas(Msg, H)}; + +base_to_nas(Rec, #diameter_header{application_id = 1}) + when is_tuple(Rec), not ?is_record(Rec, 'diameter_base_answer-message') -> + D = case element(1, Rec) of + diameter_base_accounting_ACA -> + diameter_gen_base_accounting; + _ -> + diameter_gen_base_rfc3588 + end, + [R | Values] = D:'#get-'(Rec), + "diameter_base_" ++ N = ?L(R), + Name = ?A("nas_" ++ if N == "accounting_ACA" -> + "ACA"; + true -> + N + end), + nas4005:'#new-'([Name | Values]); + +base_to_nas(Msg, _) -> + Msg. + %% request/3 %% send_experimental_result -request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 5}, +request(['ACR' | #{'Accounting-Record-Number' := 5}], [Hdr | Avps], #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}}) -> @@ -1393,14 +1748,14 @@ request(Msg, _Avps, Caps) -> %% request/2 %% send_nok -request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 0}, +request(['ACR' | #{'Accounting-Record-Number' := 0}], _) -> {eval_packet, {protocol_error, ?INVALID_AVP_BITS}, [fun log/2, invalid]}; %% send_bad_answer -request(#diameter_base_accounting_ACR{'Session-Id' = SId, - 'Accounting-Record-Type' = RT, - 'Accounting-Record-Number' = 2 = RN}, +request(['ACR' | #{'Session-Id' := SId, + 'Accounting-Record-Type' := RT, + 'Accounting-Record-Number' := 2 = RN}], #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}}) -> Ans = ['ACA', {'Result-Code', ?SUCCESS}, @@ -1414,9 +1769,9 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId, msg = Ans}}; %% send_eval -request(#diameter_base_accounting_ACR{'Session-Id' = SId, - 'Accounting-Record-Type' = RT, - 'Accounting-Record-Number' = 3 = RN}, +request(['ACR' | #{'Session-Id' := SId, + 'Accounting-Record-Type' := RT, + 'Accounting-Record-Number' := 3 = RN}], #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}}) -> Ans = ['ACA', {'Result-Code', ?SUCCESS}, @@ -1428,9 +1783,9 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId, {eval, {reply, Ans}, {erlang, now, []}}; %% send_ok -request(#diameter_base_accounting_ACR{'Session-Id' = SId, - 'Accounting-Record-Type' = RT, - 'Accounting-Record-Number' = 1 = RN}, +request(['ACR' | #{'Session-Id' := SId, + 'Accounting-Record-Type' := RT, + 'Accounting-Record-Number' := 1 = RN}], #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}}) -> {reply, ['ACA', {'Result-Code', ?SUCCESS}, @@ -1441,48 +1796,69 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId, {'Accounting-Record-Number', RN}]}; %% send_protocol_error -request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 4}, +request(['ACR' | #{'Accounting-Record-Number' := 4}], #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}}) -> + %% Include a DOIC AVP that will be encoded/decoded because of + %% avp_dictionaries config. + OLR = #{'OC-Sequence-Number' => 1, + 'OC-Report-Type' => 0, %% HOST_REPORT + 'OC-Reduction-Percentage' => [25], + 'OC-Validity-Duration' => [60], + 'AVP' => [{'OC-Supported-Features', []}]}, + %% Include a NAS Failed-AVP AVP that will only be decoded under + %% that application. Encode as 'AVP' since RFC 3588 doesn't list + %% Failed-AVP in the answer-message grammar while RFC 6733 does. + NP = #diameter_avp{data = {nas4005, 'NAS-Port', 44}}, + FR = #diameter_avp{name = 'Firmware-Revision', value = 12}, %% M=0 + AP = #diameter_avp{name = 'Auth-Grace-Period', value = 13}, %% M=1 + Failed = #diameter_avp{data = {diameter_gen_base_rfc3588, + 'Failed-AVP', + [{'AVP', [NP,FR,AP]}]}}, Ans = ['answer-message', {'Result-Code', ?TOO_BUSY}, {'Origin-Host', OH}, - {'Origin-Realm', OR}], + {'Origin-Realm', OR}, + {'AVP', [{'OC-OLR', OLR}, Failed]}], {reply, Ans}; -request(#diameter_base_ASR{'Session-Id' = SId, - 'AVP' = Avps}, +%% send_proxy_info +request(['ASR' | #{'Proxy-Info' := _}], + _) -> + {protocol_error, 3999}; + +request(['ASR' | #{'Session-Id' := SId} = Avps], #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}}) -> {reply, ['ASA', {'Result-Code', ?SUCCESS}, {'Session-Id', SId}, {'Origin-Host', OH}, {'Origin-Realm', OR}, - {'AVP', Avps}]}; + {'AVP', maps:get('AVP', Avps, [])}]}; %% send_invalid_reject -request(#diameter_base_STR{'Termination-Cause' = ?USER_MOVED}, +request(['STR' | #{'Termination-Cause' := ?USER_MOVED}], _Caps) -> {protocol_error, ?TOO_BUSY}; %% send_noreply -request(#diameter_base_STR{'Termination-Cause' = T}, +request(['STR' | #{'Termination-Cause' := T}], _Caps) when T /= ?LOGOUT -> discard; %% send_destination_5 -request(#diameter_base_STR{'Destination-Realm' = R}, +request(['STR' | #{'Destination-Realm' := R}], #diameter_caps{origin_realm = {OR, _}}) when R /= undefined, R /= OR -> {protocol_error, ?REALM_NOT_SERVED}; %% send_destination_6 -request(#diameter_base_STR{'Destination-Host' = [H]}, +request(['STR' | #{'Destination-Host' := [H]}], #diameter_caps{origin_host = {OH, _}}) when H /= OH -> {protocol_error, ?UNABLE_TO_DELIVER}; -request(#diameter_base_STR{'Session-Id' = SId}, +request(['STR' | #{'Session-Id' := SId}], #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}}) -> {reply, ['STA', {'Result-Code', ?SUCCESS}, @@ -1491,7 +1867,7 @@ request(#diameter_base_STR{'Session-Id' = SId}, {'Origin-Realm', OR}]}; %% send_error/send_timeout -request(#diameter_base_RAR{}, _Caps) -> +request(['RAR' | #{}], _Caps) -> receive after 2000 -> {protocol_error, ?TOO_BUSY} end. %% message/3 @@ -1505,8 +1881,8 @@ message(Dir, #diameter_packet{bin = Bin}, N) -> message(Dir, Bin, N); %% incoming request -message(recv, <<_:32, 1, _/bits>> = Bin, N) -> - [Bin, 1 < N, fun ?MODULE:message/3, N-1]; +message(recv, <<_:32, 1:1, _/bits>> = Bin, N) -> + [Bin, N < 16, fun ?MODULE:message/3, N+1]; %% incoming answer message(recv, Bin, _) -> @@ -1517,9 +1893,35 @@ message(send, Bin, _) -> [Bin]; %% sent request -message(ack, <<_:32, 1, _/bits>>, _) -> +message(ack, <<_:32, 1:1, _/bits>>, _) -> []; %% sent answer or discarded request message(ack, _, N) -> - [0 =< N, fun ?MODULE:message/3, N+1]. + [N =< 16, fun ?MODULE:message/3, N-1]. + +%% ------------------------------------------------------------------------ + +compile_and_load() -> + try + Path = hd([P || H <- [[here(), ".."], [code:lib_dir(diameter)]], + P <- [filename:join(H ++ ["examples", + "dict", + "rfc4005_nas.dia"])], + {ok, _} <- [file:read_file_info(P)]]), + {ok, [Forms]} + = diameter_make:codec(Path, [return, + forms, + {name, "nas4005"}, + {prefix, "nas"}, + {inherits, "common/diameter_gen_base_rfc3588"}]), + {ok, nas4005, Bin, []} = compile:forms(Forms, [debug_info, return]), + {module, nas4005} = code:load_binary(nas4005, "nas4005", Bin), + true + catch + E:R -> + {E, R, erlang:get_stacktrace()} + end. + +here() -> + filename:dirname(code:which(?MODULE)). diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index 9d981d0a2b..284d2b9566 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -349,35 +349,40 @@ rand_bytes(N) -> %% start_connect/3 start_connect(Prot, PortNr, Ref) -> - {ok, TPid, [?ADDR]} = start_connect(Prot, - {connect, Ref}, - ?SVC([]), - [{raddr, ?ADDR}, - {rport, PortNr}, - {ip, ?ADDR}, - {port, 0}]), - ?RECV(?TMSG({TPid, connected, _})), + {ok, TPid} = start_connect(Prot, + {connect, Ref}, + ?SVC([]), + [{raddr, ?ADDR}, + {rport, PortNr}, + {ip, ?ADDR}, + {port, 0}]), + connected(Prot, TPid), TPid. +connected(sctp, TPid) -> + ?RECV(?TMSG({TPid, connected, _})); +connected(tcp, TPid) -> + ?RECV(?TMSG({TPid, connected, _, [?ADDR]})). + start_connect(sctp, T, Svc, Opts) -> - diameter_sctp:start(T, Svc, [{sctp_initmsg, ?SCTP_INIT} | Opts]); + {ok, TPid, [?ADDR]} + = diameter_sctp:start(T, Svc, [{sctp_initmsg, ?SCTP_INIT} | Opts]), + {ok, TPid}; start_connect(tcp, T, Svc, Opts) -> diameter_tcp:start(T, Svc, Opts). %% start_accept/2 start_accept(Prot, Ref) -> - {Mod, Opts} = tmod(Prot), - {ok, TPid, [?ADDR]} = Mod:start({accept, Ref}, - ?SVC([?ADDR]), - [{port, 0} | Opts]), + {ok, TPid, [?ADDR]} + = start_accept(Prot, {accept, Ref}, ?SVC([?ADDR]), [{port, 0}]), ?RECV(?TMSG({TPid, connected})), TPid. -tmod(sctp) -> - {diameter_sctp, [{sctp_initmsg, ?SCTP_INIT}]}; -tmod(tcp) -> - {diameter_tcp, []}. +start_accept(sctp, T, Svc, Opts) -> + diameter_sctp:start(T, Svc, [{sctp_initmsg, ?SCTP_INIT} | Opts]); +start_accept(tcp, T, Svc, Opts) -> + diameter_tcp:start(T, Svc, Opts). %% =========================================================================== diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 03f79096ac..d249b0e4fa 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -32,7 +32,8 @@ foldl/3, scramble/1, unique_string/0, - have_sctp/0]). + have_sctp/0, + eprof/1]). %% diameter-specific -export([lport/2, @@ -48,6 +49,16 @@ -define(L, atom_to_list). +%% --------------------------------------------------------------------------- + +eprof(start) -> + eprof:start(), + eprof:start_profiling([self()]); + +eprof(stop) -> + eprof:stop_profiling(), + eprof:analyze(), + eprof:stop(). %% --------------------------------------------------------------------------- %% name/2 diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index 6e17ec0af0..0e084e619e 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -198,7 +198,7 @@ source({M, Name, Path}, Dir, Suffix, Env, Set, Private, Hidden, {Set, Error} end; R -> - report("skipping source file '~ts': ~P.", [File, R, 15]), + report("skipping source file '~ts': ~tP.", [File, R, 15]), {Set, true} end. diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index ebdb0f79f6..d00a283794 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -541,13 +541,13 @@ uri_get_http_1(Result, URI) -> Reason = inet:format_error(R), {error, http_errmsg(Reason, URI)}; {ok, R} -> - Reason = io_lib:format("bad return value ~P", [R, 5]), + Reason = io_lib:format("bad return value ~tP", [R, 5]), {error, http_errmsg(Reason, URI)}; {'EXIT', R} -> - Reason = io_lib:format("crashed with reason ~w", [R]), + Reason = io_lib:format("crashed with reason ~tw", [R]), {error, http_errmsg(Reason, URI)}; R -> - Reason = io_lib:format("uncaught throw: ~w", [R]), + Reason = io_lib:format("uncaught throw: ~tw", [R]), {error, http_errmsg(Reason, URI)} end. @@ -603,7 +603,7 @@ filename([]) -> filename(N) when is_atom(N) -> atom_to_list(N); filename(N) -> - report("bad filename: `~P'.", [N, 25]), + report("bad filename: `~tP'.", [N, 25]), exit(error). %% @private @@ -1000,7 +1000,7 @@ run_plugin(Name, Key, Default, Fun, Opts) when is_atom(Name) -> {ok, Value} -> Value; R -> - report("error in ~ts '~w': ~P.", [Name, Module, R, 20]), + report("error in ~ts '~w': ~tP.", [Name, Module, R, 20]), exit(error) end. @@ -1009,7 +1009,7 @@ get_plugin(Key, Default, Opts) -> M when is_atom(M) -> M; Other -> - report("bad value for option '~w': ~P.", [Key, Other, 10]), + report("bad value for option '~w': ~tP.", [Key, Other, 10]), exit(error) end. diff --git a/lib/edoc/src/edoc_run.erl b/lib/edoc/src/edoc_run.erl index c88c6cfd78..50aba0a930 100644 --- a/lib/edoc/src/edoc_run.erl +++ b/lib/edoc/src/edoc_run.erl @@ -150,7 +150,7 @@ file(Args) -> -spec invalid_args(string(), args()) -> no_return(). invalid_args(Where, Args) -> - report("invalid arguments to ~ts: ~w.", [Where, Args]), + report("invalid arguments to ~ts: ~tw.", [Where, Args]), shutdown_error(). run(F) -> @@ -159,10 +159,10 @@ run(F) -> {ok, _} -> shutdown_ok(); {'EXIT', E} -> - report("edoc terminated abnormally: ~P.", [E, 10]), + report("edoc terminated abnormally: ~tP.", [E, 10]), shutdown_error(); Thrown -> - report("internal error: throw without catch in edoc: ~P.", + report("internal error: throw without catch in edoc: ~tP.", [Thrown, 15]), shutdown_error() end. diff --git a/lib/edoc/src/edoc_types.erl b/lib/edoc/src/edoc_types.erl index ccc3169767..510f9513b2 100644 --- a/lib/edoc/src/edoc_types.erl +++ b/lib/edoc/src/edoc_types.erl @@ -107,7 +107,7 @@ to_xml(#t_paren{type = T}, Env) -> to_xml(#t_nonempty_list{type = T}, Env) -> {nonempty_list, [wrap_utype(T, Env)]}; to_xml(#t_atom{val = V}, _Env) -> - {atom, [{value, io_lib:write(V)}], []}; + {atom, [{value, atom_to_list(V)}], []}; to_xml(#t_integer{val = V}, _Env) -> {integer, [{value, integer_to_list(V)}], []}; to_xml(#t_integer_range{from = From, to = To}, _Env) -> diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index d863c056e9..a5e277aece 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -1803,7 +1803,7 @@ <!-- Modulesummary --> <xsl:template match="modulesummary"> <xsl:param name="partnum"/> - <h3><a name="module-sumary" href="#module-sumary">Module Summary</a></h3> + <h3><a name="module-summary" href="#module-summary">Module Summary</a></h3> <div class="REFBODY module-summary-body"> <xsl:apply-templates> <xsl:with-param name="partnum" select="$partnum"/> @@ -1826,7 +1826,7 @@ <!-- Libsummary --> <xsl:template match="libsummary"> <xsl:param name="partnum"/> - <h3><a name="library-sumary" href="#library-sumary">Library Summary</a></h3> + <h3><a name="library-summary" href="#library-summary">Library Summary</a></h3> <div class="REFBODY library-summary-body"> <xsl:apply-templates> <xsl:with-param name="partnum" select="$partnum"/> diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 6c41147e27..126229ecc9 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -406,7 +406,7 @@ t_var(E) -> [get_attrval(name, E)]. t_atom(E) -> - [get_attrval(value, E)]. + [io_lib:write(list_to_atom(get_attrval(value, E)))]. t_integer(E) -> [get_attrval(value, E)]. @@ -578,7 +578,7 @@ ot_var(E) -> {var,0,list_to_atom(get_attrval(name, E))}. ot_atom(E) -> - {ok, [{atom,A,Name}], _} = erl_scan:string(get_attrval(value, E), 0), + {ok, [{atom,A,Name}], _} = erl_scan:string(lists:flatten(t_atom(E)), 0), {atom,erl_anno:line(A),Name}. ot_integer(E) -> diff --git a/lib/et/src/et_collector.erl b/lib/et/src/et_collector.erl index aba90b0be1..b0f016a8ea 100644 --- a/lib/et/src/et_collector.erl +++ b/lib/et/src/et_collector.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -750,7 +750,7 @@ next_iterate(TH, Prev = first, Limit, Fun, Acc) -> '$end_of_table' -> Acc; {'EXIT', _} = Error -> - io:format("~p(~p): First ~p~n", [?MODULE, ?LINE, Error]), + io:format("~p(~p): First ~tp~n", [?MODULE, ?LINE, Error]), iterate(TH#table_handle.collector_pid, Prev, Limit, Fun, Acc); First -> lookup_and_apply(TH, Prev, First, Limit, -1, Fun, Acc) @@ -761,7 +761,7 @@ next_iterate(TH, Prev = last, Limit, Fun, Acc) -> '$end_of_table' -> Acc; {'EXIT', _} = Error -> - io:format("~p(~p): Last ~p~n", [?MODULE, ?LINE, Error]), + io:format("~p(~p): Last ~tp~n", [?MODULE, ?LINE, Error]), iterate(TH#table_handle.collector_pid, Prev, Limit, Fun, Acc); Last -> lookup_and_apply(TH, Prev, Last, Limit, -1, Fun, Acc) @@ -773,7 +773,7 @@ next_iterate(TH, Prev, Limit, Fun, Acc) -> '$end_of_table' -> Acc; {'EXIT', _} = Error -> - io:format("~p(~p): Next ~p -> ~p~n", [?MODULE, ?LINE, Key, Error]), + io:format("~p(~p): Next ~tp -> ~tp~n", [?MODULE, ?LINE, Key, Error]), iterate(TH#table_handle.collector_pid, Prev, Limit, Fun, Acc); Next -> lookup_and_apply(TH, Prev, Next, Limit, -1, Fun, Acc) @@ -785,7 +785,7 @@ prev_iterate(TH, Prev = first, Limit, Fun, Acc) -> '$end_of_table' -> Acc; {'EXIT', _} = Error -> - io:format("~p(~p): First ~p~n", [?MODULE, ?LINE, Error]), + io:format("~p(~p): First ~tp~n", [?MODULE, ?LINE, Error]), iterate(TH#table_handle.collector_pid, Prev, Limit, Fun, Acc); First -> lookup_and_apply(TH, Prev, First, Limit, 1, Fun, Acc) @@ -796,7 +796,7 @@ prev_iterate(TH, Prev = last, Limit, Fun, Acc) -> '$end_of_table' -> Acc; {'EXIT', _} = Error -> - io:format("~p(~p): Last ~p~n", [?MODULE, ?LINE, Error]), + io:format("~p(~p): Last ~tp~n", [?MODULE, ?LINE, Error]), iterate(TH#table_handle.collector_pid, Prev, Limit, Fun, Acc); Last -> lookup_and_apply(TH, Prev, Last, Limit, 1, Fun, Acc) @@ -808,7 +808,7 @@ prev_iterate(TH, Prev, Limit, Fun, Acc) -> '$end_of_table' -> Acc; {'EXIT', _} = Error -> - io:format("~p(~p): Prev ~p -> ~p~n", [?MODULE, ?LINE, Key, Error]), + io:format("~p(~p): Prev ~tp -> ~tp~n", [?MODULE, ?LINE, Key, Error]), iterate(TH#table_handle.collector_pid, Prev, Limit, Fun, Acc); Next -> lookup_and_apply(TH, Prev, Next, Limit, 1, Fun, Acc) @@ -1049,7 +1049,7 @@ handle_call(stop, _From, S) -> end, {stop, shutdown, ok, S}; handle_call(Request, From, S) -> - ok = error_logger:format("~p(~p): handle_call(~p, ~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_call(~tp, ~tp, ~tp)~n", [?MODULE, self(), Request, From, S]), reply({error, {bad_request, Request}}, S). @@ -1061,7 +1061,7 @@ handle_call(Request, From, S) -> %%---------------------------------------------------------------------- handle_cast(Msg, S) -> - ok = error_logger:format("~p(~p): handle_cast(~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_cast(~tp, ~tp)~n", [?MODULE, self(), Msg, S]), noreply(S). @@ -1083,18 +1083,18 @@ handle_info({nodeup, Node}, S) -> S2 = listen_on_trace_port(Node, Port, S), noreply(S2); {error, Reason} when Reason =:= already_started-> - ok = error_logger:format("~p(~p): producer ignored(~p:~p):~n ~p~n", + ok = error_logger:format("~p(~p): producer ignored(~p:~p):~n ~tp~n", [?MODULE, self(), Node, Port, Reason]), S2 = S#state{trace_port = Port + 1}, noreply(S2); {badrpc, Reason} -> - ok = error_logger:format("~p(~p): producer ignored(~p:~p):~n ~p~n", + ok = error_logger:format("~p(~p): producer ignored(~p:~p):~n ~tp~n", [?MODULE, self(), Node, Port, Reason]), S2 = S#state{trace_port = Port + 1}, noreply(S2); {error, Reason} -> self() ! {nodeup, Node}, - ok = error_logger:format("~p(~p): producer retry(~p:~p):~n ~p~n", + ok = error_logger:format("~p(~p): producer retry(~p:~p):~n ~tp~n", [?MODULE, self(), Node, Port, Reason]), S2 = S#state{trace_port = Port + 1}, noreply(S2) @@ -1125,12 +1125,12 @@ handle_info(Info = {'EXIT', Pid, Reason}, S) -> opt_unlink(S#state.parent_pid), {stop, Reason, S}; false -> - ok = error_logger:format("~p(~p): handle_info(~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_info(~tp, ~tp)~n", [?MODULE, self(), Info, S]), noreply(S) end; handle_info(Info, S) -> - ok = error_logger:format("~p(~p): handle_info(~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_info(~tp, ~tp)~n", [?MODULE, self(), Info, S]), noreply(S). @@ -1143,12 +1143,12 @@ listen_on_trace_port(Node, Port, S) -> S#state{trace_nodes = [Node | S#state.trace_nodes], trace_port = Port + 1}; {'EXIT', Reason} when Reason =:= already_started-> - ok = error_logger:format("~p(~p): consumer ignored(~p:~p): ~p~n", + ok = error_logger:format("~p(~p): consumer ignored(~p:~p): ~tp~n", [?MODULE, self(), Node, Port, Reason]), S#state{trace_port = Port + 1}; {'EXIT', Reason} -> self() ! {nodeup, Node}, - ok = error_logger:format("~p(~p): consumer retry(~p:~p):~n ~p~n", + ok = error_logger:format("~p(~p): consumer retry(~p:~p):~n ~tp~n", [?MODULE, self(), Node, Port, Reason]), S#state{trace_port = Port + 1} end. @@ -1247,7 +1247,7 @@ file_open(F) -> {ok, _} -> {ok, Fd}; {repaired, _, _, BadBytes} -> - ok = error_logger:format("~p: Skipped ~p bad bytes in file: ~p~n", + ok = error_logger:format("~p: Skipped ~p bad bytes in file: ~tp~n", [?MODULE, BadBytes, F#file.name]), {ok, Fd}; {error,Reason} -> diff --git a/lib/et/src/et_selector.erl b/lib/et/src/et_selector.erl index a0297c21d1..35db07cd99 100644 --- a/lib/et/src/et_selector.erl +++ b/lib/et/src/et_selector.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. +%% Copyright Ericsson AB 2001-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -208,7 +208,7 @@ parse_event(Mod, Trace) -> {to, undefined}, {drop, NumberOfDroppedItems}]}}; _ -> - error_logger:format("~p(~p): Ignoring unknown trace type -> ~p~n~n", + error_logger:format("~p(~p): Ignoring unknown trace type -> ~tp~n~n", [?MODULE, ?LINE, Trace]), false end. @@ -258,7 +258,7 @@ parse_seq_event(Trace, ParsedTS, ReportedTS, Label, Info) -> {serial, Serial}, {user_info, UserInfo}]}}; _ -> - error_logger:format("~p(~p): Ignoring unknown trace type -> ~p~n~n", + error_logger:format("~p(~p): Ignoring unknown trace type -> ~tp~n~n", [?MODULE, ?LINE, Trace]), false end. @@ -590,7 +590,7 @@ parse_event(Mod, Trace, ParsedTS, ReportedTS, From, Label, Contents) -> {to, From}, {gc_items, GcKeyValueList}]}}; _ -> - error_logger:format("~p(~p): Ignoring unknown trace type -> ~p~n~n", + error_logger:format("~p(~p): Ignoring unknown trace type -> ~tp~n~n", [?MODULE, ?LINE, Trace]), false end. diff --git a/lib/et/src/et_wx_contents_viewer.erl b/lib/et/src/et_wx_contents_viewer.erl index 247dd4c7ba..bca517317e 100644 --- a/lib/et/src/et_wx_contents_viewer.erl +++ b/lib/et/src/et_wx_contents_viewer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -213,7 +213,7 @@ init([S]) when is_record(S, state) -> %%---------------------------------------------------------------------- handle_call(Request, From, S) -> - ok = error_logger:format("~p(~p): handle_call(~p, ~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_call(~tp, ~tp, ~tp)~n", [?MODULE, self(), Request, From, S]), Reply = {error, {bad_request, Request}}, {reply, Reply, S}. @@ -226,7 +226,7 @@ handle_call(Request, From, S) -> %%---------------------------------------------------------------------- handle_cast(Msg, S) -> - ok = error_logger:format("~p(~p): handle_cast(~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_cast(~tp, ~tp)~n", [?MODULE, self(), Msg, S]), {noreply, S}. @@ -272,10 +272,11 @@ handle_event(#wx{id = Id, end, FileName = lists:flatten(["et_contents_viewer_", now_to_string(TimeStamp), ".txt"]), Style = ?wxFD_SAVE bor ?wxFD_OVERWRITE_PROMPT, - Msg = "Select a file to the events to", + Msg = "Select a file to save events to", case select_file(S#state.frame, Msg, filename:absname(FileName), Style) of {ok, FileName2} -> - Bin = list_to_binary(event_to_string(Event, S#state.event_order)), + EventString = event_to_string(Event, S#state.event_order), + Bin = unicode:characters_to_binary(EventString), ok = file:write_file(FileName2, Bin); cancel -> ok @@ -381,7 +382,7 @@ handle_event(#wx{event = #wxSize{size = {W, H}}}, S) -> S2 = S#state{width = W, height = H}, {noreply, S2}; handle_event(Wx = #wx{}, S) -> - io:format("~p got an unexpected event: ~p\n", [self(), Wx]), + io:format("~p got an unexpected event: ~tp\n", [self(), Wx]), {noreply, S}. %%---------------------------------------------------------------------- @@ -405,7 +406,7 @@ handle_info({'EXIT', Pid, Reason}, S) -> {noreply, S} end; handle_info(Info, S) -> - ok = error_logger:format("~p(~p): handle_info(~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_info(~tp, ~tp)~n", [?MODULE, self(), Info, S]), {noreply, S}. @@ -606,8 +607,8 @@ do_config_editor(Editor, Event, _Colour, TsKey) -> %%%---------------------------------------------------------------------- term_to_string(Term) -> - case catch io_lib:format("~s", [Term]) of - {'EXIT', _} -> io_lib:format("~p", [Term]); + case catch io_lib:format("~ts", [Term]) of + {'EXIT', _} -> io_lib:format("~tp", [Term]); GoodString -> GoodString end. @@ -659,7 +660,7 @@ pad_string(Int, MinLen, Char, Dir) when is_integer(Int) -> pad_string(Atom, MinLen, Char, Dir) when is_atom(Atom) -> pad_string(atom_to_list(Atom), MinLen, Char, Dir); pad_string(String, MinLen, Char, Dir) when is_integer(MinLen), MinLen >= 0 -> - Len = length(String), + Len = string:length(String), case {Len >= MinLen, Dir} of {true, _} -> String; diff --git a/lib/et/src/et_wx_viewer.erl b/lib/et/src/et_wx_viewer.erl index 9613299e6b..4dd44e7a4c 100644 --- a/lib/et/src/et_wx_viewer.erl +++ b/lib/et/src/et_wx_viewer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -352,7 +352,7 @@ handle_call({open_event, N}, _From, S) when is_integer(N), N > 0-> Reply = do_open_event(S, N), reply(Reply, S); handle_call(Request, From, S) -> - ok = error_logger:format("~p(~p): handle_call(~p, ~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_call(~tp, ~tp, ~tp)~n", [?MODULE, self(), Request, From, S]), Reply = {error, {bad_request, Request}}, reply(Reply, S). @@ -365,7 +365,7 @@ handle_call(Request, From, S) -> %%---------------------------------------------------------------------- handle_cast(Msg, S) -> - ok = error_logger:format("~p(~p): handle_cast(~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_cast(~tp, ~tp)~n", [?MODULE, self(), Msg, S]), noreply(S). @@ -803,7 +803,7 @@ handle_info(timeout, S) -> handle_info({'EXIT', Pid, Reason}, S) -> if Pid =:= S#state.collector_pid -> - io:format("collector died: ~p\n\n", [Reason]), + io:format("collector died: ~tp\n\n", [Reason]), wxFrame:destroy(S#state.frame), {stop, Reason, S}; Pid =:= S#state.parent_pid -> @@ -853,10 +853,10 @@ handle_info(#wx{event = #wxPaint{}}, S) -> S2 = refresh_main_window(S), noreply(S2); handle_info(#wx{event = #wxMouse{type = T, x=X,y=Y}}, S) -> - io:format("~p ~p\n", [T, {X,Y}]), + io:format("~tp ~tp\n", [T, {X,Y}]), noreply(S); handle_info(Info, S) -> - ok = error_logger:format("~p(~p): handle_info(~p, ~p)~n", + ok = error_logger:format("~p(~p): handle_info(~tp, ~tp)~n", [?MODULE, self(), Info, S]), noreply(S). @@ -1162,7 +1162,7 @@ open_viewer(Scale, FilterName, Actors, S) -> %% unlink(ViewerPid), ok; {error, Reason} -> - ok = error_logger:format("~p: Failed to start a new window: ~p~n", + ok = error_logger:format("~p: Failed to start a new window: ~tp~n", [?MODULE, Reason]) end. @@ -1393,7 +1393,7 @@ create_filter_menu(S=#state{filter_menu = {Menu,Data}}, ActiveFilterName, Filter wxMenu:delete(Menu,I) catch _:Reason -> - io:format("Could not delete item: ~p, because ~p.\n", [I, Reason]) + io:format("Could not delete item: ~tp, because ~tp.\n", [I, Reason]) end end, Data), @@ -1872,7 +1872,7 @@ create_contents_window(Event, {S, Res}) -> {ok, Pid} -> {S, [{ok, Pid} | Res]}; {error, Reason} -> - ok = error_logger:format("~p(~p): create_contents_window(~p) ->~n ~p~n", + ok = error_logger:format("~p(~p): create_contents_window(~tp) ->~n ~tp~n", [?MODULE, self(), Options, Reason]), {S, [{error, Reason} | Res]}; Stuff -> @@ -2069,15 +2069,15 @@ create_actor(Name) -> #actor{name = Name, string = String, include = false, exclude = false}. name_to_string(Name) -> - case catch io_lib:format("~s", [Name]) of - {'EXIT', _} -> lists:flatten(io_lib:format("~w", [Name])); + case catch io_lib:format("~ts", [Name]) of + {'EXIT', _} -> lists:flatten(io_lib:format("~tw", [Name])); GoodString -> lists:flatten(GoodString) end. pad_string(Atom, MinLen) when is_atom(Atom) -> pad_string(atom_to_list(Atom), MinLen); pad_string(String, MinLen) when is_integer(MinLen), MinLen >= 0 -> - Len = length(String), + Len = string:length(String), case Len >= MinLen of true -> String; diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index aa2cffc66d..e340f50a3c 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -107,7 +107,7 @@ format_stacktrace(Trace) -> format_stacktrace(Trace, "in function", "in call from"). format_stacktrace([{M,F,A,L}|Fs], Pre, Pre1) when is_integer(A) -> - [io_lib:fwrite("~ts ~w:~w/~w~ts\n", + [io_lib:fwrite("~ts ~w:~tw/~w~ts\n", [Pre, M, F, A, format_stacktrace_location(L)]) | format_stacktrace(Fs, Pre1, Pre1)]; format_stacktrace([{M,F,As,L}|Fs], Pre, Pre1) when is_list(As) -> @@ -121,9 +121,9 @@ format_stacktrace([{M,F,As,L}|Fs], Pre, Pre1) when is_list(As) -> io_lib:fwrite("~ts ~ts ~ts", [format_arg(A1),F,format_arg(A2)]); false -> - io_lib:fwrite("~w(~ts)", [F,format_arglist(As)]) + io_lib:fwrite("~tw(~ts)", [F,format_arglist(As)]) end, - [io_lib:fwrite("~ts ~w:~w/~w~ts\n called as ~ts\n", + [io_lib:fwrite("~ts ~w:~tw/~w~ts\n called as ~ts\n", [Pre,M,F,A,format_stacktrace_location(L),C]) | format_stacktrace(Fs,Pre1,Pre1)]; format_stacktrace([{M,F,As}|Fs], Pre, Pre1) -> @@ -162,15 +162,15 @@ is_op(_M, _F, _A) -> format_error({bad_test, Term}) -> error_msg("bad test descriptor", "~tP", [Term, 15]); format_error({bad_generator, {{M,F,A}, Term}}) -> - error_msg(io_lib:format("result from generator ~w:~w/~w is not a test", + error_msg(io_lib:format("result from generator ~w:~tw/~w is not a test", [M,F,A]), "~tP", [Term, 15]); format_error({generator_failed, {{M,F,A}, Exception}}) -> - error_msg(io_lib:format("test generator ~w:~w/~w failed",[M,F,A]), + error_msg(io_lib:format("test generator ~w:~tw/~w failed",[M,F,A]), "~ts", [format_exception(Exception)]); format_error({no_such_function, {M,F,A}}) when is_atom(M), is_atom(F), is_integer(A) -> - error_msg(io_lib:format("no such function: ~w:~w/~w", [M,F,A]), + error_msg(io_lib:format("no such function: ~w:~tw/~w", [M,F,A]), "", []); format_error({module_not_found, M}) -> error_msg("test module not found", "~tp", [M]); @@ -185,7 +185,7 @@ format_error({cleanup_failed, Exception}) -> error_msg("context cleanup failed", "~ts", [format_exception(Exception)]); format_error({{bad_instantiator, {{M,F,A}, Term}}, _DummyException}) -> - error_msg(io_lib:format("result from instantiator ~w:~w/~w is not a test", + error_msg(io_lib:format("result from instantiator ~w:~tw/~w is not a test", [M,F,A]), "~tP", [Term, 15]); format_error({instantiation_failed, Exception}) -> @@ -384,11 +384,9 @@ fun_parent(F) -> {arity, A} = erlang:fun_info(F, arity), {M, N, A}; {type, local} -> - [$-|S] = atom_to_list(N), - C1 = string:chr(S, $/), - C2 = string:chr(S, $-), - {M, list_to_atom(string:sub_string(S, 1, C1 - 1)), - list_to_integer(string:sub_string(S, C1 + 1, C2 - 1))} + [$-|S] = atom_to_list(N), + [S2, T] = string:split(S, "/", trailing), + {M, list_to_atom(S2), element(1, string:to_integer(T))} end. -ifdef(TEST). diff --git a/lib/eunit/src/eunit_tty.erl b/lib/eunit/src/eunit_tty.erl index 77a7cf1fd5..2c9a598628 100644 --- a/lib/eunit/src/eunit_tty.erl +++ b/lib/eunit/src/eunit_tty.erl @@ -235,7 +235,7 @@ print_test_error({skipped, Reason}, _) -> format_skipped({module_not_found, M}) -> io_lib:fwrite("missing module: ~w", [M]); format_skipped({no_such_function, {M,F,A}}) -> - io_lib:fwrite("no such function: ~w:~w/~w", [M,F,A]). + io_lib:fwrite("no such function: ~w:~tw/~w", [M,F,A]). print_test_cancel(Reason) -> fwrite(format_cancel(Reason)). diff --git a/lib/hipe/cerl/cerl_cconv.erl b/lib/hipe/cerl/cerl_cconv.erl index 122e6ef039..2cd0e261d5 100644 --- a/lib/hipe/cerl/cerl_cconv.erl +++ b/lib/hipe/cerl/cerl_cconv.erl @@ -258,7 +258,7 @@ bind_module_defs([], Env, S) -> check_function_name(Name, S) -> case s__is_function_name(Name, S) of true -> - error_msg("multiple definitions of function `~w'.", [Name]), + error_msg("multiple definitions of function `~tw'.", [Name]), exit(error); false -> ok diff --git a/lib/inets/src/http_server/mod_disk_log.erl b/lib/inets/src/http_server/mod_disk_log.erl index 3be5f2dd74..2023546f01 100644 --- a/lib/inets/src/http_server/mod_disk_log.erl +++ b/lib/inets/src/http_server/mod_disk_log.erl @@ -363,17 +363,21 @@ create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList) -> %%---------------------------------------------------------------------- open(Filename, MaxBytes, MaxFiles, internal) -> - Opts = [{format, internal}, {repair, truncate}], - open1(Filename, MaxBytes, MaxFiles, Opts); + Opt0 = {format, internal}, + Opts1 = [Opt0, {repair, true}], + Opts2 = [Opt0, {repair, truncate}], + open1(Filename, MaxBytes, MaxFiles, Opts1, Opts2); open(Filename, MaxBytes, MaxFiles, _) -> Opts = [{format, external}], - open1(Filename, MaxBytes, MaxFiles, Opts). + open1(Filename, MaxBytes, MaxFiles, Opts, Opts). -open1(Filename, MaxBytes, MaxFiles, Opts0) -> - Opts1 = [{name, Filename}, {file, Filename}, {type, wrap}] ++ Opts0, - case open2(Opts1, {MaxBytes, MaxFiles}) of +open1(Filename, MaxBytes, MaxFiles, Opts1, Opts2) -> + Opts0 = [{name, Filename}, {file, Filename}, {type, wrap}], + case open2(Opts0 ++ Opts1, Opts0 ++ Opts2, {MaxBytes, MaxFiles}) of {ok, LogDB} -> {ok, LogDB}; + {repaired, LogDB, {recovered, _}, {badbytes, _}} -> + {ok, LogDB}; {error, Reason} -> {error, ?NICE("Can't create " ++ Filename ++ @@ -382,11 +386,16 @@ open1(Filename, MaxBytes, MaxFiles, Opts0) -> {error, ?NICE("Can't create "++Filename)} end. -open2(Opts, Size) -> - case disk_log:open(Opts) of +open2(Opts1, Opts2, Size) -> + case disk_log:open(Opts1) of {error, {badarg, size}} -> %% File did not exist, add the size option and try again - disk_log:open([{size, Size} | Opts]); + disk_log:open([{size, Size} | Opts1]); + {error, {Reason, _}} when + Reason == not_a_log_file; + Reason == invalid_index_file -> + %% File was corrupt, add the truncate option and try again + disk_log:open([{size, Size} | Opts2]); Else -> Else end. diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 055b847319..b4f0f2aa7d 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -73,6 +73,7 @@ all() -> {group, http_reload}, {group, https_reload}, {group, http_mime_types}, + {group, http_logging}, mime_types_format ]. @@ -96,6 +97,7 @@ groups() -> {https_htaccess, [], [{group, htaccess}]}, {http_security, [], [{group, security}]}, {https_security, [], [{group, security}]}, + {http_logging, [], [{group, logging}]}, {http_reload, [], [{group, reload}]}, {https_reload, [], [{group, reload}]}, {http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]}, @@ -119,6 +121,8 @@ groups() -> ]}, {htaccess, [], [htaccess_1_1, htaccess_1_0, htaccess_0_9]}, {security, [], [security_1_1, security_1_0]}, %% Skip 0.9 as causes timing issus in test code + {logging, [], [disk_log_internal, disk_log_exists, + disk_log_bad_size, disk_log_bad_file]}, {http_1_1, [], [host, chunked, expect, cgi, cgi_chunked_encoding_test, trace, range, if_modified_since, mod_esi_chunk_timeout, @@ -254,6 +258,11 @@ init_per_group(auth_api_dets, Config) -> init_per_group(auth_api_mnesia, Config) -> start_mnesia(proplists:get_value(node, Config)), [{auth_prefix, "mnesia_"} | Config]; +init_per_group(http_logging, Config) -> + Config1 = [{http_version, "HTTP/1.1"} | Config], + ServerRoot = proplists:get_value(server_root, Config1), + Path = ServerRoot ++ "/httpd_log_transfer", + [{transfer_log, Path} | Config1]; init_per_group(_, Config) -> Config. @@ -310,10 +319,60 @@ init_per_testcase(range, Config) -> create_range_data(DocRoot), dbg(range, Config, init); +init_per_testcase(disk_log_internal, Config0) -> + ok = start_apps(http_logging), + Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]), + ct:timetrap({seconds, 20}), + dbg(disk_log_internal, Config1, init); + +init_per_testcase(disk_log_exists, Config0) -> + ServerRoot = proplists:get_value(server_root, Config0), + Filename = ServerRoot ++ "/httpd_log_transfer", + {ok, Log} = disk_log:open([{name, Filename}, {file, Filename}, + {repair, truncate}, {format, internal}, + {type, wrap}, {size, {1048576, 5}}]), + ok = disk_log:log(Log, {bogus, node(), self()}), + ok = disk_log:close(Log), + ok = start_apps(http_logging), + Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]), + ct:timetrap({seconds, 20}), + dbg(disk_log_internal, Config1, init); + +init_per_testcase(disk_log_bad_size, Config0) -> + ServerRoot = proplists:get_value(server_root, Config0), + Filename = ServerRoot ++ "/httpd_log_transfer", + {ok, Log} = disk_log:open([{name, Filename}, {file, Filename}, + {repair, truncate}, {format, internal}, + {type, wrap}, {size, {1048576, 5}}]), + ok = disk_log:log(Log, {bogus, node(), self()}), + ok = disk_log:close(Log), + ok = file:delete(Filename ++ ".siz"), + ok = start_apps(http_logging), + Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]), + ct:timetrap({seconds, 20}), + dbg(disk_log_internal, Config1, init); + +init_per_testcase(disk_log_bad_file, Config0) -> + ServerRoot = proplists:get_value(server_root, Config0), + Filename = ServerRoot ++ "/httpd_log_transfer", + ok = file:write_file(Filename ++ ".1", <<>>), + ok = start_apps(http_logging), + Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]), + ct:timetrap({seconds, 20}), + dbg(disk_log_internal, Config1, init); + init_per_testcase(Case, Config) -> ct:timetrap({seconds, 20}), dbg(Case, Config, init). +end_per_testcase(Case, Config) when + Case == disk_log_internal; + Case == disk_log_exists; + Case == disk_log_bad_size; + Case == disk_log_bad_file -> + inets:stop(), + dbg(Case, Config, 'end'); + end_per_testcase(Case, Config) -> dbg(Case, Config, 'end'). @@ -1257,6 +1316,63 @@ security(Config) -> true = unblock_user(Node, "two", Port, OpenDir). %%------------------------------------------------------------------------- + +disk_log_internal() -> + ["Test mod_disk_log"]. + +disk_log_internal(Config) -> + Version = proplists:get_value(http_version, Config), + Request = "GET /" ++ integer_to_list(rand:uniform(1000000)) ++ " ", + ok = http_status(Request, Config, [{statuscode, 404}]), + Log = proplists:get_value(transfer_log, Config), + Match = list_to_binary(Request ++ Version), + disk_log_internal1(Log, Match, disk_log:chunk(Log, start)). +disk_log_internal1(_, _, eof) -> + ct:fail(eof); +disk_log_internal1(Log, Match, {Cont, [H | T]}) -> + case binary:match(H, Match) of + nomatch -> + disk_log_internal1(Log, Match, {Cont, T}); + _ -> + ok + end; +disk_log_internal1(Log, Match, {Cont, []}) -> + disk_log_internal1(Log, Match, disk_log:chunk(Log, Cont)). + +disk_log_exists() -> + ["Test mod_disk_log with existing logs"]. + +disk_log_exists(Config) -> + Log = proplists:get_value(transfer_log, Config), + Self = self(), + Node = node(), + Log = proplists:get_value(transfer_log, Config), + {_, [{bogus, Node, Self} | _]} = disk_log:chunk(Log, start). + +disk_log_bad_size() -> + ["Test mod_disk_log with existing log, missing .siz"]. + +disk_log_bad_size(Config) -> + Log = proplists:get_value(transfer_log, Config), + Self = self(), + Node = node(), + Log = proplists:get_value(transfer_log, Config), + {_, [{bogus, Node, Self} | _]} = disk_log:chunk(Log, start). + +disk_log_bad_file() -> + ["Test mod_disk_log with bad file"]. + +disk_log_bad_file(Config) -> + Log = proplists:get_value(transfer_log, Config), + Version = proplists:get_value(http_version, Config), + Request = "GET /" ++ integer_to_list(rand:uniform(1000000)) ++ " ", + ok = http_status(Request, Config, [{statuscode, 404}]), + Log = proplists:get_value(transfer_log, Config), + Match = list_to_binary(Request ++ Version), + {_, [H | _]} = disk_log:chunk(Log, start), + {_, _} = binary:match(H, Match). + +%%------------------------------------------------------------------------- non_disturbing_reconfiger_dies(Config) when is_list(Config) -> do_reconfiger_dies([{http_version, "HTTP/1.1"} | Config], non_disturbing). disturbing_reconfiger_dies(Config) when is_list(Config) -> @@ -1567,6 +1683,7 @@ start_apps(Group) when Group == http_basic; Group == http_auth_api_mnesia; Group == http_htaccess; Group == http_security; + Group == http_logging; Group == http_reload; Group == http_mime_types-> inets_test_lib:start_apps([inets]). @@ -1662,6 +1779,8 @@ server_config(http_security, Config) -> server_config(https_security, Config) -> ServerRoot = proplists:get_value(server_root, Config), tl(auth_conf(ServerRoot)) ++ security_conf(ServerRoot) ++ server_config(https, Config); +server_config(http_logging, Config) -> + log_conf() ++ server_config(http, Config); server_config(http_mime_types, Config0) -> Config1 = basic_conf() ++ server_config(http, Config0), ServerRoot = proplists:get_value(server_root, Config0), @@ -1863,6 +1982,16 @@ mod_security_conf(SecFile, Dir) -> {path, Dir} %% This is should not be needed, but is atm, awful design! ]. +log_conf() -> + [{modules, [mod_alias, mod_dir, mod_get, mod_head, mod_disk_log]}, + {transfer_disk_log, "httpd_log_transfer"}, + {security_disk_log, "httpd_log_security"}, + {error_disk_log, "httpd_log_error"}, + {transfer_disk_log_size, {1048576, 5}}, + {error_disk_log_size, {1048576, 5}}, + {error_disk_log_size, {1048576, 5}}, + {security_disk_log_size, {1048576, 5}}, + {disk_log_format, internal}]. http_status(Request, Config, Expected) -> Version = proplists:get_value(http_version, Config), diff --git a/lib/kernel/doc/src/inet_res.xml b/lib/kernel/doc/src/inet_res.xml index 4ada4203c0..3454e3c6f9 100644 --- a/lib/kernel/doc/src/inet_res.xml +++ b/lib/kernel/doc/src/inet_res.xml @@ -130,7 +130,7 @@ dns_header() = DnsHeader inet_dns:header(DnsHeader) -> [ {id, integer()} | {qr, boolean()} - | {opcode, 'query' | iquery | status | integer()} + | {opcode, query | iquery | status | integer()} | {aa, boolean()} | {tc, boolean()} | {rd, boolean()} diff --git a/lib/kernel/examples/Makefile b/lib/kernel/examples/Makefile index 26ec58f571..f86e662838 100644 --- a/lib/kernel/examples/Makefile +++ b/lib/kernel/examples/Makefile @@ -45,7 +45,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/kernel-$(KERNEL_VSN)/examples # Pack and install the complete directory structure from # here (CWD) and down, for all examples. -EXAMPLES = uds_dist +EXAMPLES = uds_dist gen_tcp_dist release_spec: $(INSTALL_DIR) "$(RELSYSDIR)" diff --git a/lib/kernel/examples/gen_tcp_dist/Makefile b/lib/kernel/examples/gen_tcp_dist/Makefile new file mode 100644 index 0000000000..65513a1729 --- /dev/null +++ b/lib/kernel/examples/gen_tcp_dist/Makefile @@ -0,0 +1,20 @@ +RM=rm -f +CP=cp +EBIN=ebin +ERLC=erlc +# Works if building in open source source tree +KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include +ERLCFLAGS+= -W -I$(KERNEL_INCLUDE) + +MODULES=gen_tcp_dist + +TARGET_FILES=$(MODULES:%=$(EBIN)/%.beam) + +opt: $(TARGET_FILES) + +$(EBIN)/%.beam: src/%.erl + $(ERLC) $(ERLCFLAGS) -o$(EBIN) $< + +clean: + $(RM) $(TARGET_FILES) + diff --git a/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore b/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore diff --git a/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl new file mode 100644 index 0000000000..98554ed805 --- /dev/null +++ b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl @@ -0,0 +1,781 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_tcp_dist). + +%% +%% This is an example of how to plug in an arbitrary distribution +%% carrier for Erlang using distribution processes. +%% +%% This example uses gen_tcp for transportation of data, but +%% you can use whatever underlying protocol you want as long +%% as your implementation reliably delivers data chunks to the +%% receiving VM in the order they were sent from the sending +%% VM. +%% +%% This code is a rewrite of the lib/kernel/src/inet_tcp_dist.erl +%% distribution impementation for TCP used by default. That +%% implementation use distribution ports instead of distribution +%% processes and is more efficient compared to this implementation. +%% This since this implementation more or less gets the +%% distribution processes in between the VM and the ports without +%% any gain specific gain. +%% + +-export([listen/1, accept/1, accept_connection/5, + setup/5, close/1, select/1, is_node_name/1]). + +%% Optional +-export([setopts/2, getopts/2]). + +%% internal exports + +-export([dist_cntrlr_setup/1, dist_cntrlr_input_setup/3, + dist_cntrlr_tick_handler/1]). + +-export([accept_loop/2,do_accept/6,do_setup/6]). + +-import(error_logger,[error_msg/2]). + +-include("net_address.hrl"). + +-include("dist.hrl"). +-include("dist_util.hrl"). + +%% ------------------------------------------------------------ +%% Select this protocol based on node name +%% select(Node) => Bool +%% ------------------------------------------------------------ + +select(Node) -> + case split_node(atom_to_list(Node), $@, []) of + [_, Host] -> + case inet:getaddr(Host, inet) of + {ok,_} -> true; + _ -> false + end; + _ -> false + end. + +%% ------------------------------------------------------------ +%% Create the listen socket, i.e. the port that this erlang +%% node is accessible through. +%% ------------------------------------------------------------ + +listen(Name) -> + case do_listen([binary, {active, false}, {packet,2}, {reuseaddr, true}]) of + {ok, Socket} -> + TcpAddress = get_tcp_address(Socket), + {_,Port} = TcpAddress#net_address.address, + ErlEpmd = net_kernel:epmd_module(), + case ErlEpmd:register_node(Name, Port) of + {ok, Creation} -> + {ok, {Socket, TcpAddress, Creation}}; + Error -> + Error + end; + Error -> + Error + end. + +do_listen(Options) -> + {First,Last} = case application:get_env(kernel,inet_dist_listen_min) of + {ok,N} when is_integer(N) -> + case application:get_env(kernel, + inet_dist_listen_max) of + {ok,M} when is_integer(M) -> + {N,M}; + _ -> + {N,N} + end; + _ -> + {0,0} + end, + do_listen(First, Last, listen_options([{backlog,128}|Options])). + +do_listen(First,Last,_) when First > Last -> + {error,eaddrinuse}; +do_listen(First,Last,Options) -> + case gen_tcp:listen(First, Options) of + {error, eaddrinuse} -> + do_listen(First+1,Last,Options); + Other -> + Other + end. + +listen_options(Opts0) -> + Opts1 = + case application:get_env(kernel, inet_dist_use_interface) of + {ok, Ip} -> + [{ip, Ip} | Opts0]; + _ -> + Opts0 + end, + case application:get_env(kernel, inet_dist_listen_options) of + {ok,ListenOpts} -> + ListenOpts ++ Opts1; + _ -> + Opts1 + end. + + +%% ------------------------------------------------------------ +%% Accepts new connection attempts from other Erlang nodes. +%% ------------------------------------------------------------ + +accept(Listen) -> + spawn_opt(?MODULE, accept_loop, [self(), Listen], [link, {priority, max}]). + +accept_loop(Kernel, Listen) -> + ?trace("~p~n",[{?MODULE, accept_loop, self()}]), + case gen_tcp:accept(Listen) of + {ok, Socket} -> + DistCtrl = spawn_dist_cntrlr(Socket), + ?trace("~p~n",[{?MODULE, accept_loop, accepted, Socket, DistCtrl, self()}]), + flush_controller(DistCtrl, Socket), + gen_tcp:controlling_process(Socket, DistCtrl), + flush_controller(DistCtrl, Socket), + Kernel ! {accept,self(),DistCtrl,inet,tcp}, + receive + {Kernel, controller, Pid} -> + call_ctrlr(DistCtrl, {supervisor, Pid}), + Pid ! {self(), controller}; + {Kernel, unsupported_protocol} -> + exit(unsupported_protocol) + end, + accept_loop(Kernel, Listen); + Error -> + exit(Error) + end. + +flush_controller(Pid, Socket) -> + receive + {tcp, Socket, Data} -> + Pid ! {tcp, Socket, Data}, + flush_controller(Pid, Socket); + {tcp_closed, Socket} -> + Pid ! {tcp_closed, Socket}, + flush_controller(Pid, Socket) + after 0 -> + ok + end. + +%% ------------------------------------------------------------ +%% Accepts a new connection attempt from another Erlang node. +%% Performs the handshake with the other side. +%% ------------------------------------------------------------ + +accept_connection(AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> + spawn_opt(?MODULE, do_accept, + [self(), AcceptPid, DistCtrl, MyNode, Allowed, SetupTime], + [link, {priority, max}]). + +do_accept(Kernel, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> + ?trace("~p~n",[{?MODULE, do_accept, self(), MyNode}]), + receive + {AcceptPid, controller} -> + Timer = dist_util:start_timer(SetupTime), + case check_ip(DistCtrl) of + true -> + HSData0 = hs_data_common(DistCtrl), + HSData = HSData0#hs_data{kernel_pid = Kernel, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + allowed = Allowed}, + dist_util:handshake_other_started(HSData); + {false,IP} -> + error_msg("** Connection attempt from " + "disallowed IP ~w ** ~n", [IP]), + ?shutdown(no_node) + end + end. + +%% we may not always want the nodelay behaviour +%% for performance reasons + +nodelay() -> + case application:get_env(kernel, dist_nodelay) of + undefined -> + {nodelay, true}; + {ok, true} -> + {nodelay, true}; + {ok, false} -> + {nodelay, false}; + _ -> + {nodelay, true} + end. + +%% ------------------------------------------------------------ +%% Setup a new connection to another Erlang node. +%% Performs the handshake with the other side. +%% ------------------------------------------------------------ + +setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> + spawn_opt(?MODULE, do_setup, + [self(), Node, Type, MyNode, LongOrShortNames, SetupTime], + [link, {priority, max}]). + +do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> + ?trace("~p~n",[{?MODULE, do_setup, self(), Node}]), + [Name, Address] = splitnode(Node, LongOrShortNames), + case inet:getaddr(Address, inet) of + {ok, Ip} -> + Timer = dist_util:start_timer(SetupTime), + ErlEpmd = net_kernel:epmd_module(), + case ErlEpmd:port_please(Name, Ip) of + {port, TcpPort, Version} -> + ?trace("port_please(~p) -> version ~p~n", + [Node,Version]), + dist_util:reset_timer(Timer), + case + gen_tcp:connect( + Ip, TcpPort, + connect_options([binary, {active, false}, {packet, 2}])) + of + {ok, Socket} -> + DistCtrl = spawn_dist_cntrlr(Socket), + call_ctrlr(DistCtrl, {supervisor, self()}), + flush_controller(DistCtrl, Socket), + gen_tcp:controlling_process(Socket, DistCtrl), + flush_controller(DistCtrl, Socket), + HSData0 = hs_data_common(DistCtrl), + HSData = HSData0#hs_data{kernel_pid = Kernel, + other_node = Node, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + other_version = Version, + request_type = Type}, + dist_util:handshake_we_started(HSData); + _ -> + %% Other Node may have closed since + %% port_please ! + ?trace("other node (~p) " + "closed since port_please.~n", + [Node]), + ?shutdown(Node) + end; + _ -> + ?trace("port_please (~p) " + "failed.~n", [Node]), + ?shutdown(Node) + end; + _Other -> + ?trace("inet_getaddr(~p) " + "failed (~p).~n", [Node,_Other]), + ?shutdown(Node) + end. + +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + ConnectOpts ++ Opts; + _ -> + Opts + end. + +%% +%% Close a socket. +%% +close(Listen) -> + gen_tcp:close(Listen). + + +%% If Node is illegal terminate the connection setup!! +splitnode(Node, LongOrShortNames) -> + case split_node(atom_to_list(Node), $@, []) of + [Name|Tail] when Tail =/= [] -> + Host = lists:append(Tail), + case split_node(Host, $., []) of + [_] when LongOrShortNames =:= longnames -> + case inet:parse_address(Host) of + {ok, _} -> + [Name, Host]; + _ -> + error_msg("** System running to use " + "fully qualified " + "hostnames **~n" + "** Hostname ~ts is illegal **~n", + [Host]), + ?shutdown(Node) + end; + L when length(L) > 1, LongOrShortNames =:= shortnames -> + error_msg("** System NOT running to use fully qualified " + "hostnames **~n" + "** Hostname ~ts is illegal **~n", + [Host]), + ?shutdown(Node); + _ -> + [Name, Host] + end; + [_] -> + error_msg("** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown(Node); + _ -> + error_msg("** Nodename ~p illegal **~n", [Node]), + ?shutdown(Node) + end. + +split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])]; +split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]); +split_node([], _, Ack) -> [lists:reverse(Ack)]. + +%% ------------------------------------------------------------ +%% Fetch local information about a Socket. +%% ------------------------------------------------------------ +get_tcp_address(Socket) -> + {ok, Address} = inet:sockname(Socket), + {ok, Host} = inet:gethostname(), + #net_address { + address = Address, + host = Host, + protocol = tcp, + family = inet + }. + +%% ------------------------------------------------------------ +%% Do only accept new connection attempts from nodes at our +%% own LAN, if the check_ip environment parameter is true. +%% ------------------------------------------------------------ +check_ip(DistCtrl) -> + case application:get_env(check_ip) of + {ok, true} -> + case get_ifs(DistCtrl) of + {ok, IFs, IP} -> + check_ip(IFs, IP); + _ -> + ?shutdown(no_node) + end; + _ -> + true + end. + +get_ifs(DistCtrl) -> + Socket = call_ctrlr(DistCtrl, socket), + case inet:peername(Socket) of + {ok, {IP, _}} -> + case inet:getif(Socket) of + {ok, IFs} -> {ok, IFs, IP}; + Error -> Error + end; + Error -> + Error + end. + +check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {inet_tcp:mask(Netmask, PeerIP), inet_tcp:mask(Netmask, OwnIP)} of + {M, M} -> true; + _ -> check_ip(IFs, PeerIP) + end; +check_ip([], PeerIP) -> + {false, PeerIP}. + +is_node_name(Node) when is_atom(Node) -> + case split_node(atom_to_list(Node), $@, []) of + [_, _Host] -> true; + _ -> false + end; +is_node_name(_Node) -> + false. + +hs_data_common(DistCtrl) -> + TickHandler = call_ctrlr(DistCtrl, tick_handler), + Socket = call_ctrlr(DistCtrl, socket), + #hs_data{f_send = send_fun(), + f_recv = recv_fun(), + f_setopts_pre_nodeup = setopts_pre_nodeup_fun(), + f_setopts_post_nodeup = setopts_post_nodeup_fun(), + f_getll = getll_fun(), + f_handshake_complete = handshake_complete_fun(), + f_address = address_fun(), + mf_setopts = setopts_fun(DistCtrl, Socket), + mf_getopts = getopts_fun(DistCtrl, Socket), + mf_getstat = getstat_fun(DistCtrl, Socket), + mf_tick = tick_fun(DistCtrl, TickHandler)}. + +%%% ------------------------------------------------------------ +%%% Distribution controller processes +%%% ------------------------------------------------------------ + +%% +%% There will be five parties working together when the +%% connection is up: +%% - The gen_tcp socket. Providing a tcp/ip connection +%% to the other node. +%% - The output handler. It will dispatch all outgoing +%% traffic from the VM to the gen_tcp socket. This +%% process is registered as distribution controller +%% for this channel with the VM. +%% - The input handler. It will dispatch all incoming +%% traffic from the gen_tcp socket to the VM. This +%% process is also the socket owner and receives +%% incoming traffic using active-N. +%% - The tick handler. Dispatches asynchronous tick +%% requests to the socket. It executes on max priority +%% since it is important to get ticks through to the +%% other end. +%% - The channel supervisor (provided by dist_util). It +%% monitors traffic. Issue tick requests to the tick +%% handler when no outgoing traffic is seen and bring +%% the connection down if no incoming traffic is seen. +%% This process also executes on max priority. +%% +%% These parties are linked togheter so should one +%% of them fail, all of them are terminated and the +%% connection is taken down. +%% + +%% In order to avoid issues with lingering signal binaries +%% we enable off-heap message queue data as well as fullsweep +%% after 0. The fullsweeps will be cheap since we have more +%% or less no live data. +-define(DIST_CNTRL_COMMON_SPAWN_OPTS, + [{message_queue_data, off_heap}, + {fullsweep_after, 0}]). + +tick_fun(DistCtrl, TickHandler) -> + fun (Ctrl) when Ctrl == DistCtrl -> + TickHandler ! tick + end. + +getstat_fun(DistCtrl, Socket) -> + fun (Ctrl) when Ctrl == DistCtrl -> + case inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of + {ok, Stat} -> + split_stat(Stat,0,0,0); + Error -> + Error + end + end. + +split_stat([{recv_cnt, R}|Stat], _, W, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_cnt, W}|Stat], R, _, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_pend, P}|Stat], R, W, _) -> + split_stat(Stat, R, W, P); +split_stat([], R, W, P) -> + {ok, R, W, P}. + +setopts_fun(DistCtrl, Socket) -> + fun (Ctrl, Opts) when Ctrl == DistCtrl -> + setopts(Socket, Opts) + end. + +getopts_fun(DistCtrl, Socket) -> + fun (Ctrl, Opts) when Ctrl == DistCtrl -> + getopts(Socket, Opts) + end. + +setopts(S, Opts) -> + case [Opt || {K,_}=Opt <- Opts, + K =:= active orelse K =:= deliver orelse K =:= packet] of + [] -> inet:setopts(S,Opts); + Opts1 -> {error, {badopts,Opts1}} + end. + +getopts(S, Opts) -> + inet:getopts(S, Opts). + +send_fun() -> + fun (Ctrlr, Packet) -> + call_ctrlr(Ctrlr, {send, Packet}) + end. + +recv_fun() -> + fun (Ctrlr, Length, Timeout) -> + case call_ctrlr(Ctrlr, {recv, Length, Timeout}) of + {ok, Bin} when is_binary(Bin) -> + {ok, binary_to_list(Bin)}; + Other -> + Other + end + end. + +getll_fun() -> + fun (Ctrlr) -> + call_ctrlr(Ctrlr, getll) + end. + +address_fun() -> + fun (Ctrlr, Node) -> + case call_ctrlr(Ctrlr, {address, Node}) of + {error, no_node} -> %% No '@' or more than one '@' in node name. + ?shutdown(no_node); + Res -> + Res + end + end. + +setopts_pre_nodeup_fun() -> + fun (Ctrlr) -> + call_ctrlr(Ctrlr, pre_nodeup) + end. + +setopts_post_nodeup_fun() -> + fun (Ctrlr) -> + call_ctrlr(Ctrlr, post_nodeup) + end. + +handshake_complete_fun() -> + fun (Ctrlr, Node, DHandle) -> + call_ctrlr(Ctrlr, {handshake_complete, Node, DHandle}) + end. + +call_ctrlr(Ctrlr, Msg) -> + Ref = erlang:monitor(process, Ctrlr), + Ctrlr ! {Ref, self(), Msg}, + receive + {Ref, Res} -> + erlang:demonitor(Ref, [flush]), + Res; + {'DOWN', Ref, process, Ctrlr, Reason} -> + exit({dist_controller_exit, Reason}) + end. + +%% +%% The tick handler process writes a tick to the +%% socket when it receives a 'tick' message from +%% the connection supervisor. +%% +%% We are not allowed to block the connection +%% superviser when writing a tick and we also want +%% the tick to go through even during a heavily +%% loaded system. gen_tcp does not have a +%% non-blocking send operation exposed in its API +%% and we don't want to run the distribution +%% controller under high priority. Therefore this +%% sparate process with max prio that dispatches +%% ticks. +%% +dist_cntrlr_tick_handler(Socket) -> + receive + tick -> + %% May block due to busy port... + sock_send(Socket, ""); + _ -> + ok + end, + dist_cntrlr_tick_handler(Socket). + +spawn_dist_cntrlr(Socket) -> + spawn_opt(?MODULE, dist_cntrlr_setup, [Socket], + [{priority, max}] ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS). + +dist_cntrlr_setup(Socket) -> + TickHandler = spawn_opt(?MODULE, dist_cntrlr_tick_handler, + [Socket], + [link, {priority, max}] + ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS), + dist_cntrlr_setup_loop(Socket, TickHandler, undefined). + +%% +%% During the handshake phase we loop in dist_cntrlr_setup(). +%% When the connection is up we spawn an input handler and +%% continue as output handler. +%% +dist_cntrlr_setup_loop(Socket, TickHandler, Sup) -> + receive + {tcp_closed, Socket} -> + exit(connection_closed); + + {Ref, From, {supervisor, Pid}} -> + Res = link(Pid), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Pid); + + {Ref, From, tick_handler} -> + From ! {Ref, TickHandler}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, socket} -> + From ! {Ref, Socket}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, {send, Packet}} -> + Res = gen_tcp:send(Socket, Packet), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, {recv, Length, Timeout}} -> + Res = gen_tcp:recv(Socket, Length, Timeout), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, getll} -> + From ! {Ref, {ok, self()}}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, {address, Node}} -> + Res = case inet:peername(Socket) of + {ok, Address} -> + case split_node(atom_to_list(Node), $@, []) of + [_,Host] -> + #net_address{address=Address,host=Host, + protocol=tcp, family=inet}; + _ -> + {error, no_node} + end + end, + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, pre_nodeup} -> + Res = inet:setopts(Socket, + [{active, false}, + {packet, 4}, + nodelay()]), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, post_nodeup} -> + Res = inet:setopts(Socket, + [{active, false}, + {packet, 4}, + nodelay()]), + From ! {Ref, Res}, + dist_cntrlr_setup_loop(Socket, TickHandler, Sup); + + {Ref, From, {handshake_complete, _Node, DHandle}} -> + From ! {Ref, ok}, + %% Handshake complete! Begin dispatching traffic... + + %% We use separate process for dispatching input. This + %% is not necessary, but it enables parallel execution + %% of independent work loads at the same time as it + %% simplifies the the implementation... + InputHandler = spawn_opt(?MODULE, dist_cntrlr_input_setup, + [DHandle, Socket, Sup], + [link] ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS), + + flush_controller(InputHandler, Socket), + gen_tcp:controlling_process(Socket, InputHandler), + flush_controller(InputHandler, Socket), + + ok = erlang:dist_ctrl_input_handler(DHandle, InputHandler), + + InputHandler ! DHandle, + + %% From now on we execute on normal priority + process_flag(priority, normal), + erlang:dist_ctrl_get_data_notification(DHandle), + dist_cntrlr_output_loop(DHandle, Socket) + end. + +%% We use active 10 for good throughput while still +%% maintaining back-pressure if the input controller +%% isn't able to handle all incoming messages... +-define(ACTIVE_INPUT, 10). + +dist_cntrlr_input_setup(DHandle, Socket, Sup) -> + link(Sup), + %% Ensure we don't try to put data before registerd + %% as input handler... + receive + DHandle -> + dist_cntrlr_input_loop(DHandle, Socket, 0) + end. + +dist_cntrlr_input_loop(DHandle, Socket, N) when N =< ?ACTIVE_INPUT/2 -> + inet:setopts(Socket, [{active, ?ACTIVE_INPUT - N}]), + dist_cntrlr_input_loop(DHandle, Socket, ?ACTIVE_INPUT); +dist_cntrlr_input_loop(DHandle, Socket, N) -> + receive + {tcp_closed, Socket} -> + %% Connection to remote node terminated... + exit(connection_closed); + + {tcp, Socket, Data} -> + %% Incoming data from remote node... + try erlang:dist_ctrl_put_data(DHandle, Data) + catch _ : _ -> death_row() + end, + dist_cntrlr_input_loop(DHandle, Socket, N-1); + + _ -> + %% Ignore... + dist_cntrlr_input_loop(DHandle, Socket, N) + end. + +dist_cntrlr_send_data(DHandle, Socket) -> + case erlang:dist_ctrl_get_data(DHandle) of + none -> + erlang:dist_ctrl_get_data_notification(DHandle); + Data -> + sock_send(Socket, Data), + dist_cntrlr_send_data(DHandle, Socket) + end. + + +dist_cntrlr_output_loop(DHandle, Socket) -> + receive + dist_data -> + %% Outgoing data from this node... + try dist_cntrlr_send_data(DHandle, Socket) + catch _ : _ -> death_row() + end, + dist_cntrlr_output_loop(DHandle, Socket); + + {send, From, Ref, Data} -> + %% This is for testing only! + %% + %% Needed by some OTP distribution + %% test suites... + sock_send(Socket, Data), + From ! {Ref, ok}, + dist_cntrlr_output_loop(DHandle, Socket); + + _ -> + %% Drop garbage message... + dist_cntrlr_output_loop(DHandle, Socket) + + end. + +sock_send(Socket, Data) -> + try gen_tcp:send(Socket, Data) of + ok -> ok; + {error, Reason} -> death_row({send_error, Reason}) + catch + Type : Reason -> death_row({send_error, {Type, Reason}}) + end. + +death_row() -> + death_row(connection_closed). + +death_row(normal) -> + %% We do not want to exit with normal + %% exit reason since it wont bring down + %% linked processes... + death_row(); +death_row(Reason) -> + %% When the connection is on its way down operations + %% begin to fail. We catch the failures and call + %% this function waiting for termination. We should + %% be terminated by one of our links to the other + %% involved parties that began bringing the + %% connection down. By waiting for termination we + %% avoid altering the exit reason for the connection + %% teardown. We however limit the wait to 5 seconds + %% and bring down the connection ourselves if not + %% terminated... + receive after 5000 -> exit(Reason) end. diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl index d6bccdf474..db4a5eaebc 100644 --- a/lib/kernel/include/dist.hrl +++ b/lib/kernel/include/dist.hrl @@ -40,3 +40,33 @@ -define(DFLAG_UTF8_ATOMS, 16#10000). -define(DFLAG_MAP_TAG, 16#20000). -define(DFLAG_BIG_CREATION, 16#40000). +-define(DFLAG_SEND_SENDER, 16#80000). + +%% DFLAGs that require strict ordering or:ed together... +-define(DFLAGS_STRICT_ORDER_DELIVERY, + ?DFLAG_DIST_HDR_ATOM_CACHE). + + +%% Also update dflag2str() in ../src/dist_util.erl +%% when adding flags... + +-define(DFLAGS_ALL, + (?DFLAG_PUBLISHED + bor ?DFLAG_ATOM_CACHE + bor ?DFLAG_EXTENDED_REFERENCES + bor ?DFLAG_DIST_MONITOR + bor ?DFLAG_FUN_TAGS + bor ?DFLAG_DIST_MONITOR_NAME + bor ?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_NEW_FUN_TAGS + bor ?DFLAG_EXTENDED_PIDS_PORTS + bor ?DFLAG_EXPORT_PTR_TAG + bor ?DFLAG_BIT_BINARIES + bor ?DFLAG_NEW_FLOATS + bor ?DFLAG_UNICODE_IO + bor ?DFLAG_DIST_HDR_ATOM_CACHE + bor ?DFLAG_SMALL_ATOM_TAGS + bor ?DFLAG_UTF8_ATOMS + bor ?DFLAG_MAP_TAG + bor ?DFLAG_BIG_CREATION + bor ?DFLAG_SEND_SENDER)). diff --git a/lib/kernel/include/dist_util.hrl b/lib/kernel/include/dist_util.hrl index e3d2fe0eb6..eeb0f8dd43 100644 --- a/lib/kernel/include/dist_util.hrl +++ b/lib/kernel/include/dist_util.hrl @@ -29,9 +29,9 @@ -endif. -ifdef(dist_trace). --define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:timestamp(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])). % Use the one below for config-file (early boot) connection tracing -%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +%-define(trace(Fmt,Args), erlang:display([erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])). -define(trace_factor,8). -else. -define(trace(Fmt,Args), ok). @@ -78,7 +78,13 @@ %% New in kernel-5.1 (OTP 19.1): mf_setopts, %% netkernel:setopts on active connection - mf_getopts %% netkernel:getopts on active connection + mf_getopts, %% netkernel:getopts on active connection + + %% New in kernel-6.0 (OTP 21.0) + f_handshake_complete, %% Notify handshake complete + add_flags, %% dflags to add + reject_flags, %% dflags not to use (not all can be rejected) + require_flags %% dflags that are required }). diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index b3507e5d13..08bd5946cd 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -74,6 +74,48 @@ ticked = 0 }). +dflag2str(?DFLAG_PUBLISHED) -> + "PUBLISHED"; +dflag2str(?DFLAG_ATOM_CACHE) -> + "ATOM_CACHE"; +dflag2str(?DFLAG_EXTENDED_REFERENCES) -> + "EXTENDED_REFERENCES"; +dflag2str(?DFLAG_DIST_MONITOR) -> + "DIST_MONITOR"; +dflag2str(?DFLAG_FUN_TAGS) -> + "FUN_TAGS"; +dflag2str(?DFLAG_DIST_MONITOR_NAME) -> + "DIST_MONITOR_NAME"; +dflag2str(?DFLAG_HIDDEN_ATOM_CACHE) -> + "HIDDEN_ATOM_CACHE"; +dflag2str(?DFLAG_NEW_FUN_TAGS) -> + "NEW_FUN_TAGS"; +dflag2str(?DFLAG_EXTENDED_PIDS_PORTS) -> + "EXTENDED_PIDS_PORTS"; +dflag2str(?DFLAG_EXPORT_PTR_TAG) -> + "EXPORT_PTR_TAG"; +dflag2str(?DFLAG_BIT_BINARIES) -> + "BIT_BINARIES"; +dflag2str(?DFLAG_NEW_FLOATS) -> + "NEW_FLOATS"; +dflag2str(?DFLAG_UNICODE_IO) -> + "UNICODE_IO"; +dflag2str(?DFLAG_DIST_HDR_ATOM_CACHE) -> + "DIST_HDR_ATOM_CACHE"; +dflag2str(?DFLAG_SMALL_ATOM_TAGS) -> + "SMALL_ATOM_TAGS"; +dflag2str(?DFLAG_UTF8_ATOMS) -> + "UTF8_ATOMS"; +dflag2str(?DFLAG_MAP_TAG) -> + "MAP_TAG"; +dflag2str(?DFLAG_BIG_CREATION) -> + "BIG_CREATION"; +dflag2str(?DFLAG_SEND_SENDER) -> + "SEND_SENDER"; +dflag2str(_) -> + "UNKNOWN". + + remove_flag(Flag, Flags) -> case Flags band Flag of 0 -> @@ -82,13 +124,13 @@ remove_flag(Flag, Flags) -> Flags - Flag end. -adjust_flags(ThisFlags, OtherFlags) -> +adjust_flags(ThisFlags, OtherFlags, RejectFlags) -> case (?DFLAG_PUBLISHED band ThisFlags) band OtherFlags of 0 -> {remove_flag(?DFLAG_PUBLISHED, ThisFlags), remove_flag(?DFLAG_PUBLISHED, OtherFlags)}; _ -> - {ThisFlags, OtherFlags} + {ThisFlags, OtherFlags band (bnot RejectFlags)} end. publish_flag(hidden, _) -> @@ -101,36 +143,71 @@ publish_flag(_, OtherNode) -> 0 end. -make_this_flags(RequestType, OtherNode) -> - publish_flag(RequestType, OtherNode) bor - %% The parenthesis below makes the compiler generate better code. - (?DFLAG_EXPORT_PTR_TAG bor - ?DFLAG_EXTENDED_PIDS_PORTS bor - ?DFLAG_EXTENDED_REFERENCES bor - ?DFLAG_DIST_MONITOR bor - ?DFLAG_FUN_TAGS bor - ?DFLAG_DIST_MONITOR_NAME bor - ?DFLAG_HIDDEN_ATOM_CACHE bor - ?DFLAG_NEW_FUN_TAGS bor - ?DFLAG_BIT_BINARIES bor - ?DFLAG_NEW_FLOATS bor - ?DFLAG_UNICODE_IO bor - ?DFLAG_DIST_HDR_ATOM_CACHE bor - ?DFLAG_SMALL_ATOM_TAGS bor - ?DFLAG_UTF8_ATOMS bor - ?DFLAG_MAP_TAG bor - ?DFLAG_BIG_CREATION). - -handshake_other_started(#hs_data{request_type=ReqType}=HSData0) -> +-define(DFLAGS_REMOVABLE, + (?DFLAG_DIST_HDR_ATOM_CACHE + bor ?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_ATOM_CACHE)). + +-define(DFLAGS_ADDABLE, + (?DFLAGS_ALL + band (bnot (?DFLAG_PUBLISHED + bor ?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_ATOM_CACHE)))). + +-define(DFLAGS_THIS_DEFAULT, + (?DFLAG_EXPORT_PTR_TAG + bor ?DFLAG_EXTENDED_PIDS_PORTS + bor ?DFLAG_EXTENDED_REFERENCES + bor ?DFLAG_DIST_MONITOR + bor ?DFLAG_FUN_TAGS + bor ?DFLAG_DIST_MONITOR_NAME + bor ?DFLAG_NEW_FUN_TAGS + bor ?DFLAG_BIT_BINARIES + bor ?DFLAG_NEW_FLOATS + bor ?DFLAG_UNICODE_IO + bor ?DFLAG_DIST_HDR_ATOM_CACHE + bor ?DFLAG_SMALL_ATOM_TAGS + bor ?DFLAG_UTF8_ATOMS + bor ?DFLAG_MAP_TAG + bor ?DFLAG_BIG_CREATION + bor ?DFLAG_SEND_SENDER)). + +make_this_flags(RequestType, AddFlags, RemoveFlags, OtherNode) -> + case RemoveFlags band (bnot ?DFLAGS_REMOVABLE) of + 0 -> ok; + Rerror -> exit({"Rejecting non rejectable flags", Rerror}) + end, + case AddFlags band (bnot ?DFLAGS_ADDABLE) of + 0 -> ok; + Aerror -> exit({"Adding non addable flags", Aerror}) + end, + Flgs0 = ?DFLAGS_THIS_DEFAULT, + Flgs1 = Flgs0 bor publish_flag(RequestType, OtherNode), + Flgs2 = Flgs1 bor AddFlags, + Flgs3 = Flgs2 band (bnot (?DFLAG_HIDDEN_ATOM_CACHE + bor ?DFLAG_ATOM_CACHE)), + Flgs3 band (bnot RemoveFlags). + +handshake_other_started(#hs_data{request_type=ReqType, + add_flags=AddFlgs0, + reject_flags=RejFlgs0, + require_flags=ReqFlgs0}=HSData0) -> + AddFlgs = convert_flags(AddFlgs0), + RejFlgs = convert_flags(RejFlgs0), + ReqFlgs = convert_flags(ReqFlgs0), {PreOtherFlags,Node,Version} = recv_name(HSData0), - PreThisFlags = make_this_flags(ReqType, Node), + PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node), {ThisFlags, OtherFlags} = adjust_flags(PreThisFlags, - PreOtherFlags), + PreOtherFlags, + RejFlgs), HSData = HSData0#hs_data{this_flags=ThisFlags, other_flags=OtherFlags, other_version=Version, other_node=Node, - other_started=true}, + other_started=true, + add_flags=AddFlgs, + reject_flags=RejFlgs, + require_flags=ReqFlgs}, check_dflags(HSData), is_allowed(HSData), ?debug({"MD5 connection from ~p (V~p)~n", @@ -165,23 +242,18 @@ is_allowed(#hs_data{other_node = Node, end. %% -%% Check that both nodes can handle the same types of extended -%% node containers. If they can not, abort the connection. +%% Check mandatory flags... %% check_dflags(#hs_data{other_node = Node, other_flags = OtherFlags, - other_started = OtherStarted} = HSData) -> - - Mandatory = [{?DFLAG_EXTENDED_REFERENCES, "EXTENDED_REFERENCES"}, - {?DFLAG_EXTENDED_PIDS_PORTS, "EXTENDED_PIDS_PORTS"}, - {?DFLAG_UTF8_ATOMS, "UTF8_ATOMS"}], - Missing = lists:filtermap(fun({Bit, Str}) -> - case Bit band OtherFlags of - Bit -> false; - 0 -> {true, Str} - end - end, - Mandatory), + other_started = OtherStarted, + require_flags = RequiredFlags} = HSData) -> + Mandatory = ((?DFLAG_EXTENDED_REFERENCES + bor ?DFLAG_EXTENDED_PIDS_PORTS + bor ?DFLAG_UTF8_ATOMS) + bor RequiredFlags), + Missing = check_mandatory(0, ?DFLAGS_ALL, Mandatory, + OtherFlags, []), case Missing of [] -> ok; @@ -201,6 +273,22 @@ check_dflags(#hs_data{other_node = Node, ?shutdown2(Node, {check_dflags_failed, Missing}) end. +check_mandatory(_Bit, 0, _Mandatory, _OtherFlags, Missing) -> + Missing; +check_mandatory(Bit, Left, Mandatory, OtherFlags, Missing) -> + DFlag = (1 bsl Bit), + NewLeft = Left band (bnot DFlag), + NewMissing = case {DFlag band Mandatory, + DFlag band OtherFlags} of + {DFlag, 0} -> + %% Mandatory and missing... + [dflag2str(DFlag) | Missing]; + _ -> + %% Not mandatory or present... + Missing + end, + check_mandatory(Bit+1, NewLeft, Mandatory, OtherFlags, NewMissing). + %% No nodedown will be sent if we fail before this process has %% succeeded to mark the node as pending. @@ -314,13 +402,24 @@ flush_down() -> end. handshake_we_started(#hs_data{request_type=ReqType, - other_node=Node}=PreHSData) -> - PreThisFlags = make_this_flags(ReqType, Node), - HSData = PreHSData#hs_data{this_flags=PreThisFlags}, + other_node=Node, + add_flags=AddFlgs0, + reject_flags=RejFlgs0, + require_flags=ReqFlgs0}=PreHSData) -> + AddFlgs = convert_flags(AddFlgs0), + RejFlgs = convert_flags(RejFlgs0), + ReqFlgs = convert_flags(ReqFlgs0), + PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node), + HSData = PreHSData#hs_data{this_flags = PreThisFlags, + add_flags = AddFlgs, + reject_flags = RejFlgs, + require_flags = ReqFlgs}, send_name(HSData), recv_status(HSData), {PreOtherFlags,ChallengeA} = recv_challenge(HSData), - {ThisFlags,OtherFlags} = adjust_flags(PreThisFlags, PreOtherFlags), + {ThisFlags,OtherFlags} = adjust_flags(PreThisFlags, + PreOtherFlags, + RejFlgs), NewHSData = HSData#hs_data{this_flags = ThisFlags, other_flags = OtherFlags, other_started = false}, @@ -336,15 +435,16 @@ handshake_we_started(#hs_data{request_type=ReqType, handshake_we_started(OldHsData) when element(1,OldHsData) =:= hs_data -> handshake_we_started(convert_old_hsdata(OldHsData)). -convert_old_hsdata({hs_data, KP, ON, TN, S, T, TF, A, OV, OF, OS, FS, FR, - FS_PRE, FS_POST, FG, FA, MFT, MFG, RT}) -> - #hs_data{ - kernel_pid = KP, other_node = ON, this_node = TN, socket = S, timer = T, - this_flags = TF, allowed = A, other_version = OV, other_flags = OF, - other_started = OS, f_send = FS, f_recv = FR, f_setopts_pre_nodeup = FS_PRE, - f_setopts_post_nodeup = FS_POST, f_getll = FG, f_address = FA, - mf_tick = MFT, mf_getstat = MFG, request_type = RT}. +convert_old_hsdata(OldHsData) -> + OHSDL = tuple_to_list(OldHsData), + NoMissing = tuple_size(#hs_data{}) - tuple_size(OldHsData), + true = NoMissing > 0, + list_to_tuple(OHSDL ++ lists:duplicate(NoMissing, undefined)). +convert_flags(Flags) when is_integer(Flags) -> + Flags; +convert_flags(_Undefined) -> + 0. %% -------------------------------------------------------------- %% The connection has been established. @@ -359,15 +459,20 @@ connection(#hs_data{other_node = Node, PType = publish_type(HSData#hs_data.other_flags), case FPreNodeup(Socket) of ok -> - do_setnode(HSData), % Succeeds or exits the process. + DHandle = do_setnode(HSData), % Succeeds or exits the process. Address = FAddress(Socket,Node), mark_nodeup(HSData,Address), case FPostNodeup(Socket) of ok -> + case HSData#hs_data.f_handshake_complete of + undefined -> ok; + HsComplete -> HsComplete(Socket, Node, DHandle) + end, con_loop({HSData#hs_data.kernel_pid, Node, Socket, PType, + DHandle, HSData#hs_data.mf_tick, HSData#hs_data.mf_getstat, HSData#hs_data.mf_setopts, @@ -425,18 +530,16 @@ do_setnode(#hs_data{other_node = Node, socket = Socket, [Node, Port, {publish_type(Flags), '(', Flags, ')', Version}]), - case (catch - erlang:setnode(Node, Port, - {Flags, Version, '', ''})) of - {'EXIT', {system_limit, _}} -> + try + erlang:setnode(Node, Port, {Flags, Version, '', ''}) + catch + error:system_limit -> error_msg("** Distribution system limit reached, " "no table space left for node ~w ** ~n", [Node]), ?shutdown(Node); - {'EXIT', Other} -> - exit(Other); - _Else -> - ok + error:Other -> + exit({Other, erlang:get_stacktrace()}) end; _ -> error_msg("** Distribution connection error, " @@ -468,7 +571,13 @@ mark_nodeup(#hs_data{kernel_pid = Kernel, ?shutdown(Node) end. -con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=ConData, +getstat(DHandle, _Socket, undefined) -> + erlang:dist_get_stat(DHandle); +getstat(_DHandle, Socket, MFGetstat) -> + MFGetstat(Socket). + +con_loop({Kernel, Node, Socket, Type, DHandle, MFTick, MFGetstat, + MFSetOpts, MFGetOpts}=ConData, Tick) -> receive {tcp_closed, Socket} -> @@ -476,7 +585,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C {Kernel, disconnect} -> ?shutdown2(Node, disconnected); {Kernel, aux_tick} -> - case MFGetstat(Socket) of + case getstat(DHandle, Socket, MFGetstat) of {ok, _, _, PendWrite} -> send_tick(Socket, PendWrite, MFTick); _ -> @@ -484,7 +593,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C end, con_loop(ConData, Tick); {Kernel, tick} -> - case send_tick(Socket, Tick, Type, + case send_tick(DHandle, Socket, Tick, Type, MFTick, MFGetstat) of {ok, NewTick} -> con_loop(ConData, NewTick); @@ -497,7 +606,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C ?shutdown2(Node, send_net_tick_failed) end; {From, get_status} -> - case MFGetstat(Socket) of + case getstat(DHandle, Socket, MFGetstat) of {ok, Read, Write, _} -> From ! {self(), get_status, {ok, Read, Write}}, con_loop(ConData, Tick); @@ -735,14 +844,14 @@ send_status(#hs_data{socket = Socket, other_node = Node, %% we haven't read anything as a hidden node only ticks when it receives %% a TICK !! -send_tick(Socket, Tick, Type, MFTick, MFGetstat) -> +send_tick(DHandle, Socket, Tick, Type, MFTick, MFGetstat) -> #tick{tick = T0, read = Read, write = Write, ticked = Ticked} = Tick, T = T0 + 1, T1 = T rem 4, - case MFGetstat(Socket) of + case getstat(DHandle, Socket, MFGetstat) of {ok, Read, _, _} when Ticked =:= T -> {error, not_responding}; {ok, Read, W, Pend} when Type =:= hidden -> @@ -771,11 +880,10 @@ send_tick(Socket, Tick, Type, MFTick, MFGetstat) -> Error end. -send_tick(Socket, 0, MFTick) -> - MFTick(Socket); -send_tick(_, _Pend, _) -> - %% Dont send tick if pending write. - ok. +send_tick(_, Pend, _) when Pend /= false, Pend /= 0 -> + ok; %% Dont send tick if pending write. +send_tick(Socket, _Pend, MFTick) -> + MFTick(Socket). %% ------------------------------------------------------------ %% Connection setup timeout timer. diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index 9bf8547745..f07ec52cfa 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -499,27 +499,16 @@ display4(A = [_|_]) -> display4(A) -> erlang:display(A). -string_p([]) -> + +string_p(Term) when is_list(Term) -> + string_p1(lists:flatten(Term)); +string_p(_Term) -> + false. + +string_p1([]) -> false; -string_p(Term) -> - string_p1(Term). - -string_p1([H|T]) when is_integer(H), H >= $\s, H < 255 -> - string_p1(T); -string_p1([$\n|T]) -> string_p1(T); -string_p1([$\r|T]) -> string_p1(T); -string_p1([$\t|T]) -> string_p1(T); -string_p1([$\v|T]) -> string_p1(T); -string_p1([$\b|T]) -> string_p1(T); -string_p1([$\f|T]) -> string_p1(T); -string_p1([$\e|T]) -> string_p1(T); -string_p1([H|T]) when is_list(H) -> - case string_p1(H) of - true -> string_p1(T); - _ -> false - end; -string_p1([]) -> true; -string_p1(_) -> false. +string_p1(FlatList) -> + io_lib:printable_list(FlatList). -spec limit_term(term()) -> term(). diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 6504174cbc..6e8f64d932 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -207,7 +207,7 @@ handle_call(stop, _From, Handle) -> {stop, normal, stopped, Handle}; handle_call(Request, From, Handle) -> - error_logger:error_msg("handle_call(~p, ~p, _)", [Request, From]), + error_logger:error_msg("handle_call(~tp, ~tp, _)", [Request, From]), {noreply, Handle}. %%---------------------------------------------------------------------- @@ -220,7 +220,7 @@ handle_call(Request, From, Handle) -> -spec handle_cast(term(), state()) -> {'noreply', state()}. handle_cast(Msg, State) -> - error_logger:error_msg("handle_cast(~p, _)", [Msg]), + error_logger:error_msg("handle_cast(~tp, _)", [Msg]), {noreply, State}. %%---------------------------------------------------------------------- @@ -243,7 +243,7 @@ handle_info({'EXIT', Handle, _Reason}, Handle) -> {stop, normal, Handle}; handle_info(Info, State) -> - error_logger:error_msg("handle_Info(~p, _)", [Info]), + error_logger:error_msg("handle_Info(~tp, _)", [Info]), {noreply, State}. %%---------------------------------------------------------------------- diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index a9e92b28b8..a38522eb5c 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -262,7 +262,7 @@ check_dupname(Name, Pid) -> {ok, allow} -> true; _ -> - S = "global: ~w registered under several names: ~w\n", + S = "global: ~w registered under several names: ~tw\n", Names = [Name | [Name1 || {_Pid, Name1} <- PidNames]], error_logger:error_msg(S, [Pid, Names]), false @@ -659,7 +659,7 @@ handle_call(stop, _From, S) -> handle_call(Request, From, S) -> error_logger:warning_msg("The global_name_server " "received an unexpected message:\n" - "handle_call(~p, ~p, _)\n", + "handle_call(~tp, ~tp, _)\n", [Request, From]), {noreply, S}. @@ -828,7 +828,7 @@ handle_cast({async_del_lock, _ResourceId, _Pid}, S) -> handle_cast(Request, S) -> error_logger:warning_msg("The global_name_server " "received an unexpected message:\n" - "handle_cast(~p, _)\n", [Request]), + "handle_cast(~tp, _)\n", [Request]), {noreply, S}. %%======================================================================== @@ -955,7 +955,7 @@ handle_info({'DOWN', MonitorRef, process, _Pid, _Info}, S0) -> handle_info(Message, S) -> error_logger:warning_msg("The global_name_server " "received an unexpected message:\n" - "handle_info(~p, _)\n", [Message]), + "handle_info(~tp, _)\n", [Message]), {noreply, S}. @@ -1949,13 +1949,13 @@ exchange_names([{Name, Pid, Method} | Tail], Node, Ops, Res) -> exchange_names(Tail, Node, [Op | Ops], [Op | Res]); {badrpc, Badrpc} -> error_logger:info_msg("global: badrpc ~w received when " - "conflicting name ~w was found\n", + "conflicting name ~tw was found\n", [Badrpc, Name]), Op = {insert, {Name, Pid, Method}}, exchange_names(Tail, Node, [Op | Ops], Res); Else -> error_logger:info_msg("global: Resolve method ~w for " - "conflicting name ~w returned ~w\n", + "conflicting name ~tw returned ~tw\n", [Method, Name, Else]), Op = {delete, Name}, exchange_names(Tail, Node, [Op | Ops], [Op | Res]) @@ -1984,7 +1984,7 @@ minmax(P1,P2) -> Pid2 :: pid(). random_exit_name(Name, Pid, Pid2) -> {Min, Max} = minmax(Pid, Pid2), - error_logger:info_msg("global: Name conflict terminating ~w\n", + error_logger:info_msg("global: Name conflict terminating ~tw\n", [{Name, Max}]), exit(Max, kill), Min. @@ -2200,7 +2200,7 @@ unexpected_message({'EXIT', _Pid, _Reason}, _What) -> ok; unexpected_message(Message, What) -> error_logger:warning_msg("The global_name_server ~w process " - "received an unexpected message:\n~p\n", + "received an unexpected message:\n~tp\n", [What, Message]). %%% Utilities diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index ddda396713..f36b4f1e6a 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -423,8 +423,8 @@ handle_call({connect, Type, Node}, From, State) -> {ok, SetupPid} -> Owners = [{SetupPid, Node} | State#state.conn_owners], {noreply,State#state{conn_owners=Owners}}; - _ -> - ?connect_failure(Node, {setup_call, failed}), + _Error -> + ?connect_failure(Node, {setup_call, failed, _Error}), async_reply({reply, false, State}, From) end end; @@ -778,7 +778,7 @@ handle_info(transition_period_end, {noreply,State#state{tick = #tick{ticker = Tckr, time = T}}}; handle_info(X, State) -> - error_msg("Net kernel got ~w~n",[X]), + error_msg("Net kernel got ~tw~n",[X]), {noreply,State}. %% ----------------------------------------------------------- diff --git a/lib/kernel/src/pg2.erl b/lib/kernel/src/pg2.erl index edf4aedde2..c4732f37ee 100644 --- a/lib/kernel/src/pg2.erl +++ b/lib/kernel/src/pg2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -199,7 +199,7 @@ handle_call({delete, Name}, _From, S) -> {reply, ok, S}; handle_call(Request, From, S) -> error_logger:warning_msg("The pg2 server received an unexpected message:\n" - "handle_call(~p, ~p, _)\n", + "handle_call(~tp, ~tp, _)\n", [Request, From]), {noreply, S}. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index b794d4f45e..99ea4210bd 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -175,6 +175,18 @@ server_loop(Iport, Oport, Curr, User, Gr, {Resp, IOQ} = IOQueue) -> {Iport,eof} -> Curr ! {self(),eof}, server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + + %% We always handle geometry and unicode requests + {Requester,tty_geometry} -> + Requester ! {self(),tty_geometry,get_tty_geometry(Iport)}, + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + {Requester,get_unicode_state} -> + Requester ! {self(),get_unicode_state,get_unicode_state(Iport)}, + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + {Requester,set_unicode_state, Bool} -> + Requester ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + Req when element(1,Req) =:= User orelse element(1,Req) =:= Curr, tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 -> %% We match {User|Curr,_}|{User|Curr,_,_} @@ -224,21 +236,16 @@ server_loop(Iport, Oport, Curr, User, Gr, {Resp, IOQ} = IOQueue) -> _ -> % not current, just remove it server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid), IOQueue) end; + {Requester, {put_chars_sync, _, _, Reply}} -> + %% We need to ack the Req otherwise originating process will hang forever + %% Do discard the output to non visible shells (as was done previously) + Requester ! {reply, Reply}, + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); _X -> - %% Ignore unknown messages. - server_loop(Iport, Oport, Curr, User, Gr, IOQueue) + %% Ignore unknown messages. + server_loop(Iport, Oport, Curr, User, Gr, IOQueue) end. -%% We always handle geometry and unicode requests -handle_req({Curr,tty_geometry},Iport,_Oport,IOQueue) -> - Curr ! {self(),tty_geometry,get_tty_geometry(Iport)}, - IOQueue; -handle_req({Curr,get_unicode_state},Iport,_Oport,IOQueue) -> - Curr ! {self(),get_unicode_state,get_unicode_state(Iport)}, - IOQueue; -handle_req({Curr,set_unicode_state, Bool},Iport,_Oport,IOQueue) -> - Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, - IOQueue; handle_req(next,Iport,Oport,{false,IOQ}=IOQueue) -> case queue:out(IOQ) of {empty,_} -> diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index b9942e899f..efe3a68531 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -148,8 +148,8 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(APP_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) kernel.spec kernel_smoke.spec $(EMAKEFILE)\ - $(COVERFILE) "$(RELSYSDIR)" + $(INSTALL_DATA) kernel.spec kernel_smoke.spec kernel_bench.spec \ + $(EMAKEFILE) $(COVERFILE) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/kernel/test/kernel_bench.spec b/lib/kernel/test/kernel_bench.spec new file mode 100644 index 0000000000..8de60dae31 --- /dev/null +++ b/lib/kernel/test/kernel_bench.spec @@ -0,0 +1 @@ +{groups,"../kernel_test",zlib_SUITE,[bench]}. diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index a44ef106d3..ae00d75460 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -21,60 +21,56 @@ -module(zlib_SUITE). -include_lib("common_test/include/ct.hrl"). - --compile(export_all). - --define(error(Format,Args), - put(test_server_loc,{?MODULE,?LINE}), - error(Format,Args,?MODULE,?LINE)). - -%% Learn erts team how to really write tests ;-) --define(m(ExpectedRes,Expr), - fun() -> - ACtual1 = (catch (Expr)), - try case ACtual1 of - ExpectedRes -> ACtual1 - end - catch - error:{case_clause,ACtuAl} -> - ?error("Not Matching Actual result was:~n ~p ~n", - [ACtuAl]), - ACtuAl - end - end()). - --define(BARG, {'EXIT',{badarg,[{zlib,_,_,_}|_]}}). --define(DATA_ERROR, {'EXIT',{data_error,[{zlib,_,_,_}|_]}}). - -init_per_testcase(_Func, Config) -> - Config. - -end_per_testcase(_Func, _Config) -> - ok. - -error(Format, Args, File, Line) -> - io:format("~p:~p: ERROR: " ++ Format, [File,Line|Args]), - group_leader() ! {failed, File, Line}. - -%% Hopefully I don't need this to get it to work with the testserver.. -%% Fail = #'REASON'{file = filename:basename(File), -%% line = Line, -%% desc = Args}, -%% case global:whereis_name(mnesia_test_case_sup) of -%% undefined -> -%% ignore; -%% Pid -> -%% Pid ! Fail -%% %% global:send(mnesia_test_case_sup, Fail), -%% end, -%% log("<>ERROR<>~n" ++ Format, Args, File, Line). +-include_lib("common_test/include/ct_event.hrl"). + +-export([suite/0, all/0, groups/0]). + +%% API group +-export([api_open_close/1]). +-export([api_deflateInit/1, api_deflateSetDictionary/1, api_deflateReset/1, + api_deflateParams/1, api_deflate/1, api_deflateEnd/1]). +-export([api_inflateInit/1, api_inflateReset/1, api_inflate2/1, api_inflate3/1, + api_inflateChunk/1, api_safeInflate/1, api_inflateEnd/1]). +-export([api_inflateSetDictionary/1, api_inflateGetDictionary/1]). +-export([api_crc32/1, api_adler32/1]). +-export([api_un_compress/1, api_un_zip/1, api_g_un_zip/1]). + +%% Examples group +-export([intro/1]). + +%% Usage group +-export([zip_usage/1, gz_usage/1, gz_usage2/1, compress_usage/1, + dictionary_usage/1, large_deflate/1, crc/1, adler/1, + only_allow_owner/1, sub_heap_binaries/1]). + +%% Bench group +-export([inflate_bench_zeroed/1, inflate_bench_rand/1, + deflate_bench_zeroed/1, deflate_bench_rand/1, + chunk_bench_zeroed/1, chunk_bench_rand/1]). + +%% Others +-export([smp/1, otp_9981/1, otp_7359/1]). + +-define(m(Guard, Expression), + fun() -> + Actual = (catch (Expression)), + case Actual of + Guard -> Actual; + _Other -> + ct:fail("Failed to match ~p, actual result was ~p", + [??Guard, Actual]) + end + end()). + +-define(EXIT(Reason), {'EXIT',{Reason,[{_,_,_,_}|_]}}). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. all() -> - [{group, api}, {group, examples}, {group, func}, smp, + [{group, api}, {group, examples}, {group, func}, + {group, bench}, smp, otp_9981, otp_7359]. @@ -84,28 +80,19 @@ groups() -> api_deflateSetDictionary, api_deflateReset, api_deflateParams, api_deflate, api_deflateEnd, api_inflateInit, api_inflateSetDictionary, api_inflateGetDictionary, - api_inflateSync, api_inflateReset, api_inflate, api_inflateChunk, - api_inflateEnd, api_setBufsz, api_getBufsz, api_crc32, - api_adler32, api_getQSize, api_un_compress, api_un_zip, + api_inflateReset, api_inflate2, api_inflate3, api_inflateChunk, + api_safeInflate, api_inflateEnd, api_crc32, + api_adler32, api_un_compress, api_un_zip, api_g_un_zip]}, {examples, [], [intro]}, {func, [], [zip_usage, gz_usage, gz_usage2, compress_usage, - dictionary_usage, large_deflate, crc, adler]}]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - + dictionary_usage, large_deflate, crc, adler, + only_allow_owner, sub_heap_binaries]}, + {bench, + [inflate_bench_zeroed, inflate_bench_rand, + deflate_bench_zeroed, deflate_bench_rand, + chunk_bench_zeroed, chunk_bench_rand]}]. %% Test open/0 and close/1. api_open_close(Config) when is_list(Config) -> @@ -113,7 +100,7 @@ api_open_close(Config) when is_list(Config) -> Fd2 = zlib:open(), ?m(false,Fd1 == Fd2), ?m(ok,zlib:close(Fd1)), - ?m(?BARG, zlib:close(Fd1)), + ?m(?EXIT(not_initialized), zlib:close(Fd1)), ?m(ok,zlib:close(Fd2)), %% Make sure that we don't get any EXIT messages if trap_exit is enabled. @@ -128,9 +115,11 @@ api_open_close(Config) when is_list(Config) -> %% Test deflateInit/2 and /6. api_deflateInit(Config) when is_list(Config) -> Z1 = zlib:open(), - ?m(?BARG, zlib:deflateInit(gurka, none)), - ?m(?BARG, zlib:deflateInit(gurka, gurka)), - ?m(?BARG, zlib:deflateInit(Z1, gurka)), + + ?m(?EXIT(badarg), zlib:deflateInit(gurka, none)), + + ?m(?EXIT(bad_compression_level), zlib:deflateInit(gurka, gurka)), + ?m(?EXIT(bad_compression_level), zlib:deflateInit(Z1, gurka)), Levels = [none, default, best_speed, best_compression] ++ lists:seq(0,9), lists:foreach(fun(Level) -> Z = zlib:open(), @@ -138,20 +127,30 @@ api_deflateInit(Config) when is_list(Config) -> ?m(ok,zlib:close(Z)) end, Levels), %% /6 - ?m(?BARG, zlib:deflateInit(Z1,gurka,deflated,-15,8,default)), - - ?m(?BARG, zlib:deflateInit(Z1,default,undefined,-15,8,default)), - - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,48,8,default)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-20,8,default)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-7,8,default)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,7,8,default)), - - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,0,default)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,10,default)), - - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,8,0)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,8,undefined)), + ?m(?EXIT(bad_compression_level), + zlib:deflateInit(Z1,gurka,deflated,-15,8,default)), + + ?m(?EXIT(bad_compression_method), + zlib:deflateInit(Z1,default,undefined,-15,8,default)), + + ?m(?EXIT(bad_compression_strategy), + zlib:deflateInit(Z1,default,deflated,-15,8,0)), + ?m(?EXIT(bad_compression_strategy), + zlib:deflateInit(Z1,default,deflated,-15,8,undefined)), + + ?m(?EXIT(bad_windowbits), + zlib:deflateInit(Z1,default,deflated,48,8,default)), + ?m(?EXIT(bad_windowbits), + zlib:deflateInit(Z1,default,deflated,-20,8,default)), + ?m(?EXIT(bad_windowbits), + zlib:deflateInit(Z1,default,deflated,-7,8,default)), + ?m(?EXIT(bad_windowbits), + zlib:deflateInit(Z1,default,deflated,7,8,default)), + + ?m(?EXIT(bad_memlevel), + zlib:deflateInit(Z1,default,deflated,-15,0,default)), + ?m(?EXIT(bad_memlevel), + zlib:deflateInit(Z1,default,deflated,-15,10,default)), lists:foreach(fun(Level) -> Z = zlib:open(), @@ -183,7 +182,11 @@ api_deflateInit(Config) when is_list(Config) -> ?m(ok,zlib:close(Z)) end, Strategies), ?m(ok, zlib:deflateInit(Z1,default,deflated,-15,8,default)), - ?m({'EXIT',_}, zlib:deflateInit(Z1,none,deflated,-15,8,default)), %% ?? + + %% Let it crash for any reason; we don't care about the order in which the + %% parameters are checked. + ?m(?EXIT(_), zlib:deflateInit(Z1,none,deflated,-15,8,default)), + ?m(ok, zlib:close(Z1)). %% Test deflateSetDictionary. @@ -192,17 +195,17 @@ api_deflateSetDictionary(Config) when is_list(Config) -> ?m(ok, zlib:deflateInit(Z1, default)), ?m(Id when is_integer(Id), zlib:deflateSetDictionary(Z1, <<1,1,2,3,4,5,1>>)), ?m(Id when is_integer(Id), zlib:deflateSetDictionary(Z1, [1,1,2,3,4,5,1])), - ?m(?BARG, zlib:deflateSetDictionary(Z1, gurka)), - ?m(?BARG, zlib:deflateSetDictionary(Z1, 128)), - ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), - ?m({'EXIT',{stream_error,_}},zlib:deflateSetDictionary(Z1,<<1,1,2,3,4,5,1>>)), + ?m(?EXIT(badarg), zlib:deflateSetDictionary(Z1, gurka)), + ?m(?EXIT(badarg), zlib:deflateSetDictionary(Z1, 128)), + ?m(L when is_list(L), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), + ?m(?EXIT(stream_error), zlib:deflateSetDictionary(Z1,<<1,1,2,3,4,5,1>>)), ?m(ok, zlib:close(Z1)). %% Test deflateReset. api_deflateReset(Config) when is_list(Config) -> Z1 = zlib:open(), ?m(ok, zlib:deflateInit(Z1, default)), - ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), + ?m(L when is_list(L), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), ?m(ok, zlib:deflateReset(Z1)), ?m(ok, zlib:deflateReset(Z1)), %% FIXME how do I make this go wrong?? @@ -212,9 +215,9 @@ api_deflateReset(Config) when is_list(Config) -> api_deflateParams(Config) when is_list(Config) -> Z1 = zlib:open(), ?m(ok, zlib:deflateInit(Z1, default)), - ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), + ?m(L when is_list(L), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), ?m(ok, zlib:deflateParams(Z1, best_compression, huffman_only)), - ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, sync)), + ?m(L when is_list(L), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, sync)), ?m(ok, zlib:close(Z1)). %% Test deflate. @@ -231,11 +234,13 @@ api_deflate(Config) when is_list(Config) -> ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, full)), ?m(B when is_list(B), zlib:deflate(Z1, <<>>, finish)), - ?m(?BARG, zlib:deflate(gurka, <<1,1,1,1,1,1,1,1,1>>, full)), - ?m(?BARG, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, asdj)), - ?m(?BARG, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, 198)), + ?m(?EXIT(badarg), zlib:deflate(gurka, <<1,1,1,1,1,1,1,1,1>>, full)), + + ?m(?EXIT(bad_flush_mode), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, asdj)), + ?m(?EXIT(bad_flush_mode), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, 198)), + %% Causes problems ERROR REPORT - ?m(?BARG, zlib:deflate(Z1, [asdj,asd], none)), + ?m(?EXIT(badarg), zlib:deflate(Z1, [asdj,asd], none)), ?m(ok, zlib:close(Z1)). @@ -244,11 +249,11 @@ api_deflateEnd(Config) when is_list(Config) -> Z1 = zlib:open(), ?m(ok, zlib:deflateInit(Z1, default)), ?m(ok, zlib:deflateEnd(Z1)), - ?m({'EXIT', {einval,_}}, zlib:deflateEnd(Z1)), %% ?? - ?m(?BARG, zlib:deflateEnd(gurka)), + ?m(?EXIT(not_initialized), zlib:deflateEnd(Z1)), + ?m(?EXIT(badarg), zlib:deflateEnd(gurka)), ?m(ok, zlib:deflateInit(Z1, default)), ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>)), - ?m({'EXIT', {data_error,_}}, zlib:deflateEnd(Z1)), + ?m(?EXIT(data_error), zlib:deflateEnd(Z1)), ?m(ok, zlib:deflateInit(Z1, default)), ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>)), ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>, finish)), @@ -259,9 +264,9 @@ api_deflateEnd(Config) when is_list(Config) -> %% Test inflateInit /1 and /2. api_inflateInit(Config) when is_list(Config) -> Z1 = zlib:open(), - ?m(?BARG, zlib:inflateInit(gurka)), + ?m(?EXIT(badarg), zlib:inflateInit(gurka)), ?m(ok, zlib:inflateInit(Z1)), - ?m({'EXIT',{einval,_}}, zlib:inflateInit(Z1, 15)), %% ?? + ?m(?EXIT(already_initialized), zlib:inflateInit(Z1, 15)), lists:foreach(fun(Wbits) -> Z11 = zlib:open(), ?m(ok, zlib:inflateInit(Z11,Wbits)), @@ -270,33 +275,34 @@ api_inflateInit(Config) when is_list(Config) -> ?m(ok,zlib:close(Z11)), ?m(ok,zlib:close(Z12)) end, lists:seq(8,15)), - ?m(?BARG, zlib:inflateInit(gurka, -15)), - ?m(?BARG, zlib:inflateInit(Z1, 7)), - ?m(?BARG, zlib:inflateInit(Z1, -7)), - ?m(?BARG, zlib:inflateInit(Z1, 48)), - ?m(?BARG, zlib:inflateInit(Z1, -16)), + ?m(?EXIT(badarg), zlib:inflateInit(gurka, -15)), + ?m(?EXIT(already_initialized), zlib:inflateInit(Z1, 7)), + ?m(?EXIT(already_initialized), zlib:inflateInit(Z1, -7)), + ?m(?EXIT(already_initialized), zlib:inflateInit(Z1, 48)), + ?m(?EXIT(already_initialized), zlib:inflateInit(Z1, -16)), ?m(ok, zlib:close(Z1)). %% Test inflateSetDictionary. api_inflateSetDictionary(Config) when is_list(Config) -> Z1 = zlib:open(), ?m(ok, zlib:inflateInit(Z1)), - ?m(?BARG, zlib:inflateSetDictionary(gurka,<<1,1,1,1,1>>)), - ?m(?BARG, zlib:inflateSetDictionary(Z1,102)), - ?m(?BARG, zlib:inflateSetDictionary(Z1,gurka)), + ?m(?EXIT(badarg), zlib:inflateSetDictionary(gurka,<<1,1,1,1,1>>)), + ?m(?EXIT(badarg), zlib:inflateSetDictionary(Z1,102)), + ?m(?EXIT(badarg), zlib:inflateSetDictionary(Z1,gurka)), Dict = <<1,1,1,1,1>>, - ?m({'EXIT',{stream_error,_}}, zlib:inflateSetDictionary(Z1,Dict)), + ?m(?EXIT(stream_error), zlib:inflateSetDictionary(Z1,Dict)), ?m(ok, zlib:close(Z1)). %% Test inflateGetDictionary. api_inflateGetDictionary(Config) when is_list(Config) -> Z1 = zlib:open(), + zlib:inflateInit(Z1), IsOperationSupported = case catch zlib:inflateGetDictionary(Z1) of - {'EXIT',{einval,_}} -> true; - {'EXIT',{enotsup,_}} -> false + ?EXIT(not_supported) -> false; + _ -> true end, - _ = zlib:close(Z1), + zlib:close(Z1), api_inflateGetDictionary_if_supported(IsOperationSupported). api_inflateGetDictionary_if_supported(false) -> @@ -306,64 +312,53 @@ api_inflateGetDictionary_if_supported(true) -> Z1 = zlib:open(), ?m(ok, zlib:deflateInit(Z1)), Dict = <<"foobar barfoo foo bar far boo">>, - ?m(_, zlib:deflateSetDictionary(Z1, Dict)), + Checksum = zlib:deflateSetDictionary(Z1, Dict), Payload = <<"foobarbarbar">>, Compressed = zlib:deflate(Z1, Payload, finish), ?m(ok, zlib:close(Z1)), - % Decompress and test dictionary extraction + % Decompress and test dictionary extraction with inflate/2 Z2 = zlib:open(), ?m(ok, zlib:inflateInit(Z2)), ?m(<<>>, iolist_to_binary(zlib:inflateGetDictionary(Z2))), - ?m({'EXIT',{stream_error,_}}, zlib:inflateSetDictionary(Z2, Dict)), - ?m({'EXIT',{{need_dictionary,_},_}}, zlib:inflate(Z2, Compressed)), + ?m(?EXIT(stream_error), zlib:inflateSetDictionary(Z2, Dict)), + ?m(?EXIT({need_dictionary,Checksum}), zlib:inflate(Z2, Compressed)), ?m(ok, zlib:inflateSetDictionary(Z2, Dict)), ?m(Dict, iolist_to_binary(zlib:inflateGetDictionary(Z2))), - ?m(Payload, iolist_to_binary(zlib:inflate(Z2, Compressed))), + Payload = iolist_to_binary(zlib:inflate(Z2, [])), ?m(ok, zlib:close(Z2)), - ?m(?BARG, zlib:inflateSetDictionary(Z2, Dict)), - ok. + ?m(?EXIT(not_initialized), zlib:inflateSetDictionary(Z2, Dict)), -%% Test inflateSync. -api_inflateSync(Config) when is_list(Config) -> - {skip,"inflateSync/1 sucks"}. -%% Z1 = zlib:open(), -%% ?m(ok, zlib:deflateInit(Z1)), -%% B1list0 = zlib:deflate(Z1, "gurkan gurra ger galna tunnor", full), -%% B2 = zlib:deflate(Z1, "grodan boll", finish), -%% io:format("~p\n", [B1list0]), -%% io:format("~p\n", [B2]), -%% ?m(ok, zlib:deflateEnd(Z1)), -%% B1 = clobber(14, list_to_binary(B1list0)), -%% Compressed = list_to_binary([B1,B2]), -%% io:format("~p\n", [Compressed]), - -%% ?m(ok, zlib:inflateInit(Z1)), -%% ?m(?BARG, zlib:inflateSync(gurka)), -%% ?m({'EXIT',{data_error,_}}, zlib:inflate(Z1, Compressed)), -%% ?m(ok, zlib:inflateSync(Z1)), -%% Ubs = zlib:inflate(Z1, []), -%% <<"grodan boll">> = list_to_binary(Ubs), -%% ?m(ok, zlib:close(Z1)). - -clobber(N, Bin) when is_binary(Bin) -> - T = list_to_tuple(binary_to_list(Bin)), - Byte = case element(N, T) of - 255 -> 254; - B -> B+1 - end, - list_to_binary(tuple_to_list(setelement(N, T, Byte))). + %% ... And do the same for inflate/3 + Z3 = zlib:open(), + ?m(ok, zlib:inflateInit(Z3)), + ?m(<<>>, iolist_to_binary(zlib:inflateGetDictionary(Z3))), + ?m(?EXIT(stream_error), zlib:inflateSetDictionary(Z3, Dict)), + + {need_dictionary, Checksum, _Output = []} = + zlib:inflate(Z3, Compressed, [{exception_on_need_dict, false}]), + + ?m(ok, zlib:inflateSetDictionary(Z3, Dict)), + ?m(Dict, iolist_to_binary(zlib:inflateGetDictionary(Z3))), + + Payload = iolist_to_binary( + zlib:inflate(Z3, [], [{exception_on_need_dict, false}])), + + ?m(ok, zlib:close(Z3)), + ?m(?EXIT(not_initialized), zlib:inflateSetDictionary(Z3, Dict)), + + ok. %% Test inflateReset. api_inflateReset(Config) when is_list(Config) -> Z1 = zlib:open(), ?m(ok, zlib:inflateInit(Z1)), - ?m(?BARG, zlib:inflateReset(gurka)), + ?m(?EXIT(badarg), zlib:inflateReset(gurka)), ?m(ok, zlib:inflateReset(Z1)), ?m(ok, zlib:close(Z1)). -%% Test inflate. -api_inflate(Config) when is_list(Config) -> +%% Test inflate/2 +api_inflate2(Config) when is_list(Config) -> Data = [<<1,2,2,3,3,3,4,4,4,4>>], Compressed = zlib:compress(Data), Z1 = zlib:open(), @@ -373,12 +368,32 @@ api_inflate(Config) when is_list(Config) -> ?m(ok, zlib:inflateEnd(Z1)), ?m(ok, zlib:inflateInit(Z1)), ?m(Data, zlib:inflate(Z1, Compressed)), - ?m(?BARG, zlib:inflate(gurka, Compressed)), - ?m(?BARG, zlib:inflate(Z1, 4384)), - ?m(?BARG, zlib:inflate(Z1, [atom_list])), + ?m(?EXIT(badarg), zlib:inflate(gurka, Compressed)), + ?m(?EXIT(badarg), zlib:inflate(Z1, 4384)), + ?m(?EXIT(badarg), zlib:inflate(Z1, [atom_list])), + ?m(ok, zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), + ?m(?EXIT(data_error), zlib:inflate(Z1, <<2,1,2,1,2>>)), + ?m(ok, zlib:close(Z1)). + +%% Test inflate/3; same as inflate/2 but with the default options inverted. +api_inflate3(Config) when is_list(Config) -> + Data = [<<1,2,2,3,3,3,4,4,4,4>>], + Options = [{exception_on_need_dict, false}], + Compressed = zlib:compress(Data), + Z1 = zlib:open(), + ?m(ok, zlib:inflateInit(Z1)), + ?m([], zlib:inflate(Z1, <<>>, Options)), + ?m(Data, zlib:inflate(Z1, Compressed)), + ?m(ok, zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), + ?m(Data, zlib:inflate(Z1, Compressed, Options)), + ?m(?EXIT(badarg), zlib:inflate(gurka, Compressed, Options)), + ?m(?EXIT(badarg), zlib:inflate(Z1, 4384, Options)), + ?m(?EXIT(badarg), zlib:inflate(Z1, [atom_list], Options)), ?m(ok, zlib:inflateEnd(Z1)), ?m(ok, zlib:inflateInit(Z1)), - ?m({'EXIT',{data_error,_}}, zlib:inflate(Z1, <<2,1,2,1,2>>)), + ?m(?EXIT(data_error), zlib:inflate(Z1, <<2,1,2,1,2>>, Options)), ?m(ok, zlib:close(Z1)). %% Test inflateChunk. @@ -388,69 +403,105 @@ api_inflateChunk(Config) when is_list(Config) -> Part1 = binary:part(Data, 0, ChunkSize), Part2 = binary:part(Data, ChunkSize, ChunkSize), Part3 = binary:part(Data, ChunkSize * 2, ChunkSize), + Compressed = zlib:compress(Data), Z1 = zlib:open(), + zlib:setBufSize(Z1, ChunkSize), + ?m(ok, zlib:inflateInit(Z1)), - ?m([], zlib:inflateChunk(Z1, <<>>)), - ?m({more, Part1}, zlib:inflateChunk(Z1, Compressed)), - ?m({more, Part2}, zlib:inflateChunk(Z1)), - ?m(Part3, zlib:inflateChunk(Z1)), - ?m(ok, zlib:inflateEnd(Z1)), + 0 = iolist_size(zlib:inflateChunk(Z1, <<>>)), + + {more, Part1AsIOList} = zlib:inflateChunk(Z1, Compressed), + {more, Part2AsIOList} = zlib:inflateChunk(Z1), + {more, Part3AsIOList} = zlib:inflateChunk(Z1), + [] = zlib:inflateChunk(Z1), + + ?m(Part1, iolist_to_binary(Part1AsIOList)), + ?m(Part2, iolist_to_binary(Part2AsIOList)), + ?m(Part3, iolist_to_binary(Part3AsIOList)), + + ?m(ok, zlib:inflateEnd(Z1)), ?m(ok, zlib:inflateInit(Z1)), - ?m({more, Part1}, zlib:inflateChunk(Z1, Compressed)), + + ?m({more, Part1AsIOList}, zlib:inflateChunk(Z1, Compressed)), ?m(ok, zlib:inflateReset(Z1)), - zlib:setBufSize(Z1, size(Data)), - ?m(Data, zlib:inflateChunk(Z1, Compressed)), - ?m(ok, zlib:inflateEnd(Z1)), + zlib:setBufSize(Z1, byte_size(Data) + 1), + DataAsIOList = zlib:inflateChunk(Z1, Compressed), + ?m(Data, iolist_to_binary(DataAsIOList)), + + ?m(ok, zlib:inflateEnd(Z1)), ?m(ok, zlib:inflateInit(Z1)), - ?m(?BARG, zlib:inflateChunk(gurka, Compressed)), - ?m(?BARG, zlib:inflateChunk(Z1, 4384)), - ?m({'EXIT',{data_error,_}}, zlib:inflateEnd(Z1)), + + ?m(?EXIT(badarg), zlib:inflateChunk(gurka, Compressed)), + ?m(?EXIT(badarg), zlib:inflateChunk(Z1, 4384)), + + ?m(?EXIT(data_error), zlib:inflateEnd(Z1)), + ?m(ok, zlib:close(Z1)). -%% Test inflateEnd. -api_inflateEnd(Config) when is_list(Config) -> +%% Test safeInflate as a mirror of inflateChunk, but ignore the stuff about +%% exact chunk sizes. +api_safeInflate(Config) when is_list(Config) -> + Data = << <<(I rem 150)>> || I <- lists:seq(1, 20 bsl 10) >>, + Compressed = zlib:compress(Data), Z1 = zlib:open(), - ?m({'EXIT',{einval,_}}, zlib:inflateEnd(Z1)), - ?m(ok, zlib:inflateInit(Z1)), - ?m(?BARG, zlib:inflateEnd(gurka)), - ?m({'EXIT',{data_error,_}}, zlib:inflateEnd(Z1)), - ?m({'EXIT',{einval,_}}, zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), - ?m(B when is_list(B), zlib:inflate(Z1, zlib:compress("abc"))), + + SafeInflateLoop = + fun + Loop({continue, Chunk}, Output) -> + Loop(zlib:safeInflate(Z1, []), [Output, Chunk]); + Loop({finished, Chunk}, Output) -> + [Output, Chunk] + end, + + Decompressed = SafeInflateLoop(zlib:safeInflate(Z1, Compressed), []), + Data = iolist_to_binary(Decompressed), + ?m(ok, zlib:inflateEnd(Z1)), - ?m(ok, zlib:close(Z1)). + ?m(ok, zlib:inflateInit(Z1)), -%% Test getBufsz. -api_getBufsz(Config) when is_list(Config) -> - Z1 = zlib:open(), - ?m(Val when is_integer(Val), zlib:getBufSize(Z1)), - ?m(?BARG, zlib:getBufSize(gurka)), - ?m(ok, zlib:close(Z1)). + {continue, Partial} = zlib:safeInflate(Z1, Compressed), + PBin = iolist_to_binary(Partial), + PSize = byte_size(PBin), + <<PBin:PSize/binary, Rest/binary>> = Data, -%% Test setBufsz. -api_setBufsz(Config) when is_list(Config) -> - Z1 = zlib:open(), - ?m(?BARG, zlib:setBufSize(Z1, gurka)), - ?m(?BARG, zlib:setBufSize(gurka, 1232330)), - Sz = ?m( Val when is_integer(Val), zlib:getBufSize(Z1)), - ?m(ok, zlib:setBufSize(Z1, Sz*2)), - DSz = Sz*2, - ?m(DSz, zlib:getBufSize(Z1)), + ?m(ok, zlib:inflateReset(Z1)), + + {continue, Partial} = zlib:safeInflate(Z1, Compressed), + PBin = iolist_to_binary(Partial), + PSize = byte_size(PBin), + <<PBin:PSize/binary, Rest/binary>> = Data, + + ?m(ok, zlib:inflateReset(Z1)), + + SafeInflateLoop(zlib:safeInflate(Z1, Compressed), []), + + ?m(?EXIT(data_error), zlib:safeInflate(Z1, Compressed)), + + ?m(ok, zlib:inflateReset(Z1)), + ?m(?EXIT(badarg), zlib:safeInflate(gurka, Compressed)), + ?m(?EXIT(badarg), zlib:safeInflate(Z1, 4384)), + ?m(?EXIT(data_error), zlib:inflateEnd(Z1)), ?m(ok, zlib:close(Z1)). -%%% Debug function ?? -%% Test getQSize. -api_getQSize(Config) when is_list(Config) -> +%% Test inflateEnd. +api_inflateEnd(Config) when is_list(Config) -> Z1 = zlib:open(), - Q = ?m(Val when is_integer(Val), zlib:getQSize(Z1)), - io:format("QSize ~p ~n", [Q]), - ?m(?BARG, zlib:getQSize(gurka)), + ?m(?EXIT(not_initialized), zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), + ?m(?EXIT(badarg), zlib:inflateEnd(gurka)), + ?m(?EXIT(data_error), zlib:inflateEnd(Z1)), + ?m(?EXIT(not_initialized), zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), + ?m(B when is_list(B), zlib:inflate(Z1, zlib:compress("abc"))), + ?m(ok, zlib:inflateEnd(Z1)), ?m(ok, zlib:close(Z1)). %% Test crc32. @@ -458,8 +509,8 @@ api_crc32(Config) when is_list(Config) -> Z1 = zlib:open(), ?m(ok, zlib:deflateInit(Z1,best_speed,deflated,-15,8,default)), Bin = <<1,1,1,1,1,1,1,1,1>>, - Compressed1 = ?m(_, zlib:deflate(Z1, Bin, none)), - Compressed2 = ?m(_, zlib:deflate(Z1, <<>>, finish)), + Compressed1 = ?m(L when is_list(L), zlib:deflate(Z1, Bin, none)), + Compressed2 = ?m(L when is_list(L), zlib:deflate(Z1, <<>>, finish)), Compressed = list_to_binary(Compressed1 ++ Compressed2), CRC1 = ?m( CRC1 when is_integer(CRC1), zlib:crc32(Z1)), ?m(CRC1 when is_integer(CRC1), zlib:crc32(Z1,Bin)), @@ -467,15 +518,15 @@ api_crc32(Config) when is_list(Config) -> ?m(CRC2 when is_integer(CRC2), zlib:crc32(Z1,Compressed)), CRC2 = ?m(CRC2 when is_integer(CRC2), zlib:crc32(Z1,0,Compressed)), ?m(CRC3 when CRC2 /= CRC3, zlib:crc32(Z1,234,Compressed)), - ?m(?BARG, zlib:crc32(gurka)), - ?m(?BARG, zlib:crc32(Z1, not_a_binary)), - ?m(?BARG, zlib:crc32(gurka, <<1,1,2,4,4>>)), - ?m(?BARG, zlib:crc32(Z1, 2298929, not_a_binary)), - ?m(?BARG, zlib:crc32(Z1, not_an_int, <<123,123,123,35,231>>)), - ?m(?BARG, zlib:crc32_combine(Z1, not_an_int, 123123, 123)), - ?m(?BARG, zlib:crc32_combine(Z1, noint, 123123, 123)), - ?m(?BARG, zlib:crc32_combine(Z1, 123123, noint, 123)), - ?m(?BARG, zlib:crc32_combine(Z1, 123123, 123, noint)), + ?m(?EXIT(badarg), zlib:crc32(gurka)), + ?m(?EXIT(badarg), zlib:crc32(Z1, not_a_binary)), + ?m(?EXIT(badarg), zlib:crc32(gurka, <<1,1,2,4,4>>)), + ?m(?EXIT(badarg), zlib:crc32(Z1, 2298929, not_a_binary)), + ?m(?EXIT(badarg), zlib:crc32(Z1, not_an_int, <<123,123,123,35,231>>)), + ?m(?EXIT(badarg), zlib:crc32_combine(Z1, not_an_int, 123123, 123)), + ?m(?EXIT(badarg), zlib:crc32_combine(Z1, noint, 123123, 123)), + ?m(?EXIT(badarg), zlib:crc32_combine(Z1, 123123, noint, 123)), + ?m(?EXIT(badarg), zlib:crc32_combine(Z1, 123123, 123, noint)), ?m(ok, zlib:deflateEnd(Z1)), ?m(ok, zlib:close(Z1)). @@ -484,74 +535,115 @@ api_adler32(Config) when is_list(Config) -> Z1 = zlib:open(), ?m(ok, zlib:deflateInit(Z1,best_speed,deflated,-15,8,default)), Bin = <<1,1,1,1,1,1,1,1,1>>, - Compressed1 = ?m(_, zlib:deflate(Z1, Bin, none)), - Compressed2 = ?m(_, zlib:deflate(Z1, <<>>, finish)), + Compressed1 = ?m(L when is_list(L), zlib:deflate(Z1, Bin, none)), + Compressed2 = ?m(L when is_list(L), zlib:deflate(Z1, <<>>, finish)), Compressed = list_to_binary(Compressed1 ++ Compressed2), ?m(ADLER1 when is_integer(ADLER1), zlib:adler32(Z1,Bin)), ?m(ADLER1 when is_integer(ADLER1), zlib:adler32(Z1,binary_to_list(Bin))), ADLER2 = ?m(ADLER2 when is_integer(ADLER2), zlib:adler32(Z1,Compressed)), ?m(ADLER2 when is_integer(ADLER2), zlib:adler32(Z1,1,Compressed)), ?m(ADLER3 when ADLER2 /= ADLER3, zlib:adler32(Z1,234,Compressed)), - ?m(?BARG, zlib:adler32(Z1, not_a_binary)), - ?m(?BARG, zlib:adler32(gurka, <<1,1,2,4,4>>)), - ?m(?BARG, zlib:adler32(Z1, 2298929, not_a_binary)), - ?m(?BARG, zlib:adler32(Z1, not_an_int, <<123,123,123,35,231>>)), - ?m(?BARG, zlib:adler32_combine(Z1, noint, 123123, 123)), - ?m(?BARG, zlib:adler32_combine(Z1, 123123, noint, 123)), - ?m(?BARG, zlib:adler32_combine(Z1, 123123, 123, noint)), + ?m(?EXIT(badarg), zlib:adler32(Z1, not_a_binary)), + ?m(?EXIT(badarg), zlib:adler32(gurka, <<1,1,2,4,4>>)), + ?m(?EXIT(badarg), zlib:adler32(Z1, 2298929, not_a_binary)), + ?m(?EXIT(badarg), zlib:adler32(Z1, not_an_int, <<123,123,123,35,231>>)), + ?m(?EXIT(badarg), zlib:adler32_combine(Z1, noint, 123123, 123)), + ?m(?EXIT(badarg), zlib:adler32_combine(Z1, 123123, noint, 123)), + ?m(?EXIT(badarg), zlib:adler32_combine(Z1, 123123, 123, noint)), ?m(ok, zlib:deflateEnd(Z1)), ?m(ok, zlib:close(Z1)). %% Test compress. api_un_compress(Config) when is_list(Config) -> - ?m(?BARG,zlib:compress(not_a_binary)), + ?m(?EXIT(badarg),zlib:compress(not_a_binary)), Bin = <<1,11,1,23,45>>, Comp = zlib:compress(Bin), - ?m(?BARG,zlib:uncompress(not_a_binary)), - ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<171,171,171,171,171>>)), - ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<>>)), - ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120>>)), - ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156>>)), - ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156,3>>)), - ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156,3,0>>)), - ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<0,156,3,0,0,0,0,1>>)), + ?m(?EXIT(badarg),zlib:uncompress(not_a_binary)), + ?m(?EXIT(data_error), zlib:uncompress(<<171,171,171,171,171>>)), + ?m(?EXIT(data_error), zlib:uncompress(<<>>)), + ?m(?EXIT(data_error), zlib:uncompress(<<120>>)), + ?m(?EXIT(data_error), zlib:uncompress(<<120,156>>)), + ?m(?EXIT(data_error), zlib:uncompress(<<120,156,3>>)), + ?m(?EXIT(data_error), zlib:uncompress(<<120,156,3,0>>)), + ?m(?EXIT(data_error), zlib:uncompress(<<0,156,3,0,0,0,0,1>>)), ?m(Bin, zlib:uncompress(binary_to_list(Comp))), ?m(Bin, zlib:uncompress(Comp)). %% Test zip. api_un_zip(Config) when is_list(Config) -> - ?m(?BARG,zlib:zip(not_a_binary)), + ?m(?EXIT(badarg),zlib:zip(not_a_binary)), Bin = <<1,11,1,23,45>>, Comp = zlib:zip(Bin), ?m(Comp, zlib:zip(binary_to_list(Bin))), - ?m(?BARG,zlib:unzip(not_a_binary)), - ?m({'EXIT',{data_error,_}}, zlib:unzip(<<171,171,171,171,171>>)), - ?m({'EXIT',{data_error,_}}, zlib:unzip(<<>>)), + ?m(?EXIT(badarg),zlib:unzip(not_a_binary)), + ?m(?EXIT(data_error), zlib:unzip(<<171,171,171,171,171>>)), + ?m(?EXIT(data_error), zlib:unzip(<<>>)), ?m(Bin, zlib:unzip(Comp)), ?m(Bin, zlib:unzip(binary_to_list(Comp))), %% OTP-6396 - B = <<131,104,19,100,0,13,99,95,99,105,100,95,99,115,103,115,110,95,50,97,1,107,0,4,208,161,246,29,107,0,3,237,166,224,107,0,6,66,240,153,0,2,10,1,0,8,97,116,116,97,99,104,101,100,104,2,100,0,22,117,112,100,97,116,101,95,112,100,112,95,99,111,110,116,101,120,116,95,114,101,113,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,197,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,5,0,33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,1,114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4,103,112,114,115,8,0,104,2,104,2,100,0,8,97,99,116,105,118,97,116,101,104,23,100,0,11,112,100,112,95,99,111,110,116,1,120,116,100,0,7,112,114,105,109,97,114,121,97,1,100,0,9,117,110,100,101,102,105,110,101,100,97,1,97,4,97,4,97,7,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,10100,100,0,9,117,110,100,101,102,105,110,101,100,100,0,5,102,97,108,115,101,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,1,101,100,97,0,100,0,9,117,110,100,101,102,105,110,101,100,107,0,4,16,0,1,144,107,0,4,61,139,186,181,107,0,4,10,8,201,49,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,0,101,100,100,0,9,117,110,100,101,102,105,110,101,100,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,21,106,108,0,0,0,3,104,2,97,1,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,167,20,104,2,97,4,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,21,104,2,97,10,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,26,106,100,0,5,118,101,114,57,57,100,0,9,117,110,0,101,102,105,110,101,100,107,0,2,0,244,107,0,4,10,6,102,195,107,0,4,10,6,102,195,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,107,0,125,248,143,0,203,25115,157,116,65,185,65,172,55,87,164,88,225,50,203,251,115,157,116,65,185,65,172,55,87,164,88,225,50,0,0,82,153,50,0,200,98,87,148,237,193,185,65,149,167,69,144,14,16,153,50,3,81,70,94,13,109,193,1,120,5,181,113,198,118,50,3,81,70,94,13,109,193,185,120,5,181,113,198,118,153,3,81,70,94,13,109,193,185,120,5,181,113,198,118,153,50,16,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,113,92,2,119,128,0,0,108,0,0,1,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,11,97,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,0,33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,101,114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4,103,112,114,115,8,0,106>>, + B = + <<131,104,19,100,0,13,99,95,99,105,100,95,99,115,103,115,110,95,50,97, + 1,107,0,4,208,161,246,29,107,0,3,237,166,224,107,0,6,66,240,153,0,2, + 10,1,0,8,97,116,116,97,99,104,101,100,104,2,100,0,22,117,112,100,97, + 116,101,95,112,100,112,95,99,111,110,116,101,120,116,95,114,101,113, + 107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,197, + 31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73, + 64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,5,0,33,4,4,10 + ,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,1,114,45,97, + 112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4, + 103,112,114,115,8,0,104,2,104,2,100,0,8,97,99,116,105,118,97,116,101, + 104,23,100,0,11,112,100,112,95,99,111,110,116,1,120,116,100,0,7,112, + 114,105,109,97,114,121,97,1,100,0,9,117,110,100,101,102,105,110,101, + 100,97,1,97,4,97,4,97,7,100,0,9,117,110,100,101,102,105,110,101,100, + 100,0,9,117,110,100,101,102,105,110,10100,100,0,9,117,110,100,101, + 102,105,110,101,100,100,0,5,102,97,108,115,101,100,0,9,117,110,100, + 101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100, + 100,0,9,117,110,100,101,102,105,1,101,100,97,0,100,0,9,117,110,100, + 101,102,105,110,101,100,107,0,4,16,0,1,144,107,0,4,61,139,186,181, + 107,0,4,10,8,201,49,100,0,9,117,110,100,101,102,105,110,101,100,100, + 0,9,117,110,100,101,102,105,0,101,100,100,0,9,117,110,100,101,102, + 105,110,101,100,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97, + 16,97,21,106,108,0,0,0,3,104,2,97,1,104,2,104,3,98,0,0,7,214,97,11, + 97,20,104,3,97,17,97,167,20,104,2,97,4,104,2,104,3,98,0,0,7,214,97, + 11,97,20,104,3,97,17,97,16,97,21,104,2,97,10,104,2,104,3,98,0,0,7, + 214,97,11,97,20,104,3,97,17,97,16,97,26,106,100,0,5,118,101,114,57, + 57,100,0,9,117,110,0,101,102,105,110,101,100,107,0,2,0,244,107,0,4, + 10,6,102,195,107,0,4,10,6,102,195,100,0,9,117,110,100,101,102,105, + 110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,107,0,125, + 248,143,0,203,25115,157,116,65,185,65,172,55,87,164,88,225,50,203, + 251,115,157,116,65,185,65,172,55,87,164,88,225,50,0,0,82,153,50,0, + 200,98,87,148,237,193,185,65,149,167,69,144,14,16,153,50,3,81,70,94, + 13,109,193,1,120,5,181,113,198,118,50,3,81,70,94,13,109,193,185,120, + 5,181,113,198,118,153,3,81,70,94,13,109,193,185,120,5,181,113,198, + 118,153,50,16,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,113,92,2,119,128,0,0, + 108,0,0,1,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104, + 12,3,11,97,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64, + 104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,0, + 33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,101, + 114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99, + 50,52,48,4,103,112,114,115,8,0,106>>, + Z = zlib:zip(B), ?m(B, zlib:unzip(Z)). %% Test gunzip. api_g_un_zip(Config) when is_list(Config) -> - ?m(?BARG,zlib:gzip(not_a_binary)), + ?m(?EXIT(badarg),zlib:gzip(not_a_binary)), Bin = <<1,11,1,23,45>>, Comp = zlib:gzip(Bin), ?m(Comp, zlib:gzip(binary_to_list(Bin))), - ?m(?BARG, zlib:gunzip(not_a_binary)), - ?m(?DATA_ERROR, zlib:gunzip(<<171,171,171,171,171>>)), - ?m(?DATA_ERROR, zlib:gunzip(<<>>)), + ?m(?EXIT(badarg), zlib:gunzip(not_a_binary)), + ?m(?EXIT(data_error), zlib:gunzip(<<171,171,171,171,171>>)), + ?m(?EXIT(data_error), zlib:gunzip(<<>>)), ?m(Bin, zlib:gunzip(Comp)), ?m(Bin, zlib:gunzip(binary_to_list(Comp))), %% Bad CRC; bad length. BadCrc = bad_crc_data(), - ?m({'EXIT',{data_error,_}},(catch zlib:gunzip(BadCrc))), + ?m(?EXIT(data_error),(catch zlib:gunzip(BadCrc))), BadLen = bad_len_data(), - ?m({'EXIT',{data_error,_}},(catch zlib:gunzip(BadLen))), + ?m(?EXIT(data_error),(catch zlib:gunzip(BadLen))), ok. bad_crc_data() -> @@ -594,30 +686,15 @@ intro(Config) when is_list(Config) -> large_deflate(Config) when is_list(Config) -> large_deflate_do(). large_deflate_do() -> - Z = zlib:open(), - Plain = rand_bytes(zlib:getBufSize(Z)*5), - ok = zlib:deflateInit(Z), - _ZlibHeader = zlib:deflate(Z, [], full), - Deflated = zlib:deflate(Z, Plain, full), - ?m(ok, zlib:close(Z)), - ?m(Plain, zlib:unzip(list_to_binary([Deflated, 3, 0]))). - -rand_bytes(Sz) -> - L = <<8,2,3,6,1,2,3,2,3,4,8,7,3,7,2,3,4,7,5,8,9,3>>, - rand_bytes(erlang:md5(L),Sz). - -rand_bytes(Bin, Sz) when byte_size(Bin) >= Sz -> - <<Res:Sz/binary, _/binary>> = Bin, - Res; -rand_bytes(Bin, Sz) -> - rand_bytes(<<(erlang:md5(Bin))/binary, Bin/binary>>, Sz). - + Plain = gen_determ_rand_bytes(64 bsl 10), + Deflated = zlib:zip(Plain), + ?m(Plain, zlib:unzip(Deflated)). %% Test a standard compressed zip file. zip_usage(Config) when is_list(Config) -> zip_usage(zip_usage({get_arg,Config})); zip_usage({get_arg,Config}) -> - Out = conf(data_dir,Config), + Out = get_data_dir(Config), {ok,ZIP} = file:read_file(filename:join(Out,"zipdoc.zip")), {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")), {run,ZIP,ORIG}; @@ -688,7 +765,7 @@ zip_usage({run,ZIP,ORIG}) -> gz_usage(Config) when is_list(Config) -> gz_usage(gz_usage({get_arg,Config})); gz_usage({get_arg,Config}) -> - Out = conf(data_dir,Config), + Out = get_data_dir(Config), {ok,GZIP} = file:read_file(filename:join(Out,"zipdoc.1.gz")), {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")), {ok,GZIP2} = file:read_file(filename:join(Out,"zipdoc.txt.gz")), @@ -709,7 +786,7 @@ gz_usage2(Config) -> case os:find_executable("gzip") of Name when is_list(Name) -> Z = zlib:open(), - Out = conf(data_dir,Config), + Out = get_data_dir(Config), {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")), Compressed = zlib:gzip(ORIG), GzOutFile = filename:join(Out,"out.gz"), @@ -737,7 +814,7 @@ gz_usage2(Config) -> compress_usage(Config) when is_list(Config) -> compress_usage(compress_usage({get_arg,Config})); compress_usage({get_arg,Config}) -> - Out = conf(data_dir,Config), + Out = get_data_dir(Config), {ok,C1} = file:read_file(filename:join(Out,"png-compressed.zlib")), {run,C1}; compress_usage({run,C1}) -> @@ -792,7 +869,7 @@ compress_usage({run,C1}) -> crc(Config) when is_list(Config) -> crc(crc({get_arg,Config})); crc({get_arg,Config}) -> - Out = conf(data_dir,Config), + Out = get_data_dir(Config), {ok,C1} = file:read_file(filename:join(Out,"zipdoc")), {run,C1}; crc({run,C1}) -> @@ -821,7 +898,7 @@ crc({run,C1}) -> adler(Config) when is_list(Config) -> adler(adler({get_arg,Config})); adler({get_arg,Config}) -> - Out = conf(data_dir,Config), + Out = get_data_dir(Config), File1 = filename:join(Out,"zipdoc"), {ok,C1} = file:read_file(File1), {run,C1}; @@ -869,10 +946,14 @@ dictionary_usage({run}) -> %% Now uncompress. Z2 = zlib:open(), ?m(ok, zlib:inflateInit(Z2)), - {'EXIT',{{need_dictionary,DictID},_}} = (catch zlib:inflate(Z2, Compressed)), + + ?m(?EXIT({need_dictionary, DictID}), zlib:inflate(Z2, Compressed)), + ?m(ok, zlib:inflateSetDictionary(Z2, Dict)), ?m(ok, zlib:inflateSetDictionary(Z2, binary_to_list(Dict))), + Uncompressed = ?m(B when is_list(B), zlib:inflate(Z2, [])), + ?m(ok, zlib:inflateEnd(Z2)), ?m(ok, zlib:close(Z2)), ?m(Data, list_to_binary(Uncompressed)). @@ -882,6 +963,35 @@ split_bin(<<Part:1997/binary,Rest/binary>>, Acc) -> split_bin(Last,Acc) -> lists:reverse([Last|Acc]). +only_allow_owner(Config) when is_list(Config) -> + Z = zlib:open(), + + ?m(ok, zlib:inflateInit(Z)), + ?m(ok, zlib:inflateReset(Z)), + + {Pid, Ref} = spawn_monitor( + fun() -> + ?m(?EXIT(not_on_controlling_process), zlib:inflateReset(Z)) + end), + + receive + {'DOWN', Ref, process, Pid, _Reason} -> + ok + after 200 -> + ct:fail("Spawned worker timed out.") + end, + + ?m(ok, zlib:inflateReset(Z)). + +sub_heap_binaries(Config) when is_list(Config) -> + Compressed = zlib:compress(<<"gurka">>), + ConfLen = erlang:length(Config), + + HeapBin = <<ConfLen:8/integer, Compressed/binary>>, + <<_:8/integer, SubHeapBin/binary>> = HeapBin, + + ?m(<<"gurka">>, zlib:uncompress(SubHeapBin)), + ok. %% Check concurrent access to zlib driver. smp(Config) -> @@ -889,20 +999,23 @@ smp(Config) -> io:format("smp starting ~p workers\n",[NumOfProcs]), %% Tests to run in parallel. - Funcs = [zip_usage, gz_usage, compress_usage, dictionary_usage, - crc, adler], + Funcs = + [zip_usage, gz_usage, compress_usage, dictionary_usage, + crc, adler], %% We get all function arguments here to avoid repeated parallel %% file read access. - FnAList = lists:map(fun(F) -> {F,?MODULE:F({get_arg,Config})} - end, Funcs), + UsageArgs = + list_to_tuple([{F, ?MODULE:F({get_arg,Config})} || F <- Funcs]), + Parent = self(), - Pids = [spawn_link(?MODULE, worker, [rand:uniform(9999), - list_to_tuple(FnAList), - self()]) - || _ <- lists:seq(1,NumOfProcs)], - wait_pids(Pids). + WorkerFun = + fun() -> + worker(rand:uniform(9999), UsageArgs, Parent) + end, + Pids = [spawn_link(WorkerFun) || _ <- lists:seq(1, NumOfProcs)], + wait_pids(Pids). worker(Seed, FnATpl, Parent) -> io:format("smp worker ~p, seed=~p~n",[self(),Seed]), @@ -993,43 +1106,98 @@ otp_9981(Config) when is_list(Config) -> Ports = lists:sort(erlang:ports()), ok. +-define(BENCH_SIZE, (16 bsl 20)). + +-define(DECOMPRESS_BENCH(Name, What, Data), + Name(Config) when is_list(Config) -> + Uncompressed = Data, + Compressed = zlib:compress(Uncompressed), + What(Compressed, byte_size(Uncompressed))). + +-define(COMPRESS_BENCH(Name, What, Data), + Name(Config) when is_list(Config) -> + Compressed = Data, + What(Compressed, byte_size(Compressed))). + +?DECOMPRESS_BENCH(inflate_bench_zeroed, throughput_bench_inflate, + <<0:(8 * ?BENCH_SIZE)>>). +?DECOMPRESS_BENCH(inflate_bench_rand, throughput_bench_inflate, + gen_determ_rand_bytes(?BENCH_SIZE)). + +?DECOMPRESS_BENCH(chunk_bench_zeroed, throughput_bench_chunk, + <<0:(8 * ?BENCH_SIZE)>>). +?DECOMPRESS_BENCH(chunk_bench_rand, throughput_bench_chunk, + gen_determ_rand_bytes(?BENCH_SIZE)). +?COMPRESS_BENCH(deflate_bench_zeroed, throughput_bench_deflate, + <<0:(8 * ?BENCH_SIZE)>>). +?COMPRESS_BENCH(deflate_bench_rand, throughput_bench_deflate, + gen_determ_rand_bytes(?BENCH_SIZE)). + +throughput_bench_inflate(Compressed, Size) -> + Z = zlib:open(), + zlib:inflateInit(Z), + + submit_throughput_results(Size, + fun() -> + zlib:inflate(Z, Compressed) + end). + +throughput_bench_deflate(Uncompressed, Size) -> + Z = zlib:open(), + zlib:deflateInit(Z), + + submit_throughput_results(Size, + fun() -> + zlib:deflate(Z, Uncompressed, finish) + end). + +throughput_bench_chunk(Compressed, Size) -> + Z = zlib:open(), + zlib:inflateInit(Z), + + ChunkLoop = + fun + Loop({more, _}) -> Loop(zlib:inflateChunk(Z)); + Loop(_) -> ok + end, + + submit_throughput_results(Size, + fun() -> + ChunkLoop(zlib:inflateChunk(Z, Compressed)) + end). + +submit_throughput_results(Size, Fun) -> + TimeTaken = measure_perf_counter(Fun, millisecond), + + KBPS = trunc((Size bsr 10) / (TimeTaken / 1000)), + ct_event:notify(#event{ name = benchmark_data, data = [{value,KBPS}] }), + {comment, io_lib:format("~p ms, ~p KBPS", [TimeTaken, KBPS])}. + +measure_perf_counter(Fun, Unit) -> + Start = os:perf_counter(Unit), + Fun(), + os:perf_counter(Unit) - Start. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Helps with testing directly %%%%%%%%%%%%% -conf(What,Config) -> - try proplists:get_value(What,Config) of - undefined -> - "./zlib_SUITE_data"; - Dir -> - Dir +get_data_dir(Config) -> + try proplists:get_value(data_dir,Config) of + undefined -> + "./zlib_SUITE_data"; + Dir -> + Dir catch - _:_ -> "./zlib_SUITE_data" + _:_ -> "./zlib_SUITE_data" end. -t() -> t([all]). - -t(What) when not is_list(What) -> - t([What]); -t(What) -> - lists:foreach(fun(T) -> - try ?MODULE:T([]) - catch _E:_R -> - Line = get(test_server_loc), - io:format("Failed ~p:~p ~p ~p ~p~n", - [T,Line,_E,_R, erlang:get_stacktrace()]) - end - end, expand(What)). - -expand(All) -> - lists:reverse(expand(All,[])). -expand([H|T], Acc) -> - case ?MODULE:H(suite) of - [] -> expand(T,[H|Acc]); - Cs -> - R = expand(Cs, Acc), - expand(T, R) - end; -expand([], Acc) -> Acc. - +%% Generates a bunch of statistically random bytes using the size as seed. +gen_determ_rand_bytes(Size) -> + gen_determ_rand_bytes(Size, erlang:md5_init(), <<>>). +gen_determ_rand_bytes(Size, _Context, Acc) when Size =< 0 -> + Acc; +gen_determ_rand_bytes(Size, Context0, Acc) when Size > 0 -> + Context = erlang:md5_update(Context0, <<Size/integer>>), + Checksum = erlang:md5_final(Context), + gen_determ_rand_bytes(Size - 16, Context, <<Acc/binary, Checksum/binary>>). diff --git a/lib/mnesia/doc/src/Mnesia_chap2.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap2.xmlsrc index 37389ce5ae..914e0e509c 100644 --- a/lib/mnesia/doc/src/Mnesia_chap2.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap2.xmlsrc @@ -327,7 +327,7 @@ <section> <title>Initial Database Content</title> <p>After the insertion of the employee named <c>klacke</c>, - the databse has the following records:</p> + the database has the following records:</p> <marker id="table2_1"></marker> <table> <row> diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 3b771e8c5b..b68b2de028 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -2283,9 +2283,9 @@ list_index_plugins([{N,M,F} | T] = Ps, Legend) -> lists:foldl(fun({N1,_,_}, Wa) -> erlang:max(Wa, length(pp_ix_name(N1))) end, 0, Ps)), - io:fwrite(Legend ++ "~-" ++ W ++ "s - ~s:~s~n", + io:fwrite(Legend ++ "~-" ++ W ++ "s - ~s:~ts~n", [pp_ix_name(N), atom_to_list(M), atom_to_list(F)]), - [io:fwrite(Indent ++ "~-" ++ W ++ "s - ~s:~s~n", + [io:fwrite(Indent ++ "~-" ++ W ++ "s - ~s:~ts~n", [pp_ix_name(N1), atom_to_list(M1), atom_to_list(F1)]) || {N1,M1,F1} <- T]. diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl index 3e55deb958..34f16f178b 100644 --- a/lib/mnesia/src/mnesia_bup.erl +++ b/lib/mnesia/src/mnesia_bup.erl @@ -920,7 +920,7 @@ create_dat_files([{schema, Tab, TabDef} | Tail], Ext, LocalTabs) -> ok -> ok; {error, Reason} -> - mnesia_lib:fatal("Cannot rename file ~p -> ~p: ~p~n", + mnesia_lib:fatal("Cannot rename file ~tp -> ~tp: ~tp~n", [TmpFile, DclFile, Reason]) end end @@ -1016,7 +1016,7 @@ disc_only_swap_fun(disc_only_copies, Expunge, Open, Close) -> ok -> ok; {error, Reason} -> - mnesia_lib:fatal("Cannot rename file ~p -> ~p: ~p~n", + mnesia_lib:fatal("Cannot rename file ~tp -> ~tp: ~tp~n", [TmpFile, DatFile, Reason]) end end; diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl index 8659e4622c..2ff77326a9 100644 --- a/lib/mnesia/src/mnesia_checkpoint.erl +++ b/lib/mnesia/src/mnesia_checkpoint.erl @@ -683,14 +683,14 @@ retainer_create(_Cp, R, Tab, Name, Ext = {ext, Alias, Mod}) -> Cs = val({Tab, cstruct}), Mod:load_table(Alias, T, {retainer, create_table}, mnesia_schema:cs2list(Cs)), - dbg_out("Checkpoint retainer created ~p ~p~n", [Name, Tab]), + dbg_out("Checkpoint retainer created ~p ~tp~n", [Name, Tab]), R#retainer{store = {Ext, T}, really_retain = true}; retainer_create(_Cp, R, Tab, Name, disc_only_copies) -> Fname = tab2retainer({Tab, Name}), file:delete(Fname), Args = [{file, Fname}, {type, set}, {keypos, 2}, {repair, false}], {ok, _} = mnesia_lib:dets_sync_open({Tab, Name}, Args), - dbg_out("Checkpoint retainer created ~p ~p~n", [Name, Tab]), + dbg_out("Checkpoint retainer created ~p ~tp~n", [Name, Tab]), R#retainer{store = {dets, {Tab, Name}}, really_retain = true}; retainer_create(Cp, R, Tab, Name, Storage) -> T = ?ets_new_table(mnesia_retainer, [set, public, {keypos, 2}]), @@ -698,7 +698,7 @@ retainer_create(Cp, R, Tab, Name, Storage) -> ReallyR = R#retainer.really_retain, ReallyCp = lists:member(Tab, Overriders), ReallyR2 = prepare_ram_tab(Tab, T, Storage, ReallyR, ReallyCp), - dbg_out("Checkpoint retainer created ~p ~p~n", [Name, Tab]), + dbg_out("Checkpoint retainer created ~p ~tp~n", [Name, Tab]), R#retainer{store = {ets, T}, really_retain = ReallyR2}. %% Copy the dumped table into retainer if needed @@ -849,7 +849,7 @@ retainer_loop(Cp = #checkpoint_args{is_activated=false, name=Name}) -> retainer_loop(Cp#checkpoint_args{iterators = Iters}); {system, From, Msg} -> - dbg_out("~p got {system, ~p, ~p}~n", [?MODULE, From, Msg]), + dbg_out("~p got {system, ~p, ~tp}~n", [?MODULE, From, Msg]), sys:handle_system_msg(Msg, From, Cp#checkpoint_args.supervisor, ?MODULE, [], Cp) end; @@ -938,11 +938,11 @@ retainer_loop(Cp = #checkpoint_args{name=Name}) -> retainer_loop(Cp#checkpoint_args{iterators = Iters}); {system, From, Msg} -> - dbg_out("~p got {system, ~p, ~p}~n", [?MODULE, From, Msg]), + dbg_out("~p got {system, ~p, ~tp}~n", [?MODULE, From, Msg]), sys:handle_system_msg(Msg, From, Cp#checkpoint_args.supervisor, ?MODULE, [], Cp); Msg -> - dbg_out("~p got ~p~n", [?MODULE, Msg]) + dbg_out("~p got ~tp~n", [?MODULE, Msg]) end. maybe_activate(Cp) diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 6b93935cb4..77013489b3 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -446,7 +446,7 @@ try_schedule_late_disc_load(Tabs, Reason, MsgTag) -> [BadNodes]), try_schedule_late_disc_load(Tabs, Reason, MsgTag); {aborted, AbortReason} -> - fatal("Cannot late_load_tables~p: ~p~n", + fatal("Cannot late_load_tables ~tp: ~tp~n", [[Tabs, Reason, MsgTag], AbortReason]) end. @@ -535,7 +535,7 @@ try_merge_schema(Nodes, Told0, UserFun) -> end, try_merge_schema(Nodes, Told, UserFun); {atomic, {"Cannot get cstructs", Node, Reason}} -> - dbg_out("Cannot get cstructs, Node ~p ~p~n", [Node, Reason]), + dbg_out("Cannot get cstructs, Node ~p ~tp~n", [Node, Reason]), timer:sleep(300), % Avoid a endless loop look alike try_merge_schema(Nodes, Told0, UserFun); {aborted, {shutdown, _}} -> %% One of the nodes is going down @@ -826,12 +826,12 @@ handle_call({del_other, Who}, _From, State = #state{others=Others0}) -> {reply, ok, State#state{others=Others}}; handle_call(Msg, _From, State) -> - error("~p got unexpected call: ~p~n", [?SERVER_NAME, Msg]), + error("~p got unexpected call: ~tp~n", [?SERVER_NAME, Msg]), noreply(State). late_disc_load(TabsR, Reason, RemoteLoaders, From, State = #state{loader_queue = LQ, late_loader_queue = LLQ}) -> - verbose("Intend to load tables: ~p~n", [TabsR]), + verbose("Intend to load tables: ~tp~n", [TabsR]), ?eval_debug_fun({?MODULE, late_disc_load}, [{tabs, TabsR}, {reason, Reason}, @@ -1118,7 +1118,7 @@ handle_cast({adopt_orphans, Node, Tabs}, State) -> noreply(State2); handle_cast(Msg, State) -> - error("~p got unexpected cast: ~p~n", [?SERVER_NAME, Msg]), + error("~p got unexpected cast: ~tp~n", [?SERVER_NAME, Msg]), noreply(State). handle_sync_tabs([Tab | Tabs], From) -> @@ -1166,7 +1166,7 @@ handle_info(#dumper_done{worker_pid=Pid, worker_res=Res}, State) -> State3 = opt_start_worker(State2), noreply(State3); true -> - fatal("Dumper failed: ~p~n state: ~p~n", [Res, State]), + fatal("Dumper failed: ~p~n state: ~tp~n", [Res, State]), {stop, fatal, State} end; @@ -1249,7 +1249,7 @@ handle_info(#sender_done{worker_pid=Pid, worker_res=Res}, State) -> true -> %% No need to send any message to the table receiver %% since it will soon get a mnesia_down anyway - fatal("Sender failed: ~p~n state: ~p~n", [Res, State]), + fatal("Sender failed: ~p~n state: ~tp~n", [Res, State]), {stop, fatal, State} end; @@ -1257,7 +1257,7 @@ handle_info({'EXIT', Pid, R}, State) when Pid == State#state.supervisor -> ?SAFE(set(mnesia_status, stopping)), case State#state.dumper_pid of undefined -> - dbg_out("~p was ~p~n", [?SERVER_NAME, R]), + dbg_out("~p was ~tp~n", [?SERVER_NAME, R]), {stop, shutdown, State}; _ -> noreply(State#state{is_stopping = true}) @@ -1266,12 +1266,12 @@ handle_info({'EXIT', Pid, R}, State) when Pid == State#state.supervisor -> handle_info({'EXIT', Pid, R}, State) when Pid == State#state.dumper_pid -> case State#state.dumper_queue of [#schema_commit_lock{}|Workers] -> %% Schema trans crashed or was killed - dbg_out("WARNING: Dumper ~p exited ~p~n", [Pid, R]), + dbg_out("WARNING: Dumper ~p exited ~tp~n", [Pid, R]), State2 = State#state{dumper_queue = Workers, dumper_pid = undefined}, State3 = opt_start_worker(State2), noreply(State3); _Other -> - fatal("Dumper or schema commit crashed: ~p~n state: ~p~n", [R, State]), + fatal("Dumper or schema commit crashed: ~p~n state: ~tp~n", [R, State]), {stop, fatal, State} end; @@ -1280,15 +1280,15 @@ handle_info(Msg = {'EXIT', Pid, R}, State) when R /= wait_for_tables_timeout -> true -> %% No need to send any message to the table receiver %% since it will soon get a mnesia_down anyway - fatal("Sender crashed: ~p~n state: ~p~n", [{Pid,R}, State]), + fatal("Sender crashed: ~p~n state: ~tp~n", [{Pid,R}, State]), {stop, fatal, State}; false -> case lists:keymember(Pid, 1, get_loaders(State)) of true -> - fatal("Loader crashed: ~p~n state: ~p~n", [R, State]), + fatal("Loader crashed: ~p~n state: ~tp~n", [R, State]), {stop, fatal, State}; false -> - error("~p got unexpected info: ~p~n", [?SERVER_NAME, Msg]), + error("~p got unexpected info: ~tp~n", [?SERVER_NAME, Msg]), noreply(State) end end; @@ -1308,7 +1308,7 @@ handle_info({'EXIT', Pid, wait_for_tables_timeout}, State) -> noreply(State); handle_info(Msg, State) -> - error("~p got unexpected info: ~p~n", [?SERVER_NAME, Msg]), + error("~p got unexpected info: ~tp~n", [?SERVER_NAME, Msg]), noreply(State). sync_tab_timeout(Pid, [{{sync_tab, Tab}, Pids} | Tail]) -> @@ -2054,7 +2054,7 @@ opt_start_sender2([Sender|R], Pids, Kept, LoaderQ) -> Pid = spawn_link(?MODULE, send_and_reply,[self(), Sender]), opt_start_sender2(R,[{Pid,Sender}|Pids],Kept,LoaderQ); true -> - verbose("Send table failed ~p not active on this node ~n", [Tab]), + verbose("Send table failed ~tp not active on this node ~n", [Tab]), Sender#send_table.receiver_pid ! {copier_done, node()}, opt_start_sender2(R,Pids, Kept, LoaderQ) end. @@ -2239,7 +2239,7 @@ disc_load_table(Tab, Reason, ReplyTo) -> Done#loader_done{is_loaded = false, reply = Res}; true -> - fatal("Cannot load table ~p from disc: ~p~n", [Tab, Res]) + fatal("Cannot load table ~tp from disc: ~tp~n", [Tab, Res]) end. filter_active(Tab) -> diff --git a/lib/mnesia/src/mnesia_dumper.erl b/lib/mnesia/src/mnesia_dumper.erl index eb02a585a6..f0ed7aef4a 100644 --- a/lib/mnesia/src/mnesia_dumper.erl +++ b/lib/mnesia/src/mnesia_dumper.erl @@ -193,7 +193,7 @@ do_perform_dump(Cont, InPlace, InitBy, Regulator, OldVersion) -> do_perform_dump(C2, InPlace, InitBy, Regulator, Version) catch _:R when R =/= fatal -> ST = erlang:get_stacktrace(), - Reason = {"Transaction log dump error: ~p~n", [{R, ST}]}, + Reason = {"Transaction log dump error: ~tp~n", [{R, ST}]}, close_files(InPlace, {error, Reason}, InitBy), exit(Reason) end; @@ -329,7 +329,7 @@ perform_update(Tid, SchemaOps, _DumperMode, _UseDir) -> ST = erlang:get_stacktrace(), Error = {error, {"Schema update error", {Reason, ST}}}, close_files(InPlace, Error, InitBy), - fatal("Schema update error ~p ~p", [{Reason,ST}, SchemaOps]) + fatal("Schema update error ~tp ~tp", [{Reason,ST}, SchemaOps]) end. insert_ops(_Tid, _Storage, [], _InPlace, _InitBy, _) -> ok; @@ -1166,7 +1166,7 @@ needs_dump_ets(Tab) -> DcdF = mnesia_lib:tab2dcd(Tab), case file:read_file_info(DcdF) of {error, Reason} -> - mnesia_lib:dbg_out("File ~p info_error ~p ~n", + mnesia_lib:dbg_out("File ~tp info_error ~tp ~n", [DcdF, Reason]), true; {ok, DcdInfo} -> @@ -1205,7 +1205,7 @@ prepare_open(Tab, UpdateInPlace) -> Tmp = mnesia_lib:tab2tmp(Tab), try ok = mnesia_lib:copy_file(Dat, Tmp) catch error:Error -> - fatal("Cannot copy dets file ~p to ~p: ~p~n", + fatal("Cannot copy dets file ~tp to ~tp: ~tp~n", [Dat, Tmp, Error]) end, Tmp @@ -1441,7 +1441,7 @@ start_regulator() -> {ok, Pid} -> Pid; {error, Reason} -> - fatal("Failed to start ~n: ~p~n", [N, Reason]) + fatal("Failed to start ~n: ~tp~n", [N, Reason]) end end. diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index b06043bc61..49b3990086 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -103,11 +103,11 @@ handle_any_event({mnesia_system_event, Event}, State) -> handle_any_event({mnesia_table_event, Event}, State) -> handle_table_event(Event, State); handle_any_event(Msg, State) -> - report_error("~p got unexpected event: ~p~n", [?MODULE, Msg]), + report_error("~p got unexpected event: ~tp~n", [?MODULE, Msg]), {ok, State}. handle_table_event({Oper, Record, TransId}, State) -> - report_info("~p performed by ~p on record:~n\t~p~n", + report_info("~p performed by ~p on record:~n\t~tp~n", [Oper, TransId, Record]), {ok, State}. @@ -155,7 +155,7 @@ handle_system_event({mnesia_down, Node}, State) -> end; handle_system_event({mnesia_overload, Details}, State) -> - report_warning("Mnesia is overloaded: ~w~n", [Details]), + report_warning("Mnesia is overloaded: ~tw~n", [Details]), {ok, State}; handle_system_event({mnesia_info, Format, Args}, State) -> @@ -175,16 +175,16 @@ handle_system_event({mnesia_fatal, Format, Args, BinaryCore}, State) -> {ok, State#state{dumped_core = true}}; handle_system_event({inconsistent_database, Reason, Node}, State) -> - report_error("mnesia_event got {inconsistent_database, ~w, ~w}~n", + report_error("mnesia_event got {inconsistent_database, ~tw, ~w}~n", [Reason, Node]), {ok, State}; handle_system_event({mnesia_user, Event}, State) -> - report_info("User event: ~p~n", [Event]), + report_info("User event: ~tp~n", [Event]), {ok, State}; handle_system_event(Msg, State) -> - report_error("mnesia_event got unexpected system event: ~p~n", [Msg]), + report_error("mnesia_event got unexpected system event: ~tp~n", [Msg]), {ok, State}. report_info(Format0, Args0) -> diff --git a/lib/mnesia/src/mnesia_index.erl b/lib/mnesia/src/mnesia_index.erl index c79f790973..d121bd01e9 100644 --- a/lib/mnesia/src/mnesia_index.erl +++ b/lib/mnesia/src/mnesia_index.erl @@ -420,7 +420,7 @@ make_ram_index(Tab, Storage, [Pos | Tail]) -> add_ram_index(Tab, Storage, {Pos, _Pref}) -> Type = ordered, - verbose("Creating index for ~w ~p ~p~n", [Tab, Pos, Type]), + verbose("Creating index for ~tw ~p ~p~n", [Tab, Pos, Type]), SetOrBag = val({Tab, setorbag}), IxValsF = index_vals_f(Storage, Tab, Pos), IxFun = fun(Val, Key) -> {{Val, Key}} end, diff --git a/lib/mnesia/src/mnesia_late_loader.erl b/lib/mnesia/src/mnesia_late_loader.erl index e273329ffc..e4f8dcf2b9 100644 --- a/lib/mnesia/src/mnesia_late_loader.erl +++ b/lib/mnesia/src/mnesia_late_loader.erl @@ -87,13 +87,13 @@ loop(State) -> loop(State); {system, From, Msg} -> - mnesia_lib:dbg_out("~p got {system, ~p, ~p}~n", + mnesia_lib:dbg_out("~p got {system, ~p, ~tp}~n", [?SERVER_NAME, From, Msg]), Parent = State#state.supervisor, sys:handle_system_msg(Msg, From, Parent, ?MODULE, [], State); Msg -> - mnesia_lib:error("~p got unexpected message: ~p~n", + mnesia_lib:error("~p got unexpected message: ~tp~n", [?SERVER_NAME, Msg]), loop(State) end. diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 1fdc656600..53fdd76de8 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -467,7 +467,7 @@ pr_other(Var) -> no -> {node_not_running, node()}; _ -> {no_exists, Var} end, - verbose("~p (~p) val(mnesia_gvar, ~w) -> ~p ~p ~n", + verbose("~p (~tp) val(mnesia_gvar, ~tw) -> ~p ~tp ~n", [self(), process_info(self(), registered_name), Var, Why, erlang:get_stacktrace()]), mnesia:abort(Why). @@ -654,7 +654,7 @@ coredump() -> coredump(CrashInfo) -> Core = mkcore(CrashInfo), Out = core_file(), - important("Writing Mnesia core to file: ~p...~p~n", [Out, CrashInfo]), + important("Writing Mnesia core to file: ~tp...~tp~n", [Out, CrashInfo]), _ = file:write_file(Out, Core), Out. @@ -844,7 +844,7 @@ vcore() -> case file:list_dir(Cwd) of {ok, Files}-> CoreFiles = lists:sort(lists:zf(Filter, Files)), - show("Mnesia core files: ~p~n", [CoreFiles]), + show("Mnesia core files: ~tp~n", [CoreFiles]), vcore(lists:last(CoreFiles)); Error -> Error @@ -853,17 +853,17 @@ vcore() -> vcore(Bin) when is_binary(Bin) -> Core = binary_to_term(Bin), Fun = fun({Item, Info}) -> - show("***** ~p *****~n", [Item]), + show("***** ~tp *****~n", [Item]), case catch vcore_elem({Item, Info}) of {'EXIT', Reason} -> - show("{'EXIT', ~p}~n", [Reason]); + show("{'EXIT', ~tp}~n", [Reason]); _ -> ok end end, lists:foreach(Fun, Core); vcore(File) -> - show("~n***** Mnesia core: ~p *****~n", [File]), + show("~n***** Mnesia core: ~tp *****~n", [File]), case file:read_file(File) of {ok, Bin} -> vcore(Bin); @@ -879,7 +879,7 @@ vcore_elem({schema_file, {ok, B}}) -> vcore_elem({logfile, {ok, BinList}}) -> Fun = fun({F, Info}) -> - show("----- logfile: ~p -----~n", [F]), + show("----- logfile: ~tp -----~n", [F]), case Info of {ok, B} -> Fname = "/tmp/mnesia_vcore_elem.TMP", @@ -887,7 +887,7 @@ vcore_elem({logfile, {ok, BinList}}) -> mnesia_log:view(Fname), file:delete(Fname); _ -> - show("~p~n", [Info]) + show("~tp~n", [Info]) end end, lists:foreach(Fun, BinList); @@ -895,12 +895,12 @@ vcore_elem({logfile, {ok, BinList}}) -> vcore_elem({crashinfo, {Format, Args}}) -> show(Format, Args); vcore_elem({gvar, L}) -> - show("~p~n", [lists:sort(L)]); + show("~tp~n", [lists:sort(L)]); vcore_elem({transactions, Info}) -> mnesia_tm:display_info(user, Info); vcore_elem({_Item, Info}) -> - show("~p~n", [Info]). + show("~tp~n", [Info]). fix_error(X) -> set(last_error, X), %% for debugabililty @@ -1018,7 +1018,7 @@ report_system_event({'EXIT', Reason}, Event) -> end; Error -> - Msg = "Mnesia(~p): Cannot report event ~p: ~p (~p)~n", + Msg = "Mnesia(~tp): Cannot report event ~tp: ~tp (~tp)~n", error_logger:format(Msg, [node(), Event, Reason, Error]) end, ok; diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index c710470a2c..4c6336cb73 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -46,7 +46,7 @@ val(Var) -> disc_load_table(Tab, Reason) -> Storage = val({Tab, storage_type}), Type = val({Tab, setorbag}), - dbg_out("Getting table ~p (~p) from disc: ~p~n", + dbg_out("Getting table ~tp (~p) from disc: ~tp~n", [Tab, Storage, Reason]), ?eval_debug_fun({?MODULE, do_get_disc_copy}, [{tab, Tab}, @@ -56,7 +56,7 @@ disc_load_table(Tab, Reason) -> do_get_disc_copy2(Tab, Reason, Storage, Type). do_get_disc_copy2(Tab, _Reason, Storage, _Type) when Storage == unknown -> - verbose("Local table copy of ~p has recently been deleted, ignored.~n", + verbose("Local table copy of ~tp has recently been deleted, ignored.~n", [Tab]), {not_loaded, storage_unknown}; do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_copies -> @@ -199,20 +199,20 @@ net_load_table(Tab, Reason, Ns, _Cs) -> try_net_load_table(Tab, Reason, Ns, val({Tab, cstruct})). try_net_load_table(Tab, _Reason, [], _Cs) -> - verbose("Copy failed. No active replicas of ~p are available.~n", [Tab]), + verbose("Copy failed. No active replicas of ~tp are available.~n", [Tab]), {not_loaded, none_active}; try_net_load_table(Tab, Reason, Ns, Cs) -> Storage = mnesia_lib:cs_to_storage_type(node(), Cs), do_get_network_copy(Tab, Reason, Ns, Storage, Cs). do_get_network_copy(Tab, _Reason, _Ns, unknown, _Cs) -> - verbose("Local table copy of ~p has recently been deleted, ignored.~n", [Tab]), + verbose("Local table copy of ~tp has recently been deleted, ignored.~n", [Tab]), {not_loaded, storage_unknown}; do_get_network_copy(Tab, Reason, Ns, Storage, Cs) -> [Node | Tail] = Ns, case lists:member(Node,val({current, db_nodes})) of true -> - dbg_out("Getting table ~p (~p) from node ~p: ~p~n", + dbg_out("Getting table ~tp (~p) from node ~p: ~tp~n", [Tab, Storage, Node, Reason]), ?eval_debug_fun({?MODULE, do_get_network_copy}, [{tab, Tab}, {reason, Reason}, @@ -222,7 +222,7 @@ do_get_network_copy(Tab, Reason, Ns, Storage, Cs) -> set({Tab, load_node}, Node), set({Tab, load_reason}, Reason), mnesia_controller:i_have_tab(Tab), - dbg_out("Table ~p copied from ~p to ~p~n", [Tab, Node, node()]), + dbg_out("Table ~tp copied from ~p to ~p~n", [Tab, Node, node()]), {loaded, ok}; Err = {error, _} when element(1, Reason) == dumper -> {not_loaded,Err}; @@ -286,12 +286,12 @@ init_receiver(Node, Tab,Storage,Cs,Reason) -> element(1,Reason) == dumper -> {error,Result}; {atomic, {error,Result}} -> - fatal("Cannot create table ~p: ~p~n", + fatal("Cannot create table ~tp: ~tp~n", [[Tab, Storage], Result]); {atomic, Result} -> Result; {aborted, nomore} -> restart; {aborted, _Reas} -> - verbose("Receiver failed on ~p from ~p:~nReason: ~p~n", + verbose("Receiver failed on ~tp from ~p:~nReason: ~tp~n", [Tab,Node,_Reas]), down %% either this node or sender is dying end, @@ -313,7 +313,7 @@ start_remote_sender(Node,Tab,Storage) -> {SenderPid, TabSize, DetsData}; %% Protocol conversion hack {copier_done, Node} -> - verbose("Sender of table ~p crashed on node ~p ~n", [Tab, Node]), + verbose("Sender of table ~tp crashed on node ~p ~n", [Tab, Node]), down(Tab, Storage) end. @@ -374,7 +374,7 @@ do_init_table(Tab,Storage,Cs,SenderPid, tab_receiver(Node,Tab,Storage,Cs,OrigTabRec); Reason -> Msg = "[d]ets:init table failed", - verbose("~s: ~p: ~p~n", [Msg, Tab, Reason]), + verbose("~ts: ~tp: ~tp~n", [Msg, Tab, Reason]), down(Tab, Storage) end; Error -> @@ -432,7 +432,7 @@ tab_receiver(Node, Tab, Storage, Cs, OrigTabRec) -> %% Protocol conversion hack {copier_done, Node} -> - verbose("Sender of table ~p crashed on node ~p ~n", [Tab, Node]), + verbose("Sender of table ~tp crashed on node ~p ~n", [Tab, Node]), down(Tab, Storage); {'EXIT', Pid, Reason} -> @@ -490,7 +490,7 @@ ext_load_table(Mod, Alias, Tab, Reason) -> ext_init_table(Action, Alias, Mod, Tab, Fun, State, Sender) -> case Fun(Action) of {copier_done, Node} -> - verbose("Receiver of table ~p crashed on ~p (more)~n", [Tab, Node]), + verbose("Receiver of table ~tp crashed on ~p (more)~n", [Tab, Node]), down(Tab, {ext,Alias,Mod}); {Data, NewFun} -> case Mod:receive_data(Data, Alias, Tab, Sender, State) of @@ -553,7 +553,7 @@ finish_copy(Storage,Tab,Cs,SenderPid,DatBin,OrigTabRec) -> ok; {error, Reason} -> Msg = "Failed to handle last", - verbose("~s: ~p: ~p~n", [Msg, Tab, Reason]), + verbose("~ts: ~tp: ~tp~n", [Msg, Tab, Reason]), down(Tab, Storage) end. @@ -859,7 +859,7 @@ send_more(Pid, N, Chunk, DataState, Tab, Storage) -> send_more(Pid, 1, NewChunk, Init(), Tab, Storage); {copier_done, Node} when Node == node(Pid)-> - verbose("Receiver of table ~p crashed on ~p (more)~n", [Tab, Node]), + verbose("Receiver of table ~tp crashed on ~p (more)~n", [Tab, Node]), throw(receiver_died) end. @@ -937,7 +937,7 @@ finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) -> {Pid, no_more} -> % Dont bother about the spurious 'more' message no_more; {copier_done, Node} -> - verbose("Tab receiver ~p crashed (more): ~p~n", [Tab, Node]), + verbose("Tab receiver ~tp crashed (more): ~p~n", [Tab, Node]), receiver_died end end, diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 59fd89059f..073b48abc0 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -245,7 +245,7 @@ loop(State) -> do_stop(); {system, From, Msg} -> - verbose("~p got {system, ~p, ~p}~n", [?MODULE, From, Msg]), + verbose("~p got {system, ~p, ~tp}~n", [?MODULE, From, Msg]), Parent = State#state.supervisor, sys:handle_system_msg(Msg, From, Parent, ?MODULE, [], State); @@ -254,7 +254,7 @@ loop(State) -> loop(State); Msg -> - error("~p got unexpected message: ~p~n", [?MODULE, Msg]), + error("~p got unexpected message: ~tp~n", [?MODULE, Msg]), loop(State) end. diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index 9536effd42..55b1d6e419 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -310,7 +310,7 @@ verify_no_exists(Fname) -> false -> ok; true -> - fatal("Log file exists: ~p~n", [Fname]) + fatal("Log file exists: ~tp~n", [Fname]) end. open_log(Name, Header, Fname) -> @@ -331,7 +331,7 @@ open_log(Name, Header, Fname, Exists, Repair) -> open_log(Name, Header, Fname, Exists, Repair, Mode) -> Args = [{file, Fname}, {name, Name}, {repair, Repair}, {mode, Mode}], -%% io:format("~p:open_log: ~p ~p~n", [?MODULE, Name, Fname]), +%% io:format("~p:open_log: ~tp ~tp~n", [?MODULE, Name, Fname]), case mnesia_monitor:open_log(Args) of {ok, Log} when Exists == true -> Log; @@ -344,19 +344,19 @@ open_log(Name, Header, Fname, Exists, Repair, Mode) -> write_header(Log, Header), Log; {repaired, Log, _Recover, BadBytes} -> - mnesia_lib:important("Data may be missing, log ~p repaired: Lost ~p bytes~n", + mnesia_lib:important("Data may be missing, log ~tp repaired: Lost ~p bytes~n", [Fname, BadBytes]), Log; {error, Reason = {file_error, _Fname, emfile}} -> - fatal("Cannot open log file ~p: ~p~n", [Fname, Reason]); + fatal("Cannot open log file ~tp: ~tp~n", [Fname, Reason]); {error, Reason} when Repair == true -> file:delete(Fname), - mnesia_lib:important("Data may be missing, Corrupt logfile deleted: ~p, ~p ~n", + mnesia_lib:important("Data may be missing, Corrupt logfile deleted: ~tp, ~tp ~n", [Fname, Reason]), %% Create a new open_log(Name, Header, Fname, false, false, read_write); {error, Reason} -> - fatal("Cannot open log file ~p: ~p~n", [Fname, Reason]) + fatal("Cannot open log file ~tp: ~tp~n", [Fname, Reason]) end. write_header(Log, Header) -> @@ -381,7 +381,7 @@ close_log(Log) -> {error, {read_only_mode, Log}} -> ok; {error, Reason} -> - mnesia_lib:important("Failed syncing ~p to_disk reason ~p ~n", + mnesia_lib:important("Failed syncing ~tp to_disk reason ~tp ~n", [Log, Reason]) end, mnesia_monitor:close_log(Log). @@ -464,13 +464,13 @@ chunk_log(_Log, eof) -> chunk_log(Log, Cont) -> case disk_log:chunk(Log, Cont) of {error, Reason} -> - fatal("Possibly truncated ~p file: ~p~n", + fatal("Possibly truncated ~tp file: ~tp~n", [Log, Reason]); {C2, Chunk, _BadBytes} -> %% Read_only case, should we warn about the bad log file? %% BUGBUG Should we crash if Repair == false ?? %% We got to check this !! - mnesia_lib:important("~p repaired, lost ~p bad bytes~n", [Log, _BadBytes]), + mnesia_lib:important("~tp repaired, lost ~p bad bytes~n", [Log, _BadBytes]), {C2, Chunk}; Other -> Other @@ -505,7 +505,7 @@ prepare_decision_log_dump(false, Prev) -> ok -> prepare_decision_log_dump(true, Prev); {error, Reason} -> - fatal("Cannot rename decision log file ~p -> ~p: ~p~n", + fatal("Cannot rename decision log file ~tp -> ~tp: ~tp~n", [decision_log_file(), Prev, Reason]) end; prepare_decision_log_dump(true, Prev) -> @@ -522,7 +522,7 @@ confirm_decision_log_dump() -> ok -> file:delete(previous_decision_log_file()); {error, Reason} -> - fatal("Cannot confirm decision log dump: ~p~n", + fatal("Cannot confirm decision log dump: ~tp~n", [Reason]) end. @@ -561,7 +561,7 @@ view() -> lists:foreach(fun(F) -> view(F) end, log_files()). view(File) -> - mnesia_lib:show("***** ~p ***** ~n", [File]), + mnesia_lib:show("***** ~tp ***** ~n", [File]), case exists(File) of false -> nolog; @@ -574,25 +574,25 @@ view(File) -> {repaired, _, _, _} -> view_file(start, N); {error, Reason} -> - error("Cannot open log ~p: ~p~n", [File, Reason]) + error("Cannot open log ~tp: ~tp~n", [File, Reason]) end end. view_file(C, Log) -> case disk_log:chunk(Log, C) of {error, Reason} -> - error("** Possibly truncated FILE ~p~n", [Reason]), + error("** Possibly truncated FILE ~tp~n", [Reason]), error; eof -> disk_log:close(Log), eof; {C2, Terms, _BadBytes} -> - dbg_out("Lost ~p bytes in ~p ~n", [_BadBytes, Log]), - lists:foreach(fun(X) -> mnesia_lib:show("~p~n", [X]) end, + dbg_out("Lost ~p bytes in ~tp ~n", [_BadBytes, Log]), + lists:foreach(fun(X) -> mnesia_lib:show("~tp~n", [X]) end, Terms), view_file(C2, Log); {C2, Terms} -> - lists:foreach(fun(X) -> mnesia_lib:show("~p~n", [X]) end, + lists:foreach(fun(X) -> mnesia_lib:show("~tp~n", [X]) end, Terms), view_file(C2, Log) end. @@ -750,12 +750,12 @@ abort_write_fun(B, What, Args) -> abort_write(B, What, Args, Reason) -> Mod = B#backup_args.module, Opaque = B#backup_args.opaque, - dbg_out("Failed to perform backup. M=~p:F=~p:A=~p -> ~p~n", + dbg_out("Failed to perform backup. M=~p:F=~tp:A=~tp -> ~tp~n", [Mod, What, Args, Reason]), try apply(Mod, abort_write, [Opaque]) of {ok, _Res} -> throw({error, Reason}) catch _:Other -> - error("Failed to abort backup. ~p:~p~p -> ~p~n", + error("Failed to abort backup. ~p:~tp~tp -> ~tp~n", [Mod, abort_write, [Opaque], Other]), throw({error, Reason}) end. @@ -802,7 +802,7 @@ select_source(Tab, Name, PrevName) -> {PrevName, retainer}; _ -> %% Do a full backup anyway - dbg_out("Incremental backup escalated to full backup: ~p~n", [Tab]), + dbg_out("Incremental backup escalated to full backup: ~tp~n", [Tab]), {Name, table} end end. diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index 22a24b6dc9..4cfe16dec0 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -178,10 +178,10 @@ check_protocol([{Node, {reject, _Mon, Version, Protocol}} | Tail], Protocols) -> [Node, Protocols, Version, Protocol]), check_protocol(Tail, Protocols); check_protocol([{error, _Reason} | Tail], Protocols) -> - dbg_out("~p connect failed error: ~p~n", [?MODULE, _Reason]), + dbg_out("~p connect failed error: ~tp~n", [?MODULE, _Reason]), check_protocol(Tail, Protocols); check_protocol([{badrpc, _Reason} | Tail], Protocols) -> - dbg_out("~p connect failed badrpc: ~p~n", [?MODULE, _Reason]), + dbg_out("~p connect failed badrpc: ~tp~n", [?MODULE, _Reason]), check_protocol(Tail, Protocols); check_protocol([], [Protocol | _Protocols]) -> set(protocol_version, Protocol), @@ -246,10 +246,10 @@ start_proc(Who, Mod, Fun, Args) -> proc_lib:start_link(mnesia_sp, init_proc, Args2, infinity). terminate_proc(Who, R, State) when R /= shutdown, R /= killed -> - fatal("~p crashed: ~p state: ~p~n", [Who, R, State]); + fatal("~p crashed: ~p state: ~tp~n", [Who, R, State]); terminate_proc(Who, Reason, _State) -> - mnesia_lib:verbose("~p terminated: ~p~n", [Who, Reason]), + mnesia_lib:verbose("~p terminated: ~tp~n", [Who, Reason]), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -294,7 +294,7 @@ init([Parent]) -> {ok, #state{supervisor = Parent}} catch _:Reason -> - mnesia_lib:report_fatal("Bad configuration: ~p~n", [Reason]), + mnesia_lib:report_fatal("Bad configuration: ~tp~n", [Reason]), {stop, {bad_config, Reason}} end. @@ -333,7 +333,7 @@ handle_call({mktab, Tab, Args}, _From, State) -> catch error:ExitReason -> Msg = "Cannot create ets table", Reason = {system_limit, Msg, Tab, Args, ExitReason}, - fatal("~p~n", [Reason]), + fatal("~tp~n", [Reason]), {noreply, State} end; @@ -353,7 +353,7 @@ handle_call({open_dets, Tab, Args}, _From, State) -> {error, Reason} -> Msg = "Cannot open dets table", Error = {error, {Msg, Tab, Args, Reason}}, - fatal("~p~n", [Error]), + fatal("~tp~n", [Error]), {noreply, State} end; @@ -385,7 +385,7 @@ handle_call({reopen_log, Name, Fname, Head}, _From, State) -> {error, Reason} -> Msg = "Cannot rename disk_log file", Error = {error, {Msg, Name, Fname, Head, Reason}}, - fatal("~p~n", [Error]), + fatal("~tp~n", [Error]), {noreply, State} end; @@ -400,7 +400,7 @@ handle_call({close_log, Name}, _From, State) -> {error, Reason} -> Msg = "Cannot close disk_log file", Error = {error, {Msg, Name, Reason}}, - fatal("~p~n", [Error]), + fatal("~tp~n", [Error]), {noreply, State} end; @@ -461,7 +461,7 @@ handle_call(init, _From, State) -> {reply, EarlyNodes, State2}; handle_call(Msg, _From, State) -> - error("~p got unexpected call: ~p~n", [?MODULE, Msg]), + error("~p got unexpected call: ~tp~n", [?MODULE, Msg]), {noreply, State}. accept_protocol(Mon, Version, Protocol, From, State) -> @@ -535,7 +535,7 @@ handle_cast({inconsistent_database, Context, Node}, State) -> {noreply, State}; handle_cast(Msg, State) -> - error("~p got unexpected cast: ~p~n", [?MODULE, Msg]), + error("~p got unexpected cast: ~tp~n", [?MODULE, Msg]), {noreply, State}. %%---------------------------------------------------------------------- @@ -572,7 +572,7 @@ handle_info(Msg = {'EXIT',Pid,_}, State) -> %% We have probably got an exit signal from %% disk_log or dets Hint = "Hint: check that the disk still is writable", - fatal("~p got unexpected info: ~p; ~p~n", + fatal("~p got unexpected info: ~tp; ~p~n", [?MODULE, Msg, Hint]) end; @@ -599,13 +599,13 @@ handle_info({disk_log, _Node, Log, Info}, State) -> {truncated, _No} -> ok; _ -> - mnesia_lib:important("Warning Log file ~p error reason ~s~n", + mnesia_lib:important("Warning Log file ~tp error reason ~ts~n", [Log, disk_log:format_error(Info)]) end, {noreply, State}; handle_info(Msg, State) -> - error("~p got unexpected info (~p): ~p~n", [?MODULE, State, Msg]). + error("~p got unexpected info (~tp): ~tp~n", [?MODULE, State, Msg]). process_q(State = #state{mq=[]}) -> {noreply,State}; process_q(State = #state{mq=[{info,Msg}|R]}) -> diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index b204fb282f..d792070332 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -762,7 +762,7 @@ handle_call(sync, _From, State) -> {reply, ok, State}; handle_call(Msg, _From, State) -> - error("~p got unexpected call: ~p~n", [?MODULE, Msg]), + error("~p got unexpected call: ~tp~n", [?MODULE, Msg]), {noreply, State}. do_log_mnesia_up(Node) -> @@ -881,7 +881,7 @@ handle_cast({log_dump_overload, Flag}, State) when is_boolean(Flag) -> {noreply, State#state{log_dump_overload = Flag}}; handle_cast(Msg, State) -> - error("~p got unexpected cast: ~p~n", [?MODULE, Msg]), + error("~p got unexpected cast: ~tp~n", [?MODULE, Msg]), {noreply, State}. %%---------------------------------------------------------------------- @@ -927,11 +927,11 @@ handle_info({force_decision, Tid}, State) -> end; handle_info({'EXIT', Pid, R}, State) when Pid == State#state.supervisor -> - mnesia_lib:dbg_out("~p was ~p~n",[?MODULE, R]), + mnesia_lib:dbg_out("~p was ~tp~n",[?MODULE, R]), {stop, shutdown, State}; handle_info(Msg, State) -> - error("~p got unexpected info: ~p~n", [?MODULE, Msg]), + error("~p got unexpected info: ~tp~n", [?MODULE, Msg]), {noreply, State}. %%---------------------------------------------------------------------- diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index f71ee26d7c..83cc19c678 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -386,7 +386,7 @@ delete_schema(Ns) when is_list(Ns), Ns /= [] -> [] -> ok; BadReplies -> - verbose("~s: ~p~n", [Reason, BadReplies]), + verbose("~s: ~tp~n", [Reason, BadReplies]), {error, {"All nodes not running", BadReplies}} end; {_Replies, BadNs} -> @@ -467,10 +467,10 @@ opt_create_dir(UseDir, Dir) when UseDir == true-> false -> case file:make_dir(Dir) of ok -> - verbose("Create Directory ~p~n", [Dir]), + verbose("Create Directory ~tp~n", [Dir]), ok; {error, Reason} -> - verbose("Cannot create mnesia dir ~p~n", [Reason]), + verbose("Cannot create mnesia dir ~tp~n", [Reason]), {error, {"Cannot create Mnesia dir", Dir, Reason}} end end; @@ -1470,7 +1470,7 @@ verify_backend_type(Name, Module) -> [] -> ok; _Other -> - io:fwrite(user, "Missing backend_type exports: ~p~n", [_Other]), + io:fwrite(user, "Missing backend_type exports: ~tp~n", [_Other]), mnesia:abort({bad_type, {backend_type,Name,Module}}) end. @@ -1776,7 +1776,7 @@ make_del_table_copy(Tab, Node) -> mnesia:abort({combine_error, Tab, "Last replica"}); [] -> ensure_active(Cs), - dbg_out("Last replica deleted in table ~p~n", [Tab]), + dbg_out("Last replica deleted in table ~tp~n", [Tab]), make_delete_table(Tab, whole_table); _ when Tab == schema -> %% ensure_active(Cs2), @@ -2178,13 +2178,13 @@ do_write_table_property(Tab, Prop) -> case change_prop_in_existing_op(Tab, Prop, write_property, Store) of true -> dbg_out("change_prop_in_existing_op" - "(~p,~p,write_property,Store) -> true~n", + "(~tp,~p,write_property,Store) -> true~n", [Tab,Prop]), %% we have merged the table prop into the create_table op ok; false -> dbg_out("change_prop_in_existing_op" - "(~p,~p,write_property,Store) -> false~n", + "(~tp,~p,write_property,Store) -> false~n", [Tab,Prop]), %% this must be an existing table get_tid_ts_and_lock(Tab, none), @@ -2315,13 +2315,13 @@ do_delete_table_property(Tab, PropKey) -> case change_prop_in_existing_op(Tab, PropKey, delete_property, Store) of true -> dbg_out("change_prop_in_existing_op" - "(~p,~p,delete_property,Store) -> true~n", + "(~tp,~p,delete_property,Store) -> true~n", [Tab,PropKey]), %% we have merged the table prop into the create_table op ok; false -> dbg_out("change_prop_in_existing_op" - "(~p,~p,delete_property,Store) -> false~n", + "(~tp,~p,delete_property,Store) -> false~n", [Tab,PropKey]), %% this must be an existing table get_tid_ts_and_lock(Tab, none), @@ -2435,17 +2435,17 @@ prepare_op(_Tid, {op, sync_trans}, {part, CoordPid}) -> {sync_trans, CoordPid} -> {false, optional}; {mnesia_down, _Node} = Else -> - mnesia_lib:verbose("sync_op terminated due to ~p~n", [Else]), + mnesia_lib:verbose("sync_op terminated due to ~tp~n", [Else]), mnesia:abort(Else); {'EXIT', _, _} = Else -> - mnesia_lib:verbose("sync_op terminated due to ~p~n", [Else]), + mnesia_lib:verbose("sync_op terminated due to ~tp~n", [Else]), mnesia:abort(Else) end; prepare_op(_Tid, {op, sync_trans}, {coord, Nodes}) -> case receive_sync(Nodes, []) of {abort, Reason} -> - mnesia_lib:verbose("sync_op terminated due to ~p~n", [Reason]), + mnesia_lib:verbose("sync_op terminated due to ~tp~n", [Reason]), mnesia:abort(Reason); Pids -> [Pid ! {sync_trans, self()} || Pid <- Pids], @@ -2707,7 +2707,7 @@ prepare_op(_Tid, {op, transform, Fun, TabDef}, _WaitFor) -> {true, Objs, mandatory} catch _:Reason -> mnesia_lib:db_fixtable(Storage, Tab, false), - mnesia_lib:important("Transform function failed: '~p' in '~p'", + mnesia_lib:important("Transform function failed: '~tp' in '~tp'", [Reason, erlang:get_stacktrace()]), exit({"Bad transform function", Tab, Fun, node(), Reason}) end @@ -2719,7 +2719,7 @@ prepare_op(_Tid, {op, merge_schema, TabDef}, _WaitFor) -> ok -> {true, optional}; Error -> - verbose("Merge_Schema ~p failed on ~p: ~p~n", [_Tid,node(),Error]), + verbose("Merge_Schema ~p failed on ~p: ~tp~n", [_Tid,node(),Error]), mnesia:abort({bad_commit, Error}) end; prepare_op(_Tid, _Op, _WaitFor) -> @@ -3133,7 +3133,7 @@ ext_real_suffixes(Ext) -> [M || {_,M} <- Ext]) catch error:E -> - verbose("Cant find real ext suffixes (~p)~n", [E]), + verbose("Cant find real ext suffixes (~tp)~n", [E]), [] end. @@ -3142,7 +3142,7 @@ ext_tmp_suffixes(Ext) -> [M || {_,M} <- Ext]) catch error:E -> - verbose("Cant find tmp ext suffixes (~p)~n", [E]), + verbose("Cant find tmp ext suffixes (~tp)~n", [E]), [] end. @@ -3153,14 +3153,14 @@ info() -> info(Tab) -> Props = get_table_properties(Tab), - io:format("-- Properties for ~w table --- ~n",[Tab]), + io:format("-- Properties for ~tw table --- ~n",[Tab]), info2(Tab, Props). info2(Tab, [{cstruct, _V} | Tail]) -> % Ignore cstruct info2(Tab, Tail); info2(Tab, [{frag_hash, _V} | Tail]) -> % Ignore frag_hash info2(Tab, Tail); info2(Tab, [{P, V} | Tail]) -> - io:format("~-20w -> ~p~n",[P,V]), + io:format("~-20tw -> ~tp~n",[P,V]), info2(Tab, Tail); info2(_, []) -> io:format("~n", []). @@ -3726,7 +3726,7 @@ merge_versions(AnythingNew, Cs, RemoteCs, Force) -> ok; true -> Str = io_lib:format("Bad cookies. Cannot merge definitions of " - "table ~w. Local = ~w, Remote = ~w~n", + "table ~tw. Local = ~w, Remote = ~w~n", [Cs#cstruct.name, Cs, RemoteCs]), throw(Str) end, @@ -3746,7 +3746,7 @@ merge_versions(AnythingNew, Cs, RemoteCs, Force) -> do_merge_versions(AnythingNew, Cs, RemoteCs); true -> Str1 = io_lib:format("Cannot merge definitions of " - "table ~w. Local = ~w, Remote = ~w~n", + "table ~tw. Local = ~w, Remote = ~w~n", [Cs#cstruct.name, Cs, RemoteCs]), throw(Str1) end. diff --git a/lib/mnesia/src/mnesia_subscr.erl b/lib/mnesia/src/mnesia_subscr.erl index c2748f5bae..dfaa20d2d3 100644 --- a/lib/mnesia/src/mnesia_subscr.erl +++ b/lib/mnesia/src/mnesia_subscr.erl @@ -264,7 +264,7 @@ handle_call({change, How}, _From, State) -> {reply, Reply, State}; handle_call(Msg, _From, State) -> - error("~p got unexpected call: ~p~n", [?MODULE, Msg]), + error("~p got unexpected call: ~tp~n", [?MODULE, Msg]), {noreply, State}. %%---------------------------------------------------------------------- @@ -274,7 +274,7 @@ handle_call(Msg, _From, State) -> %% {stop, Reason, State} (terminate/2 is called) %%---------------------------------------------------------------------- handle_cast(Msg, State) -> - error("~p got unexpected cast: ~p~n", [?MODULE, Msg]), + error("~p got unexpected cast: ~tp~n", [?MODULE, Msg]), {noreply, State}. %%---------------------------------------------------------------------- @@ -292,7 +292,7 @@ handle_info({'EXIT', Pid, _Reason}, State) -> {noreply, State}; handle_info(Msg, State) -> - error("~p got unexpected info: ~p~n", [?MODULE, Msg]), + error("~p got unexpected info: ~tp~n", [?MODULE, Msg]), {noreply, State}. %%---------------------------------------------------------------------- diff --git a/lib/mnesia/src/mnesia_text.erl b/lib/mnesia/src/mnesia_text.erl index 21adca813a..7d24d09472 100644 --- a/lib/mnesia/src/mnesia_text.erl +++ b/lib/mnesia/src/mnesia_text.erl @@ -87,18 +87,18 @@ validate_tab(_) -> error(badtab). make_tabs([{Tab, Def} | Tail]) -> try mnesia:table_info(Tab, where_to_read) of Node -> - io:format("** Table ~w already exists on ~p, just entering data~n", + io:format("** Table ~tw already exists on ~p, just entering data~n", [Tab, Node]), make_tabs(Tail) catch exit:_ -> %% non-existing table case mnesia:create_table(Tab, Def) of {aborted, Reason} -> - io:format("** Failed to create table ~w ~n" - "** Reason = ~w, Args = ~p~n", + io:format("** Failed to create table ~tw ~n" + "** Reason = ~tw, Args = ~tp~n", [Tab, Reason, Def]), [Tab | make_tabs(Tail)]; _ -> - io:format("New table ~w~n", [Tab]), + io:format("New table ~tw~n", [Tab]), make_tabs(Tail) end end; @@ -139,12 +139,12 @@ collect_data(Tabs, [{Line, Term} | Tail]) when is_tuple(Term) -> {value, _} -> [Term | collect_data(Tabs, Tail)]; _Other -> - io:format("Object:~p at line ~w unknown\n", [Term,Line]), + io:format("Object:~tp at line ~w unknown\n", [Term,Line]), error(undefined_object) end; collect_data(_Tabs, []) -> []; collect_data(_Tabs, [H|_T]) -> - io:format("Object:~p unknown\n", [H]), + io:format("Object:~tp unknown\n", [H]), error(undefined_object). error(What) -> throw({error, What}). @@ -178,7 +178,7 @@ read_term_from_stream(Stream, File, Line) -> {ok, {Line, Term}, EndLine}; {error, {NewLine,Mod,What}} -> Str = Mod:format_error(What), - io:format("Error in line:~p of:~p ~s\n", + io:format("Error in line:~p of:~tp ~ts\n", [NewLine, File, Str]), error end; diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index 305bf14bcf..ebf580d09e 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -314,7 +314,7 @@ doit_loop(#state{coordinators=Coordinators,participants=Participants,supervisor= ?eval_debug_fun({?MODULE, do_abort, pre}, [{tid, Tid}]), case gb_trees:lookup(Tid, Participants) of none -> - verbose("Tried to abort a non participant transaction ~p: ~p~n", + verbose("Tried to abort a non participant transaction ~p: ~tp~n", [Tid, Reason]), mnesia_locker:release_tid(Tid), doit_loop(State); @@ -417,7 +417,7 @@ doit_loop(#state{coordinators=Coordinators,participants=Participants,supervisor= {From, {unblock_me, Tab}} -> case lists:member(Tab, State#state.blocked_tabs) of false -> - verbose("Wrong dirty Op blocked on ~p ~p ~p", + verbose("Wrong dirty Op blocked on ~p ~tp ~p", [node(), Tab, From]), reply(From, unblocked), doit_loop(State); @@ -466,11 +466,11 @@ doit_loop(#state{coordinators=Coordinators,participants=Participants,supervisor= end; {system, From, Msg} -> - dbg_out("~p got {system, ~p, ~p}~n", [?MODULE, From, Msg]), + dbg_out("~p got {system, ~p, ~tp}~n", [?MODULE, From, Msg]), sys:handle_system_msg(Msg, From, Sup, ?MODULE, [], State); Msg -> - verbose("** ERROR ** ~p got unexpected message: ~p~n", [?MODULE, Msg]), + verbose("** ERROR ** ~p got unexpected message: ~tp~n", [?MODULE, Msg]), doit_loop(State) end. @@ -556,7 +556,7 @@ handle_exit(Pid, Reason, State) -> %% We got exit from a local fool doit_loop(State); {P = #participant{}, _RestP} -> - fatal("Participant ~p in transaction ~p died ~p~n", + fatal("Participant ~p in transaction ~p died ~tp~n", [P#participant.pid, P#participant.tid, Reason]), NewPs = gb_trees:delete(P#participant.tid,State#state.participants), doit_loop(State#state{participants = NewPs}) @@ -598,7 +598,7 @@ recover_coordinator(Tid, Etabs) -> ok %% to the new nested trans store. end catch _:Reason -> - dbg_out("Recovery of coordinator ~p failed:~n", + dbg_out("Recovery of coordinator ~p failed: ~tp~n", [Tid, {Reason, erlang:get_stacktrace()}]), Protocol = asym_trans, tell_outcome(Tid, Protocol, node(), CheckNodes, TellNodes) @@ -941,7 +941,7 @@ decr(_X) -> 0. return_abort(Fun, Args, Reason) -> {_Mod, Tid, Ts} = get(mnesia_activity_state), - dbg_out("Transaction ~p calling ~p with ~p failed: ~n ~p~n", + dbg_out("Transaction ~p calling ~tp with ~tp failed: ~n ~tp~n", [Tid, Fun, Args, Reason]), OldStore = Ts#tidstore.store, Nodes = get_elements(nodes, OldStore), @@ -1714,7 +1714,7 @@ commit_participant(Coord, Tid, Bin, C0, DiscNs, _RamNs) -> mnesia_schema:undo_prepare_commit(Tid, C0); Msg -> - verbose("** ERROR ** commit_participant ~p, got unexpected msg: ~p~n", + verbose("** ERROR ** commit_participant ~p, got unexpected msg: ~tp~n", [Tid, Msg]) end; {Tid, {do_abort, Reason}} -> @@ -1730,7 +1730,7 @@ commit_participant(Coord, Tid, Bin, C0, DiscNs, _RamNs) -> Msg -> reply(Coord, {do_abort, Tid, self(), {bad_commit,internal}}), - verbose("** ERROR ** commit_participant ~p, got unexpected msg: ~p~n", + verbose("** ERROR ** commit_participant ~p, got unexpected msg: ~tp~n", [Tid, Msg]) end catch _:Reason -> @@ -1804,7 +1804,7 @@ do_update(Tid, Storage, [Op | Ops], OldRes) -> %% Determine actual storage type and try again. %% BUGBUG: Updates may be lost if table is transformed. ST = erlang:get_stacktrace(), - verbose("do_update in ~w failed: ~p -> {'EXIT', ~p}~n", + verbose("do_update in ~w failed: ~tp -> {'EXIT', ~tp}~n", [Tid, Op, {Reason, ST}]), do_update(Tid, Storage, Ops, OldRes) end; @@ -1919,7 +1919,7 @@ do_snmp(Tid, [Head|Tail]) -> %% deleted our local replica or recently deattached %% the snmp table ST = erlang:get_stacktrace(), - verbose("do_snmp in ~w failed: ~p -> {'EXIT', ~p}~n", + verbose("do_snmp in ~w failed: ~tp -> {'EXIT', ~tp}~n", [Tid, Head, {Reason, ST}]) end, do_snmp(Tid, Tail). @@ -2151,7 +2151,7 @@ pr_participant(Stream, P) -> true -> Commit0 end, pr_tid(Stream, P#participant.tid), - io:format(Stream, "with participant objects ~p~n", [Commit]). + io:format(Stream, "with participant objects ~tp~n", [Commit]). pr_tid(Stream, Tid) -> @@ -2193,7 +2193,7 @@ search_pr_participant(S, [ P | Tail]) -> true -> Commit0 end, - io:format("~p~n", [Commit]), + io:format("~tp~n", [Commit]), search_pr_participant(S,Tail); %% !!!!! true -> search_pr_participant(S, Tail) @@ -2214,12 +2214,12 @@ display_pid_info(Pid) -> Reds = fetch(reductions, Info), LM = length(fetch(messages, Info)), pformat(io_lib:format("~p", [Pid]), - io_lib:format("~p", [Call]), - io_lib:format("~p", [Curr]), Reds, LM) + io_lib:format("~tp", [Call]), + io_lib:format("~tp", [Curr]), Reds, LM) end. pformat(A1, A2, A3, A4, A5) -> - io:format( "~-12s ~-21s ~-21s ~9w ~4w~n", [A1,A2,A3,A4,A5]). + io:format( "~-12s ~-21ts ~-21ts ~9w ~4w~n", [A1,A2,A3,A4,A5]). fetch(Key, Info) -> case lists:keysearch(Key, 1, Info) of diff --git a/lib/observer/src/cdv_atom_cb.erl b/lib/observer/src/cdv_atom_cb.erl index a123354c8f..86cdf2fd6d 100644 --- a/lib/observer/src/cdv_atom_cb.erl +++ b/lib/observer/src/cdv_atom_cb.erl @@ -42,7 +42,7 @@ get_info(_) -> {Info,TW}. format({Bin,q}) when is_binary(Bin) -> - [$'|binary_to_list(Bin)]; + [$'|lists:flatten(io_lib:format("~ts",[Bin]))]; format({Bin,nq}) when is_binary(Bin) -> lists:flatten(io_lib:format("~ts",[Bin])); format(D) -> diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index 5472d36a6f..5502869973 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -38,6 +38,7 @@ init_bin_page(Parent,{Type,Bin}) -> [{"Format \~p",cdv_html_wx,{Type,format_bin_fun("~p",Bin)}}, {"Format \~tp",cdv_html_wx,{Type,format_bin_fun("~tp",Bin)}}, {"Format \~w",cdv_html_wx,{Type,format_bin_fun("~w",Bin)}}, + {"Format \~tw",cdv_html_wx,{Type,format_bin_fun("~tw",Bin)}}, {"Format \~s",cdv_html_wx,{Type,format_bin_fun("~s",Bin)}}, {"Format \~ts",cdv_html_wx,{Type,format_bin_fun("~ts",Bin)}}, {"Hex",cdv_html_wx,{Type,hex_binary_fun(Bin)}}, @@ -56,7 +57,7 @@ format_bin_fun(Format,Bin) -> binary_to_term_fun(Bin) -> fun() -> try binary_to_term(Bin) of - Term -> plain_html(io_lib:format("~p",[Term])) + Term -> plain_html(io_lib:format("~tp",[Term])) catch error:badarg -> Warning = "This binary can not be converted to an Erlang term", observer_html_lib:warning(Warning) diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index 27057fd27f..4c26e447a6 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -133,7 +133,7 @@ handle_event(Event, _State) -> error({unhandled_event, Event}). handle_info(_Info, State) -> - %% io:format("~p: ~p, Handle info: ~p~n", [?MODULE, ?LINE, _Info]), + %% io:format("~p: ~p, Handle info: ~tp~n", [?MODULE, ?LINE, _Info]), {noreply, State}. handle_call(Call, From, _State) -> diff --git a/lib/observer/src/cdv_html_wx.erl b/lib/observer/src/cdv_html_wx.erl index 0ab0ba4315..5158e95a65 100644 --- a/lib/observer/src/cdv_html_wx.erl +++ b/lib/observer/src/cdv_html_wx.erl @@ -62,7 +62,7 @@ handle_info(active, State) -> {noreply, State}; handle_info(Info, State) -> - io:format("~p:~p: Unhandled info: ~p~n", [?MODULE, ?LINE, Info]), + io:format("~p:~p: Unhandled info: ~tp~n", [?MODULE, ?LINE, Info]), {noreply, State}. terminate(_Reason, _State) -> @@ -72,7 +72,7 @@ code_change(_, _, State) -> {ok, State}. handle_call(Msg, _From, State) -> - io:format("~p~p: Unhandled Call ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p~p: Unhandled Call ~tp~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. handle_cast({detail_win_closed, Id},#state{expand_wins=Opened0}=State) -> @@ -80,7 +80,7 @@ handle_cast({detail_win_closed, Id},#state{expand_wins=Opened0}=State) -> {noreply, State#state{expand_wins=Opened}}; handle_cast(Msg, State) -> - io:format("~p~p: Unhandled cast ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]), {noreply, State}. handle_event(#wx{event=#wxHtmlLink{type=command_html_link_clicked, @@ -118,7 +118,7 @@ handle_event(#wx{event=#wxHtmlLink{type=command_html_link_clicked, {noreply, NewState}; handle_event(Event, State) -> - io:format("~p:~p: Unhandled event ~p\n", [?MODULE,?LINE,Event]), + io:format("~p:~p: Unhandled event ~tp\n", [?MODULE,?LINE,Event]), {noreply, State}. %%%----------------------------------------------------------------- diff --git a/lib/observer/src/cdv_info_wx.erl b/lib/observer/src/cdv_info_wx.erl index 01fe6b15f2..7e416dd11a 100644 --- a/lib/observer/src/cdv_info_wx.erl +++ b/lib/observer/src/cdv_info_wx.erl @@ -65,7 +65,7 @@ handle_info(active, State) -> {noreply, State}; handle_info(Info, State) -> - io:format("~p:~p: Unhandled info: ~p~n", [?MODULE, ?LINE, Info]), + io:format("~p:~p: Unhandled info: ~tp~n", [?MODULE, ?LINE, Info]), {noreply, State}. terminate(_Reason, _State) -> @@ -88,11 +88,11 @@ handle_call(new_dump, _From, #state{callback=Callback,panel=Panel, {reply, ok, State#state{fpanel=NewFPanel,trunc_warn=TW}}; handle_call(Msg, _From, State) -> - io:format("~p~p: Unhandled Call ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p~p: Unhandled Call ~tp~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. handle_cast(Msg, State) -> - io:format("~p~p: Unhandled cast ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]), {noreply, State}. handle_event(#wx{event=#wxMouse{type=left_down},userData=Target}, State) -> @@ -108,7 +108,7 @@ handle_event(#wx{obj=Obj,event=#wxMouse{type=leave_window}},State) -> {noreply, State}; handle_event(Event, State) -> - io:format("~p:~p: Unhandled event ~p\n", [?MODULE,?LINE,Event]), + io:format("~p:~p: Unhandled event ~tp\n", [?MODULE,?LINE,Event]), {noreply, State}. %%%----------------------------------------------------------------- diff --git a/lib/observer/src/cdv_multi_wx.erl b/lib/observer/src/cdv_multi_wx.erl index b511503752..93f045b1da 100644 --- a/lib/observer/src/cdv_multi_wx.erl +++ b/lib/observer/src/cdv_multi_wx.erl @@ -94,7 +94,7 @@ handle_info(active, State) -> {noreply, NewState}; handle_info(Info, State) -> - io:format("~p:~p: Unhandled info: ~p~n", [?MODULE, ?LINE, Info]), + io:format("~p:~p: Unhandled info: ~tp~n", [?MODULE, ?LINE, Info]), {noreply, State}. terminate(_Reason, _State) -> @@ -112,11 +112,11 @@ handle_call(new_dump, _From, State) -> {reply, ok, NewState}; handle_call(Msg, _From, State) -> - io:format("~p:~p: Unhandled Call ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p:~p: Unhandled Call ~tp~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. handle_cast(Msg, State) -> - io:format("~p:~p: Unhandled cast ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p:~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]), {noreply, State}. handle_event(#wx{event=#wxCommand{type=command_listbox_selected, @@ -136,7 +136,7 @@ handle_event(#wx{event=#wxCommand{type=command_listbox_selected, {noreply,NewState}; handle_event(Event, State) -> - io:format("~p:~p: Unhandled event ~p\n", [?MODULE,?LINE,Event]), + io:format("~p:~p: Unhandled event ~tp\n", [?MODULE,?LINE,Event]), {noreply, State}. %%%%%%%%%%%%%%%%%%%%%%% Internal %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/cdv_proc_cb.erl b/lib/observer/src/cdv_proc_cb.erl index 592150146b..f10650bbb7 100644 --- a/lib/observer/src/cdv_proc_cb.erl +++ b/lib/observer/src/cdv_proc_cb.erl @@ -71,7 +71,7 @@ get_details(Id, _) -> Proplist0 = crashdump_viewer:to_proplist(record_info(fields,proc),Info), Proplist = [{expand_table,Tab}|Proplist0], - Title = io_lib:format("~s (~s)",[Info#proc.name, Id]), + Title = io_lib:format("~ts (~s)",[Info#proc.name, Id]), {ok,{Title,Proplist,TW}}; {error,{other_node,NodeId}} -> Info = "The process you are searching for was residing on " diff --git a/lib/observer/src/cdv_table_wx.erl b/lib/observer/src/cdv_table_wx.erl index df16230b70..ba23758ea6 100644 --- a/lib/observer/src/cdv_table_wx.erl +++ b/lib/observer/src/cdv_table_wx.erl @@ -74,7 +74,7 @@ handle_info(active, State) -> {noreply, State}; handle_info(Info, State) -> - io:format("~p:~p: Unhandled info: ~p~n", [?MODULE, ?LINE, Info]), + io:format("~p:~p: Unhandled info: ~tp~n", [?MODULE, ?LINE, Info]), {noreply, State}. terminate(_Reason, _State) -> @@ -84,15 +84,15 @@ code_change(_, _, State) -> {ok, State}. handle_call(Msg, _From, State) -> - io:format("~p~p: Unhandled Call ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p~p: Unhandled Call ~tp~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. handle_cast(Msg, State) -> - io:format("~p~p: Unhandled cast ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]), {noreply, State}. handle_event(Event, State) -> - io:format("~p:~p: Unhandled event ~p\n", [?MODULE,?LINE,Event]), + io:format("~p:~p: Unhandled event ~tp\n", [?MODULE,?LINE,Event]), {noreply, State}. %%%%%%%%%%%%%%%%%%%%%%% Internal %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/cdv_term_cb.erl b/lib/observer/src/cdv_term_cb.erl index f0d90dde7c..f206d7e4c9 100644 --- a/lib/observer/src/cdv_term_cb.erl +++ b/lib/observer/src/cdv_term_cb.erl @@ -57,13 +57,7 @@ expand(['#CDVBin',Offset,Size,Pos], true) -> {ok,Bin} = crashdump_viewer:expand_binary({Offset,Size,Pos}), Bin; expand(Bin, Tab) when is_binary(Bin), not is_boolean(Tab) -> - Size = byte_size(Bin), - PrevSize = min(Size, 10) * 8, - <<Preview:PrevSize, _/binary>> = Bin, - Hash = erlang:phash2(Bin), - Key = {Preview, Size, Hash}, - ets:insert(Tab, {Key,Bin}), - ['#OBSBin',Preview,Size,Hash]; + observer_lib:make_obsbin(Bin, Tab); expand([H|T], Expand) -> case expand(T, Expand) of ET when is_list(ET) -> diff --git a/lib/observer/src/cdv_virtual_list_wx.erl b/lib/observer/src/cdv_virtual_list_wx.erl index ebf58865e9..f3daae8e4d 100644 --- a/lib/observer/src/cdv_virtual_list_wx.erl +++ b/lib/observer/src/cdv_virtual_list_wx.erl @@ -73,7 +73,7 @@ start_detail_win(Id) -> "#Port"++_ -> start_detail_win(Id, port); _ -> - io:format("cdv: unknown identifier: ~p~n",[Id]), + io:format("cdv: unknown identifier: ~tp~n",[Id]), ignore end. @@ -195,7 +195,7 @@ call(Holder, What) when is_pid(Holder) -> erlang:demonitor(Ref), Res after 5000 -> - io:format("Hanging call ~p~n",[What]), + io:format("Hanging call ~tp~n",[What]), "" end; call(_,_) -> @@ -214,7 +214,7 @@ handle_info(active, State) -> {noreply, State}; handle_info(Info, State) -> - io:format("~p:~p, Unexpected info: ~p~n", [?MODULE, ?LINE, Info]), + io:format("~p:~p, Unexpected info: ~tp~n", [?MODULE, ?LINE, Info]), {noreply, State}. terminate(_Reason, #state{holder=Holder}) -> @@ -236,7 +236,7 @@ handle_call(new_dump, _From, {reply, ok, State#state{detail_wins=[],holder=NewHolder,trunc_warn=TW}}; handle_call(Msg, _From, State) -> - io:format("~p:~p: Unhandled call ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p:~p: Unhandled call ~tp~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. handle_cast({start_detail_win,Id}, State) -> @@ -248,7 +248,7 @@ handle_cast({detail_win_closed, Id},#state{detail_wins=Opened}=State) -> {noreply, State#state{detail_wins=Opened2}}; handle_cast(Msg, State) -> - io:format("~p:~p: Unhandled cast ~p~n", [?MODULE, ?LINE, Msg]), + io:format("~p:~p: Unhandled cast ~tp~n", [?MODULE, ?LINE, Msg]), {noreply, State}. %%%%%%%%%%%%%%%%%%%%LOOP%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -322,7 +322,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_activated, {noreply, State}; handle_event(Event, State) -> - io:format("~p:~p: handle event ~p\n", [?MODULE, ?LINE, Event]), + io:format("~p:~p: handle event ~tp\n", [?MODULE, ?LINE, Event]), {noreply, State}. @@ -382,7 +382,7 @@ table_holder(#holder{callback=Callback, attrs=Attrs, info=Info}=S0) -> stop -> ok; What -> - io:format("Table holder got ~p~n",[What]), + io:format("Table holder got ~tp~n",[What]), table_holder(S0) end. diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl index 1e3fb6289e..898f39ded2 100644 --- a/lib/observer/src/cdv_wx.erl +++ b/lib/observer/src/cdv_wx.erl @@ -306,7 +306,7 @@ handle_info({'EXIT', Pid, normal}, #state{server=Pid}=State) -> {stop, normal, State}; handle_info({'EXIT', Pid, _Reason}, State) -> - io:format("Child (~s) crashed exiting: ~p ~p~n", + io:format("Child (~s) crashed exiting: ~p ~tp~n", [pid2panel(Pid, State), Pid,_Reason]), {stop, normal, State}; diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index 8d70f5e2c8..fd8b3b9e67 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -200,13 +200,13 @@ do_script_start(StartFun) -> {'EXIT', Pid, normal} -> ok; {'EXIT', Pid, Reason} -> - io:format("\ncdv crash: ~p\n",[Reason]) + io:format("\ncdv crash: ~tp\n",[Reason]) end; _ -> io:format("\ncdv crash: ~p\n",[unknown_reason]) end; Error -> - io:format("\ncdv start failed: ~p\n",[Error]) + io:format("\ncdv start failed: ~tp\n",[Error]) end. usage() -> @@ -340,7 +340,7 @@ handle_call(general_info,_From,State=#state{file=File}) -> handle_call({expand_binary,{Offset,Size,Pos}},_From,State=#state{file=File}) -> Fd = open(File), pos_bof(Fd,Pos), - {Bin,_Line} = get_binary(Offset,Size,val(Fd)), + {Bin,_Line} = get_binary(Offset,Size,bytes(Fd)), close(Fd), {reply,{ok,Bin},State}; handle_call(procs_summary,_From,State=#state{file=File,wordsize=WS}) -> @@ -512,9 +512,9 @@ unexpected(_Fd,{eof,_LastLine},_Where) -> ok; % truncated file unexpected(Fd,{part,What},Where) -> skip_rest_of_line(Fd), - io:format("WARNING: Found unexpected line in ~s:~n~s ...~n",[Where,What]); + io:format("WARNING: Found unexpected line in ~ts:~n~ts ...~n",[Where,What]); unexpected(_Fd,What,Where) -> - io:format("WARNING: Found unexpected line in ~s:~n~s~n",[Where,What]). + io:format("WARNING: Found unexpected line in ~ts:~n~ts~n",[Where,What]). truncated_warning([]) -> []; @@ -701,9 +701,24 @@ skip(Fd,<<>>) -> end. -val(Fd) -> - val(Fd, "-1"). -val(Fd, NoExist) -> +string(Fd) -> + string(Fd, "-1"). +string(Fd,NoExist) -> + case bytes(Fd,noexist) of + noexist -> NoExist; + Val -> byte_list_to_string(Val) + end. + +byte_list_to_string(ByteList) -> + Bin = list_to_binary(ByteList), + case unicode:characters_to_list(Bin) of + Str when is_list(Str) -> Str; + _ -> ByteList + end. + +bytes(Fd) -> + bytes(Fd, "-1"). +bytes(Fd, NoExist) -> case get_rest_of_line(Fd) of {eof,[]} -> NoExist; [] -> NoExist; @@ -742,7 +757,7 @@ get_lines_to_empty(Fd,<<$\n:8,Bin/binary>>,[],Lines) -> put_chunk(Fd,Bin), lists:reverse(Lines); get_lines_to_empty(Fd,<<$\n:8,Bin/binary>>,Acc,Lines) -> - get_lines_to_empty(Fd,Bin,[],[lists:reverse(Acc)|Lines]); + get_lines_to_empty(Fd,Bin,[],[byte_list_to_string(lists:reverse(Acc))|Lines]); get_lines_to_empty(Fd,<<$\r:8,Bin/binary>>,Acc,Lines) -> get_lines_to_empty(Fd,Bin,Acc,Lines); get_lines_to_empty(Fd,<<$\s:8,Bin/binary>>,[],Lines) -> @@ -754,7 +769,7 @@ get_lines_to_empty(Fd,<<>>,Acc,Lines) -> {ok,Bin} -> get_lines_to_empty(Fd,Bin,Acc,Lines); eof -> - lists:reverse(Lines,[lists:reverse(Acc)]) + lists:reverse(Lines,[byte_list_to_string(lists:reverse(Acc))]) end. split(Str) -> @@ -816,7 +831,7 @@ do_read_file(File) -> {ok,Binaries,DumpVsn}; _Other -> R = io_lib:format( - "~s is not an Erlang crash dump~n", + "~ts is not an Erlang crash dump~n", [File]), close(Fd), {error,R} @@ -824,20 +839,20 @@ do_read_file(File) -> {ok,<<"<Erlang crash dump>",_Rest/binary>>} -> %% old version - no longer supported R = io_lib:format( - "The crashdump ~s is in the pre-R10B format, " + "The crashdump ~ts is in the pre-R10B format, " "which is no longer supported.~n", [File]), close(Fd), {error,R}; _Other -> R = io_lib:format( - "~s is not an Erlang crash dump~n", + "~ts is not an Erlang crash dump~n", [File]), close(Fd), {error,R} end; _other -> - R = io_lib:format("~s is not an Erlang crash dump~n",[File]), + R = io_lib:format("~ts is not an Erlang crash dump~n",[File]), {error,R} end. @@ -986,7 +1001,7 @@ general_info(File) -> instr_info=InstrInfo}. get_slogan_and_sysvsn(Fd,Acc) -> - case val(Fd,eof) of + case string(Fd,eof) of "Slogan: " ++ SloganPart when Acc==[] -> get_slogan_and_sysvsn(Fd,[SloganPart]); "System version: " ++ SystemVsn -> @@ -1000,14 +1015,14 @@ get_slogan_and_sysvsn(Fd,Acc) -> get_general_info(Fd,GenInfo) -> case line_head(Fd) of "Compiled" -> - get_general_info(Fd,GenInfo#general_info{compile_time=val(Fd)}); + get_general_info(Fd,GenInfo#general_info{compile_time=bytes(Fd)}); "Taints" -> - Val = case val(Fd) of "-1" -> "(none)"; Line -> Line end, + Val = case string(Fd) of "-1" -> "(none)"; Line -> Line end, get_general_info(Fd,GenInfo#general_info{taints=Val}); "Atoms" -> - get_general_info(Fd,GenInfo#general_info{num_atoms=val(Fd)}); + get_general_info(Fd,GenInfo#general_info{num_atoms=bytes(Fd)}); "Calling Thread" -> - get_general_info(Fd,GenInfo#general_info{thread=val(Fd)}); + get_general_info(Fd,GenInfo#general_info{thread=bytes(Fd)}); "=" ++ _next_tag -> GenInfo; Other -> @@ -1068,15 +1083,15 @@ get_proc_details(File,Pid,WS,DumpVsn,Binaries) -> get_procinfo(Fd,Fun,Proc,WS) -> case line_head(Fd) of "State" -> - State = case val(Fd) of + State = case bytes(Fd) of "Garbing" -> "Garbing\n(limited info)"; State0 -> State0 end, get_procinfo(Fd,Fun,Proc#proc{state=State},WS); "Name" -> - get_procinfo(Fd,Fun,Proc#proc{name=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{name=string(Fd)},WS); "Spawned as" -> - IF = val(Fd), + IF = string(Fd), case Proc#proc.name of undefined -> get_procinfo(Fd,Fun,Proc#proc{name=IF,init_func=IF},WS); @@ -1085,17 +1100,17 @@ get_procinfo(Fd,Fun,Proc,WS) -> end; "Message queue length" -> %% stored as integer so we can sort on it - get_procinfo(Fd,Fun,Proc#proc{msg_q_len=list_to_integer(val(Fd))},WS); + get_procinfo(Fd,Fun,Proc#proc{msg_q_len=list_to_integer(bytes(Fd))},WS); "Reductions" -> %% stored as integer so we can sort on it - get_procinfo(Fd,Fun,Proc#proc{reds=list_to_integer(val(Fd))},WS); + get_procinfo(Fd,Fun,Proc#proc{reds=list_to_integer(bytes(Fd))},WS); "Stack+heap" -> %% stored as integer so we can sort on it get_procinfo(Fd,Fun,Proc#proc{stack_heap= - list_to_integer(val(Fd))*WS},WS); + list_to_integer(bytes(Fd))*WS},WS); "Memory" -> %% stored as integer so we can sort on it - get_procinfo(Fd,Fun,Proc#proc{memory=list_to_integer(val(Fd))},WS); + get_procinfo(Fd,Fun,Proc#proc{memory=list_to_integer(bytes(Fd))},WS); {eof,_} -> Proc; % truncated file Other -> @@ -1117,67 +1132,67 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) -> case LineHead of %% - START - moved from get_procinfo - "Spawned by" -> - case val(Fd) of + case bytes(Fd) of "[]" -> get_procinfo(Fd,Fun,Proc,WS); Parent -> get_procinfo(Fd,Fun,Proc#proc{parent=Parent},WS) end; "Started" -> - get_procinfo(Fd,Fun,Proc#proc{start_time=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{start_time=bytes(Fd)},WS); "Last scheduled in for" -> get_procinfo(Fd,Fun,Proc#proc{current_func= {"Last scheduled in for", - val(Fd)}},WS); + string(Fd)}},WS); "Current call" -> get_procinfo(Fd,Fun,Proc#proc{current_func={"Current call", - val(Fd)}},WS); + string(Fd)}},WS); "Number of heap fragments" -> - get_procinfo(Fd,Fun,Proc#proc{num_heap_frag=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{num_heap_frag=bytes(Fd)},WS); "Heap fragment data" -> - get_procinfo(Fd,Fun,Proc#proc{heap_frag_data=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{heap_frag_data=bytes(Fd)},WS); "OldHeap" -> - Bytes = list_to_integer(val(Fd))*WS, + Bytes = list_to_integer(bytes(Fd))*WS, get_procinfo(Fd,Fun,Proc#proc{old_heap=Bytes},WS); "Heap unused" -> - Bytes = list_to_integer(val(Fd))*WS, + Bytes = list_to_integer(bytes(Fd))*WS, get_procinfo(Fd,Fun,Proc#proc{heap_unused=Bytes},WS); "OldHeap unused" -> - Bytes = list_to_integer(val(Fd))*WS, + Bytes = list_to_integer(bytes(Fd))*WS, get_procinfo(Fd,Fun,Proc#proc{old_heap_unused=Bytes},WS); "New heap start" -> - get_procinfo(Fd,Fun,Proc#proc{new_heap_start=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{new_heap_start=bytes(Fd)},WS); "New heap top" -> - get_procinfo(Fd,Fun,Proc#proc{new_heap_top=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{new_heap_top=bytes(Fd)},WS); "Stack top" -> - get_procinfo(Fd,Fun,Proc#proc{stack_top=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{stack_top=bytes(Fd)},WS); "Stack end" -> - get_procinfo(Fd,Fun,Proc#proc{stack_end=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{stack_end=bytes(Fd)},WS); "Old heap start" -> - get_procinfo(Fd,Fun,Proc#proc{old_heap_start=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{old_heap_start=bytes(Fd)},WS); "Old heap top" -> - get_procinfo(Fd,Fun,Proc#proc{old_heap_top=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{old_heap_top=bytes(Fd)},WS); "Old heap end" -> - get_procinfo(Fd,Fun,Proc#proc{old_heap_end=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{old_heap_end=bytes(Fd)},WS); %% - END - moved from get_procinfo - "Last calls" -> get_procinfo(Fd,Fun,Proc#proc{last_calls=get_lines_to_empty(Fd)},WS); "Link list" -> - {Links,Monitors,MonitoredBy} = parse_link_list(val(Fd),[],[],[]), + {Links,Monitors,MonitoredBy} = parse_link_list(bytes(Fd),[],[],[]), get_procinfo(Fd,Fun,Proc#proc{links=Links, monitors=Monitors, mon_by=MonitoredBy},WS); "Program counter" -> - get_procinfo(Fd,Fun,Proc#proc{prog_count=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{prog_count=string(Fd)},WS); "CP" -> - get_procinfo(Fd,Fun,Proc#proc{cp=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{cp=string(Fd)},WS); "arity = " ++ Arity -> %%! Temporary workaround get_procinfo(Fd,Fun,Proc#proc{arity=Arity--"\r\n"},WS); "Run queue" -> - get_procinfo(Fd,Fun,Proc#proc{run_queue=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{run_queue=string(Fd)},WS); "Internal State" -> - get_procinfo(Fd,Fun,Proc#proc{int_state=val(Fd)},WS); + get_procinfo(Fd,Fun,Proc#proc{int_state=string(Fd)},WS); "=" ++ _next_tag -> Proc; Other -> @@ -1204,7 +1219,7 @@ parse_link_list(", "++Rest,Links,Monitors,MonitoredBy) -> parse_link_list([],Links,Monitors,MonitoredBy) -> {lists:reverse(Links),lists:reverse(Monitors),lists:reverse(MonitoredBy)}; parse_link_list(Unexpected,Links,Monitors,MonitoredBy) -> - io:format("WARNING: found unexpected data in link list:~n~s~n",[Unexpected]), + io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]), parse_link_list([],Links,Monitors,MonitoredBy). @@ -1363,7 +1378,7 @@ read_stack_dump(Fd,Pid,BinAddrAdj,Dict) -> end. read_stack_dump1(Fd,BinAddrAdj,Dict,Acc) -> %% This function is never called if the dump is truncated in {?proc_heap,Pid} - case val(Fd) of + case bytes(Fd) of "=" ++ _next_tag -> lists:reverse(Acc); Line -> @@ -1391,7 +1406,7 @@ read_messages(Fd,Pid,BinAddrAdj,Dict) -> end. read_messages1(Fd,BinAddrAdj,Dict,Acc) -> %% This function is never called if the dump is truncated in {?proc_heap,Pid} - case val(Fd) of + case bytes(Fd) of "=" ++ _next_tag -> lists:reverse(Acc); Line -> @@ -1419,7 +1434,7 @@ read_dictionary(Fd,Pid,BinAddrAdj,Dict) -> end. read_dictionary1(Fd,BinAddrAdj,Dict,Acc) -> %% This function is never called if the dump is truncated in {?proc_heap,Pid} - case val(Fd) of + case bytes(Fd) of "=" ++ _next_tag -> lists:reverse(Acc); Line -> @@ -1451,7 +1466,7 @@ read_heap(BinAddrAdj,Dict0) -> end_of_heap -> Dict0; Fd -> - case val(Fd) of + case bytes(Fd) of "=" ++ _next_tag -> put(fd, end_of_heap), Dict0; @@ -1498,42 +1513,42 @@ get_portinfo(Fd,Port) -> case line_head(Fd) of "Slot" -> %% stored as integer so we can sort on it - get_portinfo(Fd,Port#port{slot=list_to_integer(val(Fd))}); + get_portinfo(Fd,Port#port{slot=list_to_integer(bytes(Fd))}); "Connected" -> %% stored as pid so we can sort on it - Connected0 = val(Fd), + Connected0 = bytes(Fd), Connected = try list_to_pid(Connected0) catch error:badarg -> Connected0 end, get_portinfo(Fd,Port#port{connected=Connected}); "Links" -> - Pids = split_pid_list_no_space(val(Fd)), + Pids = split_pid_list_no_space(bytes(Fd)), Links = [{Pid,Pid} || Pid <- Pids], get_portinfo(Fd,Port#port{links=Links}); "Registered as" -> - get_portinfo(Fd,Port#port{name=val(Fd)}); + get_portinfo(Fd,Port#port{name=string(Fd)}); "Monitors" -> - Monitors0 = string:tokens(val(Fd),"()"), + Monitors0 = string:tokens(bytes(Fd),"()"), Monitors = [begin [Pid,Ref] = string:tokens(Mon,","), {Pid,Pid++" ("++Ref++")"} end || Mon <- Monitors0], get_portinfo(Fd,Port#port{monitors=Monitors}); "Port controls linked-in driver" -> - Str = lists:flatten(["Linked in driver: " | val(Fd)]), + Str = lists:flatten(["Linked in driver: " | string(Fd)]), get_portinfo(Fd,Port#port{controls=Str}); "Port controls forker process" -> - Str = lists:flatten(["Forker process: " | val(Fd)]), + Str = lists:flatten(["Forker process: " | string(Fd)]), get_portinfo(Fd,Port#port{controls=Str}); "Port controls external process" -> - Str = lists:flatten(["External proc: " | val(Fd)]), + Str = lists:flatten(["External proc: " | string(Fd)]), get_portinfo(Fd,Port#port{controls=Str}); "Port is a file" -> - Str = lists:flatten(["File: "| val(Fd)]), + Str = lists:flatten(["File: "| string(Fd)]), get_portinfo(Fd,Port#port{controls=Str}); "Port is UNIX fd not opened by emulator" -> - Str = lists:flatten(["UNIX fd not opened by emulator: "| val(Fd)]), + Str = lists:flatten(["UNIX fd not opened by emulator: "| string(Fd)]), get_portinfo(Fd,Port#port{controls=Str}); "=" ++ _next_tag -> Port; @@ -1566,23 +1581,23 @@ tab_is_named(#ets_table{}) -> "no". get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) -> case line_head(Fd) of "Slot" -> - get_etsinfo(Fd,EtsTable#ets_table{slot=list_to_integer(val(Fd))},WS); + get_etsinfo(Fd,EtsTable#ets_table{slot=list_to_integer(bytes(Fd))},WS); "Table" -> - get_etsinfo(Fd,EtsTable#ets_table{id=val(Fd)},WS); + get_etsinfo(Fd,EtsTable#ets_table{id=string(Fd)},WS); "Name" -> - get_etsinfo(Fd,EtsTable#ets_table{name=val(Fd)},WS); + get_etsinfo(Fd,EtsTable#ets_table{name=string(Fd)},WS); "Ordered set (AVL tree), Elements" -> skip_rest_of_line(Fd), get_etsinfo(Fd,EtsTable#ets_table{data_type="tree"},WS); "Buckets" -> %% A bug in erl_db_hash.c prints a space after the buckets %% - need to strip the string to make list_to_integer/1 happy. - Buckets = list_to_integer(string:strip(val(Fd))), + Buckets = list_to_integer(string:strip(bytes(Fd))), get_etsinfo(Fd,EtsTable#ets_table{buckets=Buckets},WS); "Objects" -> - get_etsinfo(Fd,EtsTable#ets_table{size=list_to_integer(val(Fd))},WS); + get_etsinfo(Fd,EtsTable#ets_table{size=list_to_integer(bytes(Fd))},WS); "Words" -> - Words = list_to_integer(val(Fd)), + Words = list_to_integer(bytes(Fd)), Bytes = case Words of -1 -> -1; % probably truncated @@ -1592,37 +1607,37 @@ get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) -> "=" ++ _next_tag -> EtsTable; "Chain Length Min" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_min=>Val}},WS); "Chain Length Avg" -> - Val = try list_to_float(string:strip(val(Fd))) catch _:_ -> "-" end, + Val = try list_to_float(string:strip(bytes(Fd))) catch _:_ -> "-" end, get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_avg=>Val}},WS); "Chain Length Max" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_max=>Val}},WS); "Chain Length Std Dev" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_stddev=>Val}},WS); "Chain Length Expected Std Dev" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_exp_stddev=>Val}},WS); "Fixed" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{fixed=>Val}},WS); "Type" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{data_type=Val},WS); "Protection" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{protection=>Val}},WS); "Compressed" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{compressed=>Val}},WS); "Write Concurrency" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{write_c=>Val}},WS); "Read Concurrency" -> - Val = val(Fd), + Val = bytes(Fd), get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{read_c=>Val}},WS); Other -> unexpected(Fd,Other,"ETS info"), @@ -1672,9 +1687,9 @@ get_timerinfo(Fd,Id) -> get_timerinfo_1(Fd,Timer) -> case line_head(Fd) of "Message" -> - get_timerinfo_1(Fd,Timer#timer{msg=val(Fd)}); + get_timerinfo_1(Fd,Timer#timer{msg=string(Fd)}); "Time left" -> - TimeLeft = list_to_integer(val(Fd) -- " ms"), + TimeLeft = list_to_integer(bytes(Fd) -- " ms"), get_timerinfo_1(Fd,Timer#timer{time=TimeLeft}); "=" ++ _next_tag -> Timer; @@ -1743,37 +1758,37 @@ get_nodeinfo(Fd,Channel,Type,Start) -> get_nodeinfo(Fd,Nod) -> case line_head(Fd) of "Name" -> - get_nodeinfo(Fd,Nod#nod{name=val(Fd)}); + get_nodeinfo(Fd,Nod#nod{name=bytes(Fd)}); "Controller" -> - get_nodeinfo(Fd,Nod#nod{controller=val(Fd)}); + get_nodeinfo(Fd,Nod#nod{controller=bytes(Fd)}); "Creation" -> %% Throwing away elements like "(refc=1)", which might be %% printed from a debug compiled emulator. Creations = lists:flatmap(fun(C) -> try [list_to_integer(C)] catch error:badarg -> [] end - end, string:tokens(val(Fd)," ")), + end, string:tokens(bytes(Fd)," ")), get_nodeinfo(Fd,Nod#nod{creation={creations,Creations}}); "Remote link" -> - Procs = val(Fd), % e.g. "<0.31.0> <4322.54.0>" + Procs = bytes(Fd), % e.g. "<0.31.0> <4322.54.0>" {Local,Remote} = split(Procs), Str = Local++" <-> "++Remote, NewRemLinks = [{Local,Str} | Nod#nod.remote_links], get_nodeinfo(Fd,Nod#nod{remote_links=NewRemLinks}); "Remote monitoring" -> - Procs = val(Fd), % e.g. "<0.31.0> <4322.54.0>" + Procs = bytes(Fd), % e.g. "<0.31.0> <4322.54.0>" {Local,Remote} = split(Procs), Str = Local++" -> "++Remote, NewRemMon = [{Local,Str} | Nod#nod.remote_mon], get_nodeinfo(Fd,Nod#nod{remote_mon=NewRemMon}); "Remotely monitored by" -> - Procs = val(Fd), % e.g. "<0.31.0> <4322.54.0>" + Procs = bytes(Fd), % e.g. "<0.31.0> <4322.54.0>" {Local,Remote} = split(Procs), Str = Local++" <- "++Remote, NewRemMonBy = [{Local,Str} | Nod#nod.remote_mon_by], get_nodeinfo(Fd,Nod#nod{remote_mon_by=NewRemMonBy}); "Error" -> - get_nodeinfo(Fd,Nod#nod{error="ERROR: "++val(Fd)}); + get_nodeinfo(Fd,Nod#nod{error="ERROR: "++string(Fd)}); "=" ++ _next_tag -> Nod; Other -> @@ -1817,9 +1832,9 @@ loaded_mods(File) -> get_loaded_mod_totals(Fd,{CC,OC}) -> case line_head(Fd) of "Current code" -> - get_loaded_mod_totals(Fd,{val(Fd),OC}); + get_loaded_mod_totals(Fd,{bytes(Fd),OC}); "Old code" -> - get_loaded_mod_totals(Fd,{CC,val(Fd)}); + get_loaded_mod_totals(Fd,{CC,bytes(Fd)}); "=" ++ _next_tag -> {CC,OC}; Other -> @@ -1830,10 +1845,10 @@ get_loaded_mod_totals(Fd,{CC,OC}) -> get_loaded_mod_info(Fd,LM,Fun) -> case line_head(Fd) of "Current size" -> - CS = list_to_integer(val(Fd)), + CS = list_to_integer(bytes(Fd)), get_loaded_mod_info(Fd,LM#loaded_mod{current_size=CS},Fun); "Old size" -> - OS = list_to_integer(val(Fd)), + OS = list_to_integer(bytes(Fd)), get_loaded_mod_info(Fd,LM#loaded_mod{old_size=OS},Fun); "=" ++ _next_tag -> LM; @@ -1849,16 +1864,16 @@ main_modinfo(_Fd,LM,_LineHead) -> all_modinfo(Fd,LM,LineHead) -> case LineHead of "Current attributes" -> - Str = hex_to_str(val(Fd,"")), + Str = hex_to_str(bytes(Fd,"")), LM#loaded_mod{current_attrib=Str}; "Current compilation info" -> - Str = hex_to_str(val(Fd,"")), + Str = hex_to_str(bytes(Fd,"")), LM#loaded_mod{current_comp_info=Str}; "Old attributes" -> - Str = hex_to_str(val(Fd,"")), + Str = hex_to_str(bytes(Fd,"")), LM#loaded_mod{old_attrib=Str}; "Old compilation info" -> - Str = hex_to_str(val(Fd,"")), + Str = hex_to_str(bytes(Fd,"")), LM#loaded_mod{old_comp_info=Str}; Other -> unexpected(Fd,Other,"loaded modules info"), @@ -1868,7 +1883,7 @@ all_modinfo(Fd,LM,LineHead) -> hex_to_str(Hex) -> Term = hex_to_term(Hex,[]), - io_lib:format("~p~n",[Term]). + io_lib:format("~tp~n",[Term]). hex_to_term([X,Y|Hex],Acc) -> MS = hex_to_dec([X]), @@ -1909,17 +1924,17 @@ funs(File) -> get_funinfo(Fd,Fu) -> case line_head(Fd) of "Module" -> - get_funinfo(Fd,Fu#fu{module=val(Fd)}); + get_funinfo(Fd,Fu#fu{module=bytes(Fd)}); "Uniq" -> - get_funinfo(Fd,Fu#fu{uniq=list_to_integer(val(Fd))}); + get_funinfo(Fd,Fu#fu{uniq=list_to_integer(bytes(Fd))}); "Index" -> - get_funinfo(Fd,Fu#fu{index=list_to_integer(val(Fd))}); + get_funinfo(Fd,Fu#fu{index=list_to_integer(bytes(Fd))}); "Address" -> - get_funinfo(Fd,Fu#fu{address=val(Fd)}); + get_funinfo(Fd,Fu#fu{address=bytes(Fd)}); "Native_address" -> - get_funinfo(Fd,Fu#fu{native_address=val(Fd)}); + get_funinfo(Fd,Fu#fu{native_address=bytes(Fd)}); "Refc" -> - get_funinfo(Fd,Fu#fu{refc=list_to_integer(val(Fd))}); + get_funinfo(Fd,Fu#fu{refc=list_to_integer(bytes(Fd))}); "=" ++ _next_tag -> Fu; Other -> @@ -1999,7 +2014,7 @@ get_meminfo(Fd,Acc) -> {eof,_last_line} -> lists:reverse(Acc); Key -> - get_meminfo(Fd,[{list_to_atom(Key),val(Fd)}|Acc]) + get_meminfo(Fd,[{list_to_atom(Key),bytes(Fd)}|Acc]) end. %%----------------------------------------------------------------- @@ -2023,7 +2038,7 @@ get_allocareainfo(Fd,Acc) -> {eof,_last_line} -> lists:reverse(Acc); Key -> - Val = val(Fd), + Val = bytes(Fd), AllocInfo = case split(Val) of {Alloc,[]} -> @@ -2061,7 +2076,7 @@ get_allocatorinfo1(Fd,Acc,Max) -> {eof,_last_line} -> pad_and_reverse(Acc,Max,[]); Key -> - Values = get_all_vals(val(Fd),[]), + Values = get_all_vals(bytes(Fd),[]), L = length(Values), Max1 = if L > Max -> L; true -> Max end, get_allocatorinfo1(Fd,[{Key,Values}|Acc],Max1) @@ -2316,13 +2331,13 @@ get_hashtableinfo(Fd,Name,Start) -> get_hashtableinfo1(Fd,HashTable) -> case line_head(Fd) of "size" -> - get_hashtableinfo1(Fd,HashTable#hash_table{size=val(Fd)}); + get_hashtableinfo1(Fd,HashTable#hash_table{size=bytes(Fd)}); "used" -> - get_hashtableinfo1(Fd,HashTable#hash_table{used=val(Fd)}); + get_hashtableinfo1(Fd,HashTable#hash_table{used=bytes(Fd)}); "objs" -> - get_hashtableinfo1(Fd,HashTable#hash_table{objs=val(Fd)}); + get_hashtableinfo1(Fd,HashTable#hash_table{objs=bytes(Fd)}); "depth" -> - get_hashtableinfo1(Fd,HashTable#hash_table{depth=val(Fd)}); + get_hashtableinfo1(Fd,HashTable#hash_table{depth=bytes(Fd)}); "=" ++ _next_tag -> HashTable; Other -> @@ -2353,15 +2368,15 @@ get_indextableinfo(Fd,Name,Start) -> get_indextableinfo1(Fd,IndexTable) -> case line_head(Fd) of "size" -> - get_indextableinfo1(Fd,IndexTable#index_table{size=val(Fd)}); + get_indextableinfo1(Fd,IndexTable#index_table{size=bytes(Fd)}); "used" -> - get_indextableinfo1(Fd,IndexTable#index_table{used=val(Fd)}); + get_indextableinfo1(Fd,IndexTable#index_table{used=bytes(Fd)}); "limit" -> - get_indextableinfo1(Fd,IndexTable#index_table{limit=val(Fd)}); + get_indextableinfo1(Fd,IndexTable#index_table{limit=bytes(Fd)}); "rate" -> - get_indextableinfo1(Fd,IndexTable#index_table{rate=val(Fd)}); + get_indextableinfo1(Fd,IndexTable#index_table{rate=bytes(Fd)}); "entries" -> - get_indextableinfo1(Fd,IndexTable#index_table{entries=val(Fd)}); + get_indextableinfo1(Fd,IndexTable#index_table{entries=bytes(Fd)}); "=" ++ _next_tag -> IndexTable; Other -> @@ -2393,45 +2408,45 @@ get_schedulerinfo(Fd,Name,Start) -> get_schedulerinfo1(Fd,Sched=#sched{details=Ds}) -> case line_head(Fd) of "Current Process" -> - get_schedulerinfo1(Fd,Sched#sched{process=val(Fd, "None")}); + get_schedulerinfo1(Fd,Sched#sched{process=bytes(Fd, "None")}); "Current Port" -> - get_schedulerinfo1(Fd,Sched#sched{port=val(Fd, "None")}); + get_schedulerinfo1(Fd,Sched#sched{port=bytes(Fd, "None")}); "Run Queue Max Length" -> - RQMax = list_to_integer(val(Fd)), + RQMax = list_to_integer(bytes(Fd)), RQ = RQMax + Sched#sched.run_q, get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_max=>RQMax}}); "Run Queue High Length" -> - RQHigh = list_to_integer(val(Fd)), + RQHigh = list_to_integer(bytes(Fd)), RQ = RQHigh + Sched#sched.run_q, get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_high=>RQHigh}}); "Run Queue Normal Length" -> - RQNorm = list_to_integer(val(Fd)), + RQNorm = list_to_integer(bytes(Fd)), RQ = RQNorm + Sched#sched.run_q, get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_norm=>RQNorm}}); "Run Queue Low Length" -> - RQLow = list_to_integer(val(Fd)), + RQLow = list_to_integer(bytes(Fd)), RQ = RQLow + Sched#sched.run_q, get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_low=>RQLow}}); "Run Queue Port Length" -> - RQ = list_to_integer(val(Fd)), + RQ = list_to_integer(bytes(Fd)), get_schedulerinfo1(Fd,Sched#sched{port_q=RQ}); "Scheduler Sleep Info Flags" -> - get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_info=>val(Fd, "None")}}); + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_info=>bytes(Fd, "None")}}); "Scheduler Sleep Info Aux Work" -> - get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_aux=>val(Fd, "None")}}); + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_aux=>bytes(Fd, "None")}}); "Run Queue Flags" -> - get_schedulerinfo1(Fd,Sched#sched{details=Ds#{runq_flags=>val(Fd, "None")}}); + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{runq_flags=>bytes(Fd, "None")}}); "Current Process State" -> - get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_state=>val(Fd)}}); + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_state=>bytes(Fd)}}); "Current Process Internal State" -> - get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_int_state=>val(Fd)}}); + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_int_state=>bytes(Fd)}}); "Current Process Program counter" -> - get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_prg_cnt=>val(Fd)}}); + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_prg_cnt=>string(Fd)}}); "Current Process CP" -> - get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_cp=>val(Fd)}}); + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_cp=>string(Fd)}}); "Current Process Limited Stack Trace" -> %% If there shall be last in scheduler information block Sched#sched{details=get_limited_stack(Fd, 0, Ds)}; @@ -2443,7 +2458,7 @@ get_schedulerinfo1(Fd,Sched=#sched{details=Ds}) -> end. get_limited_stack(Fd, N, Ds) -> - case val(Fd) of + case string(Fd) of Addr = "0x" ++ _ -> get_limited_stack(Fd, N+1, Ds#{{currp_stack, N} => Addr}); "=" ++ _next_tag -> @@ -2595,7 +2610,7 @@ skip_dist_ext([C|Cs], KeptCs) -> parse_atom([$A|Line0], D) -> {N,":"++Line1} = get_hex(Line0), {Chars, Line} = get_chars(N, Line1), - {list_to_atom(Chars), Line, D}. + {binary_to_atom(list_to_binary(Chars),utf8), Line, D}. parse_atom_translation_table(0, Line0, As) -> {list_to_tuple(lists:reverse(As)), Line0}; @@ -2614,7 +2629,7 @@ deref_ptr(Ptr, Line, BinAddrAdj, D0) -> end_of_heap -> {['#CDVIncompleteHeap'],Line,D0}; Fd -> - case val(Fd) of + case bytes(Fd) of "="++_ -> put(fd, end_of_heap), deref_ptr(Ptr, Line, BinAddrAdj, D0); @@ -2759,7 +2774,7 @@ tag_to_atom("scheduler") -> ?scheduler; tag_to_atom("timer") -> ?timer; tag_to_atom("visible_node") -> ?visible_node; tag_to_atom(UnknownTag) -> - io:format("WARNING: Found unexpected tag:~s~n",[UnknownTag]), + io:format("WARNING: Found unexpected tag:~ts~n",[UnknownTag]), list_to_atom(UnknownTag). %%%----------------------------------------------------------------- diff --git a/lib/observer/src/etop_tr.erl b/lib/observer/src/etop_tr.erl index 8e43f8bb35..1e48fefca4 100644 --- a/lib/observer/src/etop_tr.erl +++ b/lib/observer/src/etop_tr.erl @@ -89,14 +89,14 @@ handle_data(Last, {_, Pid, out, _, Time2} = G, Store) -> end, New; false -> - io:format("Erlang top got garbage ~p~n", [G]), + io:format("Erlang top got garbage ~tp~n", [G]), Last end; handle_data(_W, {drop, D}, _) -> %% Error case we are missing data here! io:format("Erlang top dropped data ~p~n", [D]), []; handle_data(Last, G, _) -> - io:format("Erlang top got garbage ~p~n", [G]), + io:format("Erlang top got garbage ~tp~n", [G]), Last. elapsed({Me1, S1, Mi1}, {Me2, S2, Mi2}) -> diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl index 183641119a..cd3ec62c13 100644 --- a/lib/observer/src/etop_txt.erl +++ b/lib/observer/src/etop_txt.erl @@ -48,7 +48,6 @@ do_update(Prev,Config) -> do_update(standard_io,Info,Prev,Config). do_update(Fd,Info,Prev,Config) -> - Encoding = encoding(Fd), {Cpu,NProcs,RQ,Clock} = loadinfo(Info,Prev), io:nl(Fd), writedoubleline(Fd), @@ -72,7 +71,7 @@ do_update(Fd,Info,Prev,Config) -> io:nl(Fd), writepinfo_header(Fd), writesingleline(Fd), - writepinfo(Fd,Info#etop_info.procinfo,Encoding), + writepinfo(Fd,Info#etop_info.procinfo,modifier(Fd)), writedoubleline(Fd), io:nl(Fd), Info. @@ -93,26 +92,27 @@ writepinfo(Fd,[#etop_proc_info{pid=Pid, cf=MFA, mq=MQ} |T], - Encoding) -> - io:fwrite(Fd,proc_format(Encoding), - [Pid,to_list(Name,Encoding),Time,Reds,Mem,MQ, - formatmfa(MFA,Encoding)]), - writepinfo(Fd,T,Encoding); + Modifier) -> + io:fwrite(Fd,proc_format(Modifier), + [Pid,to_string(Name,Modifier),Time,Reds,Mem,MQ, + to_string(MFA,Modifier)]), + writepinfo(Fd,T,Modifier); writepinfo(_Fd,[],_) -> ok. +proc_format(Modifier) -> + "~-15w~-20"++Modifier++"s~8w~8w~8w~8w ~-20"++Modifier++"s~n". -formatmfa({M, F, A},latin1) -> - io_lib:format("~w:~w/~w",[M, F, A]); -formatmfa({M, F, A},_) -> - io_lib:format("~w:~tw/~w",[M, F, A]); -formatmfa(Other,_) -> - %% E.g. when running hipe - the current_function for some - %% processes will be 'undefined' - io_lib:format("~w",[Other]). +to_string({M,F,A},Modifier) -> + io_lib:format("~w:~"++Modifier++"w/~w",[M,F,A]); +to_string(Other,Modifier) -> + io_lib:format("~"++Modifier++"w",[Other]). -to_list(Name,_) when is_atom(Name) -> atom_to_list(Name); -to_list({_M,_F,_A}=MFA,Encoding) -> formatmfa(MFA,Encoding). +modifier(Device) -> + case encoding(Device) of + latin1 -> ""; + _ -> "t" + end. encoding(Device) -> case io:getopts(Device) of @@ -122,7 +122,3 @@ encoding(Device) -> latin1 end. -proc_format(latin1) -> - "~-15w~-20s~8w~8w~8w~8w ~-20s~n"; -proc_format(_) -> - "~-15w~-20ts~8w~8w~8w~8w ~-20ts~n". diff --git a/lib/observer/src/multitrace.erl b/lib/observer/src/multitrace.erl index a01eeec6ae..82aec05e0d 100644 --- a/lib/observer/src/multitrace.erl +++ b/lib/observer/src/multitrace.erl @@ -103,16 +103,16 @@ print_func(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) -> io:format(Out, "~w: ~s~n" "Process : ~w~n" - "Call : ~w:~w/~w~n" - "Arguments : ~p~n" - "Caller : ~w~n~n", + "Call : ~w:~tw/~w~n" + "Arguments : ~tp~n" + "Caller : ~tw~n~n", [N,ts(Ts),P,M,F,length(A),A,C]); print_func(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> io:format(Out, "~w: ~s~n" "Process : ~w~n" - "Return from : ~w:~w/~w~n" - "Return value : ~p~n~n", + "Return from : ~w:~tw/~w~n" + "Return value : ~tp~n~n", [N,ts(Ts),P,M,F,A,R]). @@ -181,7 +181,7 @@ handle_schedule(Out,{trace_ts,P,out,Info,Ts},_TI,S) -> "out:~n" "Process : ~w~n" "Time : ~s~n" - "Function : ~w~n~n",[P,ts(Ts),Info]), + "Function : ~tw~n~n",[P,ts(Ts),Info]), case lists:keysearch(P,1,S) of {value,{P,List}} -> lists:keyreplace(P,1,S,{P,[{out,Ts}|List]}); @@ -193,7 +193,7 @@ handle_schedule(Out,{trace_ts,P,in,Info,Ts},_TI,S) -> "in:~n" "Process : ~w~n" "Time : ~s~n" - "Function : ~w~n~n",[P,ts(Ts),Info]), + "Function : ~tw~n~n",[P,ts(Ts),Info]), case lists:keysearch(P,1,S) of {value,{P,List}} -> lists:keyreplace(P,1,S,{P,[{in,Ts}|List]}); diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index ef425f0874..7f4b3dd484 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -80,7 +80,7 @@ init([Notebook, Parent, Config]) -> } } catch _:Err -> - io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), + io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, erlang:get_stacktrace()]), {stop, Err} end. @@ -183,7 +183,7 @@ handle_info({'EXIT', Old, _}, State = #state{appmon=Old}) -> {noreply, State#state{active=false, appmon=undefined}}; handle_info(_Event, State) -> - %% io:format("~p:~p: ~p~n",[?MODULE,?LINE,_Event]), + %% io:format("~p:~p: ~tp~n",[?MODULE,?LINE,_Event]), {noreply, State}. terminate(_Event, #state{}) -> diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl index bc4f1fe117..2a481966da 100644 --- a/lib/observer/src/observer_app_wx.erl +++ b/lib/observer/src/observer_app_wx.erl @@ -320,7 +320,7 @@ handle_info({'EXIT', _, noconnection}, State) -> handle_info({'EXIT', _, normal}, State) -> {noreply, State}; handle_info(_Event, State) -> - %% io:format("~p:~p: ~p~n",[?MODULE,?LINE,_Event]), + %% io:format("~p:~p: ~tp~n",[?MODULE,?LINE,_Event]), {noreply, State}. %%%%%%%%%% diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl index 1f1306c370..3dfcc42ada 100644 --- a/lib/observer/src/observer_html_lib.erl +++ b/lib/observer/src/observer_html_lib.erl @@ -142,13 +142,13 @@ dict_table(Tab,{Key0,Value0}, Even) -> tr(color(Even), [td("VALIGN=center",pre(Key)), td(pre(Value))]). proc_state(Tab,{Key0,Value0}, Even) -> - Key = lists:flatten(io_lib:format("~s",[Key0])), + Key = lists:flatten(io_lib:format("~ts",[Key0])), Value = all_or_expand(Tab,Value0), tr(color(Even), [td("VALIGN=center",Key), td(pre(Value))]). all_or_expand(Tab,Term) -> - Preview = io_lib:format("~P",[Term,8]), - Check = io_lib:format("~P",[Term,100]), + Preview = io_lib:format("~tP",[Term,8]), + Check = io_lib:format("~tP",[Term,100]), Exp = Preview=/=Check, all_or_expand(Tab,Term,Preview,Exp). all_or_expand(_Tab,Term,Str,false) @@ -166,13 +166,8 @@ all_or_expand(Tab,Term,Preview,true) "Click to expand above term")]; all_or_expand(Tab,Bin,_PreviewStr,_Expand) when is_binary(Bin) -> - Size = byte_size(Bin), - PrevSize = min(Size, 10) * 8, - <<Preview:PrevSize, _/binary>> = Bin, - Hash = erlang:phash2(Bin), - Key = {Preview, Size, Hash}, - ets:insert(Tab,{Key,Bin}), - Term = io_lib:format("~p", [['#OBSBin',Preview,Size,Hash]]), + OBSBin = observer_lib:make_obsbin(Bin,Tab), + Term = io_lib:format("~tp", [OBSBin]), href_proc_port(lists:flatten(Term), true). color(true) -> io_lib:format("BGCOLOR=\"#~2.16.0B~2.16.0B~2.16.0B\"", tuple_to_list(?BG_EVEN)); @@ -339,9 +334,11 @@ href_proc_bin(From, T, Acc, LTB) -> BinStr = case string:tokens(OffsetSizePos,",.| \n") of [Offset,SizeStr,Pos] when From =:= cdv -> - Id = {list_to_integer(Offset),10,list_to_integer(Pos)}, + Size = list_to_integer(SizeStr), + PreviewSize = min(Size,10), + Id = {list_to_integer(Offset),PreviewSize,list_to_integer(Pos)}, {ok,PreviewBin} = crashdump_viewer:expand_binary(Id), - PreviewStr = preview_string(list_to_integer(SizeStr), PreviewBin), + PreviewStr = preview_string(Size, PreviewBin), if LTB -> href("TARGET=\"expanded\"", ["#Binary?offset="++Offset++ @@ -351,14 +348,14 @@ href_proc_bin(From, T, Acc, LTB) -> true -> PreviewStr end; - [Preview,SizeStr,Md5] when From =:= obs -> + [PreviewIntStr,SizeStr,Md5] when From =:= obs -> Size = list_to_integer(SizeStr), - PrevSize = min(Size, 10) * 8, - PreviewStr = preview_string(Size, - <<(list_to_integer(Preview)):PrevSize>>), + PreviewInt = list_to_integer(PreviewIntStr), + PrevSize = (trunc(math:log2(PreviewInt)/8)+1)*8, + PreviewStr = preview_string(Size,<<PreviewInt:PrevSize>>), if LTB -> href("TARGET=\"expanded\"", - ["#OBSBinary?key1="++Preview++ + ["#OBSBinary?key1="++PreviewIntStr++ "&key2="++SizeStr++ "&key3="++Md5], PreviewStr); @@ -372,14 +369,14 @@ href_proc_bin(From, T, Acc, LTB) -> preview_string(Size, PreviewBin) when Size > 10 -> ["<<", - remove_lgt(io_lib:format("~p",[PreviewBin])), + remove_lgt(io_lib:format("~tp",[PreviewBin])), "...(", observer_lib:to_str({bytes,Size}), ")", ">>"]; preview_string(_, PreviewBin) -> ["<<", - remove_lgt(io_lib:format("~p",[PreviewBin])), + remove_lgt(io_lib:format("~tp",[PreviewBin])), ">>"]. remove_lgt(Deep) -> diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index c7ee294719..463fb5b8ef 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -30,7 +30,8 @@ create_attrs/0, set_listctrl_col_size/2, create_status_bar/1, - html_window/1, html_window/2 + html_window/1, html_window/2, + make_obsbin/2 ]). -include_lib("wx/include/wx.hrl"). @@ -297,8 +298,10 @@ to_str(No) when is_integer(No) -> integer_to_list(No); to_str(Float) when is_float(Float) -> io_lib:format("~.3f", [Float]); +to_str({trunc, Float}) when is_float(Float) -> + float_to_list(Float, [{decimals,0}]); to_str(Term) -> - io_lib:format("~w", [Term]). + io_lib:format("~tw", [Term]). create_menus([], _MenuBar, _Type) -> ok; create_menus(Menus, MenuBar, Type) -> @@ -518,7 +521,7 @@ link_entry2(Panel,{Target,Str},Cursor) -> TC. to_link(RegName={Name, Node}) when is_atom(Name), is_atom(Node) -> - Str = io_lib:format("{~p,~p}", [Name, Node]), + Str = io_lib:format("{~tp,~p}", [Name, Node]), {RegName, Str}; to_link(TI = {_Target, _Identifier}) -> TI; @@ -639,11 +642,11 @@ parse_string(Str) -> Tokens = case erl_scan:string(Str, 1, [text]) of {ok, Ts, _} -> Ts; {error, {_SLine, SMod, SError}, _} -> - throw(io_lib:format("~s", [SMod:format_error(SError)])) + throw(io_lib:format("~ts", [SMod:format_error(SError)])) end, case lib:extended_parse_term(Tokens) of {error, {_PLine, PMod, PError}} -> - throw(io_lib:format("~s", [PMod:format_error(PError)])); + throw(io_lib:format("~ts", [PMod:format_error(PError)])); Res -> Res end catch @@ -767,3 +770,26 @@ update_progress_text(PD,Text) -> end. finish_progress(PD) -> wxProgressDialog:destroy(PD). + +make_obsbin(Bin,Tab) -> + Size = byte_size(Bin), + Preview = + try + %% The binary might be a unicode string, in which case we + %% don't want to split it in the middle of a grapheme + %% cluster - thus trying string:length and slice. + PL1 = min(string:length(Bin), 10), + PB1 = string:slice(Bin,0,PL1), + PS1 = byte_size(PB1) * 8, + <<P1:PS1>> = PB1, + P1 + catch _:_ -> + %% Probably not a string, so just split anywhere + PS2 = min(Size, 10) * 8, + <<P2:PS2, _/binary>> = Bin, + P2 + end, + Hash = erlang:phash2(Bin), + Key = {Preview, Size, Hash}, + ets:insert(Tab, {Key,Bin}), + ['#OBSBin',Preview,Size,Hash]. diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index fcc51310c8..5adfadb16e 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -87,7 +87,7 @@ init([Notebook, Parent, Config]) -> }, {Panel, State0} catch _:Err -> - io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), + io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, erlang:get_stacktrace()]), {stop, Err} end. @@ -235,7 +235,7 @@ handle_info({'EXIT', Old, _}, State = #state{appmon=Old}) -> {noreply, State#state{active=false, appmon=undefined}}; handle_info(_Event, State) -> - %% io:format("~p:~p: ~p~n",[?MODULE,?LINE,_Event]), + %% io:format("~p:~p: ~tp~n",[?MODULE,?LINE,_Event]), {noreply, State}. %%%%%%%%%% diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl index 8339267659..5908e99e36 100644 --- a/lib/observer/src/observer_port_wx.erl +++ b/lib/observer/src/observer_port_wx.erl @@ -338,7 +338,7 @@ handle_info({info, {port_info_not_available,NodeName}}, {noreply, State}; handle_info({error, Error}, #state{panel=Panel} = State) -> - Str = io_lib:format("ERROR: ~s~n",[Error]), + Str = io_lib:format("ERROR: ~ts~n",[Error]), observer_lib:display_info_dialog(Panel, Str), {noreply, State}; diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index 3083297f31..2e5fe0bc1a 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -217,7 +217,7 @@ call(Holder, What) -> erlang:demonitor(Ref), Res after 2000 -> - io:format("Hanging call ~p~n",[What]), + io:format("Hanging call ~tp~n",[What]), "" end. @@ -256,7 +256,7 @@ handle_info(not_active, #state{timer=Timer0}=State) -> {noreply, State#state{timer=Timer}}; handle_info(Info, State) -> - io:format("~p:~p, Unexpected info: ~p~n", [?MODULE, ?LINE, Info]), + io:format("~p:~p, Unexpected info: ~tp~n", [?MODULE, ?LINE, Info]), {noreply, State}. terminate(_Reason, #state{holder=Holder}) -> @@ -273,11 +273,11 @@ handle_call(get_config, _, #state{holder=Holder, timer=Timer}=State) -> {reply, Conf#{acc=>Accum}, State}; handle_call(Msg, _From, State) -> - io:format("~p:~p: Unhandled call ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p:~p: Unhandled call ~tp~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. handle_cast(Msg, State) -> - io:format("~p:~p: Unhandled cast ~p~n", [?MODULE, ?LINE, Msg]), + io:format("~p:~p: Unhandled cast ~tp~n", [?MODULE, ?LINE, Msg]), {noreply, State}. %%%%%%%%%%%%%%%%%%%%LOOP%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -401,7 +401,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_activated}}, {noreply, State#state{procinfo_menu_pids=Opened2}}; handle_event(Event, State) -> - io:format("~p:~p: handle event ~p\n", [?MODULE, ?LINE, Event]), + io:format("~p:~p: handle event ~tp\n", [?MODULE, ?LINE, Event]), {noreply, State}. @@ -559,7 +559,7 @@ table_holder(#holder{info=Info, attrs=Attrs, %% Node crashed will be noticed soon.. table_holder(S0#holder{backend_pid=undefined}); _What -> - %% io:format("~p: Table holder got ~p~n",[?MODULE, _What]), + %% io:format("~p: Table holder got ~tp~n",[?MODULE, _What]), table_holder(S0) end. diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 10decd8b62..963def958b 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -56,7 +56,7 @@ init([Pid, ParentFrame, Parent]) -> Table = ets:new(observer_expand,[set,public]), Title=case observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, registered_name]) of [] -> io_lib:format("~p",[Pid]); - {registered_name, Registered} -> io_lib:format("~p (~p)",[Registered, Pid]); + {registered_name, Registered} -> io_lib:format("~tp (~p)",[Registered, Pid]); undefined -> throw(process_undefined) end, Frame=wxFrame:new(ParentFrame, ?wxID_ANY, [atom_to_list(node(Pid)), $:, Title], @@ -171,7 +171,7 @@ handle_info({get_debug_info, From}, State = #state{notebook=Notebook}) -> From ! {procinfo_debug, Notebook}, {noreply, State}; handle_info(_Info, State) -> - %% io:format("~p: ~p, Handle info: ~p~n", [?MODULE, ?LINE, Info]), + %% io:format("~p: ~p, Handle info: ~tp~n", [?MODULE, ?LINE, Info]), {noreply, State}. handle_call(Call, From, _State) -> @@ -263,7 +263,7 @@ init_stack_page(Parent, Pid) -> wxListCtrl:setItem(LCtrl, Row, 0, observer_lib:to_str({M,F,A})), FileLine = case Info of [{file,File},{line,Line}] -> - io_lib:format("~s:~w", [File,Line]); + io_lib:format("~ts:~w", [File,Line]); _ -> [] end, @@ -487,5 +487,5 @@ io_request({put_chars, Encoding, Module, Function, Args}, State) -> {error, {error, Function}, State} end; io_request(_Req, State) -> - %% io:format("~p: Unknown req: ~p ~n",[?LINE, _Req]), + %% io:format("~p: Unknown req: ~tp ~n",[?LINE, _Req]), {ok, {error, request}, State}. diff --git a/lib/observer/src/observer_sys_wx.erl b/lib/observer/src/observer_sys_wx.erl index db86c05bed..8c2ffd77b4 100644 --- a/lib/observer/src/observer_sys_wx.erl +++ b/lib/observer/src/observer_sys_wx.erl @@ -48,7 +48,7 @@ start_link(Notebook, Parent, Config) -> init([Notebook, Parent, Config]) -> SysInfo = observer_backend:sys_info(), - {Sys, Mem, Cpu, Stats} = info_fields(), + {Sys, Mem, Cpu, Stats, Limits} = info_fields(), Panel = wxPanel:new(Notebook), Sizer = wxBoxSizer:new(?wxVERTICAL), HSizer0 = wxBoxSizer:new(?wxHORIZONTAL), @@ -63,17 +63,26 @@ init([Notebook, Parent, Config]) -> wxSizer:add(HSizer1, FPanel2, [{flag, ?wxEXPAND}, {proportion, 1}]), wxSizer:add(HSizer1, FPanel3, [{flag, ?wxEXPAND}, {proportion, 1}]), + HSizer2 = wxBoxSizer:new(?wxHORIZONTAL), + {FPanel4, _FSizer4, Fields4} = observer_lib:display_info(Panel, observer_lib:fill_info(Limits, SysInfo)), + wxSizer:add(HSizer2, FPanel4, [{flag, ?wxEXPAND}, {proportion, 1}]), + + BorderFlags = ?wxLEFT bor ?wxRIGHT, wxSizer:add(Sizer, HSizer0, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP}, {proportion, 0}, {border, 5}]), wxSizer:add(Sizer, HSizer1, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, {proportion, 0}, {border, 5}]), + wxSizer:add(Sizer, HSizer2, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, + {proportion, 0}, {border, 5}]), + wxPanel:setSizer(Panel, Sizer), Timer = observer_lib:start_timer(Config, 10), {Panel, #sys_wx_state{parent=Parent, parent_notebook=Notebook, panel=Panel, sizer=Sizer, - timer=Timer, fields=Fields0 ++ Fields1++Fields2++Fields3}}. + timer=Timer, fields=Fields0 ++ Fields1++Fields2++Fields3++Fields4}}. + create_sys_menu(Parent) -> View = {"View", [#create_menu{id = ?ID_REFRESH, text = "Refresh\tCtrl-R"}, @@ -83,14 +92,40 @@ create_sys_menu(Parent) -> update_syspage(#sys_wx_state{node = undefined}) -> ignore; update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer}) -> SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), - {Sys, Mem, Cpu, Stats} = info_fields(), + {Sys, Mem, Cpu, Stats, Limits} = info_fields(), observer_lib:update_info(Fields, observer_lib:fill_info(Sys, SysInfo) ++ observer_lib:fill_info(Mem, SysInfo) ++ observer_lib:fill_info(Cpu, SysInfo) ++ - observer_lib:fill_info(Stats, SysInfo)), + observer_lib:fill_info(Stats, SysInfo)++ + observer_lib:fill_info(Limits, SysInfo)), + wxSizer:layout(Sizer). + +maybe_convert(undefined) -> "Not available"; +maybe_convert(V) -> observer_lib:to_str(V). + +get_dist_buf_busy_limit_info() -> + fun(Data) -> + maybe_convert(proplists:get_value(dist_buf_busy_limit, Data)) + end. + +get_limit_count_info(Count, Limit) -> + fun(Data) -> + C = proplists:get_value(Count, Data), + L = proplists:get_value(Limit, Data), + lists:flatten( + io_lib:format("~s / ~s ~s", + [maybe_convert(C), maybe_convert(L), + if + C =:= undefined -> ""; + L =:= undefined -> ""; + true -> io_lib:format("(~s % used)",[observer_lib:to_str({trunc, (C / L) *100})]) + end])) + end. + + info_fields() -> Sys = [{"System and Architecture", [{"System Version", otp_release}, @@ -122,14 +157,20 @@ info_fields() -> ]}], Stats = [{"Statistics", right, [{"Up time", {time_ms, uptime}}, - {"Max Processes", process_limit}, - {"Processes", process_count}, {"Run Queue", run_queue}, {"IO Input", {bytes, io_input}}, {"IO Output", {bytes, io_output}} ]} ], - {Sys, Mem, Cpu, Stats}. + Limits = [{"System statistics / limit", + [{"Atoms", get_limit_count_info(atom_count, atom_limit)}, + {"Processes", get_limit_count_info(process_count, process_limit)}, + {"Ports", get_limit_count_info(port_count, port_limit)}, + {"ETS", get_limit_count_info(ets_count, ets_limit)}, + {"Distribution buffer busy limit", get_dist_buf_busy_limit_info()} + ]}], + {Sys, Mem, Cpu, Stats, Limits}. + %%%%%%%%%%%%%%%%%%%%%%% Callbacks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -158,7 +199,7 @@ handle_info(not_active, #sys_wx_state{timer = Timer} = State) -> {noreply, State#sys_wx_state{timer = observer_lib:stop_timer(Timer)}}; handle_info(Info, State) -> - io:format("~p:~p: Unhandled info: ~p~n", [?MODULE, ?LINE, Info]), + io:format("~p:~p: Unhandled info: ~tp~n", [?MODULE, ?LINE, Info]), {noreply, State}. terminate(_Reason, _State) -> @@ -171,11 +212,11 @@ handle_call(get_config, _, #sys_wx_state{timer=Timer}=State) -> {reply, observer_lib:timer_config(Timer), State}; handle_call(Msg, _From, State) -> - io:format("~p~p: Unhandled Call ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p~p: Unhandled Call ~tp~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. handle_cast(Msg, State) -> - io:format("~p~p: Unhandled cast ~p~n",[?MODULE, ?LINE, Msg]), + io:format("~p~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]), {noreply, State}. handle_event(#wx{id = ?ID_REFRESH, event = #wxCommand{type = command_menu_selected}}, @@ -194,5 +235,5 @@ handle_event(#wx{id = ?ID_REFRESH_INTERVAL, {noreply, State#sys_wx_state{timer=Timer}}; handle_event(Event, State) -> - io:format("~p:~p: Unhandled event ~p\n", [?MODULE,?LINE,Event]), + io:format("~p:~p: Unhandled event ~tp\n", [?MODULE,?LINE,Event]), {noreply, State}. diff --git a/lib/observer/src/observer_trace_wx.erl b/lib/observer/src/observer_trace_wx.erl index b960c61ff0..8127248262 100644 --- a/lib/observer/src/observer_trace_wx.erl +++ b/lib/observer/src/observer_trace_wx.erl @@ -683,7 +683,7 @@ handle_event(#wx{id=?REMOVE_NODES}, #state{n_view=Nview, nodes=Ns0} = State) -> {noreply, State#state{nodes = Ns}}; handle_event(#wx{id=ID, event = What}, State) -> - io:format("~p:~p: Unhandled event: ~p, ~p ~n", [?MODULE, ?LINE, ID, What]), + io:format("~p:~p: Unhandled event: ~p, ~tp ~n", [?MODULE, ?LINE, ID, What]), {noreply, State}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -729,7 +729,7 @@ handle_info({update_ms, NewMs}, State) -> {noreply, State#state{match_specs=NewMs}}; handle_info(Any, State) -> - io:format("~p~p: received unexpected message: ~p\n", [?MODULE, self(), Any]), + io:format("~p~p: received unexpected message: ~tp\n", [?MODULE, self(), Any]), {noreply, State}. terminate(_Reason, #state{nodes=_Nodes}) -> @@ -1046,33 +1046,33 @@ format_trace(Trace, Size, TS0={_,_,MS}) -> case element(4, Trace) of {dbg,ok} -> ""; Message -> - io_lib:format("~s (~100p) << ~100p~n", [TS,From,Message]) + io_lib:format("~s (~100p) << ~100tp~n", [TS,From,Message]) end; 'send' -> Message = element(4, Trace), To = element(5, Trace), - io_lib:format("~s (~100p) ~100p ! ~100p~n", [TS,From,To,Message]); + io_lib:format("~s (~100p) ~100p ! ~100tp~n", [TS,From,To,Message]); call -> case element(4, Trace) of MFA when Size == 5 -> Message = element(5, Trace), - io_lib:format("~s (~100p) call ~s (~100p) ~n", [TS,From,ffunc(MFA),Message]); + io_lib:format("~s (~100p) call ~ts (~100tp) ~n", [TS,From,ffunc(MFA),Message]); MFA -> - io_lib:format("~s (~100p) call ~s~n", [TS,From,ffunc(MFA)]) + io_lib:format("~s (~100p) call ~ts~n", [TS,From,ffunc(MFA)]) end; return_from -> MFA = element(4, Trace), Ret = element(5, Trace), - io_lib:format("~s (~100p) returned from ~s -> ~100p~n", [TS,From,ffunc(MFA),Ret]); + io_lib:format("~s (~100p) returned from ~ts -> ~100tp~n", [TS,From,ffunc(MFA),Ret]); return_to -> MFA = element(4, Trace), - io_lib:format("~s (~100p) returning to ~s~n", [TS,From,ffunc(MFA)]); + io_lib:format("~s (~100p) returning to ~ts~n", [TS,From,ffunc(MFA)]); spawn when Size == 5 -> Pid = element(4, Trace), MFA = element(5, Trace), - io_lib:format("~s (~100p) spawn ~100p as ~s~n", [TS,From,Pid,ffunc(MFA)]); + io_lib:format("~s (~100p) spawn ~100p as ~ts~n", [TS,From,Pid,ffunc(MFA)]); Op -> - io_lib:format("~s (~100p) ~100p ~s~n", [TS,From,Op,ftup(Trace,4,Size)]) + io_lib:format("~s (~100p) ~100p ~ts~n", [TS,From,Op,ftup(Trace,4,Size)]) end. %%% These f* functions returns non-flat strings @@ -1080,24 +1080,24 @@ format_trace(Trace, Size, TS0={_,_,MS}) -> %% {M,F,[A1, A2, ..., AN]} -> "M:F(A1, A2, ..., AN)" %% {M,F,A} -> "M:F/A" ffunc({M,F,Argl}) when is_list(Argl) -> - io_lib:format("~100p:~100p(~s)", [M, F, fargs(Argl)]); + io_lib:format("~100p:~100tp(~ts)", [M, F, fargs(Argl)]); ffunc({M,F,Arity}) -> - io_lib:format("~100p:~100p/~100p", [M,F,Arity]); -ffunc(X) -> io_lib:format("~100p", [X]). + io_lib:format("~100p:~100tp/~100p", [M,F,Arity]); +ffunc(X) -> io_lib:format("~100tp", [X]). %% Integer -> "Integer" %% [A1, A2, ..., AN] -> "A1, A2, ..., AN" fargs(Arity) when is_integer(Arity) -> integer_to_list(Arity); fargs([]) -> []; -fargs([A]) -> io_lib:format("~100p", [A]); %% last arg -fargs([A|Args]) -> [io_lib:format("~100p,", [A]) | fargs(Args)]; -fargs(A) -> io_lib:format("~100p", [A]). % last or only arg +fargs([A]) -> io_lib:format("~100tp", [A]); %% last arg +fargs([A|Args]) -> [io_lib:format("~100tp,", [A]) | fargs(Args)]; +fargs(A) -> io_lib:format("~100tp", [A]). % last or only arg %% {A_1, A_2, ..., A_N} -> "A_Index A_Index+1 ... A_Size" ftup(Trace, Index, Index) -> - io_lib:format("~100p", [element(Index, Trace)]); + io_lib:format("~100tp", [element(Index, Trace)]); ftup(Trace, Index, Size) -> - [io_lib:format("~100p ", [element(Index, Trace)]) + [io_lib:format("~100tp ", [element(Index, Trace)]) | ftup(Trace, Index+1, Size)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1125,18 +1125,19 @@ get_config(#state{def_proc_flags = ProcFlags, write_file(Frame, Filename, Config) -> Str = - ["%%%\n%%% This file is generated by Observer\n", + ["%%% ",epp:encoding_to_string(utf8), "\n" + "%%%\n%%% This file is generated by Observer\n", "%%%\n%%% DO NOT EDIT!\n%%%\n", - [io_lib:format("~p.~n",[MSTerm]) || + [io_lib:format("~tp.~n",[MSTerm]) || MSTerm <- proplists:get_value(match_specs, Config)], io_lib:format("~p.~n",[lists:keyfind(procflags, 1, Config)]), io_lib:format("~p.~n",[lists:keyfind(portflags, 1, Config)]), - io_lib:format("~p.~n",[lists:keyfind(output, 1, Config)]), - [io_lib:format("~p.~n",[ModuleTerm]) || + io_lib:format("~tp.~n",[lists:keyfind(output, 1, Config)]), + [io_lib:format("~tp.~n",[ModuleTerm]) || ModuleTerm <- proplists:get_value(trace_p, Config)] ], - case file:write_file(Filename, list_to_binary(Str)) of + case file:write_file(Filename, unicode:characters_to_binary(Str)) of ok -> success; {error, Reason} -> @@ -1200,7 +1201,7 @@ make_ms(MS) -> make_ms(Name,Term,FunStr). make_ms(Name, Term, FunStr) -> - #match_spec{name=Name, term=Term, str=io_lib:format("~w", Term), func = FunStr}. + #match_spec{name=Name, term=Term, str=io_lib:format("~tw", Term), func = FunStr}. parse_tp({tp, Mod, FAs}, State) -> Patterns = [#tpattern{m=Mod,fa={F,A}, ms=make_ms(List)} || diff --git a/lib/observer/src/observer_traceoptions_wx.erl b/lib/observer/src/observer_traceoptions_wx.erl index 285c298c4b..fbcf6d7fe9 100644 --- a/lib/observer/src/observer_traceoptions_wx.erl +++ b/lib/observer/src/observer_traceoptions_wx.erl @@ -487,7 +487,7 @@ edit_ms(TextCtrl, Label0, Parent) -> _ -> Label0 end, #match_spec{name=Label, term=MatchSpec, - str=io_lib:format("~w",[MatchSpec]), + str=io_lib:format("~tw",[MatchSpec]), func=Str} catch throw:cancel -> @@ -511,18 +511,18 @@ ms_from_string(Str) -> Tokens = case erl_scan:string(Str) of {ok, Ts, _} -> Ts; {error, {SLine, SMod, SError}, _} -> - throw(io_lib:format("~w: ~s", [SLine,SMod:format_error(SError)])) + throw(io_lib:format("~w: ~ts", [SLine,SMod:format_error(SError)])) end, Exprs = case erl_parse:parse_exprs(Tokens) of {ok, T} -> T; {error, {PLine, PMod, PError}} -> - throw(io_lib:format("~w: ~s", [PLine,PMod:format_error(PError)])) + throw(io_lib:format("~w: ~ts", [PLine,PMod:format_error(PError)])) end, Term = case Exprs of [{'fun', _, {clauses, Clauses}}|_] -> case ms_transform:transform_from_shell(dbg,Clauses,orddict:new()) of {error, [{_,[{MSLine,Mod,MSInfo}]}],_} -> - throw(io_lib:format("~w: ~p", [MSLine,Mod:format_error(MSInfo)])); + throw(io_lib:format("~w: ~tp", [MSLine,Mod:format_error(MSInfo)])); {error, _} -> throw("Could not convert fun() to match spec"); Ms -> @@ -536,7 +536,7 @@ ms_from_string(Str) -> {error, List} -> throw([[Error, $\n] || {_, Error} <- List]) end catch error:_Reason -> - %% io:format("Bad term: ~s~n ~p in ~p~n", [Str, _Reason, erlang:get_stacktrace()]), + %% io:format("Bad term: ~ts~n ~tp in ~tp~n", [Str, _Reason, erlang:get_stacktrace()]), throw("Invalid term") end. @@ -556,7 +556,8 @@ filter_listbox_data(Input, Data, ListBox) -> filter_listbox_data(Input, Data, ListBox, true). filter_listbox_data(Input, Data, ListBox, AddClientData) -> - FilteredData = [X || X = {Str, _} <- Data, re:run(Str, Input) =/= nomatch], + FilteredData = [X || X = {Str, _} <- Data, + re:run(Str, Input, [unicode]) =/= nomatch], wxListBox:clear(ListBox), wxListBox:appendStrings(ListBox, [Str || {Str,_} <- FilteredData]), AddClientData andalso @@ -618,7 +619,7 @@ create_styled_txtctrl(Parent) -> keyWords() -> L = ["after","begin","case","try","cond","catch","andalso","orelse", - "end","fun","if","let","of","query","receive","when","bnot","not", + "end","fun","if","let","of","receive","when","bnot","not", "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], lists:flatten([K ++ " " || K <- L] ++ [0]). @@ -648,9 +649,9 @@ parse_function_names(Choices) -> parse_function_names([], Acc) -> lists:reverse(Acc); parse_function_names([{H, Term}|T], Acc) -> - IsFun = re:run(H, ".*-fun-\\d*?-"), - IsLc = re:run(H, ".*-lc\\$\\^\\d*?/\\d*?-\\d*?-"), - IsLbc = re:run(H, ".*-lbc\\$\\^\\d*?/\\d*?-\\d*?-"), + IsFun = re:run(H, ".*-fun-\\d*?-", [unicode,ucp]), + IsLc = re:run(H, ".*-lc\\$\\^\\d*?/\\d*?-\\d*?-", [unicode,ucp]), + IsLbc = re:run(H, ".*-lbc\\$\\^\\d*?/\\d*?-\\d*?-", [unicode,ucp]), Parsed = if IsFun =/= nomatch -> "Fun: " ++ H; IsLc =/= nomatch -> "List comprehension: " ++ H; diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 789e060cfb..d6dcee2cda 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -258,7 +258,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_selected, itemIndex=Index} State = #state{pid=Pid, grid=Grid, status=StatusBar}) -> N = wxListCtrl:getItemCount(Grid), Str = get_row(Pid, Index, all), - wxStatusBar:setStatusText(StatusBar, io_lib:format("Objects: ~w: ~s",[N, Str])), + wxStatusBar:setStatusText(StatusBar, io_lib:format("Objects: ~w: ~ts",[N, Str])), {noreply, State#state{selected=Index}}; handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Index}}, @@ -278,7 +278,7 @@ handle_event(#wx{id=?ID_DELETE}, State = #state{grid=Grid, pid=Pid, status=StatusBar, selected=Index}) -> Str = get_row(Pid, Index, all), Pid ! {delete, Index}, - wxStatusBar:setStatusText(StatusBar, io_lib:format("Deleted object: ~s",[Str])), + wxStatusBar:setStatusText(StatusBar, io_lib:format("Deleted object: ~ts",[Str])), wxListCtrl:setItemState(Grid, Index, 0, ?wxLIST_STATE_FOCUSED), {noreply, State#state{selected=undefined}}; @@ -338,7 +338,7 @@ handle_event(#wx{id=?SEARCH_ENTRY, event=#wxCommand{type=command_text_enter,cmdS Pid ! {mark_search_hit, false}, case search(Pid, Str, Pos, Dir, Case) of false -> - wxStatusBar:setStatusText(SB, io_lib:format("Not found (regexp): ~s",[Str])), + wxStatusBar:setStatusText(SB, io_lib:format("Not found (regexp): ~ts",[Str])), Pid ! {mark_search_hit, Find#find.start}, wxListCtrl:refreshItem(Grid, Find#find.start), {noreply, State#state{search=Search#search{find=Find#find{found=false}}}}; @@ -372,7 +372,7 @@ handle_event(#wx{id=?SEARCH_ENTRY, event=#wxCommand{cmdString=Str}}, Pid ! {mark_search_hit, false}, case search(Pid, Str, Cont#find.start, Dir, Case) of false -> - wxStatusBar:setStatusText(SB, io_lib:format("Not found (regexp): ~s",[Str])), + wxStatusBar:setStatusText(SB, io_lib:format("Not found (regexp): ~ts",[Str])), {noreply, State}; Row -> wxListCtrl:ensureVisible(Grid, Row), @@ -395,19 +395,19 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL}, {noreply, State#state{timer=Timer}}; handle_event(_Event, State) -> - %io:format("~p:~p, handle event ~p\n", [?MODULE, ?LINE, Event]), + %io:format("~p:~p, handle event ~tp\n", [?MODULE, ?LINE, Event]), {noreply, State}. handle_sync_event(_Event, _Obj, _State) -> - %io:format("~p:~p, handle sync_event ~p\n", [?MODULE, ?LINE, Event]), + %io:format("~p:~p, handle sync_event ~tp\n", [?MODULE, ?LINE, Event]), ok. handle_call(_Event, _From, State) -> - %io:format("~p:~p, handle call (~p) ~p\n", [?MODULE, ?LINE, From, Event]), + %io:format("~p:~p, handle call (~p) ~tp\n", [?MODULE, ?LINE, From, Event]), {noreply, State}. handle_cast(_Event, State) -> - %io:format("~p:~p, handle cast ~p\n", [?MODULE, ?LINE, Event]), + %io:format("~p:~p, handle cast ~tp\n", [?MODULE, ?LINE, Event]), {noreply, State}. handle_info({no_rows, N}, State = #state{grid=Grid, status=StatusBar}) -> @@ -433,7 +433,7 @@ handle_info(refresh_interval, State = #state{pid=Pid}) -> handle_info({error, Error}, State = #state{frame=Frame}) -> ErrorStr = try io_lib:format("~ts", [Error]), Error - catch _:_ -> io_lib:format("~p", [Error]) + catch _:_ -> io_lib:format("~tp", [Error]) end, Dlg = wxMessageDialog:new(Frame, ErrorStr), wxMessageDialog:showModal(Dlg), @@ -441,7 +441,7 @@ handle_info({error, Error}, State = #state{frame=Frame}) -> {noreply, State}; handle_info(_Event, State) -> - %% io:format("~p:~p, handle info ~p\n", [?MODULE, ?LINE, _Event]), + %% io:format("~p:~p, handle info ~tp\n", [?MODULE, ?LINE, _Event]), {noreply, State}. terminate(_Event, #state{pid=Pid, attrs=Attrs}) -> @@ -554,7 +554,7 @@ table_holder(S0 = #holder{parent=Parent, pid=Pid, table=Table}) -> edit_row(Row, Term, S0), table_holder(S0); What -> - io:format("Table holder got ~p~n",[What]), + io:format("Table holder got ~tp~n",[What]), Parent ! {refresh, 0, S0#holder.n-1}, table_holder(S0) end. @@ -641,7 +641,7 @@ search([Str, Row, Dir0, CaseSens], true -> 1; false -> -1 end, - Res = case re:compile(Str, Opt) of + Res = case re:compile(Str, [unicode|Opt]) of {ok, Re} -> re_search(Row, Dir, N, Re, Table); {error, _} -> false end, @@ -665,7 +665,7 @@ get_row(From, Row, Col, Table) -> [Object|_] when Col =:= all -> From ! {self(), format(Object)}; [Object|_] when Col =:= all_multiline -> - From ! {self(), io_lib:format("~p", [Object])}; + From ! {self(), io_lib:format("~tp", [Object])}; [Object|_] when Col =:= term -> From ! {self(), Object}; [Object|_] when tuple_size(Object) >= Col -> @@ -801,7 +801,7 @@ format(Bin) when is_binary(Bin), byte_size(Bin) > 100 -> io_lib:format("<<#Bin:~w>>", [byte_size(Bin)]); format(Bin) when is_binary(Bin) -> try - true = printable_list(unicode:characters_to_list(Bin)), + true = io_lib:printable_list(unicode:characters_to_list(Bin)), io_lib:format("<<\"~ts\">>", [Bin]) catch _:_ -> io_lib:format("~w", [Bin]) @@ -809,7 +809,7 @@ format(Bin) when is_binary(Bin) -> format(Float) when is_float(Float) -> io_lib:format("~.3g", [Float]); format(Term) -> - io_lib:format("~w", [Term]). + io_lib:format("~tw", [Term]). format_tuple(Tuple, I, Max) when I < Max -> [format(element(I, Tuple)), $,|format_tuple(Tuple, I+1, Max)]; @@ -820,7 +820,7 @@ format_tuple(_Tuple, 1, 0) -> format_list([]) -> "[]"; format_list(List) -> - case printable_list(List) of + case io_lib:printable_list(List) of true -> io_lib:format("\"~ts\"", [map_printable_list(List)]); false -> [$[ | make_list(List)] end. @@ -849,26 +849,3 @@ map_printable_list([$\e|Cs]) -> map_printable_list([]) -> []; map_printable_list([C|Cs]) -> [C|map_printable_list(Cs)]. - -%% printable_list([Char]) -> bool() -%% Return true if CharList is a list of printable characters, else -%% false. - -printable_list([C|Cs]) when is_integer(C), C >= $ , C =< 255 -> - printable_list(Cs); -printable_list([$\n|Cs]) -> - printable_list(Cs); -printable_list([$\r|Cs]) -> - printable_list(Cs); -printable_list([$\t|Cs]) -> - printable_list(Cs); -printable_list([$\v|Cs]) -> - printable_list(Cs); -printable_list([$\b|Cs]) -> - printable_list(Cs); -printable_list([$\f|Cs]) -> - printable_list(Cs); -printable_list([$\e|Cs]) -> - printable_list(Cs); -printable_list([]) -> true; -printable_list(_Other) -> false. %Everything else is false diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index 9564bdfa1c..e16f3cab6b 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -252,7 +252,7 @@ handle_info(not_active, State = #state{timer = Timer0}) -> {noreply, State#state{timer=Timer}}; handle_info({error, Error}, #state{panel=Panel,opt=Opt}=State) -> - Str = io_lib:format("ERROR: ~s~n",[Error]), + Str = io_lib:format("ERROR: ~ts~n",[Error]), observer_lib:display_info_dialog(Panel,Str), case Opt#opt.type of mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true); diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 9b9e80f479..be93b1d5f1 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -459,7 +459,7 @@ handle_info({'EXIT', Pid, Reason}, State) -> normal -> {noreply, State}; _ -> - io:format("Observer: Child (~s) crashed exiting: ~p ~p~n", + io:format("Observer: Child (~s) crashed exiting: ~p ~tp~n", [pid2panel(Pid, State), Pid, Reason]), {stop, normal, State} end; @@ -504,7 +504,7 @@ save_config(Panels) -> File = config_file(), case filelib:ensure_dir(File) of ok -> - Format = [io_lib:format("~p.~n",[Conf]) || Conf <- Configs], + Format = [io_lib:format("~tp.~n",[Conf]) || Conf <- Configs], _ = file:write_file(File, Format); _ -> ignore diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 09b0bc6710..940fdc9818 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -635,7 +635,7 @@ stop(Opts) when is_list(Opts) -> ok; {_, {stopped, _}} -> %% Printout moved out of the ttb loop to avoid occasional deadlock - io:format("Stored logs in ~s~n", [element(2, Result)]); + io:format("Stored logs in ~ts~n", [element(2, Result)]); {_, _} -> ok end, @@ -792,7 +792,7 @@ do_stop({FetchOrFormat, UserDir}, Sender, NodeInfo, SessionInfo) -> write_config(?last_config, all), Localhost = host(node()), Dir = get_fetch_dir(UserDir, proplists:get_value(logfile, SessionInfo)), - file:make_dir(Dir), + ok = filelib:ensure_dir(filename:join(Dir,"*")), %% The nodes are traversed twice here because %% the meta tracing in observer_backend must be %% stopped before dbg is stopped, and dbg must @@ -900,21 +900,29 @@ fetch_report(Localhost, Dir, Node, MetaFile) -> fetch(Localhost,Dir,Node,MetaFile) -> case (host(Node) == Localhost) orelse is_local(MetaFile) of - true -> % same host, just move the files + true -> % same host, just move the files Files = get_filenames(Node,MetaFile), lists:foreach( - fun(File0) -> - Dest = filename:join(Dir,filename:basename(File0)), - file:rename(File0, Dest) - end, - Files); + fun(File0) -> + Dest = filename:join(Dir,filename:basename(File0)), + file:rename(File0, Dest) + end, + Files); false -> {ok, LSock} = gen_tcp:listen(0, [binary,{packet,2},{active,false}]), {ok,Port} = inet:port(LSock), - rpc:cast(Node,observer_backend,ttb_fetch, - [MetaFile,{Port,Localhost}]), + Enc = file:native_name_encoding(), + Args = + case rpc:call(Node,erlang,function_exported, + [observer_backend,ttb_fetch,3]) of + true -> + [MetaFile,{Port,Localhost},Enc]; + false -> + [MetaFile,{Port,Localhost}] + end, + rpc:cast(Node,observer_backend,ttb_fetch,Args), {ok, Sock} = gen_tcp:accept(LSock), - receive_files(Dir,Sock,undefined), + receive_files(Dir,Sock,undefined,Enc), ok = gen_tcp:close(LSock), ok = gen_tcp:close(Sock) end. @@ -929,25 +937,48 @@ get_filenames(_N, {local,F,_}) -> get_filenames(N, F) -> rpc:call(N, observer_backend,ttb_get_filenames,[F]). -receive_files(Dir,Sock,Fd) -> +receive_files(Dir,Sock,Fd,Enc) -> case gen_tcp:recv(Sock, 0) of {ok, <<0,Bin/binary>>} -> file:write(Fd,Bin), - receive_files(Dir,Sock,Fd); - {ok, <<1,Bin/binary>>} -> - File0 = binary_to_list(Bin), + receive_files(Dir,Sock,Fd,Enc); + {ok, <<Code,Bin/binary>>} when Code==1; Code==2; Code==3 -> + File0 = decode_filename(Code,Bin,Enc), File = filename:join(Dir,File0), {ok,Fd1} = file:open(File,[raw,write]), - receive_files(Dir,Sock,Fd1); + receive_files(Dir,Sock,Fd1,Enc); {error, closed} -> ok = file:close(Fd) end. +decode_filename(1,Bin,_Enc) -> + %% Old version of observer_backend - filename encoded with + %% list_to_binary + binary_to_list(Bin); +decode_filename(2,Bin,Enc) -> + %% Successfully encoded filename with correct encoding + unicode:characters_to_list(Bin,Enc); +decode_filename(3,Bin,latin1) -> + %% Filename encoded with faulty encoding. This has to be utf8 + %% remote and latin1 here, and the filename actually containing + %% characters outside the latin1 range. So making an escaped + %% variant of the filename and warning about it. + File0 = unicode:characters_to_list(Bin,utf8), + File = [ case X of + High when High > 255 -> + ["\\\\x{",erlang:integer_to_list(X, 16),$}]; + Low -> + Low + end || X <- File0 ], + io:format("Warning: fetching file with faulty filename encoding ~ts~n" + "Will be written as ~ts~n", + [File0,File]), + File. + host(Node) -> [_name,Host] = string:tokens(atom_to_list(Node),"@"), Host. - wait_for_fetch([]) -> ok; wait_for_fetch(Nodes) -> @@ -1087,7 +1118,7 @@ read_traci(File) -> {ok,B} -> interpret_binary(B,dict:new(),[]); _ -> - io:format("Warning: no meta data file: ~s~n",[MetaFile]), + io:format("Warning: no meta data file: ~ts~n",[MetaFile]), {dict:new(),[]} end. @@ -1303,7 +1334,7 @@ get_term(B) -> end. display_warning(Item,Warning) -> - io:format("Warning: {~w,~w}~n",[Warning,Item]). + io:format("Warning: {~tw,~tw}~n",[Warning,Item]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/ttb_et.erl b/lib/observer/src/ttb_et.erl index 95e8e9aa07..1b828eebc0 100644 --- a/lib/observer/src/ttb_et.erl +++ b/lib/observer/src/ttb_et.erl @@ -137,13 +137,13 @@ processes(E0) -> E = label(E0), {{FromProc,FromNode},{ToProc,ToNode}} = get_actors(E#event.from,E#event.to), - {true,E#event{from = io_lib:format("~w~n~w",[FromProc,FromNode]), - to = io_lib:format("~w~n~w",[ToProc,ToNode])}}. + {true,E#event{from = io_lib:format("~tw~n~w",[FromProc,FromNode]), + to = io_lib:format("~tw~n~w",[ToProc,ToNode])}}. mods_and_procs(E) -> ActorFun = fun({M,_F,_A},{Proc,Node}) -> - io_lib:format("~w~n~w~n~w",[M,Proc,Node]) + io_lib:format("~w~n~tw~n~w",[M,Proc,Node]) end, calltrace_filter(E,ActorFun). @@ -155,13 +155,13 @@ modules(E) -> funcs_and_procs(E) -> ActorFun = fun({M,F,A},{Proc,Node}) -> - io_lib:format("~s~n~w~n~w",[mfa(M,F,A),Proc,Node]) + io_lib:format("~ts~n~tw~n~w",[mfa(M,F,A),Proc,Node]) end, calltrace_filter(E,ActorFun). functions(E) -> ActorFun = fun({M,F,A},{_Proc,Node}) -> - io_lib:format("~s~n~w",[mfa(M,F,A),Node]) + io_lib:format("~ts~n~w",[mfa(M,F,A),Node]) end, calltrace_filter(E,ActorFun). @@ -221,7 +221,7 @@ label(Event=#event{label=L,contents=C}) -> false -> Event end. label(L,{M,F,A}) -> label(L,M,F,A); -label(L,Other) -> io_lib:format("~w ~w",[L,Other]). +label(L,Other) -> io_lib:format("~w ~tw",[L,Other]). label(call,M,F,A) -> "call " ++ mfa(M,F,A); label(return_from,M,F,A) -> "return_from " ++ mfa(M,F,A); label(return_to,M,F,A) -> "return_to " ++ mfa(M,F,A); diff --git a/lib/observer/test/Makefile b/lib/observer/test/Makefile index 6100af5e17..fcb1b73911 100644 --- a/lib/observer/test/Makefile +++ b/lib/observer/test/Makefile @@ -27,7 +27,8 @@ MODULES = \ ttb_SUITE \ client \ server \ - crashdump_helper + crashdump_helper \ + crashdump_helper_unicode ERL_FILES= $(MODULES:%=%.erl) @@ -46,7 +47,7 @@ RELSYSDIR = $(RELEASE_PATH)/observer_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += +ERL_COMPILE_FLAGS += +nowarn_export_all EBIN = . diff --git a/lib/observer/test/crashdump_helper_unicode.erl b/lib/observer/test/crashdump_helper_unicode.erl new file mode 100644 index 0000000000..60c3d20315 --- /dev/null +++ b/lib/observer/test/crashdump_helper_unicode.erl @@ -0,0 +1,22 @@ +-module(crashdump_helper_unicode). +-behaviour(gen_server). +-export([start/0, init/1, handle_call/3, handle_cast/2]). +-record(state, {s,a,b,lb}). + +start() -> + gen_server:start({local, 'unicode_reg_name_αβ'}, ?MODULE, [], []). + +init([]) -> + process_flag(trap_exit, true), + ets:new('tab_αβ',[set,named_table]), + Bin = <<"bin αβ"/utf8>>, + LongBin = <<"long bin αβ - a utf8 binary which can be expanded αβ"/utf8>>, + {ok, #state{s = "unicode_string_αβ", + a = 'unicode_atom_αβ', + b = Bin, + lb = LongBin}}. + +handle_call(_Info, _From, State) -> + {reply, ok, State}. +handle_cast(_Info, State) -> + {noreply, State}. diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 1fd94ffb3c..77cf086d4b 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -427,6 +427,18 @@ special(File,Procs) -> {ok,_,[TW]} = crashdump_viewer:general_info(), {match,_} = re:run(TW,"CRASH DUMP SIZE LIMIT REACHED"), ok; + ".unicode" -> + #proc{pid=Pid0} = + lists:keyfind("'unicode_reg_name_αβ'",#proc.name,Procs), + Pid = pid_to_list(Pid0), + {ok,#proc{},[]} = crashdump_viewer:proc_details(Pid), + io:format(" unicode registered name ok",[]), + + {ok,[#ets_table{id="'tab_αβ'",name="'tab_αβ'"}],[]} = + crashdump_viewer:ets_tables(Pid), + io:format(" unicode table name ok",[]), + + ok; _ -> ok end, @@ -492,7 +504,8 @@ do_create_dumps(DataDir,Rel) -> CD5 = dump_with_args(DataDir,Rel,"trunc.bytes", "-env ERL_CRASH_DUMP_BYTES " ++ integer_to_list(Bytes)), - {[CD1,CD2,CD3,CD4,CD5], DosDump}; + CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"), + {[CD1,CD2,CD3,CD4,CD5,CD6], DosDump}; _ -> {[CD1,CD2], DosDump} end. @@ -573,6 +586,16 @@ dump_with_strange_module_name(DataDir,Rel,DumpName) -> ?t:stop_node(n1), CD. +dump_with_unicode_atoms(DataDir,Rel,DumpName) -> + Opt = rel_opt(Rel), + Pz = "-pz \"" ++ filename:dirname(code:which(?MODULE)) ++ "\"", + PzOpt = [{args,Pz}], + {ok,N1} = ?t:start_node(n1,peer,Opt ++ PzOpt), + {ok,_Pid} = rpc:call(N1,crashdump_helper_unicode,start,[]), + CD = dump(N1,DataDir,Rel,DumpName), + ?t:stop_node(n1), + CD. + dump(Node,DataDir,Rel,DumpName) -> Crashdump = filename:join(DataDir, dump_prefix(Rel)++DumpName), rpc:call(Node,os,putenv,["ERL_CRASH_DUMP",Crashdump]), diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index 36730aac74..aeec335ba7 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -285,7 +285,7 @@ check_disk_space({unix, sunos4}, Port, Threshold) -> Result = my_cmd("df", Port), check_disks_solaris(skip_to_eol(Result), Threshold); check_disk_space({unix, darwin}, Port, Threshold) -> - Result = my_cmd("/bin/df -i -k -t ufs,hfs", Port), + Result = my_cmd("/bin/df -i -k -t ufs,hfs,apfs", Port), check_disks_susv3(skip_to_eol(Result), Threshold). % This code works for Linux and FreeBSD as well diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 1776baf830..c2060c144c 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -419,7 +419,7 @@ generate_key({rsa, ModulusSize, PublicExponent}) -> {[E, N], [E, N, D, P, Q, D_mod_P_1, D_mod_Q_1, InvQ_mod_P]} -> Nint = crypto:bytes_to_integer(N), Eint = crypto:bytes_to_integer(E), - #'RSAPrivateKey'{version = 0, % Two-factor (I guess since otherPrimeInfos is not given) + #'RSAPrivateKey'{version = 'two-prime', % Two-factor (I guess since otherPrimeInfos is not given) modulus = Nint, publicExponent = Eint, privateExponent = crypto:bytes_to_integer(D), @@ -437,7 +437,7 @@ generate_key({rsa, ModulusSize, PublicExponent}) -> % 1976. Nint = crypto:bytes_to_integer(N), Eint = crypto:bytes_to_integer(E), - #'RSAPrivateKey'{version = 0, % Two-factor (I guess since otherPrimeInfos is not given) + #'RSAPrivateKey'{version = 'two-prime', % Two-factor (I guess since otherPrimeInfos is not given) modulus = Nint, publicExponent = Eint, privateExponent = crypto:bytes_to_integer(D), diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl index 2d56d74563..894d6e2ecb 100644 --- a/lib/reltool/src/reltool_mod_win.erl +++ b/lib/reltool/src/reltool_mod_win.erl @@ -833,7 +833,7 @@ load_code(Ed, Code) when is_binary(Code) -> keyWords() -> L = ["after","begin","case","try","cond","catch","andalso","orelse", - "end","fun","if","let","of","query","receive","when","bnot","not", + "end","fun","if","let","of","receive","when","bnot","not", "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], lists:flatten([K ++ " " || K <- L] ++ [0]). diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index d36af257ce..1b075a507d 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -36,6 +36,7 @@ ttb_write_binary/2, ttb_stop/1, ttb_fetch/2, + ttb_fetch/3, ttb_resume_trace/0, ttb_get_filenames/1]). -define(CHUNKSIZE,8191). % 8 kbytes - 1 byte @@ -63,9 +64,7 @@ sys_info() -> end, {{_,Input},{_,Output}} = erlang:statistics(io), - [{process_count, erlang:system_info(process_count)}, - {process_limit, erlang:system_info(process_limit)}, - {uptime, element(1, erlang:statistics(wall_clock))}, + [{uptime, element(1, erlang:statistics(wall_clock))}, {run_queue, erlang:statistics(run_queue)}, {io_input, Input}, {io_output, Output}, @@ -86,7 +85,17 @@ sys_info() -> {thread_pool_size, erlang:system_info(thread_pool_size)}, {wordsize_internal, erlang:system_info({wordsize, internal})}, {wordsize_external, erlang:system_info({wordsize, external})}, - {alloc_info, alloc_info()} + {alloc_info, alloc_info()}, + {process_count, erlang:system_info(process_count)}, + {atom_limit, erlang:system_info(atom_limit)}, + {atom_count, erlang:system_info(atom_count)}, + {process_limit, erlang:system_info(process_limit)}, + {process_count, erlang:system_info(process_count)}, + {port_limit, erlang:system_info(port_limit)}, + {port_count, erlang:system_info(port_count)}, + {ets_limit, erlang:system_info(ets_limit)}, + {ets_count, length(ets:all())}, + {dist_buf_busy_limit, erlang:system_info(dist_buf_busy_limit)} | MemInfo]. alloc_info() -> @@ -650,22 +659,42 @@ stop_seq_trace() -> %% Fetch ttb logs from remote node ttb_fetch(MetaFile,{Port,Host}) -> + ttb_fetch(MetaFile,{Port,Host},undefined). +ttb_fetch(MetaFile,{Port,Host},MasterEnc) -> erlang:process_flag(priority,low), Files = ttb_get_filenames(MetaFile), {ok, Sock} = gen_tcp:connect(Host, Port, [binary, {packet, 2}]), - send_files({Sock,Host},Files), + send_files({Sock,Host},Files,MasterEnc,file:native_name_encoding()), ok = gen_tcp:close(Sock). -send_files({Sock,Host},[File|Files]) -> +send_files({Sock,Host},[File|Files],MasterEnc,MyEnc) -> {ok,Fd} = file:open(File,[raw,read,binary]), - ok = gen_tcp:send(Sock,<<1,(list_to_binary(filename:basename(File)))/binary>>), + Basename = filename:basename(File), + {Code,FilenameBin} = encode_filename(Basename,MasterEnc,MyEnc), + ok = gen_tcp:send(Sock,<<Code,FilenameBin/binary>>), send_chunks(Sock,Fd), ok = file:delete(File), - send_files({Sock,Host},Files); -send_files({_Sock,_Host},[]) -> + send_files({Sock,Host},Files,MasterEnc,MyEnc); +send_files({_Sock,_Host},[],_MasterEnc,_MyEnc) -> done. +encode_filename(Basename,undefined,MyEnc) -> + %% Compatible with old version of ttb.erl, but no longer crashing + %% for code points > 255. + {1,unicode:characters_to_binary(Basename,MyEnc,MyEnc)}; +encode_filename(Basename,MasterEnc,MyEnc) -> + case unicode:characters_to_binary(Basename,MyEnc,MasterEnc) of + Bin when is_binary(Bin) -> + %% Encoding succeeded + {2,Bin}; + _ -> + %% Can't convert Basename from my encoding to the master + %% node's encoding. Doing my best and hoping that master + %% node can fix it... + {3,unicode:characters_to_binary(Basename,MyEnc,MyEnc)} + end. + send_chunks(Sock,Fd) -> case file:read(Fd,?CHUNKSIZE) of {ok,Bin} -> diff --git a/lib/sasl/doc/src/sasl_app.xml b/lib/sasl/doc/src/sasl_app.xml index 0576397f9b..e0693fcb60 100644 --- a/lib/sasl/doc/src/sasl_app.xml +++ b/lib/sasl/doc/src/sasl_app.xml @@ -103,13 +103,16 @@ <tag><c>{file,FileName}</c></tag> <item><p>Installs <c>sasl_report_file_h</c> in the error logger. All reports go to file <c>FileName</c>, which is a - string.</p></item> + string. The file is opened in <c>write</c> mode with encoding + <c>utf8</c>.</p></item> <tag><c>{file,FileName,Modes}</c></tag> <item><p>Same as <c>{file,FileName}</c>, except that <c>Modes</c> allows you to specify the modes used for opening the <c>FileName</c> given to the <seealso marker="kernel:file#open/2">file:open/2</seealso> - call. When not specified, <c>Modes</c> defaults to <c>[write]</c>. - Use <c>[append]</c> to have the <c>FileName</c> open in append mode. + call. By default, the file is opened in <c>write</c> mode + with encoding <c>utf8</c>. Use <c>[append]</c> to have + the <c>FileName</c> open in append mode. A different + encoding can also be specified. <c>FileName</c> is a string.</p></item> <tag><c>false</c></tag> <item><p>No SASL error logger handler is installed.</p></item> diff --git a/lib/sasl/src/sasl_report.erl b/lib/sasl/src/sasl_report.erl index eb454155d5..e6556ec6ce 100644 --- a/lib/sasl/src/sasl_report.erl +++ b/lib/sasl/src/sasl_report.erl @@ -47,6 +47,7 @@ io_report(_IO, _Fd, _, _) -> is_my_error_report(all, Type) -> is_my_error_report(Type); is_my_error_report(error, Type) -> is_my_error_report(Type); is_my_error_report(_, _Type) -> false. + is_my_error_report(supervisor_report) -> true; is_my_error_report(crash_report) -> true; is_my_error_report(_) -> false. @@ -54,6 +55,7 @@ is_my_error_report(_) -> false. is_my_info_report(all, Type) -> is_my_info_report(Type); is_my_info_report(progress, Type) -> is_my_info_report(Type); is_my_info_report(_, _Type) -> false. + is_my_info_report(progress) -> true; is_my_info_report(_) -> false. @@ -62,46 +64,65 @@ write_report2(IO, Fd, Head, supervisor_report, Report) -> Context = sup_get(errorContext, Report), Reason = sup_get(reason, Report), Offender = sup_get(offender, Report), - {FmtString,Args} = supervisor_format([Name,Context,Reason,Offender]), - write_report_action(IO, Fd, Head, FmtString, Args); + Enc = encoding(Fd), + {FmtString,Args} = supervisor_format([Name,Context,Reason,Offender], Enc), + String = io_lib:format(FmtString, Args), + write_report_action(IO, Fd, Head, String); write_report2(IO, Fd, Head, progress, Report) -> - Format = format_key_val(Report), - write_report_action(IO, Fd, Head, "~s", [Format]); + Encoding = encoding(Fd), + Depth = error_logger:get_format_depth(), + String = format_key_val(Report, Encoding, Depth), + write_report_action(IO, Fd, Head, String); write_report2(IO, Fd, Head, crash_report, Report) -> + Encoding = encoding(Fd), Depth = error_logger:get_format_depth(), - Format = proc_lib:format(Report, latin1, Depth), - write_report_action(IO, Fd, Head, "~s", [Format]). - -supervisor_format(Args0) -> - case error_logger:get_format_depth() of - unlimited -> - {" Supervisor: ~p~n" - " Context: ~p~n" - " Reason: ~80.18p~n" - " Offender: ~80.18p~n~n", - Args0}; - Depth -> - [A,B,C,D] = Args0, - Args = [A,Depth,B,Depth,C,Depth,D,Depth], - {" Supervisor: ~P~n" - " Context: ~P~n" - " Reason: ~80.18P~n" - " Offender: ~80.18P~n~n", - Args} - end. - -write_report_action(IO, Fd, Head, Format, Args) -> - S = [Head|io_lib:format(Format, Args)], + String = proc_lib:format(Report, Encoding, Depth), + write_report_action(IO, Fd, Head, String). + +supervisor_format(Args0, Encoding) -> + {P, Tl} = p(Encoding, error_logger:get_format_depth()), + [A,B,C,D] = Args0, + Args = [A|Tl] ++ [B|Tl] ++ [C|Tl] ++ [D|Tl], + {" Supervisor: ~" ++ P ++ "\n" + " Context: ~" ++ P ++ "\n" + " Reason: ~80.18" ++ P ++ "\n" + " Offender: ~80.18" ++ P ++ "\n~n", + Args}. + +write_report_action(IO, Fd, Head, String) -> + S = [Head|String], case IO of io -> io:put_chars(Fd, S); io_lib -> S end. -format_key_val([{Tag,Data}|Rep]) -> - io_lib:format(" ~16w: ~p~n",[Tag,Data]) ++ format_key_val(Rep); -format_key_val(_) -> +format_key_val(Rep, Encoding, Depth) -> + {P, Tl} = p(Encoding, Depth), + format_key_val1(Rep, P, Tl). + +format_key_val1([{Tag,Data}|Rep], P, Tl) -> + (io_lib:format(" ~16w: ~" ++ P ++ "\n", [Tag, Data|Tl]) ++ + format_key_val1(Rep, P, Tl)); +format_key_val1(_, _, _) -> []. +p(Encoding, Depth) -> + {Letter, Tl} = case Depth of + unlimited -> {"p", []}; + _ -> {"P", [Depth]} + end, + P = modifier(Encoding) ++ Letter, + {P, Tl}. + +encoding(IO) -> + case lists:keyfind(encoding, 1, io:getopts(IO)) of + false -> latin1; + {encoding, Enc} -> Enc + end. + +modifier(latin1) -> ""; +modifier(_) -> "t". + sup_get(Tag, Report) -> case lists:keysearch(Tag, 1, Report) of {value, {_, Value}} -> diff --git a/lib/sasl/src/sasl_report_file_h.erl b/lib/sasl/src/sasl_report_file_h.erl index 21746839fa..d3b5c7dc0d 100644 --- a/lib/sasl/src/sasl_report_file_h.erl +++ b/lib/sasl/src/sasl_report_file_h.erl @@ -29,15 +29,27 @@ handle_event/2, handle_call/2, handle_info/2, terminate/2]). -init({File, Modes, Type}) when is_list(Modes) -> +init({File, Modes0, Type}) when is_list(Modes0) -> process_flag(trap_exit, true), + Modes1 = + case lists:keymember(encoding,1,Modes0) of + true -> Modes0; + false -> [{encoding,utf8}|Modes0] + end, + Modes = + case [M || M <- Modes1, lists:member(M,[write,append,exclusive])] of + [] -> + [write|Modes1]; + _ -> + Modes1 + end, case file:open(File, Modes) of {ok,Fd} -> {ok, {Fd, File, Type}}; What -> What end. - + handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> {ok, State}; handle_event(Event, {Fd, File, Type}) -> diff --git a/lib/sasl/test/sasl_report_SUITE.erl b/lib/sasl/test/sasl_report_SUITE.erl index 53fb614921..92df5e6e40 100644 --- a/lib/sasl/test/sasl_report_SUITE.erl +++ b/lib/sasl/test/sasl_report_SUITE.erl @@ -20,7 +20,7 @@ -module(sasl_report_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). --export([gen_server_crash/1]). +-export([gen_server_crash/1, gen_server_crash_unicode/1]). -export([crash_me/0,start_link/0,init/1,handle_cast/2,terminate/2]). @@ -29,7 +29,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [gen_server_crash]. + [gen_server_crash, gen_server_crash_unicode]. groups() -> []. @@ -47,8 +47,14 @@ end_per_group(_GroupName, Config) -> Config. gen_server_crash(Config) -> + gen_server_crash(Config, latin1). + +gen_server_crash_unicode(Config) -> + gen_server_crash(Config, unicode). + +gen_server_crash(Config, Encoding) -> try - do_gen_server_crash(Config) + do_gen_server_crash(Config, Encoding) after error_logger:tty(true), ok = application:unset_env(sasl, sasl_error_logger), @@ -57,7 +63,7 @@ gen_server_crash(Config) -> end, ok. -do_gen_server_crash(Config) -> +do_gen_server_crash(Config, Encoding) -> PrivDir = ?config(priv_dir, Config), LogDir = filename:join(PrivDir, ?MODULE), KernelLog = filename:join(LogDir, "kernel.log"), @@ -67,7 +73,8 @@ do_gen_server_crash(Config) -> error_logger:delete_report_handler(cth_log_redirect), error_logger:tty(false), application:stop(sasl), - ok = application:set_env(sasl, sasl_error_logger, {file,SaslLog}, + Modes = [write, {encoding, Encoding}], + ok = application:set_env(sasl, sasl_error_logger, {file,SaslLog,Modes}, [{persistent,true}]), application:set_env(kernel, error_logger_format_depth, 30), error_logger:logfile({open,KernelLog}), @@ -78,16 +85,21 @@ do_gen_server_crash(Config) -> error_logger:logfile(close), - check_file(KernelLog, 70000, 150000), - check_file(SaslLog, 100000, 150000), + check_file(KernelLog, utf8, 70000, 150000), + check_file(SaslLog, Encoding, 70000, 150000), + %% ok = file:delete(KernelLog), + %% ok = file:delete(SaslLog), ok. -check_file(File, Min, Max) -> +check_file(File, Encoding, Min, Max) -> {ok,Bin} = file:read_file(File), Base = filename:basename(File), io:format("*** Contents of ~s ***\n", [Base]), - io:put_chars([Bin,"\n"]), + case Encoding of + latin1 -> io:format("~s\n", [Bin]); + _ -> io:format("~ts\n", [Bin]) + end, Sz = byte_size(Bin), io:format("Size: ~p (allowed range is ~p..~p)\n", [Sz,Min,Max]), @@ -110,7 +122,9 @@ crash_me() -> {ok,SuperPid} = supervisor:start_link(sasl_report_suite_supervisor, []), [{Id,Pid,_,_}] = supervisor:which_children(SuperPid), HugeData = gb_sets:from_list(lists:seq(1, 100000)), - gen_server:cast(Pid, HugeData), + SomeData1 = list_to_atom([246]), + SomeData2 = list_to_atom([1024]), + gen_server:cast(Pid, {HugeData,SomeData1,SomeData2}), Ref = monitor(process, Pid), receive {'DOWN',Ref,process,Pid,_} -> @@ -129,6 +143,12 @@ init(_) -> handle_cast(Big, St) -> Seq = lists:seq(1, 10000), + Latin1Atom = list_to_atom([246]), + UnicodeAtom = list_to_atom([1024]), + put(Latin1Atom, Latin1Atom), + put(UnicodeAtom, UnicodeAtom), + self() ! Latin1Atom, + self() ! UnicodeAtom, self() ! Seq, self() ! Seq, self() ! Seq, diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile index a759854da4..adbda5a030 100644 --- a/lib/ssh/doc/src/Makefile +++ b/lib/ssh/doc/src/Makefile @@ -53,7 +53,8 @@ XML_PART_FILES = part_notes.xml \ XML_CHAPTER_FILES = notes.xml \ introduction.xml \ ssh_protocol.xml \ - using_ssh.xml + using_ssh.xml \ + configure_algos.xml BOOK_FILES = book.xml diff --git a/lib/ssh/doc/src/configure_algos.xml b/lib/ssh/doc/src/configure_algos.xml new file mode 100644 index 0000000000..dd60324851 --- /dev/null +++ b/lib/ssh/doc/src/configure_algos.xml @@ -0,0 +1,428 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2017</year> + <year>2017</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>Configuring algorithms in SSH</title> + <prepared></prepared> + <docno></docno> + <approved></approved> + <date></date> + <rev></rev> + <file>configure_algos.xml</file> + </header> + + <section> + <marker id="introduction"/> + <title>Introduction</title> + <p>To fully understand how to configure the algorithms, it is essential to have a basic understanding of the SSH protocol + and how OTP SSH app handles the corresponding items</p> + + <p>The first subsection will give a short background of the SSH protocol while later sections describes + the implementation and provides some examples</p> + + <section> + <title>Basics of the ssh protocol's algorithms handling</title> + + <p>SSH uses different sets of algorithms in different phases of a session. Which + algorithms to use is negotiated by the client and the server at the beginning of a session. + See <url href="https://tools.ietf.org/html/rfc4253">RFC 4253</url>, + "The Secure Shell (SSH) Transport Layer Protocol" for details. + </p> + + <p>The negotiation is simple: both peers sends their list of supported alghorithms to the other part. + The first algorithm on the client's list that also in on the server's list is selected. So it is the + client's orderering of the list that gives the priority for the algorithms.</p> + + <p>There are five lists exchanged in the connection setup. Three of them are also divided in two + directions, to and from the server.</p> + + <p>The lists are (named as in the SSH application's options):</p> + <taglist> + <tag><c>kex</c></tag> + <item> + <p>Key exchange.</p> + <p>An algorithm is selected for computing a secret encryption key. Among examples are: + the old nowadays week <c>'diffie-hellman-group-exchange-sha1'</c> and the very strong and modern + <c>'ecdh-sha2-nistp512'</c>.</p> + </item> + + <tag><c>public_key</c></tag> + <item> + <p>Server host key</p> + <p>The asymetric encryption algorithm used in the server's private-public host key pair. + Examples include the well-known RSA <c>'ssh-rsa'</c> and elliptic curve <c>'ecdsa-sha2-nistp521'</c>. + </p> + </item> + + <tag><c>cipher</c></tag> + <item> + <p>Symetric cipher algorithm used for the payload encryption. This algorithm will use the key calculated + in the kex phase (together with other info) to genereate the actual key used. Examples are + tripple-DES <c>'3des-cbc'</c> and one of many AES variants <c>'aes192-ctr'</c>. + </p> + <p>This list is actually two - one for each direction server-to-client and client-to-server. Therefore it + is possible but rare to have different algorithms in the two directions in one connection.</p> + </item> + + <tag><c>mac</c></tag> + <item> + <p>Message authentication code</p> + <p>"Check sum" of each message sent between the peers. Examples are SHA <c>'hmac-sha1'</c> and + SHA2 <c>'hmac-sha2-512'</c>.</p> + <p>This list is also divided into two for the both directions</p> + </item> + + <tag><c>compression</c></tag> + <item> + <p>If and how to compress the message. Examples are <c>none</c>, that is, no compression and + <c>zlib</c>.</p> + <p>This list is also divided into two for the both directions</p> + </item> + + </taglist> + </section> + + <section> + <title>The SSH app's mechanism</title> + <p>The set of algorithms that the SSH app uses by default depends on the algoritms supported by the:</p> + <list> + <item><p><seealso marker="crypto:crypto">crypto</seealso> app,</p> + </item> + <item><p>The cryptolib OTP is linked with, usally the one the OS uses, probably OpenSSL,</p> + </item> + <item><p>and finaly what the SSH app implements</p> + </item> + </list> + <p>Due to this, it impossible to list in documentation what algorithms that are available in a certain installation.</p> + <p>There is an important command to list the actual algorithms and their ordering: + <seealso marker="ssh#default_algorithms-0">ssh:default_algorithms/0</seealso>.</p> + <code type="erl"> +0> ssh:default_algorithms(). +[{kex,['ecdh-sha2-nistp384','ecdh-sha2-nistp521', + 'ecdh-sha2-nistp256','diffie-hellman-group-exchange-sha256', + 'diffie-hellman-group16-sha512', + 'diffie-hellman-group18-sha512', + 'diffie-hellman-group14-sha256', + 'diffie-hellman-group14-sha1', + 'diffie-hellman-group-exchange-sha1']}, + {public_key,['ecdsa-sha2-nistp384','ecdsa-sha2-nistp521', + 'ecdsa-sha2-nistp256','ssh-rsa','rsa-sha2-256', + 'rsa-sha2-512','ssh-dss']}, + {cipher,[{client2server,['[email protected]', + 'aes256-ctr','aes192-ctr','[email protected]', + 'aes128-ctr','aes128-cbc','3des-cbc']}, + {server2client,['[email protected]','aes256-ctr', + 'aes192-ctr','[email protected]','aes128-ctr', + 'aes128-cbc','3des-cbc']}]}, + {mac,[{client2server,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}, + {server2client,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}]}, + {compression,[{client2server,[none,'[email protected]',zlib]}, + {server2client,[none,'[email protected]',zlib]}]}] + + </code> + <p>To change the algorithm list, there are two options which can be used in + <seealso marker="ssh#connect-3">ssh:connect/2,3,4</seealso> + and + <seealso marker="ssh#daemon-2">ssh:daemon/2,3</seealso>. The options could of course + be used in all other functions that initiates connections.</p> + + <p>The options are <c>preferred_algorithms</c> and <c>modify_algorithms</c>. The first one + replaces the default set, while the latter modifies the default set.</p> + </section> + </section> + + <section> + <title>Replacing the default set: preferred_algorithms</title> + <p>See the <seealso marker="ssh#option_preferred_algorithms">Reference Manual</seealso> for details</p> + + <p>Here follows a series of examples ranging from simple to more complex.</p> + + <p>To forsee the effect of an option there is an experimental function <c>ssh:chk_algos_opts(Opts)</c>. + It mangles the options <c>preferred_algorithms</c> + and <c>modify_algorithms</c> in the same way as <c>ssh:dameon</c>, <c>ssh:connect</c> and their friends does.</p> + + <section> + <title>Example 1</title> + <p>Replace the kex algorithms list with the single algorithm <c>'diffie-hellman-group14-sha256'</c>:</p> + <code> +1> ssh:chk_algos_opts( + [{preferred_algorithms, + [{kex, ['diffie-hellman-group14-sha256']} + ] + } + ]). +[{kex,['diffie-hellman-group14-sha256']}, + {public_key,['ecdsa-sha2-nistp384','ecdsa-sha2-nistp521', + 'ecdsa-sha2-nistp256','ssh-rsa','rsa-sha2-256', + 'rsa-sha2-512','ssh-dss']}, + {cipher,[{client2server,['[email protected]', + 'aes256-ctr','aes192-ctr','[email protected]', + 'aes128-ctr','aes128-cbc','3des-cbc']}, + {server2client,['[email protected]','aes256-ctr', + 'aes192-ctr','[email protected]','aes128-ctr', + 'aes128-cbc','3des-cbc']}]}, + {mac,[{client2server,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}, + {server2client,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}]}, + {compression,[{client2server,[none,'[email protected]',zlib]}, + {server2client,[none,'[email protected]',zlib]}]}] + </code> + <p>Note that the unmentioned lists (<c>public_key</c>, <c>cipher</c>, <c>mac</c> and <c>compression</c>) + are un-changed.</p> + </section> + + <section> + <title>Example 2</title> + <p>In the lists that are divided in two for the two directions (c.f <c>cipher</c>) it is possible + to change both directions at once:</p> + <code> +2> ssh:chk_algos_opts( + [{preferred_algorithms, + [{cipher,['aes128-ctr']} + ] + } + ]). +[{kex,['ecdh-sha2-nistp384','ecdh-sha2-nistp521', + 'ecdh-sha2-nistp256','diffie-hellman-group-exchange-sha256', + 'diffie-hellman-group16-sha512', + 'diffie-hellman-group18-sha512', + 'diffie-hellman-group14-sha256', + 'diffie-hellman-group14-sha1', + 'diffie-hellman-group-exchange-sha1']}, + {public_key,['ecdsa-sha2-nistp384','ecdsa-sha2-nistp521', + 'ecdsa-sha2-nistp256','ssh-rsa','rsa-sha2-256', + 'rsa-sha2-512','ssh-dss']}, + {cipher,[{client2server,['aes128-ctr']}, + {server2client,['aes128-ctr']}]}, + {mac,[{client2server,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}, + {server2client,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}]}, + {compression,[{client2server,[none,'[email protected]',zlib]}, + {server2client,[none,'[email protected]',zlib]}]}] + </code> + <p>Note that both lists in <c>cipher</c> has been changed to the provided value (<c>'aes128-ctr'</c>).</p> + </section> + + <section> + <title>Example 3</title> + <p>In the lists that are divided in two for the two directions (c.f <c>cipher</c>) it is possible + to change only one of the directions:</p> + <code> +3> ssh:chk_algos_opts( + [{preferred_algorithms, + [{cipher,[{client2server,['aes128-ctr']}]} + ] + } + ]). +[{kex,['ecdh-sha2-nistp384','ecdh-sha2-nistp521', + 'ecdh-sha2-nistp256','diffie-hellman-group-exchange-sha256', + 'diffie-hellman-group16-sha512', + 'diffie-hellman-group18-sha512', + 'diffie-hellman-group14-sha256', + 'diffie-hellman-group14-sha1', + 'diffie-hellman-group-exchange-sha1']}, + {public_key,['ecdsa-sha2-nistp384','ecdsa-sha2-nistp521', + 'ecdsa-sha2-nistp256','ssh-rsa','rsa-sha2-256', + 'rsa-sha2-512','ssh-dss']}, + {cipher,[{client2server,['aes128-ctr']}, + {server2client,['[email protected]','aes256-ctr', + 'aes192-ctr','[email protected]','aes128-ctr', + 'aes128-cbc','3des-cbc']}]}, + {mac,[{client2server,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}, + {server2client,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}]}, + {compression,[{client2server,[none,'[email protected]',zlib]}, + {server2client,[none,'[email protected]',zlib]}]}] + </code> + </section> + + <section> + <title>Example 4</title> + <p>It is of course possible to change more than one list:</p> + <code> +4> ssh:chk_algos_opts( + [{preferred_algorithms, + [{cipher,['aes128-ctr']}, + {mac,['hmac-sha2-256']}, + {kex,['ecdh-sha2-nistp384']}, + {public_key,['ssh-rsa']}, + {compression,[{server2client,[none]}, + {client2server,[zlib]}]} + ] + } + ]). +[{kex,['ecdh-sha2-nistp384']}, + {public_key,['ssh-rsa']}, + {cipher,[{client2server,['aes128-ctr']}, + {server2client,['aes128-ctr']}]}, + {mac,[{client2server,['hmac-sha2-256']}, + {server2client,['hmac-sha2-256']}]}, + {compression,[{client2server,[zlib]}, + {server2client,[none]}]}] + + </code> + <p>Note that the ordering of the tuples in the lists didn't matter.</p> + </section> + </section> + + <section> + <title>Modifying the default set: modify_algorithms</title> + <p>A situation where it might be useful to add an algorithm is when one need to use a supported but disabled one. + An example is the <c>'diffie-hellman-group1-sha1'</c> which nowadays is very unsecure and therefore disabled. It is + however still supported and might be used.</p> + + <p>The option <c>preferred_algorithms</c> may be complicated to use for adding or removing single algorithms. + First one has to list them with <c>ssh:default_algorithms()</c> and then do changes in the lists.</p> + + <p>To facilitate addition or removal of algorithms the option <c>modify_algorithms</c> is available. + See the <seealso marker="ssh#option_modify_algorithms">Reference Manual</seealso> for details.</p> + + <p>The option takes a list with instructions to append, prepend or remove algorithms:</p> + <code type="erl"> +{modify_algorithms, [{append, ...}, + {prepend, ...}, + {rm, ...} + ]} + </code> + <p>Each of the <c>...</c> can be a <c>algs_list()</c> as the argument to the <c>preferred_algorithms</c> option.</p> + <section> + <title>Example 5</title> + <p>As an example let's add the Diffie-Hellman Group1 first in the kex list. It is supported according to + <seealso marker="SSH_app#supported_algos">Supported algoritms</seealso>.</p> + <code type="erl"> +5> ssh:chk_algos_opts( + [{modify_algorithms, + [{prepend, + [{kex,['diffie-hellman-group1-sha1']}] + } + ] + } + ]). +[{kex,['diffie-hellman-group1-sha1','ecdh-sha2-nistp384', + 'ecdh-sha2-nistp521','ecdh-sha2-nistp256', + 'diffie-hellman-group-exchange-sha256', + 'diffie-hellman-group16-sha512', + 'diffie-hellman-group18-sha512', + 'diffie-hellman-group14-sha256', + 'diffie-hellman-group14-sha1', + 'diffie-hellman-group-exchange-sha1']}, + {public_key,['ecdsa-sha2-nistp384','ecdsa-sha2-nistp521', + 'ecdsa-sha2-nistp256','ssh-rsa','rsa-sha2-256', + 'rsa-sha2-512','ssh-dss']}, + {cipher,[{client2server,['[email protected]', + 'aes256-ctr','aes192-ctr','[email protected]', + 'aes128-ctr','aes128-cbc','3des-cbc']}, + {server2client,['[email protected]','aes256-ctr', + 'aes192-ctr','[email protected]','aes128-ctr', + 'aes128-cbc','3des-cbc']}]}, + {mac,[{client2server,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}, + {server2client,['hmac-sha2-256','hmac-sha2-512', + 'hmac-sha1']}]}, + {compression,[{client2server,[none,'[email protected]',zlib]}, + {server2client,[none,'[email protected]',zlib]}]}] + + </code> + <p>And the result shows that the Diffie-Hellman Group1 is added at the head of the kex list</p> + </section> + + <section> + <title>Example 6</title> + <p>In this example, we in put the 'diffie-hellman-group1-sha1' first and also move the + <c>'ecdh-sha2-nistp521'</c> to the end in the kex list, that is, <c>append</c> it.</p> + <code type="erl"> +6> ssh:chk_algos_opts( + [{modify_algorithms, + [{prepend, + [{kex, ['diffie-hellman-group1-sha1']} + ]}, + {append, + [{kex, ['ecdh-sha2-nistp521']} + ]} + ] + } + ]). +[{kex,['diffie-hellman-group1-sha1','ecdh-sha2-nistp384', + 'ecdh-sha2-nistp256','diffie-hellman-group-exchange-sha256', + 'diffie-hellman-group16-sha512', + 'diffie-hellman-group18-sha512', + 'diffie-hellman-group14-sha256', + 'diffie-hellman-group14-sha1', + 'diffie-hellman-group-exchange-sha1','ecdh-sha2-nistp521']}, + {public_key,['ecdsa-sha2-nistp384','ecdsa-sha2-nistp521', + ..... +] + </code> + <p>Note that the appended algorithm is removed from its original place and then appended to the same list.</p> + </section> + + <section> + <title>Example 7</title> + <p>In this example, we use both options (<c>preferred_algorithms</c> and <c>modify_algorithms</c>) and + also try to prepend an unsupported algorithm. Any unsupported algorithm is quietly removed.</p> + <code type="erl"> +7> ssh:chk_algos_opts( + [{preferred_algorithms, + [{cipher,['aes128-ctr']}, + {mac,['hmac-sha2-256']}, + {kex,['ecdh-sha2-nistp384']}, + {public_key,['ssh-rsa']}, + {compression,[{server2client,[none]}, + {client2server,[zlib]}]} + ] + }, + {modify_algorithms, + [{prepend, + [{kex, ['some unsupported algorithm']} + ]}, + {append, + [{kex, ['diffie-hellman-group1-sha1']} + ]} + ] + } + ]). +[{kex,['ecdh-sha2-nistp384','diffie-hellman-group1-sha1']}, + {public_key,['ssh-rsa']}, + {cipher,[{client2server,['aes128-ctr']}, + {server2client,['aes128-ctr']}]}, + {mac,[{client2server,['hmac-sha2-256']}, + {server2client,['hmac-sha2-256']}]}, + {compression,[{client2server,[zlib]}, + {server2client,[none]}]}] + + </code> + <p>It is of course questionable why anyone would like to use the both these options together, + but it is possible if an unforeseen need should arise.</p> + </section> + + + + </section> + +</chapter> diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index f93753f1d2..5826d14a4a 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,22 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.5.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + All unknown options are sent to the transport handler + regardless of type.</p> + <p> + Own Id: OTP-14541 Aux Id: EIRERL-63 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.5</title> <section><title>Improvements and New Features</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index ea7e975ef5..d9516fff12 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -108,6 +108,9 @@ <tag><c>double_algs() =</c></tag> <item><p><c>[{client2serverlist,simple_algs()},{server2client,simple_algs()}] | simple_algs()</c></p></item> + + <tag><c>modify_algs_list() =</c></tag> + <item><p><c>list( {append,algs_list()} | {prepend,algs_list()} | {rm,algs_list()} )</c></p></item> </taglist> </section> @@ -254,7 +257,8 @@ </p> </item> - <tag><c><![CDATA[{preferred_algorithms, algs_list()}]]></c></tag> + <tag><marker id="option_preferred_algorithms"></marker> + <c><![CDATA[{preferred_algorithms, algs_list()}]]></c></tag> <item> <p>List of algorithms to use in the algorithm negotiation. The default <c>algs_list()</c> can be obtained from <seealso marker="#default_algorithms/0">default_algorithms/0</seealso>. @@ -275,6 +279,8 @@ for cipher but specifies the same algorithms for mac and compression in both directions. The kex (key exchange) is implicit but public_key is set explicitly.</p> + <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> + <warning> <p>Changing the values can make a connection less secure. Do not change unless you know exactly what you are doing. If you do not understand the values then you @@ -282,6 +288,62 @@ </warning> </item> + <tag><marker id="option_modify_algorithms"></marker> + <c><![CDATA[{modify_algorithms, modify_algs_list()}]]></c></tag> + <item> + <p>Modifies the list of algorithms to use in the algorithm negotiation. The modifications are + applied after the option <c>preferred_algorithms</c> (if existing) is applied.</p> + <p>The algoritm for modifications works like this:</p> + <list> + <item> + <p>Input is the <c>modify_algs_list()</c> and a set of algorithms <c>A</c> + obtained from the <c>preferred_algorithms</c> option if existing, or else from the + <seealso marker="ssh#default_algorithms-0">ssh:default_algorithms/0</seealso>. + </p> + </item> + <item> + <p>The head of the <c>modify_algs_list()</c> modifies <c>A</c> giving the result <c>A'</c>.</p> + <p>The possible modifications are:</p> + <list> + <item> + <p>Append or prepend supported but not enabled algorithm(s) to the list of + algorithms. If the wanted algorithms already are in <c>A</c> they will first + be removed and then appended or prepended, + </p> + </item> + <item> + <p>Remove (rm) one or more algorithms from <c>A</c>. + </p> + </item> + </list> + </item> + <item> + <p>Repeat the modification step with the tail of <c>modify_algs_list()</c> and the resulting + <c>A'</c>. + </p> + </item> + </list> + <p>If an unsupported algorithm is in the <c>modify_algs_list()</c>, it will be silently ignored</p> + <p>If there are more than one modify_algorithms options, the result is undefined.</p> + <p>Here is an example of this option:</p> + <code> +{modify_algorithms, + [{prepend, [{kex, ['diffie-hellman-group1-sha1']}], + {rm, [{compression, [none]}]} + ] +} +</code> + <p>The example specifies that:</p> + <list> + <item><p>the old key exchange algorithm 'diffie-hellman-group1-sha1' should be + the main alternative. It will be the main alternative since it is prepened to the list</p> + </item> + <item><p>The compression algorithm none (= no compression) is removed so compression is enforced</p> + </item> + </list> + <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> + </item> + <tag><c><![CDATA[{dh_gex_limits,{Min=integer(),I=integer(),Max=integer()}}]]></c></tag> <item> <p>Sets the three diffie-hellman-group-exchange parameters that guides the connected server in choosing a group. @@ -555,6 +617,8 @@ for cipher but specifies the same algorithms for mac and compression in both directions. The kex (key exchange) is implicit but public_key is set explicitly.</p> + <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> + <warning> <p>Changing the values can make a connection less secure. Do not change unless you know exactly what you are doing. If you do not understand the values then you @@ -562,6 +626,41 @@ </warning> </item> + <tag><marker id="option_modify_algorithms"></marker> + <c><![CDATA[{modify_algorithms, modify_algs_list()}]]></c></tag> + <item> + <p>Modifies the list of algorithms to use in the algorithm negotiation. The modifications are + applied after the option <c>preferred_algorithms</c> is applied (if existing)</p> + <p>The possible modifications are to:</p> + <list> + <item><p>Append or prepend supported but not enabled algorithm(s) to the list of + algorithms.</p><p>If the wanted algorithms already are in the list of algorithms, they will first + be removed and then appended or prepended. + </p> + </item> + <item><p>Remove (rm) one or more algorithms from the list of algorithms.</p></item> + </list> + <p>If an unsupported algorithm is in the list, it will be silently ignored</p> + + <p>Here is an example of this option:</p> + <code> +{modify_algorithms, + [{prepend, [{kex, ['diffie-hellman-group1-sha1']}], + {rm, [{compression, [none]}]} + ] +} +</code> + <p>The example specifies that:</p> + <list> + <item><p>the old key exchange algorithm 'diffie-hellman-group1-sha1' should be + the main alternative. It will be the main alternative since it is prepened to the list</p> + </item> + <item><p>The compression algorithm none (= no compression) is removed so compression is enforced</p> + </item> + </list> + <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> + </item> + <tag><c><![CDATA[{dh_gex_groups, [{Size=integer(),G=integer(),P=integer()}] | {file,filename()} {ssh_moduli_file,filename()} }]]></c></tag> <item> <p>Defines the groups the server may choose among when diffie-hellman-group-exchange is negotiated. diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml index 33ec7aaee0..1cbbdfcf38 100644 --- a/lib/ssh/doc/src/ssh_app.xml +++ b/lib/ssh/doc/src/ssh_app.xml @@ -97,7 +97,7 @@ <p>The <c>known_hosts</c> file contains a list of approved servers and their public keys. Once a server is listed, it can be verified without user interaction. - </p> + </p> </section> <section> <title>Authorized Keys</title> @@ -135,7 +135,7 @@ </p> <p>Supported algorithms are:</p> - + <marker id="supported_algos"></marker> <taglist> <tag>Key exchange algorithms</tag> <item> diff --git a/lib/ssh/doc/src/usersguide.xml b/lib/ssh/doc/src/usersguide.xml index 70051ba771..d902df6848 100644 --- a/lib/ssh/doc/src/usersguide.xml +++ b/lib/ssh/doc/src/usersguide.xml @@ -36,4 +36,5 @@ </description> <xi:include href="introduction.xml"/> <xi:include href="using_ssh.xml"/> + <xi:include href="configure_algos.xml"/> </part> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 5ebab43c30..1a5d48baca 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -35,6 +35,7 @@ daemon/1, daemon/2, daemon/3, daemon_info/1, default_algorithms/0, + chk_algos_opts/1, stop_listener/1, stop_listener/2, stop_listener/3, stop_daemon/1, stop_daemon/2, stop_daemon/3, shell/1, shell/2, shell/3 @@ -381,6 +382,27 @@ default_algorithms() -> ssh_transport:default_algorithms(). %%-------------------------------------------------------------------- +-spec chk_algos_opts(list(any())) -> algs_list() . +%%-------------------------------------------------------------------- +chk_algos_opts(Opts) -> + case lists:foldl( + fun({preferred_algorithms,_}, Acc) -> Acc; + ({modify_algorithms,_}, Acc) -> Acc; + (KV, Acc) -> [KV|Acc] + end, [], Opts) + of + [] -> + case ssh_options:handle_options(client, Opts) of + M when is_map(M) -> + maps:get(preferred_algorithms, M); + Others -> + Others + end; + OtherOps -> + {error, {non_algo_opts_found,OtherOps}} + end. + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- %% The handle_daemon_args/2 function basically only sets the ip-option in Opts diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index 7eeed70739..6939094401 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -170,9 +170,10 @@ handle_options(Role, PropList0, Opts0) when is_map(Opts0), OptionDefinitions), %% Enter the user's values into the map; unknown keys are %% treated as socket options - lists:foldl(fun(KV, Vals) -> - save(KV, OptionDefinitions, Vals) - end, InitialMap, PropList1) + final_preferred_algorithms( + lists:foldl(fun(KV, Vals) -> + save(KV, OptionDefinitions, Vals) + end, InitialMap, PropList1)) catch error:{eoptions, KV, undefined} -> {error, {eoptions,KV}}; @@ -236,7 +237,10 @@ save({Key,Value}, Defs, OptMap) when is_map(OptMap) -> %% by the check fun will give an error exception: error:{check,{BadValue,Extra}} -> error({eoptions, {Key,BadValue}, Extra}) - end. + end; +save(Opt, _Defs, OptMap) when is_map(OptMap) -> + OptMap#{socket_options := [Opt | maps:get(socket_options,OptMap)]}. + %%%================================================================ %%% @@ -506,6 +510,15 @@ default(common) -> class => user_options }, + %% NOTE: This option is supposed to be used only in this very module (?MODULE). There is + %% a final stage in handle_options that "merges" the preferred_algorithms option and this one. + %% The preferred_algorithms is the one to use in the rest of the ssh application! + {modify_algorithms, def} => + #{default => undefined, % signals error if unsupported algo in preferred_algorithms :( + chk => fun check_modify_algorithms/1, + class => user_options + }, + {id_string, def} => #{default => undefined, % FIXME: see ssh_transport:ssh_vsn/0 chk => fun(random) -> @@ -817,83 +830,190 @@ valid_hash(L, Ss) when is_list(L) -> lists:all(fun(S) -> valid_hash(S,Ss) end, L valid_hash(X, _) -> error_in_check(X, "Expect atom or list in fingerprint spec"). %%%---------------------------------------------------------------- -check_preferred_algorithms(Algs) -> - [error_in_check(K,"Bad preferred_algorithms key") - || {K,_} <- Algs, - not lists:keymember(K,1,ssh:default_algorithms())], +check_modify_algorithms(M) when is_list(M) -> + [error_in_check(Op_KVs, "Bad modify_algorithms") + || Op_KVs <- M, + not is_tuple(Op_KVs) + orelse (size(Op_KVs) =/= 2) + orelse (not lists:member(element(1,Op_KVs), [append,prepend,rm]))], + {true, [{Op,normalize_mod_algs(KVs,false)} || {Op,KVs} <- M]}; +check_modify_algorithms(_) -> + error_in_check(modify_algorithms, "Bad option value. List expected."). + + + + +normalize_mod_algs(KVs, UseDefaultAlgs) -> + normalize_mod_algs(ssh_transport:algo_classes(), KVs, [], UseDefaultAlgs). + +normalize_mod_algs([K|Ks], KVs0, Acc, UseDefaultAlgs) -> + %% Pick the expected keys in order and check if they are in the user's list + {Vs1, KVs} = + case lists:keytake(K, 1, KVs0) of + {value, {K,Vs0}, KVs1} -> + {Vs0, KVs1}; + false -> + {[], KVs0} + end, + Vs = normalize_mod_alg_list(K, Vs1, UseDefaultAlgs), + normalize_mod_algs(Ks, KVs, [{K,Vs} | Acc], UseDefaultAlgs); +normalize_mod_algs([], [], Acc, _) -> + %% No values left in the key-value list after removing the expected entries + %% (thats good) + lists:reverse(Acc); +normalize_mod_algs([], [{K,_}|_], _, _) -> + %% Some values left in the key-value list after removing the expected entries + %% (thats bad) + case ssh_transport:algo_class(K) of + true -> error_in_check(K, "Duplicate key"); + false -> error_in_check(K, "Unknown key") + end; +normalize_mod_algs([], [X|_], _, _) -> + error_in_check(X, "Bad list element"). - try alg_duplicates(Algs, [], []) - of - [] -> - {true, - [case proplists:get_value(Key, Algs) of - undefined -> - {Key,DefAlgs}; - Vals -> - handle_pref_alg(Key,Vals,SupAlgs) - end - || {{Key,DefAlgs}, {Key,SupAlgs}} <- lists:zip(ssh:default_algorithms(), - ssh_transport:supported_algorithms()) - ] - }; - - Dups -> - error_in_check(Dups, "Duplicates") - catch - _:_ -> - false - end. -alg_duplicates([{K,V}|KVs], Ks, Dups0) -> - Dups = - case lists:member(K,Ks) of - true -> [K|Dups0]; - false -> Dups0 - end, - case V--lists:usort(V) of - [] -> alg_duplicates(KVs, [K|Ks], Dups); - Ds -> alg_duplicates(KVs, [K|Ks], Dups++Ds) + +%%% Handle the algorithms list +normalize_mod_alg_list(K, Vs, UseDefaultAlgs) -> + normalize_mod_alg_list(K, + ssh_transport:algo_two_spec_class(K), + Vs, + def_alg(K,UseDefaultAlgs)). + + +normalize_mod_alg_list(_K, _, [], Default) -> + Default; + +normalize_mod_alg_list(K, true, [{client2server,L1}], [_,{server2client,L2}]) -> + [nml1(K,{client2server,L1}), + {server2client,L2}]; + +normalize_mod_alg_list(K, true, [{server2client,L2}], [{client2server,L1},_]) -> + [{client2server,L1}, + nml1(K,{server2client,L2})]; + +normalize_mod_alg_list(K, true, [{server2client,L2},{client2server,L1}], _) -> + [nml1(K,{client2server,L1}), + nml1(K,{server2client,L2})]; + +normalize_mod_alg_list(K, true, [{client2server,L1},{server2client,L2}], _) -> + [nml1(K,{client2server,L1}), + nml1(K,{server2client,L2})]; + +normalize_mod_alg_list(K, true, L0, _) -> + L = nml(K,L0), % Throws errors + [{client2server,L}, + {server2client,L}]; + +normalize_mod_alg_list(K, false, L, _) -> + nml(K,L). + + +nml1(K, {T,V}) when T==client2server ; T==server2client -> + {T, nml({K,T}, V)}. + +nml(K, L) -> + [error_in_check(K, "Bad value for this key") % This is a throw + || V <- L, + not is_atom(V) + ], + case L -- lists:usort(L) of + [] -> ok; + Dups -> error_in_check({K,Dups}, "Duplicates") % This is a throw + end, + L. + + +def_alg(K, false) -> + case ssh_transport:algo_two_spec_class(K) of + false -> []; + true -> [{client2server,[]}, {server2client,[]}] end; -alg_duplicates([], _Ks, Dups) -> - Dups. - -handle_pref_alg(Key, - Vs=[{client2server,C2Ss=[_|_]},{server2client,S2Cs=[_|_]}], - [{client2server,Sup_C2Ss},{server2client,Sup_S2Cs}] - ) -> - chk_alg_vs(Key, C2Ss, Sup_C2Ss), - chk_alg_vs(Key, S2Cs, Sup_S2Cs), - {Key, Vs}; - -handle_pref_alg(Key, - Vs=[{server2client,[_|_]},{client2server,[_|_]}], - Sup=[{client2server,_},{server2client,_}] - ) -> - handle_pref_alg(Key, lists:reverse(Vs), Sup); - -handle_pref_alg(Key, - Vs=[V|_], - Sup=[{client2server,_},{server2client,_}] - ) when is_atom(V) -> - handle_pref_alg(Key, [{client2server,Vs},{server2client,Vs}], Sup); - -handle_pref_alg(Key, - Vs=[V|_], - Sup=[S|_] - ) when is_atom(V), is_atom(S) -> - chk_alg_vs(Key, Vs, Sup), - {Key, Vs}; - -handle_pref_alg(Key, Vs, _) -> - error_in_check({Key,Vs}, "Badly formed list"). - -chk_alg_vs(OptKey, Values, SupportedValues) -> - case (Values -- SupportedValues) of - [] -> Values; - [none] -> [none]; % for testing only - Bad -> error_in_check({OptKey,Bad}, "Unsupported value(s) found") +def_alg(K, true) -> + ssh_transport:default_algorithms(K). + + + +check_preferred_algorithms(Algs) when is_list(Algs) -> + check_input_ok(Algs), + {true, normalize_mod_algs(Algs, true)}; + +check_preferred_algorithms(_) -> + error_in_check(modify_algorithms, "Bad option value. List expected."). + + +check_input_ok(Algs) -> + [error_in_check(KVs, "Bad preferred_algorithms") + || KVs <- Algs, + not is_tuple(KVs) + orelse (size(KVs) =/= 2)]. + +%%%---------------------------------------------------------------- +final_preferred_algorithms(Options) -> + Result = + case ?GET_OPT(modify_algorithms, Options) of + undefined -> + rm_non_supported(true, + ?GET_OPT(preferred_algorithms, Options)); + ModAlgs -> + rm_non_supported(false, + eval_ops(?GET_OPT(preferred_algorithms, Options), + ModAlgs)) + end, + error_if_empty(Result), % Throws errors if any value list is empty + ?PUT_OPT({preferred_algorithms,Result}, Options). + +eval_ops(PrefAlgs, ModAlgs) -> + lists:foldl(fun eval_op/2, PrefAlgs, ModAlgs). + +eval_op({Op,AlgKVs}, PrefAlgs) -> + eval_op(Op, AlgKVs, PrefAlgs, []). + +eval_op(Op, [{C,L1}|T1], [{C,L2}|T2], Acc) -> + eval_op(Op, T1, T2, [{C,eval_op(Op,L1,L2,[])} | Acc]); + +eval_op(_, [], [], Acc) -> lists:reverse(Acc); +eval_op(rm, Opt, Pref, []) when is_list(Opt), is_list(Pref) -> Pref -- Opt; +eval_op(append, Opt, Pref, []) when is_list(Opt), is_list(Pref) -> (Pref--Opt) ++ Opt; +eval_op(prepend, Opt, Pref, []) when is_list(Opt), is_list(Pref) -> Opt ++ (Pref--Opt). + + +rm_non_supported(UnsupIsErrorFlg, KVs) -> + [{K,rmns(K,Vs, UnsupIsErrorFlg)} || {K,Vs} <- KVs]. + +rmns(K, Vs, UnsupIsErrorFlg) -> + case ssh_transport:algo_two_spec_class(K) of + false -> + rm_unsup(Vs, ssh_transport:supported_algorithms(K), UnsupIsErrorFlg, K); + true -> + [{C, rm_unsup(Vsx, Sup, UnsupIsErrorFlg, {K,C})} + || {{C,Vsx},{C,Sup}} <- lists:zip(Vs,ssh_transport:supported_algorithms(K)) + ] end. +rm_unsup(A, B, Flg, ErrInf) -> + case A--B of + Unsup=[_|_] when Flg==true -> error({eoptions, + {preferred_algorithms,{ErrInf,Unsup}}, + "Unsupported value(s) found" + }); + Unsup -> A -- Unsup + end. + + +error_if_empty([{K,[]}|_]) -> + error({eoptions, K, "Empty resulting algorithm list"}); +error_if_empty([{K,[{client2server,[]}, {server2client,[]}]}]) -> + error({eoptions, K, "Empty resulting algorithm list"}); +error_if_empty([{K,[{client2server,[]}|_]} | _]) -> + error({eoptions, {K,client2server}, "Empty resulting algorithm list"}); +error_if_empty([{K,[_,{server2client,[]}|_]} | _]) -> + error({eoptions, {K,server2client}, "Empty resulting algorithm list"}); +error_if_empty([_|T]) -> + error_if_empty(T); +error_if_empty([]) -> + ok. + %%%---------------------------------------------------------------- forbidden_option(K,V) -> Txt = io_lib:format("The option '~s' is used internally. The " diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index c1558a19b1..9e1229dc85 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -1050,7 +1050,7 @@ attr_to_info(A) when is_record(A, ssh_xfer_attr) -> #file_info{ size = A#ssh_xfer_attr.size, type = A#ssh_xfer_attr.type, - access = read_write, %% FIXME: read/write/read_write/none + access = file_mode_to_owner_access(A#ssh_xfer_attr.permissions), atime = unix_to_datetime(A#ssh_xfer_attr.atime), mtime = unix_to_datetime(A#ssh_xfer_attr.mtime), ctime = unix_to_datetime(A#ssh_xfer_attr.createtime), @@ -1062,6 +1062,28 @@ attr_to_info(A) when is_record(A, ssh_xfer_attr) -> uid = A#ssh_xfer_attr.owner, gid = A#ssh_xfer_attr.group}. +file_mode_to_owner_access(FileMode) + when is_integer(FileMode) -> + %% The file mode contains the access permissions. + %% The read and write access permission of file owner + %% are located in 8th and 7th bit of file mode respectively. + + ReadPermission = ((FileMode bsr 8) band 1), + WritePermission = ((FileMode bsr 7) band 1), + case {ReadPermission, WritePermission} of + {1, 1} -> + read_write; + {1, 0} -> + read; + {0, 1} -> + write; + {0, 0} -> + none; + _ -> + undefined + end; +file_mode_to_owner_access(_) -> + undefined. unix_to_datetime(undefined) -> undefined; diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 412f5de9de..c48c0800e4 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -34,6 +34,8 @@ -export([next_seqnum/1, supported_algorithms/0, supported_algorithms/1, default_algorithms/0, default_algorithms/1, + algo_classes/0, algo_class/1, + algo_two_spec_classes/0, algo_two_spec_class/1, handle_packet_part/4, handle_hello_version/1, key_exchange_init_msg/1, @@ -81,6 +83,23 @@ default_algorithms() -> [{K,default_algorithms(K)} || K <- algo_classes()]. algo_classes() -> [kex, public_key, cipher, mac, compression]. +algo_class(kex) -> true; +algo_class(public_key) -> true; +algo_class(cipher) -> true; +algo_class(mac) -> true; +algo_class(compression) -> true; +algo_class(_) -> false. + + +algo_two_spec_classes() -> [cipher, mac, compression]. + +algo_two_spec_class(cipher) -> true; +algo_two_spec_class(mac) -> true; +algo_two_spec_class(compression) -> true; +algo_two_spec_class(_) -> false. + + + default_algorithms(kex) -> supported_algorithms(kex, [ 'diffie-hellman-group1-sha1' % Gone in OpenSSH 7.3.p1 diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 0837fe7eaf..7da921adb2 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -34,8 +34,8 @@ -define(NEWLINE, <<"\r\n">>). -define(REKEY_DATA_TMO, 65000). -%%-define(DEFAULT_KEX, 'diffie-hellman-group1-sha1'). -define(DEFAULT_KEX, 'diffie-hellman-group14-sha256'). +-define(EXTRA_KEX, 'diffie-hellman-group1-sha1'). -define(CIPHERS, ['aes256-ctr','aes192-ctr','aes128-ctr','aes128-cbc','3des-cbc']). -define(DEFAULT_CIPHERS, [{client2server,?CIPHERS}, {server2client,?CIPHERS}]). @@ -60,7 +60,8 @@ all() -> {group,authentication}, {group,packet_size_error}, {group,field_size_error}, - {group,ext_info} + {group,ext_info}, + {group,preferred_algorithms} ]. groups() -> @@ -96,7 +97,13 @@ groups() -> no_ext_info_s2, ext_info_s, ext_info_c - ]} + ]}, + {preferred_algorithms, [], [preferred_algorithms, + modify_append, + modify_prepend, + modify_rm, + modify_combo + ]} ]. @@ -701,8 +708,6 @@ ext_info_s(Config) -> %%%-------------------------------------------------------------------- %%% The client sends the extension ext_info_c(Config) -> - {User,_Pwd} = server_user_password(Config), - %% Create a listening socket as server socket: {ok,InitialState} = ssh_trpt_test_lib:exec(listen), HostPort = ssh_trpt_test_lib:server_host_port(InitialState), @@ -757,10 +762,135 @@ ext_info_c(Config) -> {result, Pid, Error} -> ct:fail("Error: ~p",[Error]) end. + +%%%---------------------------------------------------------------- +%%% +preferred_algorithms(Config) -> + Ciphers = filter_supported(cipher, ?CIPHERS), + {error,{eoptions,{{preferred_algorithms,{kex,[some_unknown_algo]}}, + "Unsupported value(s) found"}}} = + chk_pref_algs(Config, + [?DEFAULT_KEX], + Ciphers, + [{preferred_algorithms, [{kex,[some_unknown_algo,?DEFAULT_KEX]}, + {cipher,Ciphers} + ]} + ]). + +%%%---------------------------------------------------------------- +%%% +modify_append(Config) -> + Ciphers = filter_supported(cipher, ?CIPHERS), + {ok,_} = + chk_pref_algs(Config, + [?DEFAULT_KEX, ?EXTRA_KEX], + Ciphers, + [{preferred_algorithms, [{kex,[?DEFAULT_KEX]}, + {cipher,Ciphers} + ]}, + {modify_algorithms, [{append,[{kex,[some_unknown_algo,?EXTRA_KEX]}]}]} + ]). + +%%%---------------------------------------------------------------- +%%% +modify_prepend(Config) -> + Ciphers = filter_supported(cipher, ?CIPHERS), + {ok,_} = + chk_pref_algs(Config, + [?EXTRA_KEX, ?DEFAULT_KEX], + Ciphers, + [{preferred_algorithms, [{kex,[?DEFAULT_KEX]}, + {cipher,Ciphers} + ]}, + {modify_algorithms, [{prepend,[{kex,[some_unknown_algo,?EXTRA_KEX]}]}]} + ]). + +%%%---------------------------------------------------------------- +%%% +modify_rm(Config) -> + Ciphers = filter_supported(cipher, ?CIPHERS), + {ok,_} = + chk_pref_algs(Config, + [?DEFAULT_KEX], + tl(Ciphers), + [{preferred_algorithms, [{kex,[?DEFAULT_KEX,?EXTRA_KEX]}, + {cipher,Ciphers} + ]}, + {modify_algorithms, [{rm,[{kex,[some_unknown_algo,?EXTRA_KEX]}, + {cipher,[hd(Ciphers)]} + ]} + ]} + ]). + + +%%%---------------------------------------------------------------- +%%% +modify_combo(Config) -> + Ciphers = filter_supported(cipher, ?CIPHERS), + LastC = lists:last(Ciphers), + {ok,_} = + chk_pref_algs(Config, + [?DEFAULT_KEX], + [LastC] ++ (tl(Ciphers)--[LastC]) ++ [hd(Ciphers)], + [{preferred_algorithms, [{kex,[?DEFAULT_KEX,?EXTRA_KEX]}, + {cipher,Ciphers} + ]}, + {modify_algorithms, [{rm,[{kex,[some_unknown_algo,?EXTRA_KEX]} + ]}, + {prepend,[{cipher,[{server2client,[LastC]}]} + ]}, + {append,[{cipher,[a,hd(Ciphers),b]} + ]} + ]} + ]). + %%%================================================================ %%%==== Internal functions ======================================== %%%================================================================ +chk_pref_algs(Config, + ExpectedKex, + ExpectedCiphers, + ServerPrefOpts) -> + %% Start the dameon + case ssh_test_lib:daemon( + [{send_ext_info,false}, + {recv_ext_info,false}, + {system_dir, system_dir(Config)} + | ServerPrefOpts]) + of + {_,Host,Port} -> + %% Check the Kex part + ssh_trpt_test_lib:exec( + [{set_options, [print_ops, {print_messages,detail}]}, + {connect, Host, Port, + [{silently_accept_hosts, true}, + {user_dir, user_dir(Config)}, + {user_interaction, false} + ]}, + {send, hello}, + receive_hello, + {match, + #ssh_msg_kexinit{ + kex_algorithms = to_lists(ExpectedKex), + encryption_algorithms_server_to_client = to_lists(ExpectedCiphers), + _ = '_'}, + receive_msg} + ]); + Error -> + Error + end. + + +filter_supported(K, Algs) -> Algs -- (Algs--supported(K)). + +supported(K) -> proplists:get_value( + server2client, + ssh_transport:supported_algorithms(cipher)). + +to_lists(L) -> lists:map(fun erlang:atom_to_list/1, L). + + %%%---- init_suite and end_suite --------------------------------------- start_apps(Config) -> catch ssh:stop(), diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 680a8ef52e..7aa3d8a00a 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -92,7 +92,7 @@ groups() -> {write_read_tests, [], [open_close_file, open_close_dir, read_file, read_dir, write_file, write_file_iolist, write_big_file, sftp_read_big_file, rename_file, mk_rm_dir, remove_file, links, - retrieve_attributes, set_attributes, async_read, + retrieve_attributes, set_attributes, file_owner_access, async_read, async_write, position, pos_read, pos_write, start_channel_sock ]} @@ -521,7 +521,36 @@ set_attributes(Config) when is_list(Config) -> ok = file:write_file(FileName, "hello again"). %%-------------------------------------------------------------------- +file_owner_access() -> + [{doc,"Test file user access validity"}]. +file_owner_access(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> + {skip, "Not a relevant test on Windows"}; + _ -> + FileName = proplists:get_value(filename, Config), + {Sftp, _} = proplists:get_value(sftp, Config), + + {ok, #file_info{mode = InitialMode}} = ssh_sftp:read_file_info(Sftp, FileName), + + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#000}), + {ok, #file_info{access = none}} = ssh_sftp:read_file_info(Sftp, FileName), + + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#400}), + {ok, #file_info{access = read}} = ssh_sftp:read_file_info(Sftp, FileName), + + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#200}), + {ok, #file_info{access = write}} = ssh_sftp:read_file_info(Sftp, FileName), + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), + {ok, #file_info{access = read_write}} = ssh_sftp:read_file_info(Sftp, FileName), + + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=InitialMode}), + + ok + end. + +%%-------------------------------------------------------------------- async_read() -> [{doc,"Test API aread/3"}]. async_read(Config) when is_list(Config) -> diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 7208baca6e..006228f8e7 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.5 +SSH_VSN = 4.5.1 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index b6aafc3fa4..ff3e69bae5 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -276,7 +276,9 @@ init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = St Result = ssl_connection:init(Type, Event, State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, protocol_specific = #{current_cookie_secret => dtls_v1:cookie_secret(), - previous_cookie_secret => <<>>}}, + previous_cookie_secret => <<>>, + ignored_alerts => 0, + max_ignored_alerts => 10}}, ?MODULE), erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret), Result; @@ -374,7 +376,7 @@ hello(internal, #server_hello{} = Hello, ssl_options = SslOptions} = State) -> case dtls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, ReqVersion, hello, State); + handle_own_alert(Alert, ReqVersion, hello, State); {Version, NewId, ConnectionStates, ProtoExt, Protocol} -> ssl_connection:handle_session(Hello, Version, NewId, ConnectionStates, ProtoExt, Protocol, State) @@ -546,7 +548,7 @@ handle_call(Event, From, StateName, State) -> handle_common_event(internal, #alert{} = Alert, StateName, #state{negotiated_version = Version} = State) -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State); + handle_own_alert(Alert, Version, StateName, State); %%% DTLS record protocol level handshake messages handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, @@ -565,7 +567,7 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} end catch throw:#alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State0) + handle_own_alert(Alert, Version, StateName, State0) end; %%% DTLS record protocol level application data messages handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> @@ -580,7 +582,7 @@ handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, Sta Alerts = [_|_] -> handle_alerts(Alerts, {next_state, StateName, State}); #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State) + handle_own_alert(Alert, Version, StateName, State) end; %% Ignore unknown TLS record level protocol messages handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> @@ -632,7 +634,7 @@ handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, ClientVersion, hello, State0); + handle_own_alert(Alert, ClientVersion, hello, State0); {Version, {Type, Session}, ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> Protocol = case Protocol0 of @@ -967,3 +969,54 @@ unprocessed_events(Events) -> %% process more TLS-records received on the socket. erlang:length(Events)-1. +handle_own_alert(Alert, Version, StateName, #state{transport_cb = gen_udp, + role = Role, + ssl_options = Options} = State0) -> + case ignore_alert(Alert, State0) of + {true, State} -> + log_ignore_alert(Options#ssl_options.log_alert, StateName, Alert, Role), + {next_state, StateName, State}; + {false, State} -> + ssl_connection:handle_own_alert(Alert, Version, StateName, State) + end; +handle_own_alert(Alert, Version, StateName, State) -> + ssl_connection:handle_own_alert(Alert, Version, StateName, State). + + +ignore_alert(#alert{level = ?FATAL}, #state{protocol_specific = #{ignored_alerts := N, + max_ignored_alerts := N}} = State) -> + {false, State}; +ignore_alert(#alert{level = ?FATAL} = Alert, + #state{protocol_specific = #{ignored_alerts := N} = PS} = State) -> + case is_ignore_alert(Alert) of + true -> + {true, State#state{protocol_specific = PS#{ignored_alerts => N+1}}}; + false -> + {false, State} + end; +ignore_alert(_, State) -> + {false, State}. + +%% RFC 6347 4.1.2.7. Handling Invalid Records +%% recommends to silently ignore invalid DTLS records when +%% upd is the transport. Note we do not support compression so no need +%% include ?DECOMPRESSION_FAILURE +is_ignore_alert(#alert{description = ?BAD_RECORD_MAC}) -> + true; +is_ignore_alert(#alert{description = ?RECORD_OVERFLOW}) -> + true; +is_ignore_alert(#alert{description = ?DECODE_ERROR}) -> + true; +is_ignore_alert(#alert{description = ?DECRYPT_ERROR}) -> + true; +is_ignore_alert(#alert{description = ?ILLEGAL_PARAMETER}) -> + true; +is_ignore_alert(_) -> + false. + +log_ignore_alert(true, StateName, Alert, Role) -> + Txt = ssl_alert:alert_txt(Alert), + error_logger:format("DTLS over UDP ~p: In state ~p ignored to send ALERT ~s as DoS-attack mitigation \n", + [Role, StateName, Txt]); +log_ignore_alert(false, _, _,_) -> + ok. diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl index fbbd479428..5f854fbb4b 100644 --- a/lib/ssl/src/dtls_socket.erl +++ b/lib/ssl/src/dtls_socket.erl @@ -137,7 +137,7 @@ internal_inet_values() -> [{active, false}, {mode,binary}]. default_inet_values() -> - [{active, true}, {mode, list}]. + [{active, true}, {mode, list}, {packet, 0}, {packet_size, 0}]. default_cb_info() -> {gen_udp, udp, udp_closed, udp_error}. @@ -149,8 +149,12 @@ get_emulated_opts(EmOpts, EmOptNames) -> emulated_socket_options(InetValues, #socket_options{ mode = Mode, + packet = Packet, + packet_size = PacketSize, active = Active}) -> #socket_options{ mode = proplists:get_value(mode, InetValues, Mode), + packet = proplists:get_value(packet, InetValues, Packet), + packet_size = proplists:get_value(packet_size, InetValues, PacketSize), active = proplists:get_value(active, InetValues, Active) }. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 75eb308ba5..4e592c02ec 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -569,7 +569,7 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> %%-------------------------------------------------------------------- -spec prf(#sslsocket{}, binary() | 'master_secret', binary(), - binary() | prf_random(), non_neg_integer()) -> + [binary() | prf_random()], non_neg_integer()) -> {ok, binary()} | {error, reason()}. %% %% Description: use a ssl sessions TLS PRF to generate key material @@ -713,6 +713,13 @@ handle_options(Opts0, Role, Host) -> Protocol = handle_option(protocol, Opts, tls), + case Versions of + [{3, 0}] -> + reject_alpn_next_prot_options(Opts); + _ -> + ok + end, + SSLOptions = #ssl_options{ versions = Versions, verify = validate_option(verify, Verify), @@ -809,7 +816,7 @@ handle_options(Opts0, Role, Host) -> ConnetionCb = connection_cb(Opts), {ok, #config{ssl = SSLOptions, emulated = Emulated, inet_ssl = Sock, - inet_user = SockOpts, transport_info = CbInfo, connection_cb = ConnetionCb + inet_user = Sock, transport_info = CbInfo, connection_cb = ConnetionCb }}. @@ -956,55 +963,32 @@ validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> validate_option(erl_dist,Value) when is_boolean(Value) -> Value; -validate_option(Opt, Value) - when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols, - is_list(Value) -> - case tls_record:highest_protocol_version([]) of - {3,0} -> - throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); - _ -> - validate_binary_list(Opt, Value), - Value - end; +validate_option(Opt, Value) when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols, + is_list(Value) -> + validate_binary_list(Opt, Value), + Value; validate_option(Opt, Value) when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols, Value =:= undefined -> undefined; -validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value) +validate_option(client_preferred_next_protocols, {Precedence, PreferredProtocols}) when is_list(PreferredProtocols) -> - case tls_record:highest_protocol_version([]) of - {3,0} -> - throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); - _ -> - validate_binary_list(client_preferred_next_protocols, PreferredProtocols), - validate_npn_ordering(Precedence), - {Precedence, PreferredProtocols, ?NO_PROTOCOL} - end; -validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols, Default} = Value) - when is_list(PreferredProtocols), is_binary(Default), - byte_size(Default) > 0, byte_size(Default) < 256 -> - case tls_record:highest_protocol_version([]) of - {3,0} -> - throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); - _ -> - validate_binary_list(client_preferred_next_protocols, PreferredProtocols), - validate_npn_ordering(Precedence), - Value - end; - + validate_binary_list(client_preferred_next_protocols, PreferredProtocols), + validate_npn_ordering(Precedence), + {Precedence, PreferredProtocols, ?NO_PROTOCOL}; +validate_option(client_preferred_next_protocols, {Precedence, PreferredProtocols, Default} = Value) + when is_list(PreferredProtocols), is_binary(Default), + byte_size(Default) > 0, byte_size(Default) < 256 -> + validate_binary_list(client_preferred_next_protocols, PreferredProtocols), + validate_npn_ordering(Precedence), + Value; validate_option(client_preferred_next_protocols, undefined) -> undefined; validate_option(log_alert, Value) when is_boolean(Value) -> Value; -validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> - case tls_record:highest_protocol_version([]) of - {3,0} -> - throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); - _ -> - validate_binary_list(next_protocols_advertised, Value), - Value - end; - +validate_option(next_protocols_advertised, Value) when is_list(Value) -> + validate_binary_list(next_protocols_advertised, Value), + Value; validate_option(next_protocols_advertised, undefined) -> undefined; validate_option(server_name_indication = Opt, Value) when is_list(Value) -> @@ -1483,3 +1467,22 @@ server_name_indication_default(Host) when is_list(Host) -> Host; server_name_indication_default(_) -> undefined. + + +reject_alpn_next_prot_options(Opts) -> + AlpnNextOpts = [alpn_advertised_protocols, + alpn_preferred_protocols, + next_protocols_advertised, + next_protocol_selector, + client_preferred_next_protocols], + reject_alpn_next_prot_options(AlpnNextOpts, Opts). + +reject_alpn_next_prot_options([], _) -> + ok; +reject_alpn_next_prot_options([Opt| AlpnNextOpts], Opts) -> + case lists:keyfind(Opt, 1, Opts) of + {Opt, Value} -> + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); + false -> + reject_alpn_next_prot_options(AlpnNextOpts, Opts) + end. diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index b923785e17..db415a3666 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -32,7 +32,7 @@ -include("ssl_record.hrl"). -include("ssl_internal.hrl"). --export([decode/1, alert_txt/1, reason_code/2]). +-export([decode/1, own_alert_txt/1, alert_txt/1, reason_code/2]). %%==================================================================== %% Internal application API @@ -60,12 +60,28 @@ reason_code(#alert{description = Description}, _) -> {tls_alert, string:to_lower(description_txt(Description))}. %%-------------------------------------------------------------------- +-spec own_alert_txt(#alert{}) -> string(). +%% +%% Description: Returns the error string for given alert generated +%% by the erlang implementation. +%%-------------------------------------------------------------------- +own_alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}, reason = undefined, role = Role}) -> + "at " ++ Mod ++ ":" ++ integer_to_list(Line) ++ " generated " ++ string:to_upper(atom_to_list(Role)) ++ " ALERT: " ++ + level_txt(Level) ++ description_txt(Description); +own_alert_txt(#alert{reason = Reason} = Alert) -> + BaseTxt = own_alert_txt(Alert#alert{reason = undefined}), + FormatDepth = 9, % Some limit on printed representation of an error + ReasonTxt = lists:flatten(io_lib:format("~P", [Reason, FormatDepth])), + BaseTxt ++ " - " ++ ReasonTxt. + +%%-------------------------------------------------------------------- -spec alert_txt(#alert{}) -> string(). %% -%% Description: Returns the error string for given alert. +%% Description: Returns the error string for given alert received from +%% the peer. %%-------------------------------------------------------------------- -alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}, reason = undefined, role = Role}) -> - "at " ++ Mod ++ ":" ++ integer_to_list(Line) ++ " " ++ string:to_upper(atom_to_list(Role)) ++ " ALERT: " ++ +alert_txt(#alert{level = Level, description = Description, reason = undefined, role = Role}) -> + "received " ++ string:to_upper(atom_to_list(Role)) ++ " ALERT: " ++ level_txt(Level) ++ description_txt(Description); alert_txt(#alert{reason = Reason} = Alert) -> BaseTxt = alert_txt(Alert#alert{reason = undefined}), @@ -103,8 +119,8 @@ description_txt(?UNEXPECTED_MESSAGE) -> "Unexpected Message"; description_txt(?BAD_RECORD_MAC) -> "Bad Record MAC"; -description_txt(?DECRYPTION_FAILED) -> - "Decryption Failed"; +description_txt(?DECRYPTION_FAILED_RESERVED) -> + "Decryption Failed Reserved"; description_txt(?RECORD_OVERFLOW) -> "Record Overflow"; description_txt(?DECOMPRESSION_FAILURE) -> diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index 1aabb6c55a..35670edea5 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -40,7 +40,7 @@ %% close_notify(0), %% unexpected_message(10), %% bad_record_mac(20), -%% decryption_failed(21), +%% decryption_failed_reserved(21), %% record_overflow(22), %% decompression_failure(30), %% handshake_failure(40), @@ -78,7 +78,7 @@ -define(CLOSE_NOTIFY, 0). -define(UNEXPECTED_MESSAGE, 10). -define(BAD_RECORD_MAC, 20). --define(DECRYPTION_FAILED, 21). +-define(DECRYPTION_FAILED_RESERVED, 21). -define(RECORD_OVERFLOW, 22). -define(DECOMPRESSION_FAILURE, 30). -define(HANDSHAKE_FAILURE, 40). diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index bd60197c88..b6cd22dd13 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -335,7 +335,9 @@ all_suites(Version) -> anonymous_suites({3, N}) -> anonymous_suites(N); - +anonymous_suites({254, _} = Version) -> + anonymous_suites(dtls_v1:corresponding_tls_version(Version)) + -- [?TLS_DH_anon_WITH_RC4_128_MD5]; anonymous_suites(N) when N >= 3 -> [?TLS_DH_anon_WITH_AES_128_GCM_SHA256, @@ -373,30 +375,38 @@ psk_suites({3, N}) -> psk_suites(N) when N >= 3 -> [ + ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, ?TLS_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384, ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, ?TLS_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256, ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, ?TLS_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, ?TLS_PSK_WITH_AES_128_CBC_SHA256 ] ++ psk_suites(0); psk_suites(_) -> - [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, + [?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA, + ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, ?TLS_PSK_WITH_AES_256_CBC_SHA, + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA, ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, ?TLS_PSK_WITH_AES_128_CBC_SHA, + ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_PSK_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDHE_PSK_WITH_RC4_128_SHA, ?TLS_DHE_PSK_WITH_RC4_128_SHA, ?TLS_RSA_PSK_WITH_RC4_128_SHA, ?TLS_PSK_WITH_RC4_128_SHA]. @@ -563,6 +573,15 @@ suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA) -> suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> {rsa_psk, aes_256_cbc, sha, default_prf}; +%%% PSK NULL Cipher Suites RFC 4785 + +suite_definition(?TLS_PSK_WITH_NULL_SHA) -> + {psk, null, sha, default_prf}; +suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA) -> + {dhe_psk, null, sha, default_prf}; +suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA) -> + {rsa_psk, null, sha, default_prf}; + %%% TLS 1.2 PSK Cipher Suites RFC 5487 suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> @@ -604,6 +623,36 @@ suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA256) -> suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA384) -> {rsa_psk, null, sha384, default_prf}; +%%% ECDHE PSK Cipher Suites RFC 5489 + +suite_definition(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) -> + {ecdhe_psk, rc4_128, sha, default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) -> + {ecdhe_psk, '3des_ede_cbc', sha, default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) -> + {ecdhe_psk, aes_128_cbc, sha, default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) -> + {ecdhe_psk, aes_256_cbc, sha, default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> + {ecdhe_psk, aes_128_cbc, sha256, default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> + {ecdhe_psk, aes_256_cbc, sha384, default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> + {ecdhe_psk, null, sha256, default_prf}; +suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> + {ecdhe_psk, null, sha384, default_prf}; + +%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 + +suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> + {ecdhe_psk, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> + {ecdhe_psk, aes_256_gcm, null, sha384}; +%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> +%% {ecdhe_psk, aes_128_ccm, null, sha256}; +%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> +%% {ecdhe_psk, aes_256_ccm, null, sha256}; + %%% SRP Cipher Suites RFC 5054 suite_definition(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> @@ -865,6 +914,15 @@ suite({rsa_psk, aes_128_cbc,sha}) -> suite({rsa_psk, aes_256_cbc,sha}) -> ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA; +%%% PSK NULL Cipher Suites RFC 4785 + +suite({psk, null, sha}) -> + ?TLS_PSK_WITH_NULL_SHA; +suite({dhe_psk, null, sha}) -> + ?TLS_DHE_PSK_WITH_NULL_SHA; +suite({rsa_psk, null, sha}) -> + ?TLS_RSA_PSK_WITH_NULL_SHA; + %%% TLS 1.2 PSK Cipher Suites RFC 5487 suite({psk, aes_128_gcm, null, sha256}) -> @@ -906,6 +964,36 @@ suite({rsa_psk, null, sha256}) -> suite({rsa_psk, null, sha384}) -> ?TLS_RSA_PSK_WITH_NULL_SHA384; +%%% ECDHE PSK Cipher Suites RFC 5489 + +suite({ecdhe_psk, rc4_128,sha}) -> + ?TLS_ECDHE_PSK_WITH_RC4_128_SHA; +suite({ecdhe_psk, '3des_ede_cbc',sha}) -> + ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA; +suite({ecdhe_psk, aes_128_cbc,sha}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA; +suite({ecdhe_psk, aes_256_cbc,sha}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA; +suite({ecdhe_psk, aes_128_cbc, sha256}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256; +suite({ecdhe_psk, aes_256_cbc, sha384}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384; +suite({ecdhe_psk, null, sha256}) -> + ?TLS_ECDHE_PSK_WITH_NULL_SHA256; +suite({ecdhe_psk, null, sha384}) -> + ?TLS_ECDHE_PSK_WITH_NULL_SHA384; + +%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 + +suite({ecdhe_psk, aes_128_gcm, null, sha256}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256; +suite({ecdhe_psk, aes_256_gcm, null, sha384}) -> + ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384; +%% suite({ecdhe_psk, aes_128_ccm, null, sha256}) -> +%% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256; +%% suite({ecdhe_psk, aes_256_ccm, null, sha256}) -> +%% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256; + %%% SRP Cipher Suites RFC 5054 suite({srp_anon, '3des_ede_cbc', sha}) -> @@ -1465,7 +1553,8 @@ is_acceptable_keyexchange(dhe_dss, Algos) -> is_acceptable_keyexchange(dhe_rsa, Algos) -> proplists:get_bool(dh, Algos) andalso proplists:get_bool(rsa, Algos); -is_acceptable_keyexchange(ecdh_anon, Algos) -> +is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_anon; + KeyExchange == ecdhe_psk -> proplists:get_bool(ecdh, Algos); is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_ecdsa; KeyExchange == ecdhe_ecdsa -> diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 8e8f3d9c67..e5462d8402 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -399,6 +399,17 @@ %% TLS_RSA_PSK_WITH_AES_256_CBC_SHA = { 0x00, 0x95 }; -define(TLS_RSA_PSK_WITH_AES_256_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#95)>>). +%%% PSK NULL Cipher Suites RFC 4785 + +%% TLS_PSK_WITH_NULL_SHA = { 0x00, 0x2C }; +-define(TLS_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2C)>>). + +%% TLS_DHE_PSK_WITH_NULL_SHA = { 0x00, 0x2D }; +-define(TLS_DHE_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2D)>>). + +%% TLS_RSA_PSK_WITH_NULL_SHA = { 0x00, 0x2E }; +-define(TLS_RSA_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2E)>>). + %%% TLS 1.2 PSK Cipher Suites RFC 5487 %% TLS_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xA8}; @@ -455,6 +466,46 @@ %% TLS_RSA_PSK_WITH_NULL_SHA384 = {0x00,0xB9}; -define(TLS_RSA_PSK_WITH_NULL_SHA384, <<?BYTE(16#00), ?BYTE(16#B9)>>). +%%% ECDHE PSK Cipher Suites RFC 5489 + +%% TLS_ECDHE_PSK_WITH_RC4_128_SHA = {0xC0,0x33}; +-define(TLS_ECDHE_PSK_WITH_RC4_128_SHA, <<?BYTE(16#C0), ?BYTE(16#33)>>). + +%% TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA = {0xC0,0x34}; +-define(TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#34)>>). + +%% TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA = {0xC0,0x35}; +-define(TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#35)>>). + +%% TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA = {0xC0,0x36}; +-define(TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#36)>>). + +%% TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256 = {0xC0,0x37}; +-define(TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256, <<?BYTE(16#C0), ?BYTE(16#37)>>). + +%% TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384 = {0xC0,0x38}; +-define(TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384, <<?BYTE(16#C0), ?BYTE(16#38)>>). + +%% TLS_ECDHE_PSK_WITH_NULL_SHA256 = {0xC0,0x3A}; +-define(TLS_ECDHE_PSK_WITH_NULL_SHA256, <<?BYTE(16#C0), ?BYTE(16#3A)>>). + +%% TLS_ECDHE_PSK_WITH_NULL_SHA384 = {0xC0,0x3B}; +-define(TLS_ECDHE_PSK_WITH_NULL_SHA384, <<?BYTE(16#C0), ?BYTE(16#3B)>>). + +%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 + +%% TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256 = {0xTBD; 0xTBD} {0xD0,0x01}; +-define(TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#D0), ?BYTE(16#01)>>). + +%% TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384 = {0xTBD; 0xTBD} {0xD0,0x02}; +-define(TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#D0), ?BYTE(16#02)>>). + +%% TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256 = {0xTBD; 0xTBD} {0xD0,0x03}; +-define(TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256, <<?BYTE(16#D0), ?BYTE(16#03)>>). + +%% TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256 = {0xTBD; 0xTBD} {0xD0,0x05}; +-define(TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256, <<?BYTE(16#D0), ?BYTE(16#05)>>). + %%% SRP Cipher Suites RFC 5054 %% TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA = { 0xC0,0x1A }; diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 72535c05cb..5d48325719 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -264,7 +264,7 @@ renegotiation(ConnectionPid) -> %%-------------------------------------------------------------------- -spec prf(pid(), binary() | 'master_secret', binary(), - binary() | ssl:prf_random(), non_neg_integer()) -> + [binary() | ssl:prf_random()], non_neg_integer()) -> {ok, binary()} | {error, reason()} | {'EXIT', term()}. %% %% Description: use a ssl sessions TLS PRF to generate key material @@ -517,7 +517,7 @@ certify(internal, #server_key_exchange{exchange_keys = Keys}, when Alg == dhe_dss; Alg == dhe_rsa; Alg == ecdhe_rsa; Alg == ecdhe_ecdsa; Alg == dh_anon; Alg == ecdh_anon; - Alg == psk; Alg == dhe_psk; Alg == rsa_psk; + Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk; Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> Params = ssl_handshake:decode_server_key(Keys, Alg, ssl:tls_version(Version)), @@ -542,6 +542,15 @@ certify(internal, #server_key_exchange{exchange_keys = Keys}, end end; +certify(internal, #certificate_request{}, + #state{role = client, negotiated_version = Version, + key_algorithm = Alg} = State, _) + when Alg == dh_anon; Alg == ecdh_anon; + Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk; + Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> + handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), + Version, certify, State); + certify(internal, #certificate_request{} = CertRequest, #state{session = #session{own_certificate = Cert}, role = client, @@ -673,10 +682,11 @@ cipher(internal, #certificate_verify{signature = Signature, tls_handshake_history = Handshake } = State0, Connection) -> + TLSVersion = ssl:tls_version(Version), %% Use negotiated value if TLS-1.2 otherwhise return default - HashSign = negotiated_hashsign(CertHashSign, KexAlg, PublicKeyInfo, Version), + HashSign = negotiated_hashsign(CertHashSign, KexAlg, PublicKeyInfo, TLSVersion), case ssl_handshake:certificate_verify(Signature, PublicKeyInfo, - ssl:tls_version(Version), HashSign, MasterSecret, Handshake) of + TLSVersion, HashSign, MasterSecret, Handshake) of valid -> {Record, State} = Connection:next_record(State0), Connection:next_event(cipher, Record, @@ -1143,7 +1153,8 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName, port = Port, session = Session, user_application = {_Mon, Pid}, role = Role, socket_options = Opts, tracker = Tracker}) -> invalidate_session(Role, Host, Port, Session), - log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), + StateName, Alert#alert{role = opposite_role(Role)}), alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection), {stop, normal}; @@ -1154,7 +1165,8 @@ handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) -> - log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + log_alert(SslOpts#ssl_options.log_alert, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), handle_normal_shutdown(Alert, StateName, State), {stop, {shutdown, peer_close}}; @@ -1162,7 +1174,8 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, #state{role = Role, ssl_options = SslOpts, renegotiation = {true, From}, protocol_cb = Connection} = State0) -> - log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + log_alert(SslOpts#ssl_options.log_alert, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), gen_statem:reply(From, {error, renegotiation_rejected}), {Record, State} = Connection:next_record(State0), %% Go back to connection! @@ -1171,7 +1184,8 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, %% Gracefully log and ignore all other warning alerts handle_alert(#alert{level = ?WARNING} = Alert, StateName, #state{ssl_options = SslOpts, protocol_cb = Connection, role = Role} = State0) -> - log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), + log_alert(SslOpts#ssl_options.log_alert, Role, + Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), {Record, State} = Connection:next_record(State0), Connection:next_event(StateName, Record, State). @@ -1394,6 +1408,16 @@ certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey, PremasterSecret = ssl_handshake:premaster_secret(ClientKey, ServerDhPrivateKey, Params, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); + +certify_client_key_exchange(#client_ecdhe_psk_identity{} = ClientKey, + #state{diffie_hellman_keys = ServerEcDhPrivateKey, + ssl_options = + #ssl_options{user_lookup_fun = PSKLookup}} = State, + Connection) -> + PremasterSecret = + ssl_handshake:premaster_secret(ClientKey, ServerEcDhPrivateKey, PSKLookup), + calculate_master_secret(PremasterSecret, State, Connection, certify, cipher); + certify_client_key_exchange(#client_rsa_psk_identity{} = ClientKey, #state{private_key = Key, ssl_options = @@ -1413,6 +1437,7 @@ certify_server(#state{key_algorithm = Algo} = State, _) when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; Algo == dhe_psk; + Algo == ecdhe_psk; Algo == srp_anon -> State; @@ -1519,6 +1544,28 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk, State = Connection:queue_handshake(Msg, State0), State#state{diffie_hellman_keys = DHKeys}; +key_exchange(#state{role = server, key_algorithm = ecdhe_psk, + ssl_options = #ssl_options{psk_identity = PskIdentityHint}, + hashsign_algorithm = HashSignAlgo, + private_key = PrivateKey, + session = #session{ecc = ECCCurve}, + connection_states = ConnectionStates0, + negotiated_version = Version + } = State0, Connection) -> + ECDHKeys = public_key:generate_key(ECCCurve), + #{security_parameters := SecParams} = + ssl_record:pending_connection_state(ConnectionStates0, read), + #security_parameters{client_random = ClientRandom, + server_random = ServerRandom} = SecParams, + Msg = ssl_handshake:key_exchange(server, ssl:tls_version(Version), + {ecdhe_psk, + PskIdentityHint, ECDHKeys, + HashSignAlgo, ClientRandom, + ServerRandom, + PrivateKey}), + State = Connection:queue_handshake(Msg, State0), + State#state{diffie_hellman_keys = ECDHKeys}; + key_exchange(#state{role = server, key_algorithm = rsa_psk, ssl_options = #ssl_options{psk_identity = undefined}} = State, _) -> State; @@ -1617,6 +1664,17 @@ key_exchange(#state{role = client, {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}), Connection:queue_handshake(Msg, State0); + +key_exchange(#state{role = client, + ssl_options = SslOpts, + key_algorithm = ecdhe_psk, + negotiated_version = Version, + diffie_hellman_keys = ECDHKeys} = State0, Connection) -> + Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version), + {ecdhe_psk, + SslOpts#ssl_options.psk_identity, ECDHKeys}), + Connection:queue_handshake(Msg, State0); + key_exchange(#state{role = client, ssl_options = SslOpts, key_algorithm = rsa_psk, @@ -1672,6 +1730,12 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, rsa_psk_key_exchange(_, _, _, _) -> throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE, pub_key_is_not_rsa)). +request_client_cert(#state{key_algorithm = Alg} = State, _) + when Alg == dh_anon; Alg == ecdh_anon; + Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk; + Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> + State; + request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer, signature_algs = SupportedHashSigns}, connection_states = ConnectionStates0, @@ -1793,6 +1857,18 @@ calculate_secret(#server_dhe_psk_params{ calculate_master_secret(PremasterSecret, State#state{diffie_hellman_keys = Keys}, Connection, certify, certify); +calculate_secret(#server_ecdhe_psk_params{ + dh_params = #server_ecdh_params{curve = ECCurve}} = ServerKey, + #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = + State=#state{session=Session}, Connection) -> + ECDHKeys = public_key:generate_key(ECCurve), + + PremasterSecret = ssl_handshake:premaster_secret(ServerKey, ECDHKeys, PSKLookup), + calculate_master_secret(PremasterSecret, + State#state{diffie_hellman_keys = ECDHKeys, + session = Session#session{ecc = ECCurve}}, + Connection, certify, certify); + calculate_secret(#server_srp_params{srp_n = Prime, srp_g = Generator} = ServerKey, #state{ssl_options = #ssl_options{srp_identity = SRPId}} = State, Connection) -> @@ -1877,6 +1953,7 @@ is_anonymous(Algo) when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; Algo == dhe_psk; + Algo == ecdhe_psk; Algo == rsa_psk; Algo == srp_anon -> true; @@ -2371,10 +2448,13 @@ alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connectio Transport, Socket, Connection, Tracker), ReasonCode}) end. -log_alert(true, ProtocolName, StateName, Alert) -> +log_alert(true, Role, ProtocolName, StateName, #alert{role = Role} = Alert) -> + Txt = ssl_alert:own_alert_txt(Alert), + error_logger:info_report(io_lib:format("~s ~p: In state ~p ~s\n", [ProtocolName, Role, StateName, Txt])); +log_alert(true, Role, ProtocolName, StateName, Alert) -> Txt = ssl_alert:alert_txt(Alert), - error_logger:format("~s: In state ~p ~s\n", [ProtocolName, StateName, Txt]); -log_alert(false, _, _, _) -> + error_logger:info_report(io_lib:format("~s ~p: In state ~p ~s\n", [ProtocolName, Role, StateName, Txt])); +log_alert(false, _, _, _, _) -> ok. handle_own_alert(Alert, Version, StateName, @@ -2392,7 +2472,7 @@ handle_own_alert(Alert, Version, StateName, ignore end, try %% Try to tell the local user - log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = Role}), + log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), StateName, Alert#alert{role = Role}), handle_normal_shutdown(Alert,StateName, State) catch _:_ -> ok diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index b1661624b5..fc4181a760 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -227,6 +227,7 @@ certificate_request(CipherSuite, CertDbHandle, CertDbRef, HashSigns, Version) -> {ecdh, #'ECPrivateKey'{}} | {psk, binary()} | {dhe_psk, binary(), binary()} | + {ecdhe_psk, binary(), #'ECPrivateKey'{}} | {srp, {binary(), binary()}, #srp_user{}, {HashAlgo::atom(), SignAlgo::atom()}, binary(), binary(), public_key:private_key()}) -> #client_key_exchange{} | #server_key_exchange{}. @@ -264,6 +265,13 @@ key_exchange(client, _Version, {dhe_psk, Identity, PublicKey}) -> dh_public = PublicKey} }; +key_exchange(client, _Version, {ecdhe_psk, Identity, #'ECPrivateKey'{publicKey = ECPublicKey}}) -> + #client_key_exchange{ + exchange_keys = #client_ecdhe_psk_identity{ + identity = Identity, + dh_public = ECPublicKey} + }; + key_exchange(client, _Version, {psk_premaster_secret, PskIdentity, Secret, {_, PublicKey, _}}) -> EncPremasterSecret = encrypted_premaster_secret(Secret, PublicKey), @@ -310,6 +318,16 @@ key_exchange(server, Version, {dhe_psk, PskIdentityHint, {PublicKey, _}, enc_server_key_exchange(Version, ServerEDHPSKParams, HashSign, ClientRandom, ServerRandom, PrivateKey); +key_exchange(server, Version, {ecdhe_psk, PskIdentityHint, + #'ECPrivateKey'{publicKey = ECPublicKey, + parameters = ECCurve}, + HashSign, ClientRandom, ServerRandom, PrivateKey}) -> + ServerECDHEPSKParams = #server_ecdhe_psk_params{ + hint = PskIdentityHint, + dh_params = #server_ecdh_params{curve = ECCurve, public = ECPublicKey}}, + enc_server_key_exchange(Version, ServerECDHEPSKParams, HashSign, + ClientRandom, ServerRandom, PrivateKey); + key_exchange(server, Version, {srp, {PublicKey, _}, #srp_user{generator = Generator, prime = Prime, salt = Salt}, @@ -532,14 +550,31 @@ premaster_secret(#server_dhe_psk_params{ LookupFun) -> PremasterSecret = premaster_secret(PublicDhKey, PrivateDhKey, Params), psk_secret(IdentityHint, LookupFun, PremasterSecret); + +premaster_secret(#server_ecdhe_psk_params{ + hint = IdentityHint, + dh_params = #server_ecdh_params{ + public = ECServerPubKey}}, + PrivateEcDhKey, + LookupFun) -> + PremasterSecret = premaster_secret(#'ECPoint'{point = ECServerPubKey}, PrivateEcDhKey), + psk_secret(IdentityHint, LookupFun, PremasterSecret); + premaster_secret({rsa_psk, PSKIdentity}, PSKLookup, RSAPremasterSecret) -> - psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret). + psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret); + +premaster_secret(#client_ecdhe_psk_identity{ + identity = PSKIdentity, + dh_public = PublicEcDhPoint}, PrivateEcDhKey, PSKLookup) -> + PremasterSecret = premaster_secret(#'ECPoint'{point = PublicEcDhPoint}, PrivateEcDhKey), + psk_secret(PSKIdentity, PSKLookup, PremasterSecret). premaster_secret(#client_dhe_psk_identity{ identity = PSKIdentity, dh_public = PublicDhKey}, PrivateKey, #'DHParameter'{} = Params, PSKLookup) -> PremasterSecret = premaster_secret(PublicDhKey, PrivateKey, Params), psk_secret(PSKIdentity, PSKLookup, PremasterSecret). + premaster_secret(#client_psk_identity{identity = PSKIdentity}, PSKLookup) -> psk_secret(PSKIdentity, PSKLookup); premaster_secret({psk, PSKIdentity}, PSKLookup) -> @@ -887,6 +922,7 @@ enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo}, | #client_ec_diffie_hellman_public{} | #client_psk_identity{} | #client_dhe_psk_identity{} + | #client_ecdhe_psk_identity{} | #client_rsa_psk_identity{} | #client_srp_public{}. %% @@ -1048,6 +1084,7 @@ dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary, _/binary>> = KeyStruc params_bin = BinMsg, hashsign = HashSign, signature = Signature}; + dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary, ?UINT16(PLen), P:PLen/binary, ?UINT16(GLen), G:GLen/binary, @@ -1062,6 +1099,22 @@ dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary, params_bin = BinMsg, hashsign = HashSign, signature = Signature}; +dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary, + ?BYTE(?NAMED_CURVE), ?UINT16(CurveID), + ?BYTE(PointLen), ECPoint:PointLen/binary, + _/binary>> = KeyStruct, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, Version) -> + DHParams = #server_ecdh_params{ + curve = {namedCurve, tls_v1:enum_to_oid(CurveID)}, + public = ECPoint}, + Params = #server_ecdhe_psk_params{ + hint = IdentityHint, + dh_params = DHParams}, + {BinMsg, HashSign, Signature} = dec_server_key_params(Len + 2 + PointLen + 4, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; dec_server_key(<<?UINT16(NLen), N:NLen/binary, ?UINT16(GLen), G:GLen/binary, ?BYTE(SLen), S:SLen/binary, @@ -1132,7 +1185,8 @@ filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc KeyExchange == ecdh_anon; KeyExchange == srp_anon; KeyExchange == psk; - KeyExchange == dhe_psk -> + KeyExchange == dhe_psk; + KeyExchange == ecdhe_psk -> %% In this case hashsigns is not used as the kexchange is anonaymous filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]). @@ -1496,6 +1550,8 @@ advertises_ec_ciphers([{ecdhe_rsa, _,_,_} | _]) -> true; advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) -> true; +advertises_ec_ciphers([{ecdhe_psk, _,_,_} | _]) -> + true; advertises_ec_ciphers([_| Rest]) -> advertises_ec_ciphers(Rest). @@ -1790,6 +1846,18 @@ encode_server_key(#server_dhe_psk_params{ YLen = byte_size(Y), <<?UINT16(Len), PskIdentityHint/binary, ?UINT16(PLen), P/binary, ?UINT16(GLen), G/binary, ?UINT16(YLen), Y/binary>>; +encode_server_key(Params = #server_ecdhe_psk_params{hint = undefined}) -> + encode_server_key(Params#server_ecdhe_psk_params{hint = <<>>}); +encode_server_key(#server_ecdhe_psk_params{ + hint = PskIdentityHint, + dh_params = #server_ecdh_params{ + curve = {namedCurve, ECCurve}, public = ECPubKey}}) -> + %%TODO: support arbitrary keys + Len = byte_size(PskIdentityHint), + KLen = size(ECPubKey), + <<?UINT16(Len), PskIdentityHint/binary, + ?BYTE(?NAMED_CURVE), ?UINT16((tls_v1:oid_to_enum(ECCurve))), + ?BYTE(KLen), ECPubKey/binary>>; encode_server_key(#server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}) -> NLen = byte_size(N), GLen = byte_size(G), @@ -1822,6 +1890,12 @@ encode_client_key(#client_dhe_psk_identity{identity = Id, dh_public = DHPublic}, Len = byte_size(Id), DHLen = byte_size(DHPublic), <<?UINT16(Len), Id/binary, ?UINT16(DHLen), DHPublic/binary>>; +encode_client_key(Identity = #client_ecdhe_psk_identity{identity = undefined}, Version) -> + encode_client_key(Identity#client_ecdhe_psk_identity{identity = <<"psk_identity">>}, Version); +encode_client_key(#client_ecdhe_psk_identity{identity = Id, dh_public = DHPublic}, _) -> + Len = byte_size(Id), + DHLen = byte_size(DHPublic), + <<?UINT16(Len), Id/binary, ?BYTE(DHLen), DHPublic/binary>>; encode_client_key(Identity = #client_rsa_psk_identity{identity = undefined}, Version) -> encode_client_key(Identity#client_rsa_psk_identity{identity = <<"psk_identity">>}, Version); encode_client_key(#client_rsa_psk_identity{identity = Id, exchange_keys = ExchangeKeys}, Version) -> @@ -1873,6 +1947,10 @@ dec_client_key(<<?UINT16(Len), Id:Len/binary, ?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, ?KEY_EXCHANGE_DHE_PSK, _) -> #client_dhe_psk_identity{identity = Id, dh_public = DH_Y}; +dec_client_key(<<?UINT16(Len), Id:Len/binary, + ?BYTE(DH_YLen), DH_Y:DH_YLen/binary>>, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, _) -> + #client_ecdhe_psk_identity{identity = Id, dh_public = DH_Y}; dec_client_key(<<?UINT16(Len), Id:Len/binary, PKEPMS/binary>>, ?KEY_EXCHANGE_RSA_PSK, {3, 0}) -> #client_rsa_psk_identity{identity = Id, @@ -2050,6 +2128,8 @@ key_exchange_alg(psk) -> ?KEY_EXCHANGE_PSK; key_exchange_alg(dhe_psk) -> ?KEY_EXCHANGE_DHE_PSK; +key_exchange_alg(ecdhe_psk) -> + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK; key_exchange_alg(rsa_psk) -> ?KEY_EXCHANGE_RSA_PSK; key_exchange_alg(Alg) @@ -2308,6 +2388,7 @@ is_acceptable_hash_sign({_, ecdsa} = Algos, ecdsa, ecdsa, ecdhe_ecdsa, Supported is_acceptable_hash_sign(_, _, _, KeyExAlgo, _) when KeyExAlgo == psk; KeyExAlgo == dhe_psk; + KeyExAlgo == ecdhe_psk; KeyExAlgo == srp_anon; KeyExAlgo == dh_anon; KeyExAlgo == ecdhe_anon diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 324b7dbde3..a191fcf766 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -133,6 +133,7 @@ -define(KEY_EXCHANGE_DIFFIE_HELLMAN, 1). -define(KEY_EXCHANGE_EC_DIFFIE_HELLMAN, 6). -define(KEY_EXCHANGE_PSK, 2). +-define(KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, 7). -define(KEY_EXCHANGE_DHE_PSK, 3). -define(KEY_EXCHANGE_RSA_PSK, 4). -define(KEY_EXCHANGE_SRP, 5). @@ -162,6 +163,11 @@ dh_params }). +-record(server_ecdhe_psk_params, { + hint, + dh_params + }). + -record(server_srp_params, { srp_n, %% opaque srp_N<1..2^16-1> srp_g, %% opaque srp_g<1..2^16-1> @@ -254,6 +260,11 @@ dh_public }). +-record(client_ecdhe_psk_identity, { + identity, + dh_public + }). + -record(client_rsa_psk_identity, { identity, exchange_keys diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index ca9aaf4660..ef7c3de7af 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -563,7 +563,7 @@ server_register_session(Port, Session, #state{session_cache_server_max = Max, do_register_session(Key, Session, Max, Pid, Cache, CacheCb) -> try CacheCb:size(Cache) of - Max -> + Size when Size >= Max -> invalidate_session_cache(Pid, CacheCb, Cache); _ -> CacheCb:update(Cache, Key, Session), diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 558be6d642..c7e2f402af 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -56,7 +56,6 @@ MODULES = \ ssl_upgrade_SUITE\ ssl_sni_SUITE \ make_certs\ - erl_make_certs\ x509_test diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl deleted file mode 100644 index 3ab6222780..0000000000 --- a/lib/ssl/test/erl_make_certs.erl +++ /dev/null @@ -1,477 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2011-2017. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% Create test certificates - --module(erl_make_certs). --include_lib("public_key/include/public_key.hrl"). - --export([make_cert/1, gen_rsa/1, verify_signature/3, write_pem/3]). --compile(export_all). - -%%-------------------------------------------------------------------- -%% @doc Create and return a der encoded certificate -%% Option Default -%% ------------------------------------------------------- -%% digest sha1 -%% validity {date(), date() + week()} -%% version 3 -%% subject [] list of the following content -%% {name, Name} -%% {email, Email} -%% {city, City} -%% {state, State} -%% {org, Org} -%% {org_unit, OrgUnit} -%% {country, Country} -%% {serial, Serial} -%% {title, Title} -%% {dnQualifer, DnQ} -%% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created) -%% (obs IssuerKey migth be {Key, Password} -%% key = KeyFile|KeyBin|rsa|dsa|ec Subject PublicKey rsa, dsa or ec generates key -%% -%% -%% (OBS: The generated keys are for testing only) -%% @spec ([{::atom(), ::term()}]) -> {Cert::binary(), Key::binary()} -%% @end -%%-------------------------------------------------------------------- - -make_cert(Opts) -> - SubjectPrivateKey = get_key(Opts), - {TBSCert, IssuerKey} = make_tbs(SubjectPrivateKey, Opts), - Cert = public_key:pkix_sign(TBSCert, IssuerKey), - true = verify_signature(Cert, IssuerKey, undef), %% verify that the keys where ok - {Cert, encode_key(SubjectPrivateKey)}. - -%%-------------------------------------------------------------------- -%% @doc Writes pem files in Dir with FileName ++ ".pem" and FileName ++ "_key.pem" -%% @spec (::string(), ::string(), {Cert,Key}) -> ok -%% @end -%%-------------------------------------------------------------------- -write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) -> - ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"), - [{'Certificate', Cert, not_encrypted}]), - ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]). - -%%-------------------------------------------------------------------- -%% @doc Creates a rsa key (OBS: for testing only) -%% the size are in bytes -%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} -%% @end -%%-------------------------------------------------------------------- -gen_rsa(Size) when is_integer(Size) -> - Key = gen_rsa2(Size), - {Key, encode_key(Key)}. - -%%-------------------------------------------------------------------- -%% @doc Creates a dsa key (OBS: for testing only) -%% the sizes are in bytes -%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} -%% @end -%%-------------------------------------------------------------------- -gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> - Key = gen_dsa2(LSize, NSize), - {Key, encode_key(Key)}. - -%%-------------------------------------------------------------------- -%% @doc Creates a ec key (OBS: for testing only) -%% the sizes are in bytes -%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} -%% @end -%%-------------------------------------------------------------------- -gen_ec(Curve) when is_atom(Curve) -> - Key = gen_ec2(Curve), - {Key, encode_key(Key)}. - -%%-------------------------------------------------------------------- -%% @doc Verifies cert signatures -%% @spec (::binary(), ::tuple()) -> ::boolean() -%% @end -%%-------------------------------------------------------------------- -verify_signature(DerEncodedCert, DerKey, _KeyParams) -> - Key = decode_key(DerKey), - case Key of - #'RSAPrivateKey'{modulus=Mod, publicExponent=Exp} -> - public_key:pkix_verify(DerEncodedCert, - #'RSAPublicKey'{modulus=Mod, publicExponent=Exp}); - #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} -> - public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}); - #'ECPrivateKey'{version = _Version, privateKey = _PrivKey, - parameters = Params, publicKey = PubKey} -> - public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params}) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -get_key(Opts) -> - case proplists:get_value(key, Opts) of - undefined -> make_key(rsa, Opts); - rsa -> make_key(rsa, Opts); - dsa -> make_key(dsa, Opts); - ec -> make_key(ec, Opts); - Key -> - Password = proplists:get_value(password, Opts, no_passwd), - decode_key(Key, Password) - end. - -decode_key({Key, Pw}) -> - decode_key(Key, Pw); -decode_key(Key) -> - decode_key(Key, no_passwd). - - -decode_key(#'RSAPublicKey'{} = Key,_) -> - Key; -decode_key(#'RSAPrivateKey'{} = Key,_) -> - Key; -decode_key(#'DSAPrivateKey'{} = Key,_) -> - Key; -decode_key(#'ECPrivateKey'{} = Key,_) -> - Key; -decode_key(PemEntry = {_,_,_}, Pw) -> - public_key:pem_entry_decode(PemEntry, Pw); -decode_key(PemBin, Pw) -> - [KeyInfo] = public_key:pem_decode(PemBin), - decode_key(KeyInfo, Pw). - -encode_key(Key = #'RSAPrivateKey'{}) -> - {ok, Der} = 'OTP-PUB-KEY':encode('RSAPrivateKey', Key), - {'RSAPrivateKey', Der, not_encrypted}; -encode_key(Key = #'DSAPrivateKey'{}) -> - {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key), - {'DSAPrivateKey', Der, not_encrypted}; -encode_key(Key = #'ECPrivateKey'{}) -> - {ok, Der} = 'OTP-PUB-KEY':encode('ECPrivateKey', Key), - {'ECPrivateKey', Der, not_encrypted}. - -make_tbs(SubjectKey, Opts) -> - Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))), - - IssuerProp = proplists:get_value(issuer, Opts, true), - {Issuer, IssuerKey} = issuer(IssuerProp, Opts, SubjectKey), - - {Algo, Parameters} = sign_algorithm(IssuerKey, Opts), - - SignAlgo = #'SignatureAlgorithm'{algorithm = Algo, - parameters = Parameters}, - Subject = case IssuerProp of - true -> %% Is a Root Ca - Issuer; - _ -> - subject(proplists:get_value(subject, Opts),false) - end, - - {#'OTPTBSCertificate'{serialNumber = trunc(rand:uniform()*100000000)*10000 + 1, - signature = SignAlgo, - issuer = Issuer, - validity = validity(Opts), - subject = Subject, - subjectPublicKeyInfo = publickey(SubjectKey), - version = Version, - extensions = extensions(Opts) - }, IssuerKey}. - -issuer(true, Opts, SubjectKey) -> - %% Self signed - {subject(proplists:get_value(subject, Opts), true), SubjectKey}; -issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) -> - {issuer_der(Issuer), decode_key(IssuerKey)}; -issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) -> - {ok, [{cert, Cert, _}|_]} = pem_to_der(File), - {issuer_der(Cert), decode_key(IssuerKey)}. - -issuer_der(Issuer) -> - Decoded = public_key:pkix_decode_cert(Issuer, otp), - #'OTPCertificate'{tbsCertificate=Tbs} = Decoded, - #'OTPTBSCertificate'{subject=Subject} = Tbs, - Subject. - -subject(undefined, IsRootCA) -> - User = if IsRootCA -> "RootCA"; true -> os:getenv("USER", "test_user") end, - Opts = [{email, User ++ "@erlang.org"}, - {name, User}, - {city, "Stockholm"}, - {country, "SE"}, - {org, "erlang"}, - {org_unit, "testing dep"}], - subject(Opts); -subject(Opts, _) -> - subject(Opts). - -subject(SubjectOpts) when is_list(SubjectOpts) -> - Encode = fun(Opt) -> - {Type,Value} = subject_enc(Opt), - [#'AttributeTypeAndValue'{type=Type, value=Value}] - end, - {rdnSequence, [Encode(Opt) || Opt <- SubjectOpts]}. - -%% Fill in the blanks -subject_enc({name, Name}) -> {?'id-at-commonName', {printableString, Name}}; -subject_enc({email, Email}) -> {?'id-emailAddress', Email}; -subject_enc({city, City}) -> {?'id-at-localityName', {printableString, City}}; -subject_enc({state, State}) -> {?'id-at-stateOrProvinceName', {printableString, State}}; -subject_enc({org, Org}) -> {?'id-at-organizationName', {printableString, Org}}; -subject_enc({org_unit, OrgUnit}) -> {?'id-at-organizationalUnitName', {printableString, OrgUnit}}; -subject_enc({country, Country}) -> {?'id-at-countryName', Country}; -subject_enc({serial, Serial}) -> {?'id-at-serialNumber', Serial}; -subject_enc({title, Title}) -> {?'id-at-title', {printableString, Title}}; -subject_enc({dnQualifer, DnQ}) -> {?'id-at-dnQualifier', DnQ}; -subject_enc(Other) -> Other. - - -extensions(Opts) -> - case proplists:get_value(extensions, Opts, []) of - false -> - asn1_NOVALUE; - Exts -> - lists:flatten([extension(Ext) || Ext <- default_extensions(Exts)]) - end. - -default_extensions(Exts) -> - Def = [{key_usage,undefined}, - {subject_altname, undefined}, - {issuer_altname, undefined}, - {basic_constraints, default}, - {name_constraints, undefined}, - {policy_constraints, undefined}, - {ext_key_usage, undefined}, - {inhibit_any, undefined}, - {auth_key_id, undefined}, - {subject_key_id, undefined}, - {policy_mapping, undefined}], - Filter = fun({Key, _}, D) -> lists:keydelete(Key, 1, D) end, - Exts ++ lists:foldl(Filter, Def, Exts). - -extension({_, undefined}) -> []; -extension({basic_constraints, Data}) -> - case Data of - default -> - #'Extension'{extnID = ?'id-ce-basicConstraints', - extnValue = #'BasicConstraints'{cA=true}, - critical=true}; - false -> - []; - Len when is_integer(Len) -> - #'Extension'{extnID = ?'id-ce-basicConstraints', - extnValue = #'BasicConstraints'{cA=true, pathLenConstraint=Len}, - critical=true}; - _ -> - #'Extension'{extnID = ?'id-ce-basicConstraints', - extnValue = Data} - end; -extension({Id, Data, Critical}) -> - #'Extension'{extnID = Id, extnValue = Data, critical = Critical}. - - -publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) -> - Public = #'RSAPublicKey'{modulus=N, publicExponent=E}, - Algo = #'PublicKeyAlgorithm'{algorithm= ?rsaEncryption, parameters='NULL'}, - #'OTPSubjectPublicKeyInfo'{algorithm = Algo, - subjectPublicKey = Public}; -publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> - Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', - parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}}, - #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}; -publickey(#'ECPrivateKey'{version = _Version, - privateKey = _PrivKey, - parameters = Params, - publicKey = PubKey}) -> - Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params}, - #'OTPSubjectPublicKeyInfo'{algorithm = Algo, - subjectPublicKey = #'ECPoint'{point = PubKey}}. - -validity(Opts) -> - DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1), - DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7), - {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}), - Format = fun({Y,M,D}) -> lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) end, - #'Validity'{notBefore={generalTime, Format(DefFrom)}, - notAfter ={generalTime, Format(DefTo)}}. - -sign_algorithm(#'RSAPrivateKey'{}, Opts) -> - Type = case proplists:get_value(digest, Opts, sha1) of - sha1 -> ?'sha1WithRSAEncryption'; - sha512 -> ?'sha512WithRSAEncryption'; - sha384 -> ?'sha384WithRSAEncryption'; - sha256 -> ?'sha256WithRSAEncryption'; - md5 -> ?'md5WithRSAEncryption'; - md2 -> ?'md2WithRSAEncryption' - end, - {Type, 'NULL'}; -sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> - {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}; -sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) -> - Type = case proplists:get_value(digest, Opts, sha1) of - sha1 -> ?'ecdsa-with-SHA1'; - sha512 -> ?'ecdsa-with-SHA512'; - sha384 -> ?'ecdsa-with-SHA384'; - sha256 -> ?'ecdsa-with-SHA256' - end, - {Type, Parms}. - -make_key(rsa, _Opts) -> - %% (OBS: for testing only) - gen_rsa2(64); -make_key(dsa, _Opts) -> - gen_dsa2(128, 20); %% Bytes i.e. {1024, 160} -make_key(ec, _Opts) -> - %% (OBS: for testing only) - CurveOid = hd(tls_v1:ecc_curves(0)), - NamedCurve = pubkey_cert_records:namedCurves(CurveOid), - gen_ec2(NamedCurve). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% RSA key generation (OBS: for testing only) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --define(SMALL_PRIMES, [65537,97,89,83,79,73,71,67,61,59,53, - 47,43,41,37,31,29,23,19,17,13,11,7,5,3]). - -gen_rsa2(Size) -> - P = prime(Size), - Q = prime(Size), - N = P*Q, - Tot = (P - 1) * (Q - 1), - [E|_] = lists:dropwhile(fun(Candidate) -> (Tot rem Candidate) == 0 end, ?SMALL_PRIMES), - {D1,D2} = extended_gcd(E, Tot), - D = erlang:max(D1,D2), - case D < E of - true -> - gen_rsa2(Size); - false -> - {Co1,Co2} = extended_gcd(Q, P), - Co = erlang:max(Co1,Co2), - #'RSAPrivateKey'{version = 'two-prime', - modulus = N, - publicExponent = E, - privateExponent = D, - prime1 = P, - prime2 = Q, - exponent1 = D rem (P-1), - exponent2 = D rem (Q-1), - coefficient = Co - } - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% DSA key generation (OBS: for testing only) -%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm -%% and the fips_186-3.pdf -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -gen_dsa2(LSize, NSize) -> - Q = prime(NSize), %% Choose N-bit prime Q - X0 = prime(LSize), - P0 = prime((LSize div 2) +1), - - %% Choose L-bit prime modulus P such that p-1 is a multiple of q. - case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of - error -> - gen_dsa2(LSize, NSize); - P -> - G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. - %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used. - - X = prime(20), %% Choose x by some random method, where 0 < x < q. - Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p. - - #'DSAPrivateKey'{version=0, p = P, q = Q, - g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X} - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% EC key generation (OBS: for testing only) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -gen_ec2(CurveId) -> - {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId), - - #'ECPrivateKey'{version = 1, - privateKey = PrivKey, - parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)}, - publicKey = PubKey}. - -%% See fips_186-3.pdf -dsa_search(T, P0, Q, Iter) when Iter > 0 -> - P = 2*T*Q*P0 + 1, - case is_prime(P, 50) of - true -> P; - false -> dsa_search(T+1, P0, Q, Iter-1) - end; -dsa_search(_,_,_,_) -> - error. - - -%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -prime(ByteSize) -> - Rand = odd_rand(ByteSize), - prime_odd(Rand, 0). - -prime_odd(Rand, N) -> - case is_prime(Rand, 50) of - true -> - Rand; - false -> - prime_odd(Rand+2, N+1) - end. - -%% see http://en.wikipedia.org/wiki/Fermat_primality_test -is_prime(_, 0) -> true; -is_prime(Candidate, Test) -> - CoPrime = odd_rand(10000, Candidate), - Result = crypto:mod_pow(CoPrime, Candidate, Candidate) , - is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test). - -is_prime(CoPrime, CoPrime, Candidate, Test) -> - is_prime(Candidate, Test-1); -is_prime(_,_,_,_) -> - false. - -odd_rand(Size) -> - Min = 1 bsl (Size*8-1), - Max = (1 bsl (Size*8))-1, - odd_rand(Min, Max). - -odd_rand(Min,Max) -> - Rand = crypto:rand_uniform(Min,Max), - case Rand rem 2 of - 0 -> - Rand + 1; - _ -> - Rand - end. - -extended_gcd(A, B) -> - case A rem B of - 0 -> - {0, 1}; - N -> - {X, Y} = extended_gcd(B, N), - {Y, X-Y*(A div B)} - end. - -pem_to_der(File) -> - {ok, PemBin} = file:read_file(File), - public_key:pem_decode(PemBin). - -der_to_pem(File, Entries) -> - PemBin = public_key:pem_encode(Entries), - file:write_file(File, PemBin). - diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index 0fbb0bb79a..64e8042b25 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -36,7 +36,9 @@ all() -> [ {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, - {group, 'tlsv1'} + {group, 'tlsv1'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} ]. groups() -> @@ -44,6 +46,8 @@ groups() -> {'tlsv1.2', [], all_versions_groups()}, {'tlsv1.1', [], all_versions_groups()}, {'tlsv1', [], all_versions_groups()}, + {'dtlsv1.2', [], all_versions_groups()}, + {'dtlsv1', [], all_versions_groups()}, {'erlang_server', [], openssl_key_cert_combinations()}, %%{'erlang_client', [], openssl_key_cert_combinations()}, {'erlang', [], key_cert_combinations() ++ misc() @@ -196,8 +200,14 @@ common_init_per_group(GroupName, Config) -> openssl_check(GroupName, Config) end. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(GroupName, Config0) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + Config = ssl_test_lib:clean_tls_version(Config0), + proplists:delete(tls_version, Config); + false -> + Config0 + end. %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl index 158b3524ac..055f05a900 100644 --- a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl @@ -35,14 +35,19 @@ all() -> [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}]. + {group, 'sslv3'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} + ]. groups() -> [ {'tlsv1.2', [], alpn_tests()}, {'tlsv1.1', [], alpn_tests()}, {'tlsv1', [], alpn_tests()}, - {'sslv3', [], alpn_not_supported()} + {'sslv3', [], alpn_not_supported()}, + {'dtlsv1.2', [], alpn_tests() -- [client_renegotiate]}, + {'dtlsv1', [], alpn_tests() -- [client_renegotiate]} ]. alpn_tests() -> @@ -67,13 +72,12 @@ alpn_not_supported() -> alpn_not_supported_server ]. -init_per_suite(Config) -> +init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> ssl_test_lib:clean_start(), - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config), - proplists:get_value(priv_dir, Config)), + Config = ssl_test_lib:make_rsa_cert(Config0), ssl_test_lib:cert_options(Config) catch _:_ -> {skip, "Crypto did not start"} @@ -90,8 +94,7 @@ init_per_group(GroupName, Config) -> true -> case ssl_test_lib:sufficient_crypto_support(GroupName) of true -> - ssl_test_lib:init_tls_version(GroupName, Config), - Config; + ssl_test_lib:init_tls_version(GroupName, Config); false -> {skip, "Missing crypto support"} end; @@ -100,8 +103,14 @@ init_per_group(GroupName, Config) -> Config end. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. + init_per_testcase(_TestCase, Config) -> ssl_test_lib:ct_log_supported_protocol_versions(Config), @@ -116,26 +125,29 @@ end_per_testcase(_TestCase, Config) -> %%-------------------------------------------------------------------- empty_protocols_are_not_allowed(Config) when is_list(Config) -> + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {error, {options, {alpn_preferred_protocols, {invalid_protocol, <<>>}}}} = (catch ssl:listen(9443, - [{alpn_preferred_protocols, [<<"foo/1">>, <<"">>]}])), + [{alpn_preferred_protocols, [<<"foo/1">>, <<"">>]}| ServerOpts])), {error, {options, {alpn_advertised_protocols, {invalid_protocol, <<>>}}}} = (catch ssl:connect({127,0,0,1}, 9443, - [{alpn_advertised_protocols, [<<"foo/1">>, <<"">>]}])). + [{alpn_advertised_protocols, [<<"foo/1">>, <<"">>]} | ServerOpts])). %-------------------------------------------------------------------------------- protocols_must_be_a_binary_list(Config) when is_list(Config) -> + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), Option1 = {alpn_preferred_protocols, hello}, - {error, {options, Option1}} = (catch ssl:listen(9443, [Option1])), + {error, {options, Option1}} = (catch ssl:listen(9443, [Option1 | ServerOpts])), Option2 = {alpn_preferred_protocols, [<<"foo/1">>, hello]}, {error, {options, {alpn_preferred_protocols, {invalid_protocol, hello}}}} - = (catch ssl:listen(9443, [Option2])), + = (catch ssl:listen(9443, [Option2 | ServerOpts])), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), Option3 = {alpn_advertised_protocols, hello}, - {error, {options, Option3}} = (catch ssl:connect({127,0,0,1}, 9443, [Option3])), + {error, {options, Option3}} = (catch ssl:connect({127,0,0,1}, 9443, [Option3 | ClientOpts])), Option4 = {alpn_advertised_protocols, [<<"foo/1">>, hello]}, {error, {options, {alpn_advertised_protocols, {invalid_protocol, hello}}}} - = (catch ssl:connect({127,0,0,1}, 9443, [Option4])). + = (catch ssl:connect({127,0,0,1}, 9443, [Option4 | ClientOpts])). %-------------------------------------------------------------------------------- @@ -226,9 +238,9 @@ client_alpn_and_server_alpn_npn(Config) when is_list(Config) -> client_renegotiate(Config) when is_list(Config) -> Data = "hello world", - ClientOpts0 = proplists:get_value(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0, - ServerOpts0 = proplists:get_value(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, ExpectedProtocol = {ok, <<"http/1.0">>}, @@ -250,9 +262,9 @@ client_renegotiate(Config) when is_list(Config) -> %-------------------------------------------------------------------------------- session_reused(Config) when is_list(Config)-> - ClientOpts0 = proplists:get_value(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0, - ServerOpts0 = proplists:get_value(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -299,7 +311,7 @@ session_reused(Config) when is_list(Config)-> %-------------------------------------------------------------------------------- alpn_not_supported_client(Config) when is_list(Config) -> - ClientOpts0 = proplists:get_value(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), PrefProtocols = {client_preferred_next_protocols, {client, [<<"http/1.0">>], <<"http/1.1">>}}, ClientOpts = [PrefProtocols] ++ ClientOpts0, @@ -315,7 +327,7 @@ alpn_not_supported_client(Config) when is_list(Config) -> %-------------------------------------------------------------------------------- alpn_not_supported_server(Config) when is_list(Config)-> - ServerOpts0 = proplists:get_value(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, ServerOpts = [AdvProtocols] ++ ServerOpts0, @@ -326,8 +338,8 @@ alpn_not_supported_server(Config) when is_list(Config)-> %%-------------------------------------------------------------------- run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) -> - ClientOpts = ClientExtraOpts ++ proplists:get_value(client_opts, Config), - ServerOpts = ServerExtraOpts ++ proplists:get_value(server_opts, Config), + ClientOpts = ClientExtraOpts ++ ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ServerExtraOpts ++ ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -346,9 +358,9 @@ run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) run_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> Data = "hello world", - ClientOpts0 = proplists:get_value(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), ClientOpts = ClientExtraOpts ++ ClientOpts0, - ServerOpts0 = proplists:get_value(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = ServerExtraOpts ++ ServerOpts0, {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 8a4d827456..9efde4752f 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -53,8 +53,7 @@ all() -> {group, options_tls}, {group, session}, {group, 'dtlsv1.2'}, - %% {group, 'dtlsv1'}, Breaks dtls in cert_verify_SUITE enable later when - %% problem is identified and fixed + {group, 'dtlsv1'}, {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, @@ -277,6 +276,12 @@ end_per_suite(_Config) -> application:stop(crypto). %%-------------------------------------------------------------------- + +init_per_group(GroupName, Config) when GroupName == basic_tls; + GroupName == options_tls; + GroupName == basic; + GroupName == options -> + ssl_test_lib:clean_tls_version(Config); init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) andalso ssl_test_lib:sufficient_crypto_support(GroupName) of true -> @@ -291,8 +296,13 @@ init_per_group(GroupName, Config) -> end end. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. %%-------------------------------------------------------------------- init_per_testcase(Case, Config) when Case == unordered_protocol_versions_client; @@ -370,6 +380,11 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites; TestCase == anonymous_cipher_suites; TestCase == psk_anon_cipher_suites; TestCase == psk_anon_with_hint_cipher_suites; + TestCase == srp_cipher_suites, + TestCase == srp_anon_cipher_suites, + TestCase == srp_dsa_cipher_suites, + TestCase == des_rsa_cipher_suites, + TestCase == des_ecdh_rsa_cipher_suites, TestCase == versions_option, TestCase == tls_tcp_connect_big -> ssl_test_lib:ct_log_supported_protocol_versions(Config), @@ -518,7 +533,7 @@ alerts() -> [{doc, "Test ssl_alert:alert_txt/1"}]. alerts(Config) when is_list(Config) -> Descriptions = [?CLOSE_NOTIFY, ?UNEXPECTED_MESSAGE, ?BAD_RECORD_MAC, - ?DECRYPTION_FAILED, ?RECORD_OVERFLOW, ?DECOMPRESSION_FAILURE, + ?DECRYPTION_FAILED_RESERVED, ?RECORD_OVERFLOW, ?DECOMPRESSION_FAILURE, ?HANDSHAKE_FAILURE, ?BAD_CERTIFICATE, ?UNSUPPORTED_CERTIFICATE, ?CERTIFICATE_REVOKED,?CERTIFICATE_EXPIRED, ?CERTIFICATE_UNKNOWN, ?ILLEGAL_PARAMETER, ?UNKNOWN_CA, ?ACCESS_DENIED, ?DECODE_ERROR, @@ -2315,20 +2330,16 @@ tls_shutdown_error(Config) when is_list(Config) -> ciphers_rsa_signed_certs() -> [{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}]. -ciphers_rsa_signed_certs(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), +ciphers_rsa_signed_certs(Config) when is_list(Config) -> Ciphers = ssl_test_lib:rsa_suites(crypto), - ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), - run_suites(Ciphers, Version, Config, rsa). + run_suites(Ciphers, Config, rsa). %%------------------------------------------------------------------- ciphers_rsa_signed_certs_openssl_names() -> [{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:openssl_rsa_suites(crypto), - ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), - run_suites(Ciphers, Version, Config, rsa). + Ciphers = ssl_test_lib:openssl_rsa_suites(), + run_suites(Ciphers, Config, rsa). %%------------------------------------------------------------------- ciphers_dsa_signed_certs() -> @@ -2336,120 +2347,104 @@ ciphers_dsa_signed_certs() -> ciphers_dsa_signed_certs(Config) when is_list(Config) -> NVersion = ssl_test_lib:protocol_version(Config, tuple), - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:dsa_suites(NVersion), - ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), - run_suites(Ciphers, Version, Config, dsa). + run_suites(Ciphers, Config, dsa). %%------------------------------------------------------------------- ciphers_dsa_signed_certs_openssl_names() -> [{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:openssl_dsa_suites(), - ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), - run_suites(Ciphers, Version, Config, dsa). + run_suites(Ciphers, Config, dsa). %%------------------------------------------------------------------- anonymous_cipher_suites()-> [{doc,"Test the anonymous ciphersuites"}]. anonymous_cipher_suites(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:anonymous_suites(Version), - run_suites(Ciphers, Version, Config, anonymous). + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl_test_lib:anonymous_suites(NVersion), + run_suites(Ciphers, Config, anonymous). %%------------------------------------------------------------------- psk_cipher_suites() -> [{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}]. psk_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = ssl_test_lib:protocol_version(Config), + NVersion = ssl_test_lib:protocol_version(Config, tuple), Ciphers = ssl_test_lib:psk_suites(NVersion), - run_suites(Ciphers, Version, Config, psk). + run_suites(Ciphers, Config, psk). %%------------------------------------------------------------------- psk_with_hint_cipher_suites()-> [{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}]. psk_with_hint_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = ssl_test_lib:protocol_version(Config), + NVersion = ssl_test_lib:protocol_version(Config, tuple), Ciphers = ssl_test_lib:psk_suites(NVersion), - run_suites(Ciphers, Version, Config, psk_with_hint). + run_suites(Ciphers, Config, psk_with_hint). %%------------------------------------------------------------------- psk_anon_cipher_suites() -> [{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}]. psk_anon_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = ssl_test_lib:protocol_version(Config), + NVersion = ssl_test_lib:protocol_version(Config, tuple), Ciphers = ssl_test_lib:psk_anon_suites(NVersion), - run_suites(Ciphers, Version, Config, psk_anon). + run_suites(Ciphers, Config, psk_anon). %%------------------------------------------------------------------- psk_anon_with_hint_cipher_suites()-> [{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}]. psk_anon_with_hint_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = ssl_test_lib:protocol_version(Config), + NVersion = ssl_test_lib:protocol_version(Config, tuple), Ciphers = ssl_test_lib:psk_anon_suites(NVersion), - run_suites(Ciphers, Version, Config, psk_anon_with_hint). + run_suites(Ciphers, Config, psk_anon_with_hint). %%------------------------------------------------------------------- srp_cipher_suites()-> [{doc, "Test the SRP ciphersuites"}]. srp_cipher_suites(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:srp_suites(), - run_suites(Ciphers, Version, Config, srp). + run_suites(Ciphers, Config, srp). %%------------------------------------------------------------------- srp_anon_cipher_suites()-> [{doc, "Test the anonymous SRP ciphersuites"}]. srp_anon_cipher_suites(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:srp_anon_suites(), - run_suites(Ciphers, Version, Config, srp_anon). + run_suites(Ciphers, Config, srp_anon). %%------------------------------------------------------------------- srp_dsa_cipher_suites()-> [{doc, "Test the SRP DSA ciphersuites"}]. srp_dsa_cipher_suites(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:srp_dss_suites(), - run_suites(Ciphers, Version, Config, srp_dsa). + run_suites(Ciphers, Config, srp_dsa). %%------------------------------------------------------------------- rc4_rsa_cipher_suites()-> [{doc, "Test the RC4 ciphersuites"}]. rc4_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = tls_record:protocol_version(NVersion), - Ciphers = ssl_test_lib:rc4_suites(NVersion), - run_suites(Ciphers, Version, Config, rc4_rsa). + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)], + run_suites(Ciphers, Config, rc4_rsa). %------------------------------------------------------------------- rc4_ecdh_rsa_cipher_suites()-> [{doc, "Test the RC4 ciphersuites"}]. rc4_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = tls_record:protocol_version(NVersion), - Ciphers = ssl_test_lib:rc4_suites(NVersion), - run_suites(Ciphers, Version, Config, rc4_ecdh_rsa). + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = [S || {ecdh_rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)], + run_suites(Ciphers, Config, rc4_ecdh_rsa). %%------------------------------------------------------------------- rc4_ecdsa_cipher_suites()-> [{doc, "Test the RC4 ciphersuites"}]. rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> NVersion = tls_record:highest_protocol_version([]), - Version = tls_record:protocol_version(NVersion), - Ciphers = ssl_test_lib:rc4_suites(NVersion), - run_suites(Ciphers, Version, Config, rc4_ecdsa). + Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)], + run_suites(Ciphers, Config, rc4_ecdsa). %%------------------------------------------------------------------- des_rsa_cipher_suites()-> [{doc, "Test the des_rsa ciphersuites"}]. des_rsa_cipher_suites(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:des_suites(Config), - run_suites(Ciphers, Version, Config, des_rsa). + run_suites(Ciphers, Config, des_rsa). %------------------------------------------------------------------- des_ecdh_rsa_cipher_suites()-> [{doc, "Test ECDH rsa signed ciphersuites"}]. des_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> NVersion = ssl_test_lib:protocol_version(Config, tuple), - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:des_suites(NVersion), - run_suites(Ciphers, Version, Config, des_dhe_rsa). + run_suites(Ciphers, Config, des_dhe_rsa). %%-------------------------------------------------------------------- default_reject_anonymous()-> @@ -2483,38 +2478,30 @@ ciphers_ecdsa_signed_certs() -> ciphers_ecdsa_signed_certs(Config) when is_list(Config) -> NVersion = ssl_test_lib:protocol_version(Config, tuple), - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:ecdsa_suites(NVersion), - ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), - run_suites(Ciphers, Version, Config, ecdsa). + run_suites(Ciphers, Config, ecdsa). %%-------------------------------------------------------------------- ciphers_ecdsa_signed_certs_openssl_names() -> [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_ecdsa_signed_certs_openssl_names(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:openssl_ecdsa_suites(), - ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), - run_suites(Ciphers, Version, Config, ecdsa). + run_suites(Ciphers, Config, ecdsa). %%-------------------------------------------------------------------- ciphers_ecdh_rsa_signed_certs() -> [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) -> NVersion = ssl_test_lib:protocol_version(Config, tuple), - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion), - ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), - run_suites(Ciphers, Version, Config, ecdh_rsa). + run_suites(Ciphers, Config, ecdh_rsa). %%-------------------------------------------------------------------- ciphers_ecdh_rsa_signed_certs_openssl_names() -> [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> - Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:openssl_ecdh_rsa_suites(), - ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), - run_suites(Ciphers, Version, Config, ecdh_rsa). + run_suites(Ciphers, Config, ecdh_rsa). %%-------------------------------------------------------------------- reuse_session() -> [{doc,"Test reuse of sessions (short handshake)"}]. @@ -3031,37 +3018,6 @@ der_input_opts(Opts) -> {Cert, {Asn1Type, Key}, CaCerts, DHParams}. %%-------------------------------------------------------------------- -%% different_ca_peer_sign() -> -%% ["Check that a CA can have a different signature algorithm than the peer cert."]; - -%% different_ca_peer_sign(Config) when is_list(Config) -> -%% ClientOpts = ssl_test_lib:ssl_options(client_mix_opts, Config), -%% ServerOpts = ssl_test_lib:ssl_options(server_mix_verify_opts, Config), - -%% {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), -%% Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, -%% {from, self()}, -%% {mfa, {ssl_test_lib, send_recv_result_active_once, []}}, -%% {options, [{active, once}, -%% {verify, verify_peer} | ServerOpts]}]), -%% Port = ssl_test_lib:inet_port(Server), - -%% Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, -%% {host, Hostname}, -%% {from, self()}, -%% {mfa, {ssl_test_lib, -%% send_recv_result_active_once, -%% []}}, -%% {options, [{active, once}, -%% {verify, verify_peer} -%% | ClientOpts]}]), - -%% ssl_test_lib:check_result(Server, ok, Client, ok), -%% ssl_test_lib:close(Server), -%% ssl_test_lib:close(Client). - - -%%-------------------------------------------------------------------- no_reuses_session_server_restart_new_cert() -> [{doc,"Check that a session is not reused if the server is restarted with a new cert."}]. no_reuses_session_server_restart_new_cert(Config) when is_list(Config) -> @@ -3129,14 +3085,14 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) -> DsaServerOpts = ssl_test_lib:ssl_options(server_dsa_opts, Config), PrivDir = proplists:get_value(priv_dir, Config), - NewServerOpts = new_config(PrivDir, ServerOpts), + NewServerOpts0 = new_config(PrivDir, ServerOpts), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {ssl_test_lib, session_info_result, []}}, - {options, NewServerOpts}]), + {options, NewServerOpts0}]), Port = ssl_test_lib:inet_port(Server), Client0 = ssl_test_lib:start_client([{node, ClientNode}, @@ -3157,13 +3113,13 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) -> ssl:clear_pem_cache(), - NewServerOpts = new_config(PrivDir, DsaServerOpts), + NewServerOpts1 = new_config(PrivDir, DsaServerOpts), Server1 = ssl_test_lib:start_server([{node, ServerNode}, {port, Port}, {from, self()}, {mfa, {ssl_test_lib, no_result, []}}, - {options, NewServerOpts}]), + {options, NewServerOpts1}]), Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -3814,8 +3770,10 @@ no_rizzo_rc4() -> no_rizzo_rc4(Config) when is_list(Config) -> Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), - Ciphers = [ssl_cipher:erl_suite_definition(Suite) || - Suite <- ssl_test_lib:rc4_suites(tls_record:protocol_version(Version))], + NVersion = ssl_test_lib:protocol_version(Config, tuple), + %% Test uses RSA certs + Ciphers = ssl_test_lib:rc4_suites(NVersion) -- [{ecdhe_ecdsa,rc4_128,sha}, + {ecdh_ecdsa,rc4_128,sha}], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -3825,7 +3783,8 @@ rizzo_one_n_minus_one() -> rizzo_one_n_minus_one(Config) when is_list(Config) -> Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), - AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + AllSuites = ssl_test_lib:available_suites(NVersion), Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_rizzo, []}). @@ -3836,7 +3795,8 @@ rizzo_zero_n() -> rizzo_zero_n(Config) when is_list(Config) -> Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), - AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + AllSuites = ssl_test_lib:available_suites(NVersion), Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -4638,7 +4598,10 @@ client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa -> {ssl_test_lib:ssl_options(client_opts, Config), ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}. -run_suites(Ciphers, Version, Config, Type) -> +run_suites(Ciphers, Config, Type) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Version = ssl_test_lib:protocol_version(Config), + ct:log("Running cipher suites ~p~n", [Ciphers]), {ClientOpts, ServerOpts} = case Type of rsa -> @@ -4650,23 +4613,24 @@ run_suites(Ciphers, Version, Config, Type) -> anonymous -> %% No certs in opts! {ssl_test_lib:ssl_options(client_verification_opts, Config), - [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(Version)}]}; + [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(NVersion)} | + ssl_test_lib:ssl_options([], Config)]}; psk -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_suites(Version)} | + [{ciphers, ssl_test_lib:psk_suites(NVersion)} | ssl_test_lib:ssl_options(server_psk, Config)]}; psk_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_suites(Version)} | + [{ciphers, ssl_test_lib:psk_suites(NVersion)} | ssl_test_lib:ssl_options(server_psk_hint, Config) ]}; psk_anon -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_anon_suites(Version)} | + [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} | ssl_test_lib:ssl_options(server_psk_anon, Config)]}; psk_anon_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_anon_suites(Version)} | + [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} | ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]}; srp -> {ssl_test_lib:ssl_options(client_srp, Config), diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 6221cffdc1..c3fd73bf09 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -110,8 +110,8 @@ init_per_group(tls, Config0) -> application:load(ssl), application:set_env(ssl, protocol_version, Version), ssl:start(), - Config = proplists:delete(protocol, Config0), - [{protocol, tls}, {version, tls_record:protocol_version(Version)} | Config]; + Config = ssl_test_lib:init_tls_version(Version, Config0), + [{version, tls_record:protocol_version(Version)} | Config]; init_per_group(dtls, Config0) -> Version = dtls_record:protocol_version(dtls_record:highest_protocol_version([])), @@ -119,8 +119,8 @@ init_per_group(dtls, Config0) -> application:load(ssl), application:set_env(ssl, protocol_version, Version), ssl:start(), - Config = proplists:delete(protocol_opts, proplists:delete(protocol, Config0)), - [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}, {version, dtls_record:protocol_version(Version)} | Config]; + Config = ssl_test_lib:init_tls_version(Version, Config0), + [{version, dtls_record:protocol_version(Version)} | Config]; init_per_group(active, Config) -> [{active, true}, {receive_function, send_recv_result_active} | Config]; @@ -134,6 +134,9 @@ init_per_group(error_handling, Config) -> init_per_group(_, Config) -> Config. +end_per_group(GroupName, Config) when GroupName == tls; + GroupName == dtls -> + ssl_test_lib:clean_tls_version(Config); end_per_group(_GroupName, Config) -> Config. diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index a02881f1ae..6bf2aa2786 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -95,8 +95,13 @@ init_per_group(GroupName, Config) -> Config end. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. init_per_testcase(_TestCase, Config) -> ssl_test_lib:ct_log_supported_protocol_versions(Config), diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 7281425461..408d62ce9c 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -53,28 +53,34 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'} + {group, 'sslv3'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} ]. groups() -> - [{'tlsv1.2', [], packet_tests()}, - {'tlsv1.1', [], packet_tests()}, - {'tlsv1', [], packet_tests()}, - {'sslv3', [], packet_tests()} + [{'tlsv1.2', [], socket_packet_tests() ++ protocol_packet_tests()}, + {'tlsv1.1', [], socket_packet_tests() ++ protocol_packet_tests()}, + {'tlsv1', [], socket_packet_tests() ++ protocol_packet_tests()}, + {'sslv3', [], socket_packet_tests() ++ protocol_packet_tests()}, + {'dtlsv1.2', [], protocol_packet_tests()}, + {'dtlsv1', [], protocol_packet_tests()} ]. -packet_tests() -> - active_packet_tests() ++ active_once_packet_tests() ++ passive_packet_tests() ++ - [packet_send_to_large, - packet_cdr_decode, packet_cdr_decode_list, +socket_packet_tests() -> + socket_active_packet_tests() ++ socket_active_once_packet_tests() ++ + socket_passive_packet_tests() ++ [packet_send_to_large, packet_tpkt_decode, packet_tpkt_decode_list]. + +protocol_packet_tests() -> + protocol_active_packet_tests() ++ protocol_active_once_packet_tests() ++ protocol_passive_packet_tests() ++ + [packet_cdr_decode, packet_cdr_decode_list, packet_http_decode, packet_http_decode_list, packet_http_bin_decode_multi, packet_line_decode, packet_line_decode_list, packet_asn1_decode, packet_asn1_decode_list, - packet_tpkt_decode, packet_tpkt_decode_list, packet_sunrm_decode, packet_sunrm_decode_list]. -passive_packet_tests() -> +socket_passive_packet_tests() -> [packet_raw_passive_many_small, packet_0_passive_many_small, packet_1_passive_many_small, @@ -85,12 +91,8 @@ passive_packet_tests() -> packet_1_passive_some_big, packet_2_passive_some_big, packet_4_passive_some_big, - packet_httph_passive, - packet_httph_bin_passive, - packet_http_error_passive, packet_wait_passive, packet_size_passive, - packet_baddata_passive, %% inet header option should be deprecated! header_decode_one_byte_passive, header_decode_two_bytes_passive, @@ -98,7 +100,14 @@ passive_packet_tests() -> header_decode_two_bytes_one_sent_passive ]. -active_once_packet_tests() -> +protocol_passive_packet_tests() -> + [packet_httph_passive, + packet_httph_bin_passive, + packet_http_error_passive, + packet_baddata_passive + ]. + +socket_active_once_packet_tests() -> [packet_raw_active_once_many_small, packet_0_active_once_many_small, packet_1_active_once_many_small, @@ -108,12 +117,16 @@ active_once_packet_tests() -> packet_0_active_once_some_big, packet_1_active_once_some_big, packet_2_active_once_some_big, - packet_4_active_once_some_big, + packet_4_active_once_some_big + ]. + +protocol_active_once_packet_tests() -> + [ packet_httph_active_once, packet_httph_bin_active_once ]. -active_packet_tests() -> +socket_active_packet_tests() -> [packet_raw_active_many_small, packet_0_active_many_small, packet_1_active_many_small, @@ -124,10 +137,7 @@ active_packet_tests() -> packet_1_active_some_big, packet_2_active_some_big, packet_4_active_some_big, - packet_httph_active, - packet_httph_bin_active, packet_wait_active, - packet_baddata_active, packet_size_active, %% inet header option should be deprecated! header_decode_one_byte_active, @@ -136,6 +146,13 @@ active_packet_tests() -> header_decode_two_bytes_one_sent_active ]. + +protocol_active_packet_tests() -> + [packet_httph_active, + packet_httph_bin_active, + packet_baddata_active + ]. + init_per_suite(Config) -> catch crypto:stop(), try crypto:start() of @@ -168,8 +185,13 @@ init_per_group(GroupName, Config) -> end. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. init_per_testcase(_TestCase, Config) -> ct:timetrap({seconds, ?BASE_TIMEOUT_SECONDS}), diff --git a/lib/ssl/test/ssl_payload_SUITE.erl b/lib/ssl/test/ssl_payload_SUITE.erl index cb1957327a..ef05241759 100644 --- a/lib/ssl/test/ssl_payload_SUITE.erl +++ b/lib/ssl/test/ssl_payload_SUITE.erl @@ -95,8 +95,13 @@ init_per_group(GroupName, Config) -> Config end. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. init_per_testcase(TestCase, Config) when TestCase == server_echos_passive_huge; TestCase == server_echos_active_once_huge; diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl index 4e916a7f03..03676cb828 100644 --- a/lib/ssl/test/ssl_sni_SUITE.erl +++ b/lib/ssl/test/ssl_sni_SUITE.erl @@ -30,21 +30,50 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- -all() -> [no_sni_header, - sni_match, - sni_no_match, - no_sni_header_fun, - sni_match_fun, - sni_no_match_fun]. +all() -> + [{group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'sslv3'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} + ]. + +groups() -> + [ + {'tlsv1.2', [], sni_tests()}, + {'tlsv1.1', [], sni_tests()}, + {'tlsv1', [], sni_tests()}, + {'sslv3', [], sni_tests()}, + {'dtlsv1.2', [], sni_tests()}, + {'dtlsv1', [], sni_tests()} + ]. + +sni_tests() -> + [no_sni_header, + sni_match, + sni_no_match, + no_sni_header_fun, + sni_match_fun, + sni_no_match_fun]. init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> ssl_test_lib:clean_start(), - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0), - proplists:get_value(priv_dir, Config0)), - ssl_test_lib:cert_options(Config0) + Config = ssl_test_lib:make_rsa_cert(Config0), + RsaOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + [{sni_server_opts, [{sni_hosts, [ + {"a.server", [ + {certfile, proplists:get_value(certfile, RsaOpts)}, + {keyfile, proplists:get_value(keyfile, RsaOpts)} + ]}, + {"b.server", [ + {certfile, proplists:get_value(certfile, RsaOpts)}, + {keyfile, proplists:get_value(keyfile, RsaOpts)} + ]} + ]}]} | Config] catch _:_ -> {skip, "Crypto did not start"} end. @@ -66,22 +95,22 @@ end_per_testcase(_TestCase, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- no_sni_header(Config) -> - run_handshake(Config, undefined, undefined, "server"). + run_handshake(Config, undefined, undefined, "server Peer cert"). no_sni_header_fun(Config) -> - run_sni_fun_handshake(Config, undefined, undefined, "server"). + run_sni_fun_handshake(Config, undefined, undefined, "server Peer cert"). sni_match(Config) -> - run_handshake(Config, "a.server", "a.server", "a.server"). + run_handshake(Config, "a.server", "a.server", "server Peer cert"). sni_match_fun(Config) -> - run_sni_fun_handshake(Config, "a.server", "a.server", "a.server"). + run_sni_fun_handshake(Config, "a.server", "a.server", "server Peer cert"). sni_no_match(Config) -> - run_handshake(Config, "c.server", undefined, "server"). + run_handshake(Config, "c.server", undefined, "server Peer cert"). sni_no_match_fun(Config) -> - run_sni_fun_handshake(Config, "c.server", undefined, "server"). + run_sni_fun_handshake(Config, "c.server", undefined, "server Peer cert"). %%-------------------------------------------------------------------- @@ -141,13 +170,13 @@ run_sni_fun_handshake(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), [{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config), SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end, - ServerOptions = proplists:get_value(server_opts, Config) ++ [{sni_fun, SNIFun}], + ServerOptions = ssl_test_lib:ssl_options(server_rsa_opts, Config) ++ [{sni_fun, SNIFun}], ClientOptions = case SNIHostname of undefined -> - proplists:get_value(client_opts, Config); + ssl_test_lib:ssl_options(client_rsa_opts, Config); _ -> - [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_opts, Config) + [{server_name_indication, SNIHostname}] ++ ssl_test_lib:ssl_options(client_rsa_opts, Config) end, ct:log("Options: ~p", [[ServerOptions, ClientOptions]]), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -167,14 +196,14 @@ run_handshake(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, " "ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), - ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_opts, Config), + ServerOptions = proplists:get_value(sni_server_opts, Config) ++ ssl_test_lib:ssl_options(server_rsa_opts, Config), ClientOptions = - case SNIHostname of - undefined -> - proplists:get_value(client_opts, Config); - _ -> - [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_opts, Config) - end, + case SNIHostname of + undefined -> + ssl_test_lib:ssl_options(client_rsa_opts, Config); + _ -> + [{server_name_indication, SNIHostname}] ++ ssl_test_lib:ssl_options(client_rsa_opts, Config) + end, ct:log("Options: ~p", [[ServerOptions, ClientOptions]]), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 3b9073ac0b..a5f03a1f15 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -384,10 +384,6 @@ cert_options(Config) -> "badkey.pem"]), PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, - SNIServerACertFile = filename:join([proplists:get_value(priv_dir, Config), "a.server", "cert.pem"]), - SNIServerAKeyFile = filename:join([proplists:get_value(priv_dir, Config), "a.server", "key.pem"]), - SNIServerBCertFile = filename:join([proplists:get_value(priv_dir, Config), "b.server", "cert.pem"]), - SNIServerBKeyFile = filename:join([proplists:get_value(priv_dir, Config), "b.server", "key.pem"]), [{client_opts, [{cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}, @@ -445,46 +441,34 @@ cert_options(Config) -> {server_bad_cert, [{ssl_imp, new},{cacertfile, ServerCaCertFile}, {certfile, BadCertFile}, {keyfile, ServerKeyFile}]}, {server_bad_key, [{ssl_imp, new},{cacertfile, ServerCaCertFile}, - {certfile, ServerCertFile}, {keyfile, BadKeyFile}]}, - {sni_server_opts, [{sni_hosts, [ - {"a.server", [ - {certfile, SNIServerACertFile}, - {keyfile, SNIServerAKeyFile} - ]}, - {"b.server", [ - {certfile, SNIServerBCertFile}, - {keyfile, SNIServerBKeyFile} - ]} - ]}]} + {certfile, ServerCertFile}, {keyfile, BadKeyFile}]} | Config]. -make_dsa_cert(Config) -> - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = - make_cert_files("server", Config, dsa, dsa, "", []), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = - make_cert_files("client", Config, dsa, dsa, "", []), - [{server_dsa_opts, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ServerCaCertFile}, - {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, - {server_dsa_verify_opts, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ClientCaCertFile}, - {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, - {verify, verify_peer}]}, - {client_dsa_opts, [{ssl_imp, new}, - {cacertfile, ClientCaCertFile}, - {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}, - {server_srp_dsa, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ServerCaCertFile}, - {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, - {user_lookup_fun, {fun user_lookup/3, undefined}}, - {ciphers, srp_dss_suites()}]}, - {client_srp_dsa, [{ssl_imp, new}, - {srp_identity, {"Test-User", "secret"}}, - {cacertfile, ClientCaCertFile}, - {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} - | Config]. - +make_dsa_cert(Config) -> + CryptoSupport = crypto:supports(), + case proplists:get_bool(dss, proplists:get_value(public_keys, CryptoSupport)) of + true -> + ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa"]), + ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa"]), + KeyGenSpec = key_gen_info(dsa, dsa), + + GenCertData = x509_test:gen_test_certs([{digest, sha} | KeyGenSpec]), + [{server_config, ServerConf}, + {client_config, ClientConf}] = + x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), + + [{server_dsa_opts, ServerConf}, + {server_dsa_verify_opts, [{verify, verify_peer} | ServerConf]}, + {client_dsa_opts, ClientConf}, + {server_srp_dsa, [{user_lookup_fun, {fun user_lookup/3, undefined}}, + {ciphers, srp_dss_suites()} | ServerConf]}, + {client_srp_dsa, [{srp_identity, {"Test-User", "secret"}} + | ClientConf]} + | Config]; + false -> + Config + end. make_rsa_cert_chains(ChainConf, Config, Suffix) -> CryptoSupport = crypto:supports(), KeyGenSpec = key_gen_info(rsa, rsa), @@ -541,6 +525,11 @@ key_gen_spec(Role, rsa) -> [{list_to_atom(Role ++ "_key_gen"), hardcode_rsa_key(1)}, {list_to_atom(Role ++ "_key_gen_chain"), [hardcode_rsa_key(2), hardcode_rsa_key(3)]} + ]; +key_gen_spec(Role, dsa) -> + [{list_to_atom(Role ++ "_key_gen"), hardcode_dsa_key(1)}, + {list_to_atom(Role ++ "_key_gen_chain"), [hardcode_dsa_key(2), + hardcode_dsa_key(3)]} ]. make_ecdsa_cert(Config) -> CryptoSupport = crypto:supports(), @@ -638,41 +627,6 @@ make_ecdh_rsa_cert(Config) -> Config end. -make_mix_cert(Config) -> - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa, - rsa, "mix", []), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa, - rsa, "mix", []), - [{server_mix_opts, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ServerCaCertFile}, - {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, - {server_mix_verify_opts, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ClientCaCertFile}, - {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, - {verify, verify_peer}]}, - {client_mix_opts, [{ssl_imp, new}, - {cacertfile, ClientCaCertFile}, - {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} - | Config]. - -make_cert_files(RoleStr, Config, Alg1, Alg2, Prefix, Opts) -> - Alg1Str = atom_to_list(Alg1), - Alg2Str = atom_to_list(Alg2), - CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, Alg1}| Opts]), - {Cert, CertKey} = erl_make_certs:make_cert([{key, Alg2}, {issuer, CaInfo} | Opts]), - CaCertFile = filename:join([proplists:get_value(priv_dir, Config), - RoleStr, Prefix ++ Alg1Str ++ "_cacerts.pem"]), - CertFile = filename:join([proplists:get_value(priv_dir, Config), - RoleStr, Prefix ++ Alg2Str ++ "_cert.pem"]), - KeyFile = filename:join([proplists:get_value(priv_dir, Config), - RoleStr, Prefix ++ Alg2Str ++ "_key.pem"]), - - der_to_pem(CaCertFile, [{'Certificate', CaCert, not_encrypted}]), - der_to_pem(CertFile, [{'Certificate', Cert, not_encrypted}]), - der_to_pem(KeyFile, [CertKey]), - {CaCertFile, CertFile, KeyFile}. - - start_upgrade_server(Args) -> Result = spawn_link(?MODULE, run_upgrade_server, [Args]), receive @@ -983,16 +937,10 @@ ecdh_rsa_suites(Version) -> end, available_suites(Version)). -openssl_rsa_suites(CounterPart) -> +openssl_rsa_suites() -> Ciphers = ssl:cipher_suites(openssl), - Names = case is_sane_ecc(CounterPart) of - true -> - "DSS | ECDSA"; - false -> - "DSS | ECDHE | ECDH" - end, - lists:filter(fun(Str) -> string_regex_filter(Str, Names) - end, Ciphers). + lists:filter(fun(Str) -> string_regex_filter(Str, "RSA") + end, Ciphers) -- openssl_ecdh_rsa_suites(). openssl_dsa_suites() -> Ciphers = ssl:cipher_suites(openssl), @@ -1026,11 +974,11 @@ string_regex_filter(_Str, _Search) -> false. anonymous_suites(Version) -> - Suites = ssl_cipher:anonymous_suites(Version), + Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)], ssl_cipher:filter_suites(Suites). psk_suites(Version) -> - Suites = ssl_cipher:psk_suites(Version), + Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:psk_suites(Version)], ssl_cipher:filter_suites(Suites). psk_anon_suites(Version) -> @@ -1062,7 +1010,7 @@ srp_dss_suites() -> ssl_cipher:filter_suites(Suites). rc4_suites(Version) -> - Suites = ssl_cipher:rc4_suites(Version), + Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:rc4_suites(Version)], ssl_cipher:filter_suites(Suites). des_suites(Version) -> @@ -1167,6 +1115,9 @@ init_tls_version(Version, Config) -> NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)), [{protocol, tls} | NewConfig]. +clean_tls_version(Config) -> + proplists:delete(protocol_opts, proplists:delete(protocol, Config)). + sufficient_crypto_support(Version) when Version == 'tlsv1.2'; Version == 'dtlsv1.2' -> CryptoSupport = crypto:supports(), @@ -1276,7 +1227,7 @@ is_fips(_) -> false. cipher_restriction(Config0) -> - Version = tls_record:protocol_version(protocol_version(Config0)), + Version = protocol_version(Config0, tuple), case is_sane_ecc(openssl) of false -> Opts = proplists:get_value(server_opts, Config0), @@ -1300,9 +1251,13 @@ check_sane_openssl_version(Version) -> true; {_, "OpenSSL 1.0.1" ++ _} -> true; - {'tlsv1.2', "OpenSSL 1.0" ++ _} -> + {'tlsv1.2', "OpenSSL 1.0.0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 1.0.0" ++ _} -> + false; + {'dtlsv1.2', "OpenSSL 1.0.0" ++ _} -> false; - {'tlsv1.1', "OpenSSL 1.0" ++ _} -> + {'dtlsv1', "OpenSSL 1.0.0" ++ _} -> false; {'tlsv1.2', "OpenSSL 0" ++ _} -> false; @@ -1367,6 +1322,12 @@ version_flag('dtlsv1.2') -> version_flag('dtlsv1') -> "-dtls1". +filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_list(Cipher)-> + filter_suites([ssl_cipher:openssl_suite(S) || S <- Ciphers], + AtomVersion); +filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_binary(Cipher)-> + filter_suites([ssl_cipher:erl_suite_definition(S) || S <- Ciphers], + AtomVersion); filter_suites(Ciphers0, AtomVersion) -> Version = tls_version(AtomVersion), Supported0 = ssl_cipher:suites(Version) @@ -1429,7 +1390,7 @@ supports_ssl_tls_version(sslv2 = Version) -> Exe = "openssl", Args = ["s_client", VersionFlag], Port = ssl_test_lib:portable_open_port(Exe, Args), - do_supports_ssl_tls_version(Port) + do_supports_ssl_tls_version(Port, "") end; supports_ssl_tls_version(Version) -> @@ -1437,23 +1398,26 @@ supports_ssl_tls_version(Version) -> Exe = "openssl", Args = ["s_client", VersionFlag], Port = ssl_test_lib:portable_open_port(Exe, Args), - do_supports_ssl_tls_version(Port). + do_supports_ssl_tls_version(Port, ""). -do_supports_ssl_tls_version(Port) -> +do_supports_ssl_tls_version(Port, Acc) -> receive - {Port, {data, "u"}} -> - false; - {Port, {data, "unknown option" ++ _}} -> - false; - {Port, {data, Data}} -> - case lists:member("error", string:tokens(Data, ":")) of - true -> - false; - false -> - do_supports_ssl_tls_version(Port) - end + {Port, {data, Data}} -> + case Acc ++ Data of + "unknown option" ++ _ -> + false; + Error when length(Error) >= 11 -> + case lists:member("error", string:tokens(Data, ":")) of + true -> + false; + false -> + do_supports_ssl_tls_version(Port, Error) + end; + _ -> + do_supports_ssl_tls_version(Port, Acc ++ Data) + end after 1000 -> - true + true end. ssl_options(Option, Config) when is_atom(Option) -> @@ -1498,6 +1462,7 @@ ct_log_supported_protocol_versions(Config) -> clean_env() -> application:unset_env(ssl, protocol_version), + application:unset_env(ssl, dtls_protocol_version), application:unset_env(ssl, session_lifetime), application:unset_env(ssl, session_cb), application:unset_env(ssl, session_cb_init_args), @@ -1517,10 +1482,14 @@ is_psk_anon_suite({psk, _,_}) -> true; is_psk_anon_suite({dhe_psk,_,_}) -> true; +is_psk_anon_suite({ecdhe_psk,_,_}) -> + true; is_psk_anon_suite({psk, _,_,_}) -> true; is_psk_anon_suite({dhe_psk, _,_,_}) -> true; +is_psk_anon_suite({ecdhe_psk, _,_,_}) -> + true; is_psk_anon_suite(_) -> false. @@ -1540,7 +1509,7 @@ tls_version(Atom) -> tls_record:protocol_version(Atom). hardcode_rsa_key(1) -> - {'RSAPrivateKey',0, + {'RSAPrivateKey', 'two-prime', 23995666614853919027835084074500048897452890537492185072956789802729257783422306095699263934587064480357348855732149402060270996295002843755712064937715826848741191927820899197493902093529581182351132392364214171173881547273475904587683433713767834856230531387991145055273426806331200574039205571401702219159773947658558490957010003143162250693492642996408861265758000254664396313741422909188635443907373976005987612936763564996605457102336549804831742940035613780926178523017685712710473543251580072875247250504243621640157403744718833162626193206685233710319205099867303242759099560438381385658382486042995679707669, 17, 11292078406990079542510627799764728892919007311761028269626724613049062486316379339152594792746853873109340637991599718616598115903530750002688030558925094987642913848386305504703012749896273497577003478759630198199473669305165131570674557041773098755873191241407597673069847908861741446606684974777271632545629600685952292605647052193819136445675100211504432575554351515262198132231537860917084269870590492135731720141577986787033006338680118008484613510063003323516659048210893001173583018220214626635609151105287049126443102976056146630518124476470236027123782297108342869049542023328584384300970694412006494684657, @@ -1552,7 +1521,7 @@ hardcode_rsa_key(1) -> asn1_NOVALUE}; hardcode_rsa_key(2) -> -{'RSAPrivateKey',0, +{'RSAPrivateKey', 'two-prime', 21343679768589700771839799834197557895311746244621307033143551583788179817796325695589283169969489517156931770973490560582341832744966317712674900833543896521418422508485833901274928542544381247956820115082240721897193055368570146764204557110415281995205343662628196075590438954399631753508888358737971039058298703003743872818150364935790613286541190842600031570570099801682794056444451081563070538409720109449780410837763602317050353477918147758267825417201591905091231778937606362076129350476690460157227101296599527319242747999737801698427160817755293383890373574621116766934110792127739174475029121017282777887777, 17, 18832658619343853622211588088997845201745658451136447382185486691577805721584993260814073385267196632785528033211903435807948675951440868570007265441362261636545666919252206383477878125774454042314841278013741813438699754736973658909592256273895837054592950290554290654932740253882028017801960316533503857992358685308186680144968293076156011747178275038098868263178095174694099811498968993700538293188879611375604635940554394589807673542938082281934965292051746326331046224291377703201248790910007232374006151098976879987912446997911775904329728563222485791845480864283470332826504617837402078265424772379987120023773, @@ -1564,7 +1533,7 @@ hardcode_rsa_key(2) -> asn1_NOVALUE}; hardcode_rsa_key(3) -> -{'RSAPrivateKey',0, +{'RSAPrivateKey', 'two-prime', 25089040456112869869472694987833070928503703615633809313972554887193090845137746668197820419383804666271752525807484521370419854590682661809972833718476098189250708650325307850184923546875260207894844301992963978994451844985784504212035958130279304082438876764367292331581532569155681984449177635856426023931875082020262146075451989132180409962870105455517050416234175675478291534563995772675388370042873175344937421148321291640477650173765084699931690748536036544188863178325887393475703801759010864779559318631816411493486934507417755306337476945299570726975433250753415110141783026008347194577506976486290259135429, 17, 8854955455098659953931539407470495621824836570223697404931489960185796768872145882893348383311931058684147950284994536954265831032005645344696294253579799360912014817761873358888796545955974191021709753644575521998041827642041589721895044045980930852625485916835514940558187965584358347452650930302268008446431977397918214293502821599497633970075862760001650736520566952260001423171553461362588848929781360590057040212831994258783694027013289053834376791974167294527043946669963760259975273650548116897900664646809242902841107022557239712438496384819445301703021164043324282687280801738470244471443835900160721870265, @@ -1575,7 +1544,7 @@ hardcode_rsa_key(3) -> 15068630434698373319269196003209754243798959461311186548759287649485250508074064775263867418602372588394608558985183294561315208336731894947137343239541687540387209051236354318837334154993136528453613256169847839789803932725339395739618592522865156272771578671216082079933457043120923342632744996962853951612, asn1_NOVALUE}; hardcode_rsa_key(4) -> -{'RSAPrivateKey',0, +{'RSAPrivateKey', 'two-prime', 28617237755030755643854803617273584643843067580642149032833640135949799721163782522787597288521902619948688786051081993247908700824196122780349730169173433743054172191054872553484065655968335396052034378669869864779940355219732200954630251223541048434478476115391643898092650304645086338265930608997389611376417609043761464100338332976874588396803891301015812818307951159858145399281035705713082131199940309445719678087542976246147777388465712394062188801177717719764254900022006288880246925156931391594131839991579403409541227225173269459173129377291869028712271737734702830877034334838181789916127814298794576266389, 17, 26933870828264240605980991639786903194205240075898493207372837775011576208154148256741268036255908348187001210401018346586267012540419880263858569570986761169933338532757527109161473558558433313931326474042230460969355628442100895016122589386862163232450330461545076609969553227901257730132640573174013751883368376011370428995523268034111482031427024082719896108094847702954695363285832195666458915142143884210891427766607838346722974883433132513540317964796373298134261669479023445911856492129270184781873446960437310543998533283339488055776892320162032014809906169940882070478200435536171854883284366514852906334641, @@ -1586,7 +1555,7 @@ hardcode_rsa_key(4) -> 34340318160575773065401929915821192439103777558577109939078671096408836197675640654693301707202885840826672396546056002756167635035389371579540325327619480512374920136684787633921441576901246290213545161954865184290700344352088099063404416346968182170720521708773285279884132629954461545103181082503707725012, asn1_NOVALUE}; hardcode_rsa_key(5) -> -{'RSAPrivateKey',0, +{'RSAPrivateKey', 'two-prime', 26363170152814518327068346871197765236382539835597898797762992537312221863402655353436079974302838986536256364057947538018476963115004626096654613827403121905035011992899481598437933532388248462251770039307078647864188314916665766359828262009578648593031111569685489178543405615478739906285223620987558499488359880003693226535420421293716164794046859453204135383236667988765227190694994861629971618548127529849059769249520775574008363789050621665120207265361610436965088511042779948238320901918522125988916609088415989475825860046571847719492980547438560049874493788767083330042728150253120940100665370844282489982633, 17, 10855423004100095781734025182257903332628104638187370093196526338893267826106975733767797636477639582691399679317978398007608161282648963686857782164224814902073240232370374775827384395689278778574258251479385325591136364965685903795223402003944149420659869469870495544106108194608892902588033255700759382142132115013969680562678811046675523365751498355532768935784747314021422035957153013494814430893022253205880275287307995039363642554998244274484818208792520243113824379110193356010059999642946040953102866271737127640405568982049887176990990501963784502429481034227543991366980671390566584211881030995602076468001, @@ -1597,7 +1566,7 @@ hardcode_rsa_key(5) -> 40624877259097915043489529504071755460170951428490878553842519165800720914888257733191322215286203357356050737713125202129282154441426952501134581314792133018830748896123382106683994268028624341502298766844710276939303555637478596035491641473828661569958212421472263269629366559343208764012473880251174832392, asn1_NOVALUE}; hardcode_rsa_key(6) -> -{'RSAPrivateKey',0, +{'RSAPrivateKey', 'two-prime', 22748888494866396715768692484866595111939200209856056370972713870125588774286266397044592487895293134537316190976192161177144143633669641697309689280475257429554879273045671863645233402796222694405634510241820106743648116753479926387434021380537483429927516962909367257212902212159798399531316965145618774905828756510318897899298783143203190245236381440043169622358239226123652592179006905016804587837199618842875361941208299410035232803124113612082221121192550063791073372276763648926636149384299189072950588522522800393261949880796214514243704858378436010975184294077063518776479282353562934591448646412389762167039, 17, 6690849557313646092873144848490175032923294179369428344403739373566349639495960705013115437616262686628622409110644753287395336362844012263914614494257428655751435080307550548130951000822418439531068973600535325512837681398082331290421770994275730420566916753796872722709677121223470117509210872101652580854566448661533030419787125312956120661097410038933324613372774190658239039998357548275441758790939430824924502690997433186652165055694361752689819209062683281242276039100201318203707142383491769671330743466041394101421674581185260900666085723130684175548215193875544802254923825103844262661010117443222587769713, @@ -1608,6 +1577,27 @@ hardcode_rsa_key(6) -> 81173034184183681160439870161505779100040258708276674532866007896310418779840630960490793104541748007902477778658270784073595697910785917474138815202903114440800310078464142273778315781957021015333260021813037604142367434117205299831740956310682461174553260184078272196958146289378701001596552915990080834227, asn1_NOVALUE}. +hardcode_dsa_key(1) -> + {'DSAPrivateKey',0, + 99438313664986922963487511141216248076486724382260996073922424025828494981416579966171753999204426907349400798052572573634137057487829150578821328280864500098312146772602202702021153757550650696224643730869835650674962433068943942837519621267815961566259265204876799778977478160416743037274938277357237615491, + 1454908511695148818053325447108751926908854531909, + 20302424198893709525243209250470907105157816851043773596964076323184805650258390738340248469444700378962907756890306095615785481696522324901068493502141775433048117442554163252381401915027666416630898618301033737438756165023568220631119672502120011809327566543827706483229480417066316015458225612363927682579, + 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358, + 1457508827177594730669011716588605181448418352823}; +hardcode_dsa_key(2) -> + {'DSAPrivateKey',0, + 145447354557382582722944332987784622105075065624518040072393858097520305927329240484963764783346271194321683798321743658303478090647837211867389721684646254999291098347011037298359107547264573476540026676832159205689428125157386525591130716464335426605521884822982379206842523670736739023467072341958074788151, + 742801637799670234315651916144768554943688916729, + 79727684678125120155622004643594683941478642656111969487719464672433839064387954070113655822700268007902716505761008423792735229036965034283173483862273639257533568978482104785033927768441235063983341565088899599358397638308472931049309161811156189887217888328371767967629005149630676763492409067382020352505, + 35853727034965131665219275925554159789667905059030049940938124723126925435403746979702929280654735557166864135215989313820464108440192507913554896358611966877432546584986661291483639036057475682547385322659469460385785257933737832719745145778223672383438466035853830832837226950912832515496378486927322864228, + 801315110178350279541885862867982846569980443911}; +hardcode_dsa_key(3) -> + {'DSAPrivateKey',0, + 99438313664986922963487511141216248076486724382260996073922424025828494981416579966171753999204426907349400798052572573634137057487829150578821328280864500098312146772602202702021153757550650696224643730869835650674962433068943942837519621267815961566259265204876799778977478160416743037274938277357237615491, + 1454908511695148818053325447108751926908854531909, + 20302424198893709525243209250470907105157816851043773596964076323184805650258390738340248469444700378962907756890306095615785481696522324901068493502141775433048117442554163252381401915027666416630898618301033737438756165023568220631119672502120011809327566543827706483229480417066316015458225612363927682579, + 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358, + 1457508827177594730669011716588605181448418352823}. dtls_hello() -> [1, diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 04c86ccbb6..2e1a0b94ea 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -85,19 +85,19 @@ all_versions_tests() -> ]. dtls_all_versions_tests() -> [ - %%erlang_client_openssl_server, + erlang_client_openssl_server, erlang_server_openssl_client, - %%erlang_client_openssl_server_dsa_cert, + erlang_client_openssl_server_dsa_cert, erlang_server_openssl_client_dsa_cert, - erlang_server_openssl_client_reuse_session + erlang_server_openssl_client_reuse_session, %%erlang_client_openssl_server_renegotiate, %%erlang_client_openssl_server_nowrap_seqnum, %%erlang_server_openssl_client_nowrap_seqnum, - %%erlang_client_openssl_server_no_server_ca_cert, - %%erlang_client_openssl_server_client_cert, - %%erlang_server_openssl_client_client_cert - %%ciphers_rsa_signed_certs, - %%ciphers_dsa_signed_certs, + erlang_client_openssl_server_no_server_ca_cert, + erlang_client_openssl_server_client_cert, + erlang_server_openssl_client_client_cert, + ciphers_rsa_signed_certs, + ciphers_dsa_signed_certs %%erlang_client_bad_openssl_server, %%expired_session ]. @@ -142,12 +142,11 @@ init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> - ssl_test_lib:clean_start(), - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0), - proplists:get_value(priv_dir, Config0)), - Config1 = ssl_test_lib:make_dsa_cert(Config0), - Config = ssl_test_lib:cert_options(Config1), - ssl_test_lib:cipher_restriction(Config) + ssl_test_lib:clean_start(), + + Config1 = ssl_test_lib:make_rsa_cert(Config0), + Config2 = ssl_test_lib:make_dsa_cert(Config1), + ssl_test_lib:cipher_restriction(Config2) catch _:_ -> {skip, "Crypto did not start"} end @@ -157,7 +156,8 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). -init_per_group(basic, Config) -> +init_per_group(basic, Config0) -> + Config = ssl_test_lib:clean_tls_version(Config0), case ssl_test_lib:supports_ssl_tls_version(sslv2) of true -> [{v2_hello_compatible, true} | Config]; @@ -183,8 +183,13 @@ init_per_group(GroupName, Config) -> Config end. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. init_per_testcase(expired_session, Config) -> ct:timetrap(?EXPIRE * 1000 * 5), @@ -196,7 +201,7 @@ init_per_testcase(expired_session, Config) -> init_per_testcase(TestCase, Config) when TestCase == ciphers_rsa_signed_certs; TestCase == ciphers_dsa_signed_certs -> - ct:timetrap({seconds, 45}), + ct:timetrap({seconds, 60}), special_init(TestCase, Config); init_per_testcase(TestCase, Config) -> @@ -270,13 +275,24 @@ special_init(TestCase, Config) check_openssl_npn_support(Config) end; -special_init(TestCase, Config) +special_init(TestCase, Config0) when TestCase == erlang_server_openssl_client_sni_match; TestCase == erlang_server_openssl_client_sni_no_match; TestCase == erlang_server_openssl_client_sni_no_header; TestCase == erlang_server_openssl_client_sni_match_fun; TestCase == erlang_server_openssl_client_sni_no_match_fun; TestCase == erlang_server_openssl_client_sni_no_header_fun -> + RsaOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config0), + Config = [{sni_server_opts, [{sni_hosts, + [{"a.server", [ + {certfile, proplists:get_value(certfile, RsaOpts)}, + {keyfile, proplists:get_value(keyfile, RsaOpts)} + ]}, + {"b.server", [ + {certfile, proplists:get_value(certfile, RsaOpts)}, + {keyfile, proplists:get_value(keyfile, RsaOpts)} + ]} + ]}]} | Config0], check_openssl_sni_support(Config); special_init(_, Config) -> @@ -295,8 +311,8 @@ basic_erlang_client_openssl_server() -> [{doc,"Test erlang client with openssl server"}]. basic_erlang_client_openssl_server(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -335,7 +351,7 @@ basic_erlang_server_openssl_client() -> [{doc,"Test erlang server with openssl client"}]. basic_erlang_server_openssl_client(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), V2Compat = proplists:get_value(v2_hello_compatible, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -369,8 +385,8 @@ erlang_client_openssl_server() -> [{doc,"Test erlang client with openssl server"}]. erlang_client_openssl_server(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -409,7 +425,7 @@ erlang_server_openssl_client() -> [{doc,"Test erlang server with openssl client"}]. erlang_server_openssl_client(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -442,7 +458,7 @@ erlang_client_openssl_server_dsa_cert() -> erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> process_flag(trap_exit, true), ClientOpts = ssl_test_lib:ssl_options(client_dsa_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_dsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_dsa_verify_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -524,7 +540,7 @@ erlang_server_openssl_client_reuse_session() -> "same session id, to test reusing of sessions."}]. erlang_server_openssl_client_reuse_session(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -562,8 +578,8 @@ erlang_client_openssl_server_renegotiate() -> [{doc,"Test erlang client when openssl server issuses a renegotiate"}]. erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -612,8 +628,8 @@ erlang_client_openssl_server_nowrap_seqnum() -> " to lower treashold substantially."}]. erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -655,7 +671,7 @@ erlang_server_openssl_client_nowrap_seqnum() -> " to lower treashold substantially."}]. erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -694,8 +710,8 @@ erlang_client_openssl_server_no_server_ca_cert() -> "implicitly tested eleswhere."}]. erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -735,8 +751,8 @@ erlang_client_openssl_server_client_cert() -> [{doc,"Test erlang client with openssl server when client sends cert"}]. erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -778,8 +794,8 @@ erlang_server_openssl_client_client_cert() -> [{doc,"Test erlang server with openssl client when client sends cert"}]. erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -819,8 +835,8 @@ erlang_server_erlang_client_client_cert() -> [{doc,"Test erlang server with erlang client when client sends cert"}]. erlang_server_erlang_client_client_cert(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = proplists:get_value(server_verification_opts, Config), - ClientOpts = proplists:get_value(client_verification_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), Version = ssl_test_lib:protocol_version(Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -865,7 +881,8 @@ ciphers_dsa_signed_certs() -> [{doc,"Test cipher suites that uses dsa certs"}]. ciphers_dsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl_test_lib:dsa_suites(NVersion), run_suites(Ciphers, Version, Config, dsa). %%-------------------------------------------------------------------- @@ -873,8 +890,8 @@ erlang_client_bad_openssl_server() -> [{doc,"Test what happens if openssl server sends garbage to erlang ssl client"}]. erlang_client_bad_openssl_server(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -928,8 +945,8 @@ expired_session() -> "better code coverage of the ssl_manager module"}]. expired_session(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), Port = ssl_test_lib:inet_port(node()), @@ -982,7 +999,7 @@ ssl2_erlang_server_openssl_client() -> ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1007,10 +1024,10 @@ ssl2_erlang_server_openssl_client_comp() -> ssl2_erlang_server_openssl_client_comp(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), V2Compat = proplists:get_value(v2_hello_compatible, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1250,22 +1267,22 @@ erlang_server_openssl_client_npn_only_client(Config) when is_list(Config) -> ok. %-------------------------------------------------------------------------- erlang_server_openssl_client_sni_no_header(Config) when is_list(Config) -> - erlang_server_openssl_client_sni_test(Config, undefined, undefined, "server"). + erlang_server_openssl_client_sni_test(Config, undefined, undefined, "server Peer cert"). erlang_server_openssl_client_sni_no_header_fun(Config) when is_list(Config) -> - erlang_server_openssl_client_sni_test_sni_fun(Config, undefined, undefined, "server"). + erlang_server_openssl_client_sni_test_sni_fun(Config, undefined, undefined, "server Peer cert"). -erlang_server_openssl_client_sni_match(Config) when is_list(Config) -> - erlang_server_openssl_client_sni_test(Config, "a.server", "a.server", "a.server"). +erlang_server_openssl_client_sni_match(Config) when is_list(Config) -> + erlang_server_openssl_client_sni_test(Config, "a.server", "a.server", "server Peer cert"). erlang_server_openssl_client_sni_match_fun(Config) when is_list(Config) -> - erlang_server_openssl_client_sni_test_sni_fun(Config, "a.server", "a.server", "a.server"). + erlang_server_openssl_client_sni_test_sni_fun(Config, "a.server", "a.server", "server Peer cert"). erlang_server_openssl_client_sni_no_match(Config) when is_list(Config) -> - erlang_server_openssl_client_sni_test(Config, "c.server", undefined, "server"). + erlang_server_openssl_client_sni_test(Config, "c.server", undefined, "server Peer cert"). erlang_server_openssl_client_sni_no_match_fun(Config) when is_list(Config) -> - erlang_server_openssl_client_sni_test_sni_fun(Config, "c.server", undefined, "server"). + erlang_server_openssl_client_sni_test_sni_fun(Config, "c.server", undefined, "server Peer cert"). %%-------------------------------------------------------------------- @@ -1275,11 +1292,11 @@ run_suites(Ciphers, Version, Config, Type) -> {ClientOpts, ServerOpts} = case Type of rsa -> - {ssl_test_lib:ssl_options(client_opts, Config), - ssl_test_lib:ssl_options(server_opts, Config)}; + {ssl_test_lib:ssl_options(client_rsa_opts, Config), + ssl_test_lib:ssl_options(server_rsa_opts, Config)}; dsa -> - {ssl_test_lib:ssl_options(client_opts, Config), - ssl_test_lib:ssl_options(server_dsa_opts, Config)} + {ssl_test_lib:ssl_options(client_dsa_opts, Config), + ssl_test_lib:ssl_options(server_dsa_verify_opts, Config)} end, Result = lists:map(fun(Cipher) -> @@ -1332,7 +1349,7 @@ send_and_hostname(SSLSocket) -> erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), - ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_opts, Config), + ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_rsa_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, @@ -1346,11 +1363,7 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname) end, ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), - - %% Client check needs to be done befor server check, - %% or server check might consume client messages - ExpectedClientOutput = ["OK", "/CN=" ++ ExpectedCN ++ "/"], - client_check_result(ClientPort, ExpectedClientOutput), + ssl_test_lib:check_result(Server, ExpectedSNIHostname), ssl_test_lib:close_port(ClientPort), ssl_test_lib:close(Server), @@ -1361,7 +1374,7 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo ct:log("Start running handshake for sni_fun, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), [{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config), SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end, - ServerOptions = proplists:get_value(server_opts, Config) ++ [{sni_fun, SNIFun}], + ServerOptions = proplists:get_value(server_rsa_opts, Config) ++ [{sni_fun, SNIFun}], {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, @@ -1377,10 +1390,6 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), - %% Client check needs to be done befor server check, - %% or server check might consume client messages - ExpectedClientOutput = ["OK", "/CN=" ++ ExpectedCN ++ "/"], - client_check_result(ClientPort, ExpectedClientOutput), ssl_test_lib:check_result(Server, ExpectedSNIHostname), ssl_test_lib:close_port(ClientPort), ssl_test_lib:close(Server). @@ -1444,8 +1453,8 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, OpensslServerOpts, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), ClientOpts = ErlangClientOpts ++ ClientOpts0, {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1490,8 +1499,8 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = proplists:get_value(server_opts, Config), - ClientOpts0 = proplists:get_value(client_opts, Config), + ServerOpts = proplists:get_value(server_rsa_opts, Config), + ClientOpts0 = proplists:get_value(client_rsa_opts, Config), ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]} | ClientOpts0], {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1526,7 +1535,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts0 = proplists:get_value(server_opts, Config), + ServerOpts0 = proplists:get_value(server_rsa_opts, Config), ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]} | ServerOpts0], {_, ServerNode, _} = ssl_test_lib:run_where(Config), @@ -1555,8 +1564,8 @@ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callba start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = proplists:get_value(server_opts, Config), - ClientOpts0 = proplists:get_value(client_opts, Config), + ServerOpts = proplists:get_value(server_rsa_opts, Config), + ClientOpts0 = proplists:get_value(client_rsa_opts, Config), ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]}, {client_preferred_next_protocols, {client, [<<"spdy/3">>, <<"http/1.1">>]}} | ClientOpts0], @@ -1595,7 +1604,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts0 = proplists:get_value(server_opts, Config), + ServerOpts0 = proplists:get_value(server_rsa_opts, Config), ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]}, {next_protocols_advertised, [<<"spdy/3">>, <<"http/1.1">>]} | ServerOpts0], @@ -1622,8 +1631,8 @@ start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Ca start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), ClientOpts = [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}} | ClientOpts0], {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1660,7 +1669,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = [{next_protocols_advertised, [<<"spdy/2">>]}, ServerOpts0], {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1690,7 +1699,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenSSLClientOpts, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = ErlangServerOpts ++ ServerOpts0, {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index f6f3d18d6a..95af2b77a5 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -408,9 +408,9 @@ calls cannot be in the guard or body of the fun. Calls to built-in match specification functions is of course allowed:</p> <pre> -4> <input>ets:fun2ms(fun({M,N}) when N > X, is_atomm(M) -> M end).</input> +4> <input>ets:fun2ms(fun({M,N}) when N > X, my_fun(M) -> M end).</input> Error: fun containing local Erlang function calls -('is_atomm' called in guard) cannot be translated into match_spec +('my_fun' called in guard) cannot be translated into match_spec {error,transform_error} 5> <input>ets:fun2ms(fun({M,N}) when N > X, is_atom(M) -> M end).</input> [{{'$1','$2'},[{'>','$2',{const,3}},{is_atom,'$1'}],['$1']}]</pre> diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 7d137fc772..da74e793e6 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -60,6 +60,8 @@ gen_server:abcast -----> Module:handle_cast/2 - -----> Module:handle_info/2 +- -----> Module:handle_continue/2 + - -----> Module:terminate/2 - -----> Module:code_change/3</pre> @@ -88,6 +90,13 @@ gen_server:abcast -----> Module:handle_cast/2 implies at least two garbage collections (when hibernating and shortly after waking up) and is not something you want to do between each call to a busy server.</p> + + <p>If the <c>gen_server</c> process needs to perform an action + immediately after initialization or to break the execution of a + callback into multiple steps, it can return <c>{continue,Continue}</c> + in place of the time-out or hibernation value, which will immediately + invoke the <c>handle_continue/2</c> callback.</p> + </description> <funcs> @@ -610,12 +619,15 @@ gen_server:abcast -----> Module:handle_cast/2 <v>State = term()</v> <v>Result = {reply,Reply,NewState} | {reply,Reply,NewState,Timeout}</v> <v> | {reply,Reply,NewState,hibernate}</v> + <v> | {reply,Reply,NewState,{continue,Continue}}</v> <v> | {noreply,NewState} | {noreply,NewState,Timeout}</v> <v> | {noreply,NewState,hibernate}</v> + <v> | {noreply,NewState,{continue,Continue}}</v> <v> | {stop,Reason,Reply,NewState} | {stop,Reason,NewState}</v> <v> Reply = term()</v> <v> NewState = term()</v> <v> Timeout = int()>=0 | infinity</v> + <v> Continue = term()</v> <v> Reason = term()</v> </type> <desc> @@ -673,9 +685,11 @@ gen_server:abcast -----> Module:handle_cast/2 <v>State = term()</v> <v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v> <v> | {noreply,NewState,hibernate}</v> + <v> | {noreply,NewState,{continue,Continue}}</v> <v> | {stop,Reason,NewState}</v> <v> NewState = term()</v> <v> Timeout = int()>=0 | infinity</v> + <v> Continue = term()</v> <v> Reason = term()</v> </type> <desc> @@ -690,6 +704,41 @@ gen_server:abcast -----> Module:handle_cast/2 </func> <func> + <name>Module:handle_continue(Continue, State) -> Result</name> + <fsummary>Handle a continue instruction.</fsummary> + <type> + <v>Continue = term()</v> + <v>State = term()</v> + <v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v> + <v> | {noreply,NewState,hibernate}</v> + <v> | {noreply,NewState,{continue,Continue}}</v> + <v> | {stop,Reason,NewState}</v> + <v> NewState = term()</v> + <v> Timeout = int()>=0 | infinity</v> + <v> Continue = term()</v> + <v> Reason = normal | term()</v> + </type> + <desc> + <note> + <p>This callback is optional, so callback modules need to + export it only if they return <c>{continue,Continue}</c> + from another callback. If continue is used and the callback + is not implemented, the process will exit with <c>undef</c> + error.</p> + </note> + <p>This function is called by a <c>gen_server</c> process whenever + a previous callback returns <c>{continue, Continue}</c>. + <c>handle_continue/2</c> is invoked immediately after the previous + callback, which makes it useful for performing work after + initialization or for splitting the work in a callback in + multiple steps, updating the process state along the way.</p> + <p>For a description of the other arguments and possible return values, + see <seealso marker="#Module:handle_call/3"> + <c>Module:handle_call/3</c></seealso>.</p> + </desc> + </func> + + <func> <name>Module:handle_info(Info, State) -> Result</name> <fsummary>Handle an incoming message.</fsummary> <type> @@ -697,6 +746,7 @@ gen_server:abcast -----> Module:handle_cast/2 <v>State = term()</v> <v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v> <v> | {noreply,NewState,hibernate}</v> + <v> | {noreply,NewState,{continue,Continue}}</v> <v> | {stop,Reason,NewState}</v> <v> NewState = term()</v> <v> Timeout = int()>=0 | infinity</v> @@ -726,7 +776,7 @@ gen_server:abcast -----> Module:handle_cast/2 <type> <v>Args = term()</v> <v>Result = {ok,State} | {ok,State,Timeout} | {ok,State,hibernate}</v> - <v> | {stop,Reason} | ignore</v> + <v> | {ok,State,{continue,Continue}} | {stop,Reason} | ignore</v> <v> State = term()</v> <v> Timeout = int()>=0 | infinity</v> <v> Reason = term()</v> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index bdd5b39cd3..604d758db3 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -432,7 +432,7 @@ marker="erts:erl"><c>erl</c></seealso> command.</p> <p> See <url - href="http://pcre.org/original/changelog.txt"><c>http://pcre.org/original/changelog.txt</c></url> + href="http://pcre.org/original/changelog.txt">http://pcre.org/original/changelog.txt</url> for information about changes made to PCRE between the versions 8.33 and 8.40.</p> <p> diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 10e8c9c800..4e3fe0e5c1 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1354,7 +1354,7 @@ open_file_loop2(Head, N) -> ?MODULE, [], Head); Message -> error_logger:format("** dets: unexpected message" - "(ignored): ~w~n", [Message]), + "(ignored): ~tw~n", [Message]), open_file_loop(Head, N) end. @@ -1403,7 +1403,7 @@ apply_op(Op, From, Head, N) -> Head; _Dirty when N =:= 0 -> % dirty or new_dirty %% The updates seems to have declined - dets_utils:vformat("** dets: Auto save of ~p\n", + dets_utils:vformat("** dets: Auto save of ~tp\n", [Head#head.name]), {NewHead, _Res} = perform_save(Head, true), erlang:garbage_collect(), @@ -1587,13 +1587,13 @@ bug_found(Name, Op, Bad, From) -> %% If stream_op/5 found more requests, this is not %% the last operation. error_logger:format - ("** dets: Bug was found when accessing table ~w,~n" - "** dets: operation was ~p and reply was ~w.~n" - "** dets: Stacktrace: ~w~n", + ("** dets: Bug was found when accessing table ~tw,~n" + "** dets: operation was ~tp and reply was ~tw.~n" + "** dets: Stacktrace: ~tw~n", [Name, Op, Bad, erlang:get_stacktrace()]); false -> error_logger:format - ("** dets: Bug was found when accessing table ~w~n", + ("** dets: Bug was found when accessing table ~tw~n", [Name]) end, if @@ -2117,7 +2117,7 @@ do_open_file([Fname, Verbose], Parent, Server, Ref) -> Error; Bad -> error_logger:format - ("** dets: Bug was found in open_file/1, reply was ~w.~n", + ("** dets: Bug was found in open_file/1, reply was ~tw.~n", [Bad]), {error, {dets_bug, Fname, Bad}} end; @@ -2135,7 +2135,7 @@ do_open_file([Tab, OpenArgs, Verb], Parent, Server, _Ref) -> Bad -> error_logger:format ("** dets: Bug was found in open_file/2, arguments were~n" - "** dets: ~w and reply was ~w.~n", + "** dets: ~tw and reply was ~tw.~n", [OpenArgs, Bad]), {error, {dets_bug, Tab, {open_file, OpenArgs}, Bad}} end. @@ -3123,7 +3123,7 @@ check_safe_fixtable(Head) -> ((get(verbose) =:= yes) orelse dets_utils:debug_mode()) of true -> error_logger:format - ("** dets: traversal of ~p needs safe_fixtable~n", + ("** dets: traversal of ~tp needs safe_fixtable~n", [Head#head.name]); false -> ok @@ -3189,7 +3189,7 @@ scan_read(H, From, _To, Min, _L, Ts, R, C) -> err(Error) -> case get(verbose) of yes -> - error_logger:format("** dets: failed with ~w~n", [Error]), + error_logger:format("** dets: failed with ~tw~n", [Error]), Error; undefined -> Error diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index da6ebd18f2..17f55ebdc2 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. +%% Copyright Ericsson AB 2001-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -387,7 +387,7 @@ corrupt_reason(Head, Reason0) -> corrupt(Head, Error) -> case get(verbose) of yes -> - error_logger:format("** dets: Corrupt table ~p: ~tp\n", + error_logger:format("** dets: Corrupt table ~tp: ~tp\n", [Head#head.name, Error]); _ -> ok end, diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 71e8471c45..64d5a71f3c 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -83,7 +83,7 @@ edit_line(Cs, {line,P,L,M}) -> edit_line1(Cs, {line,P,L,{blink,N}}) -> edit(Cs, P, L, none, [{move_rel,N}]); edit_line1(Cs, {line,P,{[],[]},none}) -> - {more_chars, {line,P,{lists:reverse(Cs),[]},none},[{put_chars, unicode, Cs}]}; + {more_chars, {line,P,{string:reverse(Cs),[]},none},[{put_chars, unicode, Cs}]}; edit_line1(Cs, {line,P,L,M}) -> edit(Cs, P, L, M, []). @@ -93,14 +93,14 @@ edit([C|Cs], P, {Bef,Aft}, Prefix, Rs0) -> case key_map(C, Prefix) of meta -> edit(Cs, P, {Bef,Aft}, meta, Rs0); - meta_o -> - edit(Cs, P, {Bef,Aft}, meta_o, Rs0); - meta_csi -> - edit(Cs, P, {Bef,Aft}, meta_csi, Rs0); - meta_meta -> - edit(Cs, P, {Bef,Aft}, meta_meta, Rs0); - {csi, _} = Csi -> - edit(Cs, P, {Bef,Aft}, Csi, Rs0); + meta_o -> + edit(Cs, P, {Bef,Aft}, meta_o, Rs0); + meta_csi -> + edit(Cs, P, {Bef,Aft}, meta_csi, Rs0); + meta_meta -> + edit(Cs, P, {Bef,Aft}, meta_meta, Rs0); + {csi, _} = Csi -> + edit(Cs, P, {Bef,Aft}, Csi, Rs0); meta_left_sq_bracket -> edit(Cs, P, {Bef,Aft}, meta_left_sq_bracket, Rs0); search_meta -> @@ -110,8 +110,8 @@ edit([C|Cs], P, {Bef,Aft}, Prefix, Rs0) -> ctlx -> edit(Cs, P, {Bef,Aft}, ctlx, Rs0); new_line -> - {done, reverse(Bef, Aft ++ "\n"), Cs, - reverse(Rs0, [{move_rel,length(Aft)},{put_chars,unicode,"\n"}])}; + {done, get_line(Bef, Aft ++ "\n"), Cs, + reverse(Rs0, [{move_rel,cp_len(Aft)},{put_chars,unicode,"\n"}])}; redraw_line -> Rs1 = erase(P, Bef, Aft, Rs0), Rs = redraw(P, Bef, Aft, Rs1), @@ -157,7 +157,7 @@ edit([], P, L, {blink,N}, Rs) -> edit([], P, L, Prefix, Rs) -> {more_chars,{line,P,L,Prefix},reverse(Rs)}; edit(eof, _, {Bef,Aft}, _, Rs) -> - {done,reverse(Bef, Aft),[],reverse(Rs, [{move_rel,length(Aft)}])}. + {done,get_line(Bef, Aft),[],reverse(Rs, [{move_rel,cp_len(Aft)}])}. %% %% Assumes that arg is a string %% %% Horizontal whitespace only. @@ -279,11 +279,21 @@ key_map(C, search) -> {insert_search,C}; key_map(C, _) -> {undefined,C}. %% do_op(Action, Before, After, Requests) - -do_op({insert,C}, Bef, [], Rs) -> - {{[C|Bef],[]},[{put_chars, unicode,[C]}|Rs]}; -do_op({insert,C}, Bef, Aft, Rs) -> - {{[C|Bef],Aft},[{insert_chars, unicode, [C]}|Rs]}; +%% Before and After are of lists of type string:grapheme_cluster() +do_op({insert,C}, [], [], Rs) -> + {{[C],[]},[{put_chars, unicode,[C]}|Rs]}; +do_op({insert,C}, [Bef|Bef0], [], Rs) -> + case string:to_graphemes([Bef,C]) of + [GC] -> {{[GC|Bef0],[]},[{put_chars, unicode,[C]}|Rs]}; + _ -> {{[C,Bef|Bef0],[]},[{put_chars, unicode,[C]}|Rs]} + end; +do_op({insert,C}, [], Aft, Rs) -> + {{[C],Aft},[{insert_chars, unicode,[C]}|Rs]}; +do_op({insert,C}, [Bef|Bef0], Aft, Rs) -> + case string:to_graphemes([Bef,C]) of + [GC] -> {{[GC|Bef0],Aft},[{insert_chars, unicode,[C]}|Rs]}; + _ -> {{[C,Bef|Bef0],Aft},[{insert_chars, unicode,[C]}|Rs]} + end; %% Search mode prompt always looks like (search)`$TERMS': $RESULT. %% the {insert_search, _} handlings allow to share this implementation %% correctly with group.erl. This module provides $TERMS, and group.erl @@ -299,13 +309,13 @@ do_op({insert_search, C}, Bef, [], Rs) -> [{insert_chars, unicode, [C]++Aft}, {delete_chars,-3} | Rs], search}; do_op({insert_search, C}, Bef, Aft, Rs) -> - Offset= length(Aft), + Offset= cp_len(Aft), NAft = "': ", {{[C|Bef],NAft}, [{insert_chars, unicode, [C]++NAft}, {delete_chars,-Offset} | Rs], search}; do_op({search, backward_delete_char}, [_|Bef], Aft, Rs) -> - Offset= length(Aft)+1, + Offset= cp_len(Aft)+1, NAft = "': ", {{Bef,NAft}, [{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs], @@ -314,13 +324,13 @@ do_op({search, backward_delete_char}, [], _Aft, Rs) -> Aft="': ", {{[],Aft}, Rs, search}; do_op({search, skip_up}, Bef, Aft, Rs) -> - Offset= length(Aft), + Offset= cp_len(Aft), NAft = "': ", {{[$\^R|Bef],NAft}, % we insert ^R as a flag to whoever called us [{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs], search}; do_op({search, skip_down}, Bef, Aft, Rs) -> - Offset= length(Aft), + Offset= cp_len(Aft), NAft = "': ", {{[$\^S|Bef],NAft}, % we insert ^S as a flag to whoever called us [{insert_chars, unicode, NAft}, {delete_chars,-Offset}|Rs], @@ -328,12 +338,12 @@ do_op({search, skip_down}, Bef, Aft, Rs) -> do_op({search, search_found}, _Bef, Aft, Rs) -> "': "++NAft = Aft, {{[],NAft}, - [{put_chars, unicode, "\n"}, {move_rel,-length(Aft)} | Rs], + [{put_chars, unicode, "\n"}, {move_rel,-cp_len(Aft)} | Rs], search_found}; do_op({search, search_quit}, _Bef, Aft, Rs) -> "': "++NAft = Aft, {{[],NAft}, - [{put_chars, unicode, "\n"}, {move_rel,-length(Aft)} | Rs], + [{put_chars, unicode, "\n"}, {move_rel,-cp_len(Aft)} | Rs], search_quit}; %% do blink after $$ do_op({blink,C,M}, Bef=[$$,$$|_], Aft, Rs) -> @@ -361,14 +371,16 @@ do_op(auto_blink, Bef, Aft, Rs) -> N -> {blink,N+1,{Bef,Aft}, [{move_rel,-(N+1)}|Rs]} end; -do_op(forward_delete_char, Bef, [_|Aft], Rs) -> - {{Bef,Aft},[{delete_chars,1}|Rs]}; -do_op(backward_delete_char, [_|Bef], Aft, Rs) -> - {{Bef,Aft},[{delete_chars,-1}|Rs]}; +do_op(forward_delete_char, Bef, [GC|Aft], Rs) -> + {{Bef,Aft},[{delete_chars,gc_len(GC)}|Rs]}; +do_op(backward_delete_char, [GC|Bef], Aft, Rs) -> + {{Bef,Aft},[{delete_chars,-gc_len(GC)}|Rs]}; do_op(transpose_char, [C1,C2|Bef], [], Rs) -> - {{[C2,C1|Bef],[]},[{put_chars, unicode,[C1,C2]},{move_rel,-2}|Rs]}; + Len = gc_len(C1)+gc_len(C2), + {{[C2,C1|Bef],[]},[{put_chars, unicode,[C1,C2]},{move_rel,-Len}|Rs]}; do_op(transpose_char, [C2|Bef], [C1|Aft], Rs) -> - {{[C2,C1|Bef],Aft},[{put_chars, unicode,[C1,C2]},{move_rel,-1}|Rs]}; + Len = gc_len(C2), + {{[C2,C1|Bef],Aft},[{put_chars, unicode,[C1,C2]},{move_rel,-Len}|Rs]}; do_op(kill_word, Bef, Aft0, Rs) -> {Aft1,Kill0,N0} = over_non_word(Aft0, [], 0), {Aft,Kill,N} = over_word(Aft1, Kill0, N0), @@ -381,7 +393,7 @@ do_op(backward_kill_word, Bef0, Aft, Rs) -> {{Bef,Aft},[{delete_chars,-N}|Rs]}; do_op(kill_line, Bef, Aft, Rs) -> put(kill_buffer, Aft), - {{Bef,[]},[{delete_chars,length(Aft)}|Rs]}; + {{Bef,[]},[{delete_chars,cp_len(Aft)}|Rs]}; do_op(yank, Bef, [], Rs) -> Kill = get(kill_buffer), {{reverse(Kill, Bef),[]},[{put_chars, unicode,Kill}|Rs]}; @@ -389,9 +401,9 @@ do_op(yank, Bef, Aft, Rs) -> Kill = get(kill_buffer), {{reverse(Kill, Bef),Aft},[{insert_chars, unicode,Kill}|Rs]}; do_op(forward_char, Bef, [C|Aft], Rs) -> - {{[C|Bef],Aft},[{move_rel,1}|Rs]}; + {{[C|Bef],Aft},[{move_rel,gc_len(C)}|Rs]}; do_op(backward_char, [C|Bef], Aft, Rs) -> - {{Bef,[C|Aft]},[{move_rel,-1}|Rs]}; + {{Bef,[C|Aft]},[{move_rel,-gc_len(C)}|Rs]}; do_op(forward_word, Bef0, Aft0, Rs) -> {Aft1,Bef1,N0} = over_non_word(Aft0, Bef0, 0), {Aft,Bef,N} = over_word(Aft1, Bef1, N0), @@ -401,16 +413,16 @@ do_op(backward_word, Bef0, Aft0, Rs) -> {Bef,Aft,N} = over_word(Bef1, Aft1, N0), {{Bef,Aft},[{move_rel,-N}|Rs]}; do_op(beginning_of_line, [C|Bef], Aft, Rs) -> - {{[],reverse(Bef, [C|Aft])},[{move_rel,-(length(Bef)+1)}|Rs]}; + {{[],reverse(Bef, [C|Aft])},[{move_rel,-(cp_len(Bef)+1)}|Rs]}; do_op(beginning_of_line, [], Aft, Rs) -> {{[],Aft},Rs}; do_op(end_of_line, Bef, [C|Aft], Rs) -> - {{reverse(Aft, [C|Bef]),[]},[{move_rel,length(Aft)+1}|Rs]}; + {{reverse(Aft, [C|Bef]),[]},[{move_rel,cp_len(Aft)+1}|Rs]}; do_op(end_of_line, Bef, [], Rs) -> {{Bef,[]},Rs}; do_op(ctlu, Bef, Aft, Rs) -> put(kill_buffer, reverse(Bef)), - {{[], Aft}, [{delete_chars, -length(Bef)} | Rs]}; + {{[], Aft}, [{delete_chars, -cp_len(Bef)} | Rs]}; do_op(beep, Bef, Aft, Rs) -> {{Bef,Aft},[beep|Rs]}; do_op(_, Bef, Aft, Rs) -> @@ -436,7 +448,7 @@ over_word(Cs, Stack, N) -> until_quote([$\'|Cs], Stack, N) -> {Cs, [$\'|Stack], N+1}; until_quote([C|Cs], Stack, N) -> - until_quote(Cs, [C|Stack], N+1). + until_quote(Cs, [C|Stack], N+gc_len(C)). over_word1([$\'=C|Cs], Stack, N) -> until_quote(Cs, [C|Stack], N+1); @@ -445,7 +457,7 @@ over_word1(Cs, Stack, N) -> over_word2([C|Cs], Stack, N) -> case word_char(C) of - true -> over_word2(Cs, [C|Stack], N+1); + true -> over_word2(Cs, [C|Stack], N+gc_len(C)); false -> {[C|Cs],Stack,N} end; over_word2([], Stack, N) when is_integer(N) -> @@ -454,7 +466,7 @@ over_word2([], Stack, N) when is_integer(N) -> over_non_word([C|Cs], Stack, N) -> case word_char(C) of true -> {[C|Cs],Stack,N}; - false -> over_non_word(Cs, [C|Stack], N+1) + false -> over_non_word(Cs, [C|Stack], N+gc_len(C)) end; over_non_word([], Stack, N) -> {[],Stack,N}. @@ -465,6 +477,7 @@ word_char(C) when C >= $a, C =< $z -> true; word_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true; word_char(C) when C >= $0, C =< $9 -> true; word_char(C) when C =:= $_ -> true; +word_char([_|_]) -> true; %% Is grapheme word_char(_) -> false. %% over_white(Chars, InitialStack, InitialCount) -> @@ -488,8 +501,8 @@ over_paren(Chars, Paren, Match) -> over_paren([C,$$,$$|Cs], Paren, Match, D, N, L) -> over_paren([C|Cs], Paren, Match, D, N+2, L); -over_paren([_,$$|Cs], Paren, Match, D, N, L) -> - over_paren(Cs, Paren, Match, D, N+2, L); +over_paren([GC,$$|Cs], Paren, Match, D, N, L) -> + over_paren(Cs, Paren, Match, D, N+1+gc_len(GC), L); over_paren([Match|_], _Paren, Match, 1, N, _) -> N; over_paren([Match|Cs], Paren, Match, D, N, [Match|L]) -> @@ -518,8 +531,8 @@ over_paren([$[|_], _, _, _, _, _) -> over_paren([${|_], _, _, _, _, _) -> beep; -over_paren([_|Cs], Paren, Match, D, N, L) -> - over_paren(Cs, Paren, Match, D, N+1, L); +over_paren([GC|Cs], Paren, Match, D, N, L) -> + over_paren(Cs, Paren, Match, D, N+gc_len(GC), L); over_paren([], _, _, _, _, _) -> 0. @@ -529,8 +542,8 @@ over_paren_auto(Chars) -> over_paren_auto([C,$$,$$|Cs], D, N, L) -> over_paren_auto([C|Cs], D, N+2, L); -over_paren_auto([_,$$|Cs], D, N, L) -> - over_paren_auto(Cs, D, N+2, L); +over_paren_auto([GC,$$|Cs], D, N, L) -> + over_paren_auto(Cs, D, N+1+gc_len(GC), L); over_paren_auto([$(|_], _, N, []) -> {N, $)}; @@ -553,8 +566,8 @@ over_paren_auto([$[|Cs], D, N, [$[|L]) -> over_paren_auto([${|Cs], D, N, [${|L]) -> over_paren_auto(Cs, D, N+1, L); -over_paren_auto([_|Cs], D, N, L) -> - over_paren_auto(Cs, D, N+1, L); +over_paren_auto([GC|Cs], D, N, L) -> + over_paren_auto(Cs, D, N+gc_len(GC), L); over_paren_auto([], _, _, _) -> 0. @@ -574,28 +587,43 @@ erase_inp({line,_,{Bef,Aft},_}) -> reverse(erase([], Bef, Aft, [])). erase(Pbs, Bef, Aft, Rs) -> - [{delete_chars,-length(Pbs)-length(Bef)},{delete_chars,length(Aft)}|Rs]. + [{delete_chars,-cp_len(Pbs)-cp_len(Bef)},{delete_chars,cp_len(Aft)}|Rs]. redraw_line({line,Pbs,{Bef,Aft},_}) -> reverse(redraw(Pbs, Bef, Aft, [])). redraw(Pbs, Bef, Aft, Rs) -> - [{move_rel,-length(Aft)},{put_chars, unicode,reverse(Bef, Aft)},{put_chars, unicode,Pbs}|Rs]. + [{move_rel,-cp_len(Aft)},{put_chars, unicode,reverse(Bef, Aft)},{put_chars, unicode,Pbs}|Rs]. length_before({line,Pbs,{Bef,_Aft},_}) -> - length(Pbs) + length(Bef). + cp_len(Pbs) + cp_len(Bef). length_after({line,_,{_Bef,Aft},_}) -> - length(Aft). + cp_len(Aft). prompt({line,Pbs,_,_}) -> Pbs. current_line({line,_,{Bef, Aft},_}) -> - reverse(Bef, Aft ++ "\n"). + get_line(Bef, Aft ++ "\n"). current_chars({line,_,{Bef,Aft},_}) -> - reverse(Bef, Aft). + get_line(Bef, Aft). + +get_line(Bef, Aft) -> + unicode:characters_to_list(reverse(Bef, Aft)). + +%% Grapheme length in codepoints +gc_len(CP) when is_integer(CP) -> 1; +gc_len(CPs) when is_list(CPs) -> length(CPs). + +%% String length in codepoints +cp_len(Str) -> + cp_len(Str, 0). + +cp_len([GC|R], Len) -> + cp_len(R, Len + gc_len(GC)); +cp_len([], Len) -> Len. %% %% expand(CurrentBefore) -> %% %% {yes,Expansion} | no diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index a1a97af4c5..bdcefda6e5 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -23,7 +23,7 @@ -export([expand/1, format_matches/1]). --import(lists, [reverse/1, nthtail/2, prefix/2]). +-import(lists, [reverse/1, prefix/2]). %% expand(CurrentBefore) -> %% {yes, Expansion, Matches} | {no, Matches} @@ -75,15 +75,15 @@ to_atom(Str) -> end. match(Prefix, Alts, Extra0) -> - Len = length(Prefix), + Len = string:length(Prefix), Matches = lists:sort( [{S, A} || {H, A} <- Alts, - prefix(Prefix, S=hd(io_lib:fwrite("~w",[H])))]), + prefix(Prefix, S=flat_write(H))]), case longest_common_head([N || {N, _} <- Matches]) of {partial, []} -> {no, [], Matches}; % format_matches(Matches)}; {partial, Str} -> - case nthtail(Len, Str) of + case string:slice(Str, Len) of [] -> {yes, [], Matches}; % format_matches(Matches)}; Remain -> @@ -94,18 +94,21 @@ match(Prefix, Alts, Extra0) -> {"(",[{Str,0}]} -> "()"; {_,_} -> Extra0 end, - {yes, nthtail(Len, Str) ++ Extra, []}; + {yes, string:slice(Str, Len) ++ Extra, []}; no -> {no, [], []} end. +flat_write(T) -> + lists:flatten(io_lib:fwrite("~tw",[T])). + %% Return the list of names L in multiple columns. format_matches(L) -> {S1, Dots} = format_col(lists:sort(L), []), S = case Dots of true -> {_, Prefix} = longest_common_head(vals(L)), - PrefixLen = length(Prefix), + PrefixLen = string:length(Prefix), case PrefixLen =< 3 of true -> S1; % Do not replace the prefix with "...". false -> @@ -128,7 +131,7 @@ format_col([A|T], Width, Len, Acc0, LL, Dots) -> {H0, R} = format_val(A), Hmax = LL - length(R), {H, NewDots} = - case length(H0) > Hmax of + case string:length(H0) > Hmax of true -> {io_lib:format("~-*ts", [Hmax - 3, H0]) ++ "...", true}; false -> {H0, Dots} end, @@ -149,12 +152,12 @@ format_val(H) -> field_width(L, LL) -> field_width(L, 0, LL). field_width([{H,_}|T], W, LL) -> - case length(H) of + case string:length(H) of L when L > W -> field_width(T, L, LL); _ -> field_width(T, W, LL) end; field_width([H|T], W, LL) -> - case length(H) of + case string:length(H) of L when L > W -> field_width(T, L, LL); _ -> field_width(T, W, LL) end; @@ -169,10 +172,11 @@ vals([S|L]) -> [S|vals(L)]. leading_dots([], _Len) -> []; leading_dots([{H, I}|L], Len) -> - [{"..." ++ nthtail(Len, H), I}|leading_dots(L, Len)]; + [{"..." ++ string:slice(H, Len), I}|leading_dots(L, Len)]; leading_dots([H|L], Len) -> - ["..." ++ nthtail(Len, H)|leading_dots(L, Len)]. + ["..." ++ string:slice(H, Len)|leading_dots(L, Len)]. +%% Strings are handled naively, but it should be OK here. longest_common_head([]) -> no; longest_common_head(LL) -> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 65ba343368..9cd4727dc3 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3238,13 +3238,13 @@ icrt_clauses(Cs, In, Vt, St0) -> icrt_clauses(Cs, Vt, St) -> mapfoldl(fun (C, St0) -> icrt_clause(C, Vt, St0) end, St, Cs). -icrt_clause({clause,_Line,H,G,B}, Vt0, St0) -> +icrt_clause({clause,_Line,H,G,B}, Vt0, #lint{catch_scope=Scope}=St0) -> {Hvt,Binvt,St1} = head(H, Vt0, St0), Vt1 = vtupdate(Hvt, Binvt), {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1), Vt2 = vtupdate(Gvt, Vt1), {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2), - {vtupdate(Bvt, Vt2),St3}. + {vtupdate(Bvt, Vt2),St3#lint{catch_scope=Scope}}. icrt_export(Vts, Vt, {Tag,Attrs}, St) -> {_File,Loc} = loc(Attrs, St), diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index ee5e7a11bf..b0064aadb8 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -598,8 +598,6 @@ lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) -> lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) -> {force_nl,fun_info(Extra), {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}}; -lexpr({'query',_,Lc}, _Prec, Opts) -> - {list,[{step,leaf("query"),lexpr(Lc, 0, Opts)},'end']}; lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) -> case erl_internal:bif(M, F, length(Args)) of true -> diff --git a/lib/stdlib/src/error_logger_file_h.erl b/lib/stdlib/src/error_logger_file_h.erl index b7c193f965..58da0cbdd6 100644 --- a/lib/stdlib/src/error_logger_file_h.erl +++ b/lib/stdlib/src/error_logger_file_h.erl @@ -126,7 +126,7 @@ format_body(State, [{Format,Args}|T]) -> S0 catch _:_ -> - format(State, "ERROR: ~p - ~p\n", [Format,Args]) + format(State, "ERROR: ~tp - ~tp\n", [Format,Args]) end, [S|format_body(State, T)]; format_body(_State, []) -> @@ -165,44 +165,26 @@ parse_event({warning_report, _GL, {Pid, std_warning, Args}}) -> parse_event(_) -> ignore. format_term(Term) when is_list(Term) -> - case string_p(Term) of + case string_p(lists:flatten(Term)) of true -> - [{"~s\n",[Term]}]; + [{"~ts\n",[Term]}]; false -> format_term_list(Term) end; format_term(Term) -> - [{"~p\n",[Term]}]. + [{"~tp\n",[Term]}]. format_term_list([{Tag,Data}|T]) -> - [{" ~p: ~p\n",[Tag,Data]}|format_term_list(T)]; + [{" ~tp: ~tp\n",[Tag,Data]}|format_term_list(T)]; format_term_list([Data|T]) -> - [{" ~p\n",[Data]}|format_term_list(T)]; + [{" ~tp\n",[Data]}|format_term_list(T)]; format_term_list([]) -> - []; -format_term_list(_) -> - %% Continue to allow non-proper lists for now. - %% FIXME: Remove this clause in OTP 19. []. string_p([]) -> false; -string_p(Term) -> - string_p1(Term). - -string_p1([H|T]) when is_integer(H), H >= $\s, H < 255 -> - string_p1(T); -string_p1([$\n|T]) -> string_p1(T); -string_p1([$\r|T]) -> string_p1(T); -string_p1([$\t|T]) -> string_p1(T); -string_p1([$\v|T]) -> string_p1(T); -string_p1([$\b|T]) -> string_p1(T); -string_p1([$\f|T]) -> string_p1(T); -string_p1([$\e|T]) -> string_p1(T); -string_p1([H|T]) when is_list(H) -> - string_p1(H) andalso string_p1(T); -string_p1([]) -> true; -string_p1(_) -> false. +string_p(FlatList) -> + io_lib:printable_list(FlatList). get_utc_config() -> %% SASL utc_log configuration overrides stdlib config @@ -225,7 +207,7 @@ header(Time, Title) -> end. header({{Y,Mo,D},{H,Mi,S}}, Title, UTC) -> - io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ~s===~n", + io_lib:format("~n=~ts==== ~p-~s-~p::~s:~s:~s ~s===~n", [Title,D,month(Mo),Y,t(H),t(Mi),t(S),UTC]). t(X) when is_integer(X) -> diff --git a/lib/stdlib/src/error_logger_tty_h.erl b/lib/stdlib/src/error_logger_tty_h.erl index 8f0d7b0362..fa940b7264 100644 --- a/lib/stdlib/src/error_logger_tty_h.erl +++ b/lib/stdlib/src/error_logger_tty_h.erl @@ -39,13 +39,16 @@ {user, prev_handler, io_mod=io, - depth=unlimited}). + depth=unlimited, + modifier=""}). %% This one is used when we takeover from the simple error_logger. init({[], {error_logger, Buf}}) -> User = set_group_leader(), Depth = error_logger:get_format_depth(), - State = #st{user=User,prev_handler=error_logger,depth=Depth}, + Modifier = modifier(), + State = #st{user=User,prev_handler=error_logger, + depth=Depth,modifier=Modifier}, write_events(State, Buf), {ok, State}; %% This one is used if someone took over from us, and now wants to @@ -57,7 +60,8 @@ init({[], {error_logger_tty_h, PrevHandler}}) -> init([]) -> User = set_group_leader(), Depth = error_logger:get_format_depth(), - {ok, #st{user=User,prev_handler=[],depth=Depth}}. + Modifier = modifier(), + {ok, #st{user=User,prev_handler=[],depth=Depth,modifier=Modifier}}. handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() -> {ok, State}; @@ -91,8 +95,9 @@ code_change(_OldVsn, State, _Extra) -> write_event(Event, IoMod) -> do_write_event(#st{io_mod=IoMod}, Event). -write_event(Event, IoMod, Depth) -> - do_write_event(#st{io_mod=IoMod,depth=Depth}, Event). +write_event(Event, IoMod, {Depth, Enc}) -> + Modifier = modifier(Enc), + do_write_event(#st{io_mod=IoMod,depth=Depth,modifier=Modifier}, Event). %%% ------------------------------------------------------ @@ -120,12 +125,12 @@ write_events(State, [Ev|Es]) -> write_events(_State, []) -> ok. -do_write_event(State, {Time, Event}) -> - case parse_event(Event) of +do_write_event(#st{modifier=M}=State, {Time, Event}) -> + case parse_event(Event,M) of ignore -> ok; {Title,Pid,FormatList} -> - Header = header(Time, Title), + Header = header(Time, Title, M), Body = format_body(State, FormatList), AtNode = if node(Pid) =/= node() -> @@ -144,13 +149,13 @@ do_write_event(State, {Time, Event}) -> do_write_event(_, _) -> ok. -format_body(State, [{Format,Args}|T]) -> +format_body(#st{modifier=M}=State, [{Format,Args}|T]) -> S = try format(State, Format, Args) of S0 -> S0 catch _:_ -> - format(State, "ERROR: ~p - ~p\n", [Format,Args]) + format(State, "ERROR: ~"++M++"p - ~"++M++"p\n", [Format,Args]) end, [S|format_body(State, T)]; format_body(_State, []) -> @@ -174,62 +179,41 @@ limit_format([H|T], Depth) -> limit_format([], _) -> []. -parse_event({error, _GL, {Pid, Format, Args}}) -> +parse_event({error, _GL, {Pid, Format, Args}},_) -> {"ERROR REPORT",Pid,[{Format,Args}]}; -parse_event({info_msg, _GL, {Pid, Format, Args}}) -> +parse_event({info_msg, _GL, {Pid, Format, Args}},_) -> {"INFO REPORT",Pid,[{Format, Args}]}; -parse_event({warning_msg, _GL, {Pid, Format, Args}}) -> +parse_event({warning_msg, _GL, {Pid, Format, Args}},_) -> {"WARNING REPORT",Pid,[{Format,Args}]}; -parse_event({error_report, _GL, {Pid, std_error, Args}}) -> - {"ERROR REPORT",Pid,format_term(Args)}; -parse_event({info_report, _GL, {Pid, std_info, Args}}) -> - {"INFO REPORT",Pid,format_term(Args)}; -parse_event({warning_report, _GL, {Pid, std_warning, Args}}) -> - {"WARNING REPORT",Pid,format_term(Args)}; -parse_event(_) -> ignore. - -format_term(Term) when is_list(Term) -> - case string_p(Term) of +parse_event({error_report, _GL, {Pid, std_error, Args}},M) -> + {"ERROR REPORT",Pid,format_term(Args,M)}; +parse_event({info_report, _GL, {Pid, std_info, Args}},M) -> + {"INFO REPORT",Pid,format_term(Args,M)}; +parse_event({warning_report, _GL, {Pid, std_warning, Args}},M) -> + {"WARNING REPORT",Pid,format_term(Args,M)}; +parse_event(_,_) -> ignore. + +format_term(Term,M) when is_list(Term) -> + case string_p(lists:flatten(Term)) of true -> - [{"~s\n",[Term]}]; + [{"~"++M++"s\n",[Term]}]; false -> - format_term_list(Term) + format_term_list(Term,M) end; -format_term(Term) -> - [{"~p\n",[Term]}]. - -format_term_list([{Tag,Data}|T]) -> - [{" ~p: ~p\n",[Tag,Data]}|format_term_list(T)]; -format_term_list([Data|T]) -> - [{" ~p\n",[Data]}|format_term_list(T)]; -format_term_list([]) -> - []; -format_term_list(_) -> - %% Continue to allow non-proper lists for now. - %% FIXME: Remove this clause in OTP 19. +format_term(Term,M) -> + [{"~"++M++"p\n",[Term]}]. + +format_term_list([{Tag,Data}|T],M) -> + [{" ~"++M++"p: ~"++M++"p\n",[Tag,Data]}|format_term_list(T,M)]; +format_term_list([Data|T],M) -> + [{" ~"++M++"p\n",[Data]}|format_term_list(T,M)]; +format_term_list([],_) -> []. string_p([]) -> false; -string_p(Term) -> - string_p1(Term). - -string_p1([H|T]) when is_integer(H), H >= $\s, H < 255 -> - string_p1(T); -string_p1([$\n|T]) -> string_p1(T); -string_p1([$\r|T]) -> string_p1(T); -string_p1([$\t|T]) -> string_p1(T); -string_p1([$\v|T]) -> string_p1(T); -string_p1([$\b|T]) -> string_p1(T); -string_p1([$\f|T]) -> string_p1(T); -string_p1([$\e|T]) -> string_p1(T); -string_p1([H|T]) when is_list(H) -> - case string_p1(H) of - true -> string_p1(T); - _ -> false - end; -string_p1([]) -> true; -string_p1(_) -> false. +string_p(FlatList) -> + io_lib:printable_list(FlatList). get_utc_config() -> %% SASL utc_log configuration overrides stdlib config @@ -243,16 +227,16 @@ get_utc_config() -> end end. -header(Time, Title) -> +header(Time, Title, M) -> case get_utc_config() of true -> - header(Time, Title, "UTC "); + header(Time, Title, "UTC ", M); _ -> - header(calendar:universal_time_to_local_time(Time), Title, "") + header(calendar:universal_time_to_local_time(Time), Title, "", M) end. -header({{Y,Mo,D},{H,Mi,S}}, Title, UTC) -> - io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ~s===~n", +header({{Y,Mo,D},{H,Mi,S}}, Title, UTC, M) -> + io_lib:format("~n=~"++M++"s==== ~p-~s-~p::~s:~s:~s ~s===~n", [Title,D,month(Mo),Y,t(H),t(Mi),t(S),UTC]). t(X) when is_integer(X) -> @@ -274,3 +258,13 @@ month(9) -> "Sep"; month(10) -> "Oct"; month(11) -> "Nov"; month(12) -> "Dec". + +modifier() -> + modifier(encoding()). +modifier(latin1) -> + ""; +modifier(_) -> + "t". + +encoding() -> + proplists:get_value(encoding,io:getopts(),latin1). diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 2093916a7c..2b9d8ff65b 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -860,7 +860,7 @@ code_handler(Name, Args, Dict, File) -> %% io:format("Calling:~p~n",[{Mod,Name,Args}]), apply(Mod, Name, Args); error -> - io:format("Script does not export ~w/~w\n", [Name,Arity]), + io:format("Script does not export ~tw/~w\n", [Name,Arity]), my_halt(127) end end. diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 898b2f5bba..b5d3cd3c8d 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -1693,7 +1693,7 @@ choice(Height, Width, P, Mode, Tab, Key, Turn, Opos) -> end, choice(Height, Width, P, Mode, Tab, Key, Turn, Opos); [$/|Regexp] -> %% from regexp - case re:compile(nonl(Regexp)) of + case re:compile(nonl(Regexp),[unicode]) of {ok,Re} -> re_search(Height, Width, Tab, ets:first(Tab), Re, 1, 1); {error,{ErrorString,_Pos}} -> diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 32f43fc706..33af0aed8f 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -422,7 +422,7 @@ debug_options(Name, Opts) -> try sys:debug_options(Options) catch _:_ -> error_logger:format( - "~p: ignoring erroneous debug options - ~p~n", + "~tp: ignoring erroneous debug options - ~tp~n", [Name,Options]), [] end; diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index da2b0da3ca..a9b98911e2 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -441,15 +441,15 @@ system_replace_state(StateFun, [ServerName, MSL, HibernateAfterTimeout, Hib]) -> print_event(Dev, {in, Msg}, Name) -> case Msg of {notify, Event} -> - io:format(Dev, "*DBG* ~p got event ~p~n", [Name, Event]); + io:format(Dev, "*DBG* ~tp got event ~tp~n", [Name, Event]); {_,_,{call, Handler, Query}} -> - io:format(Dev, "*DBG* ~p(~p) got call ~p~n", + io:format(Dev, "*DBG* ~tp(~tp) got call ~tp~n", [Name, Handler, Query]); _ -> - io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) + io:format(Dev, "*DBG* ~tp got ~tp~n", [Name, Msg]) end; print_event(Dev, Dbg, Name) -> - io:format(Dev, "*DBG* ~p : ~p~n", [Name, Dbg]). + io:format(Dev, "*DBG* ~tp : ~tp~n", [Name, Dbg]). %% server_add_handler(Handler, Args, MSL) -> {Ret, MSL'}. @@ -582,8 +582,8 @@ server_update(Handler1, Func, Event, SName) -> remove, SName, normal), no; {'EXIT', {undef, [{Mod1, handle_info, [_,_], _}|_]}} -> - error_logger:warning_msg("** Undefined handle_info in ~p~n" - "** Unhandled message: ~p~n", [Mod1, Event]), + error_logger:warning_msg("** Undefined handle_info in ~tp~n" + "** Unhandled message: ~tp~n", [Mod1, Event]), {ok, Handler1}; Other -> do_terminate(Mod1, Handler1, {error, Other}, State, @@ -767,10 +767,10 @@ report_error(Handler, Reason, State, LastIn, SName) -> State end, error_msg("** gen_event handler ~p crashed.~n" - "** Was installed in ~p~n" - "** Last event was: ~p~n" - "** When handler state == ~p~n" - "** Reason == ~p~n", + "** Was installed in ~tp~n" + "** Last event was: ~tp~n" + "** When handler state == ~tp~n" + "** Reason == ~tp~n", [handler(Handler),SName,LastIn,FmtState,Reason1]). handler(Handler) when not Handler#handler.id -> diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 9ef0ca818c..96a53426e2 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -452,30 +452,30 @@ system_replace_state(StateFun, [Name, StateName, StateData, Mod, Time, Hibernate print_event(Dev, {in, Msg}, {Name, StateName}) -> case Msg of {'$gen_event', Event} -> - io:format(Dev, "*DBG* ~p got event ~p in state ~w~n", + io:format(Dev, "*DBG* ~tp got event ~tp in state ~tw~n", [Name, Event, StateName]); {'$gen_all_state_event', Event} -> io:format(Dev, - "*DBG* ~p got all_state_event ~p in state ~w~n", + "*DBG* ~tp got all_state_event ~tp in state ~tw~n", [Name, Event, StateName]); {timeout, Ref, {'$gen_timer', Message}} -> io:format(Dev, - "*DBG* ~p got timer ~p in state ~w~n", + "*DBG* ~tp got timer ~tp in state ~tw~n", [Name, {timeout, Ref, Message}, StateName]); {timeout, _Ref, {'$gen_event', Event}} -> io:format(Dev, - "*DBG* ~p got timer ~p in state ~w~n", + "*DBG* ~tp got timer ~tp in state ~tw~n", [Name, Event, StateName]); _ -> - io:format(Dev, "*DBG* ~p got ~p in state ~w~n", + io:format(Dev, "*DBG* ~tp got ~tp in state ~tw~n", [Name, Msg, StateName]) end; print_event(Dev, {out, Msg, To, StateName}, Name) -> - io:format(Dev, "*DBG* ~p sent ~p to ~w~n" - " and switched to state ~w~n", + io:format(Dev, "*DBG* ~tp sent ~tp to ~tw~n" + " and switched to state ~tw~n", [Name, Msg, To, StateName]); print_event(Dev, return, {Name, StateName}) -> - io:format(Dev, "*DBG* ~p switched to state ~w~n", + io:format(Dev, "*DBG* ~tp switched to state ~tw~n", [Name, StateName]). handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTimeout) -> %No debug here @@ -500,7 +500,7 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTi exit(R); {'EXIT', {undef, [{Mod, handle_info, [_,_,_], _}|_]}} -> error_logger:warning_msg("** Undefined handle_info in ~p~n" - "** Unhandled message: ~p~n", [Mod, Msg]), + "** Unhandled message: ~tp~n", [Mod, Msg]), loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, []); {'EXIT', What} -> terminate(What, Name, Msg, Mod, StateName, StateData, []); @@ -620,29 +620,29 @@ error_info(Reason, Name, Msg, StateName, StateData, Debug) -> _ -> Reason end, - Str = "** State machine ~p terminating \n" ++ + Str = "** State machine ~tp terminating \n" ++ get_msg_str(Msg) ++ - "** When State == ~p~n" - "** Data == ~p~n" - "** Reason for termination = ~n** ~p~n", + "** When State == ~tp~n" + "** Data == ~tp~n" + "** Reason for termination = ~n** ~tp~n", format(Str, [Name, get_msg(Msg), StateName, StateData, Reason1]), sys:print_log(Debug), ok. get_msg_str({'$gen_event', _Event}) -> - "** Last event in was ~p~n"; + "** Last event in was ~tp~n"; get_msg_str({'$gen_sync_event', _Event}) -> - "** Last sync event in was ~p~n"; + "** Last sync event in was ~tp~n"; get_msg_str({'$gen_all_state_event', _Event}) -> - "** Last event in was ~p (for all states)~n"; + "** Last event in was ~tp (for all states)~n"; get_msg_str({'$gen_sync_all_state_event', _Event}) -> - "** Last sync event in was ~p (for all states)~n"; + "** Last sync event in was ~tp (for all states)~n"; get_msg_str({timeout, _Ref, {'$gen_timer', _Msg}}) -> - "** Last timer event in was ~p~n"; + "** Last timer event in was ~tp~n"; get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}) -> - "** Last timer event in was ~p~n"; + "** Last timer event in was ~tp~n"; get_msg_str(_Msg) -> - "** Last message in was ~p~n". + "** Last message in was ~tp~n". get_msg({'$gen_event', Event}) -> Event; get_msg({'$gen_sync_event', Event}) -> Event; diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index a3d53efd0d..ac172325b5 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -116,23 +116,27 @@ %%%========================================================================= -callback init(Args :: term()) -> - {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate | {continue, term()}} | {stop, Reason :: term()} | ignore. -callback handle_call(Request :: term(), From :: {pid(), Tag :: term()}, State :: term()) -> {reply, Reply :: term(), NewState :: term()} | - {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | + {reply, Reply :: term(), NewState :: term(), timeout() | hibernate | {continue, term()}} | {noreply, NewState :: term()} | - {noreply, NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} | {stop, Reason :: term(), Reply :: term(), NewState :: term()} | {stop, Reason :: term(), NewState :: term()}. -callback handle_cast(Request :: term(), State :: term()) -> {noreply, NewState :: term()} | - {noreply, NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} | {stop, Reason :: term(), NewState :: term()}. -callback handle_info(Info :: timeout | term(), State :: term()) -> {noreply, NewState :: term()} | - {noreply, NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_continue(Info :: term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} | {stop, Reason :: term(), NewState :: term()}. -callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | term()), @@ -149,7 +153,7 @@ Status :: term(). -optional_callbacks( - [handle_info/2, terminate/2, code_change/3, format_status/2]). + [handle_info/2, handle_continue/2, terminate/2, code_change/3, format_status/2]). %%% ----------------------------------------------------------------- %%% Starts a generic server. @@ -309,7 +313,7 @@ enter_loop(Mod, Options, State, ServerName, Timeout) -> Name = gen:get_proc_name(ServerName), Parent = gen:get_parent(), Debug = gen:debug_options(Name, Options), - HibernateAfterTimeout = gen:hibernate_after(Options), + HibernateAfterTimeout = gen:hibernate_after(Options), loop(Parent, Name, State, Mod, Timeout, HibernateAfterTimeout, Debug). %%%======================================================================== @@ -374,6 +378,19 @@ init_it(Mod, Args) -> %%% --------------------------------------------------- %%% The MAIN loop. %%% --------------------------------------------------- + +loop(Parent, Name, State, Mod, {continue, Continue} = Msg, HibernateAfterTimeout, Debug) -> + Reply = try_dispatch(Mod, handle_continue, Continue, State), + case Debug of + [] -> + handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, + HibernateAfterTimeout, State); + _ -> + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, Msg), + handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, + HibernateAfterTimeout, State, Debug1) + end; + loop(Parent, Name, State, Mod, hibernate, HibernateAfterTimeout, Debug) -> proc_lib:hibernate(?MODULE,wake_hib,[Parent, Name, State, Mod, HibernateAfterTimeout, Debug]); @@ -621,7 +638,7 @@ try_dispatch(Mod, Func, Msg, State) -> case erlang:function_exported(Mod, handle_info, 2) of false -> error_logger:warning_msg("** Undefined handle_info in ~p~n" - "** Unhandled message: ~p~n", + "** Unhandled message: ~tp~n", [Mod, Msg]), {ok, {noreply, State}}; true -> @@ -785,21 +802,21 @@ system_replace_state(StateFun, [Name, State, Mod, Time, HibernateAfterTimeout]) print_event(Dev, {in, Msg}, Name) -> case Msg of {'$gen_call', {From, _Tag}, Call} -> - io:format(Dev, "*DBG* ~p got call ~p from ~w~n", + io:format(Dev, "*DBG* ~tp got call ~tp from ~w~n", [Name, Call, From]); {'$gen_cast', Cast} -> - io:format(Dev, "*DBG* ~p got cast ~p~n", + io:format(Dev, "*DBG* ~tp got cast ~tp~n", [Name, Cast]); _ -> - io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) + io:format(Dev, "*DBG* ~tp got ~tp~n", [Name, Msg]) end; print_event(Dev, {out, Msg, To, State}, Name) -> - io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", + io:format(Dev, "*DBG* ~tp sent ~tp to ~w, new state ~tp~n", [Name, Msg, To, State]); print_event(Dev, {noreply, State}, Name) -> - io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); + io:format(Dev, "*DBG* ~tp new state ~tp~n", [Name, State]); print_event(Dev, Event, Name) -> - io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). + io:format(Dev, "*DBG* ~tp dbg ~tp~n", [Name, Event]). %%% --------------------------------------------------- @@ -881,10 +898,10 @@ error_info(Reason, Name, From, Msg, State, Debug) -> end, {ClientFmt, ClientArgs} = client_stacktrace(From), LimitedState = error_logger:limit_term(State), - error_logger:format("** Generic server ~p terminating \n" - "** Last message in was ~p~n" - "** When Server state == ~p~n" - "** Reason for termination == ~n** ~p~n" ++ ClientFmt, + error_logger:format("** Generic server ~tp terminating \n" + "** Last message in was ~tp~n" + "** When Server state == ~tp~n" + "** Reason for termination == ~n** ~tp~n" ++ ClientFmt, [Name, Msg, LimitedState, Reason1] ++ ClientArgs), sys:print_log(Debug), ok. @@ -898,11 +915,11 @@ client_stacktrace(From) when is_pid(From), node(From) =:= node() -> {"** Client ~p is dead~n", [From]}; [{current_stacktrace, Stacktrace}, {registered_name, []}] -> {"** Client ~p stacktrace~n" - "** ~p~n", + "** ~tp~n", [From, Stacktrace]}; [{current_stacktrace, Stacktrace}, {registered_name, Name}] -> - {"** Client ~p stacktrace~n" - "** ~p~n", + {"** Client ~tp stacktrace~n" + "** ~tp~n", [Name, Stacktrace]} end; client_stacktrace(From) when is_pid(From) -> diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index b5e9da1e66..1110d18af6 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -791,34 +791,34 @@ format_status( print_event(Dev, {in,Event}, {Name,State}) -> io:format( - Dev, "*DBG* ~p receive ~s in state ~p~n", + Dev, "*DBG* ~tp receive ~ts in state ~tp~n", [Name,event_string(Event),State]); print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) -> io:format( - Dev, "*DBG* ~p send ~p to ~p from state ~p~n", + Dev, "*DBG* ~tp send ~tp to ~p from state ~tp~n", [Name,Reply,To,State]); print_event(Dev, {terminate,Reason}, {Name,State}) -> io:format( - Dev, "*DBG* ~p terminate ~p in state ~p~n", + Dev, "*DBG* ~tp terminate ~tp in state ~tp~n", [Name,Reason,State]); print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> StateString = case NextState of State -> - io_lib:format("~p", [State]); + io_lib:format("~tp", [State]); _ -> - io_lib:format("~p => ~p", [State,NextState]) + io_lib:format("~tp => ~tp", [State,NextState]) end, io:format( - Dev, "*DBG* ~p ~w ~s in state ~s~n", + Dev, "*DBG* ~tp ~tw ~ts in state ~ts~n", [Name,Tag,event_string(Event),StateString]). event_string(Event) -> case Event of {{call,{Pid,_Tag}},Request} -> - io_lib:format("call ~p from ~w", [Request,Pid]); + io_lib:format("call ~tp from ~w", [Request,Pid]); {EventType,EventContent} -> - io_lib:format("~w ~p", [EventType,EventContent]) + io_lib:format("~tw ~tp", [EventType,EventContent]) end. sys_debug(Debug, #{name := Name}, State, Entry) -> @@ -1732,25 +1732,25 @@ error_info( CallbackMode end, error_logger:format( - "** State machine ~p terminating~n" ++ + "** State machine ~tp terminating~n" ++ case Q of [] -> ""; - _ -> "** Last event = ~p~n" + _ -> "** Last event = ~tp~n" end ++ - "** When server state = ~p~n" ++ - "** Reason for termination = ~w:~p~n" ++ + "** When server state = ~tp~n" ++ + "** Reason for termination = ~w:~tp~n" ++ "** Callback mode = ~p~n" ++ case Q of - [_,_|_] -> "** Queued = ~p~n"; + [_,_|_] -> "** Queued = ~tp~n"; _ -> "" end ++ case P of [] -> ""; - _ -> "** Postponed = ~p~n" + _ -> "** Postponed = ~tp~n" end ++ case FixedStacktrace of [] -> ""; - _ -> "** Stacktrace =~n** ~p~n" + _ -> "** Stacktrace =~n** ~tp~n" end, [Name | case Q of diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 8933eb01b5..c59db903dc 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -63,9 +63,9 @@ obsolete_1(gen_fsm, start, 4) -> {deprecated, {gen_statem, start, 4}}; obsolete_1(gen_fsm, start_link, 3) -> - {deprecated, {gen_statem, start, 3}}; + {deprecated, {gen_statem, start_link, 3}}; obsolete_1(gen_fsm, start_link, 4) -> - {deprecated, {gen_statem, start, 4}}; + {deprecated, {gen_statem, start_link, 4}}; obsolete_1(gen_fsm, stop, 1) -> {deprecated, {gen_statem, stop, 1}}; @@ -83,9 +83,9 @@ obsolete_1(gen_fsm, reply, 2) -> {deprecated, {gen_statem, reply, 2}}; obsolete_1(gen_fsm, send_event, 2) -> - {deprecated, {gen_statem, cast, 1}}; + {deprecated, {gen_statem, cast, 2}}; obsolete_1(gen_fsm, send_all_state_event, 2) -> - {deprecated, {gen_statem, cast, 1}}; + {deprecated, {gen_statem, cast, 2}}; obsolete_1(gen_fsm, sync_send_event, 2) -> {deprecated, {gen_statem, call, 2}}; @@ -98,11 +98,11 @@ obsolete_1(gen_fsm, sync_send_all_state_event, 3) -> {deprecated, {gen_statem, call, 3}}; obsolete_1(gen_fsm, start_timer, 2) -> - {deprecated, {erlang, start_timer, 2}}; + {deprecated, {erlang, start_timer, 3}}; obsolete_1(gen_fsm, cancel_timer, 1) -> {deprecated, {erlang, cancel_timer, 1}}; obsolete_1(gen_fsm, send_event_after, 2) -> - {deprecated, {erlang, send_after, 2}}; + {deprecated, {erlang, send_after, 3}}; %% *** CRYPTO added in OTP 20 *** @@ -485,10 +485,6 @@ obsolete_1(wxPaintDC, new, 0) -> {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; obsolete_1(wxWindowDC, new, 0) -> {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxGraphicsContext, createLinearGradientBrush, 7) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxGraphicsContext, createRadialGradientBrush, 8) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; obsolete_1(wxGraphicsRenderer, createLinearGradientBrush, 7) -> {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; obsolete_1(wxGraphicsRenderer, createRadialGradientBrush, 8) -> diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index d4d1bdccec..8e10cbe93b 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -823,22 +823,22 @@ to_string(A, _) -> io_lib:write_atom(A). pp_fun({Enc,Depth}) -> - {Letter,Tl} = case Depth of - unlimited -> {"p",[]}; - _ -> {"P",[Depth]} - end, - P = modifier(Enc) ++ Letter, + {P,Tl} = p(Enc, Depth), fun(Term, I) -> io_lib:format("~." ++ integer_to_list(I) ++ P, [Term|Tl]) end. -format_tag(Indent, Tag, Data, {_Enc,Depth}) -> - case Depth of - unlimited -> - io_lib:format("~s~p: ~80.18p~n", [Indent, Tag, Data]); - _ -> - io_lib:format("~s~p: ~80.18P~n", [Indent, Tag, Data, Depth]) - end. +format_tag(Indent, Tag, Data, {Enc,Depth}) -> + {P,Tl} = p(Enc, Depth), + io_lib:format("~s~p: ~80.18" ++ P ++ "\n", [Indent, Tag, Data|Tl]). + +p(Encoding, Depth) -> + {Letter, Tl} = case Depth of + unlimited -> {"p", []}; + _ -> {"P", [Depth]} + end, + P = modifier(Encoding) ++ Letter, + {P, Tl}. modifier(latin1) -> ""; modifier(_) -> "t". diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 535ca57a6b..f11f9d0a0b 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1132,7 +1132,7 @@ wait_for_request(Parent, MonRef, Post) -> wait_for_request(Parent, MonRef, Post); Other -> error_logger:error_msg( - "The qlc cursor ~w received an unexpected message:\n~p\n", + "The qlc cursor ~w received an unexpected message:\n~tp\n", [self(), Other]), wait_for_request(Parent, MonRef, Post) end. diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 26b3960f4f..212b143b1d 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1459,7 +1459,7 @@ check_env(V) -> {ok, Val} -> Txt = io_lib:fwrite ("Invalid value of STDLIB configuration parameter" - "~w: ~tp\n", [V, Val]), + "~tw: ~tp\n", [V, Val]), error_logger:info_report(lists:flatten(Txt)) end. diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index 5b5c328c0c..d7cf6386f5 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -77,7 +77,7 @@ start_pseudo(_,_,_) -> ok. %% It's already there Pid :: pid(). relay({badrpc,Reason}) -> - error_msg(" ** exiting relay server ~w :~w **~n", [self(),Reason]), + error_msg(" ** exiting relay server ~w :~tw **~n", [self(),Reason]), exit(Reason); relay(undefined) -> error_msg(" ** exiting relay server ~w **~n", [self()]), diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 1cd65fbf18..7920e55930 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -628,7 +628,7 @@ handle_info({'EXIT', Pid, Reason}, State) -> end; handle_info(Msg, State) -> - error_logger:error_msg("Supervisor received unexpected message: ~p~n", + error_logger:error_msg("Supervisor received unexpected message: ~tp~n", [Msg]), {noreply, State}. diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 72211332e9..7b79dcf04d 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -36,6 +36,7 @@ MODULES= \ ets_tough_SUITE \ expand_test \ expand_test1 \ + unicode_expand \ ExpandTestCaps \ ExpandTestCaps1 \ filelib_SUITE \ diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl index 1f694ea549..5c2b1965ba 100644 --- a/lib/stdlib/test/edlin_expand_SUITE.erl +++ b/lib/stdlib/test/edlin_expand_SUITE.erl @@ -22,7 +22,7 @@ init_per_testcase/2, end_per_testcase/2, init_per_group/2,end_per_group/2]). -export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1, - erl_352/1]). + erl_352/1, unicode/1]). -include_lib("common_test/include/ct.hrl"). @@ -37,7 +37,8 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [normal, quoted_fun, quoted_module, quoted_both, erl_1152, erl_352]. + [normal, quoted_fun, quoted_module, quoted_both, erl_1152, erl_352, + unicode]. groups() -> []. @@ -150,6 +151,7 @@ quoted_both(Config) when is_list(Config) -> {yes,"weird-fun-name'()",[]} = do_expand("'ExpandTestCaps1':'#"), ok. +%% Note: pull request #1152. erl_1152(Config) when is_list(Config) -> "\n"++"foo"++" "++[1089]++_ = do_format(["foo",[1089]]), ok. @@ -226,6 +228,26 @@ check_trailing([I|Str], ArityStr, Suffix, Dots) -> Rest =:= Suffix end. +unicode(Config) when is_list(Config) -> + {module,unicode_expand} = c:l('unicode_expand'), + {no,[],[{"'кlирилли́ческий атом'",0}, + {"'кlирилли́ческий атом'",1}, + {"'кlирилли́ческий атомB'",1}, + {"module_info",0}, + {"module_info",1}]} = do_expand("unicode_expand:"), + {yes,"рилли́ческий атом", []} = do_expand("unicode_expand:'кlи"), + {yes,"еский атом", []} = do_expand("unicode_expand:'кlирилли́ч"), + {yes,"(",[]} = do_expand("unicode_expand:'кlирилли́ческий атомB'"), + "\n'кlирилли́ческий атом'/0 'кlирилли́ческий атом'/1 " + "'кlирилли́ческий атомB'/1 \nmodule_info/0 " + "module_info/1 \n" = + do_format([{"'кlирилли́ческий атом'",0}, + {"'кlирилли́ческий атом'",1}, + {"'кlирилли́ческий атомB'",1}, + {"module_info",0}, + {"module_info",1}]), + ok. + do_expand(String) -> edlin_expand:expand(lists:reverse(String)). diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl index 789a9d4363..7d9df1f989 100644 --- a/lib/stdlib/test/erl_internal_SUITE.erl +++ b/lib/stdlib/test/erl_internal_SUITE.erl @@ -80,7 +80,7 @@ callbacks(application) -> callbacks(gen_server) -> [{init,1}, {handle_call,3}, {handle_cast,2}, {handle_info,2}, {terminate,2}, {code_change,3}, - {format_status,2}]; + {format_status,2}, {handle_continue, 2}]; callbacks(gen_fsm) -> [{init,1}, {handle_event,3}, {handle_sync_event,4}, {handle_info,3}, {terminate,3}, {code_change,4}, @@ -101,7 +101,7 @@ callbacks(supervisor) -> optional_callbacks(application) -> []; optional_callbacks(gen_server) -> - [{handle_info, 2}, {terminate, 2}, {code_change, 3}, {format_status, 2}]; + [{handle_info, 2}, {handle_continue, 2}, {terminate, 2}, {code_change, 3}, {format_status, 2}]; optional_callbacks(gen_fsm) -> [{handle_info, 3}, {terminate, 3}, {code_change, 4}, {format_status, 2}]; optional_callbacks(gen_event) -> diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index cb1cceb8db..b76bece07f 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -4104,7 +4104,27 @@ get_stacktrace(Config) -> [], {warnings,[{4,erl_lint,{get_stacktrace,wrong_part_of_try}}, {13,erl_lint,{get_stacktrace,after_try}}, - {22,erl_lint,{get_stacktrace,after_try}}]}}], + {22,erl_lint,{get_stacktrace,after_try}}]}}, + {multiple_catch_clauses, + <<"maybe_error(Arg) -> + try 5 / Arg + catch + error:badarith -> + _Stacktrace = erlang:get_stacktrace(), + try io:nl() + catch + error:_ -> io:format('internal error') + end; + error:badarg -> + _Stacktrace = erlang:get_stacktrace(), + try io:format(qwe) + catch + error:_ -> io:format('internal error') + end + end. + ">>, + [], + []}], run(Config, Ts), ok. diff --git a/lib/stdlib/test/error_logger_h_SUITE.erl b/lib/stdlib/test/error_logger_h_SUITE.erl index 30f96e0522..1f2a9fda0b 100644 --- a/lib/stdlib/test/error_logger_h_SUITE.erl +++ b/lib/stdlib/test/error_logger_h_SUITE.erl @@ -162,7 +162,7 @@ tty_log_open(Log) -> {ok,D} -> D; _ -> unlimited end, - error_logger:add_report_handler(?MODULE, {Fd,Depth}), + error_logger:add_report_handler(?MODULE, {Fd,Depth,latin1}), Fd. tty_log_close() -> @@ -393,11 +393,11 @@ dl_format_1([], [], _, Facc, Aacc) -> %%% calling error_logger_tty_h:write_event/2. %%% -init({_,_}=St) -> +init({_,_,_}=St) -> {ok,St}. -handle_event(Event, {Fd,Depth}=St) -> - case error_logger_tty_h:write_event(tag_event(Event), io_lib, Depth) of +handle_event(Event, {Fd,Depth,Enc}=St) -> + case error_logger_tty_h:write_event(tag_event(Event), io_lib, {Depth,Enc}) of ok -> ok; Str when is_list(Str) -> @@ -405,7 +405,7 @@ handle_event(Event, {Fd,Depth}=St) -> end, {ok,St}. -terminate(_Reason, {Fd,_}) -> +terminate(_Reason, {Fd,_,_}) -> ok = file:close(Fd), []. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 2e9dc4d4fb..2bc220fef2 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -27,7 +27,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([start/1, crash/1, call/1, cast/1, cast_fast/1, - info/1, abcast/1, multicall/1, multicall_down/1, + continue/1, info/1, abcast/1, multicall/1, multicall_down/1, call_remote1/1, call_remote2/1, call_remote3/1, call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1, spec_init_local_registered_parent/1, @@ -37,7 +37,8 @@ get_state/1, replace_state/1, call_with_huge_message_queue/1, undef_handle_call/1, undef_handle_cast/1, undef_handle_info/1, undef_init/1, undef_code_change/1, undef_terminate1/1, - undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1 + undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1, + undef_handle_continue/1 ]). -export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1, @@ -52,7 +53,7 @@ %% The gen_server behaviour --export([init/1, handle_call/3, handle_cast/2, +-export([init/1, handle_call/3, handle_cast/2, handle_continue/2, handle_info/2, code_change/3, terminate/2, format_status/2]). suite() -> @@ -61,7 +62,7 @@ suite() -> all() -> [start, {group,stop}, crash, call, cast, cast_fast, info, abcast, - multicall, multicall_down, call_remote1, call_remote2, + continue, multicall, multicall_down, call_remote1, call_remote2, call_remote3, call_remote_n1, call_remote_n2, call_remote_n3, spec_init, spec_init_local_registered_parent, @@ -76,7 +77,7 @@ groups() -> [{stop, [], [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}, {undef_callbacks, [], - [undef_handle_call, undef_handle_cast, undef_handle_info, + [undef_handle_call, undef_handle_cast, undef_handle_info, undef_handle_continue, undef_init, undef_code_change, undef_terminate1, undef_terminate2]}]. @@ -458,6 +459,47 @@ call(Config) when is_list(Config) -> ok. %% -------------------------------------- +%% Test handle_continue. +%% -------------------------------------- + +continue(Config) when is_list(Config) -> + {ok, Pid} = gen_server:start_link(gen_server_SUITE, {continue, self()}, []), + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + gen_server:call(Pid, {continue_reply, self()}), + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + gen_server:call(Pid, {continue_noreply, self()}), + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + gen_server:cast(Pid, {continue_noreply, self()}), + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + Pid ! {continue_noreply, self()}, + [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + Pid ! {continue_continue, self()}, + [{Pid, before_continue}, {Pid, continue}, {Pid, after_continue}] = read_replies(Pid), + + Ref = monitor(process, Pid), + Pid ! continue_stop, + verify_down_reason(Ref, Pid, normal). + +read_replies(Pid) -> + receive + {Pid, ack} -> read_replies() + after + 1000 -> ct:fail({continue, ack}) + end. + +read_replies() -> + receive + Msg -> [Msg | read_replies()] + after + 0 -> [] + end. + +%% -------------------------------------- %% Test call to nonexisting processes on remote nodes %% -------------------------------------- @@ -1346,7 +1388,7 @@ echo_loop() -> %% Test the default implementation of terminate if the callback module %% does not export it undef_terminate1(Config) when is_list(Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), MRef = monitor(process, Server), ok = gen_server:stop(Server), ok = verify_down_reason(MRef, Server, normal). @@ -1354,7 +1396,7 @@ undef_terminate1(Config) when is_list(Config) -> %% Test the default implementation of terminate if the callback module %% does not export it undef_terminate2(Config) when is_list(Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), MRef = monitor(process, Server), ok = gen_server:stop(Server, {error, test}, infinity), ok = verify_down_reason(MRef, Server, {error, test}). @@ -1377,7 +1419,7 @@ undef_init(_Config) -> %% The upgrade should fail if code_change is expected in the callback module %% but not exported, but the server should continue with the old code undef_code_change(Config) when is_list(Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), {error, {'EXIT', {undef, [{oc_server, code_change, [_, _, _], _}|_]}}} = fake_upgrade(Server, ?MODULE), true = is_process_alive(Server). @@ -1385,7 +1427,7 @@ undef_code_change(Config) when is_list(Config) -> %% The server should crash if the handle_call callback is %% not exported in the callback module undef_handle_call(_Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), try gen_server:call(Server, call_msg), ct:fail(should_crash) @@ -1397,17 +1439,25 @@ undef_handle_call(_Config) -> %% The server should crash if the handle_cast callback is %% not exported in the callback module undef_handle_cast(_Config) -> - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), MRef = monitor(process, Server), gen_server:cast(Server, cast_msg), verify_undef_down(MRef, Server, oc_server, handle_cast), ok. +%% The server should crash if the handle_continue callback is +%% not exported in the callback module +undef_handle_continue(_Config) -> + {ok, Server} = oc_server:start(continue), + MRef = monitor(process, Server), + verify_undef_down(MRef, Server, oc_server, handle_continue), + ok. + %% The server should log but not crash if the handle_info callback is %% calling an undefined function undef_handle_info(Config) when is_list(Config) -> error_logger_forwarder:register(), - {ok, Server} = gen_server:start(oc_server, [], []), + {ok, Server} = oc_server:start(), Server ! hej, wait_until_processed(Server, hej, 10), true = is_process_alive(Server), @@ -1570,8 +1620,11 @@ init(hibernate) -> init(sleep) -> ct:sleep(1000), {ok, []}; +init({continue, Pid}) -> + self() ! {after_continue, Pid}, + {ok, [], {continue, {message, Pid}}}; init({state,State}) -> - {ok, State}. + {ok,State}. handle_call(started_p, _From, State) -> io:format("FROZ"), @@ -1604,6 +1657,12 @@ handle_call(shutdown_reason, _From, _State) -> handle_call({call_undef_fun, Mod, Fun}, _From, State) -> Mod:Fun(), {reply, ok, State}; +handle_call({continue_reply, Pid}, _From, State) -> + self() ! {after_continue, Pid}, + {reply, ok, State, {continue, {message, Pid}}}; +handle_call({continue_noreply, Pid}, From, State) -> + self() ! {after_continue, Pid}, + {noreply, State, {continue, {message, Pid, From}}}; handle_call(stop_shutdown_reason, _From, State) -> {stop,{shutdown,stop_reason},State}. @@ -1620,6 +1679,9 @@ handle_cast(hibernate_later, _State) -> handle_cast({call_undef_fun, Mod, Fun}, State) -> Mod:Fun(), {noreply, State}; +handle_cast({continue_noreply, Pid}, State) -> + self() ! {after_continue, Pid}, + {noreply, State, {continue, {message, Pid}}}; handle_cast({From, stop}, State) -> io:format("BAZ"), {stop, {From,stopped}, State}. @@ -1657,9 +1719,34 @@ handle_info(continue, From) -> {noreply, []}; handle_info({From, stop}, State) -> {stop, {From,stopped_info}, State}; +handle_info({after_continue, Pid}, State) -> + Pid ! {self(), after_continue}, + Pid ! {self(), ack}, + {noreply, State}; +handle_info({continue_noreply, Pid}, State) -> + self() ! {after_continue, Pid}, + {noreply, State, {continue, {message, Pid}}}; +handle_info({continue_continue, Pid}, State) -> + {noreply, State, {continue, {continue, Pid}}}; +handle_info(continue_stop, State) -> + {noreply, State, {continue, stop}}; handle_info(_Info, State) -> {noreply, State}. +handle_continue({continue, Pid}, State) -> + Pid ! {self(), before_continue}, + self() ! {after_continue, Pid}, + {noreply, State, {continue, {message, Pid}}}; +handle_continue(stop, State) -> + {stop, normal, State}; +handle_continue({message, Pid}, State) -> + Pid ! {self(), continue}, + {noreply, State}; +handle_continue({message, Pid, From}, State) -> + Pid ! {self(), continue}, + gen_server:reply(From, ok), + {noreply, State}. + code_change(_OldVsn, {new, {undef_in_code_change, {Mod, Fun}}} = State, _Extra) -> diff --git a/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl b/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl index 4ba37987f3..7b92a49bf6 100644 --- a/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl +++ b/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl @@ -22,7 +22,7 @@ -behaviour(gen_server). %% API --export([start/0]). +-export([start/0, start/1]). %% gen_server callbacks -export([init/1]). @@ -30,8 +30,12 @@ -record(state, {}). start() -> - gen_server:start({local, ?MODULE}, ?MODULE, [], []). + gen_server:start(?MODULE, ok, []). -init([]) -> - {ok, #state{}}. +start(continue) -> + gen_server:start(?MODULE, continue, []). +init(ok) -> + {ok, #state{}}; +init(continue) -> + {ok, #state{}, {continue, continue}}. diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index c4fafe82a4..7686889360 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -552,14 +552,17 @@ t_format(_Config) -> t_format() -> error_logger:add_report_handler(?MODULE, self()), - Pid = proc_lib:spawn(fun t_format_looper/0), + Pid = proc_lib:spawn(fun '\x{aaa}t_format_looper'/0), HugeData = gb_sets:from_list(lists:seq(1, 100)), - Pid ! {die,HugeData}, + SomeData1 = list_to_atom([246]), + SomeData2 = list_to_atom([1024]), + Pid ! {SomeData1,SomeData2}, + Pid ! {die,{HugeData,SomeData1,SomeData2}}, Report = receive {crash_report, Pid, Report0} -> Report0 end, - Usz = do_test_format(Report, unlimited), - Tsz = do_test_format(Report, 20), + Usz = do_test_format(Report, latin1, unlimited), + Tsz = do_test_format(Report, latin1, 20), if Tsz >= Usz -> @@ -568,6 +571,16 @@ t_format() -> ok end, + UszU = do_test_format(Report, unicode, unlimited), + TszU = do_test_format(Report, unicode, 20), + + if + TszU >= UszU -> + ct:fail(failed); + true -> + ok + end, + ok. t_format_arbitrary(_Config) -> @@ -597,15 +610,19 @@ do_test_format(Report, Encoding, Depth) -> io:format("*** Depth = ~p, Encoding = ~p", [Depth, Encoding]), S0 = proc_lib:format(Report, Encoding, Depth), S = lists:flatten(S0), - io:put_chars(S), + case Encoding of + latin1 -> io:format("~s\n", [S]); + _ -> io:format("~ts\n", [S]) + end, length(S). -t_format_looper() -> +'\x{aaa}t_format_looper'() -> receive {die,Data} -> exit(Data); - _ -> - t_format_looper() + M -> + put(M, M), + '\x{aaa}t_format_looper'() end. %%----------------------------------------------------------------- diff --git a/lib/stdlib/test/re_SUITE_data/testoutput1 b/lib/stdlib/test/re_SUITE_data/testoutput1 index a2b3cffe9d..eff8ecc948 100644 --- a/lib/stdlib/test/re_SUITE_data/testoutput1 +++ b/lib/stdlib/test/re_SUITE_data/testoutput1 @@ -9442,4 +9442,8 @@ No match \ X 0: X +/X+(?#comment)?/ + >XXX< + 0: X + /-- End of testinput1 --/ diff --git a/lib/stdlib/test/re_SUITE_data/testoutput8 b/lib/stdlib/test/re_SUITE_data/testoutput8 index 17b667a980..4984376d3c 100644 --- a/lib/stdlib/test/re_SUITE_data/testoutput8 +++ b/lib/stdlib/test/re_SUITE_data/testoutput8 @@ -7801,4 +7801,8 @@ No match ** Show all captures ignored after DFA matching 0: a +/(02-)?[0-9]{3}-[0-9]{3}/ + 02-123-123 + 0: 02-123-123 + /-- End of testinput8 --/ diff --git a/lib/stdlib/test/unicode_expand.erl b/lib/stdlib/test/unicode_expand.erl new file mode 100644 index 0000000000..41f741fa84 --- /dev/null +++ b/lib/stdlib/test/unicode_expand.erl @@ -0,0 +1,36 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(unicode_expand). + +-export(['кlирилли́ческий атом'/0, 'кlирилли́ческий атом'/1, + 'кlирилли́ческий атомB'/1]). + +-export_type(['кlирилли́ческий атом'/0]). + +-type 'кlирилли́ческий атом'() :: integer(). + +'кlирилли́ческий атом'() -> + 'кlирилли́ческий атом'('кlирилли́ческий атом'). + +'кlирилли́ческий атом'(_Atom) -> + ok. + +'кlирилли́ческий атомB'(_B) -> + true. diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index cf1ba0abfa..0a12e8fd8b 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -866,10 +866,10 @@ tokens_to_string([]) -> format_error(macro_args) -> errormsg("macro call missing end parenthesis"); format_error({unknown, Reason}) -> - errormsg(io_lib:format("unknown error: ~P", [Reason, 15])). + errormsg(io_lib:format("unknown error: ~tP", [Reason, 15])). errormsg(String) -> - io_lib:format("~s: ~s", [?MODULE, String]). + io_lib:format("~s: ~ts", [?MODULE, String]). %% ===================================================================== diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index a7a2c10b79..07e501e553 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -309,7 +309,7 @@ filename([C|T]) when is_integer(C), C > 0 -> filename([]) -> []; filename(N) -> - report_error("bad filename: `~P'.", [N, 25]), + report_error("bad filename: `~tP'.", [N, 25]), exit(error). error_read_file(Name) -> diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index 888cb71f51..5623aa6af3 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -193,7 +193,7 @@ dir_3(Name, Dir, Regexp, Env) -> dir_1(Dir1, Regexp, Env). dir_4(File, Regexp, Env) -> - case re:run(File, Regexp) of + case re:run(File, Regexp, [unicode]) of {match, _} -> Opts = [{outfile, File}, {dir, ""} | Env#dir.options], case catch file(File, Opts) of @@ -805,7 +805,7 @@ keep_form(Form, Used, Opts) -> {F, A} = N, File = proplists:get_value(file, Opts, ""), report({File, erl_syntax:get_pos(Form), - "removing unused function `~w/~w'."}, + "removing unused function `~tw/~w'."}, [F, A], Opts), false; true -> @@ -870,8 +870,8 @@ update_attribute(F, Imports, Opts) -> Names -> File = proplists:get_value(file, Opts, ""), report({File, erl_syntax:get_pos(F), - "removing unused imports:~s"}, - [[io_lib:fwrite("\n\t`~w:~w/~w'", [M, N, A]) + "removing unused imports:~ts"}, + [[io_lib:fwrite("\n\t`~w:~tw/~w'", [M, N, A]) || {N, A} <- Names]], Opts) end, Is = [make_fname(N) || N <- Ns1], @@ -1166,7 +1166,7 @@ visit_import_application({N, A} = Name, F, As, Tree, Env, St0) -> case Expand of true -> report({Env#env.file, erl_syntax:get_pos(F), - "expanding call to imported function `~w:~w/~w'."}, + "expanding call to imported function `~w:~tw/~w'."}, [M, N, A], Env#env.verbosity), F1 = erl_syntax:module_qualifier(erl_syntax:atom(M), erl_syntax:atom(N)), @@ -1220,7 +1220,7 @@ visit_spawn_call({N, A}, F, Ps, [A1, A2, A3] = As, Tree, case erl_syntax:is_proper_list(A3) of true -> report({Env#env.file, erl_syntax:get_pos(F), - "changing use of `~w/~w' to `~w/~w' with a fun."}, + "changing use of `~tw/~w' to `~tw/~w' with a fun."}, [N, A, N, 1 + length(Ps)], Env#env.verbosity), F1 = case erl_syntax:is_atom(A1, Env#env.module) of true -> @@ -1404,8 +1404,8 @@ visit_remote_application({M, N, A} = Name, F, As, Tree, Env, St) -> case rename_remote_call(Name, St) of {M1, N1} -> report({Env#env.file, erl_syntax:get_pos(F), - "updating obsolete call to `~w:~w/~w' " - "to use `~w:~w/~w' instead."}, + "updating obsolete call to `~w:~tw/~w' " + "to use `~w:~tw/~w' instead."}, [M, N, A, M1, N1, A], Env#env.verbosity), M2 = erl_syntax:atom(M1), N2 = erl_syntax:atom(N1), @@ -1820,7 +1820,7 @@ filename([]) -> filename(N) when is_atom(N) -> atom_to_list(N); filename(N) -> - report_error("bad filename: `~P'.", [N, 25]), + report_error("bad filename: `~tP'.", [N, 25]), exit(error). get_env(Tree) -> @@ -1911,11 +1911,11 @@ format({warning, D}, Vs) -> format({recommend, D}, Vs) -> ["recommendation: ", format(D, Vs)]; format({"", L, D}, Vs) when is_integer(L), L > 0 -> - [io_lib:fwrite("~w: ", [L]), format(D, Vs)]; + [io_lib:fwrite("~tw: ", [L]), format(D, Vs)]; format({"", _L, D}, Vs) -> format(D, Vs); format({F, L, D}, Vs) when is_integer(L), L > 0 -> - [io_lib:fwrite("~ts:~w: ", [filename(F), L]), format(D, Vs)]; + [io_lib:fwrite("~ts:~tw: ", [filename(F), L]), format(D, Vs)]; format({F, _L, D}, Vs) -> [io_lib:fwrite("~ts: ", [filename(F)]), format(D, Vs)]; format(S, Vs) when is_list(S) -> diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index b92cd8d607..16e3511734 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -834,7 +834,7 @@ merge_sources_1(Name, Modules, Trees, Opts) -> dict:from_list(Rs); false -> report_error("bad value for `redirect' option: " - "~P.", + "~tP.", [Rs, 10]), exit(error) end, @@ -1069,7 +1069,7 @@ filter_forms_2(Forms, Env) -> comment -> kill; _ -> report_error("invalid value for option " - "`file_attributes': ~w.", + "`file_attributes': ~tw.", [FileAttrsOpt]), exit(error) end, @@ -1180,7 +1180,7 @@ merge_namespaces(Modules, Env) -> [] -> ok; Fs -> - report_warning("interface functions renamed:\n\t~p.", [Fs]) + report_warning("interface functions renamed:\n\t~tp.", [Fs]) end, {M4, Acc2} = merge_namespaces_1(M2, Acc1), Ms = M3 ++ M4, @@ -1778,7 +1778,7 @@ transform_function(T, Env, St) -> {maybe_modified(V, T1, 2, Text, Env), St1}. renaming_note(Name) -> - [lists:flatten(io_lib:fwrite("renamed function to `~w'", + [lists:flatten(io_lib:fwrite("renamed function to `~tw'", [Name]))]. rename_atom(Node, Atom) -> @@ -2488,7 +2488,7 @@ rename(Files, Renamings, Opts) -> true -> dict:from_list(Renamings); false -> - report_error("bad module renaming: ~P.", + report_error("bad module renaming: ~tP.", [Renamings, 10]), exit(error) end, @@ -2672,7 +2672,7 @@ error_text(D, Name) -> end. error_text_1(D, Name) -> - io_lib:fwrite("error: `~w', ~P.", [Name, D, 15]). + io_lib:fwrite("error: `~w', ~tP.", [Name, D, 15]). check_records(Rs, Name) -> case duplicates([N || {N, _} <- Rs]) of @@ -2680,7 +2680,7 @@ check_records(Rs, Name) -> ok; Ns -> report_error("in module `~w': " - "multiply defined records: ~p.", + "multiply defined records: ~tp.", [Name, Ns]), exit(error) end. @@ -2694,7 +2694,7 @@ expand_imports(Is, Name) -> ordsets:from_list(As); Ns -> report_error("in module `~w': " - "multiply imported functions: ~p.", + "multiply imported functions: ~tp.", [Name, Ns]), exit(error) end. @@ -2968,7 +2968,7 @@ filename([]) -> filename(N) when is_atom(N) -> atom_to_list(N); filename(N) -> - report_error("bad filename: `~P'.", [N, 25]), + report_error("bad filename: `~tP'.", [N, 25]), exit(error). duplicates(Xs) -> @@ -3031,7 +3031,7 @@ split_lines_1(Cs, Cs1, Ls) -> %% Reporting warning_unsafe_call(Name, Module, Target) -> - report_warning("call to `~w' in module `~w' " + report_warning("call to `~tw' in module `~w' " "possibly unsafe in `~s'.", [Name, Module, Target]). warning_apply_2(Module, Target) -> diff --git a/lib/syntax_tools/src/merl.erl b/lib/syntax_tools/src/merl.erl index d6cf208998..b503944442 100644 --- a/lib/syntax_tools/src/merl.erl +++ b/lib/syntax_tools/src/merl.erl @@ -565,13 +565,13 @@ parse_5(Ts, Es) -> -dialyzer({nowarn_function, parse_error/1}). % no local return parse_error({L, M, R}) when is_atom(M), is_integer(L) -> - fail("~w: ~s", [L, M:format_error(R)]); + fail("~w: ~ts", [L, M:format_error(R)]); parse_error({{L,C}, M, R}) when is_atom(M), is_integer(L), is_integer(C) -> - fail("~w:~w: ~s", [L,C,M:format_error(R)]); + fail("~w:~w: ~ts", [L,C,M:format_error(R)]); parse_error({_, M, R}) when is_atom(M) -> fail(M:format_error(R)); parse_error(R) -> - fail("unknown parse error: ~p", [R]). + fail("unknown parse error: ~tp", [R]). %% ------------------------------------------------------------------------ %% Templates, substitution and matching diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml index 922c2ac0f4..5bdfc60448 100644 --- a/lib/tools/doc/src/lcnt.xml +++ b/lib/tools/doc/src/lcnt.xml @@ -471,7 +471,7 @@ <c>lcnt:rt_opt/2</c>. </p> <p>Valid categories are:</p> - <taglist> + <list> <item><c>allocator</c></item> <item><c>db</c> (ETS tables)</item> <item><c>debug</c></item> @@ -480,7 +480,7 @@ <item><c>io</c></item> <item><c>process</c></item> <item><c>scheduler</c></item> - </taglist> + </list> <p> This list is subject to change at any time, as is the category any given lock may belong to. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 438abc2d29..46256daca9 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -900,6 +900,11 @@ resulting regexp is surrounded by \\_< and \\_>." "display" "display_nl" "display_string" + "dist_get_stat" + "dist_ctrl_get_data" + "dist_ctrl_get_data_notification" + "dist_ctrl_input_handler" + "dist_ctrl_put_data" "dist_exit" "dlink" "dmonitor_node" @@ -931,6 +936,7 @@ resulting regexp is surrounded by \\_< and \\_>." "has_prepared_code_on_load" "hibernate" "insert_element" + "iolist_to_iovec" "is_builtin" "load_nif" "loaded" @@ -3642,8 +3648,10 @@ The return value is a string of the form \"foo/1\"." (error nil))))) -;; Keeping erlang-get-function-under-point for backward compatibility. -;; It is used by erldoc.el and maybe other code out there. +;; erlang-get-function-under-point is replaced by +;; erlang-get-identifier-at-point as far as internal erlang.el usage +;; is concerned. But it is kept for backward compatibility. It is +;; used by erldoc.el and maybe other code out there. (defun erlang-get-function-under-point () "Return the module and function under the point, or nil. @@ -4881,7 +4889,12 @@ considered first when it is time to jump to the definition.") '(progn (cl-defmethod xref-backend-identifier-at-point ((_backend (eql erlang-etags))) - (erlang-id-to-string (erlang-get-identifier-at-point))) + (if (eq this-command 'xref-find-references) + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end)) + (thing-at-point 'symbol)) + (erlang-id-to-string (erlang-get-identifier-at-point)))) (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags)) identifier) diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl index 3ae899a078..535ddbcd04 100644 --- a/lib/tools/src/eprof.erl +++ b/lib/tools/src/eprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -246,7 +246,7 @@ handle_call(profile_stop, _From, #state{ profiling = true } = S) -> %% logfile handle_call({logfile, File}, _From, #state{ fd = OldFd } = S) -> - case file:open(File, [write]) of + case file:open(File, [write, {encoding, utf8}]) of {ok, Fd} -> case OldFd of undefined -> ok; @@ -478,11 +478,11 @@ string_bp_mfa([{Mfa, {Count, Time}}|Mfas], Tus, {MfaW, CountW, PercW, TimeW, TpC Stpc = s("~.2f", [divide(Time,Count)]), string_bp_mfa(Mfas, Tus, { - erlang:max(MfaW, length(Smfa)), - erlang:max(CountW,length(Scount)), - erlang:max(PercW, length(Sperc)), - erlang:max(TimeW, length(Stime)), - erlang:max(TpCW, length(Stpc)) + erlang:max(MfaW, string:length(Smfa)), + erlang:max(CountW,string:length(Scount)), + erlang:max(PercW, string:length(Sperc)), + erlang:max(TimeW, string:length(Stime)), + erlang:max(TpCW, string:length(Stpc)) }, [[Smfa, Scount, Sperc, Stime, Stpc] | Strings]). print_bp_mfa(Mfas, {Tn, Tus}, Fd, Opts) -> @@ -491,11 +491,11 @@ print_bp_mfa(Mfas, {Tn, Tus}, Fd, Opts) -> TnStr = s(Tn), TusStr = s(Tus), TuspcStr = s("~.2f", [divide(Tus,Tn)]), - Ws = {erlang:max(length("FUNCTION"), MfaW), - lists:max([length("CALLS"), CountW, length(TnStr)]), - erlang:max(length(" %"), PercW), - lists:max([length("TIME"), TimeW, length(TusStr)]), - lists:max([length("uS / CALLS"), TpCW, length(TuspcStr)])}, + Ws = {erlang:max(string:length("FUNCTION"), MfaW), + lists:max([string:length("CALLS"), CountW, string:length(TnStr)]), + erlang:max(string:length(" %"), PercW), + lists:max([string:length("TIME"), TimeW, string:length(TusStr)]), + lists:max([string:length("uS / CALLS"), TpCW, string:length(TuspcStr)])}, format(Fd, Ws, ["FUNCTION", "CALLS", " %", "TIME", "uS / CALLS"]), format(Fd, Ws, ["--------", "-----", "-------", "----", "----------"]), lists:foreach(fun (String) -> format(Fd, Ws, String) end, Strs), @@ -503,13 +503,13 @@ print_bp_mfa(Mfas, {Tn, Tus}, Fd, Opts) -> format(Fd, Ws, ["Total:", TnStr, "100.00%", TusStr, TuspcStr]), ok. -s({M,F,A}) -> s("~w:~w/~w",[M,F,A]); -s(Term) -> s("~p", [Term]). +s({M,F,A}) -> s("~w:~tw/~w",[M,F,A]); +s(Term) -> s("~tp", [Term]). s(Format, Terms) -> lists:flatten(io_lib:format(Format, Terms)). format(Fd, {MfaW, CountW, PercW, TimeW, TpCW}, Strings) -> - format(Fd, s("~~.~ps ~~~ps ~~~ps ~~~ps [~~~ps]~~n", [MfaW, CountW, PercW, TimeW, TpCW]), Strings); + format(Fd, s("~~.~wts ~~~ws ~~~ws ~~~ws [~~~ws]~~n", [MfaW, CountW, PercW, TimeW, TpCW]), Strings); format(undefined, Format, Strings) -> io:format(Format, Strings), ok; diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl index 436f68d12b..2fe42beb03 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. +%% Copyright Ericsson AB 2001-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1475,7 +1475,7 @@ info_suspect_call(GroupLeader, GroupLeader, _, _) -> ok; info_suspect_call(GroupLeader, _, Func, Pid) -> io:format(GroupLeader, - "~nWarning: ~p called in ~p - trace may become corrupt!~n", + "~nWarning: ~tp called in ~p - trace may become corrupt!~n", parsify([Func, Pid])). info(GroupLeader, GroupLeader, _, _) -> @@ -1498,13 +1498,13 @@ dump_stack(Dump, Stack, Term) -> {N, length(hd(Stack))} end end, - io:format(Dump, "~s~p.~n", [lists:duplicate(Depth, " "), parsify(Term)]), + io:format(Dump, "~s~tp.~n", [lists:duplicate(Depth, " "), parsify(Term)]), true. dump(undefined, _) -> false; dump(Dump, Term) -> - io:format(Dump, "~p.~n", [parsify(Term)]), + io:format(Dump, "~tp.~n", [parsify(Term)]), true. @@ -2603,17 +2603,17 @@ println({Io, [W1, W2, W3, W4]}, Head, println({Io, _}, Head, [], Tail, Comment) -> - io:format(Io, "~s~s~s~n", + io:format(Io, "~s~ts~ts~n", [pad(Head, $ , 3), Tail, Comment]); println({Io, _}, Head, {Tag, Term}, Tail, Comment) -> - io:format(Io, "~s~p, ~p~s~s~n", + io:format(Io, "~s~tp, ~tp~ts~ts~n", [pad(Head, $ , 3), parsify(Tag), parsify(Term), Tail, Comment]); println({Io, _}, Head, Term, Tail, Comment) -> - io:format(Io, "~s~p~s~s~n", + io:format(Io, "~s~tp~ts~ts~n", [pad(Head, $ , 3), parsify(Term), Tail, Comment]). @@ -2720,7 +2720,7 @@ postsort_r([[_|C] | L], R) -> flat_format(F, Trailer) when is_float(F) -> lists:flatten([io_lib:format("~.3f", [F]), Trailer]); flat_format(W, Trailer) -> - lists:flatten([io_lib:format("~p", [W]), Trailer]). + lists:flatten([io_lib:format("~tp", [W]), Trailer]). %% Format, flatten, and pad. flat_format(Term, Trailer, Width) -> diff --git a/lib/tools/src/xref_base.erl b/lib/tools/src/xref_base.erl index 8d2cc07e40..3199b28acb 100644 --- a/lib/tools/src/xref_base.erl +++ b/lib/tools/src/xref_base.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -405,21 +405,21 @@ analysis(exports_not_used, _) -> %% Local calls are not considered here. "X * UU" would do otherwise. "X - XU"; analysis({call, F}, functions) -> - make_query("range (E | ~w : Fun)", [F]); + make_query("range (E | ~tw : Fun)", [F]); analysis({use, F}, functions) -> - make_query("domain (E || ~w : Fun)", [F]); + make_query("domain (E || ~tw : Fun)", [F]); analysis({module_call, M}, _) -> - make_query("range (ME | ~w : Mod)", [M]); + make_query("range (ME | ~tw : Mod)", [M]); analysis({module_use, M}, _) -> - make_query("domain (ME || ~w : Mod)", [M]); + make_query("domain (ME || ~tw : Mod)", [M]); analysis({application_call, A}, _) -> - make_query("range (AE | ~w : App)", [A]); + make_query("range (AE | ~tw : App)", [A]); analysis({application_use, A}, _) -> - make_query("domain (AE || ~w : App)", [A]); + make_query("domain (AE || ~tw : App)", [A]); analysis({release_call, R}, _) -> - make_query("range (RE | ~w : Rel)", [R]); + make_query("range (RE | ~tw : Rel)", [R]); analysis({release_use, R}, _) -> - make_query("domain (RE || ~w : Rel)", [R]); + make_query("domain (RE || ~tw : Rel)", [R]); analysis(deprecated_function_calls, functions) -> "XC || DF"; analysis({deprecated_function_calls,Flag}, functions) -> @@ -1833,9 +1833,9 @@ message(true, What, Arg) -> unreadable -> io:format("Skipping ~ts (unreadable)~n", [Arg]); xref_attr -> - io:format("~ts: Skipping 'xref' attribute ~w~n", Arg); + io:format("~ts: Skipping 'xref' attribute ~tw~n", Arg); depr_attr -> - io:format("~ts: Skipping 'deprecated' attribute ~w~n", Arg); + io:format("~ts: Skipping 'deprecated' attribute ~tw~n", Arg); lib_search -> io:format("Scanning library path for BEAM files... ", []); lib_check -> diff --git a/lib/tools/src/xref_parser.yrl b/lib/tools/src/xref_parser.yrl index 0711da79e2..5ee6419ff5 100644 --- a/lib/tools/src/xref_parser.yrl +++ b/lib/tools/src/xref_parser.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -170,7 +170,7 @@ is_prefix_op('#') -> numeric; is_prefix_op(_) -> false. check_regexp(String) -> - case re:compile(String) of + case re:compile(String, [unicode]) of {ok, _Expr} -> {regexpr, String}; {error, {ErrString, Position}} -> @@ -274,7 +274,7 @@ mfa2s({M,F,A}) -> [c2s(M),':',c2s(F),'/',A]. c2s(C) -> - [S] = io_lib:format("~p", [C]), + [S] = io_lib:format("~tp", [C]), list_to_atom(S). re(variable) -> ['_']; diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl index b0c168e018..02e207d40c 100644 --- a/lib/tools/src/xref_utils.erl +++ b/lib/tools/src/xref_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -638,14 +638,14 @@ neighbours([], G, Fun, VT, L, _V, Vs) -> neighbours(Vs, G, Fun, VT, L). match_list(L, RExpr) -> - {ok, Expr} = re:compile(RExpr), + {ok, Expr} = re:compile(RExpr, [unicode]), filter(fun(E) -> match(E, Expr) end, L). match_one(VarL, Con, Col) -> select_each(VarL, fun(E) -> Con =:= element(Col, E) end). match_many(VarL, RExpr, Col) -> - {ok, Expr} = re:compile(RExpr), + {ok, Expr} = re:compile(RExpr, [unicode]), select_each(VarL, fun(E) -> match(element(Col, E), Expr) end). match(I, Expr) when is_integer(I) -> @@ -653,7 +653,12 @@ match(I, Expr) when is_integer(I) -> {match, [{0,length(S)}]} =:= re:run(S, Expr, [{capture, first}]); match(A, Expr) when is_atom(A) -> S = atom_to_list(A), - {match, [{0,length(S)}]} =:= re:run(S, Expr, [{capture, first}]). + case re:run(S, Expr, [{capture, first}]) of + {match, [{0,Size}]} -> + Size =:= byte_size(unicode:characters_to_binary(S)); + _ -> + false + end. select_each([{Mod,Funs} | L], Pred) -> case filter(Pred, Funs) of diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index 057449d4a2..379a5c09ab 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -50,7 +50,8 @@ -export([analyze/1, basic/1, md/1, q/1, variables/1, unused_locals/1]). --export([format_error/1, otp_7423/1, otp_7831/1, otp_10192/1, otp_13708/1]). +-export([format_error/1, otp_7423/1, otp_7831/1, otp_10192/1, otp_13708/1, + otp_14464/1]). -import(lists, [append/2, flatten/1, keysearch/3, member/2, sort/1, usort/1]). @@ -81,8 +82,10 @@ groups() -> update, deprecated, trycatch, fun_mfa, fun_mfa_r14, fun_mfa_vars, qlc]}, {analyses, [], + [analyze, basic, md, q, variables, unused_locals]}, - {misc, [], [format_error, otp_7423, otp_7831, otp_10192, otp_13708]}]. + {misc, [], [format_error, otp_7423, otp_7831, otp_10192, otp_13708, + otp_14464]}]. init_per_suite(Conf) when is_list(Conf) -> @@ -2396,7 +2399,6 @@ otp_10192(Conf) when is_list(Conf) -> xref:stop(s), ok. -%% OTP-10192. Allow filenames with character codes greater than 126. otp_13708(Conf) when is_list(Conf) -> {ok, _} = start(s), ok = xref:set_default(s, [{verbose, true}]), @@ -2409,6 +2411,36 @@ otp_13708(Conf) when is_list(Conf) -> ok = xref:set_library_path(s, [Dir], [{verbose, true}]), xref:stop(s). +%% OTP-14464. Unicode atoms. +otp_14464(Conf) when is_list(Conf) -> + Dir = ?copydir, + + File1 = fname(Dir, "a.erl"), + MFile1 = fname(Dir, "a"), + Beam1 = fname(Dir, "a.beam"), + Test1 = "-module(a). + -export([ärlig/0, 'кlирилли́ческий атомB'/0]). + + ärlig() -> + 'кlирилли́ческий атомB'. + + 'кlирилли́ческий атомB'() -> + foo. + ", + ok = file:write_file(File1, unicode:characters_to_binary(Test1)), + {ok, a} = compile:file(File1, [debug_info,{outdir,Dir}]), + + {ok, _} = xref:start(s), + {ok, a} = xref:add_module(s, MFile1), + + {ok, [{a,ärlig,0}]} = xref:q(s, 'a:"ärlig"/0'), + {ok, [{a,'кlирилли́ческий атомB',0}]} = + xref:q(s, 'a:"кlирилли́ческий атомB"/0'), + + xref:stop(s), + ok = file:delete(File1), + ok = file:delete(Beam1). + %%% %%% Utilities %%% diff --git a/lib/wx/api_gen/README b/lib/wx/api_gen/README index dd0c49d227..200ef4c856 100644 --- a/lib/wx/api_gen/README +++ b/lib/wx/api_gen/README @@ -3,12 +3,13 @@ API GENERATION: Users of wxErlang should not normally need to regenerate the generated code, as it is checked in by wxErlang developers, when changes are made. - Code checked in is currently generated from wxwidgets 2.8.10. + Code checked in is currently generated from wxwidgets 2.8.12. REQUIREMENTS: The code generation requires doxygen (1.4.6) which is used to parse wxWidgets c++ headers and generate xml files (in wx_xml/). + 2017-08-16 doxygen 1.8.11 is working with WXGTK_DIR=/ldisk/src/wxWidgets-2.8.12/include 2012-02-09 doxygen 1.7.4 is working fine diff --git a/lib/wx/api_gen/wx_doxygen.conf b/lib/wx/api_gen/wx_doxygen.conf index a96db00254..d6a0e9e6a1 100644 --- a/lib/wx/api_gen/wx_doxygen.conf +++ b/lib/wx/api_gen/wx_doxygen.conf @@ -71,12 +71,12 @@ WARN_LOGFILE = #--------------------------------------------------------------------------- # configuration options related to the input files #--------------------------------------------------------------------------- -INPUT = @WXGTK_DIR@/wx/ wx_extra/ +INPUT = @WXGTK_DIR@/wx/ @WXGTK_DIR@/../contrib/include/wx/stc/ wx_extra/ # FILE_PATTERNS = *.h RECURSIVE = YES EXCLUDE = EXCLUDE_SYMLINKS = NO -EXCLUDE_PATTERNS = mac/* mgl/* msw/* os2/* x11/* gtk1/* cocoa/* motif/* msdos/* palmos/* private/* vms_x_fix.h +EXCLUDE_PATTERNS = */mac/* */dfb/* */mgl/* */msw/* */os2/* */x11/* */gtk1/* */cocoa/* */motif/* */msdos/* */palmos/* */private/* */univ/* */vms_x_fix.h EXAMPLE_PATH = EXAMPLE_PATTERNS = EXAMPLE_RECURSIVE = NO @@ -155,8 +155,6 @@ MAN_LINKS = NO #--------------------------------------------------------------------------- GENERATE_XML = YES XML_OUTPUT = ./wx_xml/ -XML_SCHEMA = -XML_DTD = XML_PROGRAMLISTING = NO #--------------------------------------------------------------------------- # configuration options for the AutoGen Definitions output diff --git a/lib/wx/api_gen/wx_gen.erl b/lib/wx/api_gen/wx_gen.erl index 6979a600f3..aadfe4b111 100644 --- a/lib/wx/api_gen/wx_gen.erl +++ b/lib/wx/api_gen/wx_gen.erl @@ -501,10 +501,11 @@ parse_member2(_, _,M0) -> M0. add_param(InParam, Opts, M0) -> - Param0 = case InParam#param.name of - undefined -> InParam#param{name="val"}; + Param0 = case {InParam#param.name, InParam#param.type} of + {undefined, void} -> InParam#param{where=nowhere}; + {undefined,_} -> InParam#param{name="val"}; _ -> InParam - end, + end, Param = case Param0#param.type of #type{base={comp,_,_Comp}} -> Param0; #type{base={class,_Class}} -> Param0; diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf index a0dfa61dd1..146c9fecc7 100644 --- a/lib/wx/api_gen/wxapi.conf +++ b/lib/wx/api_gen/wxapi.conf @@ -401,8 +401,8 @@ ['~wxGraphicsContext', 'Create', %%CreateFromNative CreateFromNativeWindow 'CreatePen','CreateBrush', - {'CreateRadialGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]}, - {'CreateLinearGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]}, + 'CreateRadialGradientBrush', + 'CreateLinearGradientBrush', 'CreateFont','CreateMatrix', 'CreatePath','Clip','ResetClip', 'DrawBitmap','DrawEllipse','DrawIcon', diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 5425e9f3cb..a47d602337 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2016. All Rights Reserved. + * Copyright Ericsson AB 2008-2017. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -6177,7 +6177,6 @@ case wxGraphicsContext_CreateBrush: { // wxGraphicsContext::CreateBrush rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } -#if !wxCHECK_VERSION(2,9,0) case wxGraphicsContext_CreateRadialGradientBrush: { // wxGraphicsContext::CreateRadialGradientBrush wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4; bp += 4; /* Align */ @@ -6201,8 +6200,6 @@ case wxGraphicsContext_CreateRadialGradientBrush: { // wxGraphicsContext::Create rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } -#endif -#if !wxCHECK_VERSION(2,9,0) case wxGraphicsContext_CreateLinearGradientBrush: { // wxGraphicsContext::CreateLinearGradientBrush wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4; bp += 4; /* Align */ @@ -6225,7 +6222,6 @@ case wxGraphicsContext_CreateLinearGradientBrush: { // wxGraphicsContext::Create rt.addRef(getRef((void *)Result,memenv), "wxGraphicsBrush"); break; } -#endif case wxGraphicsContext_CreateFont: { // wxGraphicsContext::CreateFont wxColour col= *wxBLACK; wxGraphicsContext *This = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4; diff --git a/lib/wx/c_src/gen/wxe_macros.h b/lib/wx/c_src/gen/wxe_macros.h index f44fa57053..4c8e52def2 100644 --- a/lib/wx/c_src/gen/wxe_macros.h +++ b/lib/wx/c_src/gen/wxe_macros.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2016. All Rights Reserved. + * Copyright Ericsson AB 2008-2017. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -1540,10 +1540,10 @@ #define wxStaticBox_destroy 1637 #define wxStaticLine_new_2 1639 #define wxStaticLine_new_0 1640 -#define wxStaticLine_Create 1641 -#define wxStaticLine_IsVertical 1642 -#define wxStaticLine_GetDefaultSize 1643 -#define wxStaticLine_destroy 1644 +#define wxStaticLine_destruct 1641 +#define wxStaticLine_Create 1642 +#define wxStaticLine_IsVertical 1643 +#define wxStaticLine_GetDefaultSize 1644 #define wxListBox_new_3 1647 #define wxListBox_new_0 1648 #define wxListBox_destruct 1650 diff --git a/lib/wx/examples/demo/demo.erl b/lib/wx/examples/demo/demo.erl index 8fb70ad7b0..8f3291305b 100644 --- a/lib/wx/examples/demo/demo.erl +++ b/lib/wx/examples/demo/demo.erl @@ -411,7 +411,7 @@ find(Ed) -> keyWords() -> L = ["after","begin","case","try","cond","catch","andalso","orelse", - "end","fun","if","let","of","query","receive","when","bnot","not", + "end","fun","if","let","of","receive","when","bnot","not", "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], lists:flatten([K ++ " " || K <- L] ++ [0]). diff --git a/lib/wx/src/gen/wxGraphicsContext.erl b/lib/wx/src/gen/wxGraphicsContext.erl index 2d0271ac48..5d371ecd7a 100644 --- a/lib/wx/src/gen/wxGraphicsContext.erl +++ b/lib/wx/src/gen/wxGraphicsContext.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -41,8 +41,6 @@ -export([getRenderer/1,isNull/1,parent_class/1]). -export_type([wxGraphicsContext/0]). --deprecated([createLinearGradientBrush/7,createRadialGradientBrush/8]). - %% @hidden parent_class(wxGraphicsObject) -> true; parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxe_debug.hrl b/lib/wx/src/gen/wxe_debug.hrl index 58cb5298e6..533f9f2df0 100644 --- a/lib/wx/src/gen/wxe_debug.hrl +++ b/lib/wx/src/gen/wxe_debug.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1491,10 +1491,10 @@ wxdebug_table() -> {1637, {wxStaticBox, 'Destroy', undefined}}, {1639, {wxStaticLine, new_2, 2}}, {1640, {wxStaticLine, new_0, 0}}, - {1641, {wxStaticLine, create, 2}}, - {1642, {wxStaticLine, isVertical, 0}}, - {1643, {wxStaticLine, getDefaultSize, 0}}, - {1644, {wxStaticLine, 'Destroy', undefined}}, + {1641, {wxStaticLine, destruct, 0}}, + {1642, {wxStaticLine, create, 2}}, + {1643, {wxStaticLine, isVertical, 0}}, + {1644, {wxStaticLine, getDefaultSize, 0}}, {1647, {wxListBox, new_3, 3}}, {1648, {wxListBox, new_0, 0}}, {1650, {wxListBox, destruct, 0}}, diff --git a/lib/wx/src/gen/wxe_funcs.hrl b/lib/wx/src/gen/wxe_funcs.hrl index af0cee0dcd..14b5545676 100644 --- a/lib/wx/src/gen/wxe_funcs.hrl +++ b/lib/wx/src/gen/wxe_funcs.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1488,10 +1488,10 @@ -define(wxStaticBox_destroy, 1637). -define(wxStaticLine_new_2, 1639). -define(wxStaticLine_new_0, 1640). --define(wxStaticLine_Create, 1641). --define(wxStaticLine_IsVertical, 1642). --define(wxStaticLine_GetDefaultSize, 1643). --define(wxStaticLine_destroy, 1644). +-define(wxStaticLine_destruct, 1641). +-define(wxStaticLine_Create, 1642). +-define(wxStaticLine_IsVertical, 1643). +-define(wxStaticLine_GetDefaultSize, 1644). -define(wxListBox_new_3, 1647). -define(wxListBox_new_0, 1648). -define(wxListBox_destruct, 1650). diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index 42973335b4..cc19ff9770 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -561,21 +561,21 @@ system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> print_event(Dev, {in, Msg}, Name) -> case Msg of {'$gen_call', {From, _Tag}, Call} -> - io:format(Dev, "*DBG* ~p got call ~p from ~w~n", + io:format(Dev, "*DBG* ~tp got call ~tp from ~w~n", [Name, Call, From]); {'$gen_cast', Cast} -> - io:format(Dev, "*DBG* ~p got cast ~p~n", + io:format(Dev, "*DBG* ~tp got cast ~tp~n", [Name, Cast]); _ -> - io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) + io:format(Dev, "*DBG* ~tp got ~tp~n", [Name, Msg]) end; print_event(Dev, {out, Msg, To, State}, Name) -> - io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", + io:format(Dev, "*DBG* ~tp sent ~tp to ~w, new state ~tp~n", [Name, Msg, To, State]); print_event(Dev, {noreply, State}, Name) -> - io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); + io:format(Dev, "*DBG* ~tp new state ~tp~n", [Name, State]); print_event(Dev, Event, Name) -> - io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). + io:format(Dev, "*DBG* ~tp dbg ~tp~n", [Name, Event]). %%% --------------------------------------------------- %%% Terminate the server. @@ -629,10 +629,10 @@ error_info(Reason, Name, Msg, State, Debug) -> _ -> Reason end, - format("** wx object server ~p terminating \n" - "** Last message in was ~p~n" - "** When Server state == ~p~n" - "** Reason for termination == ~n** ~p~n", + format("** wx object server ~tp terminating \n" + "** Last message in was ~tp~n" + "** When Server state == ~tp~n" + "** Reason for termination == ~n** ~tp~n", [Name, Msg, State, Reason1]), sys:print_log(Debug), ok. @@ -657,7 +657,7 @@ debug_options(Name, Opts) -> dbg_opts(Name, Opts) -> case catch sys:debug_options(Opts) of {'EXIT',_} -> - format("~p: ignoring erroneous debug options - ~p~n", + format("~tp: ignoring erroneous debug options - ~tp~n", [Name, Opts]), []; Dbg -> diff --git a/make/otp.mk.in b/make/otp.mk.in index 3ab04f8256..4232d37c2e 100644 --- a/make/otp.mk.in +++ b/make/otp.mk.in @@ -47,7 +47,9 @@ CROSS_COMPILING = @CROSS_COMPILING@ # ---------------------------------------------------- DEFAULT_TARGETS = opt debug release release_docs clean docs -TYPES=@TYPES@ +TYPES = @TYPES@ + +USE_PGO = @USE_PGO@ # Slash separated list of return values from $(origin VAR) # that are untrusted - set default in this file instead. @@ -60,8 +62,8 @@ DUBIOUS_ORIGINS = /undefined/environment/ # HiPE # ---------------------------------------------------- -HIPE_ENABLED=@HIPE_ENABLED@ -NATIVE_LIBS_ENABLED=@NATIVE_LIBS_ENABLED@ +HIPE_ENABLED = @HIPE_ENABLED@ +NATIVE_LIBS_ENABLED = @NATIVE_LIBS_ENABLED@ # ---------------------------------------------------- # Command macros @@ -83,6 +85,7 @@ LD = @LD@ RANLIB = @RANLIB@ AR = @AR@ PERL = @PERL@ +LLVM_PROFDATA = @LLVM_PROFDATA@ BITS64 = @BITS64@ diff --git a/make/output.mk.in b/make/output.mk.in index 171d2456aa..7c6533fddd 100644 --- a/make/output.mk.in +++ b/make/output.mk.in @@ -139,3 +139,7 @@ vsn_verbose = $(vsn_verbose_$(V)) yecc_verbose_0 = @echo " YECC "$@; yecc_verbose = $(yecc_verbose_$(V)) + +llvm_profdata_verbose_0 = @echo " LLVM_PROFDATA "$@; +llvm_profdata_verbose = $(llvm_profdata_verbose_$(V)) +V_LLVM_PROFDATA = $(llvm_profdata_verbose)$(LLVM_PROFDATA) diff --git a/otp_versions.table b/otp_versions.table index 7f08898179..3c6474bf4d 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,5 @@ +OTP-20.0.4 : dialyzer-3.2.1 erts-9.0.4 # asn1-5.0.2 common_test-1.15.1 compiler-7.1.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3.1 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5.1 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 : +OTP-20.0.3 : asn1-5.0.2 compiler-7.1.1 erts-9.0.3 ssh-4.5.1 # common_test-1.15.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3.1 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 : OTP-20.0.2 : asn1-5.0.1 erts-9.0.2 kernel-5.3.1 # common_test-1.15.1 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 : OTP-20.0.1 : common_test-1.15.1 erts-9.0.1 runtime_tools-1.12.1 stdlib-3.4.1 tools-2.10.1 # asn1-5.0 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 syntax_tools-2.1.2 wx-1.8.1 xmerl-1.3.15 : OTP-20.0 : asn1-5.0 common_test-1.15 compiler-7.1 cosProperty-1.2.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 erl_docgen-0.7 erl_interface-3.10 erts-9.0 eunit-2.3.3 hipe-3.16 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 orber-3.8.3 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4 syntax_tools-2.1.2 tools-2.10 wx-1.8.1 xmerl-1.3.15 # cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 eldap-1.2.2 et-1.6 ic-4.4.2 odbc-2.12 os_mon-2.4.2 otp_mibs-1.1.1 : diff --git a/scripts/run-dialyzer b/scripts/run-dialyzer index 383ae2301d..05c1fd63c0 100755 --- a/scripts/run-dialyzer +++ b/scripts/run-dialyzer @@ -4,4 +4,13 @@ set -e $ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools wx xmerl --statistics $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts kernel stdlib asn1 crypto dialyzer hipe parsetools public_key runtime_tools sasl tools --statistics -$ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc inets mnesia observer ssh ssl syntax_tools tools wx xmerl --statistics +$ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc inets mnesia observer ssh ssl syntax_tools wx xmerl --statistics + +# In travis we don't dialyze everything as it takes too much time +if [ "X$DIALYZE_ALL_APPLICATIONS" = "Xtrue" ]; then + $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps eldap erl_docgen et odbc --statistics + $ERL_TOP/bin/dialyzer -n --apps eunit reltool os_mon --statistics + + # These application are not run always as the currently have dialyzer warnings + # $ERL_TOP/bin/dialyzer -n --apps cosEvent cosEventDomain cosFileTransfer cosNotification cosProperty cosTime cosTransactions diameter megaco orber snmp --statistics +fi diff --git a/system/doc/design_principles/des_princ.xml b/system/doc/design_principles/des_princ.xml index 8ab8661c2d..af5904ce78 100644 --- a/system/doc/design_principles/des_princ.xml +++ b/system/doc/design_principles/des_princ.xml @@ -225,10 +225,8 @@ free(Ch, {Alloc, Free} = Channels) -> <list type="bulleted"> <item><p><seealso marker="gen_server_concepts">gen_server</seealso></p> <p>For implementing the server of a client-server relation</p></item> - <item><p><seealso marker="fsm">gen_fsm</seealso></p> - <p>For implementing finite-state machines (Old)</p></item> <item><p><seealso marker="statem">gen_statem</seealso></p> - <p>For implementing state machines (New)</p></item> + <p>For implementing state machines</p></item> <item><p><seealso marker="events">gen_event</seealso></p> <p>For implementing event handling functionality</p></item> <item><p><seealso marker="sup_princ">supervisor</seealso></p> diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml index 7febe31df3..a0611a46da 100644 --- a/system/doc/design_principles/statem.xml +++ b/system/doc/design_principles/statem.xml @@ -411,14 +411,6 @@ StateName(EventType, EventContent, Data) -> <marker id="Example" /> <title>Example</title> <p> - This example starts off as equivalent to the example in section - <seealso marker="fsm"><c>gen_fsm</c> Behavior</seealso>. - In later sections, additions and tweaks are made - using features in <c>gen_statem</c> that <c>gen_fsm</c> does not have. - The end of this chapter provides the example again - with all the added features. - </p> - <p> A door with a code lock can be seen as a state machine. Initially, the door is locked. When someone presses a button, an event is generated. diff --git a/system/doc/efficiency_guide/advanced.xml b/system/doc/efficiency_guide/advanced.xml index e1760d0ded..896eda5f1c 100644 --- a/system/doc/efficiency_guide/advanced.xml +++ b/system/doc/efficiency_guide/advanced.xml @@ -255,30 +255,36 @@ <cell><marker id="unique_references"/>Unique References on a Runtime System Instance</cell> <cell>Each scheduler thread has its own set of references, and all other threads have a shared set of references. Each set of references - consist of <c>2⁶⁴ - 1</c> unique references. That is the total + consist of <c>2⁶⁴ - 1</c> unique references. That is, the total amount of unique references that can be produced on a runtime - system instance is <c>(NoSchedulers + 1) * (2⁶⁴ - 1)</c>. If a - scheduler thread create a new reference each nano second, + system instance is <c>(NoSchedulers + 1) × (2⁶⁴ - 1)</c>. + <br/><br/> + If a scheduler thread create a new reference each nano second, references will at earliest be reused after more than 584 years. That is, for the foreseeable future they are unique enough.</cell> </row> <row> <cell><marker id="unique_integers"/>Unique Integers on a Runtime System Instance</cell> - <cell>There are two types of unique integers both created using the - <seealso marker="erts:erlang#unique_integer/1">erlang:unique_integer()</seealso> - BIF. Unique integers created: - <taglist> - <tag>with the <c>monotonic</c> modifier</tag> - <item>consist of a set of <c>2⁶⁴ - 1</c> unique integers.</item> - <tag>without the <c>monotonic</c> modifier</tag> - <item>consist of a set of <c>2⁶⁴ - 1</c> unique integers per scheduler - thread and a set of <c>2⁶⁴ - 1</c> unique integers shared by - other threads. That is the total amount of unique integers without - the <c>monotonic</c> modifier is <c>(NoSchedulers + 1) * (2⁶⁴ - 1)</c></item> - </taglist> - If a unique integer is created each nano second, unique integers - will at earliest be reused after more than 584 years. That is, for - the foreseeable future they are unique enough.</cell> + <cell> + There are two types of unique integers both created using the + <seealso marker="erts:erlang#unique_integer/1">erlang:unique_integer()</seealso> + BIF: + <br/><br/> + <em>1.</em> Unique integers created <em>with</em> the + <c>monotonic</c> modifier consist of a set of <c>2⁶⁴ - 1</c> + unique integers. + <br/><br/> + <em>2.</em> Unique integers created <em>without</em> the + <c>monotonic</c> modifier consist of a set of <c>2⁶⁴ - 1</c> + unique integers per scheduler thread and a set of <c>2⁶⁴ - 1</c> + unique integers shared by other threads. That is, the total + amount of unique integers without the <c>monotonic</c> modifier + is <c>(NoSchedulers + 1) × (2⁶⁴ - 1)</c>. + <br/><br/> + If a unique integer is created each nano second, unique integers + will at earliest be reused after more than 584 years. That is, for + the foreseeable future they are unique enough. + </cell> </row> <tcaption>System Limits</tcaption> </table> diff --git a/system/doc/oam/oam_intro.xml b/system/doc/oam/oam_intro.xml index 8b8d69e638..b4142b3cc5 100644 --- a/system/doc/oam/oam_intro.xml +++ b/system/doc/oam/oam_intro.xml @@ -243,8 +243,8 @@ snmp:c("MY-MIB", [{il, ["sasl/priv/mibs"]}]).</code> loading the MIBs into the agent. Some MIB implementations are code-only, while others need a server. One way, used by the code-only MIB implementations, is for the user to call a - function such as <c>otp_mib:init(Agent)</c> to load the MIB, - and <c>otp_mib:stop(Agent)</c> to unload the MIB. See the + function such as <c>otp_mib:load(Agent)</c> to load the MIB, + and <c>otp_mib:unload(Agent)</c> to unload the MIB. See the manual page for each application for a description of how to load each MIB.</p> </section> |