diff options
286 files changed, 8158 insertions, 2923 deletions
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex e8f9a4fe12..73381d4d8b 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 e8f9a4fe12..73381d4d8b 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam Binary files differindex 15ca7ee757..e677c125a3 100644 --- a/bootstrap/lib/compiler/ebin/beam_bool.beam +++ b/bootstrap/lib/compiler/ebin/beam_bool.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex 4294fcb23f..b65f915978 100644 --- a/bootstrap/lib/compiler/ebin/beam_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 32e0485ff8..88857b8905 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex 7233eee9de..37120929ba 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 8126046e08..5234f98a75 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex aa4b5f9585..322469639f 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 2082153b33..6e6496c7f9 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam Binary files differindex b3f927ab3c..6555a39c86 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex c80144ec65..ac01acad27 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex e380d59305..42f71e7a20 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 2b12bfe427..9b250ba708 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_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam Binary files differindex 9111e3c69c..fc1c4781f1 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/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam Binary files differindex bd24310b0b..480cb0b878 100644 --- a/bootstrap/lib/kernel/ebin/heart.beam +++ b/bootstrap/lib/kernel/ebin/heart.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index a409bf6f3a..14f526c30c 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -116,6 +116,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-7.0", "stdlib-2.6", "sasl-2.6"]} + {runtime_dependencies, ["erts-7.3", "stdlib-2.6", "sasl-2.6"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex 1dae85119a..9fd407c287 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam Binary files differindex ed3e5a2683..9ebe6c770f 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam Binary files differindex 775f43ce2f..68d1b50f84 100644 --- a/bootstrap/lib/kernel/ebin/seq_trace.beam +++ b/bootstrap/lib/kernel/ebin/seq_trace.beam diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam Binary files differindex 971c19a824..e306b172bf 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex 9ad11640b5..4caf4f6455 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex d9d34914f9..b255a4e10f 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 964ed4e791..ab627d50df 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v8.beam b/bootstrap/lib/stdlib/ebin/dets_v8.beam Binary files differindex 6c2a3e9efb..9a1416a316 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v8.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v8.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex 46f8d2c6a5..0b966769ba 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v9.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam Binary files differindex 45cc303498..3b2b5a4c04 100644 --- a/bootstrap/lib/stdlib/ebin/dict.beam +++ b/bootstrap/lib/stdlib/ebin/dict.beam diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam Binary files differindex 28b65ce7b5..76713562bc 100644 --- a/bootstrap/lib/stdlib/ebin/digraph.beam +++ b/bootstrap/lib/stdlib/ebin/digraph.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam Binary files differindex 136c2d5196..8b1719eb0a 100644 --- a/bootstrap/lib/stdlib/ebin/edlin.beam +++ b/bootstrap/lib/stdlib/ebin/edlin.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex d9cd838ca9..dc2b80b019 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex c8358c42b8..b58781d3f8 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 001709532a..617913c674 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 0cdf78b62b..3a0681d1bf 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex 78d9d727eb..9286aea119 100644 --- a/bootstrap/lib/stdlib/ebin/file_sorter.beam +++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 4d64451826..4788735049 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 5e26fae139..f78a7368d5 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 d40b5808f3..8ebe9d7a3a 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam Binary files differindex 56b9d2c88a..91297311b2 100644 --- a/bootstrap/lib/stdlib/ebin/lists.beam +++ b/bootstrap/lib/stdlib/ebin/lists.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex d3ae7b6775..2c0eb8a742 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 a8ee669a95..3e3673577a 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 51529c5570..436b62e50e 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex 915c8dfc91..4032af0dd7 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam Binary files differindex 5bc835e2e8..8370469ff4 100644 --- a/bootstrap/lib/stdlib/ebin/rand.beam +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex ee304db782..8e64036c90 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex 7cc095b953..5514b0d4f9 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 3e166b2b4b..7287cbd451 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -105,7 +105,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex ed50c91bf7..e03a3264a6 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam Binary files differindex 279fded868..d2bfe6eea8 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam Binary files differindex e34f8a35cf..17a318c4d4 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam Binary files differindex 943fce47e0..1a19b1f28a 100644 --- a/bootstrap/lib/stdlib/ebin/zip.beam +++ b/bootstrap/lib/stdlib/ebin/zip.beam diff --git a/erts/configure.in b/erts/configure.in index 2f19c0f760..d84651f4f9 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -342,6 +342,21 @@ AS_HELP_STRING([--disable-saved-compile-time], [disable saved compile time]), AC_DEFINE_UNQUOTED(ERTS_SAVED_COMPILE_TIME, $save_compile_time, [Save compile time?]) +AC_ARG_WITH(microstate-accounting, +AS_HELP_STRING([--with-microstate-accounting={yes|extra}], + [enable microstate account, possibly with extra detailed states]) +AS_HELP_STRING([--without-microstate-accounting], + [don't enable microstate accounting]), +[],[with_microstate_accounting=yes]) + +case "$with_microstate_accounting" in + yes) AC_DEFINE(ERTS_ENABLE_MSACC,[1], + [Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;; + extra) AC_DEFINE(ERTS_ENABLE_MSACC,[2], + [Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;; + *) ;; +esac + dnl Magic test for clearcase. OTP_RELEASE= if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index cade732c56..241d4131d5 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -347,6 +347,16 @@ the driver does not handle sizes that overflow an <c>int</c> all will work as before.</p> </item> + <tag><marker id="time_measurement"/>Time Measurement</tag> + <item><p>Support for time measurement in drivers: + <list> + <item><seealso marker="#ErlDrvTime"><c>ErlDrvTime</c></seealso></item> + <item><seealso marker="#ErlDrvTimeUnit"><c>ErlDrvTimeUnit</c></seealso></item> + <item><seealso marker="#erl_drv_monotonic_time"><c>erl_drv_monotonic_time()</c></seealso></item> + <item><seealso marker="#erl_drv_time_offset"><c>erl_drv_time_offset()</c></seealso></item> + <item><seealso marker="#erl_drv_convert_time_unit"><c>erl_drv_convert_time_unit()</c></seealso></item> + </list></p> + </item> </taglist> </section> @@ -860,6 +870,24 @@ typedef struct ErlIOVec { <seealso marker="#erl_drv_tsd_get">erl_drv_tsd_get()</seealso>. </p> </item> + <tag><marker id="ErlDrvTime"/>ErlDrvTime</tag> + <item> + <p>A signed 64-bit integer type for representation of time.</p> + </item> + <tag><marker id="ErlDrvTimeUnit"/>ErlDrvTimeUnit</tag> + <item> + <p>An enumeration of time units supported by the driver API:</p> + <taglist> + <tag><c>ERL_DRV_SEC</c></tag> + <item><p>Seconds</p></item> + <tag><c>ERL_DRV_MSEC</c></tag> + <item><p>Milliseconds</p></item> + <tag><c>ERL_DRV_USEC</c></tag> + <item><p>Microseconds</p></item> + <tag><c>ERL_DRV_NSEC</c></tag> + <item><p>Nanoseconds</p></item> + </taglist> + </item> </taglist> </section> @@ -1023,6 +1051,11 @@ typedef struct ErlIOVec { <fsummary>Read a system timestamp</fsummary> <desc> <marker id="driver_get_now"></marker> + <warning><p><em>This function is deprecated! Do not use it!</em> + Use <seealso marker="#erl_drv_monotonic_time"><c>erl_drv_monotonic_time()</c></seealso> + (perhaps in combination with + <seealso marker="#erl_drv_time_offset"><c>erl_drv_time_offset()</c></seealso>) + instead.</p></warning> <p>This function reads a timestamp into the memory pointed to by the parameter <c>now</c>. See the description of <seealso marker="#ErlDrvNowData">ErlDrvNowData</seealso> for specification of its fields. </p> @@ -3042,6 +3075,86 @@ ERL_DRV_MAP int sz </desc> </func> + <func> + <name><ret>ErlDrvTime</ret><nametext>erl_drv_monotonic_time(ErlDrvTimeUnit time_unit)</nametext></name> + <fsummary>Get Erlang Monotonic Time</fsummary> + <desc> + <marker id="erl_drv_monotonic_time"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>time_unit</c></tag> + <item>Time unit of returned value.</item> + </taglist> + <p> + Returns + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. Note that it is not uncommon with + negative values. + </p> + <p>Returns <c>ERL_DRV_TIME_ERROR</c> if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.</p> + <p>See also:</p> + <list> + <item><seealso marker="#ErlDrvTime"><c>ErlDrvTime</c></seealso></item> + <item><seealso marker="#ErlDrvTimeUnit"><c>ErlDrvTimeUnit</c></seealso></item> + </list> + </desc> + </func> + + <func> + <name><ret>ErlDrvTime</ret><nametext>erl_drv_time_offset(ErlDrvTimeUnit time_unit)</nametext></name> + <fsummary>Get current Time Offset</fsummary> + <desc> + <marker id="erl_drv_time_offset"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>time_unit</c></tag> + <item>Time unit of returned value.</item> + </taglist> + <p>Returns the current time offset between + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang monotonic time</seealso> + and + <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso> + converted into the <c>time_unit</c> passed as argument.</p> + <p>Returns <c>ERL_DRV_TIME_ERROR</c> if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.</p> + <p>See also:</p> + <list> + <item><seealso marker="#ErlDrvTime"><c>ErlDrvTime</c></seealso></item> + <item><seealso marker="#ErlDrvTimeUnit"><c>ErlDrvTimeUnit</c></seealso></item> + </list> + </desc> + </func> + + <func> + <name><ret>ErlDrvTime</ret><nametext>erl_drv_convert_time_unit(ErlDrvTime val, ErlDrvTimeUnit from, ErlDrvTimeUnit to)</nametext></name> + <fsummary>Convert time unit of a time value</fsummary> + <desc> + <marker id="erl_drv_convert_time_unit"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>val</c></tag> + <item>Value to convert time unit for.</item> + <tag><c>from</c></tag> + <item>Time unit of <c>val</c>.</item> + <tag><c>to</c></tag> + <item>Time unit of returned value.</item> + </taglist> + <p>Converts the <c>val</c> value of time unit <c>from</c> to + the corresponding value of time unit <c>to</c>. The result is + rounded using the floor function.</p> + <p>Returns <c>ERL_DRV_TIME_ERROR</c> if called with an invalid + time unit argument.</p> + <p>See also:</p> + <list> + <item><seealso marker="#ErlDrvTime"><c>ErlDrvTime</c></seealso></item> + <item><seealso marker="#ErlDrvTimeUnit"><c>ErlDrvTimeUnit</c></seealso></item> + </list> + </desc> + </func> + </funcs> <section> <title>SEE ALSO</title> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 2d8706169f..420c9fea38 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -317,6 +317,17 @@ ok libraries might however fail if deprecated features are used. </p></item> + <tag><marker id="time_measurement"/>Time Measurement</tag> + <item><p>Support for time measurement in NIF libraries: + <list> + <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item> + <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item> + <item><seealso marker="#enif_monotonic_time"><c>enif_monotonic_time()</c></seealso></item> + <item><seealso marker="#enif_time_offset"><c>enif_time_offset()</c></seealso></item> + <item><seealso marker="#enif_convert_time_unit"><c>enif_convert_time_unit()</c></seealso></item> + </list></p> + </item> + <tag>Long-running NIFs</tag> <item><p><marker id="dirty_nifs"/>Native functions <seealso marker="#lengthy_work"> @@ -560,6 +571,25 @@ typedef enum { <item><p>A native signed 64-bit integer type.</p></item> <tag><marker id="ErlNifUInt64"/>ErlNifUInt64</tag> <item><p>A native unsigned 64-bit integer type.</p></item> + + <tag><marker id="ErlNifTime"/>ErlNifTime</tag> + <item> + <p>A signed 64-bit integer type for representation of time.</p> + </item> + <tag><marker id="ErlNifTimeUnit"/>ErlNifTimeUnit</tag> + <item> + <p>An enumeration of time units supported by the NIF API:</p> + <taglist> + <tag><c>ERL_NIF_SEC</c></tag> + <item><p>Seconds</p></item> + <tag><c>ERL_NIF_MSEC</c></tag> + <item><p>Milliseconds</p></item> + <tag><c>ERL_NIF_USEC</c></tag> + <item><p>Microseconds</p></item> + <tag><c>ERL_NIF_NSEC</c></tag> + <item><p>Nanoseconds</p></item> + </taglist> + </item> </taglist> </section> @@ -1486,6 +1516,88 @@ enif_map_iterator_destroy(env, &iter); <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_set">erl_drv_tsd_set</seealso>. </p></desc> </func> + + + <func> + <name><ret>ErlNifTime</ret><nametext>enif_monotonic_time(ErlNifTimeUnit time_unit)</nametext></name> + <fsummary>Get Erlang Monotonic Time</fsummary> + <desc> + <marker id="enif_monotonic_time"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>time_unit</c></tag> + <item>Time unit of returned value.</item> + </taglist> + <p> + Returns + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. Note that it is not uncommon with + negative values. + </p> + <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.</p> + <p>See also:</p> + <list> + <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item> + <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item> + </list> + </desc> + </func> + + <func> + <name><ret>ErlNifTime</ret><nametext>enif_time_offset(ErlNifTimeUnit time_unit)</nametext></name> + <fsummary>Get current Time Offset</fsummary> + <desc> + <marker id="enif_time_offset"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>time_unit</c></tag> + <item>Time unit of returned value.</item> + </taglist> + <p>Returns the current time offset between + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang monotonic time</seealso> + and + <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso> + converted into the <c>time_unit</c> passed as argument.</p> + <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.</p> + <p>See also:</p> + <list> + <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item> + <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item> + </list> + </desc> + </func> + + <func> + <name><ret>ErlNifTime</ret><nametext>enif_convert_time_unit(ErlNifTime val, ErlNifTimeUnit from, ErlNifTimeUnit to)</nametext></name> + <fsummary>Convert time unit of a time value</fsummary> + <desc> + <marker id="enif_convert_time_unit"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>val</c></tag> + <item>Value to convert time unit for.</item> + <tag><c>from</c></tag> + <item>Time unit of <c>val</c>.</item> + <tag><c>to</c></tag> + <item>Time unit of returned value.</item> + </taglist> + <p>Converts the <c>val</c> value of time unit <c>from</c> to + the corresponding value of time unit <c>to</c>. The result is + rounded using the floor function.</p> + <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid + time unit argument.</p> + <p>See also:</p> + <list> + <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item> + <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item> + </list> + </desc> + </func> + </funcs> <section> <title>SEE ALSO</title> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 10c0d65e31..803da382ed 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -131,6 +131,17 @@ </note> </item> + <tag><c>perf_counter</c></tag> + <item><p>Symbolic representation of the performance counter + time unit used by the Erlang runtime system.</p> + + <p>The <c>perf_counter</c> time unit behaves much in the same way + as the <c>native</c> time unit. That is it might differ inbetween + run-time restarts. You get values of this type by calling + <seealso marker="kernel:os#perf_counter/0"><c>os:perf_counter()</c></seealso> + </p> + </item> + </taglist> <p>The <c>time_unit/0</c> type may be extended. Use @@ -5859,6 +5870,146 @@ true</pre> <func> <name name="statistics" arity="1" clause_i="6"/> + <fsummary>Information about microstate accounting.</fsummary> + <desc> + <marker id="statistics_microstate_accounting"></marker> + <p> + Microstate accounting can be used to measure how much time the Erlang + runtime system spends doing various tasks. It is designed to be as + lightweight as possible, but there will be some overhead when this + is enabled. Microstate accounting is meant to be a profiling tool + to help figure out performance bottlenecks. + To <c>start</c>/<c>stop</c>/<c>reset</c> microstate_accounting you use + the system_flag + <seealso marker="#system_flag_microstate_accounting"> + <c>microstate_accounting</c></seealso>. + </p> + <p> + <c>erlang:statistics(microstate_accounting)</c> returns a list of maps + representing some of the OS threads within ERTS. Each map contains + <c>type</c> and <c>id</c> fields that can be used to identify what + thread it is, and also a counters field that contains data about how + much time has been spent in the various states.</p> + <pre> +> <input>erlang:statistics(microstate_accounting).</input> +[#{counters => #{aux => 1899182914, + check_io => 2605863602, + emulator => 45731880463, + gc => 1512206910, + other => 5421338456, + port => 221631, + sleep => 5150294100}, + id => 1, + type => scheduler}|...] + </pre> + <p>The time unit is the same as returned by + <seealso marker="kernel:os#perf_counter/0"> + <c>os:perf_counter/0</c></seealso>. + So to convert it to milliseconds you could do something like this:</p> + <pre> +lists:map( + fun(#{ counters := Cnt } = M) -> + MsCnt = maps:map(fun(_K, PerfCount) -> + erlang:convert_time_unit(PerfCount, perf_counter, 1000) + end, Cnt), + M#{ counters := MsCnt } + end, erlang:statistics(microstate_accounting)). + </pre> + <p> + It is important to note that these values are not guaranteed to be + the exact time spent in each state. This is because of various + optimisation done in order to keep the overhead as small as possible. + </p> + + <p>Currently the following <c><anno>MSAcc_Thread_Type</anno></c> are available:</p> + <taglist> + <tag><c>scheduler</c></tag> + <item>The main execution threads that do most of the work.</item> + <tag><c>async</c></tag><item>Async threads are used by various + linked-in drivers (mainly the file drivers) do offload non-cpu + intensive work.</item> + <tag><c>aux</c></tag><item>Takes care of any work that is not + specifically assigned to a scheduler.</item> + </taglist> + <p>Currently the following <c><anno>MSAcc_Thread_State</anno></c>s are available. + All states are exclusive, meaning that a thread cannot be in two states + at once. So if you add the numbers of all counters in a thread + you will get the total run-time for that thread.</p> + <taglist> + <tag><c>aux</c></tag> + <item>Time spent handling auxiliary jobs.</item> + <tag><c>check_io</c></tag> + <item>Time spent checking for new I/O events.</item> + <tag><c>emulator</c></tag> + <item>Time spent executing erlang processes.</item> + <tag><c>gc</c></tag> + <item>Time spent doing garbage collection. When extra states are + enabled this is the time spent doing non-fullsweep garbage + collections.</item> + <tag><c>other</c></tag> + <item>Time spent doing unaccounted things.</item> + <tag><c>port</c></tag> + <item>Time spent executing ports.</item> + <tag><c>sleep</c></tag> + <item>Time spent sleeping.</item> + </taglist> + <p>It is possible to add more fine grained <c><anno>MSAcc_Thread_State</anno></c>s + through configure. + (e.g. <c>./configure --with-microstate-accounting=extra</c>). + Enabling these states will cause a performance degradation when + microstate accounting is turned off and increase the overhead when + it is turned on.</p> + <taglist> + <tag><c>alloc</c></tag> + <item>Time spent managing memory. Without extra states this time is + spread out over all other states.</item> + <tag><c>bif</c></tag> + <item>Time spent in bifs. Without extra states this time is part of + the <c>emulator</c> state.</item> + <tag><c>busy_wait</c></tag> + <item>Time spent busy waiting. This is also the state where a + scheduler no longer reports that it is active when using + <seealso marker="#statistics_scheduler_wall_time"> + <c>erlang:statistics(scheduler_wall_time)</c></seealso>. + So if you add all other states but this and sleep and then divide that + by all time in the thread you should get something very similar to the + scheduler_wall_time fraction. Without extra states this time is part + of the <c>other</c> state.</item> + <tag><c>ets</c></tag> + <item>Time spent executing ETS bifs. Without extra states this time is + part of the <c>emulator</c> state.</item> + <tag><c>gc_full</c></tag> + <item>Time spent doing fullsweep garbage collection. Without extra + states this time is part of the <c>gc</c> state.</item> + <tag><c>nif</c></tag> + <item>Time spent in nifs. Without extra states this time is part of + the <c>emulator</c> state.</item> + <tag><c>send</c></tag> + <item>Time spent sending messages (processes only). Without extra + states this time is part of the <c>emulator</c> state.</item> + <tag><c>timers</c></tag> + <item>Time spent managing timers. Without extra states this time is + part of the <c>other</c> state.</item> + </taglist> + <p>There is a utility module called + <seealso marker="runtime_tools:msacc"><c>msacc</c></seealso> in + runtime_tools that can be used to more easily analyse these + statistics.</p> + + <p> + Returns <c>undefined</c> if the system flag + <seealso marker="#system_flag_microstate_accounting"> + <c>microstate_accounting</c></seealso> + is turned off. + </p> + <p>The list of thread information is unsorted and may appear in + different order between calls.</p> + <note><p>The threads and states are subject to change without any + prior notice.</p></note> + </desc> + </func> + <func> + <name name="statistics" arity="1" clause_i="7"/> <fsummary>Information about reductions.</fsummary> <desc> <marker id="statistics_reductions"></marker> @@ -5876,7 +6027,7 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="7"/> + <name name="statistics" arity="1" clause_i="8"/> <fsummary>Information about the run-queues.</fsummary> <desc><marker id="statistics_run_queue"></marker> <p> @@ -5892,7 +6043,7 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="8"/> + <name name="statistics" arity="1" clause_i="9"/> <fsummary>Information about the run-queue lengths.</fsummary> <desc><marker id="statistics_run_queue_lengths"></marker> <p> @@ -5912,7 +6063,7 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="9"/> + <name name="statistics" arity="1" clause_i="10"/> <fsummary>Information about runtime.</fsummary> <desc> <p>Returns information about runtime, in milliseconds.</p> @@ -5927,7 +6078,7 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="10"/> + <name name="statistics" arity="1" clause_i="11"/> <fsummary>Information about each schedulers work time.</fsummary> <desc> <marker id="statistics_scheduler_wall_time"></marker> @@ -5998,7 +6149,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="11"/> + <name name="statistics" arity="1" clause_i="12"/> <fsummary>Information about active processes and ports.</fsummary> <desc><marker id="statistics_total_active_tasks"></marker> <p> @@ -6016,7 +6167,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="12"/> + <name name="statistics" arity="1" clause_i="13"/> <fsummary>Information about the run-queue lengths.</fsummary> <desc><marker id="statistics_total_run_queue_lengths"></marker> <p> @@ -6035,7 +6186,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="13"/> + <name name="statistics" arity="1" clause_i="14"/> <fsummary>Information about wall clock.</fsummary> <desc> <p>Returns information about wall clock. <c>wall_clock</c> can @@ -6269,6 +6420,17 @@ ok <func> <name name="system_flag" arity="2" clause_i="5"/> + <fsummary>Set system flag microstate_accounting</fsummary> + <desc><p><marker id="system_flag_microstate_accounting"></marker> + Turns on/off microstate accounting measurements. By passing reset it is possible to reset + all counters to 0.</p> + <p>For more information see, + <seealso marker="#statistics_microstate_accounting">erlang:statistics(microstate_accounting)</seealso>. + </p> + </desc> + </func> + <func> + <name name="system_flag" arity="2" clause_i="6"/> <fsummary>Sets system flag <c>min_heap_size</c>.</fsummary> <desc> <p>Sets the default minimum heap size for processes. The size @@ -6283,7 +6445,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="6"/> + <name name="system_flag" arity="2" clause_i="7"/> <fsummary>Sets system flag <c>min_bin_vheap_size</c>.</fsummary> <desc> <p>Sets the default minimum binary virtual heap size for @@ -6300,7 +6462,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="7"/> + <name name="system_flag" arity="2" clause_i="8"/> <fsummary>Sets system flag <c>multi_scheduling</c>.</fsummary> <desc> <p><marker id="system_flag_multi_scheduling"></marker> @@ -6338,7 +6500,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="8"/> + <name name="system_flag" arity="2" clause_i="9"/> <fsummary>Sets system flag <c>scheduler_bind_type</c>.</fsummary> <type name="scheduler_bind_type"/> <desc> @@ -6456,7 +6618,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="9"/> + <name name="system_flag" arity="2" clause_i="10"/> <fsummary>Sets system flag <c>scheduler_wall_time</c>.</fsummary> <desc><p><marker id="system_flag_scheduler_wall_time"></marker> Turns on or off scheduler wall time measurements.</p> @@ -6466,7 +6628,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="10"/> + <name name="system_flag" arity="2" clause_i="11"/> <fsummary>Sets system flag <c>schedulers_online</c>.</fsummary> <desc> <p><marker id="system_flag_schedulers_online"></marker> @@ -6491,7 +6653,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="11"/> + <name name="system_flag" arity="2" clause_i="12"/> <fsummary>Sets system flag <c>trace_control_word</c>.</fsummary> <desc> <p>Sets the value of the node trace control word to @@ -7854,6 +8016,14 @@ ok <c>inactive</c>, and later <c>active</c> when the port callback returns.</p> </item> + <tag><c>monotonic_timestamp</c></tag> + <item> + <p>Timestamps in profile messages will use + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. The time-stamp (Ts) has the same + format and value as produced by + <c>erlang:monotonic_time(nano_seconds)</c>.</p> + </item> <tag><c>runnable_procs</c></tag> <item> <p>If a process is put into or removed from the run queue, a @@ -7874,6 +8044,25 @@ ok <c>{profile, scheduler, Id, State, NoScheds, Ts}</c>, is sent to <c><anno>ProfilerPid</anno></c>.</p> </item> + <tag><c>strict_monotonic_timestamp</c></tag> + <item> + <p>Timestamps in profile messages will consisting of + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> and a monotonically increasing + integer. The time-stamp (Ts) has the same format and value + as produced by <c>{erlang:monotonic_time(nano_seconds), + erlang:unique_integer([monotonic])}</c>.</p> + </item> + <tag><c>timestamp</c></tag> + <item> + <p>Timestamps in profile messages will include a + time-stamp (Ts) that has the same form as returned by + <c>erlang:now()</c>. This is also the default if no + timestamp flag is given. If <c>cpu_timestamp</c> has + been enabled via <c>erlang:trace/3</c>, this will also + effect the timestamp produced in profiling messages + when <c>timestamp</c> flag is enabled.</p> + </item> </taglist> <note><p><c>erlang:system_profile</c> is considered experimental and its behavior can change in a future release.</p> @@ -8233,7 +8422,10 @@ timestamp() -> <tag><c>cpu_timestamp</c></tag> <item> <p>A global trace flag for the Erlang node that makes all - trace time-stamps to be in CPU time, not wall clock time. + trace time-stamps using the <c>timestamp</c> flag to be + in CPU time, not wall clock time. That is, <c>cpu_timestamp</c> + will not be used if <c>monotonic_timestamp</c>, or + <c>strict_monotonic_timestamp</c> is enabled. Only allowed with <c>PidSpec==all</c>. If the host machine OS does not support high-resolution CPU time measurements, <c>trace/3</c> exits with @@ -8241,6 +8433,26 @@ timestamp() -> not synchronize this value across cores, so be prepared that time might seem to go backwards when using this option.</p> </item> + <tag><c>monotonic_timestamp</c></tag> + <item> + <p>Includes an + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> time-stamp in all trace messages. The + time-stamp (Ts) has the same format and value as produced by + <c>erlang:monotonic_time(nano_seconds)</c>. This flag overrides + the <c>cpu_timestamp</c> flag.</p> + </item> + <tag><c>strict_monotonic_timestamp</c></tag> + <item> + <p>Includes an timestamp consisting of + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> and a monotonically increasing + integer in all trace messages. The time-stamp (Ts) has the + same format and value as produced by + <c>{erlang:monotonic_time(nano_seconds), + erlang:unique_integer([monotonic])}</c>. This flag overrides + the <c>cpu_timestamp</c> flag.</p> + </item> <tag><c>arity</c></tag> <item> <p>Used with the <c>call</c> trace flag. @@ -8287,9 +8499,16 @@ timestamp() -> in the following list. <c>Pid</c> is the process identifier of the traced process in which the traced event has occurred. The third tuple element is the message tag.</p> - <p>If flag <c>timestamp</c> is given, the first tuple - element is <c>trace_ts</c> instead, and the time-stamp - is added last in the message tuple.</p> + <p>If flag <c>timestamp</c>, <c>strict_monotonic_timestamp</c>, or + <c>monotonic_timestamp</c> is given, the first tuple + element is <c>trace_ts</c> instead, and the time-stamp + is added as an extra element last in the message tuple. If + multiple timestamp flags are passed, <c>timestamp</c> has + precedence over <c>strict_monotonic_timestamp</c> which + in turn has precedence over <c>monotonic_timestamp</c>. All + timestamp flags are remembered, so if two are passed + and the one with highest precedence later is disabled + the other one will become active.</p> <marker id="trace_3_trace_messages"></marker> <taglist> <tag><c>{trace, Pid, 'receive', Msg}</c></tag> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index f4b806fae9..12148ad9c7 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -776,7 +776,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \ $(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_ptab.o $(OBJDIR)/erl_map.o \ + $(OBJDIR)/erl_msacc.o ifeq ($(TARGET),win32) DRV_OBJS = \ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 898f0fd9df..6fb08ee896 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -102,6 +102,7 @@ atom asynchronous atom atom atom atom_used atom attributes +atom await_microstate_accounting_modifications atom await_port_send_result atom await_proc_exit atom await_result @@ -172,6 +173,7 @@ atom const atom context_switches atom control atom copy +atom counters atom cpu atom cpu_timestamp atom cr @@ -269,6 +271,7 @@ atom get_tcw atom getenv atom gather_gc_info_result atom gather_io_bytes +atom gather_microstate_accounting_result atom gather_sched_wall_time_result atom getting_linked atom getting_unlinked @@ -360,6 +363,7 @@ atom merge_trap atom meta atom meta_match_spec atom micro_seconds +atom microstate_accounting atom milli_seconds atom min_heap_size atom min_bin_vheap_size @@ -373,6 +377,7 @@ atom monitor atom monitor_nodes atom monitors atom monotonic +atom monotonic_timestamp atom more atom multi_scheduling atom multiline @@ -557,6 +562,7 @@ atom static atom stderr_to_stdout atom stop atom stream +atom strict_monotonic_timestamp atom sunrm atom suspend atom suspended diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 2a23da4f25..5d471d168b 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -864,7 +864,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, Eterm* cpp; int return_to_trace = 0; BeamInstr w; - BeamInstr *cp_save; + BeamInstr *cp_save = c_p->cp; Uint32 flags; Uint need = 0; Eterm* E = c_p->stop; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 659ff3ad2f..10f132abfc 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -113,6 +113,9 @@ do { \ #define MAX(x, y) (((x) > (y)) ? (x) : (y)) #endif +#define GET_BIF_MODULE(p) ((Eterm) (((Export *) p)->code[0])) +#define GET_BIF_FUNCTION(p) ((Eterm) (((Export *) p)->code[1])) +#define GET_BIF_ARITY(p) ((Eterm) (((Export *) p)->code[2])) #define GET_BIF_ADDRESS(p) ((BifFunction) (((Export *) p)->code[4])) #define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm)))) @@ -1249,6 +1252,8 @@ void process_main(void) Uint64 start_time = 0; /* Monitor long schedule */ BeamInstr* start_time_i = NULL; + ERTS_MSACC_DECLARE_CACHE_X() /* a cached value of the tsd pointer for msacc */ + ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */ @@ -1302,6 +1307,8 @@ void process_main(void) ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_MSACC_UPDATE_CACHE_X(); + if (erts_system_monitor_long_schedule != 0) { start_time = erts_timestamp_millis(); start_time_i = c_p->i; @@ -2741,11 +2748,21 @@ do { \ */ OpCase(call_bif_e): { - Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); + Eterm (*bf)(Process*, Eterm*, BeamInstr*); Eterm result; BeamInstr *next; ErlHeapFragment *live_hf_end; + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + if (GET_BIF_MODULE(Arg(0)) == am_ets) { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS); + } else { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF); + } + } + + bf = GET_BIF_ADDRESS(Arg(0)); + PRE_BIF_SWAPOUT(c_p); c_p->fcalls = FCALLS - 1; if (FCALLS <= 0) { @@ -2768,6 +2785,12 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); HTOP = HEAP_TOP(c_p); FCALLS = 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)); @@ -3452,6 +3475,8 @@ do { \ BifFunction vbf; ErlHeapFragment *live_hf_end; + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); + DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); c_p->current = I-3; /* current and vbf set to please handle_error */ SWAPOUT; @@ -3476,6 +3501,8 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + DTRACE_NIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); goto apply_bif_or_nif_epilogue; @@ -3490,6 +3517,13 @@ do { \ * code[3]: &&apply_bif * code[4]: Function pointer to BIF function */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + if ((Eterm)I[-3] == am_ets) { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS); + } else { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF); + } + } c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */ c_p->i = I; /* In case we apply check_process_code/2. */ @@ -3516,7 +3550,12 @@ do { \ 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, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); apply_bif_or_nif_epilogue: @@ -3885,7 +3924,7 @@ do { \ Op1 += Arg1; store_bs_add_result: - if (MY_IS_SSMALL((Sint) Op1)) { + if (Op1 <= MAX_SMALL) { Op1 = make_small(Op1); } else { /* @@ -4895,6 +4934,38 @@ do { \ } } + /* 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) || HALFWORD_HEAP + 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, I-3, reg, am_breakpoint); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index d367cce212..4d67587b10 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -6322,6 +6322,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) code_hdr->literals_end = NULL; code_hdr->literals_off_heap = 0; code_hdr->on_load_function_ptr = NULL; + code_hdr->line_table = NULL; code_hdr->md5_ptr = NULL; /* diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index bb9165cd79..e116b10b95 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -44,6 +44,7 @@ #include "erl_ptab.h" #include "erl_bits.h" #include "erl_bif_unique.h" +#include "erl_msacc.h" Export *erts_await_result; static Export* flush_monitor_messages_trap = NULL; @@ -54,6 +55,9 @@ Export* erts_format_cpu_topology_trap = NULL; static Export dsend_continue_trap_export; Export *erts_convert_time_unit_trap = NULL; +static Export *await_msacc_mod_trap = NULL; +static erts_smp_atomic32_t msacc; + static Export *await_sched_wall_time_mod_trap; static erts_smp_atomic32_t sched_wall_time; @@ -2143,7 +2147,11 @@ BIF_RETTYPE send_3(BIF_ALIST_3) int connect = !0; Eterm l = opts; Sint result; + DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P); + + ERTS_MSACC_PUSH_STATE_M_X(); + UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); ctx->suspend = !0; @@ -2172,7 +2180,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3) ref = NIL; #endif + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_SEND); result = do_send(p, to, msg, &ref, ctx); + ERTS_MSACC_POP_STATE_M_X(); + if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) @@ -2288,8 +2299,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) Eterm ref; Sint result; DeclareTypedTmpHeap(ErtsSendContext, ctx, p); + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_SEND); UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); - #ifdef DEBUG ref = NIL; #endif @@ -2300,7 +2311,9 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; result = do_send(p, to, msg, &ref, ctx); - + + ERTS_MSACC_POP_STATE_M_X(); + if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) @@ -2904,175 +2917,20 @@ BIF_RETTYPE integer_to_list_1(BIF_ALIST_1) /**********************************************************************/ -/* convert a list of ascii ascii integer value to an integer */ - - -#define LTI_BAD_STRUCTURE 0 -#define LTI_NO_INTEGER 1 -#define LTI_SOME_INTEGER 2 -#define LTI_ALL_INTEGER 3 - -static int do_list_to_integer(Process *p, Eterm orig_list, - Eterm *integer, Eterm *rest) -{ - Sint i = 0; - Uint ui = 0; - int skip = 0; - int neg = 0; - Sint n = 0; - int m; - int lg2; - Eterm res; - Eterm* hp; - Eterm *hp_end; - Eterm lst = orig_list; - Eterm tail = lst; - int error_res = LTI_BAD_STRUCTURE; - - if (is_nil(lst)) { - error_res = LTI_NO_INTEGER; - error: - *rest = tail; - *integer = make_small(0); - return error_res; - } - if (is_not_list(lst)) - goto error; - - /* if first char is a '-' then it is a negative integer */ - if (CAR(list_val(lst)) == make_small('-')) { - neg = 1; - skip = 1; - lst = CDR(list_val(lst)); - if (is_not_list(lst)) { - tail = lst; - error_res = LTI_NO_INTEGER; - goto error; - } - } else if (CAR(list_val(lst)) == make_small('+')) { - /* ignore plus */ - skip = 1; - lst = CDR(list_val(lst)); - if (is_not_list(lst)) { - tail = lst; - error_res = LTI_NO_INTEGER; - goto error; - } - } - - /* Calculate size and do type check */ - - while(1) { - if (is_not_small(CAR(list_val(lst)))) { - break; - } - if (unsigned_val(CAR(list_val(lst))) < '0' || - unsigned_val(CAR(list_val(lst))) > '9') { - break; - } - ui = ui * 10; - ui = ui + unsigned_val(CAR(list_val(lst))) - '0'; - n++; - lst = CDR(list_val(lst)); - if (is_nil(lst)) { - break; - } - if (is_not_list(lst)) { - break; - } - } - - tail = lst; - if (!n) { - error_res = LTI_NO_INTEGER; - goto error; - } - - - /* If n <= 8 then we know it's a small int - ** since 2^27 = 134217728. If n > 8 then we must - ** construct a bignum and let that routine do the checking - */ - - if (n <= SMALL_DIGITS) { /* It must be small */ - if (neg) i = -(Sint)ui; - else i = (Sint)ui; - res = make_small(i); - } else { - /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219 - which we round up to (3 + 1/3) */ - lg2 = (n+1)*3 + (n+1)/3 + 1; - m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ - m = BIG_NEED_SIZE(m); /* number of words + thing */ - - hp = HAlloc(p, m); - hp_end = hp + m; - - lst = orig_list; - if (skip) - lst = CDR(list_val(lst)); - - /* load first digits (at least one digit) */ - if ((i = (n % D_DECIMAL_EXP)) == 0) - i = D_DECIMAL_EXP; - n -= i; - m = 0; - while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); - lst = CDR(list_val(lst)); - } - res = small_to_big(m, hp); /* load first digits */ - - while(n) { - i = D_DECIMAL_EXP; - n -= D_DECIMAL_EXP; - m = 0; - while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); - lst = CDR(list_val(lst)); - } - if (is_small(res)) - res = small_to_big(signed_val(res), hp); - res = big_times_small(res, D_DECIMAL_BASE, hp); - if (is_small(res)) - res = small_to_big(signed_val(res), hp); - res = big_plus_small(res, m, hp); - } - - if (neg) { - if (is_small(res)) - res = make_small(-signed_val(res)); - else { - Uint *big = big_val(res); /* point to thing */ - *big = bignum_header_neg(*big); - } - } - - if (is_not_small(res)) { - res = big_plus_small(res, 0, hp); /* includes conversion to small */ +/* + * Converts a list of ascii base10 digits to an integer fully or partially. + * Returns result and the remaining tail. + * On error returns: {error,not_a_list}, or {error, no_integer} + */ - if (is_not_small(res)) { - hp += (big_arity(res)+1); - } - } - HRelease(p,hp_end,hp); - } - *integer = res; - *rest = tail; - if (tail != NIL) { - return LTI_SOME_INTEGER; - } - return LTI_ALL_INTEGER; -} BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) { Eterm res; Eterm tail; Eterm *hp; /* must be a list */ - switch (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&tail)) { - /* HAlloc after do_list_to_integer as it - might HAlloc itself (bignum) */ + switch (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, &res, &tail)) { + /* HAlloc after erts_list_to_integer as it might HAlloc itself (bignum) */ case LTI_BAD_STRUCTURE: hp = HAlloc(BIF_P,3); BIF_RET(TUPLE2(hp, am_error, am_not_a_list)); @@ -3087,13 +2945,14 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) { - /* Using do_list_to_integer is about twice as fast as using + /* Using erts_list_to_integer is about twice as fast as using erts_chars_to_integer because we do not have to copy the entire list */ Eterm res; Eterm dummy; /* must be a list */ - if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) { + if (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, + &res, &dummy) != LTI_ALL_INTEGER) { BIF_ERROR(BIF_P,BADARG); } BIF_RET(res); @@ -3101,14 +2960,12 @@ BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) { - /* Bif implementation is about 50% faster than pure erlang, and since we have erts_chars_to_integer now it is simpler as well. This could be optmized further if we did not have to copy the list to buf. */ int i; - Eterm res; - char *buf = NULL; + Eterm res, dummy; int base; i = erts_list_length(BIF_ARG_1); @@ -3116,31 +2973,16 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); base = signed_val(BIF_ARG_2); - + if (base < 2 || base > 36) BIF_ERROR(BIF_P, BADARG); - /* Take fast path if base it 10 */ - if (base == 10) - return list_to_integer_1(BIF_P,&BIF_ARG_1); - - buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); - - if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) - goto list_to_integer_1_error; - buf[i] = '\0'; /* null terminal */ - - if ((res = erts_chars_to_integer(BIF_P,buf,i,base)) == THE_NON_VALUE) - goto list_to_integer_1_error; - - erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (erts_list_to_integer(BIF_P, BIF_ARG_1, base, + &res, &dummy) != LTI_ALL_INTEGER) { + BIF_ERROR(BIF_P,BADARG); + } BIF_RET(res); - - list_to_integer_1_error: - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_ERROR(BIF_P, BADARG); - - } +} /**********************************************************************/ @@ -4586,6 +4428,31 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) default: ERTS_INTERNAL_ERROR("Unknown state"); } +#ifdef ERTS_ENABLE_MSACC + } else if (BIF_ARG_1 == am_microstate_accounting) { + Eterm threads; + if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) { + erts_aint32_t new = BIF_ARG_2 == am_true ? ERTS_MSACC_ENABLE : ERTS_MSACC_DISABLE; + erts_aint32_t old = erts_smp_atomic32_xchg_nob(&msacc, new); + Eterm ref = erts_msacc_request(BIF_P, new, &threads); + if (is_non_value(ref)) + BIF_RET(old ? am_true : am_false); + BIF_TRAP3(await_msacc_mod_trap, + BIF_P, + ref, + old ? am_true : am_false, + threads); + } else if (BIF_ARG_2 == am_reset) { + Eterm ref = erts_msacc_request(BIF_P, ERTS_MSACC_RESET, &threads); + erts_aint32_t old = erts_smp_atomic32_read_nob(&msacc); + ASSERT(is_value(ref)); + BIF_TRAP3(await_msacc_mod_trap, + BIF_P, + ref, + old ? am_true : am_false, + threads); + } +#endif } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { int what; if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2)) @@ -4915,8 +4782,12 @@ void erts_init_bif(void) await_port_send_result_trap = erts_export_put(am_erts_internal, am_await_port_send_result, 3); await_sched_wall_time_mod_trap - = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2); + = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2); + await_msacc_mod_trap + = erts_export_put(am_erts_internal, am_await_microstate_accounting_modifications, 3); + erts_smp_atomic32_init_nob(&sched_wall_time, 0); + erts_smp_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED()); } #ifdef HARDDEBUG diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 1b8ae8cef5..4efc055aaf 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -170,6 +170,7 @@ bif erts_internal:term_type/1 bif erts_internal:map_hashmap_children/1 bif erts_internal:time_unit/0 +bif erts_internal:perf_counter_unit/0 bif erts_internal:is_system_process/1 @@ -369,6 +370,7 @@ bif os:getpid/0 bif os:timestamp/0 bif os:system_time/0 bif os:system_time/1 +bif os:perf_counter/0 # # Bifs in the erl_ddll module (the module actually does not exist) diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 02d37e24df..11838e24ef 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -48,7 +48,7 @@ _t_dst = (dst)+((sz)-1); \ _t_src = (src)+((sz)-1); \ while(_t_sz--) *_t_dst-- = *_t_src--; \ - } \ + } \ } while(0) /* add a and b with carry in + out */ @@ -423,6 +423,25 @@ #endif +/* Forward declaration of lookup tables (See below in this file) used in list to + * integer conversions for different bases. Also used in bignum printing. + */ +static const byte digits_per_sint_lookup[36-1]; +static const byte digits_per_small_lookup[36-1]; +static const Sint largest_power_of_base_lookup[36-1]; + +static ERTS_INLINE byte get_digits_per_signed_int(Uint base) { + return digits_per_sint_lookup[base-2]; +} + +static ERTS_INLINE byte get_digits_per_small(Uint base) { + return digits_per_small_lookup[base-2]; +} + +static ERTS_INLINE Sint get_largest_power_of_base(Uint base) { + return largest_power_of_base_lookup[base-2]; +} + /* ** compare two number vectors */ @@ -1719,8 +1738,10 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) short sign = BIG_SIGN(xp); ErtsDigit rem; Uint n = 0; + const Uint digits_per_Sint = get_digits_per_signed_int(10); + const Sint largest_pow_of_base = get_largest_power_of_base(10); - if (xl == 1 && *dx < D_DECIMAL_BASE) { + if (xl == 1 && *dx < largest_pow_of_base) { rem = *dx; if (rem == 0) { (*write_func)(arg, '0'); n++; @@ -1738,7 +1759,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) MOVE_DIGITS(tmp, dx, xl); while(1) { - tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem); + tmpl = D_div(tmp, tmpl, largest_pow_of_base, tmp, &rem); if (tmpl == 1 && *tmp == 0) { while(rem) { (*write_func)(arg, (rem % 10)+'0'); n++; @@ -1746,7 +1767,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) } break; } else { - int i = D_DECIMAL_EXP; + Uint i = digits_per_Sint; while(i--) { (*write_func)(arg, (rem % 10)+'0'); n++; rem /= 10; @@ -2522,63 +2543,100 @@ int term_equals_2pow32(Eterm x) } } +static ERTS_INLINE int c2int_is_invalid_char(byte ch, int base) { + return (ch < '0' + || (ch > ('0' + base - 1) + && !(base > 10 + && ((ch >= 'a' && ch < ('a' + base - 10)) + || (ch >= 'A' && ch < ('A' + base - 10)))))); +} -#define IS_VALID_CHARACTER(CHAR,BASE) \ - (CHAR < '0' \ - || (CHAR > ('0' + BASE - 1) \ - && !(BASE > 10 \ - && ((CHAR >= 'a' && CHAR < ('a' + BASE - 10)) \ - || (CHAR >= 'A' && CHAR < ('A' + BASE - 10)))))) -#define CHARACTER_FROM_BASE(CHAR) \ - ((CHAR <= '9') ? CHAR - '0' : 10 + ((CHAR <= 'Z') ? CHAR - 'A' : CHAR - 'a')) -#define D_BASE_EXP(BASE) (d_base_exp_lookup[BASE-2]) -#define D_BASE_BASE(BASE) (d_base_base_lookup[BASE-2]) -#define LG2_LOOKUP(BASE) (lg2_lookup[base-2]) +static ERTS_INLINE byte c2int_digit_from_base(byte ch) { + return ch <= '9' ? ch - '0' + : (10 + (ch <= 'Z' ? ch - 'A' : ch - 'a')); +} /* - * for i in 2..64 do - * lg2_lookup[i-2] = log2(i) - * end - * How many bits are needed to store string of size n + * How many bits are needed to store 1 digit of given base in binary + * Wo.Alpha formula: Table [log2[n], {n,2,36}] */ -const double lg2_lookup[] = { 1.0, 1.58496, 2, 2.32193, 2.58496, 2.80735, 3.0, - 3.16993, 3.32193, 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, - 4.08746, 4.16993, 4.24793, 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, - 4.64386, 4.70044, 4.75489, 4.80735, 4.85798, 4.90689, 4.9542, 5.0, - 5.04439, 5.08746, 5.12928, 5.16993, 5.20945, 5.24793, 5.2854, 5.32193, - 5.35755, 5.39232, 5.42626, 5.45943, 5.49185, 5.52356, 5.55459, 5.58496, - 5.61471, 5.64386, 5.67243, 5.70044, 5.72792, 5.75489, 5.78136, 5.80735, - 5.83289, 5.85798, 5.88264, 5.90689, 5.93074, 5.9542, 5.97728, 6.0 }; +static const double lg2_lookup[36-1] = { + 1.0, 1.58496, 2.0, 2.32193, 2.58496, 2.80735, 3.0, 3.16993, 3.32193, + 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, 4.08746, 4.16993, 4.24793, + 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, 4.64386, 4.70044, 4.75489, + 4.80735, 4.85798, 4.90689, 4.9542, 5.0, 5.04439, 5.08746, 5.12928, 5.16993 +}; +static ERTS_INLINE double lookup_log2(Uint base) { + return lg2_lookup[base - 2]; +} /* - * for i in 2..64 do - * d_base_exp_lookup[i-2] = 31 / lg2_lookup[i-2]; - * end - * How many characters can fit in 31 bits + * How many digits can fit into a signed int (Sint) for given base, we take + * one digit away just to be on the safer side (some corner cases). */ -const byte d_base_exp_lookup[] = { 31, 19, 15, 13, 11, 11, 10, 9, 9, 8, 8, 8, 8, - 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5 }; +static const byte digits_per_sint_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Trunc[31 / log[2,n]]-1, {n, 2, 36}] */ + 30, 18, 14, 12, 10, 10, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Trunc[63 / log[2,n]]-1, {n, 2, 36}] */ + 62, 38, 30, 26, 23, 21, 20, 18, 17, 17, 16, 16, 15, 15, 14, 14, 14, 13, 13, + 13, 13, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11, 11, 11 +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; /* - * for i in 2..64 do - * d_base_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]); - * end - * How much can the characters which fit in 31 bit represent + * How many digits can fit into Erlang Small (SMALL_BITS-1) counting sign bit */ -const Uint d_base_base_lookup[] = { 2147483648u, 1162261467u, 1073741824u, - 1220703125u, 362797056u, 1977326743u, 1073741824u, 387420489u, - 1000000000u, 214358881u, 429981696u, 815730721u, 1475789056u, - 170859375u, 268435456u, 410338673u, 612220032u, 893871739u, 1280000000u, - 1801088541u, 113379904u, 148035889u, 191102976u, 244140625u, 308915776u, - 387420489u, 481890304u, 594823321u, 729000000u, 887503681u, 1073741824u, - 1291467969u, 1544804416u, 1838265625u, 60466176u, 69343957u, 79235168u, - 90224199u, 102400000u, 115856201u, 130691232u, 147008443u, 164916224u, - 184528125u, 205962976u, 229345007u, 254803968u, 282475249u, 312500000u, - 345025251u, 380204032u, 418195493u, 459165024u, 503284375u, 550731776u, - 601692057u, 656356768u, 714924299u, 777600000u, 844596301u, 916132832u, - 992436543u, 1073741824u }; +static const byte digits_per_small_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Trunc[27 / log[2,n]]-1, {n, 2, 36}] */ + 27, 17, 13, 11, 10, 9, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Trunc[59 / log[2,n]]-1, {n, 2, 36}] */ + 59, 37, 29, 25, 22, 21, 19, 18, 17, 17, 16, 15, 15, 15, 14, 14, 14, 13, 13, + 13, 13, 13, 12, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11 +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; + +/* + * Largest power of base which can be represented in a signed int (Sint). + * Calculated by base 2..36 to the power of corresponding element from + * digits_per_sint_lookup. + */ +static const Sint largest_power_of_base_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Pow[n, Trunc[31 / log[2,n]]-1], {n, 2, 36}] */ + 1073741824, 387420489, 268435456, 244140625, 60466176, 282475249, 134217728, + 43046721, 100000000, 19487171, 35831808, 62748517, 105413504, 11390625, + 16777216, 24137569, 34012224, 47045881, 64000000, 85766121, 5153632, + 6436343,7962624, 9765625, 11881376, 14348907, 17210368, 20511149, 24300000, + 28629151, 33554432, 39135393, 45435424, 52521875, 1679616 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Pow[n, Trunc[63 / log[2,n]]-1], {n, 2, 36}] + * with LL added after each element manually */ + 4611686018427387904LL, 1350851717672992089LL, 1152921504606846976LL, + 1490116119384765625LL, 789730223053602816LL, 558545864083284007LL, + 1152921504606846976LL, 150094635296999121LL, 100000000000000000LL, + 505447028499293771LL, 184884258895036416LL, 665416609183179841LL, + 155568095557812224LL, 437893890380859375LL, 72057594037927936LL, + 168377826559400929LL, 374813367582081024LL, 42052983462257059LL, + 81920000000000000LL, 154472377739119461LL, 282810057883082752LL, + 21914624432020321LL, 36520347436056576LL, 59604644775390625LL, + 95428956661682176LL, 150094635296999121LL, 232218265089212416LL, + 12200509765705829LL, 17714700000000000LL, 25408476896404831LL, + 36028797018963968LL, 50542106513726817LL, 70188843638032384LL, + 96549157373046875LL, 131621703842267136LL +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, Uint size, const int base) { @@ -2588,8 +2646,11 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, int neg = 0; byte b; Eterm *hp, *hp_end; - int m; + Sint m; int lg2; + const Uint digits_per_small = get_digits_per_small(base); + const Uint digits_per_Sint = get_digits_per_signed_int(base); + const Sint largest_pow_of_base = get_largest_power_of_base(base); if (size == 0) goto bytebuf_to_integer_1_error; @@ -2604,57 +2665,68 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, size--; } + /* Trim leading zeroes */ + if (size) { + while (*bytes == '0') { + bytes++; + size--; + if (!size) { + /* All zero! */ + res = make_small(0); + goto bytebuf_to_integer_1_done; + } + } + } + if (size == 0) goto bytebuf_to_integer_1_error; - if (size < SMALL_DIGITS && base <= 10) { - /* * - * Take shortcut if we know that all chars are '0' < b < '9' and - * fit in a small. This improves speed by about 10% over the generic - * small case. - * */ - while (size--) { - b = *bytes++; + if (size < digits_per_small) { + if (base <= 10) { + /* * + * Take shortcut if we know that all chars are '0' < b < '9' and + * fit in a small. This improves speed by about 10% over the generic + * small case. + * */ + while (size--) { + b = *bytes++; - if (b < '0' || b > ('0'+base-1)) - goto bytebuf_to_integer_1_error; + if (b < '0' || b > ('0'+base-1)) + goto bytebuf_to_integer_1_error; - i = i * base + b - '0'; - } + i = i * base + b - '0'; + } - if (neg) - i = -i; - res = make_small(i); - goto bytebuf_to_integer_1_done; + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; + } + + /* Take shortcut if we know it will fit in a small. + * This improves speed by about 30%. + */ + while (size) { + b = *bytes++; + size--; + + if (c2int_is_invalid_char(b, base)) + goto bytebuf_to_integer_1_error; + + i = i * base + c2int_digit_from_base(b); + } + + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; } /* * Calculate the maximum number of bits which will * be needed to represent the binary */ - lg2 = ((size+2)*LG2_LOOKUP(base)+1); - - if (lg2 < SMALL_BITS) { - /* Take shortcut if we know it will fit in a small. - * This improves speed by about 30%. - */ - while (size) { - b = *bytes++; - size--; - - if (IS_VALID_CHARACTER(b,base)) - goto bytebuf_to_integer_1_error; - - i = i * base + CHARACTER_FROM_BASE(b); - - } - - if (neg) - i = -i; - res = make_small(i); - goto bytebuf_to_integer_1_done; - - } + lg2 = ((size+2)*lookup_log2(base)+1); /* Start calculating bignum */ m = (lg2 + D_EXP-1)/D_EXP; @@ -2663,8 +2735,8 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, hp = HAlloc(BIF_P, m); hp_end = hp + m; - if ((i = (size % D_BASE_EXP(base))) == 0) - i = D_BASE_EXP(base); + if ((i = (size % digits_per_Sint)) == 0) + i = digits_per_Sint; n = size - i; m = 0; @@ -2672,34 +2744,34 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, while (i--) { b = *bytes++; - if (IS_VALID_CHARACTER(b,base)) { + if (c2int_is_invalid_char(b,base)) { HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_error; } - m = base * m + CHARACTER_FROM_BASE(b); + m = base * m + c2int_digit_from_base(b); } res = small_to_big(m, hp); while (n) { - i = D_BASE_EXP(base); - n -= D_BASE_EXP(base); + i = digits_per_Sint; + n -= digits_per_Sint; m = 0; while (i--) { b = *bytes++; - if (IS_VALID_CHARACTER(b,base)) { + if (c2int_is_invalid_char(b,base)) { HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_error; } - m = base * m + CHARACTER_FROM_BASE(b); + m = base * m + c2int_digit_from_base(b); } if (is_small(res)) { res = small_to_big(signed_val(res), hp); } - res = big_times_small(res, D_BASE_BASE(base), hp); + res = big_times_small(res, largest_pow_of_base, hp); if (is_small(res)) { res = small_to_big(signed_val(res), hp); } @@ -2730,5 +2802,166 @@ bytebuf_to_integer_1_error: bytebuf_to_integer_1_done: return res; +} +/* Converts list of digits with given 'base' to integer sequentially. Returns + * result in 'integer_out', remaining tail goes to 'tail_out' and returns result + * code if the list was consumed fully or partially or there was an error + */ +LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list, + const Uint base, + Eterm *integer_out, Eterm *tail_out) +{ + Sint i = 0; + Uint ui = 0; + int skip = 0; + int neg = 0; + Sint n = 0; + Sint m; + int lg2; + Eterm res; + Eterm lst = orig_list; + Eterm tail = lst; + int error_res = LTI_BAD_STRUCTURE; + const Uint digits_per_small = get_digits_per_small(base); + const Uint digits_per_Sint = get_digits_per_signed_int(base); + + if (is_nil(lst)) { + error_res = LTI_NO_INTEGER; + error: + *tail_out = tail; + *integer_out = make_small(0); + return error_res; + } + if (is_not_list(lst)) + goto error; + + /* if first char is a '-' then it is a negative integer */ + if (CAR(list_val(lst)) == make_small('-')) { + neg = 1; + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } else if (CAR(list_val(lst)) == make_small('+')) { + /* ignore plus */ + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } + + /* Calculate size and do type check */ + + while(1) { + byte ch; + if (is_not_small(CAR(list_val(lst)))) { + break; + } + ch = unsigned_val(CAR(list_val(lst))); + if (c2int_is_invalid_char(ch, base)) { + break; + } + ui = ui * base; + ui = ui + c2int_digit_from_base(ch); + n++; + lst = CDR(list_val(lst)); + if (is_nil(lst)) { + break; + } + if (is_not_list(lst)) { + break; + } + } + + tail = lst; + if (!n) { + error_res = LTI_NO_INTEGER; + goto error; + } + + + /* If length fits inside Sint then we know it's a small int. Else we + * must construct a bignum and let that routine do the checking + */ + + if (n <= digits_per_small) { /* It must be small */ + i = neg ? -(Sint)ui : (Sint)ui; + res = make_small(i); + } else { + const Sint largest_pow_of_base = get_largest_power_of_base(base); + Eterm *hp; + Eterm *hp_end; + + /* Convert from log_base to log2 using lookup table */ + lg2 = ((n+2)*lookup_log2(base)+1); + m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ + m = BIG_NEED_SIZE(m); /* number of words + thing */ + + hp = HAlloc(BIF_P, m); + hp_end = hp + m; + + lst = orig_list; + if (skip) + lst = CDR(list_val(lst)); + + /* load first digits (at least one digit) */ + if ((i = (n % digits_per_Sint)) == 0) + i = digits_per_Sint; + n -= i; + m = 0; + while(i--) { + m *= base; + m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst)))); + lst = CDR(list_val(lst)); + } + res = small_to_big(m, hp); /* load first digits */ + + while(n) { + i = digits_per_Sint; + n -= digits_per_Sint; + m = 0; + while(i--) { + m *= base; + m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst)))); + lst = CDR(list_val(lst)); + } + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_times_small(res, largest_pow_of_base, hp); + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_plus_small(res, m, hp); + } + + if (neg) { + if (is_small(res)) + res = make_small(-signed_val(res)); + else { + Uint *big = big_val(res); /* point to thing */ + *big = bignum_header_neg(*big); + } + } + + if (is_not_small(res)) { + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (is_not_small(res)) { + hp += (big_arity(res)+1); + } + } + HRelease(BIF_P, hp_end, hp); + } + *integer_out = res; + *tail_out = tail; + if (tail != NIL) { + return LTI_SOME_INTEGER; + } + return LTI_ALL_INTEGER; } diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 94f9bce10e..9c92de6b55 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -54,9 +54,6 @@ typedef Uint32 ErtsHalfDigit; #error "can not determine machine size" #endif -#define D_DECIMAL_EXP 9 -#define D_DECIMAL_BASE 1000000000 - typedef Uint dsize_t; /* Vector size type */ #define D_EXP (ERTS_SIZEOF_ETERM*8) @@ -173,4 +170,15 @@ Eterm erts_sint64_to_big(Sint64, Eterm **); Eterm erts_chars_to_integer(Process *, char*, Uint, const int); +/* How list_to_integer classifies the input, was it even a string? */ +typedef enum { + LTI_BAD_STRUCTURE = 0, + LTI_NO_INTEGER = 1, + LTI_SOME_INTEGER = 2, + LTI_ALL_INTEGER = 3 +} LTI_result_t; + +LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list, + const Uint base, + Eterm *integer_out, Eterm *tail_out); #endif diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 5544712e8d..806f569c38 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -103,9 +103,9 @@ static Uint install_debug_functions(void); static int lock_all_physical_memory = 0; -ErtsAllocatorFunctions_t erts_allctrs[ERTS_ALC_A_MAX+1]; +ErtsAllocatorFunctions_t ERTS_WRITE_UNLIKELY(erts_allctrs[ERTS_ALC_A_MAX+1]); ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1]; -ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]; +ErtsAllocatorThrSpec_t ERTS_WRITE_UNLIKELY(erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]); #define ERTS_MIN(A, B) ((A) < (B) ? (A) : (B)) #define ERTS_MAX(A, B) ((A) > (B) ? (A) : (B)) @@ -968,6 +968,10 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu) else #endif { +#ifdef ERTS_SMP + erl_exit(ERTS_ABORT_EXIT, "%salloc is not thread safe\n", + init->init.util.name_prefix); +#else af->alloc = erts_alcu_alloc; if (init->init.util.fix_type_size) af->realloc = erts_realloc_fixed_size; @@ -976,6 +980,7 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu) else af->realloc = erts_alcu_realloc; af->free = erts_alcu_free; +#endif } af->extra = NULL; ai->alloc_util = 1; @@ -1917,7 +1922,7 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) va_start(argp, n); size = va_arg(argp, Uint); va_end(argp); - erl_exit(1, + erl_exit(-1, "%s: Cannot %s %lu bytes of memory (of type \"%s\").\n", allctr_str, op, size, t_str); break; @@ -3402,8 +3407,11 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3) init.enable = 1; init.atype = GOODFIT; init.init.util.name_prefix = (char *) a1; - init.init.util.ts = a2 ? 1 : 0; - +#ifdef ERTS_SMP + init.init.util.ts = 1; +#else + init.init.util.ts = a2 ? 1 : 0; +#endif if ((char **) a3) { char **argv = (char **) a3; int i = 0; diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 14e80960f5..71e4713624 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -233,12 +233,14 @@ ERTS_ALC_INLINE void *erts_alloc(ErtsAlcType_t type, Uint size) { void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, size); if (!res) erts_alloc_n_enomem(ERTS_ALC_T2N(type), size); + ERTS_MSACC_POP_STATE_X(); return res; } @@ -246,6 +248,7 @@ ERTS_ALC_INLINE void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size) { void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, @@ -253,37 +256,48 @@ void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size) size); if (!res) erts_realloc_n_enomem(ERTS_ALC_T2N(type), ptr, size); + ERTS_MSACC_POP_STATE_X(); return res; } ERTS_ALC_INLINE void erts_free(ErtsAlcType_t type, void *ptr) { + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); (*erts_allctrs[ERTS_ALC_T2A(type)].free)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, ptr); + ERTS_MSACC_POP_STATE_X(); } ERTS_ALC_INLINE void *erts_alloc_fnf(ErtsAlcType_t type, Uint size) { - return (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( + void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); + res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, size); + ERTS_MSACC_POP_STATE_X(); + return res; } ERTS_ALC_INLINE void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size) { - return (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( + void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); + res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, ptr, size); + ERTS_MSACC_POP_STATE_X(); + return res; } ERTS_ALC_INLINE diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index e0bc71c88a..5f153ac0ab 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -361,6 +361,7 @@ type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap +type MSACC DRIVER SYSTEM microstate_accounting # # Types used by system specific code diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index eedfd1e13d..3230b6ef34 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -5337,6 +5337,11 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) { void *res; +#ifdef ERTS_SMP + ASSERT(!"This is not thread safe"); +#elif defined(USE_THREADS) + ASSERT(erts_equal_tids(erts_main_thread, erts_thr_self())); +#endif res = do_erts_alcu_alloc(type, extra, size); DEBUG_CHECK_ALIGNMENT(res); return res; diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index be0bc0cfec..cdeeb5281b 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -400,13 +400,19 @@ static ERTS_INLINE void call_async_ready(ErtsAsync *a) ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); #endif if (!p) { - if (a->async_free) + if (a->async_free) { + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT); a->async_free(a->async_data); + ERTS_MSACC_POP_STATE(); + } } else { if (async_ready(p, a->async_data)) { - if (a->async_free) + if (a->async_free) { + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT); a->async_free(a->async_data); + ERTS_MSACC_POP_STATE(); + } } #if ERTS_USE_ASYNC_READY_Q erts_port_release(p); @@ -460,6 +466,8 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq) { ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT; erts_tse_t *tse = erts_tse_fetch(); + ERTS_DECLARE_DUMMY(Uint no); + #ifdef ERTS_SMP ErtsThrPrgrCallbacks callbacks; @@ -483,10 +491,12 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq) /* Inform main thread that we are done initializing... */ erts_mtx_lock(&async->init.data.mtx); - async->init.data.no_initialized++; + no = async->init.data.no_initialized++; erts_cnd_signal(&async->init.data.cnd); erts_mtx_unlock(&async->init.data.mtx); + erts_msacc_init_thread("async", no, 0); + return tse; } @@ -494,6 +504,7 @@ static void *async_main(void* arg) { ErtsAsyncQ *aq = (ErtsAsyncQ *) arg; erts_tse_t *tse = async_thread_init(aq); + ERTS_MSACC_DECLARE_CACHE(); while (1) { ErtsThrQPrepEnQ_t *prep_enq; @@ -501,11 +512,14 @@ static void *async_main(void* arg) if (is_nil(a->port)) break; /* Time to die */ + ERTS_MSACC_UPDATE_CACHE(); + #if ERTS_ASYNC_PRINT_JOB erts_fprintf(stderr, "<- %ld\n", a->async_id); #endif - + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); a->async_invoke(a->async_data); + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER); async_reply(a, prep_enq); } @@ -628,10 +642,13 @@ long driver_async(ErlDrvPort ix, unsigned int* key, unsigned int qix; #if ERTS_USE_ASYNC_READY_Q Uint sched_id; + ERTS_MSACC_PUSH_STATE(); sched_id = erts_get_scheduler_id(); if (!sched_id) sched_id = 1; +#else + ERTS_MSACC_PUSH_STATE(); #endif prt = erts_drvport2port(ix); @@ -684,12 +701,17 @@ long driver_async(ErlDrvPort ix, unsigned int* key, return id; } #endif - + + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); (*a->async_invoke)(a->async_data); + ERTS_MSACC_POP_STATE(); if (async_ready(prt, a->async_data)) { - if (a->async_free != NULL) + if (a->async_free != NULL) { + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); (*a->async_free)(a->async_data); + ERTS_MSACC_POP_STATE(); + } } erts_free(ERTS_ALC_T_ASYNC, (void *) a); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 06e7dc8661..017339e1f6 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -64,6 +64,7 @@ static Export* alloc_sizes_trap = NULL; static Export* gather_io_bytes_trap = NULL; static Export *gather_sched_wall_time_res_trap; +static Export *gather_msacc_res_trap; static Export *gather_gc_info_res_trap; #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) @@ -3260,6 +3261,14 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) szp = NULL; hpp = &hp; } +#ifdef ERTS_ENABLE_MSACC + } else if (BIF_ARG_1 == am_microstate_accounting) { + Eterm threads; + res = erts_msacc_request(BIF_P, ERTS_MSACC_GATHER, &threads); + if (is_non_value(res)) + BIF_RET(am_undefined); + BIF_TRAP2(gather_msacc_res_trap, BIF_P, res, threads); +#endif } else if (BIF_ARG_1 == am_context_switches) { Eterm cs = erts_make_integer(erts_get_total_context_switches(), BIF_P); hp = HAlloc(BIF_P, 3); @@ -4396,6 +4405,9 @@ erts_bif_info_init(void) = erts_export_put(am_erlang, am_gather_gc_info_result, 1); gather_io_bytes_trap = erts_export_put(am_erts_internal, am_gather_io_bytes, 2); + gather_msacc_res_trap + = erts_export_put(am_erts_internal, am_gather_microstate_accounting_result, 2); + process_info_init(); os_info_init(); } diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 4d67e39e7e..71a7079b09 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -431,6 +431,9 @@ Uint erts_trace_flag2bit(Eterm flag) { switch (flag) { + case am_timestamp: return F_NOW_TS; + case am_strict_monotonic_timestamp: return F_STRICT_MON_TS; + case am_monotonic_timestamp: return F_MON_TS; case am_all: return TRACEE_FLAGS; case am_send: return F_TRACE_SEND; case am_receive: return F_TRACE_RECEIVE; @@ -439,7 +442,6 @@ erts_trace_flag2bit(Eterm flag) case am_set_on_first_spawn: return F_TRACE_SOS1; case am_set_on_link: return F_TRACE_SOL; case am_set_on_first_link: return F_TRACE_SOL1; - case am_timestamp: return F_TIMESTAMP; case am_running: return F_TRACE_SCHED; case am_exiting: return F_TRACE_SCHED_EXIT; case am_garbage_collection: return F_TRACE_GC; @@ -592,7 +594,7 @@ Eterm trace_3(BIF_ALIST_3) ERTS_TRACE_FLAGS(tracee_port) |= mask; else ERTS_TRACE_FLAGS(tracee_port) &= ~mask; - + if (!ERTS_TRACE_FLAGS(tracee_port)) ERTS_TRACER_PROC(tracee_port) = NIL; else if (tracer != NIL) @@ -978,7 +980,7 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) } if (key == am_flags) { - int num_flags = 19; /* MAXIMUM number of flags. */ + int num_flags = 21; /* MAXIMUM number of flags. */ Uint needed = 3+2*num_flags; Eterm flag_list = NIL; Eterm* limit; @@ -996,6 +998,9 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) #endif hp = HAlloc(p, needed); limit = hp+needed; + FLAG(F_NOW_TS, am_timestamp); + FLAG(F_STRICT_MON_TS, am_strict_monotonic_timestamp); + FLAG(F_MON_TS, am_monotonic_timestamp); FLAG(F_TRACE_SEND, am_send); FLAG(F_TRACE_RECEIVE, am_receive); FLAG(F_TRACE_SOS, am_set_on_spawn); @@ -1007,7 +1012,6 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) FLAG(F_TRACE_SCHED, am_running); FLAG(F_TRACE_SCHED_EXIT, am_exiting); FLAG(F_TRACE_GC, am_garbage_collection); - FLAG(F_TIMESTAMP, am_timestamp); FLAG(F_TRACE_ARITY_ONLY, am_arity); FLAG(F_TRACE_RETURN_TO, am_return_to); FLAG(F_TRACE_SILENT, am_silent); @@ -1798,7 +1802,11 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2, } else if (arg1 == am_print) { current_flag = SEQ_TRACE_PRINT; } else if (arg1 == am_timestamp) { - current_flag = SEQ_TRACE_TIMESTAMP; + current_flag = SEQ_TRACE_NOW_TS; + } else if (arg1 == am_strict_monotonic_timestamp) { + current_flag = SEQ_TRACE_STRICT_MON_TS; + } else if (arg1 == am_monotonic_timestamp) { + current_flag = SEQ_TRACE_MON_TS; } else current_flag = 0; @@ -1901,7 +1909,9 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { if ((item == am_send) || (item == am_receive) || - (item == am_print) || (item == am_timestamp)) { + (item == am_print) || (item == am_timestamp) + || (item == am_monotonic_timestamp) + || (item == am_strict_monotonic_timestamp)) { hp = HAlloc(p,3); res = TUPLE2(hp, item, am_false); BIF_RET(res); @@ -1919,7 +1929,11 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) } else if (item == am_print) { current_flag = SEQ_TRACE_PRINT; } else if (item == am_timestamp) { - current_flag = SEQ_TRACE_TIMESTAMP; + current_flag = SEQ_TRACE_NOW_TS; + } else if (item == am_strict_monotonic_timestamp) { + current_flag = SEQ_TRACE_STRICT_MON_TS; + } else if (item == am_monotonic_timestamp) { + current_flag = SEQ_TRACE_MON_TS; } else { current_flag = 0; } @@ -2221,6 +2235,7 @@ static Eterm system_profile_get(Process *p) { if (erts_system_profile_flags.exclusive) { res = CONS(hp, am_exclusive, res); hp += 2; } + return TUPLE2(hp, system_profile, res); } } @@ -2239,6 +2254,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2) int system_blocked = 0; Process *profiler_p = NULL; Port *profiler_port = NULL; + int ts; if (profiler == am_undefined || list == NIL) { prev = system_profile_get(p); @@ -2270,7 +2286,8 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2) goto error; } - for (scheduler = 0, runnable_ports = 0, runnable_procs = 0, exclusive = 0; + for (ts = ERTS_TRACE_FLG_NOW_TIMESTAMP, scheduler = 0, + runnable_ports = 0, runnable_procs = 0, exclusive = 0; is_list(list); list = CDR(list_val(list))) { @@ -2283,6 +2300,12 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2) exclusive = !0; } else if (t == am_scheduler) { scheduler = !0; + } else if (t == am_timestamp) { + ts = ERTS_TRACE_FLG_NOW_TIMESTAMP; + } else if (t == am_strict_monotonic_timestamp) { + ts = ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP; + } else if (t == am_monotonic_timestamp) { + ts = ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP; } else goto error; } if (is_not_nil(list)) goto error; @@ -2295,7 +2318,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2) erts_system_profile_flags.runnable_ports = !!runnable_ports; erts_system_profile_flags.runnable_procs = !!runnable_procs; erts_system_profile_flags.exclusive = !!exclusive; - + erts_system_profile_ts_type = ts; erts_smp_thr_progress_unblock(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 3030c1c91a..55b8789e29 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1376,7 +1376,6 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) status |= DB_ORDERED_SET; status &= ~(DB_SET | DB_BAG | DB_DUPLICATE_BAG); } - /*TT*/ else if (is_tuple(val)) { Eterm *tp = tuple_val(val); if (arityval(tp[0]) == 2) { @@ -3460,10 +3459,10 @@ static void fix_table_locked(Process* p, DbTable* tb) #endif erts_refc_inc(&tb->common.ref,1); fix = tb->common.fixations; - if (fix == NULL) { - get_now(&(tb->common.megasec), - &(tb->common.sec), - &(tb->common.microsec)); + if (fix == NULL) { + tb->common.time.monotonic + = erts_get_monotonic_time(ERTS_PROC_GET_SCHDATA(p)); + tb->common.time.offset = erts_get_time_offset(); } else { for (; fix != NULL; fix = fix->next) { @@ -3722,6 +3721,7 @@ static int free_table_cont(Process *p, static Eterm table_info(Process* p, DbTable* tb, Eterm What) { Eterm ret = THE_NON_VALUE; + int use_monotonic; if (What == am_size) { ret = make_small(erts_smp_atomic_read_nob(&tb->common.nitems)); @@ -3779,7 +3779,10 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) ret = am_true; else ret = am_false; - } else if (What == am_atom_put("safe_fixed",10)) { + } else if ((use_monotonic + = ERTS_IS_ATOM_STR("safe_fixed_monotonic_time", + What)) + || ERTS_IS_ATOM_STR("safe_fixed", What)) { #ifdef ERTS_SMP erts_smp_mtx_lock(&tb->common.fixlock); #endif @@ -3788,7 +3791,19 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) Eterm *hp; Eterm tpl, lst; DbFixation *fix; - need = 7; + Sint64 mtime; + + need = 3; + if (use_monotonic) { + mtime = (Sint64) tb->common.time.monotonic; + mtime += ERTS_MONOTONIC_OFFSET_NATIVE; + if (!IS_SSMALL(mtime)) + need += ERTS_SINT64_HEAP_SIZE(mtime); + } + else { + mtime = 0; + need += 4; + } for (fix = tb->common.fixations; fix != NULL; fix = fix->next) { need += 5; } @@ -3800,11 +3815,18 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) lst = CONS(hp,tpl,lst); hp += 2; } - tpl = TUPLE3(hp, - make_small(tb->common.megasec), - make_small(tb->common.sec), - make_small(tb->common.microsec)); - hp += 4; + if (use_monotonic) + tpl = (IS_SSMALL(mtime) + ? make_small(mtime) + : erts_sint64_to_big(mtime, &hp)); + else { + Uint ms, s, us; + erts_make_timestamp_value(&ms, &s, &us, + tb->common.time.monotonic, + tb->common.time.offset); + tpl = TUPLE3(hp, make_small(ms), make_small(s), make_small(us)); + hp += 4; + } ret = TUPLE2(hp, tpl, lst); } else { ret = am_false; diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index c0966655cd..911ed37aef 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -226,7 +226,10 @@ typedef struct db_table_common { DbTableMethod* meth; /* table methods */ erts_smp_atomic_t nitems; /* Total number of items in table */ erts_smp_atomic_t memory_size;/* Total memory size. NOTE: in bytes! */ - Uint megasec,sec,microsec; /* Last fixation time */ + struct { /* Last fixation time */ + ErtsMonotonicTime monotonic; + ErtsMonotonicTime offset; + } time; DbFixation* fixations; /* List of processes who have done safe_fixtable, "local" fixations not included. */ /* All 32-bit fields */ diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 0636171ad1..0234b9b0e4 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -37,43 +37,6 @@ # endif #endif -#ifdef SIZEOF_CHAR -# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR -# undef SIZEOF_CHAR -#endif -#ifdef SIZEOF_SHORT -# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT -# undef SIZEOF_SHORT -#endif -#ifdef SIZEOF_INT -# define SIZEOF_INT_SAVED__ SIZEOF_INT -# undef SIZEOF_INT -#endif -#ifdef SIZEOF_LONG -# define SIZEOF_LONG_SAVED__ SIZEOF_LONG -# undef SIZEOF_LONG -#endif -#ifdef SIZEOF_LONG_LONG -# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG -# undef SIZEOF_LONG_LONG -#endif -#include "erl_int_sizes_config.h" -#if defined(SIZEOF_CHAR_SAVED__) && SIZEOF_CHAR_SAVED__ != SIZEOF_CHAR -# error SIZEOF_CHAR mismatch -#endif -#if defined(SIZEOF_SHORT_SAVED__) && SIZEOF_SHORT_SAVED__ != SIZEOF_SHORT -# error SIZEOF_SHORT mismatch -#endif -#if defined(SIZEOF_INT_SAVED__) && SIZEOF_INT_SAVED__ != SIZEOF_INT -# error SIZEOF_INT mismatch -#endif -#if defined(SIZEOF_LONG_SAVED__) && SIZEOF_LONG_SAVED__ != SIZEOF_LONG -# error SIZEOF_LONG mismatch -#endif -#if defined(SIZEOF_LONG_LONG_SAVED__) && SIZEOF_LONG_LONG_SAVED__ != SIZEOF_LONG_LONG -# error SIZEOF_LONG_LONG mismatch -#endif - #include "erl_drv_nif.h" #include <stdlib.h> @@ -168,28 +131,12 @@ typedef struct { /* * Integer types */ -#if defined(__WIN32__) && (SIZEOF_VOID_P == 8) -typedef unsigned __int64 ErlDrvTermData; -typedef unsigned __int64 ErlDrvUInt; -typedef signed __int64 ErlDrvSInt; -#else -typedef unsigned long ErlDrvTermData; -typedef unsigned long ErlDrvUInt; -typedef signed long ErlDrvSInt; -#endif -#if defined(__WIN32__) -typedef unsigned __int64 ErlDrvUInt64; -typedef __int64 ErlDrvSInt64; -#elif SIZEOF_LONG == 8 -typedef unsigned long ErlDrvUInt64; -typedef long ErlDrvSInt64; -#elif SIZEOF_LONG_LONG == 8 -typedef unsigned long long ErlDrvUInt64; -typedef long long ErlDrvSInt64; -#else -#error No 64-bit integer type -#endif +typedef ErlNapiUInt64 ErlDrvUInt64; +typedef ErlNapiSInt64 ErlDrvSInt64; +typedef ErlNapiUInt ErlDrvUInt; +typedef ErlNapiSInt ErlDrvSInt; +typedef ErlNapiUInt ErlDrvTermData; #if defined(__WIN32__) || defined(_WIN32) typedef ErlDrvUInt ErlDrvSizeT; @@ -242,6 +189,17 @@ typedef struct { unsigned long microsecs; } ErlDrvNowData; +typedef ErlDrvSInt64 ErlDrvTime; + +#define ERL_DRV_TIME_ERROR ((ErlDrvSInt64) ERTS_NAPI_TIME_ERROR__) + +typedef enum { + ERL_DRV_SEC = ERTS_NAPI_SEC__, + ERL_DRV_MSEC = ERTS_NAPI_MSEC__, + ERL_DRV_USEC = ERTS_NAPI_USEC__, + ERL_DRV_NSEC = ERTS_NAPI_NSEC__ +} ErlDrvTimeUnit; + /* * Error codes that can be return from driver. */ @@ -678,8 +636,16 @@ EXTERN long driver_async(ErlDrvPort ix, EXTERN int driver_lock_driver(ErlDrvPort ix); /* Get the current 'now' timestamp (analogue to erlang:now()) */ -EXTERN int driver_get_now(ErlDrvNowData *now); - +EXTERN int driver_get_now(ErlDrvNowData *now) ERL_DRV_DEPRECATED_FUNC; + +/* Erlang Monotonic Time */ +EXTERN ErlDrvTime erl_drv_monotonic_time(ErlDrvTimeUnit time_unit); +/* Time offset between Erlang Monotonic Time and Erlang System Time */ +EXTERN ErlDrvTime erl_drv_time_offset(ErlDrvTimeUnit time_unit); +/* Time unit conversion */ +EXTERN ErlDrvTime erl_drv_convert_time_unit(ErlDrvTime val, + ErlDrvTimeUnit from, + ErlDrvTimeUnit to); /* These were removed from the ANSI version, now they're back. */ diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h index e2385f63f4..f6b946ae82 100644 --- a/erts/emulator/beam/erl_drv_nif.h +++ b/erts/emulator/beam/erl_drv_nif.h @@ -50,6 +50,90 @@ typedef enum { } ErlDrvDirtyJobFlags; #endif +#ifdef SIZEOF_CHAR +# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR +# undef SIZEOF_CHAR +#endif +#ifdef SIZEOF_SHORT +# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT +# undef SIZEOF_SHORT +#endif +#ifdef SIZEOF_INT +# define SIZEOF_INT_SAVED__ SIZEOF_INT +# undef SIZEOF_INT +#endif +#ifdef SIZEOF_LONG +# define SIZEOF_LONG_SAVED__ SIZEOF_LONG +# undef SIZEOF_LONG +#endif +#ifdef SIZEOF_LONG_LONG +# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG +# undef SIZEOF_LONG_LONG +#endif +#ifdef HALFWORD_HEAP_EMULATOR +# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR +# undef HALFWORD_HEAP_EMULATOR +#endif +#include "erl_int_sizes_config.h" +#if defined(SIZEOF_CHAR_SAVED__) && SIZEOF_CHAR_SAVED__ != SIZEOF_CHAR +# error SIZEOF_CHAR mismatch +#endif +#if defined(SIZEOF_SHORT_SAVED__) && SIZEOF_SHORT_SAVED__ != SIZEOF_SHORT +# error SIZEOF_SHORT mismatch +#endif +#if defined(SIZEOF_INT_SAVED__) && SIZEOF_INT_SAVED__ != SIZEOF_INT +# error SIZEOF_INT mismatch +#endif +#if defined(SIZEOF_LONG_SAVED__) && SIZEOF_LONG_SAVED__ != SIZEOF_LONG +# error SIZEOF_LONG mismatch +#endif +#if defined(SIZEOF_LONG_LONG_SAVED__) && SIZEOF_LONG_LONG_SAVED__ != SIZEOF_LONG_LONG +# error SIZEOF_LONG_LONG mismatch +#endif + +#if !defined(__GNUC__) && (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +typedef unsigned __int64 ErlNapiUInt64; +typedef signed __int64 ErlNapiSInt64; +#define ERL_NAPI_SINT64_MAX__ 9223372036854775807i64 +#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1i64) +#elif SIZEOF_LONG == 8 +typedef unsigned long ErlNapiUInt64; +typedef signed long ErlNapiSInt64; +#define ERL_NAPI_SINT64_MAX__ 9223372036854775807L +#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1L) +#elif SIZEOF_LONG_LONG == 8 +typedef unsigned long long ErlNapiUInt64; +typedef signed long long ErlNapiSInt64; +#define ERL_NAPI_SINT64_MAX__ 9223372036854775807LL +#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1LL) +#else +# error No 64-bit integer type +#endif + +#if SIZEOF_VOID_P == 8 +typedef ErlNapiUInt64 ErlNapiUInt; +typedef ErlNapiSInt64 ErlNapiSInt; +#elif SIZEOF_VOID_P == 4 +# if SIZEOF_LONG == SIZEOF_VOID_P +typedef unsigned long ErlNapiUInt; +typedef signed long ErlNapiSInt; +# elif SIZEOF_INT == SIZEOF_VOID_P +typedef unsigned int ErlNapiUInt; +typedef signed int ErlNapiSInt; +# else +# error No 32-bit integer type +# endif +#else +# error Not support arch +#endif + +#define ERTS_NAPI_TIME_ERROR__ ERL_NAPI_SINT64_MIN__ + +#define ERTS_NAPI_SEC__ 0 +#define ERTS_NAPI_MSEC__ 1 +#define ERTS_NAPI_USEC__ 2 +#define ERTS_NAPI_NSEC__ 3 + #endif /* __ERL_DRV_NIF_H__ */ diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 06acece471..21b03ae8bd 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -576,6 +576,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, int reds; ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */ ErtsSchedulerData *esdp; + ERTS_MSACC_PUSH_STATE_M(); #ifdef USE_VM_PROBES DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif @@ -588,6 +589,8 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, else if (p->live_hf_end != ERTS_INVALID_HFRAG_PTR) live_hf_end = p->live_hf_end; + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_GC); + esdp = erts_get_scheduler_data(); if (IS_TRACED_FL(p, F_TRACE_GC)) { @@ -624,9 +627,11 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, } else { do_major_collection: + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC_FULL); DTRACE2(gc_major_start, pidbuf, need); reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); DTRACE2(gc_major_end, pidbuf, reclaimed_now); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC); } reset_active_writer(p); @@ -669,6 +674,8 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, FLAGS(p) &= ~F_FORCE_GC; p->live_hf_end = ERTS_INVALID_HFRAG_PTR; + ERTS_MSACC_POP_STATE_M(); + #ifdef CHECK_FOR_HOLES /* * We intentionally do not rescan the areas copied by the GC. diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 42aca726bf..67089df863 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -152,7 +152,7 @@ volatile int erts_writing_erl_crash_dump = 0; int erts_initialized = 0; #if defined(USE_THREADS) && !defined(ERTS_SMP) -static erts_tid_t main_thread; +erts_tid_t erts_main_thread; #endif int erts_use_sender_punish; @@ -394,6 +394,7 @@ erl_init(int ncpu, #endif packet_parser_init(); erl_nif_init(); + erts_msacc_init(); } static Eterm @@ -744,6 +745,10 @@ early_init(int *argc, char **argv) /* char envbuf[21]; /* enough for any 64-bit integer */ size_t envbufsz; +#if defined(USE_THREADS) && !defined(ERTS_SMP) + erts_main_thread = erts_thr_self(); +#endif + erts_save_emu_args(*argc, argv); erts_sched_compact_load = 1; @@ -797,9 +802,6 @@ early_init(int *argc, char **argv) /* (erts_aint32_t) ((Uint16) -1)); erts_pre_init_process(); -#if defined(USE_THREADS) && !defined(ERTS_SMP) - main_thread = erts_thr_self(); -#endif /* * We need to know the number of schedulers to use before we @@ -1193,6 +1195,7 @@ early_init(int *argc, char **argv) /* erts_thr_late_init(&elid); } #endif + erts_msacc_early_init(); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_late_init(); @@ -2220,6 +2223,7 @@ erl_start(int argc, char **argv) #else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); + erts_msacc_init_thread("scheduler", 1, 1); erts_thr_set_main_status(1, 1); #if ERTS_USE_ASYNC_READY_Q esdp->aux_work_data.async_ready.queue @@ -2285,7 +2289,7 @@ system_cleanup(int flush_async) if (!flush_async || !erts_initialized #if defined(USE_THREADS) && !defined(ERTS_SMP) - || !erts_equal_tids(main_thread, erts_thr_self()) + || !erts_equal_tids(erts_main_thread, erts_thr_self()) #endif ) return; diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index f7b4bd8041..598bf84c0b 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -137,6 +137,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "mmap_init_atoms", NULL }, { "drv_tsd", NULL }, { "async_enq_mtx", NULL }, + { "msacc_list_mutex", NULL }, + { "msacc_unmanaged_mutex", NULL }, #ifdef ERTS_SMP { "atom_tab", NULL }, { "misc_op_list_pre_alloc_lock", "address" }, diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index b3e74e3e6a..88efb2c59f 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -1504,7 +1504,7 @@ erts_factory_message_create(ErtsHeapFactory* factory, } if (on_heap) { - ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN); + ERTS_SMP_ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN); ASSERT(ohp == &proc->off_heap); factory->mode = FACTORY_HALLOC; factory->p = proc; diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c new file mode 100644 index 0000000000..71e3fd8b6e --- /dev/null +++ b/erts/emulator/beam/erl_msacc.c @@ -0,0 +1,486 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014-2015. 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: Microstate accounting. + * + * We keep track of the different states that the + * Erlang VM threads are in, in order to provide + * performance/debugging statistics. There is a + * small overhead in enabling this, but in the big + * scheme of things it should be negligible. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERTS_MSACC_STATE_STRINGS 1 + +#include "sys.h" +#include "global.h" +#include "erl_threads.h" +#include "erl_bif_unique.h" +#include "erl_map.h" +#include "erl_msacc.h" + +#if ERTS_ENABLE_MSACC + +static Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp); +static void erts_msacc_reset(ErtsMsAcc *msacc); +static ErtsMsAcc* get_msacc(void); + +#ifdef USE_THREADS +erts_tsd_key_t ERTS_WRITE_UNLIKELY(erts_msacc_key); +#else +ErtsMsAcc *ERTS_WRITE_UNLIKELY(erts_msacc) = NULL; +#endif +int ERTS_WRITE_UNLIKELY(erts_msacc_enabled); + +static Eterm *erts_msacc_state_atoms = NULL; +static erts_rwmtx_t msacc_mutex; +static ErtsMsAcc *msacc_managed = NULL; +#ifdef USE_THREADS +static ErtsMsAcc *msacc_unmanaged = NULL; +static Uint msacc_unmanaged_count = 0; +#endif + +/* we have to split initiation as atoms are not inited in early init */ +void erts_msacc_early_init(void) { +#ifndef ERTS_MSACC_ALWAYS_ON + erts_msacc_enabled = 0; +#endif + erts_rwmtx_init(&msacc_mutex,"msacc_list_mutex"); +#ifdef USE_THREADS + erts_tsd_key_create(&erts_msacc_key,"erts_msacc_key"); +#else + erts_msacc = NULL; +#endif +} + +void erts_msacc_init(void) { + int i; + erts_msacc_state_atoms = erts_alloc(ERTS_ALC_T_MSACC, + sizeof(Eterm)*ERTS_MSACC_STATE_COUNT); + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + erts_msacc_state_atoms[i] = am_atom_put(erts_msacc_states[i], + strlen(erts_msacc_states[i])); + } +} + +void erts_msacc_init_thread(char *type, int id, int managed) { + ErtsMsAcc *msacc; + + msacc = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMsAcc)); + + msacc->type = strdup(type); + msacc->id = make_small(id); + msacc->unmanaged = !managed; + msacc->tid = erts_thr_self(); + msacc->perf_counter = 0; + +#ifdef USE_THREADS + erts_rwmtx_rwlock(&msacc_mutex); + if (!managed) { + erts_mtx_init(&msacc->mtx,"msacc_unmanaged_mutex"); + msacc->next = msacc_unmanaged; + msacc_unmanaged = msacc; + msacc_unmanaged_count++; + ERTS_MSACC_TSD_SET(msacc); + } else { + msacc->next = msacc_managed; + msacc_managed = msacc; + } + erts_rwmtx_rwunlock(&msacc_mutex); +#else + msacc_managed = msacc; +#endif + + erts_msacc_reset(msacc); + +#ifdef ERTS_MSACC_ALWAYS_ON + ERTS_MSACC_TSD_SET(msacc); + msacc->perf_counter = erts_sys_perf_counter(); + msacc->state = ERTS_MSACC_STATE_OTHER; +#endif +} + +/* + * Creates a structure looking like this + * #{ type => scheduler, id => 1, counters => #{ State1 => Counter1 ... StateN => CounterN}} + */ +static +Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp) { + int i; + Eterm *hp; + Eterm key, state_key, state_map; + Eterm res = THE_NON_VALUE; + flatmap_t *map; + + if (szp) { + *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(3); + *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(ERTS_MSACC_STATE_COUNT); + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + (void)erts_bld_sint64(NULL,szp,(Sint64)msacc->perf_counters[i]); +#ifdef ERTS_MSACC_STATE_COUNTERS + (void)erts_bld_uint64(NULL,szp,msacc->state_counters[i]); + *szp += 3; /* tuple to put state+perf counter in */ +#endif + } + } + + if (hpp) { + Eterm counters[ERTS_MSACC_STATE_COUNT]; + hp = *hpp; + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + Eterm counter = erts_bld_sint64(&hp,NULL,(Sint64)msacc->perf_counters[i]); +#ifdef ERTS_MSACC_STATE_COUNTERS + Eterm counter__ = erts_bld_uint64(&hp,NULL,msacc->state_counters[i]); + counters[i] = TUPLE2(hp,counter,counter__); + hp += 3; +#else + counters[i] = counter; +#endif + } + + key = TUPLE3(hp,am_counters,am_id,am_type); + hp += 4; + + state_key = make_tuple(hp); + hp[0] = make_arityval(ERTS_MSACC_STATE_COUNT); + + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) + hp[1+i] = erts_msacc_state_atoms[i]; + hp += 1 + ERTS_MSACC_STATE_COUNT; + + map = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; + map->thing_word = MAP_HEADER_FLATMAP; + map->size = ERTS_MSACC_STATE_COUNT; + map->keys = state_key; + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) + hp[i] = counters[i]; + hp += ERTS_MSACC_STATE_COUNT; + state_map = make_flatmap(map); + + map = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; + map->thing_word = MAP_HEADER_FLATMAP; + map->size = 3; + map->keys = key; + hp[0] = state_map; + hp[1] = msacc->id; + hp[2] = am_atom_put(msacc->type,strlen(msacc->type)); + hp += 3; + + *hpp = hp; + res = make_flatmap(map); + } + + return res; +} + +typedef struct { + int action; + Process *proc; + Eterm ref; + Eterm ref_heap[REF_THING_SIZE]; + Uint req_sched; + erts_smp_atomic32_t refc; +} ErtsMSAccReq; + +static ErtsMsAcc* get_msacc(void) { + ErtsMsAcc *msacc; + erts_rwmtx_rlock(&msacc_mutex); + msacc = msacc_managed; + while (!erts_equal_tids(msacc->tid,erts_thr_self())) { + msacc = msacc->next; + ASSERT(msacc != NULL); + } + erts_rwmtx_runlock(&msacc_mutex); + return msacc; +} + +static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + Process *rp = msaccrp->proc; + ErtsMessage *msgp = NULL; + Eterm **hpp, *hp; + Eterm ref_copy = NIL, msg; + Uint sz, *szp; + ErlOffHeap *ohp = NULL; + ErtsProcLocks rp_locks = (esdp && msaccrp->req_sched == esdp->no + ? ERTS_PROC_LOCK_MAIN : 0); + + sz = 0; + hpp = NULL; + szp = &sz; + + if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx); + + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, msaccrp->ref); + else + *szp += REF_THING_SIZE; + + if (msaccrp->action != ERTS_MSACC_GATHER) + msg = ref_copy; + else { + msg = erts_msacc_gather_stats(msacc, hpp, szp); + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + } + if (hpp) + break; + + msgp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + hpp = &hp; + szp = NULL; + } + + if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx); + + erts_queue_message(rp, &rp_locks, msgp, msg, NIL); + + if (esdp && msaccrp->req_sched == esdp->no) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + +} + +static void +reply_msacc(void *vmsaccrp) +{ + ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET(); + ErtsMSAccReq *msaccrp = (ErtsMSAccReq *) vmsaccrp; + + ASSERT(!msacc || !msacc->unmanaged); + + if (msaccrp->action == ERTS_MSACC_ENABLE && !msacc) { + msacc = get_msacc(); + + msacc->perf_counter = erts_sys_perf_counter(); + + msacc->state = ERTS_MSACC_STATE_OTHER; + + ERTS_MSACC_TSD_SET(msacc); + + } else if (msaccrp->action == ERTS_MSACC_DISABLE && msacc) { + ERTS_MSACC_TSD_SET(NULL); + } else if (msaccrp->action == ERTS_MSACC_RESET) { + msacc = msacc ? msacc : get_msacc(); + erts_msacc_reset(msacc); + } else if (msaccrp->action == ERTS_MSACC_GATHER && !msacc) { + msacc = get_msacc(); + } + + ASSERT(!msacc || !msacc->unmanaged); + + send_reply(msacc, msaccrp); + + erts_proc_dec_refc(msaccrp->proc); + + if (erts_smp_atomic32_dec_read_nob(&msaccrp->refc) == 0) + erts_free(ERTS_ALC_T_MSACC, vmsaccrp); +} + +static void erts_msacc_reset(ErtsMsAcc *msacc) { + int i; + if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx); + + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + msacc->perf_counters[i] = 0; +#ifdef ERTS_MSACC_STATE_COUNTERS + msacc->state_counters[i] = 0; +#endif + } + + if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx); +} + +#endif /* ERTS_ENABLE_MSACC */ + + +/* + * This function is responsible for enabling, disabling, resetting and + * gathering data related to microstate accounting. + * + * Managed threads and unmanaged threads are handled differently. + * - managed threads get a misc_aux job telling them to switch on msacc + * - unmanaged have some fields protected by a mutex that has to be taken + * before any values can be updated + * + * For performance reasons there is also a global value erts_msacc_enabled + * that controls the state of all threads. Statistics gathering is only on + * if erts_msacc_enabled && msacc is true. + */ +Eterm +erts_msacc_request(Process *c_p, int action, Eterm *threads) +{ +#ifdef ERTS_ENABLE_MSACC + ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET(); + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + Eterm ref; + ErtsMSAccReq *msaccrp; + Eterm *hp; + + +#ifdef ERTS_MSACC_ALWAYS_ON + if (action == ERTS_MSACC_ENABLE || action == ERTS_MSACC_DISABLE) + return THE_NON_VALUE; +#else + /* take care of double enable, and double disable here */ + if (msacc && action == ERTS_MSACC_ENABLE) { + return THE_NON_VALUE; + } else if (!msacc && action == ERTS_MSACC_DISABLE) { + return THE_NON_VALUE; + } +#endif + + ref = erts_make_ref(c_p); + + msaccrp = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMSAccReq)); + hp = &msaccrp->ref_heap[0]; + + msaccrp->action = action; + msaccrp->proc = c_p; + msaccrp->ref = STORE_NC(&hp, NULL, ref); + msaccrp->req_sched = esdp->no; + +#ifdef ERTS_SMP + *threads = erts_no_schedulers; + *threads += 1; /* aux thread */ +#else + *threads = 1; +#endif + + erts_smp_atomic32_init_nob(&msaccrp->refc,(erts_aint32_t)*threads); + + erts_proc_add_refc(c_p, *threads); + + if (erts_no_schedulers > 1) + erts_schedule_multi_misc_aux_work(1, + erts_no_schedulers, + reply_msacc, + (void *) msaccrp); +#ifdef ERTS_SMP + /* aux thread */ + erts_schedule_misc_aux_work(0, reply_msacc, (void *) msaccrp); +#endif + +#ifdef USE_THREADS + /* Manage unmanaged threads */ + switch (action) { + case ERTS_MSACC_GATHER: { + Uint unmanaged_count; + ErtsMsAcc *msacc, **unmanaged; + int i = 0; + + /* we copy a list of pointers here so that we do not have to have + the msacc_mutex when sending messages */ + erts_rwmtx_rlock(&msacc_mutex); + unmanaged_count = msacc_unmanaged_count; + unmanaged = erts_alloc(ERTS_ALC_T_MSACC, + sizeof(ErtsMsAcc*)*unmanaged_count); + + for (i = 0, msacc = msacc_unmanaged; + i < unmanaged_count; + i++, msacc = msacc->next) { + unmanaged[i] = msacc; + } + erts_rwmtx_runlock(&msacc_mutex); + + for (i = 0; i < unmanaged_count; i++) { + erts_mtx_lock(&unmanaged[i]->mtx); + if (unmanaged[i]->perf_counter) { + ErtsSysPerfCounter perf_counter; + /* if enabled update stats */ + perf_counter = erts_sys_perf_counter(); + unmanaged[i]->perf_counters[unmanaged[i]->state] += + perf_counter - unmanaged[i]->perf_counter; + unmanaged[i]->perf_counter = perf_counter; + } + erts_mtx_unlock(&unmanaged[i]->mtx); + send_reply(unmanaged[i],msaccrp); + } + erts_free(ERTS_ALC_T_MSACC,unmanaged); + /* We have just sent unmanaged_count messages, so bump no of threads */ + *threads += unmanaged_count; + break; + } + case ERTS_MSACC_RESET: { + ErtsMsAcc *msacc; + erts_rwmtx_rlock(&msacc_mutex); + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) + erts_msacc_reset(msacc); + erts_rwmtx_runlock(&msacc_mutex); + break; + } + case ERTS_MSACC_ENABLE: { + erts_rwmtx_rlock(&msacc_mutex); + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) { + erts_mtx_lock(&msacc->mtx); + msacc->perf_counter = erts_sys_perf_counter(); + /* we assume the unmanaged thread is sleeping */ + msacc->state = ERTS_MSACC_STATE_SLEEP; + erts_mtx_unlock(&msacc->mtx); + } + erts_rwmtx_runlock(&msacc_mutex); + break; + } + case ERTS_MSACC_DISABLE: { + ErtsSysPerfCounter perf_counter; + erts_rwmtx_rlock(&msacc_mutex); + /* make sure to update stats with latest results */ + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) { + erts_mtx_lock(&msacc->mtx); + perf_counter = erts_sys_perf_counter(); + msacc->perf_counters[msacc->state] += perf_counter - msacc->perf_counter; + msacc->perf_counter = 0; + erts_mtx_unlock(&msacc->mtx); + } + erts_rwmtx_runlock(&msacc_mutex); + break; + } + default: { ASSERT(0); } + } + +#endif + + *threads = make_small(*threads); + + reply_msacc((void *) msaccrp); + +#ifndef ERTS_MSACC_ALWAYS_ON + /* enable/disable the global value */ + if (action == ERTS_MSACC_ENABLE) { + erts_msacc_enabled = 1; + } else if (action == ERTS_MSACC_DISABLE) { + erts_msacc_enabled = 0; + } +#endif + + return ref; +#else + return THE_NON_VALUE; +#endif +} diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h new file mode 100644 index 0000000000..284388f7aa --- /dev/null +++ b/erts/emulator/beam/erl_msacc.h @@ -0,0 +1,409 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014-2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_MSACC_H__ +#define ERL_MSACC_H__ + +/* Can be enabled/disabled via configure */ +#if ERTS_ENABLE_MSACC == 2 +#define ERTS_MSACC_EXTENDED_STATES 1 +#endif + +/* Uncomment this to also count the number of + transitions to a state. This will add a count + to the counter map. */ +/* #define ERTS_MSACC_STATE_COUNTERS 1 */ + +/* Uncomment this to make msacc to always be on, + this reduces overhead a little bit when profiling */ +/* #define ERTS_MSACC_ALWAYS_ON 1 */ + +#define ERTS_MSACC_DISABLE 0 +#define ERTS_MSACC_ENABLE 1 +#define ERTS_MSACC_RESET 2 +#define ERTS_MSACC_GATHER 3 + +/* + * When adding a new state, you have to: + * * Add it here + * * Increment ERTS_MSACC_STATE_COUNT + * * Add string value to erts_msacc_states + * * Have to be in alphabetical order! + * * Only add states to the non-extended section after + * careful benchmarking to make sure the overhead + * when disabled is minimal. + */ + +#ifndef ERTS_MSACC_EXTENDED_STATES +#define ERTS_MSACC_STATE_AUX 0 +#define ERTS_MSACC_STATE_CHECK_IO 1 +#define ERTS_MSACC_STATE_EMULATOR 2 +#define ERTS_MSACC_STATE_GC 3 +#define ERTS_MSACC_STATE_OTHER 4 +#define ERTS_MSACC_STATE_PORT 5 +#define ERTS_MSACC_STATE_SLEEP 6 + +#define ERTS_MSACC_STATE_COUNT 7 + +#if ERTS_MSACC_STATE_STRINGS && ERTS_ENABLE_MSACC +static char *erts_msacc_states[] = { + "aux", + "check_io", + "emulator", + "gc", + "other", + "port", + "sleep" +}; +#endif + +#else + +#define ERTS_MSACC_STATE_ALLOC 0 +#define ERTS_MSACC_STATE_AUX 1 +#define ERTS_MSACC_STATE_BIF 2 +#define ERTS_MSACC_STATE_BUSY_WAIT 3 +#define ERTS_MSACC_STATE_CHECK_IO 4 +#define ERTS_MSACC_STATE_EMULATOR 5 +#define ERTS_MSACC_STATE_ETS 6 +#define ERTS_MSACC_STATE_GC 7 +#define ERTS_MSACC_STATE_GC_FULL 8 +#define ERTS_MSACC_STATE_NIF 9 +#define ERTS_MSACC_STATE_OTHER 10 +#define ERTS_MSACC_STATE_PORT 11 +#define ERTS_MSACC_STATE_SEND 12 +#define ERTS_MSACC_STATE_SLEEP 13 +#define ERTS_MSACC_STATE_TIMERS 14 + +#define ERTS_MSACC_STATE_COUNT 15 + +#if ERTS_MSACC_STATE_STRINGS +static char *erts_msacc_states[] = { + "alloc", + "aux", + "bif", + "busy_wait", + "check_io", + "emulator", + "ets", + "gc", + "gc_full", + "nif", + "other", + "port", + "send", + "sleep", + "timers" +}; +#endif + +#endif + +typedef struct erl_msacc_t_ ErtsMsAcc; + +struct erl_msacc_t_ { + + /* the the values below are protected by mtx iff unmanaged = 1 */ + ErtsSysPerfCounter perf_counter; + ErtsSysPerfCounter perf_counters[ERTS_MSACC_STATE_COUNT]; +#ifdef ERTS_MSACC_STATE_COUNTERS + Uint64 state_counters[ERTS_MSACC_STATE_COUNT]; +#endif + Uint state; + + /* protected by msacc_mutex in erl_msacc.c, and should be constant */ + int unmanaged; + erts_mtx_t mtx; + ErtsMsAcc *next; + erts_tid_t tid; + Eterm id; + char *type; +}; + +#if ERTS_ENABLE_MSACC + +#define ERTS_MSACC_INLINE ERTS_GLB_INLINE + +#ifdef USE_THREADS +extern erts_tsd_key_t erts_msacc_key; +#else +extern ErtsMsAcc *erts_msacc; +#endif + +#ifdef ERTS_MSACC_ALWAYS_ON +#define erts_msacc_enabled 1 +#else +extern int erts_msacc_enabled; +#endif + +#ifdef USE_THREADS +#define ERTS_MSACC_TSD_GET() erts_tsd_get(erts_msacc_key) +#define ERTS_MSACC_TSD_SET(tsd) erts_tsd_set(erts_msacc_key,tsd) +#else +#define ERTS_MSACC_TSD_GET() erts_msacc +#define ERTS_MSACC_TSD_SET(tsd) erts_msacc = tsd +#endif + +void erts_msacc_early_init(void); +void erts_msacc_init(void); +void erts_msacc_init_thread(char *type, int id, int liberty); + +/* The defines below are used to instrument the vm code + * with different state changes. There are two variants + * of each define. One that has a cached ErtsMsAcc * + * that it can use, and one that does not. + * The cached values are necessary to have in order to get + * low enough overhead when running without msacc enabled. + * + * The two most common patterns to use the function with are: + * + * ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_NEWSTATE); + * ... call other function in new state ... + * ERTS_MSACC_POP_STATE(); + * + * Note that the erts_msacc_push* function declare new variables, so + * to conform with C89 we have to call it in the beginning of a function. + * We might not want to change state it the beginning though, so we use this: + * + * ERTS_MSACC_PUSH_STATE(); + * ... some other code ... + * ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_NEWSTATE); + * ... call other function in new state ... + * ERTS_MSACC_POP_STATE(); + * + * Notice that we used the cached version of set_state as push_state already + * read the erts_msacc_enabled to the cache. + * + * Most macros also have other variants with the suffix _m which means that + * they are known to only be called in managed threads, or with the _x suffix + * which means that it should only be used in an emulator compiled with + * extended states. + * + * Here is a listing of the entire api: + * + * void ERTS_MSACC_DECLARE_CACHE() + * void ERTS_MSACC_UPDATE_CACHE() + * void ERTS_MSACC_IS_ENABLED() + * void ERTS_MSACC_IS_ENABLED_CACHED() + * + * void ERTS_MSACC_PUSH_STATE() + * void ERTS_MSACC_SET_STATE(int state) + * void ERTS_MSACC_PUSH_AND_SET_STATE(int state) + * + * void ERTS_MSACC_PUSH_STATE_CACHED() + * void ERTS_MSACC_SET_STATE_CACHED(int state) + * void ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(int state) + * void ERTS_MSACC_POP_STATE() + * + * void ERTS_MSACC_PUSH_STATE_M() + * void ERTS_MSACC_PUSH_STATE_CACHED_M() + * void ERTS_MSACC_SET_STATE_CACHED_M(int state) + * void ERTS_MSACC_SET_STATE_M(int state) + * void ERTS_MSACC_POP_STATE_M() + * void ERTS_MSACC_PUSH_AND_SET_STATE_M(int state) + * + * Most functions are also available with an _x suffix that are only enabled + * when using the extra states. If they are not, just add them to the end + * of this file. + */ + +/* cache handling functions */ +#define ERTS_MSACC_IS_ENABLED() ERTS_UNLIKELY(erts_msacc_enabled) +#define ERTS_MSACC_DECLARE_CACHE() \ + ErtsMsAcc *ERTS_MSACC_UPDATE_CACHE(); \ + ERTS_DECLARE_DUMMY(Uint __erts_msacc_state) = ERTS_MSACC_STATE_OTHER; +#define ERTS_MSACC_IS_ENABLED_CACHED() ERTS_UNLIKELY(__erts_msacc_cache != NULL) +#define ERTS_MSACC_UPDATE_CACHE() \ + __erts_msacc_cache = erts_msacc_enabled ? ERTS_MSACC_TSD_GET() : NULL + + +/* The defines below implicitly declare and load a new cache */ +#define ERTS_MSACC_PUSH_STATE() \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_PUSH_STATE_CACHED() +#define ERTS_MSACC_SET_STATE(state) \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE(state) \ + ERTS_MSACC_PUSH_STATE(); ERTS_MSACC_SET_STATE_CACHED(state) + +/* The defines below need an already declared cache to work */ +#define ERTS_MSACC_PUSH_STATE_CACHED() \ + __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \ + erts_msacc_get_state_um__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER +#define ERTS_MSACC_SET_STATE_CACHED(state) \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_um__(__erts_msacc_cache, state, 1) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) \ + ERTS_MSACC_PUSH_STATE_CACHED(); ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_POP_STATE() \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_um__(__erts_msacc_cache, __erts_msacc_state, 0) + +/* Only use these defines when we know that we have in a managed thread */ +#define ERTS_MSACC_PUSH_STATE_M() \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M() \ + __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \ + erts_msacc_get_state_m__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER +#define ERTS_MSACC_SET_STATE_M(state) \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_SET_STATE_CACHED_M(state) \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_m__(__erts_msacc_cache, state, 1) +#define ERTS_MSACC_POP_STATE_M() \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0) +#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) \ + ERTS_MSACC_PUSH_STATE_M(); ERTS_MSACC_SET_STATE_CACHED_M(state) + +ERTS_MSACC_INLINE +void erts_msacc_set_state_um__(ErtsMsAcc *msacc,Uint state,int increment); +ERTS_MSACC_INLINE +void erts_msacc_set_state_m__(ErtsMsAcc *msacc,Uint state,int increment); + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc); +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc) { + Uint state; + if (msacc->unmanaged) + erts_mtx_lock(&msacc->mtx); + state = msacc->state; + if (msacc->unmanaged) + erts_mtx_unlock(&msacc->mtx); + return state; +} + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc) { + return msacc->state; +} + +ERTS_MSACC_INLINE +void erts_msacc_set_state_um__(ErtsMsAcc *msacc, Uint new_state, int increment) { + if (ERTS_UNLIKELY(msacc->unmanaged)) { + erts_mtx_lock(&msacc->mtx); + msacc->state = new_state; + if (ERTS_LIKELY(!msacc->perf_counter)) { + erts_mtx_unlock(&msacc->mtx); + return; + } + } + + erts_msacc_set_state_m__(msacc,new_state,increment); + + if (ERTS_UNLIKELY(msacc->unmanaged)) + erts_mtx_unlock(&msacc->mtx); +} + +ERTS_MSACC_INLINE +void erts_msacc_set_state_m__(ErtsMsAcc *msacc, Uint new_state, int increment) { + ErtsSysPerfCounter prev_perf_counter; + Sint64 diff; + + if (new_state == msacc->state) + return; + + prev_perf_counter = msacc->perf_counter; + msacc->perf_counter = erts_sys_perf_counter(); + diff = msacc->perf_counter - prev_perf_counter; + ASSERT(diff >= 0); + msacc->perf_counters[msacc->state] += diff; +#ifdef ERTS_MSACC_STATE_COUNTERS + msacc->state_counters[new_state] += increment; +#endif + msacc->state = new_state; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#else + +#define ERTS_MSACC_IS_ENABLED() 0 +#define erts_msacc_early_init() +#define erts_msacc_init() +#define erts_msacc_init_thread(type, id, liberty) +#define ERTS_MSACC_PUSH_STATE() +#define ERTS_MSACC_PUSH_STATE_CACHED() +#define ERTS_MSACC_POP_STATE() +#define ERTS_MSACC_SET_STATE(state) +#define ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) +#define ERTS_MSACC_UPDATE_CACHE() +#define ERTS_MSACC_IS_ENABLED_CACHED() +#define ERTS_MSACC_DECLARE_CACHE() +#define ERTS_MSACC_PUSH_STATE_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_POP_STATE_M() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) + + +#endif /* ERTS_ENABLE_MSACC */ + +#ifndef ERTS_MSACC_EXTENDED_STATES + +#define ERTS_MSACC_PUSH_STATE_X() +#define ERTS_MSACC_POP_STATE_X() +#define ERTS_MSACC_SET_STATE_X(state) +#define ERTS_MSACC_SET_STATE_M_X(state) +#define ERTS_MSACC_SET_STATE_CACHED_X(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state) +#define ERTS_MSACC_UPDATE_CACHE_X() +#define ERTS_MSACC_IS_ENABLED_CACHED_X() 0 +#define ERTS_MSACC_DECLARE_CACHE_X() +#define ERTS_MSACC_PUSH_STATE_M_X() +#define ERTS_MSACC_PUSH_STATE_CACHED_M_X() +#define ERTS_MSACC_SET_STATE_CACHED_M_X(state) +#define ERTS_MSACC_POP_STATE_M_X() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state) + +#else + +#define ERTS_MSACC_PUSH_STATE_X() ERTS_MSACC_PUSH_STATE() +#define ERTS_MSACC_POP_STATE_X() ERTS_MSACC_POP_STATE() +#define ERTS_MSACC_SET_STATE_X(state) ERTS_MSACC_SET_STATE(state) +#define ERTS_MSACC_SET_STATE_M_X(state) ERTS_MSACC_SET_STATE_M(state) +#define ERTS_MSACC_SET_STATE_CACHED_X(state) ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state) ERTS_MSACC_PUSH_AND_SET_STATE(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) +#define ERTS_MSACC_UPDATE_CACHE_X() ERTS_MSACC_UPDATE_CACHE() +#define ERTS_MSACC_IS_ENABLED_CACHED_X() ERTS_MSACC_IS_ENABLED_CACHED() +#define ERTS_MSACC_DECLARE_CACHE_X() ERTS_MSACC_DECLARE_CACHE() +#define ERTS_MSACC_PUSH_STATE_M_X() ERTS_MSACC_PUSH_STATE_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M_X() ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_SET_STATE_CACHED_M_X(state) ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_POP_STATE_M_X() ERTS_MSACC_POP_STATE_M() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_M(state) + +#endif /* !ERTS_MSACC_EXTENDED_STATES */ + +#endif /* ERL_MSACC_H__ */ diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index d659788f30..3bc4e62f0f 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1188,6 +1188,26 @@ void enif_thread_exit(void *resp) { erl_drv_thread_exit(resp); } int enif_thread_join(ErlNifTid tid, void **respp) { return erl_drv_thread_join(tid,respp); } int enif_getenv(const char *key, char *value, size_t *value_size) { return erl_drv_getenv(key, value, value_size); } +ErlNifTime enif_monotonic_time(ErlNifTimeUnit time_unit) +{ + return (ErlNifTime) erts_napi_monotonic_time((int) time_unit); +} + +ErlNifTime enif_time_offset(ErlNifTimeUnit time_unit) +{ + return (ErlNifTime) erts_napi_time_offset((int) time_unit); +} + +ErlNifTime +enif_convert_time_unit(ErlNifTime val, + ErlNifTimeUnit from, + ErlNifTimeUnit to) +{ + return (ErlNifTime) erts_napi_convert_time_unit((ErtsMonotonicTime) val, + (int) from, + (int) to); +} + int enif_fprintf(void* filep, const char* format, ...) { int ret; @@ -1785,12 +1805,10 @@ execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); ep->fp = NULL; + erts_smp_atomic32_read_band_mb(&proc->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC)); result = (*fp)(env, argc, argv); - erts_smp_atomic32_read_band_mb(&proc->state, - ~(ERTS_PSFLG_DIRTY_CPU_PROC - |ERTS_PSFLG_DIRTY_IO_PROC - |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q - |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); + if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL) close_lib(env->mod_nif); /* @@ -1838,13 +1856,6 @@ schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[ a = erts_smp_atomic32_read_acqb(&proc->state); while (1) { n = state = a; - /* - * clear any current dirty flags and dirty queue indicators, - * in case the application is shifting a job from one type - * of dirty scheduler to the other - */ - n &= ~(ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC - |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) n |= ERTS_PSFLG_DIRTY_CPU_PROC; else diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 40c2ad6f08..c9c8b1d0af 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -49,9 +49,10 @@ ** add ErlNifFunc flags ** 2.8: 18.0 add enif_has_pending_exception ** 2.9: 18.2 enif_getenv +** 2.10: Time API */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 9 +#define ERL_NIF_MINOR_VERSION 10 /* * The emulator will refuse to load a nif-lib with a major version @@ -67,54 +68,31 @@ #include <stdlib.h> -#ifdef SIZEOF_CHAR -# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR -# undef SIZEOF_CHAR -#endif -#ifdef SIZEOF_SHORT -# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT -# undef SIZEOF_SHORT -#endif -#ifdef SIZEOF_INT -# define SIZEOF_INT_SAVED__ SIZEOF_INT -# undef SIZEOF_INT -#endif -#ifdef SIZEOF_LONG -# define SIZEOF_LONG_SAVED__ SIZEOF_LONG -# undef SIZEOF_LONG -#endif -#ifdef SIZEOF_LONG_LONG -# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG -# undef SIZEOF_LONG_LONG -#endif -#include "erl_int_sizes_config.h" - #ifdef __cplusplus extern "C" { #endif -#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) -typedef unsigned __int64 ErlNifUInt64; -typedef __int64 ErlNifSInt64; -#elif SIZEOF_LONG == 8 -typedef unsigned long ErlNifUInt64; -typedef long ErlNifSInt64; -#elif SIZEOF_LONG_LONG == 8 -typedef unsigned long long ErlNifUInt64; -typedef long long ErlNifSInt64; -#else -#error No 64-bit integer type -#endif +typedef ErlNapiUInt64 ErlNifUInt64; +typedef ErlNapiSInt64 ErlNifSInt64; +typedef ErlNapiUInt ErlNifUInt; +typedef ErlNapiSInt ErlNifSInt; -#define ERL_NIF_VM_VARIANT "beam.vanilla" -#if SIZEOF_LONG == SIZEOF_VOID_P -typedef unsigned long ERL_NIF_TERM; -#elif SIZEOF_LONG_LONG == SIZEOF_VOID_P -typedef unsigned long long ERL_NIF_TERM; -#endif +# define ERL_NIF_VM_VARIANT "beam.vanilla" +typedef ErlNifUInt ERL_NIF_TERM; typedef ERL_NIF_TERM ERL_NIF_UINT; +typedef ErlNifSInt64 ErlNifTime; + +#define ERL_NIF_TIME_ERROR ((ErlNifSInt64) ERTS_NAPI_TIME_ERROR__) + +typedef enum { + ERL_NIF_SEC = ERTS_NAPI_SEC__, + ERL_NIF_MSEC = ERTS_NAPI_MSEC__, + ERL_NIF_USEC = ERTS_NAPI_USEC__, + ERL_NIF_NSEC = ERTS_NAPI_NSEC__ +} ErlNifTimeUnit; + struct enif_environment_t; typedef struct enif_environment_t ErlNifEnv; diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 08b9afc6af..1448a508a2 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -160,6 +160,9 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_nif,(ErlNifEnv*,const char*,int ERL_NIF_API_FUNC_DECL(int, enif_has_pending_exception, (ErlNifEnv *env, ERL_NIF_TERM* reason)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_raise_exception, (ErlNifEnv *env, ERL_NIF_TERM reason)); ERL_NIF_API_FUNC_DECL(int,enif_getenv,(const char* key, char* value, size_t* value_size)); +ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_monotonic_time, (ErlNifTimeUnit)); +ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_time_offset, (ErlNifTimeUnit)); +ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_convert_time_unit, (ErlNifTime, ErlNifTimeUnit, ErlNifTimeUnit)); /* ** ADD NEW ENTRIES HERE (before this comment) !!! @@ -312,6 +315,9 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); # define enif_has_pending_exception ERL_NIF_API_FUNC_MACRO(enif_has_pending_exception) # define enif_raise_exception ERL_NIF_API_FUNC_MACRO(enif_raise_exception) # define enif_getenv ERL_NIF_API_FUNC_MACRO(enif_getenv) +# define enif_monotonic_time ERL_NIF_API_FUNC_MACRO(enif_monotonic_time) +# define enif_time_offset ERL_NIF_API_FUNC_MACRO(enif_time_offset) +# define enif_convert_time_unit ERL_NIF_API_FUNC_MACRO(enif_convert_time_unit) /* ** ADD NEW ENTRIES HERE (before this comment) diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 2c09834d19..197b328fe2 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1648,6 +1648,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) int active; Uint64 start_time = 0; ErtsSchedulerData *esdp = runq->scheduler; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); @@ -1690,6 +1691,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) state = erts_atomic32_read_nob(&pp->state); pp->reds = ERTS_PORT_REDS_EXECUTE; + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); goto begin_handle_tasks; while (1) { @@ -1822,6 +1824,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) } erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); if (io_tasks_executed) { diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index c386d63a9e..b7499c5b5a 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -148,14 +148,14 @@ extern BeamInstr beam_apply[]; extern BeamInstr beam_exit[]; extern BeamInstr beam_continue_exit[]; -int erts_default_spo_flags = 0; -int erts_eager_check_io = 1; -int erts_sched_compact_load; -int erts_sched_balance_util = 0; -Uint erts_no_schedulers; +int ERTS_WRITE_UNLIKELY(erts_default_spo_flags) = 0; +int ERTS_WRITE_UNLIKELY(erts_eager_check_io) = 1; +int ERTS_WRITE_UNLIKELY(erts_sched_compact_load); +int ERTS_WRITE_UNLIKELY(erts_sched_balance_util) = 0; +Uint ERTS_WRITE_UNLIKELY(erts_no_schedulers); #ifdef ERTS_DIRTY_SCHEDULERS -Uint erts_no_dirty_cpu_schedulers; -Uint erts_no_dirty_io_schedulers; +Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_cpu_schedulers); +Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_io_schedulers); #endif static char *erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_NO_FLAGS] = {0}; @@ -295,7 +295,7 @@ do { \ erts_sched_stat_t erts_sched_stat; #ifdef USE_THREADS -static erts_tsd_key_t sched_data_key; +static erts_tsd_key_t ERTS_WRITE_UNLIKELY(sched_data_key); #endif static erts_smp_atomic32_t function_calls; @@ -335,15 +335,16 @@ static ErtsAlignedSchedulerSleepInfo *aligned_dirty_io_sched_sleep_info; static Uint last_reductions; static Uint last_exact_reductions; -Eterm erts_system_monitor; -Eterm erts_system_monitor_long_gc; -Uint erts_system_monitor_long_schedule; -Eterm erts_system_monitor_large_heap; +Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor); +Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_long_gc); +Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_schedule); +Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_large_heap); struct erts_system_monitor_flags_t erts_system_monitor_flags; /* system performance monitor */ Eterm erts_system_profile; struct erts_system_profile_flags_t erts_system_profile_flags; +int erts_system_profile_ts_type = ERTS_TRACE_FLG_NOW_TIMESTAMP; #if ERTS_MAX_PROCESSES > 0x7fffffff #error "Need to store process_count in another type" @@ -940,6 +941,12 @@ sched_wall_time_change(ErtsSchedulerData *esdp, int working) } } } + if (!working) { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT); + } else { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER); + } + } typedef struct { @@ -1695,15 +1702,17 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin int need_thr_progress = 0; ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; int more_work = 0; - + ERTS_MSACC_PUSH_STATE_M_X(); #ifdef ERTS_DIRTY_SCHEDULERS ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); #endif unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ALLOC); erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, &need_thr_progress, &wakeup, &more_work); + ERTS_MSACC_POP_STATE_M_X(); if (more_work) { if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD) & ERTS_SSI_AUX_WORK_DD_THR_PRGR) { @@ -2175,12 +2184,15 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \ if (!(aux_work & ~ignore)) { \ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \ + ERTS_MSACC_UPDATE_CACHE(); \ + ERTS_MSACC_POP_STATE_M(); \ return aux_work; \ } \ } erts_aint32_t aux_work = orig_aux_work; erts_aint32_t ignore = 0; + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_AUX); ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); #ifdef ERTS_SMP @@ -2271,6 +2283,8 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) haw_thr_prgr_current_check_progress(awdp); #endif + ERTS_MSACC_UPDATE_CACHE(); + ERTS_MSACC_POP_STATE_M(); return aux_work; #undef HANDLE_AUX_WORK @@ -2778,6 +2792,8 @@ aux_thread(void *unused) ssi->event = erts_tse_fetch(); + erts_msacc_init_thread("aux", 1, 1); + callbacks.arg = (void *) ssi; callbacks.wakeup = thr_prgr_wakeup; callbacks.prepare_wait = thr_prgr_prep_wait; @@ -2788,6 +2804,7 @@ aux_thread(void *unused) init_aux_work_data(awdp, NULL, NULL); awdp->ssi = ssi; + sched_prep_spin_wait(ssi); while (1) { @@ -2841,6 +2858,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) #ifdef ERTS_SMP int thr_prgr_active = 1; erts_aint32_t flgs; +#endif + ERTS_MSACC_PUSH_STATE_M(); +#ifdef ERTS_SMP ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); @@ -2888,7 +2908,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_wall_time_change(esdp, thr_prgr_active); while (1) { - ErtsMonotonicTime current_time; + ErtsMonotonicTime current_time = 0; aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) { @@ -2897,6 +2917,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_wall_time_change(esdp, 1); } aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); + ERTS_MSACC_UPDATE_CACHE(); if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); } @@ -2958,7 +2979,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) - 1) + 1; } else timeout = -1; + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); res = erts_tse_twait(ssi->event, timeout); + ERTS_MSACC_POP_STATE_M(); current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 : erts_get_monotonic_time(esdp); } while (res == EINTR); @@ -3027,9 +3050,13 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (working) sched_wall_time_change(esdp, working = 0); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + ASSERT(!erts_port_task_have_outstanding_io_tasks()); erl_sys_schedule(1); /* Might give us something to do */ + ERTS_MSACC_POP_STATE_M(); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -3050,6 +3077,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_thr_progress_active(esdp, thr_prgr_active = 1); #endif aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); + ERTS_MSACC_UPDATE_CACHE(); #ifdef ERTS_SMP if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); @@ -3147,8 +3175,12 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ASSERT(!erts_port_task_have_outstanding_io_tasks()); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + erl_sys_schedule(0); + ERTS_MSACC_POP_STATE_M(); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -3543,6 +3575,13 @@ check_requeue_process(ErtsRunQueue *rq, int prio_q) return 0; } +static ERTS_INLINE void +free_proxy_proc(Process *proxy) +{ + ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY); + erts_free(ERTS_ALC_T_PROC, proxy); +} + #ifdef ERTS_SMP static ErtsRunQueue * @@ -3857,9 +3896,6 @@ evacuate_run_queue(ErtsRunQueue *rq, erts_aint32_t state; Process *proc; int notify = 0; -#ifdef ERTS_DIRTY_SCHEDULERS - int requeue; -#endif to_rq = NULL; #ifdef ERTS_DIRTY_SCHEDULERS @@ -3874,49 +3910,94 @@ evacuate_run_queue(ErtsRunQueue *rq, proc = dequeue_process(rq, prio_q, &state); while (proc) { -#ifdef ERTS_DIRTY_SCHEDULERS - requeue = 1; + Process *real_proc; + int prio; + erts_aint32_t max_qbit, qbit, real_state; + + prio = ERTS_PSFLGS_GET_PRQ_PRIO(state); + qbit = ((erts_aint32_t) 1) << prio; + + if (!(state & ERTS_PSFLG_PROXY)) { + real_proc = proc; + real_state = state; + } + else { + real_proc = erts_proc_lookup_raw(proc->common.id); + if (!real_proc) { + free_proxy_proc(proc); + goto handle_next_proc; + } + real_state = erts_smp_atomic32_read_acqb(&real_proc->state); + } + + max_qbit = (state >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET); + max_qbit &= ERTS_PSFLGS_QMASK; + max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; + max_qbit &= -max_qbit; + + if (qbit > max_qbit) { + /* Process already queued with higher prio; drop it... */ + if (real_proc != proc) + free_proxy_proc(proc); + else { + erts_aint32_t clr_bits; +#ifdef DEBUG + erts_aint32_t old; #endif - if (ERTS_PSFLG_BOUND & state) { - /* Bound processes get stuck here... */ - proc->next = NULL; - if (sbpp->last) - sbpp->last->next = proc; - else - sbpp->first = proc; - sbpp->last = proc; -#ifdef ERTS_DIRTY_SCHEDULERS - requeue = 0; + + clr_bits = ERTS_PSFLG_IN_RUNQ; + clr_bits |= qbit << ERTS_PSFLGS_IN_PRQ_MASK_OFFSET; + +#ifdef DEBUG + old = +#else + (void) #endif + erts_smp_atomic32_read_band_mb(&proc->state, + ~clr_bits); + ASSERT((old & clr_bits) == clr_bits); + + } + + goto handle_next_proc; } + #ifdef ERTS_DIRTY_SCHEDULERS - else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) { + + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) { + erts_aint32_t dqbit = qbit; #ifdef DEBUG - erts_aint32_t old = -#else - (void) + erts_aint32_t old_dqbit; #endif - erts_smp_atomic32_read_band_nob(&proc->state, - ~(ERTS_PSFLG_DIRTY_CPU_PROC - | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)); - /* assert that no other dirty flags are set */ - ASSERT(!(old & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q))); - } else if (state & ERTS_PSFLG_DIRTY_IO_PROC_IN_Q) { + + if (rq == ERTS_DIRTY_CPU_RUNQ) + dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET; + else { + ASSERT(rq == ERTS_DIRTY_IO_RUNQ); + dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET; + } + #ifdef DEBUG - erts_aint32_t old = + old_dqbit = (int) #else - (void) + (void) #endif - erts_smp_atomic32_read_band_nob(&proc->state, - ~(ERTS_PSFLG_DIRTY_IO_PROC - | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); - /* assert that no other dirty flags are set */ - ASSERT(!(old & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q))); + erts_smp_atomic32_read_band_mb(&real_proc->dirty_state, + ~dqbit); + ASSERT(old_dqbit & dqbit); } - if (requeue) { -#else - else { #endif + + if (ERTS_PSFLG_BOUND & real_state) { + /* Bound processes get stuck here... */ + proc->next = NULL; + if (sbpp->last) + sbpp->last->next = proc; + else + sbpp->first = proc; + sbpp->last = proc; + } + else { int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state); erts_smp_runq_unlock(rq); @@ -3939,6 +4020,8 @@ evacuate_run_queue(ErtsRunQueue *rq, erts_smp_runq_lock(rq); } + + handle_next_proc: proc = dequeue_process(rq, prio_q, &state); } if (notify) @@ -5871,19 +5954,96 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio) return proxy; } -static ERTS_INLINE void -free_proxy_proc(Process *proxy) -{ - ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY); - erts_free(ERTS_ALC_T_PROC, proxy); -} - #define ERTS_ENQUEUE_NOT 0 #define ERTS_ENQUEUE_NORMAL_QUEUE 1 -#ifdef ERTS_DIRTY_SCHEDULERS #define ERTS_ENQUEUE_DIRTY_CPU_QUEUE 2 #define ERTS_ENQUEUE_DIRTY_IO_QUEUE 3 + +#ifdef ERTS_DIRTY_SCHEDULERS + +static int +check_dirty_enqueue_in_prio_queue(Process *c_p, + erts_aint32_t *newp, + erts_aint32_t actual, + erts_aint32_t aprio, + erts_aint32_t qbit) +{ + int queue; + erts_aint32_t dact, max_qbit; + + /* Termination should be done on an ordinary scheduler */ + if (actual & ERTS_PSFLG_EXITING) { + *newp &= ~ERTS_PSFLGS_DIRTY_WORK; + return ERTS_ENQUEUE_NORMAL_QUEUE; + } + + /* + * If we have system tasks, we enqueue on ordinary run-queue + * and take care of those system tasks first. + */ + if (actual & ERTS_PSFLG_ACTIVE_SYS) + return ERTS_ENQUEUE_NORMAL_QUEUE; + + dact = erts_smp_atomic32_read_mb(&c_p->dirty_state); + if (actual & (ERTS_PSFLG_DIRTY_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_CPU_PROC)) { + max_qbit = ((dact >> ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET) + & ERTS_PDSFLGS_QMASK); + queue = ERTS_ENQUEUE_DIRTY_CPU_QUEUE; + } + else { + ASSERT(actual & ERTS_PSFLG_DIRTY_IO_PROC); + max_qbit = ((dact >> ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET) + & ERTS_PDSFLGS_QMASK); + queue = ERTS_ENQUEUE_DIRTY_IO_QUEUE; + } + + max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; + max_qbit &= -max_qbit; + + if (qbit >= max_qbit) + return ERTS_ENQUEUE_NOT; /* Already queued in higher or equal prio */ + if ((actual & (ERTS_PSFLG_IN_RUNQ|ERTS_PSFLGS_USR_PRIO_MASK)) + != (aprio << ERTS_PSFLGS_USR_PRIO_OFFSET)) { + /* + * Process struct already enqueued, or actual prio not + * equal to user prio, i.e., enqueue using proxy. + */ + return -1*queue; + } + + *newp |= ERTS_PSFLG_IN_RUNQ; + return queue; +} + +static ERTS_INLINE int +fin_dirty_enq_s_change(Process *p, + int pstruct_reserved, + erts_aint32_t enq_prio, + int qmask_offset) +{ + erts_aint32_t qbit = 1 << enq_prio; + qbit <<= qmask_offset; + + if (qbit & erts_smp_atomic32_read_bor_mb(&p->dirty_state, qbit)) { + /* Already enqueue by someone else... */ + if (pstruct_reserved) { + /* We reserved process struct for enqueue; clear it... */ +#ifdef DEBUG + erts_aint32_t old = +#else + (void) #endif + erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_IN_RUNQ); + ASSERT(old & ERTS_PSFLG_IN_RUNQ); + } + return 0; + } + + return !0; +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ static ERTS_INLINE int check_enqueue_in_prio_queue(Process *c_p, @@ -5899,61 +6059,14 @@ check_enqueue_in_prio_queue(Process *c_p, *prq_prio_p = aprio; #ifdef ERTS_DIRTY_SCHEDULERS - if (actual & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) { - /* - * If we have system tasks of a priority higher - * or equal to the user priority, we enqueue - * on ordinary run-queue and take care of - * those system tasks first. - */ - if (actual & ERTS_PSFLG_ACTIVE_SYS) { - erts_aint32_t uprio, stprio, qmask; - uprio = (actual >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK; - if (aprio < uprio) - goto enqueue_normal_runq; /* system tasks with higher prio */ - erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS); - qmask = c_p->sys_task_qs->qmask; - erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); - switch (qmask & -qmask) { - case MAX_BIT: - stprio = PRIORITY_MAX; - break; - case HIGH_BIT: - stprio = PRIORITY_HIGH; - break; - case NORMAL_BIT: - stprio = PRIORITY_NORMAL; - break; - case LOW_BIT: - stprio = PRIORITY_LOW; - break; - default: - stprio = PRIORITY_LOW+1; - break; - } - if (stprio <= uprio) - goto enqueue_normal_runq; /* system tasks with higher prio */ - } - - /* Enqueue in dirty run queue if not already enqueued */ - if (actual & (ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)) - return ERTS_ENQUEUE_NOT; /* already in queue */ - if (actual & ERTS_PSFLG_DIRTY_CPU_PROC) { - *newp |= ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q; - if (actual & ERTS_PSFLG_IN_RUNQ) - return -ERTS_ENQUEUE_DIRTY_CPU_QUEUE; /* use proxy */ - *newp |= ERTS_PSFLG_IN_RUNQ; - return ERTS_ENQUEUE_DIRTY_CPU_QUEUE; - } - *newp |= ERTS_PSFLG_DIRTY_IO_PROC_IN_Q; - if (actual & ERTS_PSFLG_IN_RUNQ) - return -ERTS_ENQUEUE_DIRTY_IO_QUEUE; /* use proxy */ - *newp |= ERTS_PSFLG_IN_RUNQ; - return ERTS_ENQUEUE_DIRTY_IO_QUEUE; + if (actual & ERTS_PSFLGS_DIRTY_WORK) { + int res = check_dirty_enqueue_in_prio_queue(c_p, newp, actual, + aprio, qbit); + if (res != ERTS_ENQUEUE_NORMAL_QUEUE) + return res; } - - enqueue_normal_runq: #endif + max_qbit = (actual >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET) & ERTS_PSFLGS_QMASK; max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; max_qbit &= -max_qbit; @@ -5985,6 +6098,65 @@ check_enqueue_in_prio_queue(Process *c_p, return ERTS_ENQUEUE_NORMAL_QUEUE; } +static ERTS_INLINE ErtsRunQueue * +select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t state) +{ + + switch (enqueue) { + + case ERTS_ENQUEUE_NOT: + + return NULL; + +#ifdef ERTS_DIRTY_SCHEDULERS + + case ERTS_ENQUEUE_DIRTY_CPU_QUEUE: + case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE: + + if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio, + ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET)) + return ERTS_DIRTY_CPU_RUNQ; + + return NULL; + + + case ERTS_ENQUEUE_DIRTY_IO_QUEUE: + case -ERTS_ENQUEUE_DIRTY_IO_QUEUE: + + if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio, + ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET)) + return ERTS_DIRTY_IO_RUNQ; + + return NULL; + +#endif + + default: { + ErtsRunQueue* runq; + + ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE + || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE); + + runq = erts_get_runq_proc(p); + +#ifdef ERTS_SMP + if (!(ERTS_PSFLG_BOUND & state)) { + ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio); + if (new_runq) { + RUNQ_SET_RQ(&p->run_queue, new_runq); + runq = new_runq; + } + } +#endif + + ASSERT(runq); + + return runq; + } + } +} + + /* * schedule_out_process() return with c_rq locked. */ @@ -5993,11 +6165,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces { erts_aint32_t a, e, n, enq_prio = -1; int enqueue; /* < 0 -> use proxy */ - Process* sched_p; ErtsRunQueue* runq; -#ifdef ERTS_SMP - int check_emigration_need; -#endif a = state; @@ -6009,7 +6177,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces enqueue = ERTS_ENQUEUE_NOT; n &= ~(ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS); - if (a & ERTS_PSFLG_ACTIVE_SYS + if (a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS) || (a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) { enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a); } @@ -6018,16 +6186,17 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces break; } - switch (enqueue) { - case ERTS_ENQUEUE_NOT: + runq = select_enqueue_run_queue(enqueue, enq_prio, p, n); + + if (!runq) { + if (erts_system_profile_flags.runnable_procs) { /* Status lock prevents out of order "runnable proc" trace msgs */ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); - if (!(a & ERTS_PSFLG_ACTIVE_SYS) - && (!(a & ERTS_PSFLG_ACTIVE) - || (a & ERTS_PSFLG_SUSPENDED))) { + if (!(a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS)) + && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) { /* Process inactive */ profile_runnable_proc(p, am_inactive); } @@ -6040,98 +6209,76 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces return 0; -#ifdef ERTS_DIRTY_SCHEDULERS -#ifdef ERTS_SMP - case ERTS_ENQUEUE_DIRTY_CPU_QUEUE: - case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE: - runq = ERTS_DIRTY_CPU_RUNQ; - ASSERT(ERTS_SCHEDULER_IS_DIRTY_CPU(runq->scheduler)); -#ifdef ERTS_SMP - check_emigration_need = 0; -#endif - break; + } + else { + Process* sched_p; - case ERTS_ENQUEUE_DIRTY_IO_QUEUE: - case -ERTS_ENQUEUE_DIRTY_IO_QUEUE: - runq = ERTS_DIRTY_IO_RUNQ; - ASSERT(ERTS_SCHEDULER_IS_DIRTY_IO(runq->scheduler)); -#ifdef ERTS_SMP - check_emigration_need = 0; -#endif - break; -#endif -#endif + ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS))); - default: - ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE - || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE); + if (enqueue < 0) + sched_p = make_proxy_proc(proxy, p, enq_prio); + else { + sched_p = p; + if (proxy) + free_proxy_proc(proxy); + } - runq = erts_get_runq_proc(p); -#ifdef ERTS_SMP - check_emigration_need = !(ERTS_PSFLG_BOUND & n); -#endif - break; - } + ASSERT(runq); - ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & ERTS_PSFLG_ACTIVE_SYS)); + erts_smp_runq_lock(runq); - if (enqueue < 0) - sched_p = make_proxy_proc(proxy, p, enq_prio); - else { - sched_p = p; - if (proxy) - free_proxy_proc(proxy); - } + /* Enqueue the process */ + enqueue_process(runq, (int) enq_prio, sched_p); -#ifdef ERTS_SMP - if (check_emigration_need) { - ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio); - if (new_runq) { - RUNQ_SET_RQ(&sched_p->run_queue, new_runq); - runq = new_runq; - } - } -#endif + if (runq == c_rq) + return 1; - ASSERT(runq); + erts_smp_runq_unlock(runq); - erts_smp_runq_lock(runq); + smp_notify_inc_runq(runq); - /* Enqueue the process */ - enqueue_process(runq, (int) enq_prio, sched_p); + erts_smp_runq_lock(c_rq); - if (runq == c_rq) return 1; - erts_smp_runq_unlock(runq); - smp_notify_inc_runq(runq); - erts_smp_runq_lock(c_rq); - return 1; + } + } static ERTS_INLINE void -add2runq(Process *p, erts_aint32_t state, erts_aint32_t prio) +add2runq(int enqueue, erts_aint32_t prio, + Process *proc, erts_aint32_t state, + Process **proxy) { - ErtsRunQueue *runq = erts_get_runq_proc(p); + ErtsRunQueue *runq; -#ifdef ERTS_SMP - if (!(ERTS_PSFLG_BOUND & state)) { - ErtsRunQueue *new_runq = erts_check_emigration_need(runq, (int) prio); - if (new_runq) { - RUNQ_SET_RQ(&p->run_queue, new_runq); - runq = new_runq; - } - } -#endif - ASSERT(runq); + runq = select_enqueue_run_queue(enqueue, prio, proc, state); - erts_smp_runq_lock(runq); + if (runq) { + Process *sched_p; - /* Enqueue the process */ - enqueue_process(runq, (int) prio, p); + if (enqueue > 0) + sched_p = proc; + else { + Process *pxy; - erts_smp_runq_unlock(runq); - smp_notify_inc_runq(runq); + if (!proxy) + pxy = NULL; + else { + pxy = *proxy; + *proxy = NULL; + } + sched_p = make_proxy_proc(pxy, proc, prio); + } + + erts_smp_runq_lock(runq); + /* Enqueue the process */ + enqueue_process(runq, (int) prio, sched_p); + + erts_smp_runq_unlock(runq); + smp_notify_inc_runq(runq); + } } static ERTS_INLINE int @@ -6237,10 +6384,7 @@ schedule_process(Process *p, erts_aint32_t in_state, ErtsProcLocks locks) &state, &enq_prio, locks); - if (enqueue != ERTS_ENQUEUE_NOT) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); + add2runq(enqueue, enq_prio, p, state, NULL); } void @@ -6379,9 +6523,7 @@ schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st) locked = 0; } - if (enqueue != ERTS_ENQUEUE_NOT) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - n, enq_prio); + add2runq(enqueue, enq_prio, p, n, NULL); cleanup: @@ -6479,10 +6621,7 @@ resume_process(Process *p, ErtsProcLocks locks) &state, &enq_prio, locks); - if (enqueue) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); + add2runq(enqueue, enq_prio, p, state, NULL); } int @@ -7925,6 +8064,8 @@ sched_thread_func(void *vesdp) callbacks.wait = thr_prgr_wait; callbacks.finalize_wait = thr_prgr_fin_wait; + erts_msacc_init_thread("scheduler", no, 1); + erts_thr_progress_register_managed_thread(esdp, &callbacks, 0); erts_alloc_register_scheduler(vesdp); #endif @@ -9203,6 +9344,8 @@ Process *schedule(Process *p, int calls) Uint32 flags; erts_aint32_t state = 0; /* Supress warning... */ + ERTS_MSACC_DECLARE_CACHE(); + #ifdef USE_VM_PROBES if (p != NULL && DTRACE_ENABLED(process_unscheduled)) { DTRACE_CHARBUF(process_buf, DTRACE_TERM_BUF_SIZE); @@ -9307,6 +9450,8 @@ Process *schedule(Process *p, int calls) erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); + if (state & ERTS_PSFLG_FREE) { #ifdef ERTS_SMP ASSERT(esdp->free_process == p); @@ -9343,15 +9488,16 @@ Process *schedule(Process *p, int calls) #ifdef ERTS_SMP ErtsMigrationPaths *mps; ErtsMigrationPath *mp; - ErtsProcList *pnd_xtrs = rq->procs.pending_exiters; - if (erts_proclist_fetch(&pnd_xtrs, NULL)) { + + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + ErtsProcList *pnd_xtrs = rq->procs.pending_exiters; + if (erts_proclist_fetch(&pnd_xtrs, NULL)) { rq->procs.pending_exiters = NULL; erts_smp_runq_unlock(rq); handle_pending_exiters(pnd_xtrs); erts_smp_runq_lock(rq); } - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { if (rq->check_balance_reds <= 0) check_balance(rq); @@ -9467,7 +9613,7 @@ Process *schedule(Process *p, int calls) scheduler_wait(&fcalls, esdp, rq); flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC); flags |= ERTS_RUNQ_FLG_EXEC; - + ERTS_MSACC_UPDATE_CACHE(); #ifdef ERTS_SMP non_empty_runq(rq); #endif @@ -9482,6 +9628,8 @@ Process *schedule(Process *p, int calls) * Schedule system-level activities. */ + ERTS_MSACC_PUSH_STATE_CACHED_M(); + erts_smp_atomic32_set_relb(&function_calls, 0); fcalls = 0; @@ -9489,7 +9637,9 @@ Process *schedule(Process *p, int calls) erts_sys_schedule_interrupt(0); #endif erts_smp_runq_unlock(rq); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); erl_sys_schedule(1); + ERTS_MSACC_POP_STATE_M(); current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -9547,11 +9697,12 @@ Process *schedule(Process *p, int calls) pick_next_process: { erts_aint32_t psflg_band_mask; int prio_q; - int qmask; + int qmask, qbit; flags = ERTS_RUNQ_FLGS_GET_NOB(rq); qmask = (int) (flags & ERTS_RUNQ_FLGS_PROCS_QMASK); - switch (qmask & -qmask) { + qbit = qmask & -qmask; + switch (qbit) { case MAX_BIT: prio_q = PRIORITY_MAX; break; @@ -9567,9 +9718,12 @@ Process *schedule(Process *p, int calls) case 0: /* No process at all */ default: ASSERT(qmask == 0); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); goto check_activities_to_run; } + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_EMULATOR); + BM_START_TIMER(system); /* @@ -9579,20 +9733,11 @@ Process *schedule(Process *p, int calls) ASSERT(p); /* Wrong qmask in rq->flags? */ - psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state) - + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET)); - -#ifdef ERTS_DIRTY_SCHEDULERS - ASSERT((state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) != - (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)); - if (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) { - ASSERT((ERTS_SCHEDULER_IS_DIRTY_CPU(esdp) && (state & ERTS_PSFLG_DIRTY_CPU_PROC)) || - (ERTS_SCHEDULER_IS_DIRTY_IO(esdp) && (state & ERTS_PSFLG_DIRTY_IO_PROC))); - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !(state & ERTS_PSFLG_ACTIVE_SYS)) - goto pick_next_process; - state &= ~(ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); - } -#endif + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + psflg_band_mask = ~((erts_aint32_t) 0); + else + psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state) + + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET)); if (!(state & ERTS_PSFLG_PROXY)) psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ; @@ -9615,9 +9760,11 @@ Process *schedule(Process *p, int calls) | ERTS_PSFLG_RUNNING_SYS))) { tmp = state & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_PENDING_EXIT - | ERTS_PSFLG_ACTIVE_SYS); + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS); if (tmp != ERTS_PSFLG_SUSPENDED) { - if (state & ERTS_PSFLG_ACTIVE_SYS) + if (state & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) new |= ERTS_PSFLG_RUNNING_SYS; else new |= ERTS_PSFLG_RUNNING; @@ -9630,7 +9777,8 @@ Process *schedule(Process *p, int calls) | ERTS_PSFLG_FREE)) || ((state & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_PENDING_EXIT - | ERTS_PSFLG_ACTIVE_SYS)) + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) == ERTS_PSFLG_SUSPENDED)) { if (state & ERTS_PSFLG_FREE) erts_proc_dec_refc(p); @@ -9649,10 +9797,42 @@ Process *schedule(Process *p, int calls) esdp->current_process = p; + + reds = context_reds; + +#ifdef ERTS_SMP + + erts_smp_runq_unlock(rq); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { +#ifdef DEBUG + int old_dqbit; +#endif + int dqbit = qbit; + + if (rq == ERTS_DIRTY_CPU_RUNQ) + dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET; + else { + ASSERT(rq == ERTS_DIRTY_IO_RUNQ); + dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET; + } + +#ifdef DEBUG + old_dqbit = (int) +#else + (void) +#endif + erts_smp_atomic32_read_band_mb(&p->dirty_state, ~dqbit); + ASSERT(old_dqbit & dqbit); + } +#endif /* ERTS_DIRTY_SCHEDULERS */ + +#endif /* ERTS_SMP */ + } #ifdef ERTS_SMP - erts_smp_runq_unlock(rq); if (flags & ERTS_RUNQ_FLG_PROTECTED) (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED); @@ -9661,6 +9841,8 @@ Process *schedule(Process *p, int calls) erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + state = erts_smp_atomic32_read_nob(&p->state); + if (erts_sched_stat.enabled) { int prio; UWord old = ERTS_PROC_SCHED_ID(p, @@ -9685,15 +9867,56 @@ Process *schedule(Process *p, int calls) erts_smp_spin_unlock(&erts_sched_stat.lock); } - if (ERTS_PROC_PENDING_EXIT(p)) { + ASSERT(!p->scheduler_data); + p->scheduler_data = esdp; + + state = erts_smp_atomic32_read_nob(&p->state); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (!!(state & ERTS_PSFLGS_DIRTY_WORK) + & !(state & ERTS_PSFLG_ACTIVE_SYS)) { + /* Migrate to dirty scheduler... */ + sunlock_sched_out_proc: + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + p->fcalls = reds; + goto sched_out_proc; + + } + } + else { + if (state & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_PENDING_EXIT + | ERTS_PSFLG_EXITING)) { + /* Migrate to normal scheduler... */ + goto sunlock_sched_out_proc; + } + if ((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS) + && rq == ERTS_DIRTY_IO_RUNQ) { + /* Migrate to dirty cpu scheduler... */ + goto sunlock_sched_out_proc; + } + + ASSERT((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS) + || *p->i == (BeamInstr) em_call_nif); + + ASSERT(rq == ERTS_DIRTY_CPU_RUNQ + ? (state & (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) + : (rq == ERTS_DIRTY_IO_RUNQ + && (state & ERTS_PSFLG_DIRTY_IO_PROC))); + } +#endif + + if (state & ERTS_PSFLG_PENDING_EXIT) { erts_handle_pending_exit(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); state = erts_smp_atomic32_read_nob(&p->state); } - ASSERT(!p->scheduler_data); - p->scheduler_data = esdp; -#endif - reds = context_reds; + +#endif /* ERTS_SMP */ + + p->fcalls = reds; if (IS_TRACED(p)) { if (state & ERTS_PSFLG_EXITING) { @@ -9722,7 +9945,8 @@ Process *schedule(Process *p, int calls) reds -= execute_sys_tasks(p, &state, reds); if (reds <= 0 #ifdef ERTS_DIRTY_SCHEDULERS - || (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) + || ERTS_SCHEDULER_IS_DIRTY(esdp) + || (state & ERTS_PSFLGS_DIRTY_WORK) #endif ) { p->fcalls = reds; @@ -9770,7 +9994,6 @@ Process *schedule(Process *p, int calls) proxy_p = NULL; } - p->fcalls = reds; ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); /* Never run a suspended process */ @@ -10655,6 +10878,9 @@ static void early_init_process_struct(void *varg, Eterm data) Process *proc = arg->proc; proc->common.id = make_internal_pid(data); +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_init_nob(&proc->dirty_state, 0); +#endif erts_smp_atomic32_init_relb(&proc->state, arg->state); #ifdef ERTS_SMP @@ -11144,6 +11370,9 @@ void erts_init_empty_process(Process *p) p->last_old_htop = NULL; #endif +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_init_nob(&p->dirty_state, 0); +#endif erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL); #ifdef ERTS_SMP @@ -11336,7 +11565,9 @@ set_proc_exiting(Process *p, ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCKS_ALL); enqueue = change_proc_schedule_state(p, - ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT, + (ERTS_PSFLG_SUSPENDED + | ERTS_PSFLG_PENDING_EXIT + | ERTS_PSFLGS_DIRTY_WORK), ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE, &state, &enq_prio, @@ -11370,10 +11601,7 @@ set_proc_exiting(Process *p, } #endif - if (enqueue) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); + add2runq(enqueue, enq_prio, p, state, NULL); } static ERTS_INLINE erts_aint32_t @@ -11476,6 +11704,11 @@ save_pending_exiter(Process *p) else rq = esdp->run_queue; +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) + rq = ERTS_RUNQ_IX(0); /* Handle on ordinary scheduler */ +#endif + plp = proclist_create(p); erts_smp_runq_lock(rq); @@ -11485,13 +11718,8 @@ save_pending_exiter(Process *p) non_empty_runq(rq); erts_smp_runq_unlock(rq); -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - wake_dirty_schedulers(rq, 0); - else -#endif - wake_scheduler(rq); + wake_scheduler(rq); } #endif diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index b50fa5a10f..ef4aab7234 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -60,6 +60,9 @@ typedef struct process Process; #include "erl_mseg.h" #include "erl_async.h" #include "erl_gc.h" +#define ERTS_ONLY_INCLUDE_TRACE_FLAGS +#include "erl_trace.h" +#undef ERTS_ONLY_INCLUDE_TRACE_FLAGS #ifdef HIPE #include "hipe_process.h" @@ -1032,6 +1035,9 @@ struct process { ErtsProcSysTaskQs *sys_task_qs; erts_smp_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */ +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_t dirty_state; /* Process dirty state flags (see ERTS_PDSFLG_*) */ +#endif #ifdef ERTS_SMP ErlMessageInQueue msg_inq; @@ -1153,15 +1159,14 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLG_DELAYED_SYS ERTS_PSFLG_BIT(17) #define ERTS_PSFLG_OFF_HEAP_MSGQ ERTS_PSFLG_BIT(18) #define ERTS_PSFLG_ON_HEAP_MSGQ ERTS_PSFLG_BIT(19) -#ifdef ERTS_DIRTY_SCHEDULERS #define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(20) #define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(21) -#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(22) -#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(23) -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 24) -#else -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 20) -#endif +#define ERTS_PSFLG_DIRTY_ACTIVE_SYS ERTS_PSFLG_BIT(22) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 22) + +#define ERTS_PSFLGS_DIRTY_WORK (ERTS_PSFLG_DIRTY_CPU_PROC \ + | ERTS_PSFLG_DIRTY_IO_PROC \ + | ERTS_PSFLG_DIRTY_ACTIVE_SYS) #define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \ | ERTS_PSFLG_IN_PRQ_HIGH \ @@ -1173,7 +1178,37 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLGS_GET_USR_PRIO(PSFLGS) \ (((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) #define ERTS_PSFLGS_GET_PRQ_PRIO(PSFLGS) \ - (((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) + (((PSFLGS) >> ERTS_PSFLGS_PRQ_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) + +#ifdef ERTS_DIRTY_SCHEDULERS + +/* + * Flags in the dirty_state field. + */ + +#define ERTS_PDSFLG_IN_CPU_PRQ_MAX (((erts_aint32_t) 1) << 0) +#define ERTS_PDSFLG_IN_CPU_PRQ_HIGH (((erts_aint32_t) 1) << 1) +#define ERTS_PDSFLG_IN_CPU_PRQ_NORMAL (((erts_aint32_t) 1) << 2) +#define ERTS_PDSFLG_IN_CPU_PRQ_LOW (((erts_aint32_t) 1) << 3) +#define ERTS_PDSFLG_IN_IO_PRQ_MAX (((erts_aint32_t) 1) << 4) +#define ERTS_PDSFLG_IN_IO_PRQ_HIGH (((erts_aint32_t) 1) << 5) +#define ERTS_PDSFLG_IN_IO_PRQ_NORMAL (((erts_aint32_t) 1) << 6) +#define ERTS_PDSFLG_IN_IO_PRQ_LOW (((erts_aint32_t) 1) << 7) + +#define ERTS_PDSFLGS_QMASK ERTS_PSFLGS_QMASK +#define ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET 0 +#define ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET ERTS_PSFLGS_QMASK_BITS + +#define ERTS_PDSFLG_IN_CPU_PRQ_MASK (ERTS_PDSFLG_IN_CPU_PRQ_MAX \ + | ERTS_PDSFLG_IN_CPU_PRQ_HIGH \ + | ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\ + | ERTS_PDSFLG_IN_CPU_PRQ_LOW) +#define ERTS_PDSFLG_IN_IO_PRQ_MASK (ERTS_PDSFLG_IN_CPU_PRQ_MAX \ + | ERTS_PDSFLG_IN_CPU_PRQ_HIGH \ + | ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\ + | ERTS_PDSFLG_IN_CPU_PRQ_LOW) +#endif + /* * Static flags that do not change after process creation. @@ -1284,6 +1319,7 @@ struct erts_system_profile_flags_t { unsigned int exclusive : 1; }; extern struct erts_system_profile_flags_t erts_system_profile_flags; +extern int erts_system_profile_ts_type; /* process flags */ #define F_HIBERNATE_SCHED (1 << 0) /* Schedule out after hibernate op */ @@ -1315,61 +1351,90 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; * not be scheduled out while F_DELAY_GC is set. */ +#define ERTS_TRACE_FLAGS_TS_TYPE_SHIFT 0 + +#define F_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N))) + /* process trace_flags */ -#define F_SENSITIVE (1 << 0) -#define F_TRACE_SEND (1 << 1) -#define F_TRACE_RECEIVE (1 << 2) -#define F_TRACE_SOS (1 << 3) /* Set on spawn */ -#define F_TRACE_SOS1 (1 << 4) /* Set on first spawn */ -#define F_TRACE_SOL (1 << 5) /* Set on link */ -#define F_TRACE_SOL1 (1 << 6) /* Set on first link */ -#define F_TRACE_CALLS (1 << 7) -#define F_TIMESTAMP (1 << 8) -#define F_TRACE_PROCS (1 << 9) -#define F_TRACE_FIRST_CHILD (1 << 10) -#define F_TRACE_SCHED (1 << 11) -#define F_TRACE_GC (1 << 12) -#define F_TRACE_ARITY_ONLY (1 << 13) -#define F_TRACE_RETURN_TO (1 << 14) /* Return_to trace when breakpoint tracing */ -#define F_TRACE_SILENT (1 << 15) /* No call trace msg suppress */ -#define F_TRACER (1 << 16) /* May be (has been) tracer */ -#define F_EXCEPTION_TRACE (1 << 17) /* May have exception trace on stack */ + +#define F_NOW_TS (ERTS_TRACE_FLG_NOW_TIMESTAMP \ + << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) +#define F_STRICT_MON_TS (ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP \ + << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) +#define F_MON_TS (ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP \ + << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) +#define F_SENSITIVE F_TRACE_FLAG(0) +#define F_TRACE_SEND F_TRACE_FLAG(1) +#define F_TRACE_RECEIVE F_TRACE_FLAG(2) +#define F_TRACE_SOS F_TRACE_FLAG(3) /* Set on spawn */ +#define F_TRACE_SOS1 F_TRACE_FLAG(4) /* Set on first spawn */ +#define F_TRACE_SOL F_TRACE_FLAG(5) /* Set on link */ +#define F_TRACE_SOL1 F_TRACE_FLAG(6) /* Set on first link */ +#define F_TRACE_CALLS F_TRACE_FLAG(7) +#define F_TRACE_PROCS F_TRACE_FLAG(8) +#define F_TRACE_FIRST_CHILD F_TRACE_FLAG(9) +#define F_TRACE_SCHED F_TRACE_FLAG(10) +#define F_TRACE_GC F_TRACE_FLAG(11) +#define F_TRACE_ARITY_ONLY F_TRACE_FLAG(12) +#define F_TRACE_RETURN_TO F_TRACE_FLAG(13) /* Return_to trace when breakpoint tracing */ +#define F_TRACE_SILENT F_TRACE_FLAG(14) /* No call trace msg suppress */ +#define F_TRACER F_TRACE_FLAG(15) /* May be (has been) tracer */ +#define F_EXCEPTION_TRACE F_TRACE_FLAG(16) /* May have exception trace on stack */ /* port trace flags, currently the same as process trace flags */ -#define F_TRACE_SCHED_PORTS (1 << 18) /* Trace of port scheduling */ -#define F_TRACE_SCHED_PROCS (1 << 19) /* With virtual scheduling */ -#define F_TRACE_PORTS (1 << 20) /* Ports equivalent to F_TRACE_PROCS */ -#define F_TRACE_SCHED_NO (1 << 21) /* Trace with scheduler id */ -#define F_TRACE_SCHED_EXIT (1 << 22) +#define F_TRACE_SCHED_PORTS F_TRACE_FLAG(17) /* Trace of port scheduling */ +#define F_TRACE_SCHED_PROCS F_TRACE_FLAG(18) /* With virtual scheduling */ +#define F_TRACE_PORTS F_TRACE_FLAG(19) /* Ports equivalent to F_TRACE_PROCS */ +#define F_TRACE_SCHED_NO F_TRACE_FLAG(20) /* Trace with scheduler id */ +#define F_TRACE_SCHED_EXIT F_TRACE_FLAG(21) -#define F_NUM_FLAGS 23 +#define F_NUM_FLAGS (ERTS_TRACE_TS_TYPE_BITS + 22) #ifdef DEBUG # define F_INITIAL_TRACE_FLAGS (5 << F_NUM_FLAGS) #else # define F_INITIAL_TRACE_FLAGS 0 #endif +/* F_TIMESTAMP_MASK is a bit-field of all all timestamp types */ +#define F_TIMESTAMP_MASK \ + (ERTS_TRACE_TS_TYPE_MASK << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) + #define TRACEE_FLAGS ( F_TRACE_PROCS | F_TRACE_CALLS \ | F_TRACE_SOS | F_TRACE_SOS1| F_TRACE_RECEIVE \ | F_TRACE_SOL | F_TRACE_SOL1 | F_TRACE_SEND \ - | F_TRACE_SCHED | F_TIMESTAMP | F_TRACE_GC \ + | F_TRACE_SCHED | F_TIMESTAMP_MASK | F_TRACE_GC \ | F_TRACE_ARITY_ONLY | F_TRACE_RETURN_TO \ | F_TRACE_SILENT | F_TRACE_SCHED_PROCS | F_TRACE_PORTS \ | F_TRACE_SCHED_PORTS | F_TRACE_SCHED_NO \ | F_TRACE_SCHED_EXIT) #define ERTS_TRACEE_MODIFIER_FLAGS \ - (F_TRACE_SILENT | F_TIMESTAMP | F_TRACE_SCHED_NO) + (F_TRACE_SILENT | F_TIMESTAMP_MASK | F_TRACE_SCHED_NO) #define ERTS_PORT_TRACEE_FLAGS \ (ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS) #define ERTS_PROC_TRACEE_FLAGS \ ((TRACEE_FLAGS & ~ERTS_PORT_TRACEE_FLAGS) | ERTS_TRACEE_MODIFIER_FLAGS) +#define SEQ_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N))) + /* Sequential trace flags */ + +/* SEQ_TRACE_TIMESTAMP_MASK is a bit-field */ +#define SEQ_TRACE_TIMESTAMP_MASK \ + (ERTS_TRACE_TS_TYPE_MASK << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT) + #define SEQ_TRACE_SEND (1 << 0) #define SEQ_TRACE_RECEIVE (1 << 1) #define SEQ_TRACE_PRINT (1 << 2) -#define SEQ_TRACE_TIMESTAMP (1 << 3) + +#define ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT 3 + +#define SEQ_TRACE_NOW_TS (ERTS_TRACE_FLG_NOW_TIMESTAMP \ + << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT) +#define SEQ_TRACE_STRICT_MON_TS (ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP \ + << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT) +#define SEQ_TRACE_MON_TS (ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP \ + << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT) #ifdef USE_VM_PROBES #define DT_UTAG_PERMANENT (1 << 0) diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 71396561a3..39c36ee7a9 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -618,7 +618,7 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) { if (psflg) erts_print(to, to_arg, " | "); - for (i = 0; i < ERTS_PSFLG_MAX && psflg; i++) { + for (i = 0; i <= ERTS_PSFLG_MAX && psflg; i++) { erts_aint32_t chk = (1 << i); if (psflg & chk) { switch (chk) { @@ -660,16 +660,14 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) { erts_print(to, to_arg, "DELAYED_SYS"); break; case ERTS_PSFLG_OFF_HEAP_MSGQ: erts_print(to, to_arg, "OFF_HEAP_MSGQ"); break; -#ifdef ERTS_DIRTY_SCHEDULERS + case ERTS_PSFLG_ON_HEAP_MSGQ: + erts_print(to, to_arg, "ON_HEAP_MSGQ"); break; case ERTS_PSFLG_DIRTY_CPU_PROC: erts_print(to, to_arg, "DIRTY_CPU_PROC"); break; case ERTS_PSFLG_DIRTY_IO_PROC: erts_print(to, to_arg, "DIRTY_IO_PROC"); break; - case ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q: - erts_print(to, to_arg, "DIRTY_CPU_PROC_IN_Q"); break; - case ERTS_PSFLG_DIRTY_IO_PROC_IN_Q: - erts_print(to, to_arg, "DIRTY_IO_PROC_IN_Q"); break; -#endif + case ERTS_PSFLG_DIRTY_ACTIVE_SYS: + erts_print(to, to_arg, "DIRTY_ACTIVE_SYS"); break; default: erts_print(to, to_arg, "UNKNOWN(%d)", chk); break; } diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 34f91e2ec8..e689547d1d 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -2056,6 +2056,8 @@ erts_atomic64_read_dirty(erts_atomic64_t *var) #endif /* !USE_THREADS */ +#include "erl_msacc.h" + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void @@ -2414,6 +2416,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx) { #ifdef USE_THREADS int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_unlock(&mtx->lc); #endif @@ -2432,6 +2435,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx) #endif if (res != 0 && res != EINTR) erts_thr_fatal_error(res, "wait on condition variable"); + ERTS_MSACC_POP_STATE(); #endif } @@ -3488,7 +3492,11 @@ ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep) ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep) { #ifdef USE_THREADS - return ethr_event_wait(&((ethr_ts_event *) ep)->event); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_wait(&((ethr_ts_event *) ep)->event); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3497,7 +3505,11 @@ ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep) ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount) { #ifdef USE_THREADS - return ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3506,8 +3518,12 @@ ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount) ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo) { #ifdef USE_THREADS - return ethr_event_twait(&((ethr_ts_event *) ep)->event, - (ethr_sint64_t) tmo); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_twait(&((ethr_ts_event *) ep)->event, + (ethr_sint64_t) tmo); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3516,9 +3532,13 @@ ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo) ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo) { #ifdef USE_THREADS - return ethr_event_stwait(&((ethr_ts_event *) ep)->event, - spincount, - (ethr_sint64_t) tmo); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_stwait(&((ethr_ts_event *) ep)->event, + spincount, + (ethr_sint64_t) tmo); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 43e543e035..5242063550 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -133,11 +133,17 @@ typedef struct { extern ErtsTimeSupData erts_time_sup__; +ErtsMonotonicTime erts_napi_monotonic_time(int time_unit); +ErtsMonotonicTime erts_napi_time_offset(int time_unit); +ErtsMonotonicTime erts_napi_convert_time_unit(ErtsMonotonicTime val, int from, int to); + ERTS_GLB_INLINE Uint64 erts_time_unit_conversion(Uint64 value, Uint32 from_time_unit, Uint32 to_time_unit); +ErtsSysPerfCounter erts_perf_counter_unit(void); + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE Uint64 diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 7ec64506e8..98159fdf72 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -33,6 +33,8 @@ #include "global.h" #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" +#include "erl_driver.h" +#include "erl_nif.h" static erts_smp_mtx_t erts_timeofday_mtx; static erts_smp_mtx_t erts_get_time_mtx; @@ -57,6 +59,7 @@ static int time_sup_initialized = 0; #define ERTS_MONOTONIC_TIME_TERA \ (ERTS_MONOTONIC_TIME_GIGA*ERTS_MONOTONIC_TIME_KILO) +static void init_time_napi(void); static void schedule_send_time_offset_changed_notifications(ErtsMonotonicTime new_offset); @@ -948,6 +951,8 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) ErtsMonotonicTime abs_native_offset, native_offset; #endif + init_time_napi(); + erts_hl_timer_init(); ASSERT(ERTS_MONOTONIC_TIME_MIN < ERTS_MONOTONIC_TIME_MAX); @@ -1744,7 +1749,40 @@ erts_get_monotonic_time(ErtsSchedulerData *esdp) { ErtsMonotonicTime mtime = time_sup.r.o.get_time(); update_last_mtime(esdp, mtime); - return mtime; + return mtime; +} + +ErtsMonotonicTime +erts_get_time_offset(void) +{ + return get_time_offset(); +} + +static ERTS_INLINE void +make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec, + ErtsMonotonicTime mtime, ErtsMonotonicTime offset) +{ + ErtsMonotonicTime stime, as; + Uint ms; + + stime = ERTS_MONOTONIC_TO_USEC(mtime + offset); + + as = stime / ERTS_MONOTONIC_TIME_MEGA; + *megasec = ms = (Uint) (stime / ERTS_MONOTONIC_TIME_TERA); + *sec = (Uint) (as - (((ErtsMonotonicTime) ms) + * ERTS_MONOTONIC_TIME_MEGA)); + *microsec = (Uint) (stime - as*ERTS_MONOTONIC_TIME_MEGA); + + ASSERT(((ErtsMonotonicTime) ms)*ERTS_MONOTONIC_TIME_TERA + + ((ErtsMonotonicTime) *sec)*ERTS_MONOTONIC_TIME_MEGA + + *microsec == stime); +} + +void +erts_make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec, + ErtsMonotonicTime mtime, ErtsMonotonicTime offset) +{ + make_timestamp_value(megasec, sec, microsec, mtime, offset); } void @@ -2165,6 +2203,146 @@ time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonoto return ret; } + +/* + * Time Native API (drivers and NIFs) + */ + +#define ERTS_NAPI_TIME_ERROR ((ErtsMonotonicTime) ERTS_NAPI_TIME_ERROR__) + +static void +init_time_napi(void) +{ + /* Verify that time native api constants are as expected... */ + + ASSERT(sizeof(ErtsMonotonicTime) == sizeof(ErlDrvTime)); + ASSERT(ERL_DRV_TIME_ERROR == (ErlDrvTime) ERTS_NAPI_TIME_ERROR); + ASSERT(ERL_DRV_TIME_ERROR < (ErlDrvTime) 0); + ASSERT(ERTS_NAPI_SEC__ == (int) ERL_DRV_SEC); + ASSERT(ERTS_NAPI_MSEC__ == (int) ERL_DRV_MSEC); + ASSERT(ERTS_NAPI_USEC__ == (int) ERL_DRV_USEC); + ASSERT(ERTS_NAPI_NSEC__ == (int) ERL_DRV_NSEC); + + ASSERT(sizeof(ErtsMonotonicTime) == sizeof(ErlNifTime)); + ASSERT(ERL_NIF_TIME_ERROR == (ErlNifTime) ERTS_NAPI_TIME_ERROR); + ASSERT(ERL_NIF_TIME_ERROR < (ErlNifTime) 0); + ASSERT(ERTS_NAPI_SEC__ == (int) ERL_NIF_SEC); + ASSERT(ERTS_NAPI_MSEC__ == (int) ERL_NIF_MSEC); + ASSERT(ERTS_NAPI_USEC__ == (int) ERL_NIF_USEC); + ASSERT(ERTS_NAPI_NSEC__ == (int) ERL_NIF_NSEC); +} + +ErtsMonotonicTime +erts_napi_monotonic_time(int time_unit) +{ + ErtsSchedulerData *esdp; + ErtsMonotonicTime mtime; + + /* At least for now only allow schedulers to do this... */ + esdp = erts_get_scheduler_data(); + if (!esdp) + return ERTS_NAPI_TIME_ERROR; + + mtime = time_sup.r.o.get_time(); + update_last_mtime(esdp, mtime); + + switch (time_unit) { + case ERTS_NAPI_SEC__: + mtime = ERTS_MONOTONIC_TO_SEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_SEC; + break; + case ERTS_NAPI_MSEC__: + mtime = ERTS_MONOTONIC_TO_MSEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_MSEC; + break; + case ERTS_NAPI_USEC__: + mtime = ERTS_MONOTONIC_TO_USEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_USEC; + break; + case ERTS_NAPI_NSEC__: + mtime = ERTS_MONOTONIC_TO_NSEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_NSEC; + break; + default: + return ERTS_NAPI_TIME_ERROR; + } + + return mtime; +} + +ErtsMonotonicTime +erts_napi_time_offset(int time_unit) +{ + ErtsSchedulerData *esdp; + ErtsSystemTime offs; + + /* At least for now only allow schedulers to do this... */ + esdp = erts_get_scheduler_data(); + if (!esdp) + return ERTS_NAPI_TIME_ERROR; + + offs = get_time_offset(); + switch (time_unit) { + case ERTS_NAPI_SEC__: + offs = ERTS_MONOTONIC_TO_SEC(offs); + offs -= ERTS_MONOTONIC_OFFSET_SEC; + break; + case ERTS_NAPI_MSEC__: + offs = ERTS_MONOTONIC_TO_MSEC(offs); + offs -= ERTS_MONOTONIC_OFFSET_MSEC; + break; + case ERTS_NAPI_USEC__: + offs = ERTS_MONOTONIC_TO_USEC(offs); + offs -= ERTS_MONOTONIC_OFFSET_USEC; + break; + case ERTS_NAPI_NSEC__: + offs = ERTS_MONOTONIC_TO_NSEC(offs); + offs -= ERTS_MONOTONIC_OFFSET_NSEC; + break; + default: + return ERTS_NAPI_TIME_ERROR; + } + return offs; +} + +ErtsMonotonicTime +erts_napi_convert_time_unit(ErtsMonotonicTime val, int from, int to) +{ + ErtsMonotonicTime ffreq, tfreq, denom; + /* + * Convertion between time units using floor function. + * + * Note that this needs to work also for negative + * values. Ordinary integer division on a negative + * value will give ceiling... + */ + + switch ((int) from) { + case ERTS_NAPI_SEC__: ffreq = 1; break; + case ERTS_NAPI_MSEC__: ffreq = 1000; break; + case ERTS_NAPI_USEC__: ffreq = 1000*1000; break; + case ERTS_NAPI_NSEC__: ffreq = 1000*1000*1000; break; + default: return ERTS_NAPI_TIME_ERROR; + } + + switch ((int) to) { + case ERTS_NAPI_SEC__: tfreq = 1; break; + case ERTS_NAPI_MSEC__: tfreq = 1000; break; + case ERTS_NAPI_USEC__: tfreq = 1000*1000; break; + case ERTS_NAPI_NSEC__: tfreq = 1000*1000*1000; break; + default: return ERTS_NAPI_TIME_ERROR; + } + + if (tfreq >= ffreq) + return val * (tfreq / ffreq); + + denom = ffreq / tfreq; + if (val >= 0) + return val / denom; + + return (val - (denom - 1)) / denom; +} + /* Built in functions */ BIF_RETTYPE monotonic_time_0(BIF_ALIST_0) @@ -2221,22 +2399,14 @@ BIF_RETTYPE time_offset_1(BIF_ALIST_1) BIF_RETTYPE timestamp_0(BIF_ALIST_0) { Eterm *hp, res; - ErtsMonotonicTime stime, mtime, all_sec, offset; + ErtsMonotonicTime mtime, offset; Uint mega_sec, sec, micro_sec; mtime = time_sup.r.o.get_time(); offset = get_time_offset(); update_last_mtime(ERTS_PROC_GET_SCHDATA(BIF_P), mtime); - stime = ERTS_MONOTONIC_TO_USEC(mtime + offset); - all_sec = stime / ERTS_MONOTONIC_TIME_MEGA; - mega_sec = (Uint) (stime / ERTS_MONOTONIC_TIME_TERA); - sec = (Uint) (all_sec - (((ErtsMonotonicTime) mega_sec) - * ERTS_MONOTONIC_TIME_MEGA)); - micro_sec = (Uint) (stime - all_sec*ERTS_MONOTONIC_TIME_MEGA); - ASSERT(((ErtsMonotonicTime) mega_sec)*ERTS_MONOTONIC_TIME_TERA - + ((ErtsMonotonicTime) sec)*ERTS_MONOTONIC_TIME_MEGA - + micro_sec == stime); + make_timestamp_value(&mega_sec, &sec, µ_sec, mtime, offset); /* * Mega seconds is the only value that potentially @@ -2265,9 +2435,19 @@ BIF_RETTYPE os_system_time_0(BIF_ALIST_0) BIF_RET(make_time_val(BIF_P, stime)); } -BIF_RETTYPE os_system_time_1(BIF_ALIST_0) +BIF_RETTYPE os_system_time_1(BIF_ALIST_1) { ErtsSystemTime stime = erts_os_system_time(); BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, stime, 0)); } +BIF_RETTYPE +os_perf_counter_0(BIF_ALIST_0) +{ + BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter())); +} + +BIF_RETTYPE erts_internal_perf_counter_unit_0(BIF_ALIST_0) +{ + BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter_unit())); +} diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index c2efb404d6..25393369a7 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -38,6 +38,7 @@ #include "erl_binary.h" #include "erl_bits.h" #include "erl_thr_progress.h" +#include "erl_bif_unique.h" #if 0 #define DEBUG_PRINTOUTS @@ -77,6 +78,264 @@ enum ErtsSysMsgType { SYS_MSG_TYPE_SYSPROF }; +#define ERTS_TRACE_TS_NOW_MAX_SIZE \ + 4 +#define ERTS_TRACE_TS_MONOTONIC_MAX_SIZE \ + ERTS_MAX_SINT64_HEAP_SIZE +#define ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE \ + (3 + ERTS_MAX_SINT64_HEAP_SIZE \ + + ERTS_MAX_UINT64_HEAP_SIZE) + +#define ERTS_TRACE_PATCH_TS_MAX_SIZE \ + (1 + ((ERTS_TRACE_TS_NOW_MAX_SIZE \ + > ERTS_TRACE_TS_MONOTONIC_MAX_SIZE) \ + ? ((ERTS_TRACE_TS_NOW_MAX_SIZE \ + > ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE) \ + ? ERTS_TRACE_TS_NOW_MAX_SIZE \ + : ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE) \ + : ((ERTS_TRACE_TS_MONOTONIC_MAX_SIZE \ + > ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE) \ + ? ERTS_TRACE_TS_MONOTONIC_MAX_SIZE \ + : ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE))) + +#define TFLGS_TS_TYPE(p) ERTS_TFLGS2TSTYPE(ERTS_TRACE_FLAGS((p))) + +/* + * FUTURE CHANGES: + * + * The timestamp functionality has intentionally been + * split in two parts for future use even though it + * is not used like this today. take_timestamp() takes + * the timestamp and calculate heap need for it (which + * is not constant). write_timestamp() writes the + * timestamp to the allocated heap. That is, one typically + * want to take the timestamp before allocating the heap + * and then write it to the heap. + * + * The trace output functionality now use patch_ts_size(), + * write_ts(), and patch_ts(). write_ts() both takes the + * timestamp and writes it. Since we don't know the + * heap need when allocating the heap area we need to + * over allocate (maximum size from patch_ts_size()) and + * then potentially (often) shrink the heap area after the + * timestamp has been written. The only reason it is + * currently done this way is because we do not want to + * make major changes of the trace behavior in a patch. + * This is planned to be changed in next major release. + */ + +typedef struct { + int ts_type_flag; + union { + struct { + Uint ms; + Uint s; + Uint us; + } now; + struct { + ErtsMonotonicTime time; + Sint64 raw_unique; + } monotonic; + } u; +} ErtsTraceTimeStamp; + +static ERTS_INLINE Uint +take_timestamp(ErtsTraceTimeStamp *tsp, int ts_type) +{ + int ts_type_flag = ts_type & -ts_type; /* least significant flag */ + + ASSERT(ts_type_flag == ERTS_TRACE_FLG_NOW_TIMESTAMP + || ts_type_flag == ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP + || ts_type_flag == ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP + || ts_type_flag == 0); + + tsp->ts_type_flag = ts_type_flag; + switch (ts_type_flag) { + case 0: + return (Uint) 0; + case ERTS_TRACE_FLG_NOW_TIMESTAMP: +#ifdef HAVE_ERTS_NOW_CPU + if (erts_cpu_timestamp) + erts_get_now_cpu(&tsp->u.now.ms, &tsp->u.now.s, &tsp->u.now.us); + else +#endif + get_now(&tsp->u.now.ms, &tsp->u.now.s, &tsp->u.now.us); + return (Uint) 4; + case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP: + case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: { + Uint hsz = 0; + ErtsMonotonicTime mtime = erts_get_monotonic_time(NULL); + mtime = ERTS_MONOTONIC_TO_NSEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_NSEC; + hsz = (IS_SSMALL(mtime) ? + (Uint) 0 + : ERTS_SINT64_HEAP_SIZE((Sint64) mtime)); + tsp->u.monotonic.time = mtime; + if (ts_type_flag == ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP) { + Sint64 raw_unique; + hsz += 3; /* 2-tuple */ + raw_unique = erts_raw_get_unique_monotonic_integer(); + tsp->u.monotonic.raw_unique = raw_unique; + hsz += erts_raw_unique_monotonic_integer_heap_size(raw_unique); + } + return hsz; + } + default: + ERTS_INTERNAL_ERROR("invalid timestamp type"); + return 0; + } +} + +static ERTS_INLINE Eterm +write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp) +{ + int ts_type_flag = tsp->ts_type_flag; + Eterm res; + + switch (ts_type_flag) { + case 0: + return NIL; + case ERTS_TRACE_FLG_NOW_TIMESTAMP: + res = TUPLE3(*hpp, + make_small(tsp->u.now.ms), + make_small(tsp->u.now.s), + make_small(tsp->u.now.us)); + *hpp += 4; + return res; + case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP: + case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: { + Sint64 mtime, raw; + Eterm unique, emtime; + + mtime = (Sint64) tsp->u.monotonic.time; + emtime = (IS_SSMALL(mtime) + ? make_small((Sint64) mtime) + : erts_sint64_to_big((Sint64) mtime, hpp)); + + if (ts_type_flag == ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP) + return emtime; + + raw = tsp->u.monotonic.raw_unique; + unique = erts_raw_make_unique_monotonic_integer_value(hpp, + raw); + res = TUPLE2(*hpp, emtime, unique); + *hpp += 3; + return res; + } + default: + ERTS_INTERNAL_ERROR("invalid timestamp type"); + return THE_NON_VALUE; + } +} + +#define PATCH_TS_SIZE(p) patch_ts_size(TFLGS_TS_TYPE(p)) + +static ERTS_INLINE Uint +patch_ts_size(int ts_type) +{ + int ts_type_flag = ts_type & -ts_type; /* least significant flag */ + switch (ts_type_flag) { + case 0: + return 0; + case ERTS_TRACE_FLG_NOW_TIMESTAMP: + return 1 + ERTS_TRACE_TS_NOW_MAX_SIZE; + case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP: + return 1 + ERTS_TRACE_TS_MONOTONIC_MAX_SIZE; + case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: + return 1 + ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE; + default: + ERTS_INTERNAL_ERROR("invalid timestamp type"); + return 0; + } +} + +/* + * Write a timestamp. The timestamp MUST be the last + * thing built on the heap. This since write_ts() might + * adjust the size of the used area. + */ +static Eterm +write_ts(int ts_type, Eterm *hp, ErlHeapFragment *bp, Process *tracer) +{ + ErtsTraceTimeStamp ts; + Sint shrink; + Eterm res, *ts_hp = hp; + Uint hsz; + + ASSERT(ts_type); + + hsz = take_timestamp(&ts, ts_type); + + res = write_timestamp(&ts, &ts_hp); + + ASSERT(ts_hp == hp + hsz); + + switch (ts.ts_type_flag) { + case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP: + shrink = ERTS_TRACE_TS_MONOTONIC_MAX_SIZE; + break; + case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: + shrink = ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE; + break; + default: + return res; + } + + shrink -= hsz; + + ASSERT(shrink >= 0); + + if (shrink) { + if (bp) + bp->used_size -= shrink; +#ifndef ERTS_SMP + else if (tracer) { + Eterm *endp = ts_hp + shrink; + HRelease(tracer, endp, ts_hp); + } +#endif + } + + return res; +} + +/* + * Patch a timestamp into a tuple. The tuple MUST be the last thing + * built on the heap before the call, and the timestamp MUST be + * the last thing after the call. This since patch_ts() might adjust + * the size of the used area. + */ + +#define PATCH_TS__(Type, Tuple, Hp, Bp, Tracer) \ + do { \ + int ts_type__ = (Type); \ + if (ts_type__) \ + patch_ts(ts_type__, (Tuple), (Hp), (Bp), (Tracer)); \ + } while (0) + +#ifdef ERTS_SMP +#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \ + PATCH_TS__((Type), (Tuple), (Hp), (Bp), NULL) +#else +#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \ + PATCH_TS__((Type), (Tuple), (Hp), (Bp), (Tracer)) +#endif + +static ERTS_INLINE void +patch_ts(int ts_type, Eterm tuple, Eterm* hp, ErlHeapFragment *bp, Process *tracer) +{ + Eterm *tptr = tuple_val(tuple); + int arity = arityval(*tptr); + + ASSERT(ts_type); + ASSERT((tptr+arity+1) == hp); + + tptr[0] = make_arityval(arity+1); + tptr[1] = am_trace_ts; + + *hp = write_ts(ts_type, hp+1, bp, tracer); +} + #ifdef ERTS_SMP static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type, Eterm from, @@ -364,23 +623,6 @@ erts_get_system_profile(void) { return profile; } - -#ifdef HAVE_ERTS_NOW_CPU -# define GET_NOW(m, s, u) \ -do { \ - if (erts_cpu_timestamp) \ - erts_get_now_cpu(m, s, u); \ - else \ - get_now(m, s, u); \ -} while (0) -#else -# define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0) -#endif - - - -static Eterm* patch_ts(Eterm tuple4, Eterm* hp); - #ifdef ERTS_SMP static void do_send_to_port(Eterm to, @@ -435,11 +677,11 @@ WRITE_SYS_MSG_TO_PORT(Eterm unused_to, /* Send {trace_ts, Pid, out, 0, Timestamp} * followed by {trace_ts, Pid, in, 0, NewTimestamp} * - * 'NewTimestamp' is fetched from GET_NOW() through patch_ts(). + * 'NewTimestamp' through patch_ts(). */ static void -do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) { -#define LOCAL_HEAP_SIZE (4+5+5) +do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp, int ts_type) { +#define LOCAL_HEAP_SIZE (5+5+ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); Eterm message; Eterm *hp; @@ -461,9 +703,11 @@ do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) { SYS_MSG_TYPE_UNDEFINED, message); - message = TUPLE4(hp, am_trace_ts, pid, am_in, mfarity); - hp += 5; - hp = patch_ts(message, hp); + + message = TUPLE5(hp, am_trace_ts, pid, am_in, mfarity, + NIL /* Will be overwritten by timestamp */); + hp += 6; + hp[-1] = write_ts(ts_type, hp, NULL, NULL); do_send_to_port(trace_port->common.id, trace_port, @@ -480,7 +724,7 @@ do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) { * It is assumed that 'message' is not an 'out' message. * * 'c_p' is the currently executing process, "tracee" is the traced process - * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP), + * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP_MASK), * 'message' must contain a timestamp. */ static void @@ -488,8 +732,9 @@ send_to_port(Process *c_p, Eterm message, Eterm *tracer_pid, Uint *tracee_flags) { Port* trace_port; #ifndef ERTS_SMP -#define LOCAL_HEAP_SIZE (4) - Eterm ts, *hp; + int ts_type; +#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE + Eterm ts; DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); #endif @@ -518,7 +763,7 @@ send_to_port(Process *c_p, Eterm message, */ if ( c_p == NULL || - (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) { + (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) { #endif do_send_to_port(*tracer_pid, trace_port, @@ -537,22 +782,12 @@ send_to_port(Process *c_p, Eterm message, */ UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - if (*tracee_flags & F_TIMESTAMP) { - ASSERT(is_tuple(message)); - hp = tuple_val(message); - ts = hp[arityval(hp[0])]; - } else { - /* A fake schedule might be needed, - * but this message does not contain a timestamp. - * Create a dummy trace message with timestamp to be - * passed to do_send_schedfix_to_port(). - */ - Uint ms,s,us; - GET_NOW(&ms, &s, &us); - hp = local_heap; - ts = TUPLE3(hp, make_small(ms), make_small(s), make_small(us)); - hp += 4; - } + /* A fake schedule might be needed. + * Create a dummy trace message with timestamp to be + * passed to do_send_schedfix_to_port(). + */ + ts_type = TFLGS_TS_TYPE(c_p); + ts = write_ts(ts_type, local_heap, NULL, NULL); trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; do_send_to_port(*tracer_pid, @@ -571,7 +806,7 @@ send_to_port(Process *c_p, Eterm message, * just after writning the real trace message, and now gets scheduled * in again. */ - do_send_schedfix_to_port(trace_port, c_p->common.id, ts); + do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type); } erts_port_release(trace_port); @@ -642,20 +877,19 @@ profile_send(Eterm from, Eterm message) { /* A fake schedule out/in message pair will be sent, * if the driver so requests. - * If (timestamp == NIL), one is fetched from GET_NOW(). * * 'c_p' is the currently executing process, may be NULL. */ static void seq_trace_send_to_port(Process *c_p, Eterm seq_tracer, - Eterm message, - Eterm timestamp) + Eterm message) { Port* trace_port; #ifndef ERTS_SMP - Eterm ts, *hp; -#define LOCAL_HEAP_SIZE (4) + int ts_type; + Eterm ts; +#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); #endif @@ -680,7 +914,7 @@ seq_trace_send_to_port(Process *c_p, } if (c_p == NULL - || (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) { + || (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) { #endif do_send_to_port(seq_tracer, trace_port, @@ -697,20 +931,12 @@ seq_trace_send_to_port(Process *c_p, * with 'running' and 'timestamp'. */ - if (timestamp != NIL) { - ts = timestamp; - } else { - /* A fake schedule might be needed, - * but this message does not contain a timestamp. - * Create a dummy trace message with timestamp to be - * passed to do_send_schedfix_to_port(). - */ - Uint ms,s,us; - GET_NOW(&ms, &s, &us); - hp = local_heap; - ts = TUPLE3(hp, make_small(ms), make_small(s), make_small(us)); - hp += 4; - } + /* A fake schedule might be needed. + * Create a dummy trace message with timestamp to be + * passed to do_send_schedfix_to_port(). + */ + ts_type = TFLGS_TS_TYPE(c_p); + ts = write_ts(ts_type, local_heap, NULL, NULL); trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; do_send_to_port(seq_tracer, @@ -729,7 +955,7 @@ seq_trace_send_to_port(Process *c_p, * just after writing the real trace message, and now gets scheduled * in again. */ - do_send_schedfix_to_port(trace_port, c_p->common.id, ts); + do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type); } erts_port_release(trace_port); @@ -739,32 +965,6 @@ seq_trace_send_to_port(Process *c_p, #endif } -#define TS_HEAP_WORDS 5 -#define TS_SIZE(p) ((ERTS_TRACE_FLAGS((p)) & F_TIMESTAMP) \ - ? TS_HEAP_WORDS \ - : 0) - -/* - * Patch a timestamp into a tuple. The tuple must be the last thing - * built on the heap. - * - * Returns the new hp pointer. -*/ -static Eterm* -patch_ts(Eterm tuple, Eterm* hp) -{ - Uint ms, s, us; - Eterm* ptr = tuple_val(tuple); - int arity = arityval(*ptr); - - ASSERT((ptr+arity+1) == hp); - ptr[0] = make_arityval(arity+1); - ptr[1] = am_trace_ts; - GET_NOW(&ms, &s, &us); - *hp = TUPLE3(hp+1, make_small(ms), make_small(s), make_small(us)); - return hp+5; -} - static ERTS_INLINE void send_to_tracer(Process *tracee, ERTS_TRACER_REF_TYPE tracer_ref, @@ -777,13 +977,13 @@ send_to_tracer(Process *tracee, erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(tracee) & F_TIMESTAMP) - *hpp = patch_ts(msg, *hpp); - - if (is_internal_pid(ERTS_TRACER_PROC(tracee))) + if (is_internal_pid(ERTS_TRACER_PROC(tracee))) { + PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(tracee->common.id, tracer_ref, msg, bp); + } else { ASSERT(is_internal_port(ERTS_TRACER_PROC(tracee))); + PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, NULL, NULL); send_to_port(no_fake_sched ? NULL : tracee, msg, &ERTS_TRACER_PROC(tracee), @@ -797,7 +997,7 @@ send_to_tracer(Process *tracee, static void trace_sched_aux(Process *p, Eterm what, int never_fake_sched) { -#define LOCAL_HEAP_SIZE (5+4+1+TS_HEAP_WORDS) +#define LOCAL_HEAP_SIZE (5+4+1+ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p); Eterm tmp, mess, *hp; ErlHeapFragment *bp = NULL; @@ -853,7 +1053,7 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched) size += 4; if (sched_no) size += 1; - size += TS_SIZE(p); + size += PATCH_TS_SIZE(p); hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); } @@ -927,7 +1127,7 @@ trace_send(Process *p, Eterm to, Eterm msg) } if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (11) +#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -935,9 +1135,7 @@ trace_send(Process *p, Eterm to, Eterm msg) mess = TUPLE5(hp, am_trace, p->common.id, operation, msg, to); hp += 6; erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); #undef LOCAL_HEAP_SIZE @@ -956,7 +1154,7 @@ trace_send(Process *p, Eterm to, Eterm msg) sz_msg = size_object(msg); sz_to = size_object(to); - need = sz_msg + sz_to + 6 + TS_SIZE(p); + need = sz_msg + sz_to + 6 + PATCH_TS_SIZE(p); hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); @@ -973,10 +1171,7 @@ trace_send(Process *p, Eterm to, Eterm msg) erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - patch_ts(mess, hp); - } - + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); } @@ -993,7 +1188,7 @@ trace_receive(Process *rp, Eterm msg) Eterm* hp; if (is_internal_port(ERTS_TRACER_PROC(rp))) { -#define LOCAL_HEAP_SIZE (10) +#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -1001,9 +1196,7 @@ trace_receive(Process *rp, Eterm msg) mess = TUPLE4(hp, am_trace, rp->common.id, am_receive, msg); hp += 5; erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(rp) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, NULL, NULL); send_to_port(rp, mess, &ERTS_TRACER_PROC(rp), &ERTS_TRACE_FLAGS(rp)); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); #undef LOCAL_HEAP_SIZE @@ -1022,7 +1215,7 @@ trace_receive(Process *rp, Eterm msg) sz_msg = size_object(msg); - hsz = sz_msg + 5 + TS_SIZE(rp); + hsz = sz_msg + 5 + PATCH_TS_SIZE(rp); hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, tracer_ref); @@ -1032,10 +1225,7 @@ trace_receive(Process *rp, Eterm msg) erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(rp) & F_TIMESTAMP) { - patch_ts(mess, hp); - } - + PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(rp->common.id, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); } @@ -1081,6 +1271,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, Eterm type_atom; int sz_exit; Eterm seq_tracer; + int ts_type; seq_tracer = erts_get_system_seq_tracer(); @@ -1108,8 +1299,10 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, return; /* no need to send anything */ } + ts_type = ERTS_SEQTFLGS2TSTYPE(unsigned_val(SEQ_TRACE_T_FLAGS(token))); + if (is_internal_port(seq_tracer)) { -#define LOCAL_HEAP_SIZE (64) +#define LOCAL_HEAP_SIZE (60 + ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -1125,17 +1318,17 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), receiver, msg); hp += 6; + erts_smp_mtx_lock(&smq_mtx); - if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) == 0) { + if (!ts_type) { mess = TUPLE3(hp, am_seq_trace, label, mess); - seq_trace_send_to_port(NULL, seq_tracer, mess, NIL); + seq_trace_send_to_port(NULL, seq_tracer, mess); } else { - Uint ms,s,us,ts; - GET_NOW(&ms, &s, &us); - ts = TUPLE3(hp, make_small(ms),make_small(s), make_small(us)); - hp += 4; - mess = TUPLE4(hp, am_seq_trace, label, mess, ts); - seq_trace_send_to_port(process, seq_tracer, mess, ts); + mess = TUPLE4(hp, am_seq_trace, label, mess, + NIL /* Will be overwritten by timestamp */); + hp += 5; + hp[-1] = write_ts(ts_type, hp, NULL, NULL); + seq_trace_send_to_port(process, seq_tracer, mess); } UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); #undef LOCAL_HEAP_SIZE @@ -1170,8 +1363,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, sz_lastcnt_serial = 3; /* TUPLE2 */ sz_msg = size_object(msg); - sz_ts = ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) ? - 5 : 0); + sz_ts = patch_ts_size(ts_type); if (exitfrom != NIL) { sz_exit = 4; /* create {'EXIT',exitfrom,msg} */ sz_exitfrom = size_object(exitfrom); @@ -1215,14 +1407,20 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, erts_smp_mtx_lock(&smq_mtx); - if (sz_ts) {/* timestamp should be included */ - Uint ms,s,us,ts; - GET_NOW(&ms, &s, &us); - ts = TUPLE3(hp, make_small(ms),make_small(s), make_small(us)); - hp += 4; - mess = TUPLE4(hp, am_seq_trace, label, mess, ts); - } else { + if (!ts_type) mess = TUPLE3(hp, am_seq_trace, label, mess); + else { + mess = TUPLE4(hp, am_seq_trace, label, mess, + NIL /* Will be overwritten by timestamp */); + hp += 5; + /* Write timestamp in element 6 of the 'msg' tuple */ + hp[-1] = write_ts(ts_type, hp, bp, +#ifndef ERTS_SMP + tracer +#else + NULL +#endif + ); } #ifdef ERTS_SMP @@ -1245,7 +1443,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, void erts_trace_return_to(Process *p, BeamInstr *pc) { -#define LOCAL_HEAP_SIZE (4+5+5) +#define LOCAL_HEAP_SIZE (4+5+ERTS_TRACE_PATCH_TS_MAX_SIZE) Eterm* hp; Eterm mfa; Eterm mess; @@ -1270,9 +1468,7 @@ erts_trace_return_to(Process *p, BeamInstr *pc) erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); if (is_internal_port(ERTS_TRACER_PROC(p))) { send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); @@ -1319,6 +1515,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) Eterm mod, name; int arity; Uint meta_flags, *tracee_flags; + int ts_type; #ifdef ERTS_SMP Eterm tracee; #endif @@ -1354,7 +1551,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) * meta trace => * use fixed flag set instead of process flags */ - meta_flags = F_TRACE_CALLS | F_TIMESTAMP; + meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; #ifdef ERTS_SMP tracee = NIL; @@ -1368,8 +1565,10 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) name = fi[1]; arity = fi[2]; + ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); + if (is_internal_port(*tracer_pid)) { -#define LOCAL_HEAP_SIZE (4+6+5) +#define LOCAL_HEAP_SIZE (4+6+ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); hp = local_heap; @@ -1378,9 +1577,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) mess = TUPLE5(hp, am_trace, p->common.id, am_return_from, mfa, retval); hp += 6; erts_smp_mtx_lock(&smq_mtx); - if (*tracee_flags & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(ts_type, mess, hp, NULL, NULL); send_to_port(p, mess, tracer_pid, tracee_flags); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); #undef LOCAL_HEAP_SIZE @@ -1391,24 +1588,15 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) ERTS_TRACER_REF_TYPE tracer_ref; unsigned size; unsigned retval_size; -#ifdef DEBUG - Eterm* limit; -#endif ASSERT(is_internal_pid(*tracer_pid)); ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags); - + retval_size = size_object(retval); - size = 6 + 4 + retval_size; - if (*tracee_flags & F_TIMESTAMP) { - size += 1+4; - } + size = 6 + 4 + retval_size + patch_ts_size(ts_type); hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); -#ifdef DEBUG - limit = hp + size; -#endif /* * Build the trace tuple and put it into receive queue of the tracer process. @@ -1422,11 +1610,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) erts_smp_mtx_lock(&smq_mtx); - if (*tracee_flags & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } - - ASSERT(hp == limit); + PATCH_TS(ts_type, mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); @@ -1449,6 +1633,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, Eterm cv; Eterm mess; Uint meta_flags, *tracee_flags; + int ts_type; #ifdef ERTS_SMP Eterm tracee; #endif @@ -1487,15 +1672,17 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, * meta trace => * use fixed flag set instead of process flags */ - meta_flags = F_TRACE_CALLS | F_TIMESTAMP; + meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; #ifdef ERTS_SMP tracee = NIL; #endif } + ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); + if (is_internal_port(*tracer_pid)) { -#define LOCAL_HEAP_SIZE (4+3+6+5) +#define LOCAL_HEAP_SIZE (4+3+6+ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -1508,10 +1695,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, hp += 6; ASSERT((hp - local_heap) <= LOCAL_HEAP_SIZE); erts_smp_mtx_lock(&smq_mtx); - if (*tracee_flags & F_TIMESTAMP) { - hp = patch_ts(mess, hp); /* hp += 5 */ - ASSERT((hp - local_heap) == LOCAL_HEAP_SIZE); - } + PATCH_TS(ts_type, mess, hp, NULL, NULL); send_to_port(p, mess, tracer_pid, tracee_flags); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); #undef LOCAL_HEAP_SIZE @@ -1522,24 +1706,15 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, ERTS_TRACER_REF_TYPE tracer_ref; unsigned size; unsigned value_size; -#ifdef DEBUG - Eterm* limit; -#endif ASSERT(is_internal_pid(*tracer_pid)); ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags); value_size = size_object(value); - size = 6 + 4 + 3 + value_size; - if (*tracee_flags & F_TIMESTAMP) { - size += 1+4; - } + size = 6 + 4 + 3 + value_size + patch_ts_size(ts_type); hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); -#ifdef DEBUG - limit = hp + size; -#endif /* * Build the trace tuple and put it into receive queue of the tracer process. @@ -1556,11 +1731,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, erts_smp_mtx_lock(&smq_mtx); - if (*tracee_flags & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } - - ASSERT(hp == limit); + PATCH_TS(ts_type, mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); @@ -1593,6 +1764,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, Eterm pam_result = am_true; Eterm mess; Uint meta_flags, *tracee_flags; + int ts_type; #ifdef ERTS_SMP Eterm tracee; #endif @@ -1634,7 +1806,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, /* No trace messages for sensitive processes. */ return 0; } - meta_flags = F_TRACE_CALLS | F_TIMESTAMP; + meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; #ifdef ERTS_SMP tracee = NIL; @@ -1677,8 +1849,10 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, } args = transformed_args; + ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); + if (is_internal_port(*tracer_pid)) { - Eterm local_heap[64+MAX_ARG]; + Eterm local_heap[64+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG]; hp = local_heap; if (!erts_is_valid_tracer_port(*tracer_pid)) { @@ -1777,9 +1951,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, *hp++ = pam_result; } erts_smp_mtx_lock(&smq_mtx); - if (*tracee_flags & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(ts_type, mess, hp, NULL, NULL); send_to_port(p, mess, tracer_pid, tracee_flags); erts_smp_mtx_unlock(&smq_mtx); erts_match_set_release_result(p); @@ -1798,9 +1970,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, unsigned sizes[MAX_ARG]; unsigned pam_result_size = 0; int invalid_tracer; -#ifdef DEBUG - Eterm* limit; -#endif + ASSERT(is_internal_pid(*tracer_pid)); tracer = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, @@ -1892,10 +2062,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, size += sizes[i]; } } - if (*tracee_flags & F_TIMESTAMP) { - size += 1 + 4; - /* One element in trace tuple + timestamp tuple. */ - } + size += patch_ts_size(ts_type); if (pam_result != am_true) { pam_result_size = size_object(pam_result); size += 1 + pam_result_size; @@ -1903,9 +2070,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, } hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); -#ifdef DEBUG - limit = hp + size; -#endif /* * Build the the {M,F,A} tuple in the message buffer. @@ -1948,11 +2112,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, erts_smp_mtx_lock(&smq_mtx); - if (*tracee_flags & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } - - ASSERT(hp == limit); + PATCH_TS(ts_type, mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); @@ -1987,9 +2147,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) mess = TUPLE4(hp, am_trace, t_p->common.id, what, data); hp += 5; erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL); send_to_port( #ifndef ERTS_SMP /* No fake schedule out and in again after an exit */ @@ -2019,7 +2177,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) sz_data = size_object(data); - need = sz_data + 5 + TS_SIZE(t_p); + need = sz_data + 5 + PATCH_TS_SIZE(t_p); hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); @@ -2029,9 +2187,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); @@ -2065,9 +2221,7 @@ trace_proc_spawn(Process *p, Eterm pid, mess = TUPLE5(hp, am_trace, p->common.id, am_spawn, pid, mfa); hp += 6; erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); #undef LOCAL_HEAP_SIZE @@ -2088,7 +2242,7 @@ trace_proc_spawn(Process *p, Eterm pid, sz_args = size_object(args); sz_pid = size_object(pid); - need = sz_args + 4 + 6 + TS_SIZE(p); + need = sz_args + 4 + 6 + PATCH_TS_SIZE(p); hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); @@ -2101,9 +2255,7 @@ trace_proc_spawn(Process *p, Eterm pid, erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); @@ -2152,11 +2304,8 @@ trace_gc(Process *p, Eterm what) #define LOCAL_HEAP_SIZE \ (ERTS_PROCESS_GC_INFO_MAX_SIZE) + \ - 5/*4-tuple */ + TS_HEAP_WORDS + 5/*4-tuple */ + ERTS_TRACE_PATCH_TS_MAX_SIZE DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p); -#ifdef DEBUG - Eterm* limit; -#endif UseTmpHeap(LOCAL_HEAP_SIZE,p); @@ -2166,7 +2315,7 @@ trace_gc(Process *p, Eterm what) size = 0; (void) erts_process_gc_info(p, &size, NULL); - size += 5/*4-tuple*/ + TS_SIZE(p); + size += 5/*4-tuple*/ + PATCH_TS_SIZE(p); #endif } else { ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); @@ -2178,15 +2327,12 @@ trace_gc(Process *p, Eterm what) size = 0; (void) erts_process_gc_info(p, &size, NULL); - size += 5/*4-tuple*/ + TS_SIZE(p); + size += 5/*4-tuple*/ + PATCH_TS_SIZE(p); hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); } -#ifdef DEBUG - limit = hp + size; ASSERT(size <= LOCAL_HEAP_SIZE); -#endif msg = erts_process_gc_info(p, NULL, &hp); @@ -2195,14 +2341,14 @@ trace_gc(Process *p, Eterm what) erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(msg, hp); - } - ASSERT(hp == limit); - if (is_internal_port(ERTS_TRACER_PROC(p))) + if (is_internal_port(ERTS_TRACER_PROC(p))) { + PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, NULL, NULL); send_to_port(p, msg, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - else + } + else { + PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, msg, bp); + } erts_smp_mtx_unlock(&smq_mtx); UnUseTmpHeap(LOCAL_HEAP_SIZE,p); #undef LOCAL_HEAP_SIZE @@ -2526,19 +2672,18 @@ monitor_generic(Process *p, Eterm type, Eterm spec) { void profile_scheduler(Eterm scheduler_id, Eterm state) { - Eterm *hp, msg, timestamp; - Uint Ms, s, us; + Eterm *hp, msg; + ErlHeapFragment *bp = NULL; #ifndef ERTS_SMP -#define LOCAL_HEAP_SIZE (4 + 7) +#define LOCAL_HEAP_SIZE (7 + ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); hp = local_heap; #else - ErlHeapFragment *bp; Uint hsz; - hsz = 4 + 7; + hsz = 7 + patch_ts_size(erts_system_profile_ts_type)-1; bp = new_message_buffer(hsz); hp = bp->mem; @@ -2558,10 +2703,13 @@ profile_scheduler(Eterm scheduler_id, Eterm state) { break; } - GET_NOW(&Ms, &s, &us); - timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; - msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state, - make_small(active_sched), timestamp); hp += 7; + msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, + state, make_small(active_sched), + NIL /* Will be overwritten by timestamp */); + hp += 7; + + /* Write timestamp in element 6 of the 'msg' tuple */ + hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL); #ifndef ERTS_SMP profile_send(NIL, msg); @@ -2632,7 +2780,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { Eterm* hp; if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (5+6) +#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -2641,9 +2789,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->common.id, drv_name); hp += 6; erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); /* No fake schedule */ send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -2657,7 +2803,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - sz_data = 6 + TS_SIZE(p); + sz_data = 6 + PATCH_TS_SIZE(p); ERTS_GET_TRACER_REF(tracer_ref, ERTS_TRACER_PROC(p), @@ -2670,9 +2816,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); @@ -2696,7 +2840,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) { || erts_thr_progress_is_blocking()); if (is_internal_port(ERTS_TRACER_PROC(t_p))) { -#define LOCAL_HEAP_SIZE (5+5) +#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -2704,9 +2848,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) { mess = TUPLE4(hp, am_trace, t_p->common.id, what, data); hp += 5; erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL); /* No fake schedule */ send_to_port(NULL,mess,&ERTS_TRACER_PROC(t_p),&ERTS_TRACE_FLAGS(t_p)); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -2720,7 +2862,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) { ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p))); - sz_data = 5 + TS_SIZE(t_p); + sz_data = 5 + PATCH_TS_SIZE(t_p); ERTS_GET_TRACER_REF(tracer_ref, ERTS_TRACER_PROC(t_p), @@ -2733,9 +2875,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) { erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); @@ -2763,7 +2903,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) { Eterm sched_id = am_undefined; if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (5+6) +#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -2786,9 +2926,8 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) { hp += ws; erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } + + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); /* No fake scheduling */ send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); @@ -2808,7 +2947,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) { ERTS_TRACER_PROC(p), ERTS_TRACE_FLAGS(p)); - hp = ERTS_ALLOC_SYSMSG_HEAP(ws+TS_SIZE(p), &bp, &off_heap, tracer_ref); + hp = ERTS_ALLOC_SYSMSG_HEAP(ws+PATCH_TS_SIZE(p), &bp, &off_heap, tracer_ref); if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) { #ifdef ERTS_SMP @@ -2826,10 +2965,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) { erts_smp_mtx_lock(&smq_mtx); - if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) { - hp = patch_ts(mess, hp); - } - + PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); erts_smp_mtx_unlock(&smq_mtx); } @@ -2839,13 +2975,12 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) { void profile_runnable_port(Port *p, Eterm status) { - Uint Ms, s, us; - Eterm *hp, msg, timestamp; - + Eterm *hp, msg; + ErlHeapFragment *bp = NULL; Eterm count = make_small(0); #ifndef ERTS_SMP -#define LOCAL_HEAP_SIZE (4 + 6) +#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -2853,10 +2988,9 @@ profile_runnable_port(Port *p, Eterm status) { hp = local_heap; #else - ErlHeapFragment *bp; Uint hsz; - hsz = 4 + 6; + hsz = 6 + patch_ts_size(erts_system_profile_ts_type)-1; bp = new_message_buffer(hsz); hp = bp->mem; @@ -2864,9 +2998,12 @@ profile_runnable_port(Port *p, Eterm status) { erts_smp_mtx_lock(&smq_mtx); - GET_NOW(&Ms, &s, &us); - timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; - msg = TUPLE5(hp, am_profile, p->common.id, status, count, timestamp); hp += 6; + msg = TUPLE5(hp, am_profile, p->common.id, status, count, + NIL /* Will be overwritten by timestamp */); + hp += 6; + + /* Write timestamp in element 5 of the 'msg' tuple */ + hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL); #ifndef ERTS_SMP profile_send(p->common.id, msg); @@ -2881,20 +3018,19 @@ profile_runnable_port(Port *p, Eterm status) { /* Process profiling */ void profile_runnable_proc(Process *p, Eterm status){ - Uint Ms, s, us; - Eterm *hp, msg, timestamp; + Eterm *hp, msg; Eterm where = am_undefined; + ErlHeapFragment *bp = NULL; #ifndef ERTS_SMP -#define LOCAL_HEAP_SIZE (4 + 6 + 4) +#define LOCAL_HEAP_SIZE (4 + 6 + ERTS_TRACE_PATCH_TS_MAX_SIZE) DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); UseTmpHeapNoproc(LOCAL_HEAP_SIZE); hp = local_heap; #else - ErlHeapFragment *bp; - Uint hsz = 4 + 6 + 4; + Uint hsz = 4 + 6 + patch_ts_size(erts_system_profile_ts_type)-1; #endif if (!p->current) { @@ -2903,7 +3039,7 @@ profile_runnable_proc(Process *p, Eterm status){ #ifdef ERTS_SMP if (!p->current) { - hsz = 4 + 6; + hsz -= 4; } bp = new_message_buffer(hsz); @@ -2918,9 +3054,13 @@ profile_runnable_proc(Process *p, Eterm status){ erts_smp_mtx_lock(&smq_mtx); - GET_NOW(&Ms, &s, &us); - timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; - msg = TUPLE5(hp, am_profile, p->common.id, status, where, timestamp); hp += 6; + msg = TUPLE5(hp, am_profile, p->common.id, status, where, + NIL /* Will be overwritten by timestamp */); + hp += 6; + + /* Write timestamp in element 5 of the 'msg' tuple */ + hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL); + #ifndef ERTS_SMP profile_send(p->common.id, msg); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 7405490f76..a0058264d7 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -18,8 +18,38 @@ * %CopyrightEnd% */ +#ifndef ERL_TRACE_H__FLAGS__ +#define ERL_TRACE_H__FLAGS__ +/* + * NOTE! The bits used for these flags matter. The flag with + * the least significant bit will take precedence! + * + * The "now timestamp" has highest precedence due to + * compatibility reasons. + */ +#define ERTS_TRACE_FLG_NOW_TIMESTAMP (1 << 0) +#define ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP (1 << 1) +#define ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP (1 << 2) + +/* + * The bits used effects trace flags (of processes and ports) + * as well as sequential trace flags. If changed make sure + * these arn't messed up... + */ +#define ERTS_TRACE_TS_TYPE_BITS 3 +#define ERTS_TRACE_TS_TYPE_MASK \ + ((1 << ERTS_TRACE_TS_TYPE_BITS) - 1) + +#define ERTS_TFLGS2TSTYPE(TFLGS) \ + ((int) (((TFLGS) >> ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) \ + & ERTS_TRACE_TS_TYPE_MASK)) +#define ERTS_SEQTFLGS2TSTYPE(SEQTFLGS) \ + ((int) (((SEQTFLGS) >> ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT) \ + & ERTS_TRACE_TS_TYPE_MASK)) + +#endif /* ERL_TRACE_H__FLAGS__ */ -#ifndef ERL_TRACE_H__ +#if !defined(ERL_TRACE_H__) && !defined(ERTS_ONLY_INCLUDE_TRACE_FLAGS) #define ERL_TRACE_H__ struct binary; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 3f5925765d..4247b25ab1 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1168,6 +1168,9 @@ extern ErtsModifiedTimings erts_modified_timings[]; extern int erts_no_line_info; extern Eterm erts_error_logger_warnings; extern int erts_initialized; +#if defined(USE_THREADS) && !defined(ERTS_SMP) +extern erts_tid_t erts_main_thread; +#endif extern int erts_compat_rel; extern int erts_use_sender_punish; void erts_short_init(void); @@ -1448,6 +1451,8 @@ ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr) #endif +Eterm erts_msacc_request(Process *c_p, int action, Eterm *threads); + /* ** Call_trace uses this API for the parameter matching functions */ diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 93c591b124..41b0fcdd1b 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -50,6 +50,7 @@ #include "erl_map.h" #include "erl_bif_unique.h" #include "erl_hl_timer.h" +#include "erl_time.h" extern ErlDrvEntry fd_driver_entry; extern ErlDrvEntry vanilla_driver_entry; @@ -705,6 +706,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ error_number = error_type = 0; if (driver->start) { + ERTS_MSACC_PUSH_STATE_M(); if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(port, am_in, am_start); } @@ -715,6 +717,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ DTRACE3(driver_start, process_str, driver->name, port_str); } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); fpe_was_unmasked = erts_block_fpe(); drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts); if (((SWord) drv_data) == -1) @@ -734,6 +737,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ } erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); port->caller = NIL; if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(port, am_out, am_start); @@ -1709,6 +1713,7 @@ call_driver_outputv(int bang_op, else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); ErlDrvSizeT size = evp->size; + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); @@ -1729,6 +1734,8 @@ call_driver_outputv(int bang_op, esdp->io.out += (Uint64) size; else erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size); + + ERTS_MSACC_POP_STATE_M(); } } @@ -1809,6 +1816,7 @@ call_driver_output(int bang_op, send_badsig(prt); else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); @@ -1828,6 +1836,8 @@ call_driver_output(int bang_op, esdp->io.out += (Uint64) size; else erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size); + + ERTS_MSACC_POP_STATE_M(); } } @@ -3472,6 +3482,7 @@ static void flush_port(Port *p) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); if (p->drv_ptr->flush != NULL) { + ERTS_MSACC_PUSH_STATE_M(); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_flush)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p) @@ -3481,9 +3492,11 @@ static void flush_port(Port *p) if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_in, am_flush); } + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); fpe_was_unmasked = erts_block_fpe(); (*p->drv_ptr->flush)((ErlDrvData)p->drv_data); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_out, am_flush); } @@ -3531,6 +3544,7 @@ terminate_port(Port *prt) drv = prt->drv_ptr; if ((drv != NULL) && (drv->stop != NULL)) { int fpe_was_unmasked = erts_block_fpe(); + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_stop)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(connected_id, prt) @@ -3539,6 +3553,7 @@ terminate_port(Port *prt) #endif (*drv->stop)((ErlDrvData)prt->drv_data); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); #ifdef ERTS_SMP if (prt->xports) erts_port_handle_xports(prt); @@ -3849,6 +3864,7 @@ call_driver_control(Eterm caller, ErlDrvSizeT *from_size) { ErlDrvSSizeT cres; + ERTS_MSACC_PUSH_STATE_M(); if (!prt->drv_ptr->control) return ERTS_PORT_OP_BADARG; @@ -3862,6 +3878,8 @@ call_driver_control(Eterm caller, command, size); } #endif + + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); prt->caller = caller; cres = prt->drv_ptr->control((ErlDrvData) prt->drv_data, @@ -3872,6 +3890,8 @@ call_driver_control(Eterm caller, *from_size); prt->caller = NIL; + ERTS_MSACC_POP_STATE_M(); + if (cres < 0) return ERTS_PORT_OP_BADARG; @@ -4259,6 +4279,7 @@ call_driver_call(Eterm caller, unsigned *ret_flagsp) { ErlDrvSSizeT cres; + ERTS_MSACC_PUSH_STATE_M(); if (!prt->drv_ptr->call) return ERTS_PORT_OP_BADARG; @@ -4274,6 +4295,8 @@ call_driver_call(Eterm caller, } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); + prt->caller = caller; cres = prt->drv_ptr->call((ErlDrvData) prt->drv_data, command, @@ -4284,6 +4307,8 @@ call_driver_call(Eterm caller, ret_flagsp); prt->caller = NIL; + ERTS_MSACC_POP_STATE_M(); + if (cres <= 0 || ((byte) (*resp_bufp)[0]) != VERSION_MAGIC) return ERTS_PORT_OP_BADARG; @@ -4987,6 +5012,7 @@ int get_port_flags(ErlDrvPort ix) void erts_raw_port_command(Port* p, byte* buf, Uint len) { int fpe_was_unmasked; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); @@ -5007,9 +5033,11 @@ void erts_raw_port_command(Port* p, byte* buf, Uint len) DTRACE4(driver_output, "-raw-", port_str, p->name, len); } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); fpe_was_unmasked = erts_block_fpe(); (*p->drv_ptr->output)((ErlDrvData)p->drv_data, (char*) buf, (int) len); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); } int async_ready(Port *p, void* data) @@ -5021,6 +5049,7 @@ int async_ready(Port *p, void* data) if (p) { ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); if (p->drv_ptr->ready_async != NULL) { + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_ready_async)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p) @@ -5029,6 +5058,7 @@ int async_ready(Port *p, void* data) #endif (*p->drv_ptr->ready_async)((ErlDrvData)p->drv_data, data); need_free = 0; + ERTS_MSACC_POP_STATE_M(); } erts_port_driver_callback_epilogue(p, NULL); @@ -6840,6 +6870,28 @@ driver_get_now(ErlDrvNowData *now_data) return 0; } +ErlDrvTime +erl_drv_monotonic_time(ErlDrvTimeUnit time_unit) +{ + return (ErlDrvTime) erts_napi_monotonic_time((int) time_unit); +} + +ErlDrvTime +erl_drv_time_offset(ErlDrvTimeUnit time_unit) +{ + return (ErlDrvTime) erts_napi_time_offset((int) time_unit); +} + +ErlDrvTime +erl_drv_convert_time_unit(ErlDrvTime val, + ErlDrvTimeUnit from, + ErlDrvTimeUnit to) +{ + return (ErlDrvTime) erts_napi_convert_time_unit((ErtsMonotonicTime) val, + (int) from, + (int) to); +} + static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon) { RefThing *refp; @@ -7030,6 +7082,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) void (*callback)(ErlDrvData drv_data, ErlDrvMonitor *monitor); ErlDrvMonitor drv_monitor; int fpe_was_unmasked; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); ASSERT(prt->drv_ptr != NULL); @@ -7041,6 +7094,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) callback = prt->drv_ptr->process_exit; ASSERT(callback != NULL); ref_to_driver_monitor(ref,&drv_monitor); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); DRV_MONITOR_UNLOCK_PDL(prt); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_process_exit)) { @@ -7052,6 +7106,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) (*callback)((ErlDrvData) (prt->drv_data), &drv_monitor); erts_unblock_fpe(fpe_was_unmasked); DRV_MONITOR_LOCK_PDL(prt); + ERTS_MSACC_POP_STATE_M(); /* remove monitor *after* callback */ rmon = erts_remove_monitor(&ERTS_P_MONITORS(prt), ref); DRV_MONITOR_UNLOCK_PDL(prt); diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 081c4108a0..9e53b4bfcc 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -988,6 +988,13 @@ move Discarded x==0 | move Something x==0 => move Something x=0 %endif +call_ext u==0 u$func:os:perf_counter/0 => \ + i_perf_counter +call_ext_last u==0 u$func:os:perf_counter/0 D => \ + i_perf_counter | deallocate_return D +call_ext_only u==0 u$func:os:perf_counter/0 => \ + i_perf_counter | return + # # The general case for BIFs that have no special instructions. # A BIF used in the tail must be followed by a return instruction. @@ -1027,6 +1034,8 @@ i_apply_fun_only i_hibernate +i_perf_counter + call_bif e # diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 53f8313daa..068d636a40 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -136,6 +136,17 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; # define ERTS_LIKELY(BOOL) (BOOL) # define ERTS_UNLIKELY(BOOL) (BOOL) #endif + +#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0) +#ifndef __llvm__ +# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("ERTS_LOW_WRITE") )) +#else +# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("__DATA,ERTS_LOW_WRITE") )) +#endif +#else +# define ERTS_WRITE_UNLIKELY(X) X +#endif + #ifdef __GNUC__ # if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5) # define ERTS_DECLARE_DUMMY(X) X __attribute__ ((unused)) @@ -196,6 +207,12 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f # define ASSERT(e) ((void) 1) #endif +#ifdef ERTS_SMP +# define ERTS_SMP_ASSERT(e) ASSERT(e) +#else +# define ERTS_SMP_ASSERT(e) ((void)1) +#endif + /* ERTS_UNDEF can be used to silence false warnings about * "variable may be used uninitialized" while keeping the variable * marked as undefined by valgrind. @@ -772,6 +789,10 @@ int local_to_univ(Sint *year, Sint *month, Sint *day, void get_now(Uint*, Uint*, Uint*); struct ErtsSchedulerData_; ErtsMonotonicTime erts_get_monotonic_time(struct ErtsSchedulerData_ *); +ErtsMonotonicTime erts_get_time_offset(void); +void +erts_make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec, + ErtsMonotonicTime mtime, ErtsMonotonicTime offset); void get_sys_now(Uint*, Uint*, Uint*); void set_break_quit(void (*)(void), void (*)(void)); diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index 0ab6661c9f..48cb39333a 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -278,9 +278,14 @@ ErtsMonotonicTime erts_check_next_timeout_time(ErtsSchedulerData *esdp) { ErtsTimerWheel *tiw = esdp->timer_wheel; + ErtsMonotonicTime time; + ERTS_MSACC_DECLARE_CACHE_X(); if (tiw->true_next_timeout_time) return tiw->next_timeout_time; - return find_next_timeout(esdp, tiw, 1, 0, 0); + ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(ERTS_MSACC_STATE_TIMERS); + time = find_next_timeout(esdp, tiw, 1, 0, 0); + ERTS_MSACC_POP_STATE_M_X(); + return time; } #ifndef ERTS_TW_DEBUG @@ -336,6 +341,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) { int tiw_pos_ix, slots, yielded_slot_restarted, yield_count; ErtsMonotonicTime bump_to, tmp_slots, old_pos; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT; @@ -371,6 +377,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->next_timeout_time = curr_time + ERTS_MONOTONIC_DAY; tiw->pos = bump_to; tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE; + ERTS_MSACC_POP_STATE_M_X(); return; } @@ -382,6 +389,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->yield_slot = ERTS_TWHEEL_SLOT_AT_ONCE; tiw->true_next_timeout_time = 1; tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(old_pos); + ERTS_MSACC_POP_STATE_M_X(); return; } @@ -400,8 +408,10 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) p = tiw->at_once.head; } - if (tiw->pos >= bump_to) + if (tiw->pos >= bump_to) { + ERTS_MSACC_POP_STATE_M_X(); break; + } if (tiw->nto == 0) goto empty_wheel; @@ -478,6 +488,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->yield_slot = tiw_pos_ix; tiw->yield_slots_left = slots; tiw->yield_start_pos = old_pos; + ERTS_MSACC_POP_STATE_M_X(); return; /* Yield! */ } @@ -500,6 +511,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) /* Search at most two seconds ahead... */ (void) find_next_timeout(NULL, tiw, 0, curr_time, ERTS_SEC_TO_MONOTONIC(2)); + ERTS_MSACC_POP_STATE_M_X(); } Uint @@ -569,6 +581,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw, ErtsMonotonicTime timeout_pos) { ErtsMonotonicTime timeout_time; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); p->u.func.timeout = timeout; p->u.func.cancel = cancel; @@ -612,6 +625,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw, tiw->true_next_timeout_time = 1; tiw->next_timeout_time = timeout_time; } + ERTS_MSACC_POP_STATE_M_X(); } void @@ -620,11 +634,13 @@ erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) if (p->slot != ERTS_TWHEEL_SLOT_INACTIVE) { ErlCancelProc cancel; void *arg; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); remove_timer(tiw, p); cancel = p->u.func.cancel; arg = p->u.func.arg; if (cancel) (*cancel)(arg); + ERTS_MSACC_POP_STATE_M_X(); } } diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index e3f5060117..f910b5955a 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -912,7 +912,7 @@ typedef union { #endif typedef struct _multi_timer_data { - ErlDrvNowData when; + ErlDrvTime when; ErlDrvTermData caller; void (*timeout_function)(ErlDrvData drv_data, ErlDrvTermData caller); struct _multi_timer_data *next; @@ -11577,115 +11577,18 @@ make_noninheritable_handle(SOCKET s) * Multi-timers */ -static void absolute_timeout(unsigned millis, ErlDrvNowData *out) -{ - unsigned rest; - unsigned long millipart; - unsigned long secpart; - unsigned long megasecpart; - unsigned tmo_secs = (millis / 1000U); - unsigned tmo_millis = (millis % 1000); - driver_get_now(out); - rest = (out->microsecs) % 1000; - millipart = ((out->microsecs) / 1000UL); - if (rest >= 500) { - ++millipart; - } - secpart = out->secs; - megasecpart = out->megasecs; - millipart += tmo_millis; - secpart += (millipart / 1000000UL); - millipart %= 1000000UL; - secpart += tmo_secs; - megasecpart += (secpart / 1000000UL); - secpart %= 1000000UL; - out->megasecs = megasecpart; - out->secs = secpart; - out->microsecs = (millipart * 1000UL); -} - -static unsigned relative_timeout(ErlDrvNowData *in) -{ - ErlDrvNowData now; - unsigned rest; - unsigned long millipart, in_millis, in_secs, in_megasecs; - - driver_get_now(&now); - - in_secs = in->secs; - in_megasecs = in->megasecs; - - rest = (now.microsecs) % 1000; - millipart = ((now.microsecs) / 1000UL); - if (rest >= 500) { - ++millipart; - } - in_millis = ((in->microsecs) / 1000UL); - if ( in_millis < millipart ) { - if (in_secs > 0) { - --in_secs; - } else { - in_secs = (1000000UL - 1UL); - if (in_megasecs <= now.megasecs) { - return 0; - } else { - --in_megasecs; - } - } - in_millis += 1000UL; - } - in_millis -= millipart; - - if (in_secs < now.secs) { - if (in_megasecs <= now.megasecs) { - return 0; - } else { - --in_megasecs; - } - in_secs += 1000000; - } - in_secs -= now.secs; - if (in_megasecs < now.megasecs) { - return 0; - } else { - in_megasecs -= now.megasecs; - } - return (unsigned) ((in_megasecs * 1000000000UL) + - (in_secs * 1000UL) + - in_millis); -} - -#ifdef DEBUG -static int nowcmp(ErlDrvNowData *d1, ErlDrvNowData *d2) -{ - /* Assume it's not safe to do signed conversion on megasecs... */ - if (d1->megasecs < d2->megasecs) { - return -1; - } else if (d1->megasecs > d2->megasecs) { - return 1; - } else if (d1->secs != d2->secs) { - return ((int) d1->secs) - ((int) d2->secs); - } - return ((int) d1->microsecs) - ((int) d2->microsecs); -} -#endif - static void fire_multi_timers(MultiTimerData **first, ErlDrvPort port, ErlDrvData data) { - unsigned next_timeout; + ErlDrvTime next_timeout; if (!*first) { ASSERT(0); return; } #ifdef DEBUG { - ErlDrvNowData chk; - driver_get_now(&chk); - chk.microsecs /= 10000UL; - chk.microsecs *= 10000UL; - chk.microsecs += 10000; - ASSERT(nowcmp(&chk,&((*first)->when)) >= 0); + ErlDrvTime chk = erl_drv_monotonic_time(ERL_DRV_MSEC); + ASSERT(chk >= (*first)->when); } #endif do { @@ -11697,9 +11600,9 @@ static void fire_multi_timers(MultiTimerData **first, ErlDrvPort port, return; } (*first)->prev = NULL; - next_timeout = relative_timeout(&((*first)->when)); - } while (next_timeout == 0); - driver_set_timer(port,next_timeout); + next_timeout = (*first)->when - erl_drv_monotonic_time(ERL_DRV_MSEC); + } while (next_timeout <= 0); + driver_set_timer(port, (unsigned long) next_timeout); } static void clean_multi_timers(MultiTimerData **first, ErlDrvPort port) @@ -11722,8 +11625,10 @@ static void remove_multi_timer(MultiTimerData **first, ErlDrvPort port, MultiTim driver_cancel_timer(port); *first = p->next; if (*first) { - unsigned ntmo = relative_timeout(&((*first)->when)); - driver_set_timer(port,ntmo); + ErlDrvTime ntmo = (*first)->when - erl_drv_monotonic_time(ERL_DRV_MSEC); + if (ntmo < 0) + ntmo = 0; + driver_set_timer(port, (unsigned long) ntmo); } } if (p->next != NULL) { @@ -11737,26 +11642,14 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, void (*timeout_fun)(ErlDrvData drv_data, ErlDrvTermData caller)) { -#define eq_mega(a, b) ((a)->when.megasecs == (b)->when.megasecs) -#define eq_sec(a, b) ((a)->when.secs == (b)->when.secs) MultiTimerData *mtd, *p, *s; mtd = ALLOC(sizeof(MultiTimerData)); - absolute_timeout(timeout, &(mtd->when)); + mtd->when = erl_drv_monotonic_time(ERL_DRV_MSEC) + ((ErlDrvTime) timeout) + 1; mtd->timeout_function = timeout_fun; mtd->caller = caller; mtd->next = mtd->prev = NULL; for(p = *first,s = NULL; p != NULL; s = p, p = p->next) { - if (p->when.megasecs >= mtd->when.megasecs) { - break; - } - } - for (; p!= NULL && eq_mega(p, mtd); s = p, p = p->next) { - if (p->when.secs >= mtd->when.secs) { - break; - } - } - for (; p!= NULL && eq_mega(p, mtd) && eq_sec(p, mtd); s = p, p = p->next) { - if (p->when.microsecs >= mtd->when.microsecs) { + if (p->when >= mtd->when) { break; } } @@ -11786,12 +11679,6 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, } return mtd; } -#undef eq_mega -#undef eq_sec - - - - /*----------------------------------------------------------------------------- diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index e3328c7d2c..5ce254314a 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -142,4 +142,4 @@ atom bs_validate_unicode atom bs_validate_unicode_retract atom emulate_fpe atom emasculate_binary - +atom is_divisible diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 6aa0c9a32e..7240280345 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -193,6 +193,7 @@ standard_bif_interface_2(nbif_rethrow, hipe_rethrow) standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub) standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address) nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error) +standard_bif_interface_2(nbif_is_divisible, hipe_is_divisible) /* * Mbox primops with implicit P parameter. diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 1bfee94e9e..16cc70234d 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -513,6 +513,18 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg) return 1; } +BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2) +{ + /* Arguments are Eterm-sized unsigned integers */ + Uint dividend = BIF_ARG_1; + Uint divisor = BIF_ARG_2; + if (dividend % divisor) { + BIF_ERROR(BIF_P, BADARG); + } else { + return NIL; + } +} + /* This is like the loop_rec_fr BEAM instruction */ Eterm hipe_check_get_msg(Process *c_p) diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index 0e1a75f7eb..55a0d3bb1b 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -68,6 +68,7 @@ AEXTERN(Eterm,nbif_bs_put_utf16le,(Process*,Eterm,byte*,unsigned int)); AEXTERN(Eterm,nbif_bs_get_utf16,(void)); AEXTERN(Eterm,nbif_bs_validate_unicode,(Process*,Eterm)); AEXTERN(Eterm,nbif_bs_validate_unicode_retract,(void)); +AEXTERN(void,nbif_is_divisible,(Process*,Uint,Uint)); AEXTERN(void,nbif_select_msg,(Process*)); AEXTERN(Eterm,nbif_cmp_2,(void)); @@ -93,6 +94,7 @@ BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3); BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1); struct erl_bin_match_buffer; int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm); +BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2); #ifdef NO_FPE_SIGNALS AEXTERN(void,nbif_emulate_fpe,(Process*)); diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h index adf7b1f382..0bec677574 100644 --- a/erts/emulator/hipe/hipe_primops.h +++ b/erts/emulator/hipe/hipe_primops.h @@ -68,6 +68,8 @@ PRIMOP_LIST(am_bs_get_utf16, &nbif_bs_get_utf16) PRIMOP_LIST(am_bs_validate_unicode, &nbif_bs_validate_unicode) PRIMOP_LIST(am_bs_validate_unicode_retract, &nbif_bs_validate_unicode_retract) +PRIMOP_LIST(am_is_divisible, &nbif_is_divisible) + PRIMOP_LIST(am_cmp_2, &nbif_cmp_2) PRIMOP_LIST(am_op_exact_eqeq_2, &nbif_eq_2) diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 21fa214364..36ee94111c 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -74,6 +74,7 @@ #include "erl_thr_progress.h" #include "erl_driver.h" #include "erl_alloc.h" +#include "erl_msacc.h" #if !defined(ERTS_POLL_USE_EPOLL) \ && !defined(ERTS_POLL_USE_DEVPOLL) \ @@ -2238,6 +2239,7 @@ static ERTS_INLINE int check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) { int res; + ERTS_MSACC_PUSH_STATE_M(); if (erts_smp_atomic_read_nob(&ps->no_of_user_fds) == 0 && timeout_time == ERTS_POLL_NO_TIMEOUT) { /* Nothing to poll and zero timeout; done... */ @@ -2259,6 +2261,7 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) #ifdef ERTS_SMP erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); timerfd_set(ps, &its); res = epoll_wait(ps->kp_fd, ps->res_events, max_res, -1); res = timerfd_clear(ps, res, max_res); @@ -2268,10 +2271,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) } #else /* !ERTS_POLL_USE_TIMERFD */ timeout = (int) get_timeout(ps, 1000, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = epoll_wait(ps->kp_fd, ps->res_events, max_res, timeout); #endif /* !ERTS_POLL_USE_TIMERFD */ #elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ @@ -2279,10 +2284,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) if (max_res > ps->res_events_len) grow_res_events(ps, max_res); timeout = get_timeout_timespec(ps, &ts, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts); #endif /* ----------------------------------------- */ } @@ -2306,26 +2313,33 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) if (poll_res.dp_nfds > ps->res_events_len) grow_res_events(ps, poll_res.dp_nfds); poll_res.dp_fds = ps->res_events; + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } poll_res.dp_timeout = timeout; res = ioctl(ps->kp_fd, DP_POLL, &poll_res); #elif ERTS_POLL_USE_POLL && defined(HAVE_PPOLL) /* --- ppoll ---------------- */ struct timespec ts; timeout = get_timeout_timespec(ps, &ts, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = ppoll(ps->poll_fds, ps->no_poll_fds, &ts, NULL); #elif ERTS_POLL_USE_POLL /* --- poll --------------------------------- */ timeout = (int) get_timeout(ps, 1000, timeout_time); + + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = poll(ps->poll_fds, ps->no_poll_fds, timeout); #elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ SysTimeval to; @@ -2334,18 +2348,22 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds); ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = ERTS_SELECT(ps->max_fd + 1, &ps->res_input_fds, &ps->res_output_fds, NULL, &to); #ifdef ERTS_SMP - if (timeout) + if (timeout) { erts_thr_progress_finalize_wait(NULL); + ERTS_MSACC_POP_STATE_M(); + } if (res < 0 && errno == EBADF && ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) { @@ -2380,10 +2398,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) return res; #endif /* ----------------------------------------- */ } + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_finalize_wait(NULL); #endif + ERTS_MSACC_POP_STATE_M(); + } return res; } } diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 0352ee1b3c..8b1822ca9f 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -101,6 +101,10 @@ #endif #include <netdb.h> +#ifdef HAVE_MACH_ABSOLUTE_TIME +#include <mach/mach_time.h> +#endif + #ifdef HAVE_POSIX_MEMALIGN # define ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC 1 #endif @@ -157,6 +161,7 @@ typedef long long ErtsSysHrTime; #endif typedef ErtsMonotonicTime ErtsSystemTime; +typedef ErtsSysHrTime ErtsSysPerfCounter; #define ERTS_MONOTONIC_TIME_MIN (((ErtsMonotonicTime) 1) << 63) #define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN) @@ -205,6 +210,7 @@ ErtsSystemTime erts_os_system_time(void); * It may or may not be monotonic. */ ErtsSysHrTime erts_sys_hrtime(void); +#define ERTS_HRTIME_UNIT (1000*1000*1000) struct erts_sys_time_read_only_data__ { #ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ @@ -213,6 +219,8 @@ struct erts_sys_time_read_only_data__ { #ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ void (*os_times)(ErtsMonotonicTime *, ErtsSystemTime *); #endif + ErtsSysPerfCounter (*perf_counter)(void); + ErtsSysPerfCounter perf_counter_unit; int ticks_per_sec; }; @@ -266,7 +274,24 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) #endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */ /* - * + * Functions for getting the performance counter + */ + +ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void); +#define erts_sys_perf_counter_unit() erts_sys_time_data__.r.o.perf_counter_unit + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter() +{ + return (*erts_sys_time_data__.r.o.perf_counter)(); +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +/* + * Functions for measuring CPU time */ #if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME)) diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c index 2e1914f564..03d39c7ce6 100644 --- a/erts/emulator/sys/unix/sys_time.c +++ b/erts/emulator/sys/unix/sys_time.c @@ -65,6 +65,8 @@ # include <fcntl.h> #endif +static void init_perf_counter(void); + /******************* Routines for time measurement *********************/ #undef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__ @@ -404,6 +406,8 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) # error Missing erts_os_system_time() implementation #endif + init_perf_counter(); + } void @@ -908,10 +912,120 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) #endif +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Performance counter functions * +\* */ + + +/* What resolution to spin to in micro seconds */ +#define RESOLUTION 100 +/* How many iterations to spin */ +#define ITERATIONS 1 +/* How many significant figures to round to */ +#define SIGFIGS 3 + +static ErtsSysPerfCounter calculate_perf_counter_unit(void) { + int i; + ErtsSysPerfCounter pre, post; + double value = 0; + double round_factor; +#if defined(HAVE_GETHRTIME) && defined(GETHRTIME_WITH_CLOCK_GETTIME) + struct timespec basetime,comparetime; +#define __GETTIME(arg) clock_gettime(CLOCK_MONOTONIC,arg) +#define __GETUSEC(arg) (arg.tv_nsec / 1000) +#else + SysTimeval basetime,comparetime; +#define __GETTIME(arg) sys_gettimeofday(arg) +#define __GETUSEC(arg) arg.tv_usec +#endif + + for (i = 0; i < ITERATIONS; i++) { + /* Make sure usec just flipped over at current resolution */ + __GETTIME(&basetime); + do { + __GETTIME(&comparetime); + } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION)); + + pre = erts_sys_perf_counter(); + + __GETTIME(&basetime); + do { + __GETTIME(&comparetime); + } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION)); + + post = erts_sys_perf_counter(); + + value += post - pre; + } + /* After this value is ticks per us */ + value /= (RESOLUTION*ITERATIONS); + + /* We round to 3 significant figures */ + round_factor = pow(10.0, SIGFIGS - ceil(log10(value))); + value = ((ErtsSysPerfCounter)(value * round_factor + 0.5)) / round_factor; + + /* convert to ticks per second */ + return 1000000 * value; +} + +static int have_rdtscp(void) +{ +#if defined(ETHR_X86_RUNTIME_CONF__) + /* On early x86 cpu's the tsc varies with the current speed of the cpu, + which means that the time per tick vary depending on the current + load of the cpu. We do not want this as it would give very scewed + numbers when the cpu is mostly idle. + The linux kernel seems to think that checking for constant and + reliable is enough to trust the counter so we do the same. + + If this test is not good enough, I don't know what we'll do. + Maybe fallback on erts_sys_hrtime always, but that would be a shame as + rdtsc is about 3 times faster than hrtime... */ + return ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ && + ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__; +#else + return 0; +#endif +} + +static ErtsSysPerfCounter rdtsc(void) +{ + /* It may have been a good idea to put the cpuid instruction before + the rdtsc, but I decided against it because it is not really + needed for msacc, and it slows it down by quite a bit (5-7 times slower). + As a result though, this timestamp becomes much less + accurate as it might be re-ordered to be executed way before or after this + function is called. + */ + ErtsSysPerfCounter ts; +#if defined(__x86_64__) + __asm__ __volatile__ ("rdtsc\n\t" + "shl $32, %%rdx\n\t" + "or %%rdx, %0" : "=a" (ts) : : "rdx"); +#elif defined(__i386__) + __asm__ __volatile__ ("rdtsc\n\t" + : "=A" (ts) ); +#endif + return ts; +} + +static void init_perf_counter(void) +{ + if (have_rdtscp()) { + erts_sys_time_data__.r.o.perf_counter = rdtsc; + erts_sys_time_data__.r.o.perf_counter_unit = calculate_perf_counter_unit(); + } else { + erts_sys_time_data__.r.o.perf_counter = erts_sys_hrtime; + erts_sys_time_data__.r.o.perf_counter_unit = ERTS_HRTIME_UNIT; + } +} + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ #ifdef HAVE_GETHRVTIME_PROCFS_IOCTL +/* The code below only has effect on solaris < 10, + needed in order for gehhrvtime to work properly */ int sys_start_hrvtime(void) { long msacct = PR_MSACCT; diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index 466f4a3b48..660ded297a 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -27,6 +27,7 @@ #include "erl_alloc.h" #include "erl_poll.h" #include "erl_time.h" +#include "erl_msacc.h" /* * Some debug macros @@ -1188,16 +1189,19 @@ int erts_poll_wait(ErtsPollSet ps, if (timeout > 0 && !erts_atomic32_read_nob(&break_waiter_state)) { HANDLE harr[2] = {ps->event_io_ready, break_happened_event}; int num_h = 2; + ERTS_MSACC_PUSH_STATE_M(); HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout)); ERTS_POLLSET_UNLOCK(ps); #ifdef ERTS_SMP erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); WaitForMultipleObjects(num_h, harr, FALSE, timeout); #ifdef ERTS_SMP erts_thr_progress_finalize_wait(NULL); #endif + ERTS_MSACC_POP_STATE_M(); ERTS_POLLSET_LOCK(ps); HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout)); woke_up(ps); diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h index baac7c903e..9c699fdba0 100644 --- a/erts/emulator/sys/win32/erl_win_dyn_driver.h +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -103,6 +103,11 @@ WDD_TYPEDEF(ErlDrvSInt, driver_pdl_inc_refc, (ErlDrvPDL)); WDD_TYPEDEF(ErlDrvSInt, driver_pdl_dec_refc, (ErlDrvPDL)); WDD_TYPEDEF(void, driver_system_info, (ErlDrvSysInfo *, size_t)); WDD_TYPEDEF(int, driver_get_now, (ErlDrvNowData *)); +WDD_TYPEDEF(ErlDrvTime, erl_drv_monotonic_time, (ErlDrvTimeUnit)); +WDD_TYPEDEF(ErlDrvTime, erl_drv_time_offset, (ErlDrvTimeUnit)); +WDD_TYPEDEF(ErlDrvTime, erl_drv_convert_time_unit, (ErlDrvTime, + ErlDrvTimeUnit, + ErlDrvTimeUnit)); WDD_TYPEDEF(int, driver_monitor_process, (ErlDrvPort port, ErlDrvTermData process, ErlDrvMonitor *monitor)); @@ -217,6 +222,9 @@ typedef struct { WDD_FTYPE(driver_pdl_dec_refc) *driver_pdl_dec_refc; WDD_FTYPE(driver_system_info) *driver_system_info; WDD_FTYPE(driver_get_now) *driver_get_now; + WDD_FTYPE(erl_drv_monotonic_time) *erl_drv_monotonic_time; + WDD_FTYPE(erl_drv_time_offset) *erl_drv_time_offset; + WDD_FTYPE(erl_drv_convert_time_unit) *erl_drv_convert_time_unit; WDD_FTYPE(driver_monitor_process) *driver_monitor_process; WDD_FTYPE(driver_demonitor_process) *driver_demonitor_process; WDD_FTYPE(driver_get_monitored_process) *driver_get_monitored_process; @@ -328,6 +336,9 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks; #define driver_pdl_dec_refc (WinDynDriverCallbacks.driver_pdl_dec_refc) #define driver_system_info (WinDynDriverCallbacks.driver_system_info) #define driver_get_now (WinDynDriverCallbacks.driver_get_now) +#define erl_drv_monotonic_time (WinDynDriverCallbacks.erl_drv_monotonic_time) +#define erl_drv_time_offset (WinDynDriverCallbacks.erl_drv_time_offset) +#define erl_drv_convert_time_unit (WinDynDriverCallbacks.erl_drv_convert_time_unit) #define driver_monitor_process \ (WinDynDriverCallbacks.driver_monitor_process) #define driver_demonitor_process \ @@ -463,6 +474,9 @@ do { \ ((W).driver_pdl_dec_refc) = driver_pdl_dec_refc; \ ((W).driver_system_info) = driver_system_info; \ ((W).driver_get_now) = driver_get_now; \ +((W).erl_drv_monotonic_time) = erl_drv_monotonic_time; \ +((W).erl_drv_time_offset) = erl_drv_time_offset; \ +((W).erl_drv_convert_time_unit) = erl_drv_convert_time_unit; \ ((W).driver_monitor_process) = driver_monitor_process; \ ((W).driver_demonitor_process) = driver_demonitor_process; \ ((W).driver_get_monitored_process) = driver_get_monitored_process; \ diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index 7e8dd8a4ca..99c1066ab3 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -183,6 +183,7 @@ typedef LONGLONG ErtsSysHrTime; #endif typedef ErtsMonotonicTime ErtsSystemTime; +typedef ErtsMonotonicTime ErtsSysPerfCounter; ErtsSystemTime erts_os_system_time(void); @@ -213,6 +214,7 @@ ERTS_GLB_INLINE ErtsMonotonicTime erts_os_monotonic_time(void); ERTS_GLB_INLINE void erts_os_times(ErtsMonotonicTime *, ErtsSystemTime *); ERTS_GLB_INLINE ErtsSysHrTime erts_sys_hrtime(void); +ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -234,6 +236,18 @@ erts_sys_hrtime(void) return (*erts_sys_time_data__.r.o.sys_hrtime)(); } +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter(void) +{ + return (*erts_sys_time_data__.r.o.sys_hrtime)(); +} + +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter_unit(void) +{ + return 1000 * 1000 * 1000; +} + #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ extern void sys_gettimeofday(SysTimeval *tv); diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c index 9e5f78703a..3b4fd26d63 100644 --- a/erts/emulator/sys/win32/sys_time.c +++ b/erts/emulator/sys/win32/sys_time.c @@ -397,6 +397,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) erts_sys_time_data__.r.o.os_monotonic_time = os_mtime_func; erts_sys_time_data__.r.o.os_times = os_times_func; + erts_sys_time_data__.r.o.sys_hrtime = sys_hrtime_func; init_resp->os_monotonic_time_unit = time_unit; init_resp->have_os_monotonic_time = 1; init_resp->have_corrected_os_monotonic_time = 0; diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c index 2f5f841e3d..44d982b6c7 100644 --- a/erts/emulator/test/alloc_SUITE_data/threads.c +++ b/erts/emulator/test/alloc_SUITE_data/threads.c @@ -96,16 +96,11 @@ static void fail(int t_no, char *frmt, ...) exit_thread(t_no, 0); } -static Allctr_t *alloc_not_ts = NULL; static Allctr_t *alloc_ts_1 = NULL; static Allctr_t *alloc_ts_2 = NULL; static void stop_allocators(void) { - if (alloc_not_ts) { - STOP_ALC(alloc_not_ts); - alloc_not_ts = NULL; - } if (alloc_ts_1) { STOP_ALC(alloc_ts_1); alloc_ts_1 = NULL; @@ -155,7 +150,6 @@ testcase_run(TestCaseState_t *tcs) if (!IS_THREADS_ENABLED) testcase_skipped(tcs, "Threads not enabled"); - alloc_not_ts = NULL; alloc_ts_1 = NULL; alloc_ts_2 = NULL; @@ -164,16 +158,12 @@ testcase_run(TestCaseState_t *tcs) sprintf(sbct_buf, "%d", SBC_THRESHOLD/1024); memcpy((void *) argv, argv_org, sizeof(argv_org)); - alloc_not_ts = START_ALC("threads_not_ts", 0, argv); - ASSERT(tcs, alloc_not_ts); - memcpy((void *) argv, argv_org, sizeof(argv_org)); alloc_ts_1 = START_ALC("threads_ts_1", 1, argv); ASSERT(tcs, alloc_ts_1); memcpy((void *) argv, argv_org, sizeof(argv_org)); alloc_ts_2 = START_ALC("threads_ts_2", 1, argv); ASSERT(tcs, alloc_ts_2); - ASSERT(tcs, !IS_ALLOC_THREAD_SAFE(alloc_not_ts)); ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_1)); ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_2)); @@ -190,12 +180,7 @@ testcase_run(TestCaseState_t *tcs) threads[i].arg.no_ops_per_bl = NO_OF_OPS_PER_BL; - if (i == 1) { - alc = "threads_not_ts"; - threads[i].arg.no_ops_per_bl *= 2; - threads[i].arg.a = alloc_not_ts; - } - else if (i % 2 == 0) { + if (i % 2 == 0) { alc = "threads_ts_1"; threads[i].arg.a = alloc_ts_1; } diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index cadb30e1a4..7ed99f5b4e 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -29,7 +29,7 @@ mem_leak/1, coerce_to_float/1, bjorn/1, huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, - otp_7422/1, zero_width/1, bad_append/1]). + otp_7422/1, zero_width/1, bad_append/1, bs_add_overflow/1]). -include_lib("test_server/include/test_server.hrl"). @@ -40,7 +40,7 @@ all() -> in_guard, mem_leak, coerce_to_float, bjorn, huge_float_field, huge_binary, system_limit, badarg, copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width, - bad_append]. + bad_append, bs_add_overflow]. groups() -> []. @@ -551,10 +551,24 @@ huge_binary(Config) when is_list(Config) -> ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), ?line garbage_collect(), {Shift,Return} = case free_mem() of - undefined -> {32,ok}; - Mb when Mb > 600 -> {32,ok}; - Mb when Mb > 300 -> {31,"Limit huge binaries to 256 Mb"}; - _ -> {30,"Limit huge binary to 128 Mb"} + undefined -> + %% This test has to be inlined inside the case to + %% use a literal Shift + ?line garbage_collect(), + ?line id(<<0:((1 bsl 32)-1)>>), + {32,ok}; + Mb when Mb > 600 -> + ?line garbage_collect(), + ?line id(<<0:((1 bsl 32)-1)>>), + {32,ok}; + Mb when Mb > 300 -> + ?line garbage_collect(), + ?line id(<<0:((1 bsl 31)-1)>>), + {31,"Limit huge binaries to 256 Mb"}; + _ -> + ?line garbage_collect(), + ?line id(<<0:((1 bsl 30)-1)>>), + {30,"Limit huge binary to 128 Mb"} end, ?line garbage_collect(), ?line id(<<0:((1 bsl Shift)-1)>>), @@ -911,5 +925,19 @@ append_unit_8(Bin) -> append_unit_16(Bin) -> <<Bin/binary-unit:16,0:1>>. +%% Produce a large result of bs_add that, if cast to signed int, would overflow +%% into a negative number that fits a smallnum. +bs_add_overflow(Config) -> + case erlang:system_info(wordsize) of + 8 -> + {skip, "64-bit architecture"}; + 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>>), + ok + end. id(I) -> I. diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 56b36d2626..b02a090103 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -42,7 +42,8 @@ otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1, dirty_nif_exception/1, call_dirty_nif_exception/1, nif_schedule/1, nif_exception/1, call_nif_exception/1, - nif_nan_and_inf/1, nif_atom_too_long/1 + nif_nan_and_inf/1, nif_atom_too_long/1, + nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1 ]). -export([many_args_100/100]). @@ -72,7 +73,8 @@ all() -> otp_9828, otp_9668, consume_timeslice, nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception, - nif_exception, nif_nan_and_inf, nif_atom_too_long + nif_exception, nif_nan_and_inf, nif_atom_too_long, + nif_monotonic_time, nif_time_offset, nif_convert_time_unit ]. groups() -> @@ -1780,6 +1782,148 @@ nif_raise_exceptions(NifFunc) -> end end, ok, ExcTerms). +-define(ERL_NIF_TIME_ERROR, -9223372036854775808). +-define(TIME_UNITS, [seconds, milli_seconds, micro_seconds, nano_seconds]). + +nif_monotonic_time(Config) -> + ?ERL_NIF_TIME_ERROR = monotonic_time(invalid_time_unit), + mtime_loop(1000000). + +mtime_loop(0) -> + ok; +mtime_loop(N) -> + chk_mtime(?TIME_UNITS), + mtime_loop(N-1). + +chk_mtime([]) -> + ok; +chk_mtime([TU|TUs]) -> + A = erlang:monotonic_time(TU), + B = monotonic_time(TU), + C = erlang:monotonic_time(TU), + try + true = A =< B, + true = B =< C + catch + _ : _ -> + ?t:fail({monotonic_time_missmatch, TU, A, B, C}) + end, + chk_mtime(TUs). + +nif_time_offset(Config) -> + ?ERL_NIF_TIME_ERROR = time_offset(invalid_time_unit), + toffs_loop(1000000). + +toffs_loop(0) -> + ok; +toffs_loop(N) -> + chk_toffs(?TIME_UNITS), + toffs_loop(N-1). + +chk_toffs([]) -> + ok; +chk_toffs([TU|TUs]) -> + TO = erlang:time_offset(TU), + NifTO = time_offset(TU), + case TO =:= NifTO of + true -> + ok; + false -> + case erlang:system_info(time_warp_mode) of + no_time_warp -> + ?t:fail({time_offset_mismatch, TU, TO, NifTO}); + _ -> + %% Most frequent time offset change + %% is currently only every 15:th + %% second so this should currently + %% work... + NTO = erlang:time_offset(TU), + case NifTO =:= NTO of + true -> + ok; + false -> + ?t:fail({time_offset_mismatch, TU, TO, NifTO, NTO}) + end + end + end, + chk_toffs(TUs). + +nif_convert_time_unit(Config) -> + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, seconds, invalid_time_unit), + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, seconds), + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, invalid_time_unit), + lists:foreach(fun (Offset) -> + lists:foreach(fun (Diff) -> + chk_ctu(Diff+(Offset*1000*1000*1000)) + end, + [999999999999, + 99999999999, + 9999999999, + 999999999, + 99999999, + 9999999, + 999999, + 99999, + 999, + 99, + 9, + 1, + 11, + 101, + 1001, + 10001, + 100001, + 1000001, + 10000001, + 100000001, + 1000000001, + 100000000001, + 1000000000001, + 5, + 50, + 500, + 5000, + 50000, + 500000, + 5000000, + 50000000, + 500000000, + 5000000000, + 50000000000, + 500000000000]) + end, + [-4711, -1000, -475, -5, -4, -3, -2, -1, 0, + 1, 2, 3, 4, 5, 475, 1000, 4711]), + ctu_loop(1000000). + +ctu_loop(0) -> + ok; +ctu_loop(N) -> + chk_ctu(erlang:monotonic_time(nano_seconds)), + ctu_loop(N-1). + +chk_ctu(Time) -> + chk_ctu(Time, ?TIME_UNITS). + +chk_ctu(_Time, []) -> + ok; +chk_ctu(Time, [FromTU|FromTUs]) -> + chk_ctu(Time, FromTU, ?TIME_UNITS), + chk_ctu(Time, FromTUs). + +chk_ctu(_Time, _FromTU, []) -> + ok; +chk_ctu(Time, FromTU, [ToTU|ToTUs]) -> + T = erlang:convert_time_unit(Time, nano_seconds, FromTU), + TE = erlang:convert_time_unit(T, FromTU, ToTU), + TN = convert_time_unit(T, FromTU, ToTU), + case TE =:= TN of + false -> + ?t:fail({conversion_mismatch, FromTU, T, ToTU, TE, TN}); + true -> + chk_ctu(Time, FromTU, ToTUs) + end. + %% The NIFs: lib_version() -> undefined. call_history() -> ?nif_stub. @@ -1849,6 +1993,11 @@ make_map_remove_nif(_,_) -> ?nif_stub. maps_from_list_nif(_) -> ?nif_stub. sorted_list_from_maps_nif(_) -> ?nif_stub. +%% Time +monotonic_time(_) -> ?nif_stub. +time_offset(_) -> ?nif_stub. +convert_time_unit(_,_,_) -> ?nif_stub. + nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 98e1efe18f..8ebce4fef4 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -34,6 +34,10 @@ static ERL_NIF_TERM atom_self; static ERL_NIF_TERM atom_ok; static ERL_NIF_TERM atom_join; static ERL_NIF_TERM atom_binary_resource_type; +static ERL_NIF_TERM atom_seconds; +static ERL_NIF_TERM atom_milli_seconds; +static ERL_NIF_TERM atom_micro_seconds; +static ERL_NIF_TERM atom_nano_seconds; typedef struct @@ -138,6 +142,10 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) atom_ok = enif_make_atom(env,"ok"); atom_join = enif_make_atom(env,"join"); atom_binary_resource_type = enif_make_atom(env,"binary_resource_type"); + atom_seconds = enif_make_atom(env,"seconds"); + atom_milli_seconds = enif_make_atom(env,"milli_seconds"); + atom_micro_seconds = enif_make_atom(env,"micro_seconds"); + atom_nano_seconds = enif_make_atom(env,"nano_seconds"); *priv_data = data; return 0; @@ -1885,6 +1893,87 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER return enif_make_tuple2(env, list_f, list_b); } + +static ERL_NIF_TERM monotonic_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifTimeUnit time_unit; + + if (argc != 1) + return atom_false; + + if (enif_compare(argv[0], atom_seconds) == 0) + time_unit = ERL_NIF_SEC; + else if (enif_compare(argv[0], atom_milli_seconds) == 0) + time_unit = ERL_NIF_MSEC; + else if (enif_compare(argv[0], atom_micro_seconds) == 0) + time_unit = ERL_NIF_USEC; + else if (enif_compare(argv[0], atom_nano_seconds) == 0) + time_unit = ERL_NIF_NSEC; + else + time_unit = 4711; /* invalid time unit */ + + return enif_make_int64(env, enif_monotonic_time(time_unit)); +} + +static ERL_NIF_TERM time_offset(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifTimeUnit time_unit; + + if (argc != 1) + return atom_false; + + if (enif_compare(argv[0], atom_seconds) == 0) + time_unit = ERL_NIF_SEC; + else if (enif_compare(argv[0], atom_milli_seconds) == 0) + time_unit = ERL_NIF_MSEC; + else if (enif_compare(argv[0], atom_micro_seconds) == 0) + time_unit = ERL_NIF_USEC; + else if (enif_compare(argv[0], atom_nano_seconds) == 0) + time_unit = ERL_NIF_NSEC; + else + time_unit = 4711; /* invalid time unit */ + return enif_make_int64(env, enif_time_offset(time_unit)); +} + +static ERL_NIF_TERM convert_time_unit(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifSInt64 i64; + ErlNifTime val; + ErlNifTimeUnit from, to; + + if (argc != 3) + return atom_false; + + if (!enif_get_int64(env, argv[0], &i64)) + return enif_make_badarg(env); + + val = (ErlNifTime) i64; + + if (enif_compare(argv[1], atom_seconds) == 0) + from = ERL_NIF_SEC; + else if (enif_compare(argv[1], atom_milli_seconds) == 0) + from = ERL_NIF_MSEC; + else if (enif_compare(argv[1], atom_micro_seconds) == 0) + from = ERL_NIF_USEC; + else if (enif_compare(argv[1], atom_nano_seconds) == 0) + from = ERL_NIF_NSEC; + else + from = 4711; /* invalid time unit */ + + if (enif_compare(argv[2], atom_seconds) == 0) + to = ERL_NIF_SEC; + else if (enif_compare(argv[2], atom_milli_seconds) == 0) + to = ERL_NIF_MSEC; + else if (enif_compare(argv[2], atom_micro_seconds) == 0) + to = ERL_NIF_USEC; + else if (enif_compare(argv[2], atom_nano_seconds) == 0) + to = ERL_NIF_NSEC; + else + to = 4711; /* invalid time unit */ + + return enif_make_int64(env, enif_convert_time_unit(val, from, to)); +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1954,7 +2043,10 @@ static ErlNifFunc nif_funcs[] = {"make_map_update_nif", 3, make_map_update_nif}, {"make_map_remove_nif", 2, make_map_remove_nif}, {"maps_from_list_nif", 1, maps_from_list_nif}, - {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif} + {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif}, + {"monotonic_time", 1, monotonic_time}, + {"time_offset", 1, time_offset}, + {"convert_time_unit", 3, convert_time_unit} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 90b6a36262..d0840fe731 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 1997-2014. All Rights Reserved. -%% +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,7 +14,7 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% @@ -36,22 +36,22 @@ %% integer_to_binary/2 %% binary_to_integer/1 --export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2, end_per_group/2, t_abs/1, t_float/1, t_float_to_string/1, t_integer_to_string/1, - t_string_to_integer/1, + t_string_to_integer/1, t_list_to_integer_edge_cases/1, t_string_to_float_safe/1, t_string_to_float_risky/1, t_round/1, t_trunc/1 ]). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [t_abs, t_float, t_float_to_string, t_integer_to_string, {group, t_string_to_float}, t_string_to_integer, t_round, - t_trunc]. + t_trunc, t_list_to_integer_edge_cases]. -groups() -> +groups() -> [{t_string_to_float, [], [t_string_to_float_safe, t_string_to_float_risky]}]. @@ -73,7 +73,7 @@ t_abs(Config) when is_list(Config) -> 5.5 = abs(id(5.5)), 0.0 = abs(id(0.0)), 100.0 = abs(id(-100.0)), - + %% Integers. 5 = abs(id(5)), 0 = abs(id(0)), @@ -93,7 +93,7 @@ t_abs(Config) when is_list(Config) -> BigNum = abs(BigNum), BigNum = abs(-BigNum), ok. - + t_float(Config) when is_list(Config) -> 0.0 = float(id(0)), 2.5 = float(id(2.5)), @@ -109,7 +109,7 @@ t_float(Config) when is_list(Config) -> %% Extremly big bignums. Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), {'EXIT', {badarg, _}} = (catch float(Big)), - + ok. @@ -183,7 +183,7 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), test_fts("1.23000000000000000000e+20",1.23e20, []), ok. - + test_fts(Expect, Float) -> Expect = float_to_list(Float), BinExpect = list_to_binary(Expect), @@ -255,7 +255,7 @@ t_round(Config) when is_list(Config) -> 256 = round(id(255.6)), -1033 = round(id(-1033.3)), -1034 = round(id(-1033.6)), - + % OTP-3722: X = id((1 bsl 27) - 1), MX = -X, @@ -345,9 +345,9 @@ t_integer_to_string(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_binary(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_list(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), @@ -416,27 +416,27 @@ t_string_to_integer(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), - + % Default base error cases lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:binary_to_integer( list_to_binary(Value))), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,["1.0"," 1"," -1","","+"]), - + % Custom base error cases lists:foreach(fun({Value,Base}) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer( list_to_binary(Value),Base)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value,Base)) end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, @@ -449,10 +449,61 @@ t_string_to_integer(Config) when is_list(Config) -> ok. +%% Tests edge cases for list_to_integer; compares with known good values + +t_list_to_integer_edge_cases(Config) when is_list(Config) -> + %% Take integer literals and compare to their representation in ExtTerm + T = [ + {16, "0", <<131,97,0>>}, + {16, "-0", <<131,97,0>>}, + + {16, "f", <<131,97,15>>}, + {16, "-f", <<131,98,255,255,255,241>>}, + + {16, "0000000000000000000000000000000000000000000000000f", + <<131,97,15>>}, + {16, "-0000000000000000000000000000000000000000000000000f", + <<131,98,255,255,255,241>>}, + + {16, "ffffffff", <<131,110,4,0,255,255,255,255>>}, + {16, "-ffffffff", <<131,110,4,1,255,255,255,255>>}, + + {16, "7fffffff", <<131,110,4,0,255,255,255,127>>}, + {16, "-7fffffff", <<131,98,128,0,0,1>>}, + + {16, "ffffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,255>>}, + {16, "-ffffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,255>>}, + + {16, "7fffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,127>>}, + {16, "-7fffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,127>>}, + + %% Alleged 32-bit corner case (should not happen on 64-bit). At 32-4 + %% bits we may corrupt sign bit and fall out of SMALL_INT range. + {2, "1000000000000000000000000000", <<131,98,8,0,0,0>>}, + {2, "-1000000000000000000000000000", <<131,98,248,0,0,0>>}, + + %% 64-bit corner case (should not happen on 32-bit) at 64-4 bits we + %% corrupt sign bit and fall out of SMALL_INT range (bam! all dead) + {2, "100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,0,0,0,0,0,0,0,0,8>>}, + {2, "-100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,1,0,0,0,0,0,0,0,8>>} + ], + [begin + io:format("~s base ~p vs ~p~n", [Str, Base, Bin]), + FromStr = list_to_integer(Str, Base), + FromStr = binary_to_term(Bin) + end || {Base, Str, Bin} <- T], + ok. + test_sti(Num) -> [begin io:format("Testing ~p:~p",[Num,Base]), - test_sti(Num,Base) + test_sti(Num,Base) end|| Base <- lists:seq(2,36)]. test_sti(Num,Base) -> diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 986a73ebb1..684e8a3b4e 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -56,6 +56,7 @@ scheduler_threads/1, scheduler_suspend/1, dirty_scheduler_threads/1, + dirty_scheduler_exit/1, reader_groups/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(15)). @@ -70,7 +71,7 @@ all() -> equal_and_high_with_part_time_max, equal_with_high, equal_with_high_max, bound_process, {group, scheduler_bind}, scheduler_threads, scheduler_suspend, - dirty_scheduler_threads, + dirty_scheduler_threads, dirty_scheduler_exit, reader_groups]. groups() -> @@ -1166,6 +1167,53 @@ get_dsstate(Config, Cmd) -> stop_node(Node), {DSCPU, DSCPUOnln, DSIO}. +dirty_scheduler_exit(Config) when is_list(Config) -> + try + erlang:system_info(dirty_cpu_schedulers), + dirty_scheduler_exit_test(Config) + catch + error:badarg -> + {skipped, "No dirty scheduler support"} + end. + +dirty_scheduler_exit_test(Config) -> + {ok, Node} = start_node(Config, "+SDio 1"), + [ok] = mcall(Node, + [fun() -> + Path = ?config(data_dir, Config), + Lib = atom_to_list(?MODULE), + ok = erlang:load_nif(filename:join(Path,Lib), []), + ok = test_dirty_scheduler_exit() + end]), + stop_node(Node), + ok. + +test_dirty_scheduler_exit() -> + process_flag(trap_exit,true), + test_dse(10,[]). +test_dse(0,Pids) -> + timer:sleep(100), + kill_dse(Pids,[]); +test_dse(N,Pids) -> + Pid = spawn_link(fun dirty_sleeper/0), + test_dse(N-1,[Pid|Pids]). +kill_dse([],Killed) -> + wait_dse(Killed); +kill_dse([Pid|Pids],AlreadyKilled) -> + exit(Pid,kill), + kill_dse(Pids,[Pid|AlreadyKilled]). +wait_dse([]) -> + ok; +wait_dse([Pid|Pids]) -> + receive + {'EXIT',Pid,killed} -> + ok + end, + wait_dse(Pids). + +dirty_sleeper() -> + erlang:nif_error({error,?MODULE}). + scheduler_suspend(Config) when is_list(Config) -> ?line Dog = ?t:timetrap(?t:minutes(5)), ?line lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end, diff --git a/erts/emulator/test/scheduler_SUITE_data/Makefile.src b/erts/emulator/test/scheduler_SUITE_data/Makefile.src new file mode 100644 index 0000000000..859112cf19 --- /dev/null +++ b/erts/emulator/test/scheduler_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ + +SCHEDULER_LIBS = scheduler_SUITE@dll@ + +all: $(SCHEDULER_LIBS) + +@SHLIB_RULES@ + +$(SCHEDULER_LIBS): scheduler_SUITE.c diff --git a/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c new file mode 100644 index 0000000000..022858c114 --- /dev/null +++ b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c @@ -0,0 +1,31 @@ +#include <unistd.h> +#include "erl_nif.h" + +static int +load(ErlNifEnv* env, void** priv, ERL_NIF_TERM info) +{ + ErlNifSysInfo sys_info; + enif_system_info(&sys_info, sizeof(ErlNifSysInfo)); + if (!sys_info.smp_support || !sys_info.dirty_scheduler_support) + return 1; + return 0; +} + +static ERL_NIF_TERM +dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + sleep(3); +#endif + return enif_make_atom(env, "ok"); +} + +static ErlNifFunc funcs[] = { +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND} +#else + {"dirty_sleeper", 0, dirty_sleeper, 0} +#endif +}; + +ERL_NIF_INIT(scheduler_SUITE, funcs, &load, NULL, NULL, NULL); diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 53c9ba8715..aab3d3e3d2 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -32,7 +32,7 @@ run_queue_one/1, scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, - badarg/1, run_queues_lengths_active_tasks/1]). + badarg/1, run_queues_lengths_active_tasks/1, msacc/1]). %% Internal exports. @@ -55,7 +55,8 @@ all() -> [{group, wall_clock}, {group, runtime}, reductions, reductions_big, {group, run_queue}, scheduler_wall_time, garbage_collection, io, badarg, - run_queues_lengths_active_tasks]. + run_queues_lengths_active_tasks, + msacc]. groups() -> [{wall_clock, [], @@ -440,6 +441,10 @@ run_queues_lengths_active_tasks(Config) -> SO = erlang:system_flag(schedulers_online, 1), + %% Give newly suspended schedulers some time to + %% migrate away work from their run queues... + receive after 1000 -> ok end, + TRQLs1 = statistics(total_run_queue_lengths), TATs1 = statistics(total_active_tasks), true = TRQLs1 >= 10, @@ -466,3 +471,114 @@ run_queues_lengths_active_tasks(Config) -> TokLoops), ok. + +msacc(doc) -> + "Tests that statistics(microstate_statistics) works."; +msacc(Config) -> + + %% Test if crypto nif is available + Niff = try crypto:strong_rand_bytes(1), ok catch _:_ -> nok end, + TmpFile = filename:join(proplists:get_value(priv_dir,Config),"file.tmp"), + + false = erlang:system_flag(microstate_accounting, true), + + msacc_test(TmpFile), + + true = erlang:system_flag(microstate_accounting, false), + + MsaccStats = erlang:statistics(microstate_accounting), + + case os:type() of + {win32, _} -> + %% Some windows have a very poor accuracy on their + %% timing primitives, so we just make sure that + %% some state besides sleep has been triggered. + Sum = lists:sum( + lists:map(fun({sleep, _V}) -> 0; + ({_, V}) -> V + end, maps:to_list(msacc_sum_states())) + ), + if Sum > 0 -> + ok; + true -> + ct:fail({no_states_triggered, MsaccStats}) + end; + _ -> + + %% Make sure that all states were triggered at least once + maps:map(fun(nif, 0) -> + case Niff of + ok -> + ct:fail({zero_state,nif}); + nok -> + ok + end; + (aux, 0) -> + %% aux will be zero if we do not have smp support + %% or no async threads + case erlang:system_info(smp_support) orelse + erlang:system_info(thread_pool_size) > 0 + of + false -> + ok; + true -> + ct:log("msacc: ~p",[MsaccStats]), + ct:fail({zero_state,aux}) + end; + (Key, 0) -> + ct:log("msacc: ~p",[MsaccStats]), + ct:fail({zero_state,Key}); + (_,_) -> ok + end, msacc_sum_states()) + end, + + erlang:system_flag(microstate_accounting, reset), + + msacc_test(TmpFile), + + %% Make sure all counters are zero after stopping and resetting + maps:map(fun(_Key, 0) -> ok; + (Key,_) -> + ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]), + ct:fail({non_zero_state,Key}) + end,msacc_sum_states()). + +%% This test tries to make sure to trigger all of the different available states +msacc_test(TmpFile) -> + + %% We write some data + [file:write_file(TmpFile,<<0:(1024*1024*8)>>,[raw]) || _ <- lists:seq(1,100)], + + %% Do some ETS operations + Tid = ets:new(table, []), + ets:insert(Tid, {1, hello}), + ets:delete(Tid), + + %% Collect some garbage + [erlang:garbage_collect() || _ <- lists:seq(1,100)], + + %% Send some messages + [begin self() ! {hello},receive _ -> ok end end || _ <- lists:seq(1,100)], + + %% Setup some timers + Refs = [erlang:send_after(10000,self(),ok) || _ <- lists:seq(1,100)], + + %% Do some nif work + catch [crypto:strong_rand_bytes(128) || _ <- lists:seq(1,100)], + + %% Cancel some timers + [erlang:cancel_timer(R) || R <- Refs], + + %% Wait for a while + timer:sleep(100). + +msacc_sum_states() -> + Stats = erlang:statistics(microstate_accounting), + [#{ counters := C }|_] = Stats, + InitialCounters = maps:map(fun(_,_) -> 0 end,C), + lists:foldl(fun(#{ counters := Counters }, Cnt) -> + maps:fold(fun(Key, Value, Acc) -> + NewValue = Value+maps:get(Key,Acc), + maps:update(Key, NewValue, Acc) + end, Cnt, Counters) + end,InitialCounters,Stats). diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index 0a0784337f..6e85f8c54e 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -113,13 +113,27 @@ runnable_procs(suite) -> runnable_procs(doc) -> ["Tests system_profiling with runnable_procs."]; runnable_procs(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + do_runnable_procs(Arg), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]). + +do_runnable_procs({TsType, TsTypeFlag}) -> Pid = start_profiler_process(), % start a ring of processes % FIXME: Set #laps and #nodes in config file Nodes = 10, Laps = 10, Master = ring(Nodes), - undefined = erlang:system_profile(Pid, [runnable_procs]), + undefined = erlang:system_profile(Pid, [runnable_procs]++TsTypeFlag), % loop a message ok = ring_message(Master, message, Laps), Events = get_profiler_events(), @@ -127,9 +141,9 @@ runnable_procs(Config) when is_list(Config) -> erlang:system_profile(undefined, []), put(master, Master), put(laps, Laps), - true = has_runnable_event(Events), + true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(Pids), + ok = check_events(TsType, Pids), erase(), exit(Pid,kill), ok. @@ -139,8 +153,22 @@ runnable_ports(suite) -> runnable_ports(doc) -> ["Tests system_profiling with runnable_port."]; runnable_ports(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + do_runnable_ports(Arg, Config), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]). + +do_runnable_ports({TsType, TsTypeFlag}, Config) -> Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [runnable_ports]), + undefined = erlang:system_profile(Pid, [runnable_ports]++TsTypeFlag), EchoPid = echo(Config), % FIXME: Set config to number_of_echos Laps = 10, @@ -149,9 +177,9 @@ runnable_ports(Config) when is_list(Config) -> Events = get_profiler_events(), kill_em_all = kill_echo(EchoPid), erlang:system_profile(undefined, []), - true = has_runnable_event(Events), + true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(Pids), + ok = check_events(TsType, Pids), erase(), exit(Pid,kill), ok. @@ -166,8 +194,19 @@ scheduler(Config) when is_list(Config) -> {_, 1} -> {skipped, "No need for scheduler test when only one scheduler online."}; _ -> Nodes = 10, - ok = check_block_system(Nodes), - ok = check_multi_scheduling_block(Nodes) + lists:foreach(fun (TsType) -> + Arg = case TsType of + no_timestamp -> + {timestamp, []}; + _ -> + {TsType, [TsType]} + end, + ok = check_block_system(Arg, Nodes), + ok = check_multi_scheduling_block(Arg, Nodes), + receive after 1000 -> ok end + end, + [no_timestamp, timestamp, monotonic_timestamp, + strict_monotonic_timestamp]) end. % the profiler pid should not be profiled @@ -195,9 +234,9 @@ dont_profile_profiler(Config) when is_list(Config) -> %%% Check scheduler profiling -check_multi_scheduling_block(Nodes) -> +check_multi_scheduling_block({TsType, TsTypeFlag}, Nodes) -> Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [scheduler]), + undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag), {ok, Supervisor} = start_load(Nodes), wait(600), erlang:system_flag(multi_scheduling, block), @@ -205,23 +244,23 @@ check_multi_scheduling_block(Nodes) -> erlang:system_flag(multi_scheduling, unblock), {Pid, [scheduler]} = erlang:system_profile(undefined, []), Events = get_profiler_events(), - true = has_scheduler_event(Events), + true = has_scheduler_event(TsType, Events), stop_load(Supervisor), exit(Pid,kill), erase(), ok. -check_block_system(Nodes) -> +check_block_system({TsType, TsTypeFlag}, Nodes) -> Dummy = spawn(?MODULE, profiler_process, [[]]), Pid = start_profiler_process(), - undefined = erlang:system_profile(Pid, [scheduler]), + undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag), {ok, Supervisor} = start_load(Nodes), wait(300), undefined = erlang:system_monitor(Dummy, [busy_port]), {Dummy, [busy_port]} = erlang:system_monitor(undefined, []), {Pid, [scheduler]} = erlang:system_profile(undefined, []), Events = get_profiler_events(), - true = has_scheduler_event(Events), + true = has_scheduler_event(TsType, Events), stop_load(Supervisor), exit(Pid,kill), exit(Dummy,kill), @@ -230,40 +269,49 @@ check_block_system(Nodes) -> %%% Check events -check_events([]) -> ok; -check_events([Pid | Pids]) -> +check_events(_TsType, []) -> ok; +check_events(TsType, [Pid | Pids]) -> Master = get(master), Laps = get(laps), CheckPids = get(pids), {Events, N} = get_pid_events(Pid), ok = check_event_flow(Events), - ok = check_event_ts(Events), + ok = check_event_ts(TsType, Events), IsMember = lists:member(Pid, CheckPids), case Pid of Master -> io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2+2, N, Pid]), N = Laps*2 + 2, - check_events(Pids); + check_events(TsType, Pids); Pid when IsMember == true -> io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2, N, Pid]), N = Laps*2, - check_events(Pids); + check_events(TsType, Pids); Pid -> - check_events(Pids) + check_events(TsType, Pids) end. %% timestamp consistency check for descending timestamps -check_event_ts(Events) -> - check_event_ts(Events, undefined). -check_event_ts([], _) -> ok; -check_event_ts([Event | Events], undefined) -> - check_event_ts(Events, Event); -check_event_ts([{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> - Time = timer:now_diff(TS1, TS0), +check_event_ts(TsType, Events) -> + check_event_ts(TsType, Events, undefined). +check_event_ts(_TsType, [], _) -> ok; +check_event_ts(TsType, [Event | Events], undefined) -> + check_event_ts(TsType, Events, Event); +check_event_ts(TsType, [{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> + Time = case TsType of + timestamp -> + timer:now_diff(TS1, TS0); + monotonic_timestamp -> + TS1 - TS0; + strict_monotonic_timestamp -> + {MT1, _} = TS1, + {MT0, _} = TS0, + MT1 - MT0 + end, if Time < 0.0 -> timestamp_error; - true -> check_event_ts(Events, Event) + true -> check_event_ts(TsType, Events, Event) end. %% consistency check for active vs. inactive activity (runnable) @@ -428,6 +476,44 @@ port_echo_loop(Port) -> %% Helpers %%% +check_ts(no_timestamp, Ts) -> + try + no_timestamp = Ts + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(timestamp, Ts) -> + try + {Ms,S,Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(monotonic_timestamp, Ts) -> + try + true = is_integer(Ts) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(strict_monotonic_timestamp, Ts) -> + try + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok. + start_load(N) -> Pid = spawn_link(?MODULE, run_load, [N, []]), {ok, Pid}. @@ -454,21 +540,24 @@ list_load() -> end, list_load(). - -has_scheduler_event(Events) -> +has_scheduler_event(TsType, Events) -> lists:any( fun (Pred) -> case Pred of - {profile, scheduler, _ID, _Activity, _NR, _TS} -> true; + {profile, scheduler, _ID, _Activity, _NR, TS} -> + check_ts(TsType, TS), + true; _ -> false end end, Events). -has_runnable_event(Events) -> +has_runnable_event(TsType, Events) -> lists:any( fun (Pred) -> case Pred of - {profile, _Pid, _Activity, _MFA, _TS} -> true; + {profile, _Pid, _Activity, _MFA, TS} -> + check_ts(TsType, TS), + true; _ -> false end end, Events). diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index a12c41a3aa..96b7dd159f 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -67,7 +67,8 @@ trace_on_and_off(Config) when is_list(Config) -> ?line Pid = spawn(?MODULE, bif_process, []), ?line Self = self(), ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line {flags,[timestamp,call]} = erlang:trace_info(Pid,flags), + ?line {flags, Flags} = erlang:trace_info(Pid,flags), + ?line [call,timestamp] = lists:sort(Flags), ?line {tracer, Self} = erlang:trace_info(Pid,tracer), ?line 1 = erlang:trace(Pid, false, [timestamp]), ?line {flags,[call]} = erlang:trace_info(Pid,flags), @@ -111,93 +112,145 @@ do_trace_bif(Flags) -> trace_bif_timestamp(doc) -> "Test tracing BIFs with timestamps."; trace_bif_timestamp(Config) when is_list(Config) -> - do_trace_bif_timestamp([]). - + do_trace_bif_timestamp([], timestamp, [timestamp]), + do_trace_bif_timestamp([], timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_timestamp([], strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_timestamp([], strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_timestamp([], monotonic_timestamp, [monotonic_timestamp]). + trace_bif_timestamp_local(doc) -> "Test tracing BIFs with timestamps and local flag."; trace_bif_timestamp_local(Config) when is_list(Config) -> - do_trace_bif_timestamp([local]). - -do_trace_bif_timestamp(Flags) -> - ?line Pid=spawn(?MODULE, bif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags), - - ?line Pid ! {do_bif, time, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}), - - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - - ?line Pid ! {do_time_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,time, []}}), - - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), + do_trace_bif_timestamp([local], timestamp, [timestamp]), + do_trace_bif_timestamp([local], timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_timestamp([local], monotonic_timestamp, [monotonic_timestamp]). + +do_trace_bif_timestamp(Flags, TsType, TsFlags) -> + io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]), + Pid=spawn(?MODULE, bif_process, []), + 1 = erlang:trace(Pid, true, [call]++TsFlags), + erlang:trace_pattern({erlang,'_','_'}, [], Flags), + + Ts0 = make_ts(TsType), + Pid ! {do_bif, time, []}, + Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}, + Ts0,TsType), + + Pid ! {do_bif, statistics, [runtime]}, + Ts2 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts1, TsType), + + Pid ! {do_time_bif}, + Ts3 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,time, []}}, + Ts2, TsType), + + Pid ! {do_statistics_bif}, + Ts4 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts3, TsType), + + check_ts(TsType, Ts4, make_ts(TsType)), %% We should be able to turn off the timestamp. - ?line 1 = erlang:trace(Pid, false, [timestamp]), + 1 = erlang:trace(Pid, false, TsFlags), - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), + Pid ! {do_statistics_bif}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), + Pid ! {do_bif, statistics, [runtime]}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({erlang,'_','_'}, false, Flags), - ?line exit(Pid, die), + exit(Pid, die), ok. trace_bif_return(doc) -> "Test tracing BIF's with return/return_to trace."; trace_bif_return(Config) when is_list(Config) -> - ?line Pid=spawn(?MODULE, bif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), - ?line erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], - [local]), - - - ?line Pid ! {do_bif, time, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,time,0}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,statistics,1}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - ?line Pid ! {do_time_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,time, []}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,time,0}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), - - - - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,statistics,1}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}), + do_trace_bif_return(timestamp, [timestamp]), + do_trace_bif_return(timestamp, + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), + do_trace_bif_return(strict_monotonic_timestamp, + [strict_monotonic_timestamp]), + do_trace_bif_return(strict_monotonic_timestamp, + [monotonic_timestamp, strict_monotonic_timestamp]), + do_trace_bif_return(monotonic_timestamp, [monotonic_timestamp]). + +do_trace_bif_return(TsType, TsFlags) -> + io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]), + Pid=spawn(?MODULE, bif_process, []), + 1 = erlang:trace(Pid, true, [call,return_to]++TsFlags), + erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], + [local]), + + Ts0 = make_ts(TsType), + Pid ! {do_bif, time, []}, + Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}, + Ts0, TsType), + Ts2 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,time,0}}, + Ts1, TsType), + Ts3 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts2, TsType), + + + Pid ! {do_bif, statistics, [runtime]}, + Ts4 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts3, TsType), + Ts5 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,statistics,1}}, + Ts4, TsType), + Ts6 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts5, TsType), + + + Pid ! {do_time_bif}, + Ts7 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,time, []}}, + Ts6, TsType), + Ts8 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,time,0}}, + Ts7, TsType), + Ts9 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts8, TsType), + + + + Pid ! {do_statistics_bif}, + Ts10 = receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}, + Ts9, TsType), + Ts11 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,statistics,1}}, + Ts10, TsType), + Ts12 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}, + Ts11, TsType), + check_ts(TsType, Ts12, make_ts(TsType)), ok. @@ -213,10 +266,11 @@ receive_trace_msg(Mess) -> ?t:fail() end. -receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) -> +receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, call, {erlang, F, A}, _Ts} -> - ok; + {trace_ts, Pid, call, {erlang, F, A}, Ts} -> + check_ts(TsType, PrevTs, Ts), + Ts; Other -> io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" "Got: ~p~n", @@ -227,10 +281,11 @@ receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) -> ?t:fail() end. -receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) -> +receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_from, {erlang, F, A}, _Value, _Ts} -> - ok; + {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} -> + check_ts(TsType, PrevTs, Ts), + Ts; Other -> io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" "Got: ~p~n", @@ -241,10 +296,11 @@ receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) -> ?t:fail() end. -receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> +receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> - ok; + {trace_ts, Pid, return_to, {M, F, A}, Ts} -> + check_ts(TsType, PrevTs, Ts), + Ts; Other -> io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" "Got: ~p~n", @@ -255,6 +311,33 @@ receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> ?t:fail() end. +make_ts(timestamp) -> + erlang:now(); +make_ts(monotonic_timestamp) -> + erlang:monotonic_time(nano_seconds); +make_ts(strict_monotonic_timestamp) -> + MT = erlang:monotonic_time(nano_seconds), + UMI = erlang:unique_integer([monotonic]), + {MT, UMI}. + +check_ts(timestamp, PrevTs, Ts) -> + {Ms, S, Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us), + true = PrevTs < Ts, + Ts; +check_ts(monotonic_timestamp, PrevTs, Ts) -> + true = is_integer(Ts), + true = PrevTs =< Ts, + Ts; +check_ts(strict_monotonic_timestamp, PrevTs, Ts) -> + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI), + true = PrevTs < Ts, + Ts. + bif_process() -> receive {do_bif, Name, Args} -> diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl index 6fa634b886..a6884d63a6 100644 --- a/erts/emulator/test/unique_SUITE.erl +++ b/erts/emulator/test/unique_SUITE.erl @@ -267,10 +267,21 @@ calc_sched_bits(NoScheds, Shift) when NoScheds < 1 bsl Shift -> calc_sched_bits(NoScheds, Shift) -> calc_sched_bits(NoScheds, Shift+1). +schedulers() -> + S = erlang:system_info(schedulers), + try + DCPUS = erlang:system_info(dirty_cpu_schedulers), + DIOS = erlang:system_info(dirty_io_schedulers), + S+DCPUS+DIOS + catch + _ : _ -> + S + end. + init_uniqint_info() -> SmallBits = erlang:system_info({wordsize, internal})*8-4, io:format("SmallBits=~p~n", [SmallBits]), - Schedulers = erlang:system_info(schedulers), + Schedulers = schedulers(), io:format("Schedulers=~p~n", [Schedulers]), MinSmall = -1*(1 bsl (SmallBits-1)), io:format("MinSmall=~p~n", [MinSmall]), @@ -337,7 +348,7 @@ check_uniqint(Int, UinqintInfo) -> true -> io:format("OK~n~n", []); false -> - io:format("result UniqInt=~p FAILED~n", [UniqInt]), + io:format("result Int=~p FAILED~n", [Int]), exit(badres) end. diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 20ad0af829..fb8cae05df 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -697,6 +697,7 @@ static void do_request(g, fd, s, buf, bsize) if (reply(g, fd, wbuf, 4) != 4) { + node_unreg(g, name); dbg_tty_printf(g,1,"** failed to send ALIVE2_RESP for \"%s\"", name); return; diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl index e8bbfdbb18..4de65500e9 100644 --- a/erts/epmd/test/epmd_SUITE.erl +++ b/erts/epmd/test/epmd_SUITE.erl @@ -76,7 +76,9 @@ buffer_overrun_2/1, no_nonlocal_register/1, no_nonlocal_kill/1, - no_live_killing/1 + no_live_killing/1, + + socket_reset_before_alive2_reply_is_written/1 ]). @@ -123,7 +125,8 @@ all() -> returns_valid_populated_extra_with_nulls, names_stdout, {group, buffer_overrun}, no_nonlocal_register, - no_nonlocal_kill, no_live_killing]. + no_nonlocal_kill, no_live_killing, + socket_reset_before_alive2_reply_is_written]. groups() -> [{buffer_overrun, [], @@ -243,11 +246,7 @@ register_node(Name,Port) -> register_node_v2(Port,$M,0,5,5,Name,""). register_node_v2(Port, NodeType, Prot, HVsn, LVsn, Name, Extra) -> - Utf8Name = unicode:characters_to_binary(Name), - Req = [?EPMD_ALIVE2_REQ, put16(Port), NodeType, Prot, - put16(HVsn), put16(LVsn), - put16(size(Utf8Name)), binary_to_list(Utf8Name), - size16(Extra), Extra], + Req = alive2_req(Port, NodeType, Prot, HVsn, LVsn, Name, Extra), case send_req(Req) of {ok,Sock} -> case recv(Sock,4) of @@ -938,6 +937,42 @@ no_live_killing(Config) when is_list(Config) -> ?line close(Sock3), ok. +socket_reset_before_alive2_reply_is_written(doc) -> + ["Check for regression - don't make zombie from node which " + "sends TCP RST at wrong time"]; +socket_reset_before_alive2_reply_is_written(suite) -> + []; +socket_reset_before_alive2_reply_is_written(Config) when is_list(Config) -> + %% - delay_write for easier triggering of race condition + %% - relaxed_command_check for gracefull shutdown of epmd even if there + %% is stuck node. + ?line ok = epmdrun("-delay_write 1 -relaxed_command_check"), + + %% We can't use send_req/1 directly as we want to do inet:setopts/2 + %% on our socket. + ?line {ok, Sock} = connect(), + + %% Issuing close/1 on such socket will result in immediate RST packet. + ?line ok = inet:setopts(Sock, [{linger, {true, 0}}]), + + Req = alive2_req(4711, 77, 0, 5, 5, "test", []), + ?line ok = send(Sock, [size16(Req), Req]), + + timer:sleep(500), %% Wait for the first 1/2 of delay_write before closing + ?line ok = close(Sock), + + timer:sleep(500 + ?SHORT_PAUSE), %% Wait for the other 1/2 of delay_write + + %% Wait another delay_write interval, due to delay doubling in epmd. + %% Should be removed when this is issue is fixed there. + timer:sleep(1000), + + ?line {ok, SockForNames} = connect_active(), + + %% And there should be no stuck nodes + ?line {ok, []} = do_get_names(SockForNames), + ?line ok = close(SockForNames), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Terminate all tests with killing epmd. @@ -1200,3 +1235,12 @@ flat_count([_|T], N) -> flat_count(T, N); flat_count([], N) -> N. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +alive2_req(Port, NodeType, Prot, HVsn, LVsn, Name, Extra) -> + Utf8Name = unicode:characters_to_binary(Name), + [?EPMD_ALIVE2_REQ, put16(Port), NodeType, Prot, + put16(HVsn), put16(LVsn), + put16(size(Utf8Name)), binary_to_list(Utf8Name), + size16(Extra), Extra]. diff --git a/erts/include/internal/ethr_internal.h b/erts/include/internal/ethr_internal.h index d4ded6ff05..693b34df61 100644 --- a/erts/include/internal/ethr_internal.h +++ b/erts/include/internal/ethr_internal.h @@ -92,7 +92,6 @@ void ethr_run_exit_handlers__(void); void ethr_ts_event_destructor__(void *vtsep); #if defined(ETHR_X86_RUNTIME_CONF__) -int ethr_x86_have_cpuid__(void); void ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx); #endif diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 4eeb7097f4..e5c5cdfa33 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -274,14 +274,40 @@ ETHR_PROTO_NORETURN__ ethr_fatal_error__(const char *file, || (defined(_MSC_VER) && (defined(_M_IX86) || defined(_M_AMD64)))) # define ETHR_X86_RUNTIME_CONF__ -# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \ - (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg != 0, 1)) -# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \ - (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg == 0, 0)) -# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \ - (__builtin_expect(ethr_runtime__.conf.have_sse2 != 0, 1)) -# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \ - (__builtin_expect(ethr_runtime__.conf.have_sse2 == 0, 0)) +# define ETHR_X86_RUNTIME_CONF_HAVE_META(feature) \ + (__builtin_expect(ethr_runtime__.conf.have_##feature != 0, 1)) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_META(feature) \ + (__builtin_expect(ethr_runtime__.conf.have_##feature == 0, 0)) + +# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(dw_cmpxchg) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(dw_cmpxchg) +# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(sse2) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(sse2) +# define ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(rdtscp) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_RDTSCP__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(rdtscp) +# define ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(constant_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_CONSTANT_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(tsc_reliable) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_TSC_RELIABLE_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(tsc_reliable) +# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC_S3__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc_s3) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC_S3__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc_s3) + #endif #if (defined(__GNUC__) \ @@ -300,6 +326,11 @@ typedef struct { #if defined(ETHR_X86_RUNTIME_CONF__) int have_dw_cmpxchg; int have_sse2; + int have_rdtscp; + int have_constant_tsc; + int have_tsc_reliable; + int have_nonstop_tsc; + int have_nonstop_tsc_s3; #endif #if defined(ETHR_PPC_RUNTIME_CONF__) int have_lwsync; diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c index 56fecf81b8..3e7aad16c7 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -139,6 +139,38 @@ x86_init(void) #endif /* bit 26 of edx is set if we have sse2 */ ethr_runtime__.conf.have_sse2 = (edx & (1 << 26)); + + /* check if we have extended feature set */ + eax = 0x80000000; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + + if (eax < 0x80000001) + return; + + if (eax >= 0x80000007) { + /* Advanced Power Management Information */ + eax = 0x80000007; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + + /* I got the values below from: + http://lxr.free-electrons.com/source/arch/x86/include/asm/cpufeature.h + They can be gotten from the intel/amd manual as well. + */ + + ethr_runtime__.conf.have_constant_tsc = (edx & (1 << 8)); + ethr_runtime__.conf.have_tsc_reliable = (edx & (1 << 23)); + ethr_runtime__.conf.have_nonstop_tsc = (edx & (1 << 24)); + ethr_runtime__.conf.have_nonstop_tsc_s3 = (edx & (1 << 30)); + + } + + /* Extended Processor Info and Feature Bits */ + eax = 0x80000001; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + + /* bit 27 of edx is set if we have rdtscp */ + ethr_runtime__.conf.have_rdtscp = (edx & (1 << 27)); + } #endif /* ETHR_X86_RUNTIME_CONF__ */ diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex f007880683..ca9e6bd20f 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex b99b28f3a1..b353129a34 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 37e6b181d6..4188e5fd9b 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 2380930767..5590f5a911 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 67159713f5..8ac7f5b471 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex fd80258d0e..3cd2515ba8 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 0e51a1bfc7..9a208d1545 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 663f5d46e6..a386613eef 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex d8a8061bae..d68d18ecba 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 1d69c2e583..01b3b1feb8 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 2ffd839f8a..7252d866bb 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 a9b1714f86..ab51cf385c 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -71,7 +71,8 @@ | 'milli_seconds' | 'micro_seconds' | 'nano_seconds' - | 'native'. + | 'native' + | 'perf_counter'. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Native code BIF stubs and their types @@ -185,6 +186,8 @@ 'receive' | 'print' | 'timestamp' | + 'monotonic_timestamp' | + 'strict_monotonic_timestamp' | 'label' | 'serial'. @@ -198,7 +201,10 @@ 'exclusive' | 'runnable_ports' | 'runnable_procs' | - 'scheduler'. + 'scheduler' | + 'timestamp' | + 'monotonic_timestamp' | + 'strict_monotonic_timestamp'. -type system_monitor_option() :: 'busy_port' | @@ -230,6 +236,8 @@ garbage_collection | timestamp | cpu_timestamp | + monotonic_timestamp | + strict_monotonic_timestamp | arity | set_on_spawn | set_on_first_spawn | @@ -258,6 +266,8 @@ running | garbage_collection | timestamp | + monotonic_timestamp | + strict_monotonic_timestamp | arity. -type trace_info_return() :: @@ -1338,6 +1348,7 @@ convert_time_unit(Time, FromUnit, ToUnit) -> try FU = case FromUnit of native -> erts_internal:time_unit(); + perf_counter -> erts_internal:perf_counter_unit(); nano_seconds -> 1000*1000*1000; micro_seconds -> 1000*1000; milli_seconds -> 1000; @@ -1346,6 +1357,7 @@ convert_time_unit(Time, FromUnit, ToUnit) -> end, TU = case ToUnit of native -> erts_internal:time_unit(); + perf_counter -> erts_internal:perf_counter_unit(); nano_seconds -> 1000*1000*1000; micro_seconds -> 1000*1000; milli_seconds -> 1000; @@ -2162,6 +2174,8 @@ send(_Dest,_Msg,_Options) -> ('receive') -> {'receive', boolean()}; (print) -> {print, boolean()}; (timestamp) -> {timestamp, boolean()}; + (monotonic_timestamp) -> {timestamp, boolean()}; + (strict_monotonic_timestamp) -> {strict_monotonic_timestamp, boolean()}; (label) -> [] | {label, non_neg_integer()}; (serial) -> [] | {serial, {non_neg_integer(), non_neg_integer()}}. seq_trace_info(_What) -> @@ -2203,6 +2217,16 @@ spawn_opt(_Tuple) -> (io) -> {{input, Input}, {output, Output}} when Input :: non_neg_integer(), Output :: non_neg_integer(); + (microstate_accounting) -> [MSAcc_Thread] | undefined when + MSAcc_Thread :: #{ type => MSAcc_Thread_Type, + id => MSAcc_Thread_Id, + counters => MSAcc_Counters}, + MSAcc_Thread_Type :: scheduler | async | aux, + MSAcc_Thread_Id :: non_neg_integer(), + MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() }, + MSAcc_Thread_State :: alloc | aux | bif | busy_wait | check_io | + emulator | ets | gc | gc_fullsweep | nif | + other | port | send | sleep | timers; (reductions) -> {Total_Reductions, Reductions_Since_Last_Call} when Total_Reductions :: non_neg_integer(), @@ -2257,6 +2281,9 @@ subtract(_,_) -> (fullsweep_after, Number) -> OldNumber when Number :: non_neg_integer(), OldNumber :: non_neg_integer(); + (microstate_accounting, Action) -> OldState when + Action :: true | false | reset, + OldState :: true | false; (min_heap_size, MinHeapSize) -> OldMinHeapSize when MinHeapSize :: non_neg_integer(), OldMinHeapSize :: non_neg_integer(); diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl index a64860bec8..d1e64342e0 100644 --- a/erts/preloaded/src/erts_code_purger.erl +++ b/erts/preloaded/src/erts_code_purger.erl @@ -31,7 +31,7 @@ start() -> loop(). loop() -> - receive + _ = receive {purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) -> Res = do_purge(Mod), From ! {reply, purge, Res, Ref}; diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 84dedab930..26025d6704 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -45,11 +45,14 @@ -export([await_result/1, gather_io_bytes/2]). --export([time_unit/0]). +-export([time_unit/0, perf_counter_unit/0]). -export([is_system_process/1]). -%% Auto import name clash +-export([await_microstate_accounting_modifications/3, + gather_microstate_accounting_result/2]). + +%% Auto-import name clash -export([check_process_code/2]). %% @@ -196,7 +199,7 @@ port_info(_Result, _Item) -> -spec request_system_task(Pid, Prio, Request) -> 'ok' when Prio :: 'max' | 'high' | 'normal' | 'low', Request :: {'garbage_collect', term()} - | {'check_process_code', term(), module(), boolean()}, + | {'check_process_code', term(), module(), non_neg_integer()}, Pid :: pid(). request_system_task(_Pid, _Prio, _Request) -> @@ -345,8 +348,38 @@ flush_monitor_messages(Ref, Multi, Res) when is_reference(Ref) -> time_unit() -> erlang:nif_error(undefined). +-spec erts_internal:perf_counter_unit() -> pos_integer(). + +perf_counter_unit() -> + erlang:nif_error(undefined). + -spec erts_internal:is_system_process(Pid) -> boolean() when Pid :: pid(). is_system_process(_Pid) -> erlang:nif_error(undefined). + +-spec await_microstate_accounting_modifications(Ref, Result, Threads) -> boolean() when + Ref :: reference(), + Result :: boolean(), + Threads :: pos_integer(). + +await_microstate_accounting_modifications(Ref, Result, Threads) -> + _ = microstate_accounting(Ref,Threads), + Result. + +-spec gather_microstate_accounting_result(Ref, Threads) -> [#{}] when + Ref :: reference(), + Threads :: pos_integer(). + +gather_microstate_accounting_result(Ref, Threads) -> + microstate_accounting(Ref, Threads). + +microstate_accounting(_Ref, 0) -> + []; +microstate_accounting(Ref, Threads) -> + receive + Ref -> microstate_accounting(Ref, Threads - 1); + {Ref, Res} -> + [Res | microstate_accounting(Ref, Threads - 1)] + end. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 093bcb5a6c..6d5062a118 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1289,6 +1289,7 @@ gen_head(Erules,Mod,Hrl) -> emit({"-module('",Mod,"').",nl}), put(currmod,Mod), emit({"-compile(nowarn_unused_vars).",nl}), + emit({"-dialyzer(no_improper_lists).",nl}), case Hrl of 0 -> ok; _ -> emit({"-include(\"",Mod,".hrl\").",nl}) diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index 4fee5a64cc..ae2e5641ec 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -58,7 +58,7 @@ dialyze(Files) -> Beams0 = [code:which(module(F)) || F <- Files], Beams = [code:which(asn1rt_nif)|Beams0], case dialyzer:run([{files,Beams}, - {warnings,[no_improper_lists]}, + {warnings,[]}, {get_warnings,true}]) of [] -> ok; diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 4f76350269..62356928ae 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -421,7 +421,8 @@ btb_follow_branches([], _, D) -> D. btb_follow_branch(0, _Regs, D) -> D; btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> - case gb_sets:is_member(Lbl, Br0) of + Key = {Lbl,Regs}, + case gb_sets:is_member(Key, Br0) of true -> %% We have already followed this branch and it was OK. D; @@ -432,7 +433,7 @@ btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> btb_reaches_match_1(Is, Regs, D), %% Since we got back, this branch is OK. - D#btb{ok_br=gb_sets:insert(Lbl, Br),must_not_save=MustNotSave, + D#btb{ok_br=gb_sets:insert(Key, Br),must_not_save=MustNotSave, must_save=MustSave} end. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 72f1a767ed..46917905de 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1620,11 +1620,8 @@ output_encoding(F, #compile{encoding = Encoding}) -> ok = io:setopts(F, [{encoding, Encoding}]), ok = io:fwrite(F, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). -restore_expanded_types("P", Fs) -> - epp:restore_typed_record_fields(Fs); restore_expanded_types("E", {M,I,Fs0}) -> - Fs1 = restore_expand_module(Fs0), - Fs = epp:restore_typed_record_fields(Fs1), + Fs = restore_expand_module(Fs0), {M,I,Fs}; restore_expanded_types(_Ext, Code) -> Code. @@ -1636,6 +1633,8 @@ restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) -> [{attribute,Line,spec,Arg}|restore_expand_module(Fs)]; restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) -> [{attribute,Line,callback,Arg}|restore_expand_module(Fs)]; +restore_expand_module([{attribute,Line,record,[R]}|Fs]) -> + [{attribute,Line,record,R}|restore_expand_module(Fs)]; restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 8074456be2..72649e5c9f 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1853,27 +1853,22 @@ uguard(Pg, Gs0, Ks, St0) -> %% uexprs([Kexpr], [KnownVar], State) -> {[Kexpr],State}. uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) -> - %% Optimise for simple set of unbound variable. - case upattern(P0, Ks, St0) of - {#c_var{},[],_Pvs,_Pus,_} -> - %% Throw our work away and just set to iset. + case upat_is_new_var(P0, Ks) of + true -> + %% Assignment to a new variable. uexprs([#iset{var=P0,arg=Arg}|Les], Ks, St0); - _Other -> - %% Throw our work away and set to icase. - if - Les =:= [] -> - %% Need to explicitly return match "value", make - %% safe for efficiency. - {La0,Lps,St1} = force_safe(Arg, St0), - La = mark_compiler_generated(La0), - Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]}, - uexprs(Lps ++ [#icase{anno=A, - args=[La0],clauses=[Mc],fc=Fc}], Ks, St1); - true -> - Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les}, - uexprs([#icase{anno=A,args=[Arg], - clauses=[Mc],fc=Fc}], Ks, St0) - end + false when Les =:= [] -> + %% Need to explicitly return match "value", make + %% safe for efficiency. + {La0,Lps,St1} = force_safe(Arg, St0), + La = mark_compiler_generated(La0), + Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]}, + uexprs(Lps ++ [#icase{anno=A, + args=[La0],clauses=[Mc],fc=Fc}], Ks, St1); + false -> + Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les}, + uexprs([#icase{anno=A,args=[Arg], + clauses=[Mc],fc=Fc}], Ks, St0) end; uexprs([Le0|Les0], Ks, St0) -> {Le1,St1} = uexpr(Le0, Ks, St0), @@ -1881,6 +1876,15 @@ uexprs([Le0|Les0], Ks, St0) -> {[Le1|Les1],St2}; uexprs([], _, St) -> {[],St}. +%% upat_is_new_var(Pattern, [KnownVar]) -> true|false. +%% Test whether the pattern is a single, previously unknown +%% variable. + +upat_is_new_var(#c_var{name=V}, Ks) -> + not is_element(V, Ks); +upat_is_new_var(_, _) -> + false. + %% Mark a "safe" as compiler-generated. mark_compiler_generated(#c_cons{anno=A,hd=H,tl=T}) -> ann_c_cons([compiler_generated|A], mark_compiler_generated(H), diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 011748df3a..4446d5ff1d 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. 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. @@ -143,8 +143,10 @@ attributes([]) -> []. include_attribute(type) -> false; include_attribute(spec) -> false; +include_attribute(callback) -> false; include_attribute(opaque) -> false; include_attribute(export_type) -> false; +include_attribute(record) -> false; include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 667c6754ee..8725e133fa 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -37,7 +37,7 @@ cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, no_partition/1,calling_a_binary/1,binary_in_map/1, match_string_opt/1,select_on_integer/1, - map_and_binary/1]). + map_and_binary/1,unsafe_branch_caching/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -64,7 +64,7 @@ groups() -> cover_beam_bool,matched_out_size,follow_fail_branch, no_partition,calling_a_binary,binary_in_map, match_string_opt,select_on_integer, - map_and_binary]}]. + map_and_binary,unsafe_branch_caching]}]. init_per_suite(Config) -> @@ -1267,6 +1267,32 @@ do_map_and_binary(#{time := _} = T) -> do_map_and_binary(#{hour := Hour, min := Min} = T) -> {Hour, Min, T}. +%% Unsafe caching of branch outcomes in beam_bsm would cause the +%% delayed creation of sub-binaries optimization to be applied even +%% when it was unsafe. + +unsafe_branch_caching(_Config) -> + <<>> = do_unsafe_branch_caching(<<42,1>>), + <<>> = do_unsafe_branch_caching(<<42,2>>), + <<>> = do_unsafe_branch_caching(<<42,3>>), + <<17,18>> = do_unsafe_branch_caching(<<42,3,17,18>>), + <<>> = do_unsafe_branch_caching(<<1,3,42,2>>), + + ok. + +do_unsafe_branch_caching(<<Code/integer, Bin/binary>>) -> + <<C1/integer, B1/binary>> = Bin, + case C1 of + X when X =:= 1 orelse X =:= 2 -> + Bin2 = <<>>; + _ -> + Bin2 = B1 + end, + case Code of + 1 -> do_unsafe_branch_caching(Bin2); + _ -> Bin2 + end. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 806cb58bab..ab9910f555 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -29,7 +29,7 @@ file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, encrypted_abstr/1, - bad_record_use1/1, bad_record_use2/1, strict_record/1, + strict_record/1, missing_testheap/1, cover/1, env/1, core/1, asm/1, sys_pre_attributes/1, dialyzer/1, warnings/1 @@ -48,13 +48,12 @@ all() -> [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, encrypted_abstr, - {group, bad_record_use}, strict_record, + strict_record, missing_testheap, cover, env, core, asm, sys_pre_attributes, dialyzer, warnings]. groups() -> - [{bad_record_use, [], - [bad_record_use1, bad_record_use2]}]. + []. init_per_suite(Config) -> Config. @@ -86,7 +85,7 @@ file_1(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {Simple, Target} = files(Config, "file_1"), + {Simple, Target} = get_files(Config, simple, "file_1"), ?line {ok, Cwd} = file:get_cwd(), ?line ok = file:set_cwd(filename:dirname(Target)), @@ -161,11 +160,8 @@ module_mismatch(Config) when is_list(Config) -> big_file(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(5)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Big = filename:join(DataDir, "big.erl"), - ?line Target = filename:join(PrivDir, "big.beam"), - ?line ok = file:set_cwd(PrivDir), + {Big,Target} = get_files(Config, big, "big_file"), + ok = file:set_cwd(filename:dirname(Target)), ?line compile_and_verify(Big, Target, []), ?line compile_and_verify(Big, Target, [debug_info]), ?line compile_and_verify(Big, Target, [no_postopt]), @@ -179,7 +175,7 @@ big_file(Config) when is_list(Config) -> outdir(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "outdir"), + {Simple, Target} = get_files(Config, simple, "outdir"), ?line {ok, simple} = compile:file(Simple, [{outdir, filename:dirname(Target)}]), ?line true = exists(Target), ?line passed = run(Target, test, []), @@ -192,7 +188,7 @@ outdir(Config) when is_list(Config) -> binary(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "binary"), + {Simple, Target} = get_files(Config, simple, "binary"), ?line {ok, simple, Binary} = compile:file(Simple, [binary]), ?line code:load_binary(simple, Target, Binary), ?line passed = simple:test(), @@ -206,7 +202,7 @@ binary(Config) when is_list(Config) -> makedep(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple,Target} = files(Config, "makedep"), + {Simple,Target} = get_files(Config, simple, "makedep"), ?line DataDir = ?config(data_dir, Config), ?line SimpleRootname = filename:rootname(Simple), ?line IncludeDir = filename:join(filename:dirname(Simple), "include"), @@ -282,7 +278,7 @@ makedep_modify_target(Mf, Target) -> cond_and_ifdef(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "cond_and_ifdef"), + {Simple, Target} = get_files(Config, simple, "cond_and_ifdef"), ?line IncludeDir = filename:join(filename:dirname(Simple), "include"), ?line Options = [{outdir, filename:dirname(Target)}, {d, need_foo}, {d, foo_value, 42}, @@ -362,21 +358,18 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> listings_big(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Big = filename:join(DataDir, big), - ?line TargetDir = filename:join(PrivDir, listings_big), - ?line ok = file:make_dir(TargetDir), + {Big,Target} = get_files(Config, big, listings_big), + TargetDir = filename:dirname(Target), ?line do_listing(Big, TargetDir, 'S'), ?line do_listing(Big, TargetDir, 'E'), ?line do_listing(Big, TargetDir, 'P'), ?line do_listing(Big, TargetDir, dkern, ".kernel"), - ?line Target = filename:join(TargetDir, big), - {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]), + TargetNoext = filename:rootname(Target, code:objfile_extension()), + {ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]), %% Cleanup. - ?line ok = file:delete(Target ++ ".beam"), + ok = file:delete(Target), ?line lists:foreach(fun(F) -> ok = file:delete(F) end, filelib:wildcard(filename:join(TargetDir, "*"))), ?line ok = file:del_dir(TargetDir), @@ -385,11 +378,7 @@ listings_big(Config) when is_list(Config) -> other_output(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(8)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, simple), - ?line TargetDir = filename:join(PrivDir, other_output), - ?line ok = file:make_dir(TargetDir), + {Simple,_Target} = get_files(Config, simple, "other_output"), io:put_chars("to_pp"), ?line {ok,[],PP} = compile:file(Simple, [to_pp,binary,time]), @@ -434,7 +423,7 @@ other_output(Config) when is_list(Config) -> encrypted_abstr(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line {Simple,Target} = files(Config, "encrypted_abstr"), + {Simple,Target} = get_files(Config, simple, "encrypted_abstr"), Res = case has_crypto() of false -> @@ -582,17 +571,17 @@ do_listing(Source, TargetDir, Type, Ext) -> Target = filename:join(TargetDir, SourceBase ++ Ext), true = exists(Target). -files(Config, Name) -> - ?line code:delete(simple), - ?line code:purge(simple), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, "simple"), - ?line TargetDir = filename:join(PrivDir, Name), - ?line ok = file:make_dir(TargetDir), - ?line Target = filename:join(TargetDir, "simple"++code:objfile_extension()), - {Simple, Target}. - +get_files(Config, Module, OutputName) -> + code:delete(Module), + code:purge(Module), + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Src = filename:join(DataDir, atom_to_list(Module)), + TargetDir = filename:join(PrivDir, OutputName), + ok = file:make_dir(TargetDir), + File = atom_to_list(Module) ++ code:objfile_extension(), + Target = filename:join(TargetDir, File), + {Src, Target}. run(Target, Func, Args) -> ?line Module = list_to_atom(filename:rootname(filename:basename(Target))), @@ -609,28 +598,6 @@ exists(Name) -> end. -%% Tests that the compiler does not accept -%% bad use of records. -bad_record_use1(Config) when is_list(Config) -> - ?line {ok, Cwd} = file:get_cwd(), - ?line file:set_cwd(?config(data_dir, Config)), - ?line true=exists("bad_record_use.erl"), - ?line Ret=c:c(bad_record_use), - ?line file:set_cwd(Cwd), - ?line error=Ret, - ok. - -%% Tests that the compiler does not accept -%% bad use of records. -bad_record_use2(Config) when is_list(Config) -> - ?line {ok, Cwd} = file:get_cwd(), - ?line file:set_cwd(?config(data_dir, Config)), - ?line true=exists("bad_record_use2.erl"), - ?line Ret=c:c(bad_record_use), - ?line file:set_cwd(Cwd), - ?line error=Ret, - ok. - strict_record(Config) when is_list(Config) -> ?line Priv = ?config(priv_dir, Config), ?line file:set_cwd(?config(data_dir, Config)), @@ -715,7 +682,7 @@ init(ReplyTo, Fun, _Filler) -> ReplyTo ! {result, Fun()}. env(Config) when is_list(Config) -> - ?line {Simple,Target} = files(Config, "file_1"), + {Simple,Target} = get_files(Config, simple, env), ?line {ok,Cwd} = file:get_cwd(), ?line ok = file:set_cwd(filename:dirname(Target)), @@ -724,9 +691,9 @@ env(Config) when is_list(Config) -> env_1(Simple, Target) after true = os:putenv("ERL_COMPILER_OPTIONS", "ignore_me"), - file:set_cwd(Cwd), - file:delete(Target), - file:del_dir(filename:dirname(Target)) + file:set_cwd(Cwd), + file:delete(Target), + file:del_dir(filename:dirname(Target)) end, ok. diff --git a/lib/compiler/test/compile_SUITE_data/bad_record_use.erl b/lib/compiler/test/compile_SUITE_data/bad_record_use.erl deleted file mode 100644 index 0fb6fc3045..0000000000 --- a/lib/compiler/test/compile_SUITE_data/bad_record_use.erl +++ /dev/null @@ -1,29 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. 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(bad_record_use). --export([test/0]). - --record(bad_use, {a=undefined, - b=undefined, - c=undefined}). - -test() -> - NewRecord=#bad_use{a=1, b=2, a=2}. - diff --git a/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl b/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl deleted file mode 100644 index 7c898af00f..0000000000 --- a/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. 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(bad_record_use2). --export([test/0]). - --record(bad_use, {a=undefined, - b=undefined, - c=undefined}). - -test() -> - R=#bad_use{a=1, b=2}, - R2=R#bad_use{a=1, b=2, a=2}, - ok. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index c0ab7ba7cd..d1f620d892 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -3006,6 +3006,9 @@ static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) } else goto out_err; + if (!group) + goto out_err; + if (enif_inspect_binary(env, prime[2], &seed)) { EC_GROUP_set_seed(group, seed.data, seed.size); } diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 6ec98a4ece..f34d27649a 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -1979,7 +1979,7 @@ dss_params() -> 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669]. ec_key_named() -> - Curve = secp112r2, + Curve = hd(crypto:ec_curves()), {D2_pub, D2_priv} = crypto:generate_key(ecdh, Curve), {[D2_priv, Curve], [D2_pub, Curve]}. @@ -2148,88 +2148,94 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv SessionKey}. ecdh() -> %% http://csrc.nist.gov/groups/STM/cavp/ - [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"), - hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"), - secp192r1, - hexstr2bin("803d8ab2e5b6e6fca715737c3a82f7ce3c783124f6d51cd0")}, - {ecdh, hexstr2point("deb5712fa027ac8d2f22c455ccb73a91e17b6512b5e030e7", "7e2690a02cc9b28708431a29fb54b87b1f0c14e011ac2125"), - hexstr2bin("56e853349d96fe4c442448dacb7cf92bb7a95dcf574a9bd5"), - secp192r1, - hexstr2bin("c208847568b98835d7312cef1f97f7aa298283152313c29d")}, - {ecdh, hexstr2point("af33cd0629bc7e996320a3f40368f74de8704fa37b8fab69abaae280", "882092ccbba7930f419a8a4f9bb16978bbc3838729992559a6f2e2d7"), - hexstr2bin("8346a60fc6f293ca5a0d2af68ba71d1dd389e5e40837942df3e43cbd"), - secp224r1, - hexstr2bin("7d96f9a3bd3c05cf5cc37feb8b9d5209d5c2597464dec3e9983743e8")}, - {ecdh, hexstr2point("13bfcd4f8e9442393cab8fb46b9f0566c226b22b37076976f0617a46", "eeb2427529b288c63c2f8963c1e473df2fca6caa90d52e2f8db56dd4"), - hexstr2bin("043cb216f4b72cdf7629d63720a54aee0c99eb32d74477dac0c2f73d"), - secp224r1, - hexstr2bin("ee93ce06b89ff72009e858c68eb708e7bc79ee0300f73bed69bbca09")}, - {ecdh, hexstr2point("700c48f77f56584c5cc632ca65640db91b6bacce3a4df6b42ce7cc838833d287", "db71e509e3fd9b060ddb20ba5c51dcc5948d46fbf640dfe0441782cab85fa4ac"), - hexstr2bin("7d7dc5f71eb29ddaf80d6214632eeae03d9058af1fb6d22ed80badb62bc1a534"), - secp256r1, - hexstr2bin("46fc62106420ff012e54a434fbdd2d25ccc5852060561e68040dd7778997bd7b")}, - {ecdh, hexstr2point("809f04289c64348c01515eb03d5ce7ac1a8cb9498f5caa50197e58d43a86a7ae", "b29d84e811197f25eba8f5194092cb6ff440e26d4421011372461f579271cda3"), - hexstr2bin("38f65d6dce47676044d58ce5139582d568f64bb16098d179dbab07741dd5caf5"), - secp256r1, - hexstr2bin("057d636096cb80b67a8c038c890e887d1adfa4195e9b3ce241c8a778c59cda67")}, - {ecdh, hexstr2point("a7c76b970c3b5fe8b05d2838ae04ab47697b9eaf52e764592efda27fe7513272734466b400091adbf2d68c58e0c50066", "ac68f19f2e1cb879aed43a9969b91a0839c4c38a49749b661efedf243451915ed0905a32b060992b468c64766fc8437a"), - hexstr2bin("3cc3122a68f0d95027ad38c067916ba0eb8c38894d22e1b15618b6818a661774ad463b205da88cf699ab4d43c9cf98a1"), - secp384r1, - hexstr2bin("5f9d29dc5e31a163060356213669c8ce132e22f57c9a04f40ba7fcead493b457e5621e766c40a2e3d4d6a04b25e533f1")}, - {ecdh, hexstr2point("30f43fcf2b6b00de53f624f1543090681839717d53c7c955d1d69efaf0349b7363acb447240101cbb3af6641ce4b88e0", "25e46c0c54f0162a77efcc27b6ea792002ae2ba82714299c860857a68153ab62e525ec0530d81b5aa15897981e858757"), - hexstr2bin("92860c21bde06165f8e900c687f8ef0a05d14f290b3f07d8b3a8cc6404366e5d5119cd6d03fb12dc58e89f13df9cd783"), - secp384r1, - hexstr2bin("a23742a2c267d7425fda94b93f93bbcc24791ac51cd8fd501a238d40812f4cbfc59aac9520d758cf789c76300c69d2ff")}, - {ecdh, hexstr2point("00685a48e86c79f0f0875f7bc18d25eb5fc8c0b07e5da4f4370f3a9490340854334b1e1b87fa395464c60626124a4e70d0f785601d37c09870ebf176666877a2046d", "01ba52c56fc8776d9e8f5db4f0cc27636d0b741bbe05400697942e80b739884a83bde99e0f6716939e632bc8986fa18dccd443a348b6c3e522497955a4f3c302f676"), - hexstr2bin("017eecc07ab4b329068fba65e56a1f8890aa935e57134ae0ffcce802735151f4eac6564f6ee9974c5e6887a1fefee5743ae2241bfeb95d5ce31ddcb6f9edb4d6fc47"), - secp521r1, - hexstr2bin("005fc70477c3e63bc3954bd0df3ea0d1f41ee21746ed95fc5e1fdf90930d5e136672d72cc770742d1711c3c3a4c334a0ad9759436a4d3c5bf6e74b9578fac148c831")}, - {ecdh, hexstr2point("01df277c152108349bc34d539ee0cf06b24f5d3500677b4445453ccc21409453aafb8a72a0be9ebe54d12270aa51b3ab7f316aa5e74a951c5e53f74cd95fc29aee7a", "013d52f33a9f3c14384d1587fa8abe7aed74bc33749ad9c570b471776422c7d4505d9b0a96b3bfac041e4c6a6990ae7f700e5b4a6640229112deafa0cd8bb0d089b0"), - hexstr2bin("00816f19c1fb10ef94d4a1d81c156ec3d1de08b66761f03f06ee4bb9dcebbbfe1eaa1ed49a6a990838d8ed318c14d74cc872f95d05d07ad50f621ceb620cd905cfb8"), - secp521r1, - hexstr2bin("000b3920ac830ade812c8f96805da2236e002acbbf13596a9ab254d44d0e91b6255ebf1229f366fb5a05c5884ef46032c26d42189273ca4efa4c3db6bd12a6853759")}, - - %% RFC-6954, Appendix A - {ecdh, hexstr2point("A9C21A569759DA95E0387041184261440327AFE33141CA04B82DC92E", - "98A0F75FBBF61D8E58AE5511B2BCDBE8E549B31E37069A2825F590C1"), - hexstr2bin("6060552303899E2140715816C45B57D9B42204FB6A5BF5BEAC10DB00"), - brainpoolP224r1, - hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, - {ecdh, hexstr2point("034A56C550FF88056144E6DD56070F54B0135976B5BF77827313F36B", - "75165AD99347DC86CAAB1CBB579E198EAF88DC35F927B358AA683681"), - hexstr2bin("39F155483CEE191FBECFE9C81D8AB1A03CDA6790E7184ACE44BCA161"), - brainpoolP224r1, - hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, - {ecdh, hexstr2point("44106E913F92BC02A1705D9953A8414DB95E1AAA49E81D9E85F929A8E3100BE5", - "8AB4846F11CACCB73CE49CBDD120F5A900A69FD32C272223F789EF10EB089BDC"), - hexstr2bin("55E40BC41E37E3E2AD25C3C6654511FFA8474A91A0032087593852D3E7D76BD3"), - brainpoolP256r1, - hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, - {ecdh, hexstr2point("8D2D688C6CF93E1160AD04CC4429117DC2C41825E1E9FCA0ADDD34E6F1B39F7B", - "990C57520812BE512641E47034832106BC7D3E8DD0E4C7F1136D7006547CEC6A"), - hexstr2bin("81DB1EE100150FF2EA338D708271BE38300CB54241D79950F77B063039804F1D"), - brainpoolP256r1, - hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, - {ecdh, hexstr2point("68B665DD91C195800650CDD363C625F4E742E8134667B767B1B476793588F885AB698C852D4A6E77A252D6380FCAF068", - "55BC91A39C9EC01DEE36017B7D673A931236D2F1F5C83942D049E3FA20607493E0D038FF2FD30C2AB67D15C85F7FAA59"), - hexstr2bin("032640BC6003C59260F7250C3DB58CE647F98E1260ACCE4ACDA3DD869F74E01F8BA5E0324309DB6A9831497ABAC96670"), - brainpoolP384r1, - hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, - {ecdh, hexstr2point("4D44326F269A597A5B58BBA565DA5556ED7FD9A8A9EB76C25F46DB69D19DC8CE6AD18E404B15738B2086DF37E71D1EB4", - "62D692136DE56CBE93BF5FA3188EF58BC8A3A0EC6C1E151A21038A42E9185329B5B275903D192F8D4E1F32FE9CC78C48"), - hexstr2bin("1E20F5E048A5886F1F157C74E91BDE2B98C8B52D58E5003D57053FC4B0BD65D6F15EB5D1EE1610DF870795143627D042"), - brainpoolP384r1, - hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, - {ecdh, hexstr2point("0A420517E406AAC0ACDCE90FCD71487718D3B953EFD7FBEC5F7F27E28C6149999397E91E029E06457DB2D3E640668B392C2A7E737A7F0BF04436D11640FD09FD", - "72E6882E8DB28AAD36237CD25D580DB23783961C8DC52DFA2EC138AD472A0FCEF3887CF62B623B2A87DE5C588301EA3E5FC269B373B60724F5E82A6AD147FDE7"), - hexstr2bin("230E18E1BCC88A362FA54E4EA3902009292F7F8033624FD471B5D8ACE49D12CFABBC19963DAB8E2F1EBA00BFFB29E4D72D13F2224562F405CB80503666B25429"), - brainpoolP512r1, - hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}, - {ecdh, hexstr2point("9D45F66DE5D67E2E6DB6E93A59CE0BB48106097FF78A081DE781CDB31FCE8CCBAAEA8DD4320C4119F1E9CD437A2EAB3731FA9668AB268D871DEDA55A5473199F", - "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"), - hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"), - brainpoolP512r1, - hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}]. + Curves = crypto:ec_curves(), + TestCases = + [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"), + hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"), + secp192r1, + hexstr2bin("803d8ab2e5b6e6fca715737c3a82f7ce3c783124f6d51cd0")}, + {ecdh, hexstr2point("deb5712fa027ac8d2f22c455ccb73a91e17b6512b5e030e7", "7e2690a02cc9b28708431a29fb54b87b1f0c14e011ac2125"), + hexstr2bin("56e853349d96fe4c442448dacb7cf92bb7a95dcf574a9bd5"), + secp192r1, + hexstr2bin("c208847568b98835d7312cef1f97f7aa298283152313c29d")}, + {ecdh, hexstr2point("af33cd0629bc7e996320a3f40368f74de8704fa37b8fab69abaae280", "882092ccbba7930f419a8a4f9bb16978bbc3838729992559a6f2e2d7"), + hexstr2bin("8346a60fc6f293ca5a0d2af68ba71d1dd389e5e40837942df3e43cbd"), + secp224r1, + hexstr2bin("7d96f9a3bd3c05cf5cc37feb8b9d5209d5c2597464dec3e9983743e8")}, + {ecdh, hexstr2point("13bfcd4f8e9442393cab8fb46b9f0566c226b22b37076976f0617a46", "eeb2427529b288c63c2f8963c1e473df2fca6caa90d52e2f8db56dd4"), + hexstr2bin("043cb216f4b72cdf7629d63720a54aee0c99eb32d74477dac0c2f73d"), + secp224r1, + hexstr2bin("ee93ce06b89ff72009e858c68eb708e7bc79ee0300f73bed69bbca09")}, + {ecdh, hexstr2point("700c48f77f56584c5cc632ca65640db91b6bacce3a4df6b42ce7cc838833d287", "db71e509e3fd9b060ddb20ba5c51dcc5948d46fbf640dfe0441782cab85fa4ac"), + hexstr2bin("7d7dc5f71eb29ddaf80d6214632eeae03d9058af1fb6d22ed80badb62bc1a534"), + secp256r1, + hexstr2bin("46fc62106420ff012e54a434fbdd2d25ccc5852060561e68040dd7778997bd7b")}, + {ecdh, hexstr2point("809f04289c64348c01515eb03d5ce7ac1a8cb9498f5caa50197e58d43a86a7ae", "b29d84e811197f25eba8f5194092cb6ff440e26d4421011372461f579271cda3"), + hexstr2bin("38f65d6dce47676044d58ce5139582d568f64bb16098d179dbab07741dd5caf5"), + secp256r1, + hexstr2bin("057d636096cb80b67a8c038c890e887d1adfa4195e9b3ce241c8a778c59cda67")}, + {ecdh, hexstr2point("a7c76b970c3b5fe8b05d2838ae04ab47697b9eaf52e764592efda27fe7513272734466b400091adbf2d68c58e0c50066", "ac68f19f2e1cb879aed43a9969b91a0839c4c38a49749b661efedf243451915ed0905a32b060992b468c64766fc8437a"), + hexstr2bin("3cc3122a68f0d95027ad38c067916ba0eb8c38894d22e1b15618b6818a661774ad463b205da88cf699ab4d43c9cf98a1"), + secp384r1, + hexstr2bin("5f9d29dc5e31a163060356213669c8ce132e22f57c9a04f40ba7fcead493b457e5621e766c40a2e3d4d6a04b25e533f1")}, + {ecdh, hexstr2point("30f43fcf2b6b00de53f624f1543090681839717d53c7c955d1d69efaf0349b7363acb447240101cbb3af6641ce4b88e0", "25e46c0c54f0162a77efcc27b6ea792002ae2ba82714299c860857a68153ab62e525ec0530d81b5aa15897981e858757"), + hexstr2bin("92860c21bde06165f8e900c687f8ef0a05d14f290b3f07d8b3a8cc6404366e5d5119cd6d03fb12dc58e89f13df9cd783"), + secp384r1, + hexstr2bin("a23742a2c267d7425fda94b93f93bbcc24791ac51cd8fd501a238d40812f4cbfc59aac9520d758cf789c76300c69d2ff")}, + {ecdh, hexstr2point("00685a48e86c79f0f0875f7bc18d25eb5fc8c0b07e5da4f4370f3a9490340854334b1e1b87fa395464c60626124a4e70d0f785601d37c09870ebf176666877a2046d", "01ba52c56fc8776d9e8f5db4f0cc27636d0b741bbe05400697942e80b739884a83bde99e0f6716939e632bc8986fa18dccd443a348b6c3e522497955a4f3c302f676"), + hexstr2bin("017eecc07ab4b329068fba65e56a1f8890aa935e57134ae0ffcce802735151f4eac6564f6ee9974c5e6887a1fefee5743ae2241bfeb95d5ce31ddcb6f9edb4d6fc47"), + secp521r1, + hexstr2bin("005fc70477c3e63bc3954bd0df3ea0d1f41ee21746ed95fc5e1fdf90930d5e136672d72cc770742d1711c3c3a4c334a0ad9759436a4d3c5bf6e74b9578fac148c831")}, + {ecdh, hexstr2point("01df277c152108349bc34d539ee0cf06b24f5d3500677b4445453ccc21409453aafb8a72a0be9ebe54d12270aa51b3ab7f316aa5e74a951c5e53f74cd95fc29aee7a", "013d52f33a9f3c14384d1587fa8abe7aed74bc33749ad9c570b471776422c7d4505d9b0a96b3bfac041e4c6a6990ae7f700e5b4a6640229112deafa0cd8bb0d089b0"), + hexstr2bin("00816f19c1fb10ef94d4a1d81c156ec3d1de08b66761f03f06ee4bb9dcebbbfe1eaa1ed49a6a990838d8ed318c14d74cc872f95d05d07ad50f621ceb620cd905cfb8"), + secp521r1, + hexstr2bin("000b3920ac830ade812c8f96805da2236e002acbbf13596a9ab254d44d0e91b6255ebf1229f366fb5a05c5884ef46032c26d42189273ca4efa4c3db6bd12a6853759")}, + + %% RFC-6954, Appendix A + {ecdh, hexstr2point("A9C21A569759DA95E0387041184261440327AFE33141CA04B82DC92E", + "98A0F75FBBF61D8E58AE5511B2BCDBE8E549B31E37069A2825F590C1"), + hexstr2bin("6060552303899E2140715816C45B57D9B42204FB6A5BF5BEAC10DB00"), + brainpoolP224r1, + hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, + {ecdh, hexstr2point("034A56C550FF88056144E6DD56070F54B0135976B5BF77827313F36B", + "75165AD99347DC86CAAB1CBB579E198EAF88DC35F927B358AA683681"), + hexstr2bin("39F155483CEE191FBECFE9C81D8AB1A03CDA6790E7184ACE44BCA161"), + brainpoolP224r1, + hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, + {ecdh, hexstr2point("44106E913F92BC02A1705D9953A8414DB95E1AAA49E81D9E85F929A8E3100BE5", + "8AB4846F11CACCB73CE49CBDD120F5A900A69FD32C272223F789EF10EB089BDC"), + hexstr2bin("55E40BC41E37E3E2AD25C3C6654511FFA8474A91A0032087593852D3E7D76BD3"), + brainpoolP256r1, + hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, + {ecdh, hexstr2point("8D2D688C6CF93E1160AD04CC4429117DC2C41825E1E9FCA0ADDD34E6F1B39F7B", + "990C57520812BE512641E47034832106BC7D3E8DD0E4C7F1136D7006547CEC6A"), + hexstr2bin("81DB1EE100150FF2EA338D708271BE38300CB54241D79950F77B063039804F1D"), + brainpoolP256r1, + hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, + {ecdh, hexstr2point("68B665DD91C195800650CDD363C625F4E742E8134667B767B1B476793588F885AB698C852D4A6E77A252D6380FCAF068", + "55BC91A39C9EC01DEE36017B7D673A931236D2F1F5C83942D049E3FA20607493E0D038FF2FD30C2AB67D15C85F7FAA59"), + hexstr2bin("032640BC6003C59260F7250C3DB58CE647F98E1260ACCE4ACDA3DD869F74E01F8BA5E0324309DB6A9831497ABAC96670"), + brainpoolP384r1, + hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, + {ecdh, hexstr2point("4D44326F269A597A5B58BBA565DA5556ED7FD9A8A9EB76C25F46DB69D19DC8CE6AD18E404B15738B2086DF37E71D1EB4", + "62D692136DE56CBE93BF5FA3188EF58BC8A3A0EC6C1E151A21038A42E9185329B5B275903D192F8D4E1F32FE9CC78C48"), + hexstr2bin("1E20F5E048A5886F1F157C74E91BDE2B98C8B52D58E5003D57053FC4B0BD65D6F15EB5D1EE1610DF870795143627D042"), + brainpoolP384r1, + hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, + {ecdh, hexstr2point("0A420517E406AAC0ACDCE90FCD71487718D3B953EFD7FBEC5F7F27E28C6149999397E91E029E06457DB2D3E640668B392C2A7E737A7F0BF04436D11640FD09FD", + "72E6882E8DB28AAD36237CD25D580DB23783961C8DC52DFA2EC138AD472A0FCEF3887CF62B623B2A87DE5C588301EA3E5FC269B373B60724F5E82A6AD147FDE7"), + hexstr2bin("230E18E1BCC88A362FA54E4EA3902009292F7F8033624FD471B5D8ACE49D12CFABBC19963DAB8E2F1EBA00BFFB29E4D72D13F2224562F405CB80503666B25429"), + brainpoolP512r1, + hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}, + {ecdh, hexstr2point("9D45F66DE5D67E2E6DB6E93A59CE0BB48106097FF78A081DE781CDB31FCE8CCBAAEA8DD4320C4119F1E9CD437A2EAB3731FA9668AB268D871DEDA55A5473199F", + "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"), + hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"), + brainpoolP512r1, + hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}], + lists:filter(fun ({_Type, _Pub, _Priv, Curve, _SharedSecret}) -> + lists:member(Curve, Curves) + end, + TestCases). dh() -> {dh, 0087761979513264537414556992123116644042638206717762626089877284926656954974893442000747478454809111207351620687968672207938731607963470779396984752680274820156266685080223616226905101126463253150237669547023934604953898814222890239130021414026118792251620881355456432549881723310342870016961804255746630219, 2}. @@ -2256,18 +2262,24 @@ ecc() -> %% information about the curves see %% http://csrc.nist.gov/encryption/dss/ecdsa/NISTReCur.pdf %% - [{ecdh,secp192r1,1, - hexstr2point("188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012", - "07192B95FFC8DA78631011ED6B24CDD573F977A11E794811")}, - {ecdh,secp192r1,2, - hexstr2point("DAFEBF5828783F2AD35534631588A3F629A70FB16982A888", - "DD6BDA0D993DA0FA46B27BBC141B868F59331AFA5C7E93AB")}, - {ecdh,secp192r1,3, - hexstr2point("76E32A2557599E6EDCD283201FB2B9AADFD0D359CBB263DA", - "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")}, - {ecdh,secp192r1,4, - hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA", - "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}]. + Curves = crypto:ec_curves(), + TestCases = + [{ecdh,secp192r1,1, + hexstr2point("188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012", + "07192B95FFC8DA78631011ED6B24CDD573F977A11E794811")}, + {ecdh,secp192r1,2, + hexstr2point("DAFEBF5828783F2AD35534631588A3F629A70FB16982A888", + "DD6BDA0D993DA0FA46B27BBC141B868F59331AFA5C7E93AB")}, + {ecdh,secp192r1,3, + hexstr2point("76E32A2557599E6EDCD283201FB2B9AADFD0D359CBB263DA", + "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")}, + {ecdh,secp192r1,4, + hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA", + "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}], + lists:filter(fun ({_Type, Curve, _Priv, _Pub}) -> + lists:member(Curve, Curves) + end, + TestCases). no_padding() -> Public = [_, Mod] = rsa_public(), diff --git a/lib/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl index b5894b070d..1e7f3a1438 100644 --- a/lib/crypto/test/old_crypto_SUITE.erl +++ b/lib/crypto/test/old_crypto_SUITE.erl @@ -1888,48 +1888,12 @@ ec(Config) when is_list(Config) -> ec_do() -> %% test for a name curve - {D2_pub, D2_priv} = crypto:generate_key(ecdh, secp112r2), - PrivECDH = [D2_priv, secp112r2], - PubECDH = [D2_pub, secp112r2], + NamedCurve = hd(crypto:ec_curves()), + {D2_pub, D2_priv} = crypto:generate_key(ecdh, NamedCurve), + PrivECDH = [D2_priv, NamedCurve], + PubECDH = [D2_pub, NamedCurve], %%TODO: find a published test case for a EC key - %% test for a full specified curve and public key, - %% taken from csca-germany_013_self_signed_cer.pem - PubKey = <<16#04, 16#4a, 16#94, 16#49, 16#81, 16#77, 16#9d, 16#df, - 16#1d, 16#a5, 16#e7, 16#c5, 16#27, 16#e2, 16#7d, 16#24, - 16#71, 16#a9, 16#28, 16#eb, 16#4d, 16#7b, 16#67, 16#75, - 16#ae, 16#09, 16#0a, 16#51, 16#45, 16#19, 16#9b, 16#d4, - 16#7e, 16#a0, 16#81, 16#e5, 16#5e, 16#d4, 16#a4, 16#3f, - 16#60, 16#7c, 16#6a, 16#50, 16#ee, 16#36, 16#41, 16#8a, - 16#87, 16#ff, 16#cd, 16#a6, 16#10, 16#39, 16#ca, 16#95, - 16#76, 16#7d, 16#ae, 16#ca, 16#c3, 16#44, 16#3f, 16#e3, 16#2c>>, - <<P:264/integer>> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9, - 16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d, - 16#72, 16#6e, 16#3b, 16#f6, 16#23, 16#d5, 16#26, 16#20, - 16#28, 16#20, 16#13, 16#48, 16#1d, 16#1f, 16#6e, 16#53, 16#77>>, - <<A:256/integer>> = <<16#7d, 16#5a, 16#09, 16#75, 16#fc, 16#2c, 16#30, 16#57, - 16#ee, 16#f6, 16#75, 16#30, 16#41, 16#7a, 16#ff, 16#e7, - 16#fb, 16#80, 16#55, 16#c1, 16#26, 16#dc, 16#5c, 16#6c, - 16#e9, 16#4a, 16#4b, 16#44, 16#f3, 16#30, 16#b5, 16#d9>>, - <<B:256/integer>> = <<16#26, 16#dc, 16#5c, 16#6c, 16#e9, 16#4a, 16#4b, 16#44, - 16#f3, 16#30, 16#b5, 16#d9, 16#bb, 16#d7, 16#7c, 16#bf, - 16#95, 16#84, 16#16, 16#29, 16#5c, 16#f7, 16#e1, 16#ce, - 16#6b, 16#cc, 16#dc, 16#18, 16#ff, 16#8c, 16#07, 16#b6>>, - BasePoint = <<16#04, 16#8b, 16#d2, 16#ae, 16#b9, 16#cb, 16#7e, 16#57, - 16#cb, 16#2c, 16#4b, 16#48, 16#2f, 16#fc, 16#81, 16#b7, - 16#af, 16#b9, 16#de, 16#27, 16#e1, 16#e3, 16#bd, 16#23, - 16#c2, 16#3a, 16#44, 16#53, 16#bd, 16#9a, 16#ce, 16#32, - 16#62, 16#54, 16#7e, 16#f8, 16#35, 16#c3, 16#da, 16#c4, - 16#fd, 16#97, 16#f8, 16#46, 16#1a, 16#14, 16#61, 16#1d, - 16#c9, 16#c2, 16#77, 16#45, 16#13, 16#2d, 16#ed, 16#8e, - 16#54, 16#5c, 16#1d, 16#54, 16#c7, 16#2f, 16#04, 16#69, 16#97>>, - <<Order:264/integer>> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9, - 16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d, - 16#71, 16#8c, 16#39, 16#7a, 16#a3, 16#b5, 16#61, 16#a6, - 16#f7, 16#90, 16#1e, 16#0e, 16#82, 16#97, 16#48, 16#56, 16#a7>>, - CoFactor = 1, - Curve = {{prime_field,P},{A,B,none},BasePoint, Order,CoFactor}, - Msg = <<99,234,6,64,190,237,201,99,80,248,58,40,70,45,149,218,5,246,242,63>>, Sign = crypto:sign(ecdsa, sha, Msg, PrivECDH), ?line true = crypto:verify(ecdsa, sha, Msg, Sign, PubECDH), diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index 4c34f253c6..1b274e20ae 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -267,7 +267,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, #ieval{level=Le,module=M}=Ieval) -> if Status =:= idle, Le =:= 1 -> - erase([Mod|db]), + erase(?DB_REF_KEY(Mod)), put(cache, []); true -> case dbg_istk:in_use_p(Mod, M) of @@ -277,7 +277,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, exit(get(self), kill), dbg_ieval:exception(exit, old_code, Bs, Ieval); false -> - erase([Mod|db]), + erase(?DB_REF_KEY(Mod)), put(cache, []) end end; diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 7ed371a653..f5e079ef7e 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -560,7 +560,7 @@ get_function(Mod, Name, Args, extern) -> end. db_ref(Mod) -> - case get([Mod|db]) of + case get(?DB_REF_KEY(Mod)) of undefined -> case dbg_iserver:call(get(int), {get_module_db, Mod, get(self)}) of @@ -572,7 +572,7 @@ db_ref(Mod) -> Node =/= node() -> {Node,ModDb}; true -> ModDb end, - put([Mod|db], DbRef), + put(?DB_REF_KEY(Mod), DbRef), DbRef end; DbRef -> diff --git a/lib/debugger/src/dbg_ieval.hrl b/lib/debugger/src/dbg_ieval.hrl index 95d0842b19..ad422a9e4a 100644 --- a/lib/debugger/src/dbg_ieval.hrl +++ b/lib/debugger/src/dbg_ieval.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,3 +27,5 @@ %% (i.e. the next call will leave interpreted code). top = false }). + +-define(DB_REF_KEY(Mod), {Mod,db}). diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 5fd1519ba0..f9c60f9b72 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -811,7 +811,7 @@ gui_show_module(Win, Mod, Line, Mod, _Pid, How) -> dbg_wx_trace_win:mark_line(Win, Line, How); gui_show_module(Win, Mod, Line, _Cm, Pid, How) -> Win2 = case dbg_wx_trace_win:is_shown(Win, Mod) of - {true, Win3} -> Win3; + %% {true, Win3} -> Win3; false -> gui_load_module(Win, Mod, Pid) end, dbg_wx_trace_win:mark_line(Win2, Line, How). diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 59d2c2b3be..50fc1d8471 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -102,21 +102,13 @@ loop(#server_state{parent = Parent} = State, send_codeserver_plt(Parent, CServer, Plt), loop(State, Analysis, ExtCalls); {AnalPid, done, Plt, DocPlt} -> - case ExtCalls =:= none of - true -> - ok; - false -> - send_ext_calls(Parent, ExtCalls) - end, + send_ext_calls(Parent, ExtCalls), send_analysis_done(Parent, Plt, DocPlt); {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); {AnalPid, ext_types, ExtTypes} -> send_ext_types(Parent, ExtTypes), loop(State, Analysis, ExtCalls); - {AnalPid, unknown_behaviours, UnknownBehaviour} -> - send_unknown_behaviours(Parent, UnknownBehaviour), - loop(State, Analysis, ExtCalls); {AnalPid, mod_deps, ModDeps} -> send_mod_deps(Parent, ModDeps), loop(State, Analysis, ExtCalls); @@ -577,6 +569,8 @@ send_analysis_done(Parent, Plt, DocPlt) -> Parent ! {self(), done, Plt, DocPlt}, ok. +send_ext_calls(_Parent, none) -> + ok; send_ext_calls(Parent, ExtCalls) -> Parent ! {self(), ext_calls, ExtCalls}, ok. @@ -585,10 +579,6 @@ send_ext_types(Parent, ExtTypes) -> Parent ! {self(), ext_types, ExtTypes}, ok. -send_unknown_behaviours(Parent, UnknownBehaviours) -> - Parent ! {self(), unknown_behaviours, UnknownBehaviours}, - ok. - send_codeserver_plt(Parent, CServer, Plt ) -> Parent ! {self(), cserver, CServer, Plt}, ok. diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 92134b7b81..50ff5304d6 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -49,8 +49,7 @@ plt_info = none :: 'none' | dialyzer_plt:plt_info(), report_mode = normal :: rep_mode(), return_status= ?RET_NOTHING_SUSPICIOUS :: dial_ret(), - stored_warnings = [] :: [raw_warning()], - unknown_behaviours = [] :: [dialyzer_behaviours:behaviour()] + stored_warnings = [] :: [raw_warning()] }). %%-------------------------------------------------------------------- @@ -638,9 +637,6 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); - {BackendPid, unknown_behaviours, Behaviours} -> - NewState = store_unknown_behaviours(State, Behaviours), - cl_loop(NewState, LogCache); {BackendPid, done, NewPlt, _NewDocPlt} -> return_value(State, NewPlt); {BackendPid, ext_calls, ExtCalls} -> @@ -683,11 +679,6 @@ format_log_cache(LogCache) -> store_warnings(#cl_state{stored_warnings = StoredWarnings} = St, Warnings) -> St#cl_state{stored_warnings = StoredWarnings ++ Warnings}. --spec store_unknown_behaviours(#cl_state{}, [dialyzer_behaviours:behaviour()]) -> #cl_state{}. - -store_unknown_behaviours(#cl_state{unknown_behaviours = Behs} = St, Beh) -> - St#cl_state{unknown_behaviours = Beh ++ Behs}. - -spec cl_error(string()) -> no_return(). cl_error(Msg) -> @@ -724,7 +715,6 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, print_warnings(State), print_ext_calls(State), print_ext_types(State), - print_unknown_behaviours(State), maybe_close_output_file(State), {RetValue, []}; true -> @@ -737,8 +727,7 @@ unknown_warnings(State = #cl_state{legal_warnings = LegalWarnings}) -> Unknown = case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of true -> unknown_functions(State) ++ - unknown_types(State) ++ - unknown_behaviours(State); + unknown_types(State); false -> [] end, WarningInfo = {_Filename = "", _Line = 0, _MorMFA = ''}, @@ -814,48 +803,6 @@ do_print_ext_types(Output, [{M,F,A}|T], Before) -> do_print_ext_types(_, [], _) -> ok. -unknown_behaviours(#cl_state{unknown_behaviours = DupBehaviours, - legal_warnings = LegalWarnings}) -> - case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) of - false -> []; - true -> - Behaviours = lists:usort(DupBehaviours), - [{unknown_behaviour, B} || B <- Behaviours] - end. - -%%print_unknown_behaviours(#cl_state{report_mode = quiet}) -> -%% ok; -print_unknown_behaviours(#cl_state{output = Output, - external_calls = Calls, - external_types = Types, - stored_warnings = Warnings, - unknown_behaviours = DupBehaviours, - legal_warnings = LegalWarnings, - output_format = Format}) -> - case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) - andalso DupBehaviours =/= [] of - false -> ok; - true -> - Behaviours = lists:usort(DupBehaviours), - case Warnings =:= [] andalso Calls =:= [] andalso Types =:= [] of - true -> io:nl(Output); %% Need to do a newline first - false -> ok - end, - {Prompt, Prefix} = - case Format of - formatted -> {"Unknown behaviours:\n"," "}; - raw -> {"%% Unknown behaviours:\n","%% "} - end, - io:put_chars(Output, Prompt), - do_print_unknown_behaviours(Output, Behaviours, Prefix) - end. - -do_print_unknown_behaviours(Output, [B|T], Before) -> - io:format(Output, "~s~p\n", [Before,B]), - do_print_unknown_behaviours(Output, T, Before); -do_print_unknown_behaviours(_, [], _) -> - ok. - print_warnings(#cl_state{stored_warnings = []}) -> ok; print_warnings(#cl_state{output = Output, diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index ce84c17f43..dd81dd01ed 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -72,9 +72,15 @@ preprocess_opts([Opt|Opts]) -> [Opt|preprocess_opts(Opts)]. postprocess_opts(Opts = #options{}) -> + check_file_existence(Opts), Opts1 = check_output_plt(Opts), adapt_get_warnings(Opts1). +check_file_existence(#options{analysis_type = plt_remove}) -> ok; +check_file_existence(#options{files = Files, files_rec = FilesRec}) -> + assert_filenames_exist(Files), + assert_filenames_exist(FilesRec). + check_output_plt(Opts = #options{analysis_type = Mode, from = From, output_plt = OutPLT}) -> case is_plt_mode(Mode) of @@ -126,14 +132,14 @@ build_options([{OptionName, Value} = Term|Rest], Options) -> apps -> OldValues = Options#options.files_rec, AppDirs = get_app_dirs(Value), - assert_filenames(Term, AppDirs), + assert_filenames_form(Term, AppDirs), build_options(Rest, Options#options{files_rec = AppDirs ++ OldValues}); files -> - assert_filenames(Term, Value), + assert_filenames_form(Term, Value), build_options(Rest, Options#options{files = Value}); files_rec -> OldValues = Options#options.files_rec, - assert_filenames(Term, Value), + assert_filenames_form(Term, Value), build_options(Rest, Options#options{files_rec = Value ++ OldValues}); analysis_type -> NewOptions = @@ -210,16 +216,26 @@ get_app_dirs(Apps) when is_list(Apps) -> get_app_dirs(Apps) -> bad_option("Use a list of otp applications", Apps). -assert_filenames(Term, [FileName|Left]) when length(FileName) >= 0 -> +assert_filenames(Term, Files) -> + assert_filenames_form(Term, Files), + assert_filenames_exist(Files). + +assert_filenames_form(Term, [FileName|Left]) when length(FileName) >= 0 -> + assert_filenames_form(Term, Left); +assert_filenames_form(_Term, []) -> + ok; +assert_filenames_form(Term, [_|_]) -> + bad_option("Malformed or non-existing filename", Term). + +assert_filenames_exist([FileName|Left]) -> case filelib:is_file(FileName) orelse filelib:is_dir(FileName) of true -> ok; - false -> bad_option("No such file, directory or application", FileName) + false -> + bad_option("No such file, directory or application", FileName) end, - assert_filenames(Term, Left); -assert_filenames(_Term, []) -> - ok; -assert_filenames(Term, [_|_]) -> - bad_option("Malformed or non-existing filename", Term). + assert_filenames_exist(Left); +assert_filenames_exist([]) -> + ok. assert_filename(FileName) when length(FileName) >= 0 -> ok; diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 634871b2eb..769f26a3df 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -137,7 +137,7 @@ delete_list(#plt{info = Info, types = Types, #plt{info = table_delete_list(Info, List), types = Types, contracts = table_delete_list(Contracts, List), - callbacks = table_delete_list(Callbacks, List), + callbacks = Callbacks, exported_types = ExpTypes}. -spec insert_contract_list(plt(), dialyzer_contracts:plt_contracts()) -> plt(). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return index 4103a2d8b4..89eb295604 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return @@ -1,2 +1,2 @@ -supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom() | tuple(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom() | tuple()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour +supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple index 5f58f69730..391c37664e 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/simple +++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple @@ -70,8 +70,8 @@ simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opaqueness simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a() simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() simple1_api.erl:503: The call 'foo':A(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() -simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() | tuple() not simple1_api:i() -simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() | tuple() not simple1_adt:i() +simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() +simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() simple1_api.erl:519: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() contains opaque terms as 1st and 2nd arguments simple1_api.erl:534: Guard test A::simple1_adt:d1() >= 3 contains an opaque term as 1st argument simple1_api.erl:536: Guard test A::simple1_adt:d1() == 3 contains an opaque term as 1st argument diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index ecbac14e5d..6ebe23b54b 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -7,12 +7,14 @@ -include("dialyzer_test_constants.hrl"). -export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1, - run_plt_check/1, run_succ_typings/1]). + local_fun_same_as_callback/1, + remove_plt/1, run_plt_check/1, run_succ_typings/1]). suite() -> [{timetrap, ?plt_timeout}]. -all() -> [build_plt, beam_tests, update_plt, run_plt_check, run_succ_typings]. +all() -> [build_plt, beam_tests, update_plt, run_plt_check, + remove_plt, run_succ_typings, local_fun_same_as_callback]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -158,6 +160,95 @@ update_plt(Config) -> {init_plt, Plt}] ++ Opts), ok. +%%% If a behaviour module contains an non-exported function with the same name +%%% as one of the behaviour's callbacks, the callback info was inadvertently +%%% deleted from the PLT as the dialyzer_plt:delete_list/2 function was cleaning +%%% up the callback table. This bug was reported by Brujo Benavides. + +local_fun_same_as_callback(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = + <<"-module(bad_behaviour). + -callback bad() -> bad. + -export([publicly_bad/0]). + + %% @doc This function is here just to avoid the 'unused' warning for bad/0 + publicly_bad() -> bad(). + + %% @doc This function overlaps with the callback with the same name, and + %% that was an issue for dialyzer since it's a private function. + bad() -> bad.">>, + {ok, Beam} = compile(Config, Prog1, bad_behaviour, []), + + ErlangBeam = case code:where_is_file("erlang.beam") of + non_existing -> + filename:join([code:root_dir(), + "erts", "preloaded", "ebin", + "erlang.beam"]); + EBeam -> + EBeam + end, + Plt = filename:join(PrivDir, "plt_bad_behaviour.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + [] = dialyzer:run([{analysis_type, plt_build}, + {files, [Beam, ErlangBeam]}, + {output_plt, Plt}] ++ Opts), + + Prog2 = + <<"-module(bad_child). + -behaviour(bad_behaviour). + + -export([bad/0]). + + %% @doc This function incorreclty implements bad_behaviour. + bad() -> not_bad.">>, + {ok, TestBeam} = compile(Config, Prog2, bad_child, []), + + [{warn_behaviour, _, + {callback_type_mismatch, + [bad_behaviour,bad,0,"'not_bad'","'bad'"]}}] = + dialyzer:run([{analysis_type, succ_typings}, + {files, [TestBeam]}, + {init_plt, Plt}] ++ Opts), + ok. + +%%% [James Fish:] +%%% Dialyzer always asserts that files and directories passed in its +%%% options exist. Therefore it is not possible to remove a beam/module +%%% from a PLT when the beam file no longer exists. Dialyzer should not to +%%% check files exist on disk when removing from the PLT. +remove_plt(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = <<"-module(m1). + -export([t/0]). + t() -> + m2:a(a).">>, + {ok, Beam1} = compile(Config, Prog1, m1, []), + + Prog2 = <<"-module(m2). + -export([a/1]). + a(A) when is_integer(A) -> A.">>, + {ok, Beam2} = compile(Config, Prog2, m2, []), + + Plt = filename:join(PrivDir, "remove.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + + [{warn_return_no_exit, _, {no_return,[only_normal,t,0]}}, + {warn_failing_call, _, {call, [m2,a,"('a')",_,_,_,_,_]}}] = + dialyzer:run([{analysis_type, plt_build}, + {files, [Beam1, Beam2]}, + {get_warnings, true}, + {output_plt, Plt}] ++ Opts), + + [] = dialyzer:run([{init_plt, Plt}, + {files, [Beam2]}, + {analysis_type, plt_remove}]), + + [] = dialyzer:run([{analysis_type, succ_typings}, + {files, [Beam1]}, + {init_plt, Plt}] ++ Opts), + ok. + compile(Config, Prog, Module, CompileOpts) -> Source = lists:concat([Module, ".erl"]), PrivDir = ?config(priv_dir,Config), diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index 220b18ca7a..bf67447ee7 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -35,6 +35,6 @@ mnesia_schema.erl:1258: Guard test FromS::'disc_copies' | 'disc_only_copies' | ' mnesia_schema.erl:1639: The pattern {'false', 'mandatory'} can never match the type {'false','optional'} mnesia_schema.erl:2434: The variable Reason can never match since previous clauses completely covered the type {'error',_} | {'ok',_} mnesia_schema.erl:451: Guard test UseDirAnyway::'false' == 'true' can never succeed -mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom() | tuple(),_}} | {'ok',_} +mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom(),_}} | {'ok',_} mnesia_tm.erl:1522: Function commit_participant/5 has no local return mnesia_tm.erl:2169: Function system_terminate/4 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/app_call b/lib/dialyzer/test/small_SUITE_data/results/app_call index cc1a63f944..1af649815a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/app_call +++ b/lib/dialyzer/test/small_SUITE_data/results/app_call @@ -1,3 +1,3 @@ -app_call.erl:6: The call M:'foo'() requires that M is of type atom() | tuple() not 42 +app_call.erl:6: The call M:'foo'() requires that M is of type atom() not 42 app_call.erl:9: The call 'mod':F() requires that F is of type atom() not {'gazonk',[]} diff --git a/lib/dialyzer/test/small_SUITE_data/results/comparisons b/lib/dialyzer/test/small_SUITE_data/results/comparisons index 642585d25e..5083d2695a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/comparisons +++ b/lib/dialyzer/test/small_SUITE_data/results/comparisons @@ -1,50 +1,43 @@ comparisons.erl:100: The pattern 'true' can never match the type 'false' -comparisons.erl:101: The pattern 'true' can never match the type 'false' +comparisons.erl:101: The pattern 'false' can never match the type 'true' comparisons.erl:102: The pattern 'false' can never match the type 'true' -comparisons.erl:103: The pattern 'false' can never match the type 'true' +comparisons.erl:103: The pattern 'true' can never match the type 'false' comparisons.erl:104: The pattern 'true' can never match the type 'false' -comparisons.erl:105: The pattern 'true' can never match the type 'false' -comparisons.erl:107: The pattern 'true' can never match the type 'false' -comparisons.erl:108: The pattern 'true' can never match the type 'false' -comparisons.erl:109: The pattern 'false' can never match the type 'true' -comparisons.erl:110: The pattern 'false' can never match the type 'true' -comparisons.erl:111: The pattern 'true' can never match the type 'false' -comparisons.erl:112: The pattern 'true' can never match the type 'false' -comparisons.erl:113: The pattern 'false' can never match the type 'true' -comparisons.erl:114: The pattern 'false' can never match the type 'true' -comparisons.erl:115: The pattern 'true' can never match the type 'false' -comparisons.erl:116: The pattern 'true' can never match the type 'false' -comparisons.erl:117: The pattern 'false' can never match the type 'true' comparisons.erl:118: The pattern 'false' can never match the type 'true' +comparisons.erl:119: The pattern 'false' can never match the type 'true' +comparisons.erl:120: The pattern 'true' can never match the type 'false' +comparisons.erl:121: The pattern 'true' can never match the type 'false' +comparisons.erl:122: The pattern 'false' can never match the type 'true' comparisons.erl:123: The pattern 'false' can never match the type 'true' -comparisons.erl:124: The pattern 'false' can never match the type 'true' +comparisons.erl:124: The pattern 'true' can never match the type 'false' comparisons.erl:125: The pattern 'true' can never match the type 'false' -comparisons.erl:126: The pattern 'true' can never match the type 'false' +comparisons.erl:126: The pattern 'false' can never match the type 'true' comparisons.erl:127: The pattern 'false' can never match the type 'true' -comparisons.erl:128: The pattern 'false' can never match the type 'true' +comparisons.erl:128: The pattern 'true' can never match the type 'false' comparisons.erl:129: The pattern 'true' can never match the type 'false' -comparisons.erl:130: The pattern 'true' can never match the type 'false' +comparisons.erl:130: The pattern 'false' can never match the type 'true' +comparisons.erl:131: The pattern 'false' can never match the type 'true' comparisons.erl:132: The pattern 'true' can never match the type 'false' comparisons.erl:133: The pattern 'true' can never match the type 'false' comparisons.erl:134: The pattern 'false' can never match the type 'true' comparisons.erl:135: The pattern 'false' can never match the type 'true' comparisons.erl:136: The pattern 'true' can never match the type 'false' comparisons.erl:137: The pattern 'true' can never match the type 'false' -comparisons.erl:138: The pattern 'false' can never match the type 'true' -comparisons.erl:139: The pattern 'false' can never match the type 'true' +comparisons.erl:139: The pattern 'true' can never match the type 'false' comparisons.erl:140: The pattern 'true' can never match the type 'false' -comparisons.erl:141: The pattern 'true' can never match the type 'false' +comparisons.erl:141: The pattern 'false' can never match the type 'true' comparisons.erl:142: The pattern 'false' can never match the type 'true' -comparisons.erl:143: The pattern 'false' can never match the type 'true' +comparisons.erl:143: The pattern 'true' can never match the type 'false' comparisons.erl:144: The pattern 'true' can never match the type 'false' -comparisons.erl:145: The pattern 'true' can never match the type 'false' +comparisons.erl:145: The pattern 'false' can never match the type 'true' comparisons.erl:146: The pattern 'false' can never match the type 'true' -comparisons.erl:147: The pattern 'false' can never match the type 'true' -comparisons.erl:152: The pattern 'false' can never match the type 'true' -comparisons.erl:153: The pattern 'false' can never match the type 'true' -comparisons.erl:154: The pattern 'true' can never match the type 'false' -comparisons.erl:155: The pattern 'true' can never match the type 'false' +comparisons.erl:147: The pattern 'true' can never match the type 'false' +comparisons.erl:148: The pattern 'true' can never match the type 'false' +comparisons.erl:149: The pattern 'false' can never match the type 'true' +comparisons.erl:150: The pattern 'false' can never match the type 'true' +comparisons.erl:155: The pattern 'false' can never match the type 'true' +comparisons.erl:156: The pattern 'false' can never match the type 'true' comparisons.erl:157: The pattern 'true' can never match the type 'false' comparisons.erl:158: The pattern 'true' can never match the type 'false' comparisons.erl:159: The pattern 'false' can never match the type 'true' @@ -59,36 +52,62 @@ comparisons.erl:167: The pattern 'false' can never match the type 'true' comparisons.erl:168: The pattern 'false' can never match the type 'true' comparisons.erl:169: The pattern 'true' can never match the type 'false' comparisons.erl:170: The pattern 'true' can never match the type 'false' -comparisons.erl:171: The pattern 'false' can never match the type 'true' -comparisons.erl:172: The pattern 'false' can never match the type 'true' +comparisons.erl:172: The pattern 'true' can never match the type 'false' comparisons.erl:173: The pattern 'true' can never match the type 'false' -comparisons.erl:174: The pattern 'true' can never match the type 'false' +comparisons.erl:174: The pattern 'false' can never match the type 'true' comparisons.erl:175: The pattern 'false' can never match the type 'true' -comparisons.erl:176: The pattern 'false' can never match the type 'true' +comparisons.erl:176: The pattern 'true' can never match the type 'false' +comparisons.erl:177: The pattern 'true' can never match the type 'false' +comparisons.erl:178: The pattern 'false' can never match the type 'true' +comparisons.erl:179: The pattern 'false' can never match the type 'true' +comparisons.erl:180: The pattern 'true' can never match the type 'false' +comparisons.erl:181: The pattern 'true' can never match the type 'false' +comparisons.erl:182: The pattern 'false' can never match the type 'true' +comparisons.erl:183: The pattern 'false' can never match the type 'true' +comparisons.erl:184: The pattern 'true' can never match the type 'false' +comparisons.erl:185: The pattern 'true' can never match the type 'false' comparisons.erl:186: The pattern 'false' can never match the type 'true' comparisons.erl:187: The pattern 'false' can never match the type 'true' -comparisons.erl:188: The pattern 'true' can never match the type 'false' -comparisons.erl:189: The pattern 'true' can never match the type 'false' -comparisons.erl:190: The pattern 'false' can never match the type 'true' -comparisons.erl:191: The pattern 'false' can never match the type 'true' -comparisons.erl:192: The pattern 'true' can never match the type 'false' -comparisons.erl:193: The pattern 'true' can never match the type 'false' -comparisons.erl:203: The pattern 'false' can never match the type 'true' -comparisons.erl:204: The pattern 'false' can never match the type 'true' +comparisons.erl:192: The pattern 'false' can never match the type 'true' +comparisons.erl:193: The pattern 'false' can never match the type 'true' +comparisons.erl:194: The pattern 'true' can never match the type 'false' +comparisons.erl:195: The pattern 'true' can never match the type 'false' +comparisons.erl:196: The pattern 'false' can never match the type 'true' +comparisons.erl:197: The pattern 'false' can never match the type 'true' +comparisons.erl:198: The pattern 'true' can never match the type 'false' +comparisons.erl:199: The pattern 'true' can never match the type 'false' +comparisons.erl:200: The pattern 'false' can never match the type 'true' +comparisons.erl:201: The pattern 'false' can never match the type 'true' +comparisons.erl:202: The pattern 'true' can never match the type 'false' +comparisons.erl:203: The pattern 'true' can never match the type 'false' comparisons.erl:205: The pattern 'true' can never match the type 'false' comparisons.erl:206: The pattern 'true' can never match the type 'false' -comparisons.erl:208: The pattern 'true' can never match the type 'false' +comparisons.erl:207: The pattern 'false' can never match the type 'true' +comparisons.erl:208: The pattern 'false' can never match the type 'true' comparisons.erl:209: The pattern 'true' can never match the type 'false' -comparisons.erl:210: The pattern 'false' can never match the type 'true' +comparisons.erl:210: The pattern 'true' can never match the type 'false' comparisons.erl:211: The pattern 'false' can never match the type 'true' +comparisons.erl:212: The pattern 'false' can never match the type 'true' +comparisons.erl:213: The pattern 'true' can never match the type 'false' +comparisons.erl:214: The pattern 'true' can never match the type 'false' +comparisons.erl:215: The pattern 'false' can never match the type 'true' +comparisons.erl:216: The pattern 'false' can never match the type 'true' +comparisons.erl:217: The pattern 'true' can never match the type 'false' +comparisons.erl:218: The pattern 'true' can never match the type 'false' +comparisons.erl:219: The pattern 'false' can never match the type 'true' +comparisons.erl:220: The pattern 'false' can never match the type 'true' comparisons.erl:221: The pattern 'true' can never match the type 'false' comparisons.erl:222: The pattern 'true' can never match the type 'false' comparisons.erl:223: The pattern 'false' can never match the type 'true' comparisons.erl:224: The pattern 'false' can never match the type 'true' -comparisons.erl:225: The pattern 'true' can never match the type 'false' -comparisons.erl:226: The pattern 'true' can never match the type 'false' -comparisons.erl:227: The pattern 'false' can never match the type 'true' -comparisons.erl:228: The pattern 'false' can never match the type 'true' +comparisons.erl:229: The pattern 'true' can never match the type 'false' +comparisons.erl:230: The pattern 'true' can never match the type 'false' +comparisons.erl:231: The pattern 'false' can never match the type 'true' +comparisons.erl:232: The pattern 'false' can never match the type 'true' +comparisons.erl:233: The pattern 'false' can never match the type 'true' +comparisons.erl:234: The pattern 'false' can never match the type 'true' +comparisons.erl:235: The pattern 'true' can never match the type 'false' +comparisons.erl:236: The pattern 'true' can never match the type 'false' comparisons.erl:242: The pattern 'false' can never match the type 'true' comparisons.erl:243: The pattern 'false' can never match the type 'true' comparisons.erl:244: The pattern 'true' can never match the type 'false' @@ -97,57 +116,86 @@ comparisons.erl:246: The pattern 'false' can never match the type 'true' comparisons.erl:247: The pattern 'false' can never match the type 'true' comparisons.erl:248: The pattern 'true' can never match the type 'false' comparisons.erl:249: The pattern 'true' can never match the type 'false' -comparisons.erl:251: The pattern 'true' can never match the type 'false' -comparisons.erl:252: The pattern 'true' can never match the type 'false' -comparisons.erl:253: The pattern 'false' can never match the type 'true' -comparisons.erl:254: The pattern 'false' can never match the type 'true' -comparisons.erl:263: The pattern 'false' can never match the type 'true' -comparisons.erl:264: The pattern 'false' can never match the type 'true' +comparisons.erl:259: The pattern 'false' can never match the type 'true' +comparisons.erl:260: The pattern 'false' can never match the type 'true' +comparisons.erl:261: The pattern 'true' can never match the type 'false' +comparisons.erl:262: The pattern 'true' can never match the type 'false' +comparisons.erl:264: The pattern 'true' can never match the type 'false' comparisons.erl:265: The pattern 'true' can never match the type 'false' -comparisons.erl:266: The pattern 'true' can never match the type 'false' -comparisons.erl:268: The pattern 'true' can never match the type 'false' -comparisons.erl:269: The pattern 'true' can never match the type 'false' -comparisons.erl:270: The pattern 'false' can never match the type 'true' -comparisons.erl:271: The pattern 'false' can never match the type 'true' -comparisons.erl:272: The pattern 'true' can never match the type 'false' -comparisons.erl:273: The pattern 'true' can never match the type 'false' -comparisons.erl:274: The pattern 'false' can never match the type 'true' -comparisons.erl:275: The pattern 'false' can never match the type 'true' -comparisons.erl:293: The pattern 'false' can never match the type 'true' -comparisons.erl:294: The pattern 'false' can never match the type 'true' -comparisons.erl:295: The pattern 'true' can never match the type 'false' -comparisons.erl:296: The pattern 'true' can never match the type 'false' -comparisons.erl:311: The pattern 'true' can never match the type 'false' -comparisons.erl:312: The pattern 'true' can never match the type 'false' -comparisons.erl:313: The pattern 'false' can never match the type 'true' -comparisons.erl:314: The pattern 'false' can never match the type 'true' -comparisons.erl:44: The pattern 'false' can never match the type 'true' -comparisons.erl:45: The pattern 'false' can never match the type 'true' -comparisons.erl:46: The pattern 'true' can never match the type 'false' -comparisons.erl:47: The pattern 'true' can never match the type 'false' -comparisons.erl:48: The pattern 'false' can never match the type 'true' -comparisons.erl:49: The pattern 'false' can never match the type 'true' -comparisons.erl:50: The pattern 'true' can never match the type 'false' -comparisons.erl:51: The pattern 'true' can never match the type 'false' +comparisons.erl:266: The pattern 'false' can never match the type 'true' +comparisons.erl:267: The pattern 'false' can never match the type 'true' +comparisons.erl:277: The pattern 'true' can never match the type 'false' +comparisons.erl:278: The pattern 'true' can never match the type 'false' +comparisons.erl:279: The pattern 'false' can never match the type 'true' +comparisons.erl:280: The pattern 'false' can never match the type 'true' +comparisons.erl:281: The pattern 'true' can never match the type 'false' +comparisons.erl:282: The pattern 'true' can never match the type 'false' +comparisons.erl:283: The pattern 'false' can never match the type 'true' +comparisons.erl:284: The pattern 'false' can never match the type 'true' +comparisons.erl:298: The pattern 'false' can never match the type 'true' +comparisons.erl:299: The pattern 'false' can never match the type 'true' +comparisons.erl:300: The pattern 'true' can never match the type 'false' +comparisons.erl:301: The pattern 'true' can never match the type 'false' +comparisons.erl:302: The pattern 'false' can never match the type 'true' +comparisons.erl:303: The pattern 'false' can never match the type 'true' +comparisons.erl:304: The pattern 'true' can never match the type 'false' +comparisons.erl:305: The pattern 'true' can never match the type 'false' +comparisons.erl:307: The pattern 'true' can never match the type 'false' +comparisons.erl:308: The pattern 'true' can never match the type 'false' +comparisons.erl:309: The pattern 'false' can never match the type 'true' +comparisons.erl:310: The pattern 'false' can never match the type 'true' +comparisons.erl:319: The pattern 'false' can never match the type 'true' +comparisons.erl:320: The pattern 'false' can never match the type 'true' +comparisons.erl:321: The pattern 'true' can never match the type 'false' +comparisons.erl:322: The pattern 'true' can never match the type 'false' +comparisons.erl:324: The pattern 'true' can never match the type 'false' +comparisons.erl:325: The pattern 'true' can never match the type 'false' +comparisons.erl:326: The pattern 'false' can never match the type 'true' +comparisons.erl:327: The pattern 'false' can never match the type 'true' +comparisons.erl:328: The pattern 'true' can never match the type 'false' +comparisons.erl:329: The pattern 'true' can never match the type 'false' +comparisons.erl:330: The pattern 'false' can never match the type 'true' +comparisons.erl:331: The pattern 'false' can never match the type 'true' +comparisons.erl:349: The pattern 'false' can never match the type 'true' +comparisons.erl:350: The pattern 'false' can never match the type 'true' +comparisons.erl:351: The pattern 'true' can never match the type 'false' +comparisons.erl:352: The pattern 'true' can never match the type 'false' +comparisons.erl:367: The pattern 'true' can never match the type 'false' +comparisons.erl:368: The pattern 'true' can never match the type 'false' +comparisons.erl:369: The pattern 'false' can never match the type 'true' +comparisons.erl:370: The pattern 'false' can never match the type 'true' comparisons.erl:52: The pattern 'false' can never match the type 'true' comparisons.erl:53: The pattern 'false' can never match the type 'true' comparisons.erl:54: The pattern 'true' can never match the type 'false' comparisons.erl:55: The pattern 'true' can never match the type 'false' +comparisons.erl:56: The pattern 'false' can never match the type 'true' +comparisons.erl:57: The pattern 'false' can never match the type 'true' +comparisons.erl:58: The pattern 'true' can never match the type 'false' +comparisons.erl:59: The pattern 'true' can never match the type 'false' +comparisons.erl:60: The pattern 'false' can never match the type 'true' +comparisons.erl:61: The pattern 'false' can never match the type 'true' +comparisons.erl:62: The pattern 'true' can never match the type 'false' +comparisons.erl:63: The pattern 'true' can never match the type 'false' +comparisons.erl:64: The pattern 'false' can never match the type 'true' +comparisons.erl:65: The pattern 'false' can never match the type 'true' +comparisons.erl:66: The pattern 'true' can never match the type 'false' +comparisons.erl:67: The pattern 'true' can never match the type 'false' +comparisons.erl:68: The pattern 'false' can never match the type 'true' comparisons.erl:69: The pattern 'false' can never match the type 'true' -comparisons.erl:70: The pattern 'false' can never match the type 'true' +comparisons.erl:70: The pattern 'true' can never match the type 'false' comparisons.erl:71: The pattern 'true' can never match the type 'false' -comparisons.erl:72: The pattern 'true' can never match the type 'false' -comparisons.erl:73: The pattern 'false' can never match the type 'true' -comparisons.erl:74: The pattern 'false' can never match the type 'true' -comparisons.erl:75: The pattern 'true' can never match the type 'false' -comparisons.erl:76: The pattern 'true' can never match the type 'false' -comparisons.erl:77: The pattern 'false' can never match the type 'true' -comparisons.erl:78: The pattern 'false' can never match the type 'true' -comparisons.erl:79: The pattern 'true' can never match the type 'false' -comparisons.erl:80: The pattern 'true' can never match the type 'false' +comparisons.erl:85: The pattern 'false' can never match the type 'true' +comparisons.erl:86: The pattern 'false' can never match the type 'true' +comparisons.erl:87: The pattern 'true' can never match the type 'false' +comparisons.erl:88: The pattern 'true' can never match the type 'false' +comparisons.erl:89: The pattern 'false' can never match the type 'true' +comparisons.erl:90: The pattern 'false' can never match the type 'true' +comparisons.erl:91: The pattern 'true' can never match the type 'false' +comparisons.erl:92: The pattern 'true' can never match the type 'false' +comparisons.erl:93: The pattern 'false' can never match the type 'true' comparisons.erl:94: The pattern 'false' can never match the type 'true' -comparisons.erl:95: The pattern 'false' can never match the type 'true' +comparisons.erl:95: The pattern 'true' can never match the type 'false' comparisons.erl:96: The pattern 'true' can never match the type 'false' -comparisons.erl:97: The pattern 'true' can never match the type 'false' +comparisons.erl:97: The pattern 'false' can never match the type 'true' comparisons.erl:98: The pattern 'false' can never match the type 'true' -comparisons.erl:99: The pattern 'false' can never match the type 'true' +comparisons.erl:99: The pattern 'true' can never match the type 'false' diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1 index 5a78d66a92..e88c91f21f 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps1 +++ b/lib/dialyzer/test/small_SUITE_data/results/maps1 @@ -1,4 +1,4 @@ maps1.erl:43: Function t3/0 has no local return maps1.erl:44: The call maps1:foo(~{'greger'=>3, ~{'arne'=>'anka'}~=>45}~,1) will never return since it differs in the 2nd argument from the success typing arguments: (#{},'b') -maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() | tuple() not #{} +maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() not #{} diff --git a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl index 70e3cb6af4..64927c6c91 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl @@ -19,12 +19,20 @@ tuple(X) when is_tuple(X) -> X. list() -> list(?r). list(X) when is_list(X) -> X. +map() -> map(?r). +map(X) when is_map(X) -> #{}. + +bitstring() -> bitstring(?r). +bitstring(X) when is_bitstring(X) -> <<0:63>>. + i() -> integer(). f() -> mfloat(). n() -> case ?r of 1 -> i(); 2 -> f() end. a() -> atom(). t() -> tuple(). l() -> list(). +m() -> map(). +b() -> bitstring(). na() -> case ?r of 1 -> n(); 2 -> a() end. at() -> case ?r of 1 -> t(); 2 -> a() end. tl() -> case ?r of 1 -> t(); 2 -> l() end. @@ -53,6 +61,14 @@ test_i_ll_l() -> case i() < l() of true -> always; false -> never end. test_i_le_l() -> case i() =< l() of true -> always; false -> never end. test_i_gg_l() -> case i() > l() of true -> never; false -> always end. test_i_ge_l() -> case i() >= l() of true -> never; false -> always end. +test_i_ll_m() -> case i() < m() of true -> always; false -> never end. +test_i_le_m() -> case i() =< m() of true -> always; false -> never end. +test_i_gg_m() -> case i() > m() of true -> never; false -> always end. +test_i_ge_m() -> case i() >= m() of true -> never; false -> always end. +test_i_ll_b() -> case i() < b() of true -> always; false -> never end. +test_i_le_b() -> case i() =< b() of true -> always; false -> never end. +test_i_gg_b() -> case i() > b() of true -> never; false -> always end. +test_i_ge_b() -> case i() >= b() of true -> never; false -> always end. test_f_ll_i() -> case f() < i() of true -> maybe; false -> maybe_too end. test_f_le_i() -> case f() =< i() of true -> maybe; false -> maybe_too end. @@ -78,6 +94,14 @@ test_f_ll_l() -> case f() < l() of true -> always; false -> never end. test_f_le_l() -> case f() =< l() of true -> always; false -> never end. test_f_gg_l() -> case f() > l() of true -> never; false -> always end. test_f_ge_l() -> case f() >= l() of true -> never; false -> always end. +test_f_ll_m() -> case f() < m() of true -> always; false -> never end. +test_f_le_m() -> case f() =< m() of true -> always; false -> never end. +test_f_gg_m() -> case f() > m() of true -> never; false -> always end. +test_f_ge_m() -> case f() >= m() of true -> never; false -> always end. +test_f_ll_b() -> case f() < b() of true -> always; false -> never end. +test_f_le_b() -> case f() =< b() of true -> always; false -> never end. +test_f_gg_b() -> case f() > b() of true -> never; false -> always end. +test_f_ge_b() -> case f() >= b() of true -> never; false -> always end. test_n_ll_i() -> case n() < i() of true -> maybe; false -> maybe_too end. test_n_le_i() -> case n() =< i() of true -> maybe; false -> maybe_too end. @@ -103,6 +127,14 @@ test_n_ll_l() -> case n() < l() of true -> always; false -> never end. test_n_le_l() -> case n() =< l() of true -> always; false -> never end. test_n_gg_l() -> case n() > l() of true -> never; false -> always end. test_n_ge_l() -> case n() >= l() of true -> never; false -> always end. +test_n_ll_m() -> case n() < m() of true -> always; false -> never end. +test_n_le_m() -> case n() =< m() of true -> always; false -> never end. +test_n_gg_m() -> case n() > m() of true -> never; false -> always end. +test_n_ge_m() -> case n() >= m() of true -> never; false -> always end. +test_n_ll_b() -> case n() < b() of true -> always; false -> never end. +test_n_le_b() -> case n() =< b() of true -> always; false -> never end. +test_n_gg_b() -> case n() > b() of true -> never; false -> always end. +test_n_ge_b() -> case n() >= b() of true -> never; false -> always end. test_a_ll_i() -> case a() < i() of true -> never; false -> always end. test_a_le_i() -> case a() =< i() of true -> never; false -> always end. @@ -128,6 +160,14 @@ test_a_ll_l() -> case a() < l() of true -> always; false -> never end. test_a_le_l() -> case a() =< l() of true -> always; false -> never end. test_a_gg_l() -> case a() > l() of true -> never; false -> always end. test_a_ge_l() -> case a() >= l() of true -> never; false -> always end. +test_a_ll_m() -> case a() < m() of true -> always; false -> never end. +test_a_le_m() -> case a() =< m() of true -> always; false -> never end. +test_a_gg_m() -> case a() > m() of true -> never; false -> always end. +test_a_ge_m() -> case a() >= m() of true -> never; false -> always end. +test_a_ll_b() -> case a() < b() of true -> always; false -> never end. +test_a_le_b() -> case a() =< b() of true -> always; false -> never end. +test_a_gg_b() -> case a() > b() of true -> never; false -> always end. +test_a_ge_b() -> case a() >= b() of true -> never; false -> always end. test_t_ll_i() -> case t() < i() of true -> never; false -> always end. test_t_le_i() -> case t() =< i() of true -> never; false -> always end. @@ -153,6 +193,14 @@ test_t_ll_l() -> case t() < l() of true -> always; false -> never end. test_t_le_l() -> case t() =< l() of true -> always; false -> never end. test_t_gg_l() -> case t() > l() of true -> never; false -> always end. test_t_ge_l() -> case t() >= l() of true -> never; false -> always end. +test_t_ll_m() -> case t() < m() of true -> always; false -> never end. +test_t_le_m() -> case t() =< m() of true -> always; false -> never end. +test_t_gg_m() -> case t() > m() of true -> never; false -> always end. +test_t_ge_m() -> case t() >= m() of true -> never; false -> always end. +test_t_ll_b() -> case t() < b() of true -> always; false -> never end. +test_t_le_b() -> case t() =< b() of true -> always; false -> never end. +test_t_gg_b() -> case t() > b() of true -> never; false -> always end. +test_t_ge_b() -> case t() >= b() of true -> never; false -> always end. test_l_ll_i() -> case l() < i() of true -> never; false -> always end. test_l_le_i() -> case l() =< i() of true -> never; false -> always end. @@ -178,6 +226,14 @@ test_l_ll_l() -> case l() < l() of true -> maybe; false -> maybe_too end. test_l_le_l() -> case l() =< l() of true -> maybe; false -> maybe_too end. test_l_gg_l() -> case l() > l() of true -> maybe; false -> maybe_too end. test_l_ge_l() -> case l() >= l() of true -> maybe; false -> maybe_too end. +test_l_ll_m() -> case l() < m() of true -> never; false -> always end. +test_l_le_m() -> case l() =< m() of true -> never; false -> always end. +test_l_gg_m() -> case l() > m() of true -> always; false -> never end. +test_l_ge_m() -> case l() >= m() of true -> always; false -> never end. +test_l_ll_b() -> case l() < b() of true -> always; false -> never end. +test_l_le_b() -> case l() =< b() of true -> always; false -> never end. +test_l_gg_b() -> case l() > b() of true -> never; false -> always end. +test_l_ge_b() -> case l() >= b() of true -> never; false -> always end. test_n_ll_na() -> case n() < na() of true -> maybe; false -> maybe_too end. test_n_le_na() -> case n() =< na() of true -> maybe; false -> maybe_too end. diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index de0f324f47..ba0e79907c 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -45,6 +45,7 @@ {"1.9.2", [{restart_application, diameter}]}, %% 17.5.5 {"1.9.2.1", [{restart_application, diameter}]}, %% 17.5.6.3 {"1.9.2.2", [{restart_application, diameter}]}, %% 17.5.6.7 + {"1.9.2.3", [{restart_application, diameter}]}, %% 17.5.6.8 {"1.10", [{load_module, diameter_codec}, %% 18.0 {load_module, diameter_peer_fsm}, {load_module, diameter_watchdog}, @@ -89,6 +90,7 @@ {"1.9.2", [{restart_application, diameter}]}, {"1.9.2.1", [{restart_application, diameter}]}, {"1.9.2.2", [{restart_application, diameter}]}, + {"1.9.2.3", [{restart_application, diameter}]}, {"1.10", [{load_module, diameter_gen_relay}, {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_base_rfc3588}, diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index b67ec31ae3..f723cd8373 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -180,7 +180,9 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> FullDesc = get_content(fullDescription, Desc), Functions = [{function_name(E), E} || E <- get_content(functions, Es)], Types = [{type_name(E), E} || E <- get_content(typedecls, Es)], - SortedFs = lists:sort(Functions), + SortedFs = if Opts#opts.sort_functions -> lists:sort(Functions); + true -> Functions + end, Body = (navigation("top") ++ [?NL, hr, ?NL, ?NL, {h1, Title}, ?NL] ++ doc_index(FullDesc, Functions, Types) @@ -204,9 +206,7 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> end ++ types(lists:sort(Types), Opts) ++ function_index(SortedFs, Opts#opts.index_columns) - ++ if Opts#opts.sort_functions -> functions(SortedFs, Opts); - true -> functions(Functions, Opts) - end + ++ functions(SortedFs, Opts) ++ [hr, ?NL] ++ navigation("bottom") ++ timestamp()), diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 6381b02393..414cb8be3e 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -601,16 +601,6 @@ struct hostent *ei_gethostbyaddr(const char *addr, int len, int type) return gethostbyaddr(addr, len, type); } -/* - * Imprecise way to select the actually available gethostbyname_r and - * gethostbyaddr_r. - * - * TODO: check this properly in configure.in - */ -#if (defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) - #define HAVE_GETHOSTBYADDR_R_8 1 -#endif - struct hostent *ei_gethostbyaddr_r(const char *addr, int length, int type, @@ -626,7 +616,7 @@ struct hostent *ei_gethostbyaddr_r(const char *addr, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); #else -#ifdef HAVE_GETHOSTBYADDR_R_8 +#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) struct hostent *result; gethostbyaddr_r(addr, length, type, hostp, buffer, buflen, &result, @@ -653,7 +643,7 @@ struct hostent *ei_gethostbyname_r(const char *name, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); #else -#ifdef HAVE_GETHOSTBYADDR_R_8 +#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__)) struct hostent *result; gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); diff --git a/lib/eunit/src/eunit_data.erl b/lib/eunit/src/eunit_data.erl index 8b53a3681d..cc002cb449 100644 --- a/lib/eunit/src/eunit_data.erl +++ b/lib/eunit/src/eunit_data.erl @@ -761,6 +761,7 @@ lazy_test_() -> lazy_gen(7), ?_assertMatch(7, get(count))]}. +-dialyzer({no_improper_lists, lazy_gen/1}). lazy_gen(N) -> {generator, fun () -> diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index d8f98cffa5..4dbe023257 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -192,6 +192,7 @@ error_msg(Title, Fmt, Args) -> io_lib:fwrite("*** ~ts ***\n~ts\n\n", [Title, Msg]). -ifdef(TEST). +-dialyzer({no_match, format_exception_test_/0}). format_exception_test_() -> [?_assertMatch( "\nymmud:rorre"++_, @@ -273,6 +274,7 @@ dlist_next([], Xs) -> -ifdef(TEST). +-dialyzer({no_match, dlist_test_/0}). dlist_test_() -> {"deep list traversal", [{"non-list term -> singleton list", @@ -338,6 +340,7 @@ is_nonempty_string([]) -> false; is_nonempty_string(Cs) -> is_string(Cs). -ifdef(TEST). +-dialyzer({no_match, is_string_test_/0}). is_string_test_() -> {"is_string", [{"no non-lists", ?_assert(not is_string($A))}, @@ -399,6 +402,7 @@ uniq([X | Xs]) -> [X | uniq(Xs)]; uniq([]) -> []. -ifdef(TEST). +-dialyzer({[no_match, no_fail_call, no_improper_lists], uniq_test_/0}). uniq_test_() -> {"uniq", [?_assertError(function_clause, uniq(ok)), @@ -459,6 +463,7 @@ normalize([]) -> -ifdef(TEST). +-dialyzer({no_match, cmd_test_/0}). cmd_test_() -> ([?_test({0, "hello\n"} = ?_cmd_("echo hello"))] ++ case os:type() of @@ -576,6 +581,7 @@ trie_match([], _T) -> -ifdef(TEST). +-dialyzer({no_match, trie_test_/0}). trie_test_() -> [{"basic representation", [?_assert(trie_new() =:= gb_trees:empty()), diff --git a/lib/eunit/src/eunit_listener.erl b/lib/eunit/src/eunit_listener.erl index ecaac424a2..d9b836863b 100644 --- a/lib/eunit/src/eunit_listener.erl +++ b/lib/eunit/src/eunit_listener.erl @@ -27,14 +27,11 @@ -export([start/1, start/2]). --export([behaviour_info/1]). - - -behaviour_info(callbacks) -> - [{init,1},{handle_begin,3},{handle_end,3},{handle_cancel,3}, - {terminate,2}]; -behaviour_info(_Other) -> - undefined. +-callback init(_) -> _. +-callback handle_begin(_, _, _) -> _. +-callback handle_end(_, _, _) -> _. +-callback handle_cancel(_, _, _) -> _. +-callback terminate(_, _) -> _. -record(state, {callback, % callback module @@ -50,18 +47,22 @@ start(Callback) -> start(Callback, Options) -> St = #state{callback = Callback}, - spawn_opt(fun () -> init(St, Options) end, + spawn_opt(init_fun(St, Options), proplists:get_all_values(spawn, Options)). -init(St0, Options) -> - St1 = call(init, [Options], St0), - St2 = expect([], undefined, St1), - Data = [{pass, St2#state.pass}, - {fail, St2#state.fail}, - {skip, St2#state.skip}, - {cancel, St2#state.cancel}], - call(terminate, [{ok, Data}, St2#state.state], St2), - exit(normal). +-spec init_fun(_, _) -> no_return(). + +init_fun(St0, Options) -> + fun () -> + St1 = call(init, [Options], St0), + St2 = expect([], undefined, St1), + Data = [{pass, St2#state.pass}, + {fail, St2#state.fail}, + {skip, St2#state.skip}, + {cancel, St2#state.cancel}], + call(terminate, [{ok, Data}, St2#state.state], St2), + exit(normal) + end. expect(Id, ParentId, St) -> case wait_for(Id, 'begin', ParentId) of diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index 98ae31d54b..8bdf94c877 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -268,6 +268,8 @@ insulator_wait(Child, Parent, Buf, St) -> kill_task(Child, St) end. +-spec kill_task(_, _) -> no_return(). + kill_task(Child, St) -> exit(Child, kill), terminate_insulator(St). diff --git a/lib/eunit/src/eunit_serial.erl b/lib/eunit/src/eunit_serial.erl index 1a0179a5df..da76064a53 100644 --- a/lib/eunit/src/eunit_serial.erl +++ b/lib/eunit/src/eunit_serial.erl @@ -61,14 +61,16 @@ messages = dict:new() :: dict:dict()}). start(Pids) -> - spawn(fun () -> serializer(Pids) end). - -serializer(Pids) -> - St = #state{listeners = sets:from_list(Pids), - cancelled = eunit_lib:trie_new(), - messages = dict:new()}, - expect([], undefined, 0, St), - exit(normal). + spawn(serializer_fun(Pids)). + +serializer_fun(Pids) -> + fun () -> + St = #state{listeners = sets:from_list(Pids), + cancelled = eunit_lib:trie_new(), + messages = dict:new()}, + expect([], undefined, 0, St), + exit(normal) + end. %% collect beginning and end of an expected item; return {Done, NewSt} %% where Done is true if there are no more items of this group diff --git a/lib/eunit/src/eunit_test.erl b/lib/eunit/src/eunit_test.erl index 9cf40a738d..62d30b1930 100644 --- a/lib/eunit/src/eunit_test.erl +++ b/lib/eunit/src/eunit_test.erl @@ -40,6 +40,7 @@ get_stacktrace() -> get_stacktrace(Ts) -> eunit_lib:uniq(prune_trace(erlang:get_stacktrace(), Ts)). +-dialyzer({no_match, prune_trace/2}). prune_trace([{eunit_data, _, _} | Rest], Tail) -> prune_trace(Rest, Tail); prune_trace([{eunit_data, _, _, _} | Rest], Tail) -> @@ -75,6 +76,7 @@ run_testfun(F) -> -ifdef(TEST). +-dialyzer({[no_match, no_fail_call, no_return], macro_test_/0}). macro_test_() -> {"macro definitions", [{?LINE, fun () -> @@ -301,6 +303,7 @@ wrapper_test_() -> ]}. %% this must be exported (done automatically by the autoexport transform) +-dialyzer({no_missing_calls, wrapper_test_exported_/0}). wrapper_test_exported_() -> {ok, ?MODULE:nonexisting_function()}. -endif. diff --git a/lib/eunit/src/eunit_tests.erl b/lib/eunit/src/eunit_tests.erl index 47ea0aaf46..5dee1cb49e 100644 --- a/lib/eunit/src/eunit_tests.erl +++ b/lib/eunit/src/eunit_tests.erl @@ -23,6 +23,8 @@ -include("eunit.hrl"). +-dialyzer(no_match). + -ifdef(TEST). id(X) -> X. % for suppressing compiler warnings -endif. diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 97b95f2e7c..ab131c2d01 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -794,9 +794,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> SL = new_label(), case SizeInfo of - {all,_NewUnit, NewAlign, S1} -> + {all, NewUnit, NewAlign, S1} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_guardop([Offset], Primop, [V, Base, Offset], SL, FL), @@ -819,9 +819,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, bitstr_gen_op([V], _Ctxt, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> case SizeInfo of - {all, _NewUnit, NewAlign, S} -> + {all, NewUnit, NewAlign, S} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_call_primop([Offset], Primop, [V, Base, Offset])], S), diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index e36643e090..7684dc4a81 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2015. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2148,7 +2148,7 @@ type_ranks(Type, I, Min, Max, [TypeClass|Rest], Opaques) -> type_order() -> [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), - t_list(), t_binary()]. + t_map(), t_list(), t_bitstr()]. key_comparisons_fail(X0, KeyPos, TupleList, Opaques) -> X = case t_is_number(t_inf(X0, t_number(), Opaques), Opaques) of @@ -2248,7 +2248,7 @@ arg_types(erlang, bit_size, 1) -> [t_bitstr()]; %% Guard bif, needs to be here. arg_types(erlang, byte_size, 1) -> - [t_binary()]; + [t_bitstr()]; arg_types(erlang, halt, 0) -> []; arg_types(erlang, halt, 1) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 14b4ba215e..fae12d7421 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -172,7 +172,6 @@ t_number_vals/1, t_number_vals/2, t_opaque_from_records/1, t_opaque_structure/1, - %% t_parameterized_module/0, t_pid/0, t_port/0, t_maybe_improper_list/0, @@ -1785,7 +1784,7 @@ t_mfa() -> -spec t_module() -> erl_type(). t_module() -> - t_sup(t_atom(), t_parameterized_module()). + t_atom(). -spec t_node() -> erl_type(). @@ -1811,11 +1810,6 @@ t_iolist(N, T) when N > 0 -> t_iolist(0, T) -> t_maybe_improper_list(t_any(), t_sup(T, t_nil())). --spec t_parameterized_module() -> erl_type(). - -t_parameterized_module() -> - t_tuple(). - -spec t_timeout() -> erl_type(). t_timeout() -> diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 0c7bdb788a..37c6ba9c60 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -881,6 +881,15 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> Dst = mk_var(Res), Temp = mk_var(new), + {FailLblName, FailCode} = + if Lbl =:= 0 -> + FailLbl = mk_label(new), + {hipe_icode:label_name(FailLbl), + [FailLbl, + hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; + true -> + {map_label(Lbl), []} + end, MultIs = case {New,Unit} of {{integer, NewInt}, _} -> @@ -890,40 +899,26 @@ trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> [hipe_icode:mk_move(Temp, NewVar)]; _ -> NewVar = mk_var(New), - if Lbl =:= 0 -> - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)])]; - true -> - Succ = mk_label(new), - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)], - hipe_icode:label_name(Succ), map_label(Lbl)), - Succ] - end + Succ = mk_label(new), + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)], + hipe_icode:label_name(Succ), FailLblName), + Succ] end, Succ2 = mk_label(new), - {FailLblName, FailCode} = - if Lbl =:= 0 -> - FailLbl = mk_label(new), - {hipe_icode:label_name(FailLbl), - [FailLbl, - hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; - true -> - {map_label(Lbl), []} - end, IsPos = [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)], hipe_icode:label_name(Succ2), FailLblName)] ++ - FailCode ++ [Succ2], - AddI = + FailCode ++ [Succ2], + AddRhs = case Old of - {integer,OldInt} -> - hipe_icode:mk_primop([Dst], '+', [Temp, hipe_icode:mk_const(OldInt)]); - _ -> - OldVar = mk_var(Old), - hipe_icode:mk_primop([Dst], '+', [Temp, OldVar]) + {integer,OldInt} -> hipe_icode:mk_const(OldInt); + _ -> mk_var(Old) end, - MultIs ++ IsPos ++ [AddI|trans_fun(Instructions, Env)]; + Succ3 = mk_label(new), + AddI = hipe_icode:mk_primop([Dst], '+', [Temp, AddRhs], + hipe_icode:label_name(Succ3), FailLblName), + MultIs ++ IsPos ++ [AddI,Succ3|trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- %% Bit syntax instructions added in R12B-5 (Fall 2008) %%-------------------------------------------------------------------- @@ -1306,7 +1301,7 @@ trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}| {Name, Args, Env2} = case Size of {atom,all} -> %% put all bits - {{bs_put_binary_all, Flags}, [Src,Base,Offset], Env}; + {{bs_put_binary_all, Unit, Flags}, [Src,Base,Offset], Env}; {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> %% Create a N*Unit bits subbinary {{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env}; diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index ffb51b2ea4..84aae30291 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -116,7 +116,7 @@ is_safe({hipe_bs_primop, {bs_init, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_binary, _, _}}) -> false; -is_safe({hipe_bs_primop, {bs_put_binary_all, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_float, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_string, _, _}}) -> false; @@ -219,7 +219,7 @@ fails({hipe_bs_primop, {bs_init, _, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_binary, _, _}}) -> true; -fails({hipe_bs_primop, {bs_put_binary_all, _}}) -> true; +fails({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_float, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_string, _, _}}) -> true; @@ -265,8 +265,8 @@ pp(Dev, Op) -> io:format(Dev, "gc_test<~w>", [N]); {hipe_bs_primop, BsOp} -> case BsOp of - {bs_put_binary_all, Flags} -> - io:format(Dev, "bs_put_binary_all<~w>", [Flags]); + {bs_put_binary_all, Unit, Flags} -> + io:format(Dev, "bs_put_binary_all<~w, ~w>", [Unit,Flags]); {bs_put_binary, Size} -> io:format(Dev, "bs_put_binary<~w>", [Size]); {bs_put_binary, Flags, Size} -> @@ -505,11 +505,13 @@ type(Primop, Args) -> NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState), if Signed =:= 0 -> - erl_types:t_product([erl_types:t_from_range(0, 1 bsl Size - 1), + UpperBound = inf_add(safe_bsl(1, Size), -1), + erl_types:t_product([erl_types:t_from_range(0, UpperBound), NewMatchState]); Signed =:= 4 -> - erl_types:t_product([erl_types:t_from_range(- (1 bsl (Size-1)), - (1 bsl (Size-1)) - 1), + erl_types:t_product([erl_types:t_from_range( + inf_inv(safe_bsl(1, Size-1)), + inf_add(safe_bsl(1, Size-1), -1)), NewMatchState]) end; [_Arg] -> @@ -628,8 +630,9 @@ type(Primop, Args) -> [_SrcType, _BitsType, _Base, Type] -> erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0)) end; - {hipe_bs_primop, {bs_put_binary_all, _Flags}} -> - [SrcType, _Base, Type] = Args, + {hipe_bs_primop, {bs_put_binary_all, Unit, _Flags}} -> + [SrcType0, _Base, Type] = Args, + SrcType = erl_types:t_inf(erl_types:t_bitstr(Unit, 0), SrcType0), erl_types:t_bitstr_concat(SrcType,Type); {hipe_bs_primop, {bs_put_string, _, Size}} -> [_Base, Type] = Args, @@ -965,3 +968,19 @@ check_fun_args(_, _) -> match_bin(Pattern, Match) -> erl_types:t_bitstr_match(Pattern, Match). + +safe_bsl(0, _) -> 0; +safe_bsl(Base, Shift) when Shift =< 128 -> Base bsl Shift; +safe_bsl(Base, _Shift) when Base > 0 -> pos_inf; +safe_bsl(Base, _Shift) when Base < 0 -> neg_inf. + +inf_inv(pos_inf) -> neg_inf; +inf_inv(neg_inf) -> pos_inf; +inf_inv(Number) -> -Number. + +inf_add(pos_inf, _Number) -> pos_inf; +inf_add(neg_inf, _Number) -> neg_inf; +inf_add(_Number, pos_inf) -> pos_inf; +inf_add(_Number, neg_inf) -> neg_inf; +inf_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> + Number1 + Number2. diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index ba5fa1bfd7..9a20527a83 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -1202,11 +1202,11 @@ basic_type(#unsafe_update_element{}) -> not_analysed. analyse_bs_get_integer(Size, Flags, true) -> Signed = Flags band 4, if Signed =:= 0 -> - Max = 1 bsl Size - 1, + Max = inf_add(inf_bsl(1, Size), -1), Min = 0; true -> - Max = 1 bsl (Size-1) - 1, - Min = -(1 bsl (Size-1)) + Max = inf_add(inf_bsl(1, Size-1), -1), + Min = inf_inv(inf_bsl(1, Size-1)) end, {Min, Max}; analyse_bs_get_integer(Size, Flags, false) when is_integer(Size), diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc index 1f455f47ed..1dff56b074 100644 --- a/lib/hipe/rtl/hipe_rtl_arith.inc +++ b/lib/hipe/rtl/hipe_rtl_arith.inc @@ -30,13 +30,13 @@ %% Returns a tuple %% {Res, Sign, Zero, Overflow, Carry} %% Res will be a number in the range -%% MAX_SIGNED_INT >= Res >= MIN_SIGNED_INT +%% MAX_UNSIGNED_INT >= Res >= 0 %% The other four values are flags that are either true or false %% eval_alu(Op, Arg1, Arg2) - when Arg1 =< ?MAX_SIGNED_INT, + when Arg1 =< ?MAX_UNSIGNED_INT, Arg1 >= ?MIN_SIGNED_INT, - Arg2 =< ?MAX_SIGNED_INT, + Arg2 =< ?MAX_UNSIGNED_INT, Arg2 >= ?MIN_SIGNED_INT -> Sign1 = sign_bit(Arg1), @@ -111,7 +111,7 @@ eval_alu(Op, Arg1, Arg2) Res = N = Z = V = C = 0, ?EXIT({"unknown alu op", Op}) end, - {two_comp_to_erl(Res), N, Z, V, C}; + {Res, N, Z, V, C}; eval_alu(Op, Arg1, Arg2) -> ?EXIT({argument_overflow,Op,Arg1,Arg2}). @@ -162,16 +162,9 @@ eval_cond(Cond, Arg1, Arg2) -> sign_bit(Val) -> ((Val bsr ?SIGN_BIT) band 1) =:= 1. -two_comp_to_erl(V) -> - if V > ?MAX_SIGNED_INT -> - - ((?MAX_UNSIGNED_INT + 1) - V); - true -> V - end. - shiftmask(Arg) -> Setbits = ?BITS - Arg, (1 bsl Setbits) - 1. zero(Val) -> Val =:= 0. - diff --git a/lib/hipe/rtl/hipe_rtl_arith_32.erl b/lib/hipe/rtl/hipe_rtl_arith_32.erl index 572556be1c..d790a8b981 100644 --- a/lib/hipe/rtl/hipe_rtl_arith_32.erl +++ b/lib/hipe/rtl/hipe_rtl_arith_32.erl @@ -24,7 +24,8 @@ %% Filename : hipe_rtl_arith_32.erl %% Module : hipe_rtl_arith_32 %% Purpose : To implement 32-bit RTL-arithmetic -%% Notes : The arithmetic works on 32-bit signed integers. +%% Notes : The arithmetic works on 32-bit signed and unsigned +%% integers. %% The implementation is taken from the implementation %% of arithmetic on SPARC. %% XXX: This code is seldom used, and hence also diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl index b549073050..9cbab08ee2 100644 --- a/lib/hipe/rtl/hipe_rtl_binary.erl +++ b/lib/hipe/rtl/hipe_rtl_binary.erl @@ -1,3 +1,4 @@ +%% -*- erlang-indent-level: 2 -*- %%% %%% %CopyrightBegin% %%% @@ -28,11 +29,20 @@ -export([gen_rtl/7]). +-export([floorlog2/1, get_word_integer/4, make_size/3, make_size/4]). + +%%-------------------------------------------------------------------- + +-define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa +-define(BYTE_SIZE, 8). + +%%-------------------------------------------------------------------- + gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) -> case type_of_operation(BsOP) of match -> {hipe_rtl_binary_match:gen_rtl( - BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; + BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; construct -> hipe_rtl_binary_construct:gen_rtl( BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) @@ -62,7 +72,7 @@ type_of_operation({bs_init,_,_}) -> construct; type_of_operation({bs_init_bits,_}) -> construct; type_of_operation({bs_init_bits,_,_}) -> construct; type_of_operation({bs_put_binary,_,_}) -> construct; -type_of_operation({bs_put_binary_all,_}) -> construct; +type_of_operation({bs_put_binary_all,_,_}) -> construct; type_of_operation({bs_put_float,_,_,_}) -> construct; type_of_operation({bs_put_integer,_,_,_}) -> construct; type_of_operation({bs_put_string,_,_}) -> construct; @@ -79,3 +89,133 @@ type_of_operation(bs_final) -> construct; type_of_operation({bs_append,_,_,_,_}) -> construct; type_of_operation({bs_private_append,_,_}) -> construct; type_of_operation(bs_init_writable) -> construct. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Small utility functions: +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +create_lbls(X) when X > 0 -> + [hipe_rtl:mk_new_label()|create_lbls(X-1)]; +create_lbls(0) -> + []. + +%%------------------------------------------------------------------------------ +%% Utilities used by both hipe_rtl_binary_construct and hipe_rtl_binary_match +%%------------------------------------------------------------------------------ + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName) -> + [EndLbl] = create_lbls(1), + EndName = hipe_rtl:label_name(EndLbl), + get_word_integer(Var, Register,SystemLimitLblName, FalseLblName, EndName, EndName, + [EndLbl]). + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName, TrueLblName, + BigLblName, Tail) -> + [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), + [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), + hipe_rtl:label_name(NotFixnumLbl), 0.99), + FixnumLbl, + hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), + hipe_rtl:label_name(SuccessLbl), FalseLblName, + 0.99), + SuccessLbl, + hipe_tagscheme:untag_fixnum(Register, Var), + hipe_rtl:mk_goto(TrueLblName), + NotFixnumLbl, + hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), + FalseLblName, SystemLimitLblName, 0.99), + BignumLbl, + hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), + hipe_rtl:mk_goto(BigLblName) | Tail]. + +make_size(UnitImm, BitsVar, FailLblName) -> + make_size(UnitImm, BitsVar, FailLblName, FailLblName). + +make_size(1, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + {get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName), DstReg}; +make_size(?BYTE_SIZE, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + [FixnumLbl, BignumLbl] = create_lbls(2), + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + FixnumLblName = hipe_rtl:label_name(FixnumLbl), + Tail = [BignumLbl, + hipe_rtl:mk_branch(DstReg, 'ltu', + hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), + FixnumLblName, OverflowLblName, 0.99), + FixnumLbl, + hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], + Code = get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName, + FixnumLblName, hipe_rtl:label_name(BignumLbl), Tail), + {Code, DstReg}; +make_size(UnitImm, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + UnitList = number2list(UnitImm), + Code = multiply_code(UnitList, BitsVar, DstReg, OverflowLblName, FalseLblName), + {Code, DstReg}. + +multiply_code(List=[Head|_Tail], Variable, Result, OverflowLblName, + FalseLblName) -> + Test = set_high(Head), + Tmp1 = hipe_rtl:mk_new_reg(), + SuccessLbl = hipe_rtl:mk_new_label(), + Register = hipe_rtl:mk_new_reg(), + Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| + get_word_integer(Variable, Register, OverflowLblName, FalseLblName)] + ++ + [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), + eq, hipe_rtl:label_name(SuccessLbl), + OverflowLblName, 0.99), + SuccessLbl], + multiply_code(List, Register, Result, OverflowLblName, Tmp1, Code). + +multiply_code([ShiftSize|Rest], Register, Result, OverflowLblName, Tmp1, + OldCode) -> + SuccessLbl = hipe_rtl:mk_new_label(), + Code = + OldCode ++ + [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), + hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, + hipe_rtl:label_name(SuccessLbl), OverflowLblName, 0.99), + SuccessLbl], + multiply_code(Rest, Register, Result, OverflowLblName, Tmp1, Code); +multiply_code([], _Register, _Result, _OverflowLblName, _Tmp1, Code) -> + Code. + +set_high(X) -> + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + set_high(min(X, WordBits), WordBits, 0). + +set_high(0, _, Y) -> + Y; +set_high(X, WordBits, Y) -> + set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). + + +number2list(X) when is_integer(X), X >= 0 -> + number2list(X, []). + +number2list(1, Acc) -> + lists:reverse([0|Acc]); +number2list(0, Acc) -> + lists:reverse(Acc); +number2list(X, Acc) -> + F = floorlog2(X), + number2list(X-(1 bsl F), [F|Acc]). + +floorlog2(X) -> + %% Double-precision floats do not have enough precision to make floorlog2 + %% exact for integers larger than 2^47. + Approx = round(math:log(X)/math:log(2)-0.5), + floorlog2_refine(X, Approx). + +floorlog2_refine(X, Approx) -> + if (1 bsl Approx) > X -> + floorlog2_refine(X, Approx - 1); + (1 bsl (Approx+1)) > X -> + Approx; + true -> + floorlog2_refine(X, Approx + 1) + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 692bad7d96..4403aa552f 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -34,6 +34,10 @@ get_field_from_term/3, set_field_from_pointer/3, get_field_from_pointer/3]). + +-import(hipe_rtl_binary, [floorlog2/1, + get_word_integer/4, + make_size/4]). %%------------------------------------------------------------------------- -include("../main/hipe.hrl"). @@ -94,10 +98,11 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab var_init_bits(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - {bs_put_binary_all, _Flags} -> + {bs_put_binary_all, Unit, _Flags} -> [Src, Base, Offset] = Args, [NewOffset] = get_real(Dst), - put_binary_all(NewOffset, Src, Base, Offset, TrueLblName, FalseLblName); + put_binary_all(NewOffset, Src, Base, Offset, Unit, + TrueLblName, FalseLblName); {bs_put_binary, Size, _Flags} -> case is_illegal_const(Size) of @@ -110,7 +115,9 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab put_static_binary(NewOffset, Src, Size, Base, Offset, TrueLblName, FalseLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), + {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TrueLblName, FalseLblName), SizeCode ++ InCode @@ -132,7 +139,9 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), + {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName), SizeCode ++ InCode @@ -161,6 +170,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab CCode, Aligned, LittleEndian, TrueLblName); [Src, Bits, Base, Offset] -> {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, @@ -209,6 +219,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab TrueLblName); [Src, Bits, Base, Offset] -> {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, @@ -293,7 +304,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [SizeReg] = create_regs(1), [Base] = create_unsafe_regs(1), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE + ?SUB_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), allocate_writable(DstVar, Base, SizeReg, Zero, Zero), hipe_rtl:mk_goto(TrueLblName)]; @@ -305,7 +316,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab SubBinSize = {sub_binary, binsize}, [get_field_from_term({sub_binary, orig}, Bin, ProcBin), get_field_from_term(SubBinSize, Bin, SubSize), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), realloc_binary(SizeReg, ProcBin, Base), calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), set_field_from_term(SubBinSize, Bin, EndSubSize), @@ -313,20 +324,21 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab hipe_rtl:mk_move(DstVar, Bin), hipe_rtl:mk_goto(TrueLblName)]; - {bs_append, _U, _F, _B, _Bla} -> + {bs_append, _U, _F, Unit, _Bla} -> [Size, Bin] = Args, [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = create_regs(5), - [ContLbl,ContLbl2,ContLbl3,WritableLbl,NotWritableLbl] = Lbls = - create_lbls(5), - [ContLblName, ContLbl2Name, ContLbl3Name, Writable, NotWritable] = + [ContLbl,ContLbl2,ContLbl3,ContLbl4,WritableLbl,NotWritableLbl] = + Lbls = create_lbls(6), + [ContLblName, ContLbl2Name, ContLbl3Name, ContLbl4Name, + Writable, NotWritable] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], Zero = hipe_rtl:mk_imm(0), SubIsWritable = {sub_binary, is_writable}, [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE + ?PROC_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), ContLbl, hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), @@ -339,17 +351,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab get_field_from_term({proc_bin, flags}, ProcBin, Flags), hipe_rtl:mk_alub(Flags, Flags, 'and', hipe_rtl:mk_imm(?PB_IS_WRITABLE), - eq, NotWritable, Writable, 0.01), + eq, NotWritable, ContLbl4Name, 0.01), + ContLbl4, + calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), + is_divisible(Offset, Unit, Writable, FalseLblName), WritableLbl, set_field_from_term(SubIsWritable, Bin, Zero), realloc_binary(SizeReg, ProcBin, Base), - calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), hipe_tagscheme:mk_sub_binary(DstVar, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin), hipe_rtl:mk_goto(TrueLblName), NotWritableLbl, - not_writable_code(Bin, SizeReg, DstVar, Base, Offset, + not_writable_code(Bin, SizeReg, DstVar, Base, Offset, Unit, TrueLblName, FalseLblName)] end, {Code, ConstTab} @@ -361,7 +375,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -not_writable_code(Bin, SizeReg, Dst, Base, Offset, +not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, TrueLblName, FalseLblName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize, TotSize, TotBytes, UsedBytes] = create_regs(5), @@ -372,13 +386,13 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS), hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(UsedBytes, TotBytes, sll, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_branch(UsedBytes, ge, hipe_rtl:mk_imm(256), + hipe_rtl:mk_branch(UsedBytes, geu, hipe_rtl:mk_imm(256), AllLblName, IncLblName), IncLbl, hipe_rtl:mk_move(UsedBytes, hipe_rtl:mk_imm(256)), AllLbl, allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize), - put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), + put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), Unit, TrueLblName, FalseLblName)]. allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> @@ -397,16 +411,6 @@ allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> hipe_tagscheme:mk_sub_binary(Dst, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin)]. -check_and_untag_fixnum(Size, SizeReg, FalseLblName) -> - [ContLbl,NextLbl] = Lbls = create_lbls(2), - [ContLblName,NextLblName] = get_label_names(Lbls), - [hipe_tagscheme:test_fixnum(Size, ContLblName, FalseLblName, 0.99), - ContLbl, - hipe_tagscheme:untag_fixnum(SizeReg,Size), - hipe_rtl:mk_branch(SizeReg, ge, hipe_rtl:mk_imm(0), NextLblName, - FalseLblName), - NextLbl]. - realloc_binary(SizeReg, ProcBin, Base) -> [NoReallocLbl, ReallocLbl, NextLbl, ContLbl] = Lbls = create_lbls(4), [NoReallocLblName, ReallocLblName, NextLblName, ContLblName] = @@ -428,7 +432,7 @@ realloc_binary(SizeReg, ProcBin, Base) -> set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), get_field_from_term(ProcBinValTag, ProcBin, BinPointer), get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), - hipe_rtl:mk_branch(OrigSize, 'lt', ResultingSize, + hipe_rtl:mk_branch(OrigSize, 'ltu', ResultingSize, ReallocLblName, NoReallocLblName), NoReallocLbl, get_field_from_term(ProcBinBytesTag, ProcBin, Base), @@ -669,14 +673,14 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName WordSize = hipe_rtl_arch:word_size(), [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4), [USize,Tmp] = create_unsafe_regs(2), - [get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), + [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE), + hipe_rtl:label_name(ContLbl), + SystemLimitLblName), ContLbl, hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), - hipe_rtl:label_name(HeapLbl), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_rtl:mk_alu(Tmp, USize, add, hipe_rtl:mk_imm(3*WordSize-1)), @@ -694,8 +698,8 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:mk_goto(TrueLblName)]. var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> - [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl,ContLbl, - NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(10), + [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl, + NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(9), [USize,ByteSize,TotByteSize,OffsetBits] = create_regs(4), [TmpDst] = create_unsafe_regs(1), Log2WordSize = hipe_rtl_arch:log2_word_size(), @@ -705,7 +709,7 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl ?PROC_BIN_WORDSIZE) + ?SUB_BIN_WORDSIZE, Zero = hipe_rtl:mk_imm(0), [hipe_rtl:mk_gctest(MaximumWords), - get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), + get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_alu(ByteSize, USize, srl, ?BYTE_SHIFT), hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(NoSubLbl), @@ -716,11 +720,7 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl SubLbl, hipe_rtl:mk_alu(TotByteSize, ByteSize, 'add', hipe_rtl:mk_imm(1)), JoinLbl, - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), - ContLbl, - hipe_rtl:mk_branch(TotByteSize, 'le', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:mk_branch(TotByteSize, 'leu', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, @@ -743,13 +743,16 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_move(Dst, TmpDst), hipe_rtl:mk_goto(TrueLblName)]. -put_binary_all(NewOffset, Src, Base, Offset, TLName, FLName) -> +put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> [SrcBase,SrcOffset,NumBits] = create_regs(3), + [ContLbl] = create_lbls(1), CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName), AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, NewOffset, TLName), - get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName) ++ - test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode). + [get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName), + is_divisible(NumBits, Unit, hipe_rtl:label_name(ContLbl), FLName), + ContLbl + |test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode)]. test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> [Tmp] = create_regs(1), @@ -976,7 +979,7 @@ copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) small_check(SizeVar, CopySize, FalseLblName) -> SuccessLbl = hipe_rtl:mk_new_label(), - [hipe_rtl:mk_branch(SizeVar, le, CopySize, + [hipe_rtl:mk_branch(SizeVar, leu, CopySize, hipe_rtl:label_name(SuccessLbl), FalseLblName), SuccessLbl]. @@ -1279,89 +1282,18 @@ copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) -> hipe_tagscheme:test_flonum(Src, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99) ++ [SuccessLbl|copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, pass)]. -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - Code = - first_part(BitsVar, DstReg, FalseLblName) ++ - [hipe_rtl:mk_alu(DstReg, DstReg, 'sll', ?BYTE_SHIFT)], - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - 'eq', hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = OldCode ++ [hipe_rtl:mk_alu(Tmp1, Register, 'sll', - hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - set_high(X, 0). - -set_high(0, Y) -> - Y; -set_high(X, Y) -> - set_high(X-1, Y+(1 bsl (27-X))). - -get_32_bit_value(Size, USize, SystemLimitLblName, NegLblName) -> - Lbls = [FixLbl, BigLbl, OkLbl, PosBigLbl] = create_lbls(4), - [FixLblName, BigLblName, OkLblName, PosBigLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], - [hipe_tagscheme:test_fixnum(Size, FixLblName, BigLblName, 0.99), - FixLbl, - hipe_tagscheme:untag_fixnum(USize, Size), - hipe_rtl:mk_branch(USize, ge, hipe_rtl:mk_imm(0), OkLblName, NegLblName), - BigLbl, - hipe_tagscheme:test_pos_bignum(Size, PosBigLblName, NegLblName, 0.99), - PosBigLbl, - hipe_tagscheme:get_one_word_pos_bignum(USize, Size, SystemLimitLblName), - OkLbl]. - - -first_part(Var, Register, FalseLblName) -> - [SuccessLbl1, SuccessLbl2] = create_lbls(2), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1), - FalseLblName, 0.99), - SuccessLbl1, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99), - SuccessLbl2, - hipe_tagscheme:untag_fixnum(Register, Var)]. - - +is_divisible(_Dividend, 1, SuccLbl, _FailLbl) -> + [hipe_rtl:mk_goto(SuccLbl)]; +is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> + Log2 = floorlog2(Divisor), + case Divisor =:= 1 bsl Log2 of + true -> %% Divisor is a power of 2 + %% Test that the Log2-1 lowest bits are clear + Mask = hipe_rtl:mk_imm(Divisor - 1), + [Tmp] = create_regs(1), + [hipe_rtl:mk_alub(Tmp, Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)]; + false -> + %% We need division, fall back to a primop + [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)], + SuccLbl, FailLbl, not_remote)] + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index cf1b8e453f..be4c35dae0 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -31,11 +31,12 @@ -import(hipe_tagscheme, [set_field_from_term/3, get_field_from_term/3]). +-import(hipe_rtl_binary, [make_size/3]). + -include("hipe_literals.hrl"). %%-------------------------------------------------------------------- --define(MAX_BINSIZE, trunc(?MAX_HEAP_BIN_SIZE / hipe_rtl_arch:word_size()) + 2). -define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa -define(LOW_BITS, 7). %% Three lowest bits set -define(BYTE_SIZE, 8). @@ -835,10 +836,10 @@ create_lbls(0) -> create_lbls(X) when X > 0 -> [hipe_rtl:mk_new_label()|create_lbls(X-1)]. -make_dyn_prep(SizeReg, CCode) -> +make_dyn_prep(SizeReg, CCode) -> [CLbl, SuccessLbl] = create_lbls(2), - Init = [hipe_rtl:mk_branch(SizeReg, le, hipe_rtl:mk_imm(?MAX_SMALL_BITS), - hipe_rtl:label_name(SuccessLbl), + Init = [hipe_rtl:mk_branch(SizeReg, leu, hipe_rtl:mk_imm(?MAX_SMALL_BITS), + hipe_rtl:label_name(SuccessLbl), hipe_rtl:label_name(CLbl)), SuccessLbl], End = [CLbl|CCode], @@ -883,8 +884,8 @@ get_unaligned_int_to_reg(Reg, Size, Base, Offset, LowBits, Shiftr, Type) -> hipe_rtl:mk_imm((WordSize-MinLoad)*?BYTE_SIZE))]; {_, WordSize} -> UnsignedBig = {unsigned, big}, - [hipe_rtl:mk_branch(TotBits, le, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), - hipe_rtl:label_name(LessLbl), + [hipe_rtl:mk_branch(TotBits, leu, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), + hipe_rtl:label_name(LessLbl), hipe_rtl:label_name(MoreLbl)), LessLbl, load_bytes(LoadDst, Base, ByteOffset, Type, MinLoad), @@ -944,7 +945,7 @@ get_big_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), load_bytes(LoadDst, Base, ByteOffset, Type, 1), BackLbl, - hipe_rtl:mk_branch(ByteOffset, le, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, leu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -973,8 +974,8 @@ get_little_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(Limit, Tmp, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), hipe_rtl:mk_move(ShiftReg, hipe_rtl:mk_imm(0)), BackLbl, - hipe_rtl:mk_branch(ByteOffset, lt, Limit, - hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, ltu, Limit, + hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(DoneLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -1090,7 +1091,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl]; little -> @@ -1102,7 +1103,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> hipe_rtl:mk_load(Tmp1, Base, TmpOffset, byte, Signedness), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, TmpOffset, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, TmpOffset, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl, hipe_rtl:mk_move(Offset, Limit)] @@ -1118,103 +1119,5 @@ create_gcsafe_regs(X) when X > 0 -> create_gcsafe_regs(0) -> []. -first_part(Var, Register, FalseLblName) -> - [EndLbl] = create_lbls(1), - EndName = hipe_rtl:label_name(EndLbl), - first_part(Var, Register, FalseLblName, EndName, EndName, [EndLbl]). - -first_part(Var, Register, FalseLblName, TrueLblName, BigLblName, Tail) -> - [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), - hipe_rtl:label_name(NotFixnumLbl), 0.99), - FixnumLbl, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl), FalseLblName, - 0.99), - SuccessLbl, - hipe_tagscheme:untag_fixnum(Register, Var), - hipe_rtl:mk_goto(TrueLblName), - NotFixnumLbl, - %% Since binaries are not allowed to be larger than 2^wordsize bits - %% and since bignum digits are words, we know that a bignum with an - %% arity larger than one can't match. - hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), - FalseLblName, 0.99), - BignumLbl, - hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), - hipe_rtl:mk_goto(BigLblName) | Tail]. - -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - [FixnumLbl, BignumLbl] = create_lbls(2), - WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, - FixnumLblName = hipe_rtl:label_name(FixnumLbl), - Tail = [BignumLbl, - hipe_rtl:mk_branch(DstReg, 'ltu', - hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), - FixnumLblName, FalseLblName, 0.99), - FixnumLbl, - hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], - Code = first_part(BitsVar, DstReg, FalseLblName, FixnumLblName, - hipe_rtl:label_name(BignumLbl), Tail), - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - eq, hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = - OldCode ++ - [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, - hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, - set_high(min(X, WordBits), WordBits, 0). - -set_high(0, _, Y) -> - Y; -set_high(X, WordBits, Y) -> - set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). - is_illegal_const(Const) -> Const >= 1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE) orelse Const < 0. diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index d77078acb6..8825a3ade3 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -42,7 +42,7 @@ test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4, test_binary/4, test_bitstr/4, test_list/4, test_map/4, test_integer/4, test_number/4, test_tuple_N/5, - test_pos_bignum_arity/5]). + test_pos_bignum_arity/6]). -export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]). -export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3, unsafe_fixnum_sub/3, @@ -351,14 +351,23 @@ test_pos_bignum(X, TrueLab, FalseLab, Pred) -> mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, TrueLab, FalseLab, Pred)]. -test_pos_bignum_arity(X, Arity, TrueLab, FalseLab, Pred) -> +test_pos_bignum_arity(X, Arity, TrueLab, NotPosBignumLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), - HalfTrueLab = hipe_rtl:mk_new_label(), + BoxedLab = hipe_rtl:mk_new_label(), HeaderImm = hipe_rtl:mk_imm(mk_header(Arity, ?TAG_HEADER_POS_BIG)), - [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred), - HalfTrueLab, - get_header(Tmp, X), - hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. + [test_is_boxed(X, hipe_rtl:label_name(BoxedLab), NotPosBignumLab, Pred), + BoxedLab, + get_header(Tmp, X)] ++ + case NotPosBignumLab =:= FalseLab of + true -> []; + false -> + BignumLab = hipe_rtl:mk_new_label(), + BigMask = ?TAG_HEADER_MASK, + [mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, + hipe_rtl:label_name(BignumLab), NotPosBignumLab, Pred), + BignumLab] + end ++ + [hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. test_matchstate(X, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), diff --git a/lib/hipe/test/bs_SUITE_data/bs_add.erl b/lib/hipe/test/bs_SUITE_data/bs_add.erl index af5a3b2f23..4b92e6b413 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_add.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_add.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------------- %% The guard in f/3 revealed a problem in the translation of the 'bs_add' %% BEAM instruction to Icode. The fail label was not properly translated. -%% Fixed 3/2/2011. +%% Fixed 3/2/2011. Then in 2015 we found another issue: g/2. Also fixed. %%------------------------------------------------------------------------- -module(bs_add). @@ -10,9 +10,17 @@ test() -> 42 = f(<<12345:16>>, 4711, <<42>>), + true = g(<<1:13>>, 3), %% was handled OK, but + false = g(<<>>, gurka), %% this one leaked badarith ok. f(Bin, A, B) when <<A:9, B:7/binary>> == Bin -> gazonk; f(Bin, _, _) when is_binary(Bin) -> 42. + +%% Complex way of testing (bit_size(Bin) + Len) rem 8 =:= 0 +g(Bin, Len) when is_binary(<<Bin/binary-unit:1, 123:Len>>) -> + true; +g(_, _) -> + false. diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 37a54c1981..b9e7d93570 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -14,6 +14,11 @@ test() -> 16#10000008 = bit_size(large_bin(1, 2, 3, 4)), ok = bad_ones(), ok = zero_width(), + ok = not_used(), + ok = bad_append(), + ok = system_limit(), + ok = bad_floats(), + ok = huge_binaries(), ok. %%-------------------------------------------------------------------- @@ -142,3 +147,159 @@ zero_width() -> ok. id(X) -> X. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. The test checks that constructed +%% binaries that are not used would still give a `badarg' exception. +%% Problem was that in native code one of them gave `badarith'. + +not_used() -> + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(42, "dum_string")), + {'EXIT',{badarg,_}} = (catch not_used2(666, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(666, "bad_size")), % this one + {'EXIT',{badarg,_}} = (catch not_used3(666)), + ok. + +not_used1(I, BinString) -> + <<I:32,BinString/binary>>, + ok. + +not_used2(I, Sz) -> + <<I:Sz>>, + ok. + +not_used3(I) -> + <<I:(-8)>>, + ok. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +bad_append() -> + do_bad_append(<<127:1>>, fun append_unit_3/1), + do_bad_append(<<127:2>>, fun append_unit_3/1), + do_bad_append(<<127:17>>, fun append_unit_3/1), + + do_bad_append(<<127:3>>, fun append_unit_4/1), + do_bad_append(<<127:5>>, fun append_unit_4/1), + do_bad_append(<<127:7>>, fun append_unit_4/1), + do_bad_append(<<127:199>>, fun append_unit_4/1), + + do_bad_append(<<127:7>>, fun append_unit_8/1), + do_bad_append(<<127:9>>, fun append_unit_8/1), + + do_bad_append(<<0:8>>, fun append_unit_16/1), + do_bad_append(<<0:15>>, fun append_unit_16/1), + do_bad_append(<<0:17>>, fun append_unit_16/1), + ok. + +do_bad_append(Bin0, Appender) -> + {'EXIT',{badarg,_}} = (catch Appender(Bin0)), + + Bin1 = id(<<0:3,Bin0/bitstring>>), + <<_:3,Bin2/bitstring>> = Bin1, + {'EXIT',{badarg,_}} = (catch Appender(Bin2)), + + %% Create a writable binary. + Empty = id(<<>>), + Bin3 = <<Empty/bitstring,Bin0/bitstring>>, + {'EXIT',{badarg,_}} = (catch Appender(Bin3)), + ok. + +append_unit_3(Bin) -> + <<Bin/binary-unit:3,0:1>>. + +append_unit_4(Bin) -> + <<Bin/binary-unit:4,0:1>>. + +append_unit_8(Bin) -> + <<Bin/binary,0:1>>. + +append_unit_16(Bin) -> + <<Bin/binary-unit:16,0:1>>. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +system_limit() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + + %% The size would be silently truncated, resulting in a crash. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), + ok. + +%%-------------------------------------------------------------------- + +bad_floats() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{badarg,_}} = (catch <<3.14:(id(33))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id(64 bor 32))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id((1 bsl 28) bor 32))/float>>), + {'EXIT',{system_limit,_}} = (catch <<3.14:(id(1 bsl BitsPerWord))/float>>), + ok. + +%%-------------------------------------------------------------------- +%% A bug in the implementation of binaries compared sizes in bits with sizes in +%% bytes, causing <<0:(id((1 bsl 31)-1))>> to fail to construct with +%% 'system_limit'. +%% <<0:(id((1 bsl 32)-1))>> was succeeding because the comparison was +%% (incorrectly) signed. + +huge_binaries() -> + AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), + case erlang:system_info(wordsize) of + 4 -> huge_binaries_32(AlmostIllegal); + 8 -> ok + end, + garbage_collect(), + id(<<0:(id((1 bsl 31)-1))>>), + id(<<0:(id((1 bsl 30)-1))>>), + garbage_collect(), + ok. + +huge_binaries_32(AlmostIllegal) -> + %% Attempt construction of too large binary using bs_init/1 (which takes the + %% number of bytes as an argument, which should be compared to the maximum + %% size in bytes). + {'EXIT',{system_limit,_}} = (catch <<0:32,AlmostIllegal/binary>>), + %% Attempt construction of too large binary using bs_init/1 with a size in + %% bytes that has the msb set (and would be negative if it was signed). + {'EXIT',{system_limit,_}} = + (catch <<0:8, AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary>>), + ok. diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index e4a6f8f748..85663b5ded 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -101,7 +101,8 @@ request(Url, Profile) -> %% {ok, {StatusLine, Headers, Body}} | {ok, {Status, Body}} | %% {ok, RequestId} | {error,Reason} | {ok, {saved_as, FilePath} %% -%% Method - atom() = head | get | put | post | trace | options| delete +%% Method - atom() = head | get | put | patch | post | trace | +%% options | delete %% Request - {Url, Headers} | {Url, Headers, ContentType, Body} %% Url - string() %% HTTPOptions - [HttpOption] @@ -176,8 +177,8 @@ request(Method, request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) - when ((Method =:= post) orelse (Method =:= put) orelse (Method =:= delete)) andalso - (is_atom(Profile) orelse is_pid(Profile)) -> + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse + (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> ?hcrt("request", [{method, Method}, {url, Url}, {headers, Headers}, diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl index e4451401f4..af4c3f75f2 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -187,7 +187,8 @@ is_client_closing(Headers) -> %%% Internal functions %%%======================================================================== post_data(Method, Headers, {ContentType, Body}, HeadersAsIs) - when (Method =:= post) orelse (Method =:= put) -> + when (Method =:= post) orelse (Method =:= put) + orelse (Method =:= patch) -> NewBody = case Headers#http_request_h.expect of "100-continue" -> ""; diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index abcc0ce898..749f58c197 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -86,7 +86,8 @@ body_data(Headers, Body) -> %%------------------------------------------------------------------------- %% validate(Method, Uri, Version) -> ok | {error, {bad_request, Reason} | %% {error, {not_supported, {Method, Uri, Version}} -%% Method = "HEAD" | "GET" | "POST" | "TRACE" | "PUT" | "DELETE" +%% Method = "HEAD" | "GET" | "POST" | "PATCH" | "TRACE" | "PUT" +%% | "DELETE" %% Uri = uri() %% Version = "HTTP/N.M" %% Description: Checks that HTTP-request-line is valid. @@ -105,6 +106,8 @@ validate("DELETE", Uri, "HTTP/1." ++ _N) -> validate_uri(Uri); validate("POST", Uri, "HTTP/1." ++ _N) -> validate_uri(Uri); +validate("PATCH", Uri, "HTTP/1." ++ _N) -> + validate_uri(Uri); validate("TRACE", Uri, "HTTP/1." ++ N) when hd(N) >= $1 -> validate_uri(Uri); validate(Method, Uri, Version) -> diff --git a/lib/inets/src/http_server/mod_cgi.erl b/lib/inets/src/http_server/mod_cgi.erl index 25d9f05028..ec8b9be32e 100644 --- a/lib/inets/src/http_server/mod_cgi.erl +++ b/lib/inets/src/http_server/mod_cgi.erl @@ -337,6 +337,8 @@ script_elements(#mod{method = "GET"}, {PathInfo, QueryString}) -> [{query_string, QueryString}, {path_info, PathInfo}]; script_elements(#mod{method = "POST", entity_body = Body}, _) -> [{entity_body, Body}]; +script_elements(#mod{method = "PATCH", entity_body = Body}, _) -> + [{entity_body, Body}]; script_elements(#mod{method = "PUT", entity_body = Body}, _) -> [{entity_body, Body}]; script_elements(_, _) -> diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 967bd6bbf3..2978ac9095 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -282,6 +282,15 @@ erl(#mod{request_uri = ReqUri, ?NICE("Erl mechanism doesn't support method DELETE")}}| Data]}; +erl(#mod{request_uri = ReqUri, + method = "PATCH", + http_version = Version, + data = Data}, _ESIBody, _Modules) -> + ?hdrt("erl", [{method, patch}]), + {proceed, [{status,{501,{"PATCH", ReqUri, Version}, + ?NICE("Erl mechanism doesn't support method PATCH")}}| + Data]}; + erl(#mod{method = "POST", entity_body = Body} = ModData, ESIBody, Modules) -> ?hdrt("erl", [{method, post}]), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index c6c59ab1af..93b96e101f 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -68,6 +68,7 @@ real_requests()-> get, post, post_stream, + patch, async, pipeline, persistent_connection, @@ -257,6 +258,28 @@ post(Config) when is_list(Config) -> "text/plain", "foobar"}, [], []). %%-------------------------------------------------------------------- +patch() -> + [{"Test http patch request against local server. We do in this case " + "only care about the client side of the the patch. The server " + "script will not actually use the patch data."}]. +patch(Config) when is_list(Config) -> + CGI = case test_server:os_type() of + {win32, _} -> + "/cgi-bin/cgi_echo.exe"; + _ -> + "/cgi-bin/cgi_echo" + end, + + URL = url(group_name(Config), CGI, Config), + + %% Cgi-script expects the body length to be 100 + Body = lists:duplicate(100, "1"), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(patch, {URL, [{"expect","100-continue"}], + "text/plain", Body}, [], []). + +%%-------------------------------------------------------------------- post_stream() -> [{"Test streaming http post request against local server. " "We only care about the client side of the the post. " diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml index a0132db8db..311e0d8ea4 100644 --- a/lib/kernel/doc/src/net_kernel.xml +++ b/lib/kernel/doc/src/net_kernel.xml @@ -63,11 +63,16 @@ <funcs> <func> <name name="allow" arity="1"/> - <fsummary>Limit access to a specified set of nodes</fsummary> + <fsummary>Permit access to a specified set of nodes</fsummary> <desc> - <p>Limits access to the specified set of nodes. Any access - attempts made from (or to) nodes not in <c><anno>Nodes</anno></c> will be - rejected.</p> + <p>Permits access to the specified set of nodes.</p> + <p>Before the first call to <c>allow/1</c>, any node with the correct + cookie can be connected. When <c>allow/1</c> is called, a list + of allowed nodes is established. Any access attempts made from (or to) + nodes not in that list will be rejected.</p> + <p>Subsequent calls to <c>allow/1</c> will add the specified nodes + to the list of allowed nodes. It is not possible to remove nodes + from the list.</p> <p>Returns <c>error</c> if any element in <c><anno>Nodes</anno></c> is not an atom.</p> </desc> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 682d4a2eac..165160a909 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -37,6 +37,7 @@ use these functions can be of help in enabling a program to run on most platforms.</p> </description> + <funcs> <func> <name name="cmd" arity="1"/> @@ -210,6 +211,30 @@ format_utc_timestamp() -> </desc> </func> <func> + <name name="perf_counter" arity="0"/> + <fsummary>Returns a performance counter</fsummary> + <desc> + <p>Returns the current performance counter value in <c>perf_counter</c> + <seealso marker="erts:erlang#type_time_unit">time unit</seealso>. + This is a highly optimized call that might not be traceable. + </p> + </desc> + </func> + <func> + <name name="perf_counter" arity="1"/> + <fsummary>Returns a performance counter</fsummary> + <desc><p>Returns a performance counter that can be used as a very fast and + high resolution timestamp. This counter is read directly from the hardware or operating + system with the same guarantees. This means that two consecutive calls + to the function are not guaranteed to be monotonic, though it most likely will be. + The performance counter till be converted to the resolution passed as an argument.</p> + <pre>1> <input>T1 = os:perf_counter(1000),receive after 10000 -> ok end,T2 = os:perf_counter(1000).</input> +176525861 +2> <input>T2 - T1.</input> +10004</pre> + </desc> + </func> + <func> <name name="type" arity="0"/> <fsummary>Return the OS family and, in some cases, OS name of the current operating system</fsummary> <desc> diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index 3439111035..f4fcd222ec 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -127,6 +127,35 @@ seq_trace:set_token(OldToken), % activate the trace token again enables/disables a timestamp to be generated for each traced event. Default is <c>false</c>.</p> </item> + <tag><c>set_token(strict_monotonic_timestamp, <anno>Bool</anno>)</c></tag> + <item> + <p>A trace token flag (<c>true | false</c>) which + enables/disables a strict monotonic timestamp to be generated + for each traced event. Default is <c>false</c>. Timestamps will + consist of + <seealso marker="erts:time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> and a monotonically increasing + integer. The time-stamp has the same format and value + as produced by <c>{erlang:monotonic_time(nano_seconds), + erlang:unique_integer([monotonic])}</c>.</p> + </item> + <tag><c>set_token(monotonic_timestamp, <anno>Bool</anno>)</c></tag> + <item> + <p>A trace token flag (<c>true | false</c>) which + enables/disables a strict monotonic timestamp to be generated + for each traced event. Default is <c>false</c>. Timestamps + will use + <seealso marker="erts:time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. The time-stamp has the same + format and value as produced by + <c>erlang:monotonic_time(nano_seconds)</c>.</p> + </item> + <p>If multiple timestamp flags are passed, <c>timestamp</c> has + precedence over <c>strict_monotonic_timestamp</c> which + in turn has precedence over <c>monotonic_timestamp</c>. All + timestamp flags are remembered, so if two are passed + and the one with highest precedence later is disabled + the other one will become active.</p> </taglist> </desc> </func> diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index 9b9fd086f1..2e61363aa6 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -79,6 +79,7 @@ log(FdC, FileName, X) -> logl(X) -> logl(X, [], 0). +-dialyzer({no_improper_lists, logl/3}). logl([X | T], Bs, Size) -> Sz = byte_size(X), BSz = <<Sz:?SIZESZ/unit:8>>, @@ -1142,6 +1143,7 @@ write_index_file(read_write, FName, NewFile, OldFile, OldCnt) -> file_error(FileName, E) end. +-dialyzer({no_improper_lists, to_8_bytes/4}). to_8_bytes(<<N:32,T/binary>>, NT, FileName, Fd) -> to_8_bytes(T, [NT | <<N:64>>], FileName, Fd); to_8_bytes(B, NT, _FileName, _Fd) when byte_size(B) =:= 0 -> @@ -1276,6 +1278,7 @@ ext_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, ext_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, ext_split_bins/6}). ext_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> NBs = Bs + byte_size(X), if @@ -1296,6 +1299,7 @@ int_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, int_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, int_split_bins/6}). int_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> Sz = byte_size(X), NBs = Bs + Sz + ?HEADERSZ, diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index 464b6919f1..137fad706f 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -265,6 +265,7 @@ do_cycle_port_program(Caller, Parent, Port, Cmd) -> send_heart_beat(Port) -> Port ! {self(), {command, [?HEART_BEAT]}}. %% Set a new HEART_COMMAND. +-dialyzer({no_improper_lists, send_heart_cmd/2}). send_heart_cmd(Port, []) -> Port ! {self(), {command, [?CLEAR_CMD]}}; send_heart_cmd(Port, Cmd) -> diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index b5555ca1a5..419dc0a2fc 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -116,6 +116,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-7.0", "stdlib-2.6", "sasl-2.6"]} + {runtime_dependencies, ["erts-7.3", "stdlib-2.6", "sasl-2.6"]} ] }. diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 0022959c11..4947088635 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -27,7 +27,9 @@ %%% BIFs --export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, system_time/0, system_time/1, +-export([getenv/0, getenv/1, getenv/2, getpid/0, + perf_counter/0, perf_counter/1, + putenv/2, system_time/0, system_time/1, timestamp/0, unsetenv/1]). -spec getenv() -> [string()]. @@ -60,6 +62,18 @@ getenv(VarName, DefaultValue) -> getpid() -> erlang:nif_error(undef). +-spec perf_counter() -> Counter when + Counter :: integer(). + +perf_counter() -> + erlang:nif_error(undef). + +-spec perf_counter(Unit) -> integer() when + Unit :: erlang:time_unit(). + +perf_counter(Unit) -> + erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit). + -spec putenv(VarName, Value) -> true when VarName :: string(), Value :: string(). diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index 07ccd3e494..a7a782c29c 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -23,7 +23,9 @@ -define(SEQ_TRACE_SEND, 1). %(1 << 0) -define(SEQ_TRACE_RECEIVE, 2). %(1 << 1) -define(SEQ_TRACE_PRINT, 4). %(1 << 2) --define(SEQ_TRACE_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4) +-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5) -export([set_token/1, set_token/2, @@ -37,7 +39,7 @@ %%--------------------------------------------------------------------------- --type flag() :: 'send' | 'receive' | 'print' | 'timestamp'. +-type flag() :: 'send' | 'receive' | 'print' | 'timestamp' | 'monotonic_timestamp' | 'strict_monotonic_timestamp'. -type component() :: 'label' | 'serial' | flag(). -type value() :: (Integer :: non_neg_integer()) | {Previous :: non_neg_integer(), @@ -135,5 +137,9 @@ decode_flags(Flags) -> Print = (Flags band ?SEQ_TRACE_PRINT) > 0, Send = (Flags band ?SEQ_TRACE_SEND) > 0, Rec = (Flags band ?SEQ_TRACE_RECEIVE) > 0, - Ts = (Flags band ?SEQ_TRACE_TIMESTAMP) > 0, - [{print,Print},{send,Send},{'receive',Rec},{timestamp,Ts}]. + NowTs = (Flags band ?SEQ_TRACE_NOW_TIMESTAMP) > 0, + StrictMonTs = (Flags band ?SEQ_TRACE_STRICT_MON_TIMESTAMP) > 0, + MonTs = (Flags band ?SEQ_TRACE_MON_TIMESTAMP) > 0, + [{print,Print},{send,Send},{'receive',Rec},{timestamp,NowTs}, + {strict_monotonic_timestamp, StrictMonTs}, + {monotonic_timestamp, MonTs}]. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index ca3c53ff93..b794d4f45e 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -559,6 +559,7 @@ put_int16(N, Tail) -> %% is sent back to the process sending the request. This command was added in %% OTP 18 to make sure that data sent from io:format is actually printed %% to the console before the vm stops when calling erlang:halt(integer()). +-dialyzer({no_improper_lists, io_command/1}). io_command({put_chars_sync, unicode,Cs,Reply}) -> {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply}; io_command({put_chars, unicode,Cs}) -> diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl index e9ff79af19..72b00e22da 100644 --- a/lib/kernel/test/erl_prim_loader_SUITE.erl +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -133,14 +133,8 @@ inet_existing(doc) -> ["Start a node using the 'inet' loading method, ", "from an already started boot server."]; inet_existing(Config) when is_list(Config) -> Name = erl_prim_test_inet_existing, - Host = host(), - Cookie = atom_to_list(erlang:get_cookie()), - IpStr = ip_str(Host), - LFlag = get_loader_flag(os:type()), - Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - {ok, BootPid} = erl_boot_server:start_link([Host]), - {ok, Node} = start_node(Name, Args), + BootPid = start_boot_server(), + Node = start_node_using_inet(Name), {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), stop_node(Node), unlink(BootPid), @@ -151,19 +145,11 @@ inet_coming_up(doc) -> ["Start a node using the 'inet' loading method, ", "but start the boot server afterwards."]; inet_coming_up(Config) when is_list(Config) -> Name = erl_prim_test_inet_coming_up, - Cookie = atom_to_list(erlang:get_cookie()), - Host = host(), - IpStr = ip_str(Host), - LFlag = get_loader_flag(os:type()), - Args = LFlag ++ - " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - {ok, Node} = start_node(Name, Args, [{wait, false}]), + Node = start_node_using_inet(Name, [{wait,false}]), %% Wait a while, then start boot server, and wait for node to start. test_server:sleep(test_server:seconds(6)), - io:format("erl_boot_server:start_link([~p]).", [Host]), - {ok, BootPid} = erl_boot_server:start_link([Host]), + BootPid = start_boot_server(), wait_really_started(Node, 25), %% Check loader argument, then cleanup. @@ -191,24 +177,19 @@ inet_disconnects(Config) when is_list(Config) -> true -> {skip,"erl_boot_server is native"}; false -> - ?line Name = erl_prim_test_inet_disconnects, - ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), - ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, + Name = erl_prim_test_inet_disconnects, - ?line {ok, BootPid} = erl_boot_server:start([Host]), + BootPid = start_boot_server(), + unlink(BootPid), Self = self(), %% This process shuts down the boot server during loading. - ?line Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end), - ?line receive - {Stopper,ready} -> ok - end, + Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end), + receive + {Stopper,ready} -> ok + end, %% Let the loading begin... - ?line {ok, Node} = start_node(Name, Args, [{wait, false}]), + Node = start_node_using_inet(Name, [{wait,false}]), %% When the stopper is ready, the slave node should be %% looking for a boot server again. @@ -222,12 +203,12 @@ inet_disconnects(Config) when is_list(Config) -> end, %% Start new boot server to see that loading is continued. - ?line {ok, BootPid2} = erl_boot_server:start_link([Host]), - ?line wait_really_started(Node, 25), - ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), - ?line stop_node(Node), - ?line unlink(BootPid2), - ?line exit(BootPid2, kill), + BootPid2 = start_boot_server(), + wait_really_started(Node, 25), + {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), + stop_node(Node), + unlink(BootPid2), + exit(BootPid2, kill), ok end. @@ -262,11 +243,8 @@ multiple_slaves(doc) -> multiple_slaves(Config) when is_list(Config) -> ?line Name = erl_prim_test_multiple_slaves, ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, + Args = " -loader inet -hosts " ++ IpStr, NoOfNodes = 10, % no of slave nodes to be started @@ -286,7 +264,7 @@ multiple_slaves(Config) when is_list(Config) -> %% long for this test to work). ?line test_server:sleep(test_server:seconds(5)), %% start the code loading circus! - ?line {ok,BootPid} = erl_boot_server:start_link([Host]), + BootPid = start_boot_server(), %% give the nodes a chance to boot up before attempting to stop them ?line test_server:sleep(test_server:seconds(10)), @@ -362,20 +340,6 @@ file_requests(Config) when is_list(Config) -> ?line exit(BootPid, kill), ok. -complete_start_node(Name) -> - ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), - ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - - ?line {ok,BootPid} = erl_boot_server:start_link([Host]), - - ?line {ok,Node} = start_node(Name, Args), - ?line wait_really_started(Node, 25), - {ok, Node, BootPid}. - local_archive(suite) -> []; local_archive(doc) -> @@ -554,7 +518,37 @@ virtual_dir_in_archive(Config) when is_list(Config) -> ?line ok = file:delete(Archive), ok. -%% Misc. functions +%%% +%%% Helper functions. +%%% + +complete_start_node(Name) -> + BootPid = start_boot_server(), + Node = start_node_using_inet(Name), + wait_really_started(Node, 25), + {ok, Node, BootPid}. + +start_boot_server() -> + %% Many linux systems define: + %% 127.0.0.1 localhost + %% 127.0.1.1 somehostname + %% Therefore, to allow the tests to work on those kind of systems, + %% also include "localhost" in the list of allowed hosts. + + Hosts = [host(),ip_str("localhost")], + {ok,BootPid} = erl_boot_server:start_link(Hosts), + BootPid. + +start_node_using_inet(Name) -> + start_node_using_inet(Name, []). + +start_node_using_inet(Name, Opts) -> + Host = host(), + IpStr = ip_str(Host), + Args = " -loader inet -hosts " ++ IpStr, + {ok,Node} = start_node(Name, Args, Opts), + Node. + ip_str({A, B, C, D}) -> lists:concat([A, ".", B, ".", C, ".", D]); @@ -580,9 +574,6 @@ host() -> stop_node(Node) -> test_server:stop_node(Node). -get_loader_flag(_) -> - " -loader inet ". - compile_app(TopDir, AppName) -> AppDir = filename:join([TopDir, AppName]), SrcDir = filename:join([AppDir, "src"]), diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 83a95019e7..e6e8568394 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -20,10 +20,11 @@ -module(os_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2]). -export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1, find_executable/1, unix_comment_in_command/1, deep_list_command/1, - large_output_command/1]). + large_output_command/1, perf_counter_api/1]). -include_lib("test_server/include/test_server.hrl"). @@ -32,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command, find_executable, unix_comment_in_command, deep_list_command, - large_output_command]. + large_output_command, perf_counter_api]. groups() -> []. @@ -49,6 +50,11 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(_TC,Config) -> + Config. + +end_per_testcase(_,_Config) -> + ok. space_in_cwd(doc) -> "Test that executing a command in a current working directory " @@ -278,6 +284,40 @@ large_output_command(Config) when is_list(Config) -> AAA = lists:duplicate(7000, $a), comp(AAA,os:cmd("echo " ++ AAA)). +%% Test that the os:perf_counter api works as expected +perf_counter_api(_Config) -> + + true = is_integer(os:perf_counter()), + true = os:perf_counter() > 0, + + T1 = os:perf_counter(), + timer:sleep(100), + T2 = os:perf_counter(), + TsDiff = erlang:convert_time_unit(T2 - T1, perf_counter, nano_seconds), + ct:pal("T1: ~p~n" + "T2: ~p~n" + "TsDiff: ~p~n", + [T1,T2,TsDiff]), + + %% We allow a 15% diff + true = TsDiff < 115000000, + true = TsDiff > 85000000, + + T1Ms = os:perf_counter(1000), + timer:sleep(100), + T2Ms = os:perf_counter(1000), + MsDiff = T2Ms - T1Ms, + ct:pal("T1Ms: ~p~n" + "T2Ms: ~p~n" + "MsDiff: ~p~n", + [T1Ms,T2Ms,MsDiff]), + + %% We allow a 15% diff + true = MsDiff < 115, + true = MsDiff > 85. + +%% Util functions + comp(Expected, Got) -> case strip_nl(Got) of Expected -> diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 7df0bc3d2f..6a63f7bc9c 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -35,6 +35,11 @@ %-define(line_trace, 1). -include_lib("test_server/include/test_server.hrl"). +-define(TIMESTAMP_MODES, [no_timestamp, + timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]). + -define(default_timeout, ?t:minutes(1)). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -75,6 +80,17 @@ end_per_testcase(_Case, Config) -> token_set_get(doc) -> []; token_set_get(suite) -> []; token_set_get(Config) when is_list(Config) -> + do_token_set_get(timestamp), + do_token_set_get(monotonic_timestamp), + do_token_set_get(strict_monotonic_timestamp). + +do_token_set_get(TsType) -> + io:format("Testing ~p~n", [TsType]), + Flags = case TsType of + timestamp -> 15; + strict_monotonic_timestamp -> 23; + monotonic_timestamp -> 39 + end, ?line Self = self(), ?line seq_trace:reset_trace(), %% Test that initial seq_trace is disabled @@ -88,22 +104,22 @@ token_set_get(Config) when is_list(Config) -> ?line {send,true} = seq_trace:get_token(send), ?line false = seq_trace:set_token('receive',true), ?line {'receive',true} = seq_trace:get_token('receive'), - ?line false = seq_trace:set_token(timestamp,true), - ?line {timestamp,true} = seq_trace:get_token(timestamp), + ?line false = seq_trace:set_token(TsType,true), + ?line {TsType,true} = seq_trace:get_token(TsType), %% Check the whole token - ?line {15,17,0,Self,0} = seq_trace:get_token(), % all flags are set + ?line {Flags,17,0,Self,0} = seq_trace:get_token(), % all flags are set %% Test setting and reading the 'serial' field ?line {0,0} = seq_trace:set_token(serial,{3,5}), ?line {serial,{3,5}} = seq_trace:get_token(serial), %% Check the whole token, test that a whole token can be set and get - ?line {15,17,5,Self,3} = seq_trace:get_token(), - ?line seq_trace:set_token({15,19,7,Self,5}), - ?line {15,19,7,Self,5} = seq_trace:get_token(), + ?line {Flags,17,5,Self,3} = seq_trace:get_token(), + ?line seq_trace:set_token({Flags,19,7,Self,5}), + ?line {Flags,19,7,Self,5} = seq_trace:get_token(), %% Check that receive timeout does not reset token ?line receive after 0 -> ok end, - ?line {15,19,7,Self,5} = seq_trace:get_token(), + ?line {Flags,19,7,Self,5} = seq_trace:get_token(), %% Check that token can be unset - ?line {15,19,7,Self,5} = seq_trace:set_token([]), + ?line {Flags,19,7,Self,5} = seq_trace:set_token([]), ?line [] = seq_trace:get_token(), %% Check that Previous serial counter survived unset token ?line 0 = seq_trace:set_token(label, 17), @@ -139,30 +155,42 @@ tracer_set_get(Config) when is_list(Config) -> print(doc) -> []; print(suite) -> []; print(Config) when is_list(Config) -> + lists:foreach(fun do_print/1, ?TIMESTAMP_MODES). + +do_print(TsType) -> ?line start_tracer(), - ?line seq_trace:set_token(print,true), + ?line set_token_flags([print, TsType]), ?line seq_trace:print(0,print1), ?line seq_trace:print(1,print2), ?line seq_trace:print(print3), ?line seq_trace:reset_trace(), - ?line [{0,{print,_,_,[],print1}}, - {0,{print,_,_,[],print3}}] = stop_tracer(2). + ?line [{0,{print,_,_,[],print1}, Ts0}, + {0,{print,_,_,[],print3}, Ts1}] = stop_tracer(2), + check_ts(TsType, Ts0), + check_ts(TsType, Ts1). send(doc) -> []; send(suite) -> []; send(Config) when is_list(Config) -> + lists:foreach(fun do_send/1, ?TIMESTAMP_MODES). + +do_send(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send, TsType]), ?line Receiver ! send, ?line Self = self(), ?line seq_trace:reset_trace(), - ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1). + ?line [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). distributed_send(doc) -> []; distributed_send(suite) -> []; distributed_send(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_send/1, ?TIMESTAMP_MODES). + +do_distributed_send(TsType) -> ?line {ok,Node} = start_node(seq_trace_other,[]), ?line {_,Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -170,30 +198,39 @@ distributed_send(Config) when is_list(Config) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send,TsType]), ?line Receiver ! send, ?line Self = self(), ?line seq_trace:reset_trace(), ?line stop_node(Node), - ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1). + ?line [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). + recv(doc) -> []; recv(suite) -> []; recv(Config) when is_list(Config) -> + lists:foreach(fun do_recv/1, ?TIMESTAMP_MODES). + +do_recv(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token('receive',true), + ?line set_token_flags(['receive',TsType]), ?line Receiver ! 'receive', %% let the other process receive the message: ?line receive after 1 -> ok end, ?line Self = self(), ?line seq_trace:reset_trace(), - ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = stop_tracer(1). + ?line [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). distributed_recv(doc) -> []; distributed_recv(suite) -> []; distributed_recv(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_recv/1, ?TIMESTAMP_MODES). + +do_distributed_recv(TsType) -> ?line {ok,Node} = start_node(seq_trace_other,[]), ?line {_,Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -201,7 +238,7 @@ distributed_recv(Config) when is_list(Config) -> ?line seq_trace:reset_trace(), ?line rpc:call(Node,?MODULE,start_tracer,[]), ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token('receive',true), + ?line set_token_flags(['receive',TsType]), ?line Receiver ! 'receive', %% let the other process receive the message: ?line receive after 1 -> ok end, @@ -210,16 +247,20 @@ distributed_recv(Config) when is_list(Config) -> ?line Result = rpc:call(Node,?MODULE,stop_tracer,[1]), ?line stop_node(Node), ?line ok = io:format("~p~n",[Result]), - ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = Result. + ?line [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = Result, + check_ts(TsType, Ts). trace_exit(doc) -> []; trace_exit(suite) -> []; trace_exit(Config) when is_list(Config) -> + lists:foreach(fun do_trace_exit/1, ?TIMESTAMP_MODES). + +do_trace_exit(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn_link(?MODULE, one_time_receiver, [exit]), ?line process_flag(trap_exit, true), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send, TsType]), ?line Receiver ! {before, exit}, %% let the other process receive the message: ?line receive @@ -233,13 +274,18 @@ trace_exit(Config) when is_list(Config) -> ?line Result = stop_tracer(2), ?line seq_trace:reset_trace(), ?line ok = io:format("~p~n", [Result]), - ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}}, + ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}, Ts0}, {0, {send, {1,2}, Receiver, Self, - {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result. + {'EXIT', Receiver, {exit, {before, exit}}}}, Ts1}] = Result, + check_ts(TsType, Ts0), + check_ts(TsType, Ts1). distributed_exit(doc) -> []; distributed_exit(suite) -> []; distributed_exit(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_exit/1, ?TIMESTAMP_MODES). + +do_distributed_exit(TsType) -> ?line {ok, Node} = start_node(seq_trace_other, []), ?line {_, Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -248,7 +294,7 @@ distributed_exit(Config) when is_list(Config) -> ?line rpc:call(Node, ?MODULE, start_tracer,[]), ?line Receiver = spawn_link(Node, ?MODULE, one_time_receiver, [exit]), ?line process_flag(trap_exit, true), - ?line seq_trace:set_token(send, true), + ?line set_token_flags([send, TsType]), ?line Receiver ! {before, exit}, %% let the other process receive the message: ?line receive @@ -264,7 +310,8 @@ distributed_exit(Config) when is_list(Config) -> ?line stop_node(Node), ?line ok = io:format("~p~n", [Result]), ?line [{0, {send, {1, 2}, Receiver, Self, - {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result. + {'EXIT', Receiver, {exit, {before, exit}}}}, Ts}] = Result, + check_ts(TsType, Ts). call(doc) -> "Tests special forms {is_seq_trace} and {get_seq_token} " @@ -361,14 +408,22 @@ port(doc) -> "Send trace messages to a port."; port(suite) -> []; port(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> do_port(TsType, Config) end, + ?TIMESTAMP_MODES). + +do_port(TsType, Config) -> + io:format("Testing ~p~n",[TsType]), ?line Port = load_tracer(Config), ?line seq_trace:set_system_tracer(Port), - ?line seq_trace:set_token(print, true), + ?line set_token_flags([print, TsType]), ?line Small = [small,term], ?line seq_trace:print(0, Small), ?line case get_port_message(Port) of - {seq_trace,0,{print,_,_,[],Small}} -> + {seq_trace,0,{print,_,_,[],Small}} when TsType == no_timestamp -> + ok; + {seq_trace,0,{print,_,_,[],Small},Ts0} when TsType /= no_timestamp -> + check_ts(TsType, Ts0), ok; Other -> ?line seq_trace:reset_trace(), @@ -382,7 +437,10 @@ port(Config) when is_list(Config) -> ?line seq_trace:print(0, OtherSmall), ?line seq_trace:reset_trace(), ?line case get_port_message(Port) of - {seq_trace,0,{print,_,_,[],OtherSmall}} -> + {seq_trace,0,{print,_,_,[],OtherSmall}} when TsType == no_timestamp -> + ok; + {seq_trace,0,{print,_,_,[],OtherSmall}, Ts1} when TsType /= no_timestamp -> + check_ts(TsType, Ts1), ok; Other1 -> ?line ?t:fail({unexpected,Other1}) @@ -399,6 +457,8 @@ port(Config) when is_list(Config) -> Other2 -> ?line ?t:fail({unexpected,Other2}) end, + unlink(Port), + exit(Port,kill), ok. get_port_message(Port) -> @@ -734,7 +794,7 @@ simple_tracer(Data, DN) -> {seq_trace,Label,Info,Ts} -> simple_tracer([{Label,Info,Ts}|Data], DN+1); {seq_trace,Label,Info} -> - simple_tracer([{Label,Info}|Data], DN+1); + simple_tracer([{Label,Info, no_timestamp}|Data], DN+1); {stop,N,From} when DN >= N -> From ! {tracerlog,lists:reverse(Data)} end. @@ -759,7 +819,55 @@ start_tracer() -> seq_trace:set_system_tracer(Pid), Pid. - + +set_token_flags([]) -> + ok; +set_token_flags([no_timestamp|Flags]) -> + seq_trace:set_token(timestamp, false), + seq_trace:set_token(monotonic_timestamp, false), + seq_trace:set_token(strict_monotonic_timestamp, false), + set_token_flags(Flags); +set_token_flags([Flag|Flags]) -> + seq_trace:set_token(Flag, true), + set_token_flags(Flags). + +check_ts(no_timestamp, Ts) -> + try + no_timestamp = Ts + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(timestamp, Ts) -> + try + {Ms,S,Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(monotonic_timestamp, Ts) -> + try + true = is_integer(Ts) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(strict_monotonic_timestamp, Ts) -> + try + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok. start_node(Name, Param) -> test_server:start_node(Name, slave, [{args, Param}]). diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 02c175760e..69ccc1d2c9 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -78,7 +78,7 @@ change_table_majority/1, del_active_replica/2, wait_for_tables/2, - get_network_copy/2, + get_network_copy/3, merge_schema/0, start_remote_sender/4, schedule_late_disc_load/2 @@ -329,14 +329,14 @@ release_schema_commit_lock() -> unlink(whereis(?SERVER_NAME)). %% Special for preparation of add table copy -get_network_copy(Tab, Cs) -> +get_network_copy(Tid, Tab, Cs) -> % We can't let the controller queue this one % because that may cause a deadlock between schema_operations % and initial tableloadings which both takes schema locks. % But we have to get copier_done msgs when the other side % goes down. call({add_other, self()}), - Reason = {dumper,add_table_copy}, + Reason = {dumper,{add_table_copy, Tid}}, Work = #net_load{table = Tab,reason = Reason,cstruct = Cs}, %% I'll need this cause it's linked trough the subscriber %% might be solved by using monitor in subscr instead. @@ -775,7 +775,7 @@ handle_call({net_load, Tab, Cs}, From, State) -> true -> Worker = #net_load{table = Tab, opt_reply_to = From, - reason = {dumper,add_table_copy}, + reason = {dumper,{add_table_copy, unknown}}, cstruct = Cs }, add_worker(Worker, State); @@ -1180,11 +1180,11 @@ handle_info(Done = #loader_done{worker_pid=WPid, table_name=Tab}, State0) -> Done#loader_done.needs_announce == true, Done#loader_done.needs_reply == true -> i_have_tab(Tab), - %% Should be {dumper,add_table_copy} only + %% Should be {dumper,{add_table_copy, _}} only reply(Done#loader_done.reply_to, Done#loader_done.reply); Done#loader_done.needs_reply == true -> - %% Should be {dumper,add_table_copy} only + %% Should be {dumper,{add_table_copy,_}} only reply(Done#loader_done.reply_to, Done#loader_done.reply); Done#loader_done.needs_announce == true, Tab == schema -> @@ -2148,6 +2148,10 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl reply_to = ReplyTo, reply = {loaded, ok} }, + AddTableCopy = case Reason of + {dumper,{add_table_copy,_}} -> true; + _ -> false + end, if ReadNode == node() -> %% Already loaded locally @@ -2157,7 +2161,7 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl Res = mnesia_loader:disc_load_table(Tab, load_local_content), Done#loader_done{reply = Res, needs_announce = true, needs_sync = true} end; - AccessMode == read_only, Reason /= {dumper,add_table_copy} -> + AccessMode == read_only, not AddTableCopy -> fun() -> disc_load_table(Tab, Reason, ReplyTo) end; true -> fun() -> diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index da8549be50..41fcd76fcb 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -180,8 +180,7 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_only_copies - -define(MAX_RAM_TRANSFERS, (?MAX_RAM_FILE_SIZE div ?MAX_TRANSFER_SIZE) + 1). -define(MAX_NOPACKETS, 20). -net_load_table(Tab, Reason, Ns, Cs) - when Reason == {dumper,add_table_copy} -> +net_load_table(Tab, {dumper,{add_table_copy, _}}=Reason, Ns, Cs) -> try_net_load_table(Tab, Reason, Ns, Cs); net_load_table(Tab, Reason, Ns, _Cs) -> try_net_load_table(Tab, Reason, Ns, val({Tab, cstruct})). @@ -233,7 +232,8 @@ do_snmpify(Tab, Us, Storage) -> set({Tab, {index, snmp}}, Snmp). %% Start the recieiver -init_receiver(Node, Tab, Storage, Cs, Reas={dumper,add_table_copy}) -> +init_receiver(Node, Tab, Storage, Cs, Reas={dumper,{add_table_copy, Tid}}) -> + rpc:call(Node, mnesia_lib, set, [{?MODULE, active_trans}, Tid]), case start_remote_sender(Node, Tab, Storage) of {SenderPid, TabSize, DetsData} -> start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,Reas); @@ -307,7 +307,7 @@ table_init_fun(SenderPid) -> end. %% Add_table_copy get's it's own locks. -start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,add_table_copy}) -> +start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,{add_table_copy,_}}) -> Init = table_init_fun(SenderPid), case do_init_table(Tab,Storage,Cs,SenderPid,TabSize,DetsData,self(), Init) of Err = {error, _} -> @@ -658,9 +658,10 @@ send_table(Pid, Tab, RemoteS) -> {Init, Chunk} = reader_funcs(UseDetsChunk, Tab, Storage, KeysPerTransfer), SendIt = fun() -> - {atomic, ok} = prepare_copy(Pid, Tab, Storage), + NeedLock = need_lock(Tab), + {atomic, ok} = prepare_copy(Pid, Tab, Storage, NeedLock), send_more(Pid, 1, Chunk, Init(), Tab), - finish_copy(Pid, Tab, Storage, RemoteS) + finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) end, try SendIt() of @@ -678,10 +679,10 @@ send_table(Pid, Tab, RemoteS) -> end end. -prepare_copy(Pid, Tab, Storage) -> +prepare_copy(Pid, Tab, Storage, NeedLock) -> Trans = fun() -> - mnesia:lock_table(Tab, load), + NeedLock andalso mnesia:lock_table(Tab, load), mnesia_subscr:subscribe(Pid, {table, Tab}), update_where_to_write(Tab, node(Pid)), mnesia_lib:db_fixtable(Storage, Tab, true), @@ -689,6 +690,21 @@ prepare_copy(Pid, Tab, Storage) -> end, mnesia:transaction(Trans). + +need_lock(Tab) -> + case ?catch_val({?MODULE, active_trans}) of + #tid{} = Tid -> + %% move_table_copy grabs it's own table-lock + %% do not deadlock with it + mnesia_lib:unset({?MODULE, active_trans}), + case mnesia_locker:get_held_locks(Tab) of + [{write, Tid}|_] -> false; + _Locks -> true + end; + _ -> + true + end. + update_where_to_write(Tab, Node) -> case val({Tab, access_mode}) of read_only -> @@ -783,12 +799,12 @@ send_packet(N, Pid, Chunk, {Recs, Cont}) when N < ?MAX_NOPACKETS -> send_packet(_N, _Pid, _Chunk, DataState) -> DataState. -finish_copy(Pid, Tab, Storage, RemoteS) -> +finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) -> RecNode = node(Pid), DatBin = dat2bin(Tab, Storage, RemoteS), Trans = fun() -> - mnesia:read_lock_table(Tab), + NeedLock andalso mnesia:read_lock_table(Tab), A = val({Tab, access_mode}), mnesia_controller:sync_and_block_table_whereabouts(Tab, RecNode, RemoteS, A), cleanup_tab_copier(Pid, Storage, Tab), diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 89feeba2c3..5766f22e92 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -22,7 +22,7 @@ -module(mnesia_locker). -export([ - get_held_locks/0, + get_held_locks/0, get_held_locks/1, get_lock_queue/0, global_lock/5, ixrlock/5, @@ -236,6 +236,11 @@ loop(State) -> From ! {Ref, ok}, loop(State); + {From, {is_locked, Oid}} -> + Held = ?ets_lookup(mnesia_held_locks, Oid), + reply(From, Held), + loop(State); + {'EXIT', Pid, _} when Pid == State#state.supervisor -> do_stop(); @@ -1151,6 +1156,19 @@ get_held_locks() -> Locks = receive {mnesia_held_locks, Ls} -> Ls after 5000 -> [] end, rewrite_locks(Locks, []). +%% Mnesia internal usage only +get_held_locks(Tab) when is_atom(Tab) -> + Oid = {Tab, ?ALL}, + ?MODULE ! {self(), {is_locked, Oid}}, + receive + {?MODULE, _Node, Locks} -> + case Locks of + [] -> []; + [{Oid, _Prev, What}] -> What + end + end. + + rewrite_locks([{Oid, _, Ls}|Locks], Acc0) -> Acc = rewrite_locks(Ls, Oid, Acc0), rewrite_locks(Locks, Acc); diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index 8313c3bda5..081d746257 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -82,9 +82,9 @@ going_down = [], tm_started = false, early_connects = [], connecting, mq = [], remote_node_status = []}). --define(current_protocol_version, {8,1}). +-define(current_protocol_version, {8,2}). --define(previous_protocol_version, {8,0}). +-define(previous_protocol_version, {8,1}). start() -> gen_server:start_link({local, ?MODULE}, ?MODULE, @@ -193,7 +193,7 @@ protocol_version() -> %% A sorted list of acceptable protocols the %% preferred protocols are first in the list acceptable_protocol_versions() -> - [protocol_version(), ?previous_protocol_version, {7,6}]. + [protocol_version(), ?previous_protocol_version]. needs_protocol_conversion(Node) -> case {?catch_val({protocol, Node}), protocol_version()} of @@ -424,8 +424,6 @@ handle_call({negotiate_protocol, Mon, Version, Protocols}, From, State) case hd(Protocols) of ?previous_protocol_version -> accept_protocol(Mon, MyVersion, ?previous_protocol_version, From, State); - {7,6} -> - accept_protocol(Mon, MyVersion, {7,6}, From, State); _ -> verbose("Connection with ~p rejected. " "version = ~p, protocols = ~p, " diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 593360415d..782493fb4f 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -646,54 +646,18 @@ cs2list(Cs) when is_record(Cs, cstruct) -> rec2list(Tags, Tags, 2, Cs); cs2list(CreateList) when is_list(CreateList) -> CreateList; -%% 4.6 + +%% since 4.6 cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> Tags = [name,type,ram_copies,disc_copies,disc_only_copies, load_order,access_mode,majority,index,snmp,local_content, record_name,attributes, user_properties,frag_properties,storage_properties, cookie,version], - rec2list(Tags, Tags, 2, Cs); -%% 4.4.19 -cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Tags, 2, Cs); -%% 4.4.18 and earlier -cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], rec2list(Tags, Tags, 2, Cs). cs2list(false, Cs) -> - cs2list(Cs); -cs2list(ver4_4_18, Cs) -> %% Or earlier - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs); -cs2list(ver4_4_19, Cs) -> - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs); -cs2list(ver4_6, Cs) -> - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes, - user_properties,frag_properties,storage_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs). - + cs2list(Cs). rec2list([Tag | Tags], [Tag | Orig], Pos, Rec) -> Val = element(Pos, Rec), @@ -703,19 +667,8 @@ rec2list([], _, _Pos, _Rec) -> rec2list(Tags, [_|Orig], Pos, Rec) -> rec2list(Tags, Orig, Pos+1, Rec). -normalize_cs(Cstructs, Node) -> - %% backward-compatibility hack; normalize before returning - case need_old_cstructs([Node]) of - false -> - Cstructs; - Version -> - %% some other format - [convert_cs(Version, Cs) || Cs <- Cstructs] - end. - -convert_cs(Version, Cs) -> - Fields = [Value || {_, Value} <- cs2list(Version, Cs)], - list_to_tuple([cstruct|Fields]). +normalize_cs(Cstructs, _Node) -> + Cstructs. list2cs(List) when is_list(List) -> Name = pick(unknown, name, List, must), @@ -1142,6 +1095,7 @@ do_delete_table(Tab) -> ensure_writable(schema), insert_schema_ops(TidTs, make_delete_table(Tab, whole_table)). +-dialyzer({no_improper_lists, make_delete_table/2}). make_delete_table(Tab, Mode) -> case existed_before(Tab) of false -> @@ -1297,6 +1251,7 @@ make_del_table_copy(Tab, Node) -> _ -> ensure_active(Cs), verify_cstruct(Cs2), + get_tid_ts_and_lock(Tab, write), [{op, del_table_copy, Storage, Node, vsn_cs2list(Cs2)}] end. @@ -1324,6 +1279,7 @@ remove_node_from_tabs([Tab|Rest], Node) -> remove_node_from_tabs(Rest, Node)]; _Ns -> verify_cstruct(Cs2), + get_tid_ts_and_lock(Tab, write), [{op, del_table_copy, ram_copies, Node, vsn_cs2list(Cs2)}| remove_node_from_tabs(Rest, Node)] end @@ -1355,6 +1311,11 @@ do_move_table(schema, _FromNode, _ToNode) -> mnesia:abort({bad_type, schema}); do_move_table(Tab, FromNode, ToNode) when is_atom(FromNode), is_atom(ToNode) -> TidTs = get_tid_ts_and_lock(schema, write), + AnyOld = lists:any(fun(Node) -> mnesia_monitor:needs_protocol_conversion(Node) end, + [ToNode|val({Tab, where_to_write})]), + if AnyOld -> ignore; %% Leads to deadlock on old nodes + true -> get_tid_ts_and_lock(Tab, write) + end, insert_schema_ops(TidTs, make_move_table(Tab, FromNode, ToNode)); do_move_table(Tab, FromNode, ToNode) -> mnesia:abort({badarg, Tab, FromNode, ToNode}). @@ -1962,7 +1923,7 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> end, %% Tables are created by mnesia_loader get_network code insert_cstruct(Tid, Cs, true), - case mnesia_controller:get_network_copy(Tab, Cs) of + case mnesia_controller:get_network_copy(Tid, Tab, Cs) of {loaded, ok} -> {true, optional}; {not_loaded, ErrReason} -> @@ -1993,28 +1954,11 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> {true, optional} end; -prepare_op(Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> +prepare_op(_Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - - if - %% Schema table lock is always required to run a schema op. - %% No need to look it. - node(Tid#tid.pid) == node(), Tab /= schema -> - Self = self(), - Pid = spawn_link(fun() -> lock_del_table(Tab, Node, Cs, Self) end), - put(mnesia_lock, Pid), - receive - {Pid, updated} -> - {true, optional}; - {Pid, FailReason} -> - mnesia:abort(FailReason); - {'EXIT', Pid, Reason} -> - mnesia:abort(Reason) - end; - true -> - {true, optional} - end; + set_where_to_read(Tab, Node, Cs), + {true, optional}; prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) when N == node() -> @@ -2228,46 +2172,6 @@ receive_sync(Nodes, Pids) -> {abort, Else} end. -lock_del_table(Tab, NewNode, Cs0, Father) -> - Ns = val({schema, active_replicas}), - process_flag(trap_exit,true), - Lock = fun() -> - mnesia:write_lock_table(Tab), - %% Sigh using cs record - Set = fun(Node) -> - [Cs] = normalize_cs([Cs0], Node), - rpc:call(Node, ?MODULE, set_where_to_read, [Tab, NewNode, Cs]) - end, - Res = [Set(Node) || Node <- Ns], - Filter = fun(ok) -> - false; - ({badrpc, {'EXIT', {undef, _}}}) -> - %% This will be the case we talks with elder nodes - %% than 3.8.2, they will set where_to_read without - %% getting a lock. - false; - (_) -> - true - end, - case lists:filter(Filter, Res) of - [] -> - Father ! {self(), updated}, - %% When transaction is commited the process dies - %% and the lock is released. - receive _ -> ok end; - Err -> - Father ! {self(), {bad_commit, Err}} - end, - ok - end, - case mnesia:transaction(Lock) of - {atomic, ok} -> ok; - {aborted, R} -> Father ! {self(), R} - end, - unlink(Father), - unlink(whereis(mnesia_tm)), - exit(normal). - set_where_to_read(Tab, Node, Cs) -> case mnesia_lib:val({Tab, where_to_read}) of Node -> @@ -2418,13 +2322,19 @@ undo_prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}) -> insert_cstruct(Tid, Cs2, true) % Don't care about the version end; -undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) - when Node == node() -> - WriteLocker = get(mnesia_lock), - WriteLocker =/= undefined andalso (WriteLocker ! die), +undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - mnesia_lib:set({Tab, where_to_read}, Node); + if node() =:= Node -> + mnesia_lib:set({Tab, where_to_read}, Node); + true -> + case mnesia_lib:val({Tab, where_to_read}) of + nowhere -> + mnesia_lib:set_remote_where_to_read(Tab); + _ -> + ignore + end + end; undo_prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}) when N == node() -> @@ -2885,40 +2795,11 @@ do_merge_schema(LockTabs0) -> end. fetch_cstructs(Node) -> - case need_old_cstructs([Node]) of - false -> - rpc:call(Node, mnesia_controller, get_remote_cstructs, []); - _Ver -> - case rpc:call(Node, mnesia_controller, get_cstructs, []) of - {cstructs, Cs0, RR} -> - {cstructs, [list2cs(cs2list(Cs)) || Cs <- Cs0], RR}; - Err -> Err - end - end. + rpc:call(Node, mnesia_controller, get_remote_cstructs, []). -need_old_cstructs() -> - need_old_cstructs(val({schema, where_to_write})). - -need_old_cstructs(Nodes) -> - Filter = fun(Node) -> not mnesia_monitor:needs_protocol_conversion(Node) end, - case lists:dropwhile(Filter, Nodes) of - [] -> false; - [Node|_] -> - case rpc:call(Node, mnesia_lib, val, [{schema,cstruct}]) of - #cstruct{} -> - %% mnesia_lib:warning("Mnesia on ~p do not need to convert cstruct (~p)~n", - %% [node(), Node]), - false; - {badrpc, _} -> - need_old_cstructs(lists:delete(Node,Nodes)); - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> - ver4_4_18; % Without majority - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - ver4_4_19; % With majority - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> - ver4_6 % With storage_properties - end - end. +need_old_cstructs() -> false. + +need_old_cstructs(_Nodes) -> false. tab_to_nodes(Tab) when is_atom(Tab) -> Cs = val({Tab, cstruct}), diff --git a/lib/mnesia/test/mnesia_isolation_test.erl b/lib/mnesia/test/mnesia_isolation_test.erl index b66da6e390..4dd0c01d05 100644 --- a/lib/mnesia/test/mnesia_isolation_test.erl +++ b/lib/mnesia/test/mnesia_isolation_test.erl @@ -39,7 +39,7 @@ groups() -> [{locking, [], [no_conflict, simple_queue_conflict, advanced_queue_conflict, simple_deadlock_conflict, - advanced_deadlock_conflict, lock_burst, + advanced_deadlock_conflict, schema_deadlock, lock_burst, {group, sticky_locks}, {group, unbound_locking}, {group, admin_conflict}, nasty]}, {sticky_locks, [], [basic_sticky_functionality]}, @@ -148,20 +148,32 @@ simple_queue_conflict(Config) when is_list(Config) -> fun_loop(Fun, AllSharedLocks, OneExclusiveLocks), ok. -wait_for_lock(Pid, _Nodes, 0) -> +wait_for_lock(Pid, Nodes, Retry) -> + wait_for_lock(Pid, Nodes, Retry, queue). + +wait_for_lock(Pid, _Nodes, 0, queue) -> Queue = mnesia:system_info(lock_queue), ?error("Timeout while waiting for lock on Pid ~p in queue ~p~n", [Pid, Queue]); -wait_for_lock(Pid, Nodes, N) -> - rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), - List = [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes], +wait_for_lock(Pid, _Nodes, 0, held) -> + Held = mnesia:system_info(held_locks), + ?error("Timeout while waiting for lock on Pid ~p (held) ~p~n", [Pid, Held]); +wait_for_lock(Pid, Nodes, N, Where) -> + rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), + List = case Where of + queue -> + [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes]; + held -> + [rpc:call(Node, mnesia, system_info, [held_locks]) || Node <- Nodes] + end, Q = lists:append(List), - check_q(Pid, Q, Nodes, N). + check_q(Pid, Q, Nodes, N, Where). -check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count) -> ok; -check_q(Pid, [_ | Tail], N, Count) -> check_q(Pid, Tail, N, Count); -check_q(Pid, [], N, Count) -> - timer:sleep(500), - wait_for_lock(Pid, N, Count - 1). +check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count, _Where) -> ok; +check_q(Pid, [{_Oid, _Op, {tid,_,Pid}} | _Tail], _N, _Count, _Where) -> ok; +check_q(Pid, [_ | Tail], N, Count, Where) -> check_q(Pid, Tail, N, Count, Where); +check_q(Pid, [], N, Count, Where) -> + timer:sleep(200), + wait_for_lock(Pid, N, Count - 1, Where). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -270,6 +282,43 @@ advanced_deadlock_conflict(Config) when is_list(Config) -> ?match([], mnesia:system_info(lock_queue)), ok. +%% Verify (and regression test) deadlock in del_table_copy(schema, Node) +schema_deadlock(Config) when is_list(Config) -> + Ns = [Node1, Node2] = ?acquire_nodes(2, Config), + ?match({atomic, ok}, mnesia:create_table(a, [{disc_copies, Ns}])), + ?match({atomic, ok}, mnesia:create_table(b, [{disc_copies, Ns}])), + + Tester = self(), + + Deadlocker = fun() -> + mnesia:write({a,1,1}), %% grab write lock on A + receive + continue -> + mnesia:write({b,1,1}), %% grab write lock on B + end_trans + end + end, + + ?match(stopped, rpc:call(Node2, mnesia, stop, [])), + timer:sleep(500), %% Let Node1 reconfigure + sys:get_status(mnesia_monitor), + + DoingTrans = spawn_link(fun() -> Tester ! {self(),mnesia:transaction(Deadlocker)} end), + wait_for_lock(DoingTrans, [Node1], 10, held), + %% Will grab write locks on schema, a, and b + DoingSchema = spawn_link(fun() -> Tester ! {self(), mnesia:del_table_copy(schema, Node2)} end), + timer:sleep(500), %% Let schema trans start, and try to grab locks + DoingTrans ! continue, + + ?match(ok, receive {DoingTrans, {atomic, end_trans}} -> ok after 5000 -> timeout end), + ?match(ok, receive {DoingSchema, {atomic, ok}} -> ok after 5000 -> timeout end), + + sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async + ?match([], mnesia:system_info(held_locks)), + ?match([], mnesia:system_info(lock_queue)), + ok. + + one_oid(Tab) -> {Tab, 1}. other_oid(Tab) -> {Tab, 2}. diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 88f606b3e4..75e6919642 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2014. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -669,6 +669,7 @@ merge([], New, _Key) -> merge(Old, New, Key) -> merge2(keysort(Key, Old), keysort(Key, New), Key). +-dialyzer({no_improper_lists, merge2/3}). merge2([[Obj|_]|Old], [Obj|New], Key) -> [[Obj]|merge2(Old, New, Key)]; merge2([[A|Op]|Old], [B|New], Key) diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 0292333f0a..38725807ae 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -41,7 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml +XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml msacc.xml XML_REF6_FILES = runtime_tools_app.xml XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml diff --git a/lib/runtime_tools/doc/src/msacc.xml b/lib/runtime_tools/doc/src/msacc.xml new file mode 100644 index 0000000000..129da3d230 --- /dev/null +++ b/lib/runtime_tools/doc/src/msacc.xml @@ -0,0 +1,305 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2014</year><year>2014</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>Microstate Accounting</title> + <prepared>Lukas Larsson</prepared> + <responsible></responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date>14-09-30</date> + <rev>A</rev> + <file>msacc.xml</file> + </header> + <module>msacc</module> + <modulesummary>Convenience functions for microstate accounting</modulesummary> + <description> + <p>This module implements some convenience functions for analyzing + microstate accounting data. For details about how to use the basic api and + what the different states represent see + <seealso marker="erts:erlang#statistics_microstate_accounting"><c> + erlang:statistics(microstate_accounting)</c></seealso>.</p> + <marker id="msacc_print_example"></marker> + <p><em>Basic Scenario</em></p> + <pre>1> <input>msacc:start(1000).</input> +ok +2> <input>msacc:print().</input> +Average thread real-time : 1000513 us +Accumulated system run-time : 2213 us +Average scheduler run-time : 1076 us + + Thread aux check_io emulator gc other port sleep + +Stats per thread: + async( 0) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + async( 1) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + aux( 1) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 99.99% + scheduler( 1) 0.00% 0.03% 0.13% 0.00% 0.01% 0.00% 99.82% + scheduler( 2) 0.00% 0.00% 0.00% 0.00% 0.03% 0.00% 99.97% + +Stats per type: + async 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + aux 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 99.99% + scheduler 0.00% 0.02% 0.06% 0.00% 0.02% 0.00% 99.89% +ok +</pre> + <p>This first command enables microstate accounting for 1000 milliseconds. + See <seealso marker="#start-0"><c>start/0</c></seealso>, + <seealso marker="#stop-0"><c>stop/0</c></seealso>, + <seealso marker="#reset-0"><c>reset/0</c></seealso> and + <seealso marker="#start-1"><c>start/1</c></seealso> for more details. + The second command prints the statistics gathered during that time. + First three general statistics are printed.</p> + <taglist> + <tag>Average real-time</tag> + <item>The average time spent collecting data in the threads. + This should be close to the time which data was collected. + </item> + <tag>System run-time</tag> + <item>The total run-time of all threads in the system. + This is what you get if you call <c>msacc:stats(total_runtime,Stats).</c> + </item> + <tag>Average scheduler run-time</tag> + <item>The average run-time for the schedulers. + This is the average amount of time the schedulers did not sleep.</item> + </taglist> + <p>Then one column per state is printed with a the percentage of time this + thread spent in the state out of it's own real-time. After the thread + specific time, the accumulated time for each type of thread is printed in + a similar format.</p> + <p>Since we have the average real-time and the percentage spent in each + state we can easily calculate the time spent in each state by multiplying + <c>Average thread real-time</c> with <c>Thread state %</c>, i.e. to + get the time Scheduler 1 spent in the emulator state we do + <c>1000513us * 0.13% = 1300us</c>.</p> + </description> + <datatypes> + <datatype> + <name name="msacc_data"/> + </datatype> + <datatype> + <name name="msacc_data_thread"/> + </datatype> + <datatype> + <name name="msacc_data_counters"/> + <desc><p>A map containing the different microstate accounting states and + the number of microseconds spent in it.</p></desc> + </datatype> + <datatype> + <name name="msacc_stats"/> + </datatype> + <datatype> + <name name="msacc_stats_thread"/> + <desc><p>A map containing information about a specific thread. The + percentages in the map can be either run-time or real-time depending + on if <c>runtime</c> or <c>realtime</c> was requested from + <seealso marker="#stats-2">stats/2</seealso>. <c>system</c> is the + percentage of total system time for this specific thread.</p></desc> + </datatype> + <datatype> + <name name="msacc_stats_counters"/> + <desc><p>A map containing the different microstate accounting states. Each + value in the map contains another map with the percentage of time that + this thread has spent in the specific state. Both the percentage of + <c>system</c> time and the time for that specific <c>thread</c> is part of + the map.</p></desc> + </datatype> + <datatype> + <name name="msacc_type"/> + </datatype> + <datatype> + <name name="msacc_id"/> + </datatype> + <datatype> + <name name="msacc_state"/> + <desc><p>The different states that a thread can be in. See + <seealso marker="erts:erlang#statistics_microstate_accounting"> + erlang:statistics(microstate_accounting)</seealso> for details. + </p></desc> + </datatype> + <datatype> + <name name="msacc_print_options"/> + <desc><p>The different options that can be given to + <seealso marker="#print-2"><c>print/2</c></seealso>. + </p></desc> + </datatype> + </datatypes> + <funcs> + <func> + <name name="available" arity="0"/> + <fsummary>Check if microstate accounting is available</fsummary> + <desc> + <p>This function checks whether microstate accounting + is available or not.</p> + </desc> + </func> + <func> + <name name="start" arity="0"/> + <fsummary>Start microstate accounting.</fsummary> + <desc> + <p>Start microstate accounting. Returns whether it was + previously enabled or disabled.</p> + </desc> + </func> + <func> + <name name="start" arity="1"/> + <fsummary>Start microstate accounting for a time.</fsummary> + <desc> + <p>Resets all counters and then starts microstate accounting + for the given milliseconds.</p> + </desc> + </func> + <func> + <name name="stop" arity="0"/> + <fsummary>Stop microstate accounting.</fsummary> + <desc> + <p>Stop microstate accounting. + Returns whether is was previously enabled or disabled.</p> + </desc> + </func> + <func> + <name name="reset" arity="0"/> + <fsummary>Reset microstate accounting counters</fsummary> + <desc> + <p>Reset microstate accounting counters. + Returns whether is was enabled or disabled.</p> + </desc> + </func> + <func> + <name name="print" arity="0"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p> + Prints the current microstate accounting to standard out. + Same as + <seealso marker="#print-1"> + <c>msacc:print(msacc:stats(),#{}).</c> + </seealso> + </p> + </desc> + </func> + <func> + <name name="print" arity="1"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to stdout. + Same as + <seealso marker="#print-1"> + <c>msacc:print(DataOrStats,#{}).</c> + </seealso> + </p> + </desc> + </func> + <func> + <name name="print" arity="2"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to standard out. + With many states this can be quite verbose. See the top of this + reference manual for a brief description of what the fields mean.</p> + <p>It is possible to print more specific types of statistics by + first manipulating the <c>DataOrStats</c> using + <seealso marker="#stats-2"><c>stats/2</c></seealso>. + For instance if you want to print the percentage of run-time for each + thread you can do:</p> + <pre><input>msacc:print(msacc:stats(runtime,msacc:stats())).</input></pre> + <p>If you want to only print run-time per thread type you can do:</p> + <pre><input>msacc:print(msacc:stats(type,msacc:stats(runtime,msacc:stats()))).</input></pre> + <p><em>Options</em></p> + <taglist> + <tag><c>system</c></tag><item>Print percentage of time spent in each + state out of system time as well as thread time. + Default: false.</item> + </taglist> + </desc> + </func> + <func> + <name name="print" arity="3"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to the given file + or device. The other arguments behave the same way as for + <seealso marker="#print-2"><c>print/2</c></seealso>.</p> + </desc> + </func> + <func> + <name name="stats" arity="0"/> + <fsummary></fsummary> + <desc> + <p>Returns a runtime system independent version of the microstate + statistics data presented by + <seealso marker="erts:erlang#statistics_microstate_accounting"> + <c>erlang:statistics(microstate_accounting)</c></seealso>. + All counters have been normalized to be in microsecond resolution.</p> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="1"/> + <fsummary></fsummary> + <desc> + <p>Returns the system time for the given microstate statistics values. + System time is the accumulated time of all threads.</p> + <taglist> + <tag><c>realtime</c></tag> + <item>Returns all time recorded for all threads.</item> + <tag><c>runtime</c></tag> + <item>Returns all time spent doing work for all threads, i.e. + all time not spent in the <c>sleep</c> state.</item> + </taglist> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="2"/> + <fsummary></fsummary> + <desc> + <p>Returns fractions of real-time or run-time spent in the various + threads from the given microstate statistics values.</p> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="3"/> + <fsummary></fsummary> + <desc> + <p>Returns a list of microstate statistics values where the values + for all threads of the same type has been merged.</p> + </desc> + </func> + <func> + <name name="to_file" arity="1"/> + <fsummary></fsummary> + <desc> + <p>Dumps the current microstate statistics counters to a file that can + be parsed with <seealso marker="kernel:file#consult/1"> + file:consult/1</seealso>.</p> + </desc> + </func> + <func> + <name name="from_file" arity="1"/> + <fsummary></fsummary> + <desc> + <p>Read a file dump produced by <seealso marker="#to_file/1"> + to_file(Filename)</seealso>.</p> + </desc> + </func> + </funcs> +</erlref> diff --git a/lib/runtime_tools/doc/src/ref_man.xml b/lib/runtime_tools/doc/src/ref_man.xml index ea0c0832a4..8657a07a30 100644 --- a/lib/runtime_tools/doc/src/ref_man.xml +++ b/lib/runtime_tools/doc/src/ref_man.xml @@ -36,6 +36,7 @@ <xi:include href="dbg.xml"/> <xi:include href="dyntrace.xml"/> <xi:include href="erts_alloc_config.xml"/> + <xi:include href="msacc.xml"/> <xi:include href="system_information.xml"/> </application> diff --git a/lib/runtime_tools/doc/src/specs.xml b/lib/runtime_tools/doc/src/specs.xml index d4c3c9dfe6..978bd39e55 100644 --- a/lib/runtime_tools/doc/src/specs.xml +++ b/lib/runtime_tools/doc/src/specs.xml @@ -1,4 +1,5 @@ <?xml version="1.0" encoding="utf-8" ?> <specs xmlns:xi="http://www.w3.org/2001/XInclude"> <xi:include href="../specs/specs_system_information.xml"/> + <xi:include href="../specs/specs_msacc.xml"/> </specs> diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 99b90f9ec5..3b41184f4e 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -45,7 +45,9 @@ MODULES= \ percept_profile \ system_information \ observer_backend \ - ttb_autostart + ttb_autostart\ + msacc + HRL_FILES= ../include/observer_backend.hrl ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 22b531e6ee..6eea1a0917 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1276,6 +1276,8 @@ gen_reader_file(ReadFun, Filename) -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader/2}). + %% Creates and returns a reader (lazy list). mk_reader(ReadFun, Source) -> fun() -> @@ -1301,6 +1303,8 @@ mk_reader_wrap([Hd | _] = WrapFiles) -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader_wrap/2}). + mk_reader_wrap([_Hd | Tail] = WrapFiles, File) -> fun() -> case read_term(fun file_read/2, File) of diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl new file mode 100644 index 0000000000..612effa5aa --- /dev/null +++ b/lib/runtime_tools/src/msacc.erl @@ -0,0 +1,355 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. 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% +%% + +%% +%% @doc Microstate accounting utility function +%% +%% This module provides a user interface for analysing +%% erlang:statistics(microstate_accounting) data. +%% + +-module(msacc). +-export([available/0, start/0, start/1, stop/0, reset/0, to_file/1, + from_file/1, stats/0, stats/2, print/0, print/1, print/2, + print/3]). + +-type msacc_data() :: [msacc_data_thread()]. + +-type msacc_data_thread() :: #{ '$type' => msacc_data, + type => msacc_type(), id => msacc_id(), + counters => msacc_data_counters() }. +-type msacc_data_counters() :: #{ msacc_state() => non_neg_integer()}. + +-type msacc_stats() :: [msacc_stats_thread()]. +-type msacc_stats_thread() :: #{ '$type' => msacc_stats, + type => msacc_type(), id => msacc_id(), + system => float(), + counters => msacc_stats_counters()}. +-type msacc_stats_counters() :: #{ msacc_state() => #{ thread => float(), + system => float()}}. + + +-type msacc_type() :: scheduler | aux | async. +-type msacc_id() :: non_neg_integer(). +-type msacc_state() :: alloc | aux | bif | busy_wait | check_io | + emulator | ets | gc | gc_fullsweep | nif | + other | port | send | sleep | timers. + +-type msacc_print_options() :: #{ system => boolean() }. + +-spec available() -> boolean(). +available() -> + try + [_|_] = erlang:statistics(microstate_accounting), + true + catch _:_ -> + false + end. + +-spec start() -> boolean(). +start() -> + erlang:system_flag(microstate_accounting, true). + +-spec stop() -> boolean(). +stop() -> + erlang:system_flag(microstate_accounting, false). + +-spec reset() -> boolean(). +reset() -> + erlang:system_flag(microstate_accounting, reset). + +-spec start(Time) -> true when + Time :: timeout(). +start(Tmo) -> + stop(), reset(), start(), + timer:sleep(Tmo), + stop(). + +-spec to_file(Filename) -> ok | {error, file:posix()} when + Filename :: file:name_all(). +to_file(Filename) -> + file:write_file(Filename, io_lib:format("~p.~n",[stats()])). + +-spec from_file(Filename) -> msacc_data() when + Filename :: file:name_all(). +from_file(Filename) -> + {ok, [Stats]} = file:consult(Filename), + Stats. + +-spec print() -> ok. +print() -> + print(stats()). + +-spec print(DataOrStats) -> ok when + DataOrStats :: msacc_data() | msacc_stats(). +print(Stats) -> + print(Stats, #{}). + +-spec print(DataOrStats, Options) -> ok when + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Stats, Options) -> + print(group_leader(), Stats, Options). + +-spec print(FileOrDevice, DataOrStats, Options) -> ok when + FileOrDevice :: file:filename() | io:device(), + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Filename, Stats, Options) when is_list(Filename) -> + case file:open(Filename,[write]) of + {ok, D} -> print(D, Stats, Options),file:close(D); + Error -> Error + end; +print(Device, Stats, Options) -> + DefaultOpts = #{ system => false }, + print_int(Device, Stats, maps:merge(DefaultOpts, Options)). +print_int(Device, [#{ '$type' := msacc_data, id := _Id }|_] = Stats, Options) -> + TypeStats = stats(type, Stats), + io:format(Device, "~s", [print_stats_overview(Stats, Options)]), + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads( + stats(realtime, Stats), Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, TypeStats), Options)]); +print_int(Device, [#{ '$type' := msacc_data }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats, id := _Id }|_] = Stats,Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + msacc:stats(type, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type(Stats, Options)]). + + +-spec stats() -> msacc_data(). +stats() -> + Fun = fun F(K,{PerfCount,StateCount}) -> + %% Need to handle ERTS_MSACC_STATE_COUNTERS + {F(K,PerfCount),StateCount}; + F(_K,PerfCount) -> + erlang:convert_time_unit(PerfCount, perf_counter, 1000000) + end, + UsStats = lists:map( + fun(#{ counters := Cnt } = M) -> + UsCnt = maps:map(Fun,Cnt), + M#{ '$type' => msacc_data, counters := UsCnt } + end, erlang:statistics(microstate_accounting)), + statssort(UsStats). + +-spec stats(Analysis, Stats) -> non_neg_integer() when + Analysis :: system_realtime | system_runtime, + Stats :: msacc_data(); + (Analysis, Stats) -> msacc_stats() when + Analysis :: realtime | runtime, + Stats :: msacc_data(); + (Analysis, StatsOrData) -> msacc_data() | msacc_stats() when + Analysis :: type, + StatsOrData :: msacc_data() | msacc_stats(). +stats(system_realtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(Cnt, Acc) + end, 0, Stats); +stats(system_runtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(maps:remove(sleep, Cnt), Acc) + end, 0, Stats); +stats(realtime, Stats) -> + RealTime = stats(system_realtime, Stats), + statssort([get_thread_perc(Thread, RealTime) || Thread <- Stats]); +stats(runtime, Stats) -> + RunTime = stats(system_runtime, Stats), + statssort([get_thread_perc(T#{ counters := maps:remove(sleep,Cnt)}, RunTime) + || T = #{ counters := Cnt } <- Stats]); +stats(type, Stats) -> + statssort(merge_threads(Stats, [])). + +print_stats_overview(Stats, _Options) -> + RunTime = stats(system_runtime, Stats), + RealTime = stats(system_realtime, Stats) div length(Stats), + SchedStats = [S || #{ type := scheduler } = S <- Stats], + AvgSchedRunTime = stats(system_runtime, SchedStats) div length(SchedStats), + NumSize = if + RealTime > RunTime -> length(integer_to_list(RealTime)); + true -> length(integer_to_list(RunTime)) + end, + [io_lib:format("Average thread real-time : ~*B us~n", + [NumSize, RealTime]), + io_lib:format("Accumulated system run-time : ~*B us~n", + [NumSize, RunTime]), + io_lib:format("Average scheduler run-time : ~*B us~n", + [NumSize, AvgSchedRunTime]), + io_lib:format("~n",[])]. + +print_stats_threads(Stats, Options) -> + [io_lib:format("~nStats per thread:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + +print_stats_type(Stats, Options) -> + [io_lib:format("~nStats per type:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + + +print_stats_header([#{ counters := Cnt }|_], #{ system := PrintSys }) -> + [io_lib:format("~14s", ["Thread"]), + map(fun(Counter, _) when PrintSys-> + io_lib:format("~9s ", [atom_to_list(Counter)]); + (Counter, _) -> + io_lib:format("~9s", [atom_to_list(Counter)]) + end, Cnt), + io_lib:format("~n",[])]. + +print_thread_info(#{ '$type' := msacc_stats, + counters := Cnt } = Thread, #{ system := PrintSys }) -> + [case maps:find(id, Thread) of + error -> + io_lib:format("~14s", [atom_to_list(maps:get(type, Thread))]); + {ok, Id} -> + io_lib:format("~10s(~2B)", [atom_to_list(maps:get(type,Thread)),Id]) + end, + map(fun(_Key, #{ thread := ThreadPerc, system := SystemPerc }) when PrintSys -> + io_lib:format("~6.2f%(~4.1f%)", [ThreadPerc, SystemPerc]); + (_Key, #{ thread := ThreadPerc }) -> + io_lib:format("~8.2f%", [ThreadPerc]) + end, Cnt), + io_lib:format("~n",[])]. + +get_total(Cnt, Base) -> + maps:fold(fun(_, {Val,_}, Time) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + Time + Val; + (_, Val, Time) -> Time + Val + end, Base, Cnt). + +get_thread_perc(#{ '$type' := msacc_data, counters := Cnt } = Thread, + SystemTime) -> + ThreadTime = get_total(Cnt, 0), + Thread#{ '$type' := msacc_stats, + system => percentage(ThreadTime,SystemTime), + counters => get_thread_perc(Cnt, ThreadTime, SystemTime)}. +get_thread_perc(Cnt, ThreadTime, SystemTime) -> + maps:map(fun F(Key, {Val, C}) -> + M = F(Key, Val), + M#{ cnt => C }; + F(_Key, Val) -> + #{ thread => percentage(Val, ThreadTime), + system => percentage(Val, SystemTime) } + end, Cnt). + +%% This code is a little bit messy as it has to be able to deal with +%% both [msacc_data()] and [msacc_stats()]. +merge_threads([#{ '$type' := msacc_stats, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0#{ threads => 1 })|Acc]); + #{ '$type' := msacc_stats, counters := Cnt0, + threads := Threads, system := System } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0), + system := System + maps:get(system, M0), + threads := Threads + 1}, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], [#{ '$type' := msacc_stats, + system := System, + threads := Threads, + counters := Cnt} = M0|R]) -> + Counters = maps:map(fun(_,#{ thread := Thr } = Map) -> + Map#{ thread := Thr / Threads } + end, Cnt), + M = maps:remove(threads, M0), + [M#{ system := System, counters := Counters} | merge_threads([],R)]; +merge_threads([], []) -> + []; +%% The clauses below deal with msacc_data() +merge_threads([#{ '$type' := msacc_data, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0)|Acc]); + #{ '$type' := msacc_data, counters := Cnt0 } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0) }, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], Acc) -> + Acc. + +add_counters(M1, M2) -> + maps:map( + fun(Key, #{ thread := Thr1, system := Sys1, cnt := Cnt1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + #{ thread := Thr2, system := Sys2, cnt := Cnt2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2, + cnt => Cnt1 + Cnt2 }; + (Key, #{ thread := Thr1, system := Sys1}) -> + #{ thread := Thr2, system := Sys2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2}; + (Key, {V1,C1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + {V2,C2} = maps:get(Key, M2),{V1+V2,C1+C2}; + (Key, V1) -> maps:get(Key, M2) + V1 + end, M1). + +percentage(Divident, Divisor) -> + if Divisor == 0 andalso Divident /= 0 -> + 100.0; + Divisor == 0 -> + 0.0; + true -> + Divident / Divisor * 100 + end. + +keyfind(Key, Value, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + H; + _ -> + keyfind(Key, Value, T) + end; +keyfind(_, _, []) -> + false. + +keyreplace(Key, Value, NewMap, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + [NewMap|T]; + _ -> + [H|keyreplace(Key, Value, NewMap, T)] + end; +keyreplace(_, _, _, []) -> + []. + +statssort(Stats) -> + lists:sort(fun(#{ type := Type1, id := Id1}, + #{ type := Type2, id := Id2}) -> + {Type1, Id1} < {Type2, Id2}; + (#{ type := Type1}, #{ type := Type2}) -> + Type1 < Type2 + end, Stats). + +map(Fun,Map) -> + [ Fun(K,V) || {K,V} <- maps:to_list(Map) ]. diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index ad10655aa0..aeda103e72 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -22,7 +22,8 @@ {vsn, "%VSN%"}, {modules, [appmon_info, dbg,observer_backend,percept_profile, runtime_tools,runtime_tools_sup,erts_alloc_config, - ttb_autostart,dyntrace,system_information]}, + ttb_autostart,dyntrace,system_information, + msacc]}, {registered, [runtime_tools_sup]}, {applications, [kernel, stdlib]}, {env, []}, diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index dcb9082231..71ac8b1157 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -7,7 +7,8 @@ MODULES = \ runtime_tools_SUITE \ system_information_SUITE \ dbg_SUITE \ - erts_alloc_config_SUITE + erts_alloc_config_SUITE \ + msacc_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/test/msacc_SUITE.erl b/lib/runtime_tools/test/msacc_SUITE.erl new file mode 100644 index 0000000000..145a6d07fb --- /dev/null +++ b/lib/runtime_tools/test/msacc_SUITE.erl @@ -0,0 +1,132 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. 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(msacc_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +%% Test server callbacks +-export([suite/0, all/0]). + +%% Test cases +-export([ + %% API-test + api_file/1, + api_start_stop/1, + api_timer/1, + api_print/1 + ]). + +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- +all() -> + [ + api_start_stop, + api_file, + api_timer, + api_print + ]. + +suite() -> [ + {timetrap,{minutes,1}}, + {ct_hooks,[ts_install_cth]} + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +api_timer(_Config) -> + + %% Run msacc for about 100ms + msacc:start(100), + + %% Verify that scheduler 1 executed+slept for about 100ms + [Sched1] = [S || S = #{ type := scheduler, id := 1 } <- msacc:stats()], + + #{ counters := Cnt } = Sched1, + + %% Time should be in us + Time = maps:fold(fun(_,V,Acc) -> V + Acc end, 0, Cnt), + + if Time < 120000 andalso Time > 80000 -> ok; + true -> ct:fail({inaccurate_time, Time, msacc:stats()}) + end. + +%% We just do a basic check that none of the apis crash +api_start_stop(_Config) -> + msacc:start(), + timer:sleep(100), + msacc:stop(), + Runtime = msacc:stats(system_runtime, msacc:stats()), + Realtime = msacc:stats(system_realtime, msacc:stats()), + true = Runtime < Realtime, + + RuntimeCnt = msacc:stats(runtime, msacc:stats()), + RealtimeCnt = msacc:stats(realtime, msacc:stats()), + TypeCnt = msacc:stats(type, msacc:stats()), + + %% These should be very similar + RuntimeTypeCnt = msacc:stats(type, RuntimeCnt), + TypeRuntimeCnt = msacc:stats(runtime, TypeCnt), + lists:map(fun({#{ system := T1 },#{ system := T2}}) -> + if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok; + true -> ct:fail({inaccurate_stats, RuntimeTypeCnt, + TypeRuntimeCnt}) + end + end, lists:zip(RuntimeTypeCnt, TypeRuntimeCnt)), + + %% These should be very similar + RealtimeTypeCnt = msacc:stats(type, RealtimeCnt), + TypeRealtimeCnt = msacc:stats(realtime, TypeCnt), + lists:map(fun({#{ system := T1 },#{ system := T2}}) -> + if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok; + true -> ct:fail({inaccurate_stats, RealtimeTypeCnt, + TypeRealtimeCnt}) + end + end,lists:zip(RealtimeTypeCnt, TypeRealtimeCnt)), + + msacc:reset(). + +api_file(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + File = filename:join(PrivDir, "msacc.stats"), + Stats = msacc:stats(), + ok = msacc:to_file(File), + Stats = msacc:from_file(File), + + PrintFile = filename:join(PrivDir, "msacc.txt"), + msacc:print(PrintFile, Stats, #{}). + +%% We just check that it is possible to print in a couple of different ways +api_print(_Config) -> + msacc:start(100), + io:format("msacc:print(msacc:stats()).~n"), + msacc:print(msacc:stats()), + io:format("msacc:print(msacc:stats(),#{ system => true }).~n"), + msacc:print(msacc:stats(), #{ system => true }), + io:format("msacc:print(msacc:stats(runtime,msacc:stats())).~n"), + msacc:print(msacc:stats(runtime, msacc:stats())), + io:format("msacc:print(msacc:stats(type,msacc:stats())).~n"), + msacc:print(msacc:stats(type, msacc:stats())), + io:format("msacc:print(msacc:stats(realtime,msacc:stats())).~n"), + msacc:print(msacc:stats(realtime, msacc:stats())), + io:format("msacc:stats(type,msacc:stats(runtime,msacc:stats())).~n"), + msacc:print(msacc:stats(type, msacc:stats(runtime, msacc:stats()))). diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 536ac924d4..a6325270a5 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -587,12 +587,12 @@ get_supervised_procs() -> get_application_names()). get_supervised_procs(_, Root, Procs, {ok, SupMod}) -> - get_procs(maybe_supervisor_which_children(get_proc_state(Root), SupMod, Root), Root) ++ + get_procs(maybe_supervisor_which_children(Root, SupMod, Root), Root) ++ [{undefined, undefined, Root, [SupMod]} | Procs]; get_supervised_procs(Application, Root, Procs, {error, _}) -> error_logger:error_msg("release_handler: cannot find top supervisor for " "application ~w~n", [Application]), - get_procs(maybe_supervisor_which_children(get_proc_state(Root), Application, Root), Root) ++ Procs. + get_procs(maybe_supervisor_which_children(Root, Application, Root), Root) ++ Procs. get_application_names() -> lists:map(fun({Application, _Name, _Vsn}) -> @@ -613,33 +613,54 @@ get_procs([{Name, Pid, worker, Mods} | T], Sup) when is_pid(Pid), is_list(Mods) [{Sup, Name, Pid, Mods} | get_procs(T, Sup)]; get_procs([{Name, Pid, supervisor, Mods} | T], Sup) when is_pid(Pid) -> [{Sup, Name, Pid, Mods} | get_procs(T, Sup)] ++ - get_procs(maybe_supervisor_which_children(get_proc_state(Pid), Name, Pid), Pid); + get_procs(maybe_supervisor_which_children(Pid, Name, Pid), Pid); get_procs([_H | T], Sup) -> get_procs(T, Sup); get_procs(_, _Sup) -> []. +maybe_supervisor_which_children(Proc, Name, Pid) -> + case get_proc_state(Proc) of + noproc -> + %% process exited before we could interrogate it. + %% not necessarily a bug, but reporting a warning as a curiosity. + error_logger:warning_msg("release_handler: a process (~p) exited" + " during supervision tree interrogation." + " Continuing ...~n", [Proc]), + []; + + suspended -> + error_logger:error_msg("release_handler: a which_children call" + " to ~p (~w) was avoided. This supervisor" + " is suspended and should likely be upgraded" + " differently. Exiting ...~n", [Name, Pid]), + error(suspended_supervisor); + + running -> + case catch supervisor:which_children(Pid) of + Res when is_list(Res) -> + Res; + Other -> + error_logger:error_msg("release_handler: ~p~nerror during" + " a which_children call to ~p (~w)." + " [State: running] Exiting ... ~n", + [Other, Name, Pid]), + error(which_children_failed) + end + end. + get_proc_state(Proc) -> - {status, _, {module, _}, [_, State, _, _, _]} = sys:get_status(Proc), - State. - -maybe_supervisor_which_children(suspended, Name, Pid) -> - error_logger:error_msg("release_handler: a which_children call" - " to ~p (~w) was avoided. This supervisor" - " is suspended and should likely be upgraded" - " differently. Exiting ...~n", [Name, Pid]), - error(suspended_supervisor); - -maybe_supervisor_which_children(State, Name, Pid) -> - case catch supervisor:which_children(Pid) of - Res when is_list(Res) -> - Res; - Other -> - error_logger:error_msg("release_handler: ~p~nerror during" - " a which_children call to ~p (~w)." - " [State: ~p] Exiting ... ~n", - [Other, Name, Pid, State]), - error(which_children_failed) + %% sys:send_system_msg can exit with {noproc, {m,f,a}}. + %% This happens if a supervisor exits after which_children has provided + %% its pid for interrogation. + %% ie. Proc may no longer be running at this point. + try sys:get_status(Proc) of + %% as per sys:get_status/1, SysState can only be running | suspended. + {status, _, {module, _}, [_, State, _, _, _]} when State == running ; + State == suspended -> + State + catch exit:{noproc, {sys, get_status, [Proc]}} -> + noproc end. maybe_get_dynamic_mods(Name, Pid) -> @@ -655,48 +676,19 @@ maybe_get_dynamic_mods(Name, Pid) -> error(get_modules_failed) end. -%% XXXX -%% Note: The following is a terrible hack done in order to resolve the -%% problem stated in ticket OTP-3452. - -%% XXXX NOTE WELL: This record is from supervisor.erl. Also the record -%% name is really `state'. --record(supervisor_state, {name, - strategy, - children = [], - dynamics = [], - intensity, - period, - restarts = [], - module, - args}). - %% Return the name of the call-back module that implements the %% (top) supervisor SupPid. %% Returns: {ok, Module} | {error,undefined} %% get_supervisor_module(SupPid) -> - case catch get_supervisor_module1(SupPid) of - {ok, Module} when is_atom(Module) -> + case catch supervisor:get_callback_module(SupPid) of + Module when is_atom(Module) -> {ok, Module}; _Other -> io:format("~w: reason: ~w~n", [SupPid, _Other]), {error, undefined} end. -get_supervisor_module1(SupPid) -> - {status, _Pid, {module, _Mod}, - [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(SupPid), - %% supervisor Misc field changed at R13B04, handle old and new variants here - State = case Misc of - [_Name, State1, _Type, _Time] -> - State1; - [_Header, _Data, {data, [{"State", State2}]}] -> - State2 - end, - %% Cannot use #supervisor_state{module = Module} = State. - {ok, element(#supervisor_state.module, State)}. - %%----------------------------------------------------------------- %% Func: do_soft_purge/3 %% Args: Mod = atom() diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index 705bb73fc5..507e2dc229 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -46,6 +46,6 @@ {env, [{sasl_error_logger, tty}, {errlog_type, all}]}, {mod, {sasl, []}}, - {runtime_dependencies, ["tools-2.6.14","stdlib-2.6","kernel-4.1", + {runtime_dependencies, ["tools-2.6.14","stdlib-2.8","kernel-4.1", "erts-6.0"]}]}. diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index d57de2593a..ee620dcdb4 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1363,7 +1363,7 @@ upgrade_supervisor(Conf) when is_list(Conf) -> %% Check that the restart strategy and child spec is updated {status, _, {module, _}, [_, _, _, _, [_,_,{data,[{"State",State}]}]]} = rpc:call(Node,sys,get_status,[a_sup]), - {state,_,RestartStrategy,[Child],_,_,_,_,_,_} = State, + {state,_,RestartStrategy,[Child],_,_,_,_,_,_,_} = State, one_for_all = RestartStrategy, % changed from one_for_one {child,_,_,_,_,brutal_kill,_,_} = Child, % changed from timeout 2000 diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 6c4c215b3d..4b53f6ec57 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -601,10 +601,14 @@ cli(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - + + TmpDir = filename:join(?config(priv_dir,Config), "tmp"), + ok = ssh_test_lib:del_dirs(TmpDir), + ok = file:make_dir(TmpDir), + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {password, "morot"}, - {ssh_cli, {ssh_test_cli, [cli]}}, + {ssh_cli, {ssh_test_cli, [cli,TmpDir]}}, {subsystems, []}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index cd9ad5f2ff..697ddb730d 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -4,20 +4,25 @@ -record(state, { type, + tmpdir, id, ref, port }). -init([Type]) -> - {ok, #state{type = Type}}. + +init([Type]) -> init([Type,"/tmp"]); + +init([Type,TmpDir]) -> + {ok, #state{type = Type, + tmpdir = TmpDir}}. handle_msg({ssh_channel_up, Id, Ref}, S) -> User = get_ssh_user(Ref), ok = ssh_connection:send(Ref, Id, << "\r\nYou are accessing a dummy, type \"q\" to exit\r\n\n" >>), - Port = run_portprog(User, S#state.type), + Port = run_portprog(User, S#state.type, S#state.tmpdir), {ok, S#state{port = Port, id = Id, ref = Ref}}; handle_msg({Port, {data, Data}}, S = #state{port = Port}) -> @@ -68,10 +73,10 @@ handle_ssh_msg({ssh_cm, _, {exit_signal, Id, _, _, _}}, terminate(_Why, _S) -> nop. -run_portprog(User, cli) -> +run_portprog(User, cli, TmpDir) -> Pty_bin = os:find_executable("cat"), open_port({spawn_executable, Pty_bin}, - [stream, {cd, "/tmp"}, {env, [{"USER", User}]}, + [stream, {cd, TmpDir}, {env, [{"USER", User}]}, {args, []}, binary, exit_status, use_stdio, stderr_to_stdout]). diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 4658e76ab1..e9dc5764a3 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -56,15 +56,15 @@ %% errors. Returns {RootCert, Path, VerifyErrors} %%-------------------------------------------------------------------- trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) -> - Path = [Cert | _] = lists:reverse(CertChain), - OtpCert = public_key:pkix_decode_cert(Cert, otp), + Path = [BinCert | _] = lists:reverse(CertChain), + OtpCert = public_key:pkix_decode_cert(BinCert, otp), SignedAndIssuerID = case public_key:pkix_is_self_signed(OtpCert) of true -> {ok, IssuerId} = public_key:pkix_issuer_id(OtpCert, self), {self, IssuerId}; false -> - other_issuer(OtpCert, CertDbHandle) + other_issuer(OtpCert, BinCert, CertDbHandle) end, case SignedAndIssuerID of @@ -187,7 +187,7 @@ public_key_type(?'id-ecPublicKey') -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> +certificate_chain(OtpCert, BinCert, CertDbHandle, CertsDbRef, Chain) -> IssuerAndSelfSigned = case public_key:pkix_is_self_signed(OtpCert) of true -> @@ -200,7 +200,7 @@ certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> {_, true = SelfSigned} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, ignore, ignore, SelfSigned); {{error, issuer_not_found}, SelfSigned} -> - case find_issuer(OtpCert, CertDbHandle) of + case find_issuer(OtpCert, BinCert, CertDbHandle) of {ok, {SerialNr, Issuer}} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned); @@ -232,12 +232,12 @@ certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned {ok, undefined, lists:reverse(Chain)} end. -find_issuer(OtpCert, CertDbHandle) -> +find_issuer(OtpCert, BinCert, CertDbHandle) -> IsIssuerFun = fun({_Key, {_Der, #'OTPCertificate'{} = ErlCertCandidate}}, Acc) -> case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of true -> - case verify_cert_signer(OtpCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of + case verify_cert_signer(BinCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of true -> throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); false -> @@ -265,9 +265,9 @@ is_valid_extkey_usage(KeyUse, server) -> %% Server wants to verify client is_valid_key_usage(KeyUse, ?'id-kp-clientAuth'). -verify_cert_signer(OtpCert, SignerTBSCert) -> +verify_cert_signer(BinCert, SignerTBSCert) -> PublicKey = public_key(SignerTBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo), - public_key:pkix_verify(public_key:pkix_encode('OTPCertificate', OtpCert, otp), PublicKey). + public_key:pkix_verify(BinCert, PublicKey). public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'id-ecPublicKey', parameters = Params}, @@ -281,12 +281,12 @@ public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorith subjectPublicKey = Key}) -> {Key, Params}. -other_issuer(OtpCert, CertDbHandle) -> +other_issuer(OtpCert, BinCert, CertDbHandle) -> case public_key:pkix_issuer_id(OtpCert, other) of {ok, IssuerId} -> {other, IssuerId}; {error, issuer_not_found} -> - case find_issuer(OtpCert, CertDbHandle) of + case find_issuer(OtpCert, BinCert, CertDbHandle) of {ok, IssuerId} -> {other, IssuerId}; Other -> diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 00e95f5c5b..311dac4619 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -263,7 +263,9 @@ init([Name, Opts]) -> session_cache_client_max = max_session_cache_size(session_cache_client_max), session_cache_server_max = - max_session_cache_size(session_cache_server_max) + max_session_cache_size(session_cache_server_max), + session_client_invalidator = undefined, + session_server_invalidator = undefined }}. %%-------------------------------------------------------------------- @@ -378,13 +380,17 @@ handle_cast({invalidate_pem, File}, handle_info(validate_sessions, #state{session_cache_cb = CacheCb, session_cache_client = ClientCache, session_cache_server = ServerCache, - session_lifetime = LifeTime + session_lifetime = LifeTime, + session_client_invalidator = Client, + session_server_invalidator = Server } = State) -> Timer = erlang:send_after(?SESSION_VALIDATION_INTERVAL, self(), validate_sessions), - start_session_validator(ClientCache, CacheCb, LifeTime), - start_session_validator(ServerCache, CacheCb, LifeTime), - {noreply, State#state{session_validation_timer = Timer}}; + CPid = start_session_validator(ClientCache, CacheCb, LifeTime, Client), + SPid = start_session_validator(ServerCache, CacheCb, LifeTime, Server), + {noreply, State#state{session_validation_timer = Timer, + session_client_invalidator = CPid, + session_server_invalidator = SPid}}; handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = CacheCb @@ -471,9 +477,11 @@ validate_session(Port, Session, LifeTime) -> invalidate_session(Port, Session) end. -start_session_validator(Cache, CacheCb, LifeTime) -> +start_session_validator(Cache, CacheCb, LifeTime, undefined) -> spawn_link(?MODULE, init_session_validator, - [[get(ssl_manager), Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]); +start_session_validator(_,_,_, Pid) -> + Pid. init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> put(ssl_manager, SslManagerName), @@ -708,6 +716,6 @@ crl_db_info(_, UserCRLDb) -> %% Only start a session invalidator if there is not %% one already active invalidate_session_cache(undefined, CacheCb, Cache) -> - start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}); + start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}, undefined); invalidate_session_cache(Pid, _CacheCb, _Cache) -> Pid. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 75cfecdf5e..ce6b8fb84f 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -311,9 +311,19 @@ set_pending_cipher_state(#connection_states{pending_read = Read, %% %% Description: Encodes a handshake message to send on the ssl-socket. %%-------------------------------------------------------------------- -encode_handshake(Frag, Version, ConnectionStates) -> - encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). - +encode_handshake(Frag, Version, + #connection_states{current_write = + #connection_state{ + security_parameters = + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + case iolist_size(Frag) of + N when N > ?MAX_PLAIN_TEXT_LENGTH -> + Data = split_bin(iolist_to_binary(Frag), ?MAX_PLAIN_TEXT_LENGTH, Version, BCA), + encode_iolist(?HANDSHAKE, Data, Version, ConnectionStates); + _ -> + encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates) + end. %%-------------------------------------------------------------------- -spec encode_alert_record(#alert{}, ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index 080817d204..211badef56 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -89,6 +89,14 @@ listen_options(Opts0) -> Opts1 end. +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + lists:ukeysort(1, ConnectOpts ++ Opts); + _ -> + Opts + end. + %%==================================================================== %% gen_server callbacks %%==================================================================== @@ -101,7 +109,7 @@ init([]) -> {ok, #state{}}. handle_call({listen, Name}, _From, State) -> - case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}, {ip, loopback}]) of {ok, Socket} -> {ok, World} = do_listen([{active, false}, binary, {packet,?PPRE}, {reuseaddr, true}]), {ok, TcpAddress} = get_tcp_address(Socket), @@ -257,10 +265,10 @@ try_connect(Port) -> setup_proxy(Ip, Port, Parent) -> process_flag(trap_exit, true), - Opts = get_ssl_options(client), + Opts = connect_options(get_ssl_options(client)), case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}, nodelay()] ++ Opts) of {ok, World} -> - {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, {127,0,0,1}}, binary, {packet,?PPRE}]), + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, loopback}, binary, {packet,?PPRE}]), {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL), Parent ! {self(), go_ahead, LPort}, case gen_tcp:accept(ErtsL) of diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index 8e909a5b74..f5cada9021 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -334,7 +334,9 @@ make_key(dsa, _Opts) -> gen_dsa2(128, 20); %% Bytes i.e. {1024, 160} make_key(ec, _Opts) -> %% (OBS: for testing only) - gen_ec2(secp256k1). + CurveOid = hd(tls_v1:ecc_curves(0)), + NamedCurve = pubkey_cert_records:namedCurves(CurveOid), + gen_ec2(NamedCurve). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% RSA key generation (OBS: for testing only) diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 5940a86a7f..968ef30791 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -75,7 +75,8 @@ error_handling_tests()-> unknown_server_ca_accept_verify_none, unknown_server_ca_accept_verify_peer, unknown_server_ca_accept_backwardscompatibility, - no_authority_key_identifier]. + no_authority_key_identifier, + no_authority_key_identifier_and_nonstandard_encoding]. init_per_suite(Config0) -> catch crypto:stop(), @@ -850,6 +851,68 @@ delete_authority_key_extension([Head | Rest], Acc) -> %%-------------------------------------------------------------------- +no_authority_key_identifier_and_nonstandard_encoding() -> + [{doc, "Test cert with nonstandard encoding that does not have" + " authorityKeyIdentifier extension but are present in trusted certs db."}]. + +no_authority_key_identifier_and_nonstandard_encoding(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), + + CertFile = proplists:get_value(certfile, ServerOpts), + NewCertFile = filename:join(PrivDir, "server/new_cert.pem"), + [{'Certificate', DerCert, _}] = ssl_test_lib:pem_to_der(CertFile), + ServerCert = public_key:pkix_decode_cert(DerCert, plain), + ServerTbsCert = ServerCert#'Certificate'.tbsCertificate, + Extensions0 = ServerTbsCert#'TBSCertificate'.extensions, + %% need to remove authorityKeyIdentifier extension to cause DB lookup by signature + Extensions = delete_authority_key_extension(Extensions0, []), + NewExtensions = replace_key_usage_extension(Extensions, []), + NewServerTbsCert = ServerTbsCert#'TBSCertificate'{extensions = NewExtensions}, + + ct:log("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), + + TbsDer = public_key:pkix_encode('TBSCertificate', NewServerTbsCert, plain), + Sig = public_key:sign(TbsDer, md5, Key), + NewServerCert = ServerCert#'Certificate'{tbsCertificate = NewServerTbsCert, signature = Sig}, + NewDerCert = public_key:pkix_encode('Certificate', NewServerCert, plain), + ssl_test_lib:der_to_pem(NewCertFile, [{'Certificate', NewDerCert, not_encrypted}]), + NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, 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, + send_recv_result_active, []}}, + {options, [{active, true} | NewServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, []}}, + {options, [{verify, verify_peer} | ClientOpts]}]), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +replace_key_usage_extension([], Acc) -> + lists:reverse(Acc); +replace_key_usage_extension([#'Extension'{extnID = ?'id-ce-keyUsage'} = E | Rest], Acc) -> + %% A nonstandard DER encoding of [digitalSignature, keyEncipherment] + Val = <<3, 2, 0, 16#A0>>, + replace_key_usage_extension(Rest, [E#'Extension'{extnValue = Val} | Acc]); +replace_key_usage_extension([Head | Rest], Acc) -> + replace_key_usage_extension(Rest, [Head | Acc]). + +%%-------------------------------------------------------------------- + invalid_signature_server() -> [{doc,"Test client with invalid signature"}]. diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index 092015d3d8..00f9ee8e3c 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -41,7 +41,7 @@ %%-------------------------------------------------------------------- all() -> [basic, payload, plain_options, plain_verify_options, nodelay_option, - listen_port_options, listen_options, use_interface]. + listen_port_options, listen_options, connect_options, use_interface]. groups() -> []. @@ -312,22 +312,7 @@ listen_port_options(Config) when is_list(Config) -> listen_options() -> [{doc, "Test inet_dist_listen_options"}]. listen_options(Config) when is_list(Config) -> - Prio = 1, - case gen_udp:open(0, [{priority,Prio}]) of - {ok,Socket} -> - case inet:getopts(Socket, [priority]) of - {ok,[{priority,Prio}]} -> - ok = gen_udp:close(Socket), - do_listen_options(Prio, Config); - _ -> - ok = gen_udp:close(Socket), - {skip, - "Can not set priority "++integer_to_list(Prio)++ - " on socket"} - end; - {error,_} -> - {skip, "Can not set priority on socket"} - end. + try_setting_priority(fun do_listen_options/2, Config). do_listen_options(Prio, Config) -> PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]", @@ -364,6 +349,48 @@ do_listen_options(Prio, Config) -> stop_ssl_node(NH2), success(Config). %%-------------------------------------------------------------------- +connect_options() -> + [{doc, "Test inet_dist_connect_options"}]. +connect_options(Config) when is_list(Config) -> + try_setting_priority(fun do_connect_options/2, Config). + +do_connect_options(Prio, Config) -> + PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]", + PriorityString = + case os:cmd("echo [{a,1}]") of + "[{a,1}]"++_ -> + PriorityString0; + _ -> + %% Some shells need quoting of [{}] + "'"++PriorityString0++"'" + end, + + Options = "-kernel inet_dist_connect_options " ++ PriorityString, + + NH1 = start_ssl_node([{additional_dist_opts, Options} | Config]), + NH2 = start_ssl_node([{additional_dist_opts, Options} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + PrioritiesNode1 = + apply_on_ssl_node(NH1, fun get_socket_priorities/0), + PrioritiesNode2 = + apply_on_ssl_node(NH2, fun get_socket_priorities/0), + + Elevated1 = [P || P <- PrioritiesNode1, P =:= Prio], + ?t:format("Elevated1: ~p~n", [Elevated1]), + Elevated2 = [P || P <- PrioritiesNode2, P =:= Prio], + ?t:format("Elevated2: ~p~n", [Elevated2]), + %% Node 1 will have a socket with elevated priority. + [_|_] = Elevated1, + %% Node 2 will not, since it only applies to outbound connections. + [] = Elevated2, + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). +%%-------------------------------------------------------------------- use_interface() -> [{doc, "Test inet_dist_use_interface"}]. use_interface(Config) when is_list(Config) -> @@ -405,6 +432,24 @@ tstsrvr_format(Fmt, ArgList) -> send_to_tstcntrl(Message) -> send_to_tstsrvr({message, Message}). +try_setting_priority(TestFun, Config) -> + Prio = 1, + case gen_udp:open(0, [{priority,Prio}]) of + {ok,Socket} -> + case inet:getopts(Socket, [priority]) of + {ok,[{priority,Prio}]} -> + ok = gen_udp:close(Socket), + TestFun(Prio, Config); + _ -> + ok = gen_udp:close(Socket), + {skip, + "Can not set priority "++integer_to_list(Prio)++ + " on socket"} + end; + {error,_} -> + {skip, "Can not set priority on socket"} + end. + get_socket_priorities() -> [Priority || {ok,[{priority,Priority}]} <- @@ -493,17 +538,13 @@ host_name() -> Host. mk_node_name(Config) -> - {A, B, C} = erlang:now(), + N = erlang:unique_integer([positive]), Case = ?config(testcase, Config), atom_to_list(?MODULE) ++ "_" ++ atom_to_list(Case) ++ "_" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C). + ++ integer_to_list(N). mk_node_cmdline(ListenPort, Name, Args) -> Static = "-detached -noinput", @@ -732,12 +773,10 @@ rand_bin(N) -> rand_bin(0, Acc) -> Acc; rand_bin(N, Acc) -> - rand_bin(N-1, [random:uniform(256)-1|Acc]). + rand_bin(N-1, [rand:uniform(256)-1|Acc]). make_randfile(Dir) -> {ok, IoDev} = file:open(filename:join([Dir, "RAND"]), [write]), - {A, B, C} = erlang:now(), - random:seed(A, B, C), ok = file:write(IoDev, rand_bin(1024)), file:close(IoDev). diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 77c29668b5..afd21f0d2f 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -818,7 +818,17 @@ rsa_suites(CounterPart) -> (_) -> false end, - ssl:cipher_suites()). + common_ciphers(CounterPart)). + +common_ciphers(crypto) -> + ssl:cipher_suites(); +common_ciphers(openssl) -> + OpenSslSuites = + string:tokens(string:strip(os:cmd("openssl ciphers"), right, $\n), ":"), + [ssl:suite_definition(S) + || S <- ssl_cipher:suites(tls_record:highest_protocol_version([])), + lists:member(ssl_cipher:openssl_suite_name(S), OpenSslSuites) + ]. rsa_non_signed_suites() -> lists:filter(fun({rsa, _, _}) -> diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml index a0d3f95b6a..48400733d1 100644 --- a/lib/stdlib/doc/src/dets.xml +++ b/lib/stdlib/doc/src/dets.xml @@ -399,15 +399,40 @@ kept in RAM.</p> </item> <item> - <p><c>{safe_fixed,</c> SafeFixed<c>}</c>. If the table - is fixed, SafeFixed is a tuple <c>{FixedAtTime, [{Pid,RefCount}]}</c>. <c>FixedAtTime</c> is the time when + <p><c>{safe_fixed_monotonic_time, SafeFixed}</c>. If the table + is fixed, <c>SafeFixed</c> is a tuple <c>{FixedAtTime, [{Pid,RefCount}]}</c>. + <c>FixedAtTime</c> is the time when the table was first fixed, and <c>Pid</c> is the pid of the process that fixes the table <c>RefCount</c> times. There may be any number of processes in the list. If the table is not fixed, SafeFixed is the atom <c>false</c>.</p> + <p><c>FixedAtTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#monotonic_time/0">erlang:monotonic_time/0</seealso> + at the time of fixation. The usage of <c>safe_fixed_monotonic_time</c> is + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>.</p> </item> <item> - <p><c>{version, integer()</c>, the version of the format of + <p> + <c>{safe_fixed, SafeFixed}</c>. The same as + <c>{safe_fixed_monotonic_time, SafeFixed}</c> with the exception + of the format and value of <c>FixedAtTime</c>. + </p> + <p> + <c>FixedAtTime</c> will correspond to the result returned by + <seealso marker="erts:erlang#timestamp/0">erlang:timestamp/0</seealso> + at the time of fixation. Note that when the system is using + single or multi + <seealso marker="erts:time_correction#Time_Warp_Modes">time warp + modes</seealso> this might produce strange results. This + since the usage of <c>safe_fixed</c> is not + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>. Time warp safe code need to use + <c>safe_fixed_monotonic_time</c> instead.</p> + </item> + <item> + <p><c>{version, integer()}</c>, the version of the format of the table.</p> </item> </list> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 7b01109ff8..447fe51130 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -488,14 +488,39 @@ Error: fun containing local Erlang function calls <item><c>Item=fixed, Value=boolean()</c> <br></br> Indicates if the table is fixed by any process or not.</item> - <item> - <p><c>Item=safe_fixed, Value={FirstFixed,Info}|false</c> <br></br> + <item><marker id="info_2_safe_fixed_monotonic_time"/> + <p><c>Item=safe_fixed|safe_fixed_monotonic_time, Value={FixationTime,Info}|false</c> <br></br> </p> - <p>If the table has been fixed using <c>safe_fixtable/2</c>, - the call returns a tuple where <c>FirstFixed</c> is the + <p>If the table has been fixed using + <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso>, + the call returns a tuple where <c>FixationTime</c> is the time when the table was first fixed by a process, which may or may not be one of the processes it is fixed by right now.</p> + <p>The format and value of <c>FixationTime</c> depends on + <c>Item</c>:</p> + <taglist> + <tag><c>safe_fixed</c></tag> + <item><p><c>FixationTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#timestamp/0">erlang:timestamp/0</seealso> + at the time of fixation. Note that when the system is using + single or multi + <seealso marker="erts:time_correction#Time_Warp_Modes">time warp + modes</seealso> this might produce strange results. This + since the usage of <c>safe_fixed</c> is not + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>. Time warp safe code need to use + <c>safe_fixed_monotonic_time</c> instead.</p></item> + + <tag><c>safe_fixed_monotonic_time</c></tag> + <item><p><c>FixationTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#monotonic_time/0">erlang:monotonic_time/0</seealso> + at the time of fixation. The usage of <c>safe_fixed_monotonic_time</c> is + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>.</p></item> + </taglist> <p><c>Info</c> is a possibly empty lists of tuples <c>{Pid,RefCount}</c>, one tuple for every process the table is fixed by right now. <c>RefCount</c> is the value @@ -1135,9 +1160,11 @@ clean_all_with_value(Tab,X,Key) -> table but never releases it, the memory used by the deleted objects will never be freed. The performance of operations on the table will also degrade significantly.</p> - <p>Use <c>info/2</c> to retrieve information about which - processes have fixed which tables. A system with a lot of - processes fixing tables may need a monitor which sends alarms + <p>Use + <seealso marker="#info_2_safe_fixed_monotonic_time"><c>info(Tab, + safe_fixed_monotonic_time)</c></seealso> to retrieve information + about which processes have fixed which tables. A system with a lot + of processes fixing tables may need a monitor which sends alarms when tables have been fixed for too long.</p> <p>Note that for tables of the <c>ordered_set</c> type, <c>safe_fixtable/2</c> is not necessary as calls to diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 24ff251ce3..815bf4a489 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -543,7 +543,10 @@ </item> <item> <p><c>active</c> - the count of all actively running child processes - managed by this supervisor.</p> + managed by this supervisor. In the case of <c>simple_one_for_one</c> + supervisors, no check is carried out to ensure that each child process + is still alive, though the result provided here is likely to be very + accurate unless the supervisor is heavily overloaded.</p> </item> <item> <p><c>supervisors</c> - the count of all children marked as diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index 529ae30862..c2e345763a 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -18,11 +18,11 @@ %% -module(erl_id_trans). -%% A identity transformer of Erlang abstract syntax. +%% An identity transformer of Erlang abstract syntax. %% This module only traverses legal Erlang code. This is most noticeable %% in guards where only a limited number of expressions are allowed. -%% N.B. if this module is to be used as a basis for tranforms then +%% N.B. if this module is to be used as a basis for transforms then %% all the error cases must be handled otherwise this module just crashes! -export([parse_transform/2]). @@ -53,6 +53,17 @@ form({attribute,Line,export,Es0}) -> form({attribute,Line,import,{Mod,Is0}}) -> Is1 = farity_list(Is0), {attribute,Line,import,{Mod,Is1}}; +form({attribute,Line,export_type,Es0}) -> + Es1 = farity_list(Es0), + {attribute,Line,export_type,Es1}; +form({attribute,Line,optional_callbacks,Es0}) -> + try farity_list(Es0) of + Es1 -> + {attribute,Line,optional_callbacks,Es1} + catch + _:_ -> + {attribute,Line,optional_callbacks,Es0} + end; form({attribute,Line,compile,C}) -> {attribute,Line,compile,C}; form({attribute,Line,record,{Name,Defs0}}) -> @@ -60,14 +71,28 @@ form({attribute,Line,record,{Name,Defs0}}) -> {attribute,Line,record,{Name,Defs1}}; form({attribute,Line,asm,{function,N,A,Code}}) -> {attribute,Line,asm,{function,N,A,Code}}; +form({attribute,Line,type,{N,T,Vs}}) -> + T1 = type(T), + Vs1 = variable_list(Vs), + {attribute,Line,type,{N,T1,Vs1}}; +form({attribute,Line,opaque,{N,T,Vs}}) -> + T1 = type(T), + Vs1 = variable_list(Vs), + {attribute,Line,opaque,{N,T1,Vs1}}; +form({attribute,Line,spec,{{N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,spec,{{N,A},FTs1}}; +form({attribute,Line,spec,{{M,N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,spec,{{M,N,A},FTs1}}; +form({attribute,Line,callback,{{N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,callback,{{N,A},FTs1}}; form({attribute,Line,Attr,Val}) -> %The general attribute. {attribute,Line,Attr,Val}; form({function,Line,Name0,Arity0,Clauses0}) -> {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0), {function,Line,Name,Arity,Clauses}; -% Mnemosyne, ignore... -form({rule,Line,Name,Arity,Body}) -> - {rule,Line,Name,Arity,Body}; % Dont dig into this %% Extra forms from the parser. form({error,E}) -> {error,E}; form({warning,W}) -> {warning,W}; @@ -79,6 +104,12 @@ farity_list([{Name,Arity}|Fas]) -> [{Name,Arity}|farity_list(Fas)]; farity_list([]) -> []. +%% -type variable_list([Var]) -> [Var] + +variable_list([{var,Line,Var}|Vs]) -> + [{var,Line,Var}|variable_list(Vs)]; +variable_list([]) -> []. + %% -type record_defs([RecDef]) -> [RecDef]. %% N.B. Field names are full expressions here but only atoms are allowed %% by the *parser*! @@ -88,6 +119,16 @@ record_defs([{record_field,Line,{atom,La,A},Val0}|Is]) -> [{record_field,Line,{atom,La,A},Val1}|record_defs(Is)]; record_defs([{record_field,Line,{atom,La,A}}|Is]) -> [{record_field,Line,{atom,La,A}}|record_defs(Is)]; +record_defs([{typed_record_field,{record_field,Line,{atom,La,A},Val0},Type}| + Is]) -> + Val1 = expr(Val0), + Type1 = type(Type), + [{typed_record_field,{record_field,Line,{atom,La,A},Val1},Type1}| + record_defs(Is)]; +record_defs([{typed_record_field,{record_field,Line,{atom,La,A}},Type}|Is]) -> + Type1 = type(Type), + [{typed_record_field,{record_field,Line,{atom,La,A}},Type1}| + record_defs(Is)]; record_defs([]) -> []. %% -type function(atom(), integer(), [Clause]) -> {atom(),integer(),[Clause]}. @@ -196,9 +237,9 @@ pattern_grp([]) -> bit_types([]) -> []; -bit_types([Atom | Rest]) when atom(Atom) -> +bit_types([Atom | Rest]) when is_atom(Atom) -> [Atom | bit_types(Rest)]; -bit_types([{Atom, Integer} | Rest]) when atom(Atom), integer(Integer) -> +bit_types([{Atom, Integer} | Rest]) when is_atom(Atom), is_integer(Integer) -> [{Atom, Integer} | bit_types(Rest)]. @@ -226,7 +267,7 @@ pattern_fields([]) -> []. %% -type guard([GuardTest]) -> [GuardTest]. -guard([G0|Gs]) when list(G0) -> +guard([G0|Gs]) when is_list(G0) -> [guard0(G0) | guard(Gs)]; guard(L) -> guard0(L). @@ -547,3 +588,97 @@ fun_clauses([C0|Cs]) -> C1 = clause(C0), [C1|fun_clauses(Cs)]; fun_clauses([]) -> []. + +function_type_list([{type,Line,bounded_fun,[Ft,Fc]}|Fts]) -> + Ft1 = function_type(Ft), + Fc1 = function_constraint(Fc), + [{type,Line,bounded_fun,[Ft1,Fc1]}|function_type_list(Fts)]; +function_type_list([Ft|Fts]) -> + [function_type(Ft)|function_type_list(Fts)]; +function_type_list([]) -> []. + +function_type({type,Line,'fun',[{type,Lt,product,As},B]}) -> + As1 = type_list(As), + B1 = type(B), + {type,Line,'fun',[{type,Lt,product,As1},B1]}. + +function_constraint([C|Cs]) -> + C1 = constraint(C), + [C1|function_constraint(Cs)]; +function_constraint([]) -> []. + +constraint({type,Line,constraint,[{atom,L,A},[V,T]]}) -> + V1 = type(V), + T1 = type(T), + {type,Line,constraint,[{atom,L,A},[V1,T1]]}. + +type({ann_type,Line,[{var,Lv,V},T]}) -> + T1 = type(T), + {ann_type,Line,[{var,Lv,V},T1]}; +type({atom,Line,A}) -> + {atom,Line,A}; +type({integer,Line,I}) -> + {integer,Line,I}; +type({op,Line,Op,T}) -> + T1 = type(T), + {op,Line,Op,T1}; +type({op,Line,Op,L,R}) -> + L1 = type(L), + R1 = type(R), + {op,Line,Op,L1,R1}; +type({type,Line,binary,[M,N]}) -> + M1 = type(M), + N1 = type(N), + {type,Line,binary,[M1,N1]}; +type({type,Line,'fun',[]}) -> + {type,Line,'fun',[]}; +type({type,Line,'fun',[{type,Lt,any},B]}) -> + B1 = type(B), + {type,Line,'fun',[{type,Lt,any},B1]}; +type({type,Line,range,[L,H]}) -> + L1 = type(L), + H1 = type(H), + {type,Line,range,[L1,H1]}; +type({type,Line,map,any}) -> + {type,Line,map,any}; +type({type,Line,map,Ps}) -> + Ps1 = map_pair_types(Ps), + {type,Line,map,Ps1}; +type({type,Line,record,[{atom,La,N}|Fs]}) -> + Fs1 = field_types(Fs), + {type,Line,record,[{atom,La,N}|Fs1]}; +type({remote_type,Line,[{atom,Lm,M},{atom,Ln,N},As]}) -> + As1 = type_list(As), + {remote_type,Line,[{atom,Lm,M},{atom,Ln,N},As1]}; +type({type,Line,tuple,any}) -> + {type,Line,tuple,any}; +type({type,Line,tuple,Ts}) -> + Ts1 = type_list(Ts), + {type,Line,tuple,Ts1}; +type({type,Line,union,Ts}) -> + Ts1 = type_list(Ts), + {type,Line,union,Ts1}; +type({var,Line,V}) -> + {var,Line,V}; +type({user_type,Line,N,As}) -> + As1 = type_list(As), + {user_type,Line,N,As1}; +type({type,Line,N,As}) -> + As1 = type_list(As), + {type,Line,N,As1}. + +map_pair_types([{type,Line,map_field_assoc,[K,V]}|Ps]) -> + K1 = type(K), + V1 = type(V), + [{type,Line,map_field_assoc,[K1,V1]}|map_pair_types(Ps)]; +map_pair_types([]) -> []. + +field_types([{type,Line,field_type,[{atom,La,A},T]}|Fs]) -> + T1 = type(T), + [{type,Line,field_type,[{atom,La,A},T1]}|field_types(Fs)]; +field_types([]) -> []. + +type_list([T|Ts]) -> + T1 = type(T), + [T1|type_list(Ts)]; +type_list([]) -> []. diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 6e00401dce..00cd1221fa 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -931,7 +931,10 @@ call_crypto_server(Req) -> end. call_crypto_server_1(Req) -> - {ok, _} = gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []), + case gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []) of + {ok, _} -> ok; + {error, {already_started, _}} -> ok + end, erlang:yield(), call_crypto_server(Req). @@ -972,9 +975,7 @@ handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) -> handle_call({crypto_key_fun, F}, {_,_} = From, S) -> case S#state.crypto_key_f of undefined -> - %% Don't allow tuple funs here. (They weren't allowed before, - %% so there is no reason to allow them now.) - if is_function(F), is_function(F, 1) -> + if is_function(F, 1) -> {Result, Fun, Reply} = case catch F(init) of ok -> diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 6887bda67c..bf22949870 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -372,7 +372,7 @@ info(Tab) -> Item :: 'access' | 'auto_save' | 'bchunk_format' | 'hash' | 'file_size' | 'filename' | 'keypos' | 'memory' | 'no_keys' | 'no_objects' | 'no_slots' | 'owner' | 'ram_file' - | 'safe_fixed' | 'size' | 'type' | 'version', + | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type' | 'version', Value :: term(). info(Tab, owner) -> @@ -1974,7 +1974,9 @@ do_safe_fixtable(Head, Pid, true) -> case Head#head.fixed of false -> link(Pid), - Fixed = {utime_now(), [{Pid, 1}]}, + MonTime = erlang:monotonic_time(), + TimeOffset = erlang:time_offset(), + Fixed = {{MonTime, TimeOffset}, [{Pid, 1}]}, Ftab = dets_utils:get_freelists(Head), Head#head{fixed = Fixed, freelists = {Ftab, Ftab}}; {TimeStamp, Counters} -> @@ -2101,7 +2103,22 @@ finfo(H, no_keys) -> finfo(H, no_slots) -> {H, (H#head.mod):no_slots(H)}; finfo(H, pid) -> {H, self()}; finfo(H, ram_file) -> {H, H#head.ram_file}; -finfo(H, safe_fixed) -> {H, H#head.fixed}; +finfo(H, safe_fixed) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, TimeOffset}, RefList} -> + {make_timestamp(FixMonTime, TimeOffset), RefList} + end}; +finfo(H, safe_fixed_monotonic_time) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, _TimeOffset}, RefList} -> + {FixMonTime, RefList} + end}; finfo(H, size) -> case catch write_cache(H) of {H2, []} -> @@ -3285,11 +3302,14 @@ err(Error) -> time_now() -> erlang:monotonic_time(1000000). --compile({inline, [utime_now/0]}). -utime_now() -> - Time = time_now(), - UniqueCounter = erlang:unique_integer([monotonic]), - {Time, UniqueCounter}. +make_timestamp(MonTime, TimeOffset) -> + ErlangSystemTime = erlang:convert_time_unit(MonTime+TimeOffset, + native, + micro_seconds), + MegaSecs = ErlangSystemTime div 1000000000000, + Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000, + MicroSecs = ErlangSystemTime rem 1000000, + {MegaSecs, Secs, MicroSecs}. %%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%% diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 196158cd48..34a8ddddaa 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -747,6 +747,8 @@ all_allocated([{X,Y} | L], _X0, Y0, A) when Y0 < X -> all_allocated_as_list(Head) -> all_allocated_as_list(all(get_freelists(Head)), 0, Head#head.base, []). +-dialyzer({no_improper_lists, all_allocated_as_list/4}). + all_allocated_as_list([], _X0, _Y0, []) -> []; all_allocated_as_list([], _X0, _Y0, A) -> diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index 49126193b8..1bf53d91b1 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -36,6 +36,8 @@ %% For backward compatibility. -export([sz2pos/1]). +-dialyzer(no_improper_lists). + -compile({inline, [{sz2pos,1},{scan_skip,7}]}). -compile({inline, [{skip_bytes,5}, {get_segp,1}]}). -compile({inline, [{wl_lookup,5}]}). diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 361780c776..6c406fc03a 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,6 +34,8 @@ -export([cache_segps/3]). +-dialyzer(no_improper_lists). + -compile({inline, [{max_objsize,1},{maxobjsize,1}]}). -compile({inline, [{write_segment_file,6}]}). -compile({inline, [{sz2pos,1},{adjsz,1}]}). diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 6ce3710f87..f921e28ef6 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-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. @@ -333,6 +333,8 @@ update_counter(Key, Incr, D0) when is_number(Incr) -> D0, Slot), maybe_expand(D1, Ic). +-dialyzer({no_improper_lists, counter_bkt/3}). + counter_bkt(Key, I, [?kv(Key,Val)|Bkt]) -> {[?kv(Key,Val+I)|Bkt],0}; counter_bkt(Key, I, [Other|Bkt0]) -> diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl index e51e560542..8a4df95027 100644 --- a/lib/stdlib/src/digraph.erl +++ b/lib/stdlib/src/digraph.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -338,6 +338,8 @@ edge(G, E) -> %% -spec new_edge_id(graph()) -> edge(). +-dialyzer({no_improper_lists, new_edge_id/1}). + new_edge_id(G) -> NT = G#digraph.ntab, [{'$eid', K}] = ets:lookup(NT, '$eid'), @@ -350,6 +352,8 @@ new_edge_id(G) -> %% -spec new_vertex_id(graph()) -> vertex(). +-dialyzer({no_improper_lists, new_vertex_id/1}). + new_vertex_id(G) -> NT = G#digraph.ntab, [{'$vid', K}] = ets:lookup(NT, '$vid'), diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 45f616bb02..be7c2ec346 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -258,20 +258,7 @@ parse_file(Ifile, Options) -> parse_file(Epp) -> case parse_erl_form(Epp) of {ok,Form} -> - case Form of - {attribute,La,record,{Record, Fields}} -> - case normalize_typed_record_fields(Fields) of - {typed, NewFields} -> - [{attribute, La, record, {Record, NewFields}}, - {attribute, La, type, - {{record, Record}, Fields, []}} - |parse_file(Epp)]; - not_typed -> - [Form|parse_file(Epp)] - end; - _ -> - [Form|parse_file(Epp)] - end; + [Form|parse_file(Epp)]; {error,E} -> [{error,E}|parse_file(Epp)]; {eof,Location} -> diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index bcfeef7321..9c0a7fb7d5 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -33,8 +33,6 @@ vcount=0, % Variable counter imports=[], % Imports records=dict:new(), % Record definitions - trecords=sets:new(), % Typed records - uses_types=false, % Are there -spec or -type in the module strict_ra=[], % strict record accesses checked_ra=[] % successfully accessed records }). @@ -47,45 +45,18 @@ %% erl_lint without errors. module(Fs0, Opts0) -> Opts = compiler_options(Fs0) ++ Opts0, - TRecs = typed_records(Fs0), - UsesTypes = uses_types(Fs0), - St0 = #exprec{compile = Opts, trecords = TRecs, uses_types = UsesTypes}, + St0 = #exprec{compile = Opts}, {Fs,_St} = forms(Fs0, St0), Fs. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -typed_records(Fs) -> - typed_records(Fs, sets:new()). - -typed_records([{attribute,_L,type,{{record, Name},_Defs,[]}} | Fs], Trecs) -> - typed_records(Fs, sets:add_element(Name, Trecs)); -typed_records([_|Fs], Trecs) -> - typed_records(Fs, Trecs); -typed_records([], Trecs) -> - Trecs. - -uses_types([{attribute,_L,spec,_}|_]) -> true; -uses_types([{attribute,_L,type,_}|_]) -> true; -uses_types([{attribute,_L,opaque,_}|_]) -> true; -uses_types([_|Fs]) -> uses_types(Fs); -uses_types([]) -> false. - -forms([{attribute,L,record,{Name,Defs}} | Fs], St0) -> +forms([{attribute,_,record,{Name,Defs}}=Attr | Fs], St0) -> NDefs = normalise_fields(Defs), St = St0#exprec{records=dict:store(Name, NDefs, St0#exprec.records)}, {Fs1, St1} = forms(Fs, St), - %% Check if we need to keep the record information for usage in types. - case St#exprec.uses_types of - true -> - case sets:is_element(Name, St#exprec.trecords) of - true -> {Fs1, St1}; - false -> {[{attribute,L,type,{{record,Name},Defs,[]}}|Fs1], St1} - end; - false -> - {Fs1, St1} - end; + {[Attr | Fs1], St1}; forms([{attribute,L,import,Is} | Fs0], St0) -> St1 = import(Is, St0), {Fs,St2} = forms(Fs0, St1), @@ -513,7 +484,6 @@ lc_tq(Line, [F0 | Qs0], St0) -> lc_tq(_Line, [], St0) -> {[],St0#exprec{checked_ra = []}}. - %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If %% none has been given then use 'undefined'. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 9ef4acdf5f..4ca9a609a8 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -360,6 +360,9 @@ format_error({redefine_type, {TypeName, Arity}}) -> [TypeName, gen_type_paren(Arity)]); format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); +format_error(old_abstract_code) -> + io_lib:format("abstract code generated before Erlang/OTP 19.0 and " + "having typed record fields cannot be compiled", []); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); format_error({redefine_spec, {F, A}}) -> @@ -1143,7 +1146,7 @@ check_untyped_records(Forms, St0) -> RecNames = dict:fetch_keys(St0#lint.records), %% these are the records with field(s) containing type info TRecNames = [Name || - {attribute,_,type,{{record,Name},Fields,_}} <- Forms, + {attribute,_,record,{Name,Fields}} <- Forms, lists:all(fun ({typed_record_field,_,_}) -> true; (_) -> false end, Fields)], @@ -1153,7 +1156,8 @@ check_untyped_records(Forms, St0) -> [] -> St; % exclude records with no fields [_|_] -> add_warning(L, {untyped_record, N}, St) end - end, St0, RecNames -- TRecNames); + end, St0, ordsets:subtract(ordsets:from_list(RecNames), + ordsets:from_list(TRecNames))); false -> St0 end. @@ -2443,7 +2447,10 @@ record_def(Line, Name, Fs0, St0) -> true -> add_error(Line, {redefine_record,Name}, St0); false -> {Fs1,St1} = def_fields(normalise_fields(Fs0), Name, St0), - St1#lint{records=dict:store(Name, {Line,Fs1}, St1#lint.records)} + St2 = St1#lint{records=dict:store(Name, {Line,Fs1}, + St1#lint.records)}, + Types = [T || {typed_record_field, _, T} <- Fs0], + check_type({type, nowarn(), product, Types}, St2) end. %% def_fields([RecDef], RecordName, State) -> {[DefField],State}. @@ -2646,11 +2653,6 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. -type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> - %% The record field names and such are checked in the record format. - %% We only need to check the types. - Types = [T || {typed_record_field, _, T} <- Fields], - check_type({type, nowarn(), product, Types}, St0); type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), @@ -2813,6 +2815,8 @@ check_type({user_type, L, TypeName, Args}, SeenVars, St) -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) end, {SeenVars, St1}, Args); +check_type([{typed_record_field,Field,_T}|_], SeenVars, St) -> + {SeenVars, add_error(element(2, Field), old_abstract_code, St)}; check_type(I, SeenVars, St) -> case erl_eval:partial_eval(I) of {integer,_ILn,_Integer} -> {SeenVars, St}; @@ -2994,9 +2998,10 @@ add_missing_spec_warnings(Forms, St0, Type) -> [{FA,L} || {function,L,F,A,_} <- Forms, not lists:member(FA = {F,A}, Specs)]; exported -> - Exps = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps0 = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps = Exps0 -- Specs, [{FA,L} || {function,L,F,A,_} <- Forms, - member(FA = {F,A}, Exps -- Specs)] + member(FA = {F,A}, Exps)] end, foldl(fun ({FA,L}, St) -> add_warning(L, {missing_spec,FA}, St) @@ -3009,7 +3014,9 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D), UsedTypes = gb_sets:from_list(L), FoldFun = - fun(Type, #typeinfo{line = FileLine}, AccSt) -> + fun({{record, _}=_Type, 0}, _, AccSt) -> + AccSt; % Before Erlang/OTP 19.0 + (Type, #typeinfo{line = FileLine}, AccSt) -> case loc(FileLine, AccSt) of {FirstFile, _} -> case gb_sets:is_member(Type, UsedTypes) of @@ -3531,6 +3538,8 @@ check_qlc_hrl(Line, M, F, As, St) -> %% deprecated_function(Line, ModName, FuncName, [Arg], State) -> State. %% Add warning for calls to deprecated functions. +-dialyzer({no_match, deprecated_function/5}). + deprecated_function(Line, M, F, As, St) -> Arity = length(As), MFA = {M, F, Arity}, @@ -3560,6 +3569,7 @@ deprecated_function(Line, M, F, As, St) -> end. -dialyzer({no_match, deprecated_type/5}). + deprecated_type(L, M, N, As, St) -> NAs = length(As), case otp_internal:obsolete_type(M, N, NAs) of diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 847def2fd8..1fca3624dc 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -146,7 +146,7 @@ info(_) -> Tab :: tab(), Item :: compressed | fixed | heir | keypos | memory | name | named_table | node | owner | protection - | safe_fixed | size | stats | type + | safe_fixed | safe_fixed_monotonic_time | size | stats | type | write_concurrency | read_concurrency, Value :: term(). diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 47adb133b0..3aeaff8dc4 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,6 +28,8 @@ check/1, check/2, keycheck/2, keycheck/3]). +-dialyzer(no_improper_lists). + -include_lib("kernel/include/file.hrl"). -define(CHUNKSIZE, 16384). @@ -305,7 +307,6 @@ options(Option) -> options([{format, Format} | L], Opts) when Format =:= binary; Format =:= term; - is_function(Format), is_function(Format, 1) -> options(L, Opts#opts{format = Format}); options([{format, binary_term} | L], Opts) -> @@ -324,7 +325,7 @@ options([{tmpdir, Dir} | L], Opts) -> FileName -> options(L, Opts#opts{tmpdir = {dir, FileName}}) end; -options([{order, Fun} | L], Opts) when is_function(Fun), is_function(Fun, 2) -> +options([{order, Fun} | L], Opts) when is_function(Fun, 2) -> options(L, Opts#opts{order = Fun}); options([{order, Order} | L], Opts) when Order =:= ascending; Order =:= descending -> @@ -409,7 +410,7 @@ merge_terms_fun(RFun) -> case RFun(read) of end_of_input -> eof; - {Objs, NRFun} when is_function(NRFun), is_function(NRFun, 1) -> + {Objs, NRFun} when is_function(NRFun, 1) -> {_, [], Ts, _} = fun_objs(Objs, [], 0, ?MAXSIZE, I, W), {{I, Ts, ?CHUNKSIZE}, merge_terms_fun(NRFun)}; Error -> @@ -425,13 +426,12 @@ merge_bins_fun(FileName) -> Fun(A) end. -wrap_output_terms(term, OutFun, _Z) when is_function(OutFun), - is_function(OutFun, 1) -> +wrap_output_terms(term, OutFun, _Z) when is_function(OutFun, 1) -> {fun_wterms(OutFun), true}; wrap_output_terms(term, File, Z) when File =/= undefined -> {file_wterms(name, File, Z++[write]), false}; wrap_output_terms(_Format, Output, _Z) -> - {Output, is_function(Output) and is_function(Output, 1)}. + {Output, is_function(Output, 1)}. binary_term_fun() -> fun binary_to_term/1. @@ -1309,8 +1309,7 @@ infun(W) -> {end_of_input, W1}; {end_of_input, Value} -> {end_of_input, W1#w{inout_value = {value, Value}}}; - {Objs, NFun} when is_function(NFun), - is_function(NFun, 1), + {Objs, NFun} when is_function(NFun, 1), is_list(Objs) -> {cont, W#w{in = NFun}, Objs}; Error -> @@ -1333,7 +1332,7 @@ outfun(A, W) -> try (W#w.out)(A) of Reply when A =:= close -> Reply; - NF when is_function(NF), is_function(NF, 1) -> + NF when is_function(NF, 1) -> W#w{out = NF}; Error -> error(Error, W1) @@ -1358,7 +1357,7 @@ is_keyposs([Bad | _]) -> is_keyposs(Bad) -> {badarg, Bad}. -is_input(Fun) when is_function(Fun), is_function(Fun, 1) -> +is_input(Fun) when is_function(Fun, 1) -> {true, Fun}; is_input(Files) -> is_files(Files). @@ -1378,7 +1377,7 @@ is_files([], L) -> is_files(Bad, _L) -> {badarg, Bad}. -maybe_output(Fun) when is_function(Fun), is_function(Fun, 1) -> +maybe_output(Fun) when is_function(Fun, 1) -> {true, Fun}; maybe_output(File) -> case read_file_info(File) of @@ -1587,7 +1586,6 @@ fun_rterms(InFun) -> (read) -> case InFun(read) of {Ts, NInFun} when is_list(Ts), - is_function(NInFun), is_function(NInFun, 1) -> {to_bin(Ts, []), fun_rterms(NInFun)}; Else -> @@ -1600,7 +1598,7 @@ fun_wterms(OutFun) -> OutFun(close); (L) -> case OutFun(wterms_arg(L)) of - NOutFun when is_function(NOutFun), is_function(NOutFun, 1) -> + NOutFun when is_function(NOutFun, 1) -> fun_wterms(NOutFun); Else -> Else diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index 62b6ca8a21..2b4472cdf7 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2267,6 +2267,8 @@ ukeysplit_2(I, Y, EY, [Z | L], R) -> ukeysplit_2(_I, Y, _EY, [], R) -> [Y | R]. +-dialyzer({no_improper_lists, ukeymergel/3}). + ukeymergel(I, [T1, [H2 | T2], [H3 | T3] | L], Acc) -> %% The fourth argument, [H2 | H3] (=HdM), may confuse type %% checkers. Its purpose is to ensure that the tests H2 == HdM diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index b67b6f75d7..24b5fde1db 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -307,15 +307,18 @@ cleanup_filename({Old,OldRec,OldWarnings}) -> add_record_definition({Name,FieldList}) -> {KeyList,_} = lists:foldl( - fun({record_field,_,{atom,Line0,FieldName}},{L,C}) -> - {[{FieldName,C,{atom,Line0,undefined}}|L],C+1}; - ({record_field,_,{atom,_,FieldName},Def},{L,C}) -> - {[{FieldName,C,Def}|L],C+1} - end, + fun(F, {L,C}) -> {[record_field(F, C)|L],C+1} end, {[],2}, FieldList), put_records([{Name,KeyList}|get_records()]). +record_field({record_field,_,{atom,Line0,FieldName}}, C) -> + {FieldName,C,{atom,Line0,undefined}}; +record_field({record_field,_,{atom,_,FieldName},Def}, C) -> + {FieldName,C,Def}; +record_field({typed_record_field,Field,_Type}, C) -> + record_field(Field, C). + forms([F0|Fs0]) -> F1 = form(F0), Fs1 = forms(Fs0), diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index bc70c296da..0dc2626ae8 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,6 +23,8 @@ %%---------------------------------------------------------------------- +-dialyzer({no_match, obsolete/3}). + -type tag() :: 'deprecated' | 'removed'. %% | 'experimental'. -type mfas() :: mfa() | {atom(), atom(), [byte()]}. -type release() :: string(). @@ -697,18 +699,20 @@ is_snmp_agent_function(del_agent_caps, 1) -> true; is_snmp_agent_function(get_agent_caps, 0) -> true; is_snmp_agent_function(_, _) -> false. +-dialyzer({no_match, obsolete_type/3}). + -spec obsolete_type(module(), atom(), arity()) -> 'no' | {tag(), string()} | {tag(), mfas(), release()}. -dialyzer({no_match, obsolete_type/3}). obsolete_type(Module, Name, NumberOfVariables) -> case obsolete_type_1(Module, Name, NumberOfVariables) of - {deprecated=Tag,{_,_,_}=Replacement} -> - {Tag,Replacement,"in a future release"}; + {deprecated=Tag,{_,_,_}=Replacement} -> + {Tag,Replacement,"in a future release"}; {_,String}=Ret when is_list(String) -> Ret; - {_,_,_}=Ret -> - Ret; + {_,_,_}=Ret -> + Ret; no -> no end. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 3ba3a88038..b396ba7057 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,6 +51,8 @@ -export([template_state/0, aux_name/3, name_suffix/2, vars/1, var_ufold/2, var_fold/3, all_selections/1]). +-dialyzer(no_improper_lists). + %% When cache=list lists bigger than ?MAX_LIST_SIZE bytes are put on %% file. Also used when merge join finds big equivalence classes. -define(MAX_LIST_SIZE, 512*1024). @@ -808,21 +810,21 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {ok, U}; {pre_fun, U=undefined} -> {ok, U}; - {info_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {info_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {pre_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {pre_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {post_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {post_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; - {lookup_fun, Fun} when is_function(Fun), is_function(Fun, 2) -> + {lookup_fun, Fun} when is_function(Fun, 2) -> {ok, Fun}; {max_lookup, Max} when is_integer(Max), Max >= 0 -> {ok, Max}; {max_lookup, infinity} -> {ok, -1}; - {format_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {format_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {parent_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {parent_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; {key_equality, KE='=='} -> {ok, KE}; @@ -885,7 +887,7 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {depth, Depth} when Depth =:= infinity; is_integer(Depth), Depth >= 0 -> {ok, Depth}; - {order, Order} when is_function(Order), is_function(Order, 2); + {order, Order} when is_function(Order, 2); (Order =:= ascending); (Order =:= descending) -> {ok, Order}; diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 9f69cd5003..e4b9768b12 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -1914,9 +1914,9 @@ expand_pattern_records(P, State) -> expand_expr_records(E, State) -> RecordDefs = State#state.records, A = anno1(), - Forms = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], - [{function,_,foo,0,[{clause,_,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [no_strict_record_tests]), + Forms0 = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], + Forms = erl_expand_records:module(Forms0, [no_strict_record_tests]), + {function,_,foo,0,[{clause,_,[],[],[NE]}]} = lists:last(Forms), NE. %% Partial evaluation. diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index dc060e82d9..d455abf7b0 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -256,6 +256,8 @@ exs64_uniform(Max, {Alg, R}) -> %% ===================================================================== -type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). +-dialyzer({no_improper_lists, exsplus_seed/1}). + exsplus_seed({A1, A2, A3}) -> {_, R1} = exsplus_next([(((A1 * 4294967197) + 1) band ?UINT58MASK)| (((A2 * 4294967231) + 1) band ?UINT58MASK)]), @@ -263,6 +265,8 @@ exsplus_seed({A1, A2, A3}) -> tl(R1)]), R2. +-dialyzer({no_improper_lists, exsplus_next/1}). + %% Advance xorshift116+ state for one step and generate 58bit unsigned integer -spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}. exsplus_next([S1|S0]) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index ce1d9eb0ff..82a3a2be4f 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -917,9 +917,9 @@ expand_records(UsedRecords, E0) -> RecordDefs = [Def || {_Name,Def} <- UsedRecords], L = erl_anno:new(1), E = prep_rec(E0), - Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], - [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [strict_record_tests]), + Forms0 = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], + Forms = erl_expand_records:module(Forms0, [strict_record_tests]), + {function,L,foo,0,[{clause,L,[],[],[NE]}]} = lists:last(Forms), prep_rec(NE). prep_rec({value,_CommandN,_V}=Value) -> @@ -1081,6 +1081,8 @@ record_fields([{record_field,_,{atom,_,Field}} | Fs]) -> [Field | record_fields(Fs)]; record_fields([{record_field,_,{atom,_,Field},_} | Fs]) -> [Field | record_fields(Fs)]; +record_fields([{typed_record_field,Field,_Type} | Fs]) -> + record_fields([Field | Fs]); record_fields([]) -> []. diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 7f9bbbf649..b8a7973cf2 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -105,7 +105,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 23f3aaee1f..0400c845ab 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -33,6 +33,9 @@ terminate/2, code_change/3]). -export([try_again_restart/2]). +%% For release_handler only +-export([get_callback_module/1]). + %%-------------------------------------------------------------------------- -export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]). @@ -115,6 +118,7 @@ intensity :: non_neg_integer() | 'undefined', period :: pos_integer() | 'undefined', restarts = [], + dynamic_restarts = 0 :: non_neg_integer(), module, args}). -type state() :: #state{}. @@ -252,6 +256,17 @@ try_again_restart(Supervisor, Child) -> cast(Supervisor, Req) -> gen_server:cast(Supervisor, Req). +%%%----------------------------------------------------------------- +%%% Called by release_handler during upgrade +-spec get_callback_module(Pid) -> Module when + Pid :: pid(), + Module :: atom(). +get_callback_module(Pid) -> + {status, _Pid, {module, _Mod}, + [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(Pid), + [_Header, _Data, {data, [{"State", State}]}] = Misc, + State#state.module. + %%% --------------------------------------------------- %%% %%% Initialize the supervisor. @@ -506,39 +521,26 @@ handle_call(which_children, _From, State) -> handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?SETS:fold(fun(Pid, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true ->{Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(temporary, State#state.dynamics)), + Sz = ?SETS:size(dynamics_db(temporary, State#state.dynamics)), Reply = case CT of - supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; - worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + supervisor -> [{specs, 1}, {active, Sz}, + {supervisors, Sz}, {workers, 0}]; + worker -> [{specs, 1}, {active, Sz}, + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; -handle_call(count_children, _From, #state{children = [#child{restart_type = RType, +handle_call(count_children, _From, #state{dynamic_restarts = Restarts, + children = [#child{restart_type = RType, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?DICTS:fold(fun(Pid, _Val, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true -> - {Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(RType, State#state.dynamics)), + Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)), + Active = Sz - Restarts, Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; + {supervisors, Sz}, {workers, 0}]; worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; @@ -808,8 +810,15 @@ restart(Child, State) -> {shutdown, remove_child(Child, NState)} end. -restart(simple_one_for_one, Child, State) -> +restart(simple_one_for_one, Child, State0) -> #child{pid = OldPid, mfargs = {M, F, A}} = Child, + State = case OldPid of + ?restarting(_) -> + NRes = State0#state.dynamic_restarts - 1, + State0#state{dynamic_restarts = NRes}; + _ -> + State0 + end, Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type, State#state.dynamics)), case do_start_child_i(M, F, A) of @@ -822,8 +831,10 @@ restart(simple_one_for_one, Child, State) -> NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {error, Error} -> + NRestarts = State#state.dynamic_restarts + 1, DynamicsDb = {dict, ?DICTS:store(restarting(OldPid), A, Dynamics)}, - NState = State#state{dynamics = DynamicsDb}, + NState = State#state{dynamic_restarts = NRestarts, + dynamics = DynamicsDb}, report_error(start_error, Error, Child, State#state.name), {try_again, NState} end; diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index 3e8e6f5101..617da11ba8 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -561,6 +561,8 @@ do_o_binary(F,L) -> erlang:iolist_to_binary(List) end. +-dialyzer({no_improper_lists, do_o_binary2/2}). + do_o_binary2(_F,[]) -> <<>>; do_o_binary2(F,[H|T]) -> diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index bec0bd3f6d..f8ba6f18e9 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -1566,6 +1566,8 @@ append_bins([_|_]=List, B) -> append_bins([], B) -> B. +-dialyzer({no_improper_lists, pwrite_iolist/3}). + pwrite_iolist(B, Pos, Bin) -> {Left, Right} = split_binary(B, Pos), Sz = erlang:iolist_size(Bin), diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index b101054229..ad8829c471 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1878,9 +1878,33 @@ fixtable(Config, Version) when is_list(Config) -> {ok, _} = dets:open_file(T, [{type, duplicate_bag} | Args]), %% In a fixed table, delete and re-insert an object. ok = dets:insert(T, {1, a, b}), + SysBefore = erlang:timestamp(), + MonBefore = erlang:monotonic_time(), dets:safe_fixtable(T, true), + MonAfter = erlang:monotonic_time(), + SysAfter = erlang:timestamp(), + Self = self(), + {FixMonTime,[{Self,1}]} = dets:info(T,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = dets:info(T,safe_fixed), + true = is_integer(FixMonTime), + true = MonBefore =< FixMonTime, + true = FixMonTime =< MonAfter, + {FstMs,FstS,FstUs} = FixSysTime, + true = is_integer(FstMs), + true = is_integer(FstS), + true = is_integer(FstUs), + case erlang:system_info(time_warp_mode) of + no_time_warp -> + true = timer:now_diff(FixSysTime, SysBefore) >= 0, + true = timer:now_diff(SysAfter, FixSysTime) >= 0; + _ -> + %% ets:info(Tab,safe_fixed) not timewarp safe... + ignore + end, ok = dets:match_delete(T, {1, a, b}), ok = dets:insert(T, {1, a, b}), + {FixMonTime,[{Self,1}]} = dets:info(T,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = dets:info(T,safe_fixed), dets:safe_fixtable(T, false), 1 = length(dets:match_object(T, '_')), diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 4c007e76ad..955b482313 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -25,7 +25,7 @@ upcase_mac_1/1, upcase_mac_2/1, variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, - otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8503/1, + otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1, otp_11728/1, encoding/1, extends/1]). @@ -68,7 +68,7 @@ all() -> [rec_1, {group, upcase_mac}, include_local, predef_mac, {group, variable}, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, - overload_mac, otp_8388, otp_8470, otp_8503, otp_8562, + overload_mac, otp_8388, otp_8470, otp_8562, otp_8665, otp_8911, otp_10302, otp_10820, otp_11728, encoding, extends]. @@ -1230,23 +1230,8 @@ otp_8470(Config) when is_list(Config) -> ?line receive _ -> fail() after 0 -> ok end, ok. -otp_8503(doc) -> - ["OTP-8503. Record with no fields is considered typed."]; -otp_8503(suite) -> - []; -otp_8503(Config) when is_list(Config) -> - Dir = ?config(priv_dir, Config), - C = <<"-record(r, {}).">>, - ?line File = filename:join(Dir, "otp_8503.erl"), - ?line ok = file:write_file(File, C), - ?line {ok, List} = epp:parse_file(File, [], []), - ?line [_] = [F || {attribute,_,type,{{record,r},[],[]}}=F <- List], - file:delete(File), - ?line receive _ -> fail() after 0 -> ok end, - ok. - otp_8562(doc) -> - ["OTP-8503. Record with no fields is considered typed."]; + ["OTP-8562. Record with no fields is considered typed."]; otp_8562(suite) -> []; otp_8562(Config) when is_list(Config) -> diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index c5e2e5609d..8f0ac828ec 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -65,7 +65,8 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1,otp_11879/1,otp_13230/1 + maps/1,maps_type/1,otp_11851/1,otp_11879/1,otp_13230/1, + record_errors/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -94,7 +95,8 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851, otp_11879, otp_13230]. + maps, maps_type, otp_11851, otp_11879, otp_13230, + record_errors]. groups() -> [{unused_vars_warn, [], @@ -2605,6 +2607,23 @@ otp_5878(Config) when is_list(Config) -> ">>, ?line [] = run_test2(Config, UsedByType, [warn_unused_record]), + %% Abstract code generated by OTP 18. Note that the type info for + %% record fields has been put in a separate form. + OldAbstract = [{attribute,1,file,{"rec.erl",1}}, + {attribute,1,module,rec}, + {attribute,3,export,[{t,0}]}, + {attribute,7,record,{r,[{record_field,7,{atom,7,f}}]}}, + {attribute,7,type, + {{record,r}, + [{typed_record_field, + {record_field,7,{atom,7,f}}, + {type,7,union,[{atom,7,undefined},{type,7,atom,[]}]}}], + []}}, + {function,9,t,0,[{clause,9,[],[],[{record,10,r,[]}]}]}, + {eof,11}], + {error,[{"rec.erl",[{7,erl_lint,old_abstract_code}]}],[]} = + compile:forms(OldAbstract, [return, report]), + ok. otp_6885(doc) -> @@ -3881,6 +3900,17 @@ otp_13230(Config) when is_list(Config) -> []} = run_test2(Config, Abstr, []), ok. +record_errors(Config) when is_list(Config) -> + Ts = [{rec1, + <<"-record(r, {a,b}). + b() -> #r{a=foo,b=42,a=bar}. + u(R) -> R#r{a=1,b=2,a=2}. + ">>, + [], + {errors,[{2,erl_lint,{redefine_field,r,a}}, + {3,erl_lint,{redefine_field,r,a}}],[]}}], + run(Config, Ts). + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 3e63d19213..39d9ddaaa7 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -3968,15 +3968,37 @@ safe_fixtable_do(Opts) -> ?line true = ets:safe_fixtable(Tab, true), ?line receive after 1 -> ok end, ?line true = ets:safe_fixtable(Tab, false), - ?line false = ets:info(Tab,safe_fixed), - ?line true = ets:safe_fixtable(Tab, true), + false = ets:info(Tab,safe_fixed_monotonic_time), + false = ets:info(Tab,safe_fixed), + SysBefore = erlang:timestamp(), + MonBefore = erlang:monotonic_time(), + true = ets:safe_fixtable(Tab, true), + MonAfter = erlang:monotonic_time(), + SysAfter = erlang:timestamp(), Self = self(), - ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), + {FixMonTime,[{Self,1}]} = ets:info(Tab,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = ets:info(Tab,safe_fixed), + true = is_integer(FixMonTime), + true = MonBefore =< FixMonTime, + true = FixMonTime =< MonAfter, + {FstMs,FstS,FstUs} = FixSysTime, + true = is_integer(FstMs), + true = is_integer(FstS), + true = is_integer(FstUs), + case erlang:system_info(time_warp_mode) of + no_time_warp -> + true = timer:now_diff(FixSysTime, SysBefore) >= 0, + true = timer:now_diff(SysAfter, FixSysTime) >= 0; + _ -> + %% ets:info(Tab,safe_fixed) not timewarp safe... + ignore + end, %% Test that an unjustified 'unfix' is a no-op. {Pid,MRef} = my_spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end), {'DOWN', MRef, process, Pid, normal} = receive M -> M end, - ?line true = ets:info(Tab,fixed), - ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), + true = ets:info(Tab,fixed), + {FixMonTime,[{Self,1}]} = ets:info(Tab,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = ets:info(Tab,safe_fixed), %% badarg's ?line {'EXIT', {badarg, _}} = (catch ets:safe_fixtable(Tab, foobar)), ?line true = ets:info(Tab,fixed), @@ -4022,6 +4044,7 @@ info_do(Opts) -> ?line undefined = ets:info(non_existing_table_xxyy,type), ?line undefined = ets:info(non_existing_table_xxyy,node), ?line undefined = ets:info(non_existing_table_xxyy,named_table), + ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed_monotonic_time), ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed), ?line verify_etsmem(EtsMem). @@ -5512,7 +5535,7 @@ otp_8166_zombie_creator(T,Deleted) -> [{'=<','$1', Deleted}], [true]}]), Pid ! zombies_created, - repeat_while(fun() -> case ets:info(T,safe_fixed) of + repeat_while(fun() -> case ets:info(T,safe_fixed_monotonic_time) of {_,[_P1,_P2]} -> false; _ -> diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index f02e82b39c..5f2167b609 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. 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,8 +342,8 @@ records(doc) -> records(Config) when is_list(Config) -> ?line setup(Config), ?line RD = <<"-record(t, {" - "t1 = []," - "t2 = foo," + "t1 = [] :: list()," + "t2 = foo :: atom()," "t3," "t4" "}).">>, diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index a9dd6b5817..3fb1a5572d 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -393,7 +393,9 @@ records(Config) when is_list(Config) -> Test = filename:join(?config(priv_dir, Config), "test.erl"), Contents = <<"-module(test). - -record(state, {bin, reply, leader}). + -record(state, {bin :: binary(), + reply = no, + leader = some :: atom()}). -ifdef(test1). -record(test1, {f}). diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 8cb2a5194a..903ca76575 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -67,6 +67,7 @@ %% Misc tests -export([child_unlink/1, tree/1, count_children/1, + count_restarting_children/1, do_not_save_start_parameters_for_temporary_children/1, do_not_save_child_specs_for_temporary_children/1, simple_one_for_one_scale_many_temporary_children/1, @@ -90,7 +91,8 @@ all() -> {group, normal_termination}, {group, shutdown_termination}, {group, abnormal_termination}, child_unlink, tree, - count_children, do_not_save_start_parameters_for_temporary_children, + count_children, count_restarting_children, + do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, simple_one_for_one_scale_many_temporary_children, temporary_bystander, simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple, @@ -1459,6 +1461,54 @@ count_children(Config) when is_list(Config) -> [1,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +%% Test count_children when some children are restarting +count_restarting_children(Config) when is_list(Config) -> + process_flag(trap_exit, true), + Child = {child, {supervisor_deadlock, start_child_noreg, []}, + permanent, brutal_kill, worker, []}, + %% 2 sek delay on failing restart (see supervisor_deadlock.erl) -> + %% MaxR=20, MaxT=10 should ensure a restart loop when starting and + %% restarting 3 instances of the child (as below) + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 20, 10}, [Child]}}), + + %% Ets table with state read by supervisor_deadlock.erl + ets:new(supervisor_deadlock,[set,named_table,public]), + ets:insert(supervisor_deadlock,{fail_start,false}), + + [1,0,0,0] = get_child_counts(SupPid), + {ok, Ch1_1} = supervisor:start_child(SupPid, []), + [1,1,0,1] = get_child_counts(SupPid), + {ok, Ch1_2} = supervisor:start_child(SupPid, []), + [1,2,0,2] = get_child_counts(SupPid), + {ok, Ch1_3} = supervisor:start_child(SupPid, []), + [1,3,0,3] = get_child_counts(SupPid), + + supervisor_deadlock:restart_child(Ch1_1), + supervisor_deadlock:restart_child(Ch1_2), + supervisor_deadlock:restart_child(Ch1_3), + test_server:sleep(400), + [1,3,0,3] = get_child_counts(SupPid), + [Ch2_1, Ch2_2, Ch2_3] = [C || {_,C,_,_} <- supervisor:which_children(SupPid)], + + ets:insert(supervisor_deadlock,{fail_start,true}), + supervisor_deadlock:restart_child(Ch2_1), + supervisor_deadlock:restart_child(Ch2_2), + test_server:sleep(4000), % allow restart to happen before proceeding + [1,1,0,3] = get_child_counts(SupPid), + + ets:insert(supervisor_deadlock,{fail_start,false}), + test_server:sleep(4000), % allow restart to happen before proceeding + [1,3,0,3] = get_child_counts(SupPid), + + ok = supervisor:terminate_child(SupPid, Ch2_3), + [1,2,0,2] = get_child_counts(SupPid), + [Ch3_1, Ch3_2] = [C || {_,C,_,_} <- supervisor:which_children(SupPid)], + ok = supervisor:terminate_child(SupPid, Ch3_1), + [1,1,0,1] = get_child_counts(SupPid), + ok = supervisor:terminate_child(SupPid, Ch3_2), + [1,0,0,0] = get_child_counts(SupPid). + +%%------------------------------------------------------------------------- %% Temporary children shall not be restarted so they should not save %% start parameters, as it potentially can take up a huge amount of %% memory for no purpose. diff --git a/lib/stdlib/test/supervisor_deadlock.erl b/lib/stdlib/test/supervisor_deadlock.erl index 288547a972..8d3d1c6f30 100644 --- a/lib/stdlib/test/supervisor_deadlock.erl +++ b/lib/stdlib/test/supervisor_deadlock.erl @@ -11,9 +11,11 @@ init([child]) -> %% terminates immediately {ok, []}; [{fail_start, true}] -> - %% Restart frequency is MaxR=8, MaxT=10, so this will - %% ensure that restart intensity is not reached -> restart - %% loop + %% A restart frequency of MaxR=8, MaxT=10 should ensure + %% that restart intensity is not reached -> restart loop. + %% (Note that if we use simple_one_for_one, and start + %% 'many' child instances, the restart frequency must be + %% ajusted accordingly.) timer:sleep(2000), % NOTE: this could be a gen_server call timeout {stop, error} @@ -41,5 +43,11 @@ code_change(_OldVsn, State, _Extra) -> start_child() -> gen_server:start_link({local, ?MODULE}, ?MODULE, [child], []). +start_child_noreg() -> + gen_server:start_link(?MODULE, [child], []). + restart_child() -> gen_server:cast(supervisor_deadlock, restart). + +restart_child(Pid) -> + gen_server:cast(Pid, restart). diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 3419f3f5d0..db8d3cde01 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -121,7 +121,7 @@ start_tracer_node(TraceFile,TI) -> %%% trace_nodes(Sock,Nodes) -> Bin = term_to_binary({add_nodes,Nodes}), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), receive_ack(Sock). @@ -142,7 +142,7 @@ receive_ack(Sock) -> %%% stop_tracer_node(Sock) -> Bin = term_to_binary(id(stop)), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), receive {tcp_closed,Sock} -> gen_tcp:close(Sock) end, ok. @@ -171,7 +171,7 @@ trc([TraceFile, PortAtom, Type]) -> {packet,2}]) of {ok,Sock} -> BinResult = term_to_binary(Result), - ok = gen_tcp:send(Sock,[1|BinResult]), + ok = gen_tcp:send(Sock,tag_trace_message(BinResult)), trc_loop(Sock,Patterns,Type); _else -> ok @@ -187,7 +187,7 @@ trc_loop(Sock,Patterns,Type) -> {ok,{add_nodes,Nodes}} -> add_nodes(Nodes,Patterns,Type), Bin = term_to_binary(id(ok)), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), trc_loop(Sock,Patterns,Type); {ok,stop} -> ttb:stop(), @@ -482,7 +482,7 @@ node_started(Host,PortAtom) -> {ok,Sock} -> Started = term_to_binary({started, node(), Version, VsnStr}), - ok = gen_tcp:send(Sock, [1|Started]), + ok = gen_tcp:send(Sock, tag_trace_message(Started)), receive _Anyting -> gen_tcp:close(Sock), erlang:halt() @@ -492,8 +492,10 @@ node_started(Host,PortAtom) -> end. - - +-compile({inline, [tag_trace_message/1]}). +-dialyzer({no_improper_lists, tag_trace_message/1}). +tag_trace_message(M) -> + [1|M]. % start_which_node(Optlist) -> hostname start_which_node(Optlist) -> diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 69e0f59b68..3732b0fc85 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -2003,7 +2003,7 @@ munge_expr({lc,Line,Expr,Qs}, Vars) -> {{lc,Line,MungedExpr,MungedQs}, Vars3}; munge_expr({bc,Line,Expr,Qs}, Vars) -> {bin,BLine,[{bin_element,EL,Val,Sz,TSL}|Es]} = Expr, - Expr2 = {bin,BLine,[{bin_element,EL,?BLOCK1(Val),Sz,TSL}|Es]}, + Expr2 = {bin,BLine,[{bin_element,EL,Val,Sz,TSL}|Es]}, {MungedExpr,Vars2} = munge_expr(Expr2, Vars), {MungedQs, Vars3} = munge_qualifiers(Qs, Vars2), {{bc,Line,MungedExpr,MungedQs}, Vars3}; diff --git a/lib/tools/src/cprof.erl b/lib/tools/src/cprof.erl index 0240f876bc..f6d68f0bf8 100644 --- a/lib/tools/src/cprof.erl +++ b/lib/tools/src/cprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -114,6 +114,7 @@ analyse(Limit) when is_integer(Limit) -> analyse(M) when is_atom(M) -> analyse(M, 1). +-dialyzer({no_improper_lists, analyse/2}). analyse(M, Limit) when is_atom(M), is_integer(Limit) -> L0 = [begin MFA = {M,F,A}, diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl index 7c6fab0b75..c5c24c8eb3 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2251,6 +2251,8 @@ do_analyse(Table, Analyse) -> ?dbg(5, "do_analyse_1(_, _) ->~p~n", [Result]), Result. +-dialyzer({no_improper_lists, do_analyse_1/2}). + do_analyse_1(Table, #analyse{group_leader = GroupLeader, dest = Io, @@ -2624,6 +2626,8 @@ funcstat_pd(Pid, Func1, Func0, Clocks) -> funcstat_sort_r(FuncstatList, Element) -> funcstat_sort_r_1(FuncstatList, Element, []). +-dialyzer({no_improper_lists, funcstat_sort_r_1/3}). + funcstat_sort_r_1([], _, R) -> postsort_r(lists:sort(R)); funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, @@ -2646,6 +2650,8 @@ funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, clocks_sort_r(L, E) -> clocks_sort_r_1(L, E, []). +-dialyzer({no_improper_lists, clocks_sort_r_1/3}). + clocks_sort_r_1([], _, R) -> postsort_r(lists:sort(R)); clocks_sort_r_1([#clocks{} = C | L], E, R) -> diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index 9ee75a688a..d552d5b46e 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -933,7 +933,6 @@ strings(Strings) -> strings(Strings, []). strings([], Out) -> Out; strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S])); strings([{left, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""])); -strings([{format, Format, S} | Ss], Out) -> strings(Ss, Out ++ term2string(Format, [S])); strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])). diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl index 438ec93962..f69aa70244 100644 --- a/lib/tools/src/xref_utils.erl +++ b/lib/tools/src/xref_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-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. @@ -245,6 +245,8 @@ select_last_application_version(AppVs) -> TL = to_external(partition(1, relation(AppVs))), [last(keysort(2, L)) || L <- TL]. +-record(scan, {collected = [], errors = [], seen = [], unreadable = []}). + %% scan_directory(Directory, Recurse, Collect, Watch) -> %% {Collected, Errors, Seen, Unreadable} %% @@ -261,8 +263,9 @@ select_last_application_version(AppVs) -> %% Unreadable. %% scan_directory(File, Recurse, Collect, Watch) -> - Init = [[] | {[],[],[]}], - [L | {E,J,U}] = find_files_dir(File, Recurse, Collect, Watch, Init), + Init = #scan{}, + S = find_files_dir(File, Recurse, Collect, Watch, Init), + #scan{collected = L, errors = E, seen = J, unreadable = U} = S, {reverse(L), reverse(E), reverse(J), reverse(U)}. %% {Dir, Basename} | false @@ -576,8 +579,7 @@ find_files_dir(Dir, Recurse, Collect, Watch, L) -> {ok, Files} -> find_files(sort(Files), Dir, Recurse, Collect, Watch, L); {error, Error} -> - [B | {E,J,U}] = L, - [B | {[file_error(Dir, Error)|E],J,U}] + L#scan{errors = [file_error(Dir, Error)|L#scan.errors]} end. find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> @@ -588,22 +590,23 @@ find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> {ok, {_, directory, _, _}} -> L; Info -> - [B | EJU = {E,J,U}] = L, + #scan{collected = B, errors = E, + seen = J, unreadable = U} = L, Ext = filename:extension(File), C = member(Ext, Collect), case C of true -> case Info of {ok, {_, file, readable, _}} -> - [[{Dir,F} | B] | EJU]; + L#scan{collected = [{Dir,F} | B]}; {ok, {_, file, unreadable, _}} -> - [B | {E,J,[File|U]}]; + L#scan{unreadable = [File|U]}; Error -> - [B | {[Error|E],J,U}] + L#scan{errors = [Error|E]} end; false -> case member(Ext, Watch) of - true -> [B | {E,[File|J],U}]; + true -> L#scan{seen = [File|J]}; false -> L end end diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 483ea9774e..71570a55fa 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,7 +28,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> NoStartStop = [eif,otp_5305,otp_5418,otp_7095,otp_8273, otp_8340,otp_8188,compile_beam_opts,eep37, - analyse_no_beam, line_0, compile_beam_no_file], + analyse_no_beam, line_0, compile_beam_no_file, + otp_13277], StartStop = [start, compile, analyse, misc, stop, distribution, reconnect, die_and_reconnect, dont_reconnect_after_stop, stop_node_after_disconnect, @@ -1252,7 +1253,7 @@ otp_8340(doc) -> ["OTP-8340. Bug."]; otp_8340(suite) -> []; otp_8340(Config) when is_list(Config) -> - ?line [{{t,1},1},{{t,2},1},{{t,4},1}] = + ?line [{{t,1},1},{{t,4},1}] = analyse_expr(<<"<< \n" " <<3:2, \n" " SeqId:62>> \n" @@ -1546,8 +1547,10 @@ comprehension_8188(Cf) -> " true]. \n" % 2 " two() -> 2">>, Cf), % 1 + %% The template cannot have a counter since it is not allowed to + %% be a block. ?line [{{t,1},1}, - {{t,2},2}, + %% {{t,2},2}, {{t,3},1}, {{t,4},1}, {{t,5},0}, @@ -1557,7 +1560,7 @@ comprehension_8188(Cf) -> {{t,13},2}, {{t,14},2}] = analyse_expr(<<"<< \n" % 1 - " << (X*2) >> || \n" % 2 + " << (X*2) >> || \n" % 2 (now: 0) " <<X>> <= << (case two() of\n" " 2 -> 1;\n" % 1 " _ -> 2\n" % 0 @@ -1572,7 +1575,7 @@ comprehension_8188(Cf) -> "two() -> 2">>, Cf), ?line [{{t,1},1}, - {{t,2},4}, + %% {{t,2},4}, {{t,4},1}, {{t,6},1}, {{t,7},0}, @@ -1581,7 +1584,7 @@ comprehension_8188(Cf) -> {{t,12},4}, {{t,13},1}] = analyse_expr(<<"<< \n" % 1 - " << (2)\n" % 4 + " << (2)\n" % 4 (now: 0) " :(8) >> || \n" " <<X>> <= << 1,\n" % 1 " (case two() of \n" @@ -1745,6 +1748,23 @@ do_scan(Str) -> {done,{ok,T,_},C} = erl_scan:tokens([],Str,0), [ T | do_scan(C) ]. +otp_13277(doc) -> + ["PR 856. Fix a bc bug."]; +otp_13277(Config) -> + Test = <<"-module(t). + -export([t/0]). + + pad(A, L) -> + P = << <<\"#\">> || _ <- lists:seq(1, L) >>, + <<A/binary, P/binary>>. + + t() -> + pad(<<\"hi\">>, 2). + ">>, + ?line File = cc_mod(t, Test, Config), + ?line <<"hi##">> = t:t(), + ?line ok = file:delete(File), + ok. %%--Auxiliary------------------------------------------------------------ diff --git a/lib/tools/test/cover_SUITE_data/d.erl b/lib/tools/test/cover_SUITE_data/d.erl index 696e27e49b..b1d8ebd62e 100644 --- a/lib/tools/test/cover_SUITE_data/d.erl +++ b/lib/tools/test/cover_SUITE_data/d.erl @@ -6,7 +6,7 @@ size/0]). -export([init/0]). % spawn --record(person, {name, age, location, moved=false}). +-record(person, {name, age :: integer(), location, moved=false :: boolean()}). %%%---------------------------------------------------------------------- %%% User interface functions diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 2bbe0eea1a..2c5caab07b 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -152,6 +152,7 @@ parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) -> %% [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)? %% [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>' %%---------------------------------------------------------------------- +-dialyzer({[no_fail_call, no_match], parse_xml_decl/2}). parse_xml_decl(?STRING_EMPTY, State) -> cf(?STRING_EMPTY, State, fun parse_xml_decl/2); parse_xml_decl(?BYTE_ORDER_MARK_1, State) -> @@ -1205,6 +1206,7 @@ send_character_event(_, true, String, State) -> %% Description: Parse whitespaces. %% [3] S ::= (#x20 | #x9 | #xD | #xA)+ %%---------------------------------------------------------------------- +-dialyzer({no_fail_call, whitespace/3}). whitespace(?STRING_EMPTY, State, Acc) -> case cf(?STRING_EMPTY, State, Acc, fun whitespace/3) of {?STRING_EMPTY, State} -> @@ -1716,6 +1718,7 @@ handle_external_entity({Tag, _Url}, State) -> %% Result : {Rest, State} %% Description: Parse the external entity. %%---------------------------------------------------------------------- +-dialyzer({[no_fail_call, no_match], parse_external_entity_1/2}). parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = State) -> case catch cf(?STRING_EMPTY, State, fun parse_external_entity_1/2) of {Rest, State1} when is_record(State1, xmerl_sax_parser_state) -> diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 2bf3172d87..829716dcdb 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -1010,7 +1010,7 @@ scan_optional_version(T,S) -> scan_enc_name([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name(MoreBytes, S1) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name([H|T], S0) when H >= $"; H =< $' -> ?bump_col(1), @@ -1020,7 +1020,7 @@ scan_enc_name([H|T], S0) when H >= $"; H =< $' -> scan_enc_name([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name([H|T], S0, Delim, Acc) when H >= $a, H =< $z -> ?bump_col(1), @@ -1034,7 +1034,7 @@ scan_enc_name([H|_T],S,_Delim,_Acc) -> scan_enc_name2([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name2(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name2([H|T], S0, H, Acc) -> ?bump_col(1), @@ -1058,7 +1058,7 @@ scan_enc_name2([H|T], S0, Delim, Acc) when H == $.; H == $_; H == $- -> scan_xml_vsn([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_xml_vsn(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_xml_vsn([H|T], S) when H==$"; H==$'-> xml_vsn(T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}, H, []). @@ -1066,7 +1066,7 @@ scan_xml_vsn([H|T], S) when H==$"; H==$'-> xml_vsn([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> xml_vsn(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); xml_vsn([H|T], S=#xmerl_scanner{col = C}, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = C+1}}; @@ -1089,7 +1089,7 @@ xml_vsn([H|T], S=#xmerl_scanner{col = C}, Delim, Acc) -> scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos, Ps) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos, Ps) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos, Ps) when H1==$x;H1==$X -> @@ -1125,7 +1125,7 @@ scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target, ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, L, C, Pos, Ps, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, @@ -1152,7 +1152,7 @@ scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target, ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, L, C, Pos, Ps, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, @@ -1180,7 +1180,7 @@ scan_pi2(Str, S0, Target, L, C, Pos, Ps, Acc) -> scan_doctype([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype(T, S) -> {_,T1,S1} = mandatory_strip(T,S), @@ -1194,7 +1194,7 @@ scan_doctype(T, S) -> scan_doctype1([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype1(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype1("PUBLIC" ++ T, S0) -> ?bump_col(6), @@ -1217,7 +1217,7 @@ scan_doctype1(T, S) -> scan_doctype2([], S=#xmerl_scanner{continuation_fun = F},DTD) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype2(MoreBytes, S1, DTD) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype2("[" ++ T, S0, DTD) -> ?bump_col(1), @@ -1237,7 +1237,7 @@ scan_doctype2(_T,S,_DTD) -> scan_doctype3([], S=#xmerl_scanner{continuation_fun = F},DTD) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype3(MoreBytes, S1,DTD) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype3("%" ++ T, S0, DTD) -> ?bump_col(1), @@ -1549,7 +1549,7 @@ scan_decl_sep(T,S) -> scan_conditional_sect([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_conditional_sect(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_conditional_sect("IGNORE" ++ T, S0) -> ?bump_col(6), @@ -1582,7 +1582,7 @@ scan_ignore(Str,S) -> scan_ignore([], S=#xmerl_scanner{continuation_fun = F},Level) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_ignore(MoreBytes, S1,Level) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_ignore("<![" ++ T, S0,Level) -> %% nested conditional section. Topmost condition is ignore, though @@ -1603,7 +1603,7 @@ scan_ignore([_H|T],S0,Level) -> scan_include([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_include(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_include("]]>" ++ T, S0) -> ?bump_col(3), @@ -1745,7 +1745,7 @@ update_attributes1([],Acc) -> scan_attdef([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_attdef(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_attdef(T, S) -> scan_attdef(T, S, _AttrAcc = []). @@ -1754,7 +1754,7 @@ scan_attdef(T, S) -> scan_attdef([], S=#xmerl_scanner{continuation_fun = F}, Attrs) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_attdef(MoreBytes, S1, Attrs) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_attdef(">" ++ T, S0, Attrs) -> ?bump_col(1), @@ -1798,7 +1798,7 @@ scan_attdef2(T, S, Attrs) -> scan_att_type([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_att_type(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_type("CDATA" ++ T, S0) -> ?bump_col(5), @@ -1856,7 +1856,7 @@ scan_att_type("%" ++ T, S0) -> scan_notation_type([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_notation_type(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_notation_type(")" ++ T, S0, Acc) -> ?bump_col(1), @@ -1889,7 +1889,7 @@ notation_exists(Name, #xmerl_scanner{rules_read_fun = Read, scan_enumeration([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enumeration(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_enumeration(")" ++ T, S0, Acc) -> ?bump_col(1), @@ -1907,7 +1907,7 @@ scan_enumeration("|" ++ T, S0, Acc) -> scan_default_decl([], S=#xmerl_scanner{continuation_fun = F}, Type) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_default_decl(MoreBytes, S1, Type) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_default_decl("#REQUIRED" ++ T, S0, _Type) -> ?bump_col(9), @@ -1936,7 +1936,7 @@ default_value(T, S, Type) -> scan_entity([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity("%" ++ T, #xmerl_scanner{rules_write_fun = Write} = S0) -> %% parameter entity @@ -1974,7 +1974,7 @@ scan_entity_completion(T,S) -> scan_entity_def([], S=#xmerl_scanner{continuation_fun = F}, EName) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity_def(MoreBytes, S1, EName) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_def("'" ++ T, S0, EName) -> ?bump_col(1), @@ -2015,7 +2015,7 @@ scan_entity_def(Str, S, EName) -> scan_ndata_decl([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_ndata_decl(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_ndata_decl(Str = ">"++_T, S) -> {[], Str, S}; @@ -2062,7 +2062,7 @@ scan_element("/", S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element("/" ++ MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element([], S=#xmerl_scanner{continuation_fun = F}, Pos, Name, StartL, StartC, Attrs, Lang, Parents, @@ -2071,7 +2071,7 @@ scan_element([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element(MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element("/>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event, @@ -2099,7 +2099,7 @@ scan_element(">", S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element(">" ++ MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element(">" ++ T, S0 = #xmerl_scanner{event_fun = Event, hook_fun = Hook, @@ -2344,7 +2344,7 @@ keyreplaceadd(_K, _Pos, [], Obj) -> scan_att_value([], S=#xmerl_scanner{continuation_fun = F},AT) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_att_value(MoreBytes, S1, AT) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_value("%"++_T,S=#xmerl_scanner{environment=prolog},_AttType) -> ?fatal({error,{wfc_PEs_In_Internal_Subset}},S); @@ -2385,7 +2385,7 @@ scan_att_chars([],S=#xmerl_scanner{continuation_fun=F},H,Acc,TmpAcc,AT,IsNorm)-> F(fun(MoreBytes, S1) -> scan_att_chars(MoreBytes, S1, H, Acc,TmpAcc,AT,IsNorm) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_chars([H|T], S0, H, Acc, TmpAcc,AttType,IsNorm) -> % End quote ?bump_col(1), @@ -2518,7 +2518,7 @@ scan_content("<", S= #xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content("<" ++ MoreBytes, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content([], S=#xmerl_scanner{environment={external,{entity,_}}}, _Pos, _Name, _Attrs, _Space, _Lang, _Parents, _NS, Acc,_) -> @@ -2532,7 +2532,7 @@ scan_content([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content(MoreBytes, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content("</" ++ T, S0, _Pos, Name, _Attrs, _Space, _Lang, _Parents, _NS, Acc,[]) -> @@ -2636,7 +2636,7 @@ scan_content_markup([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content_markup( MoreBytes,S1,Pos,Name, Attrs,Space,Lang,Parents,NS) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content_markup("![CDATA[" ++ T, S0, Pos, _Name, _Attrs, _Space, _Lang, Parents, _NS) -> @@ -2664,7 +2664,7 @@ scan_char_data([], S=#xmerl_scanner{environment=internal_parsed_entity}, scan_char_data([], S=#xmerl_scanner{continuation_fun = F}, Space, _MUD,Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_data(MoreBytes,S1,Space,_MUD,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_data([$&|T], S,Space,"&",Acc) -> scan_char_data(T, S, Space,[], [$&|Acc]); @@ -2716,7 +2716,7 @@ scan_cdata(Str, S, Pos, Parents) -> scan_cdata([], S=#xmerl_scanner{continuation_fun = F}, Pos, Parents, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_cdata(MoreBytes, S1, Pos, Parents, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_cdata("]]>" ++ T, S0, Pos, Parents, Acc) -> ?bump_col(3), @@ -2741,7 +2741,7 @@ scan_cdata(Str, S0, Pos, Parents, Acc) -> scan_reference([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_reference(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_reference("#x" ++ T, S0) -> %% [66] CharRef @@ -2783,7 +2783,7 @@ scan_reference(T, S) -> scan_entity_ref([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity_ref(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_ref("amp;" ++ T, S0) -> ?bump_col(4), @@ -2868,7 +2868,7 @@ expand_reference(Name, #xmerl_scanner{rules_read_fun = Read} = S) -> scan_char_ref_dec([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_ref_dec(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_ref_dec([H|T], S0, Acc) when H >= $0, H =< $9 -> ?bump_col(1), @@ -2883,7 +2883,7 @@ scan_char_ref_dec(";" ++ T, S0, Acc) -> scan_char_ref_hex([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_ref_hex(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_ref_hex([H|T], S0, Acc) when H >= $0, H =< $9 -> ?bump_col(1), @@ -2957,7 +2957,7 @@ scan_name_no_colons(Str, S) -> scan_name([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_name(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_name(Str = [$:|T], S0 = #xmerl_scanner{namespace_conformant = NSC}) -> if NSC == false -> @@ -3007,7 +3007,7 @@ scan_nmtoken(Str, S, Acc, NSC) -> scan_nmtoken([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_nmtoken(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_nmtoken("%"++T, S0=#xmerl_scanner{environment={external,_}}) -> ?bump_col(1), @@ -3084,7 +3084,7 @@ isLatin1(_,_) -> scan_system_literal([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_system_literal(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_system_literal("\"" ++ T, S) -> scan_system_literal(T, S, $", []); @@ -3096,7 +3096,7 @@ scan_system_literal([], S=#xmerl_scanner{continuation_fun = F}, Delimiter, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_system_literal(MoreBytes,S1,Delimiter,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_system_literal([H|T], S, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}}; @@ -3114,7 +3114,7 @@ scan_system_literal(Str, S, Delimiter, Acc) -> scan_pubid_literal([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pubid_literal(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pubid_literal([H|T], S) when H == $"; H == $' -> scan_pubid_literal(T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}, H, []); @@ -3126,7 +3126,7 @@ scan_pubid_literal([], S=#xmerl_scanner{continuation_fun = F}, Delimiter, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pubid_literal(MoreBytes,S1,Delimiter,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pubid_literal([H|T], S, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}}; @@ -3161,7 +3161,7 @@ is_pubid_char(X) -> scan_contentspec([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_contentspec(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_contentspec("EMPTY" ++ T, S0) -> ?bump_col(5), @@ -3195,7 +3195,7 @@ scan_elem_content([], S=#xmerl_scanner{continuation_fun = F}, Context, Mode, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes,S1) -> scan_elem_content(MoreBytes,S1,Context,Mode,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_elem_content(")" ++ T, S0, Context, Mode0, Acc0) -> ?bump_col(1), @@ -3282,7 +3282,7 @@ format_elem_content(Other) -> Other. scan_occurrence([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_occurrence(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_occurrence([$?|T], S0) -> ?bump_col(1), @@ -3433,7 +3433,7 @@ wfc_whitespace_betw_attrs([$> |_]=L,S) -> wfc_whitespace_betw_attrs([],S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> wfc_whitespace_betw_attrs(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); wfc_whitespace_betw_attrs(_,S) -> ?fatal({whitespace_required_between_attributes},S). @@ -3477,7 +3477,7 @@ vc_Element_valid(_,_) -> scan_pe_def([], S=#xmerl_scanner{continuation_fun = F}, PEName) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pe_def(MoreBytes, S1, PEName) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pe_def("'" ++ T, S0, PEName) -> ?bump_col(1), @@ -3510,7 +3510,7 @@ scan_notation_decl(T, #xmerl_scanner{rules_write_fun = Write, scan_notation_decl1([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_notation_decl1(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_notation_decl1("SYSTEM" ++ T, S0) -> ?bump_col(6), @@ -3536,7 +3536,7 @@ scan_notation_decl1("PUBLIC" ++ T, S0) -> scan_external_id([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_external_id(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_external_id("SYSTEM" ++ T, S0) -> ?bump_col(6), @@ -3582,7 +3582,7 @@ scan_entity_value([], S=#xmerl_scanner{continuation_fun = F}, scan_entity_value(MoreBytes,S1, Delim,Acc,PEName,Namespace,PENesting) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_value([Delim|T], S=#xmerl_scanner{validation=dtd}, Delim,_Acc,PEName,_NS,PENesting) when length(PENesting) /= 0 -> @@ -3850,7 +3850,7 @@ scan_comment1([], S=#xmerl_scanner{continuation_fun = F}, Pos, Comment, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_comment1(MoreBytes, S1, Pos, Comment, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_comment1("-->" ++ T, S0 = #xmerl_scanner{col = C, event_fun = Event, @@ -4100,6 +4100,13 @@ handle_schema_result({error,Reason},S5) -> %%% Helper functions +-compile({inline, [fatal_fun/1]}). + +-spec fatal_fun(_) -> fun((_) -> no_return()). + +fatal_fun(Reason) -> + fun(S) -> ?fatal(Reason, S) end. + fatal(Reason, S) -> exit({fatal, {Reason, {file,S#xmerl_scanner.filename}, |