aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/configure.in15
-rw-r--r--erts/doc/src/erl_driver.xml113
-rw-r--r--erts/doc/src/erl_nif.xml112
-rw-r--r--erts/doc/src/erlang.xml264
-rw-r--r--erts/emulator/Makefile.in3
-rw-r--r--erts/emulator/beam/atom.names7
-rw-r--r--erts/emulator/beam/beam_bp.c2
-rw-r--r--erts/emulator/beam/beam_emu.c77
-rw-r--r--erts/emulator/beam/bif.c48
-rw-r--r--erts/emulator/beam/bif.tab2
-rw-r--r--erts/emulator/beam/erl_alloc.c6
-rw-r--r--erts/emulator/beam/erl_alloc.h18
-rw-r--r--erts/emulator/beam/erl_alloc.types1
-rw-r--r--erts/emulator/beam/erl_async.c34
-rw-r--r--erts/emulator/beam/erl_bif_info.c42
-rw-r--r--erts/emulator/beam/erl_bif_trace.c41
-rw-r--r--erts/emulator/beam/erl_db.c46
-rw-r--r--erts/emulator/beam/erl_db_util.h5
-rw-r--r--erts/emulator/beam/erl_driver.h86
-rw-r--r--erts/emulator/beam/erl_drv_nif.h84
-rw-r--r--erts/emulator/beam/erl_gc.c60
-rw-r--r--erts/emulator/beam/erl_gc.h5
-rw-r--r--erts/emulator/beam/erl_init.c3
-rw-r--r--erts/emulator/beam/erl_lock_check.c2
-rw-r--r--erts/emulator/beam/erl_msacc.c486
-rw-r--r--erts/emulator/beam/erl_msacc.h409
-rw-r--r--erts/emulator/beam/erl_nif.c20
-rw-r--r--erts/emulator/beam/erl_nif.h60
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h6
-rw-r--r--erts/emulator/beam/erl_port_task.c3
-rw-r--r--erts/emulator/beam/erl_process.c73
-rw-r--r--erts/emulator/beam/erl_process.h87
-rw-r--r--erts/emulator/beam/erl_threads.h34
-rw-r--r--erts/emulator/beam/erl_time.h6
-rw-r--r--erts/emulator/beam/erl_time_sup.c204
-rw-r--r--erts/emulator/beam/erl_trace.c757
-rw-r--r--erts/emulator/beam/erl_trace.h32
-rw-r--r--erts/emulator/beam/global.h2
-rw-r--r--erts/emulator/beam/io.c55
-rw-r--r--erts/emulator/beam/ops.tab9
-rw-r--r--erts/emulator/beam/sys.h15
-rw-r--r--erts/emulator/beam/time.c20
-rw-r--r--erts/emulator/drivers/common/efile_drv.c8
-rw-r--r--erts/emulator/drivers/common/inet_drv.c139
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c5
-rw-r--r--erts/emulator/hipe/hipe_bif0.tab2
-rw-r--r--erts/emulator/hipe/hipe_bif_list.m41
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c12
-rw-r--r--erts/emulator/hipe/hipe_native_bif.h2
-rw-r--r--erts/emulator/hipe/hipe_primops.h2
-rw-r--r--erts/emulator/sys/common/erl_poll.c36
-rw-r--r--erts/emulator/sys/unix/erl_unix_sys.h27
-rw-r--r--erts/emulator/sys/unix/sys_time.c114
-rw-r--r--erts/emulator/sys/win32/erl_poll.c4
-rw-r--r--erts/emulator/sys/win32/erl_win_dyn_driver.h14
-rw-r--r--erts/emulator/sys/win32/erl_win_sys.h14
-rw-r--r--erts/emulator/sys/win32/sys_time.c1
-rw-r--r--erts/emulator/test/bs_construct_SUITE.erl40
-rw-r--r--erts/emulator/test/nif_SUITE.erl153
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c94
-rw-r--r--erts/emulator/test/process_SUITE.erl47
-rw-r--r--erts/emulator/test/statistics_SUITE.erl120
-rw-r--r--erts/emulator/test/system_profile_SUITE.erl155
-rw-r--r--erts/emulator/test/trace_bif_SUITE.erl249
-rw-r--r--erts/include/internal/ethr_internal.h1
-rw-r--r--erts/include/internal/ethread.h47
-rw-r--r--erts/lib_src/common/ethr_aux.c32
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin49964 -> 49984 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin101268 -> 101988 bytes
-rw-r--r--erts/preloaded/ebin/erts_code_purger.beambin8768 -> 8764 bytes
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin8536 -> 9412 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin44728 -> 44724 bytes
-rw-r--r--erts/preloaded/ebin/otp_ring0.beambin1452 -> 1468 bytes
-rw-r--r--erts/preloaded/ebin/prim_eval.beambin1324 -> 1340 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin44892 -> 44908 bytes
-rw-r--r--erts/preloaded/ebin/prim_inet.beambin72612 -> 72632 bytes
-rw-r--r--erts/preloaded/ebin/prim_zip.beambin23284 -> 23308 bytes
-rw-r--r--erts/preloaded/ebin/zlib.beambin14160 -> 14176 bytes
-rw-r--r--erts/preloaded/src/erlang.erl33
-rw-r--r--erts/preloaded/src/erts_internal.erl35
-rw-r--r--lib/compiler/src/cerl_trees.erl223
-rw-r--r--lib/dialyzer/doc/src/dialyzer.xml2
-rw-r--r--lib/dialyzer/src/Makefile2
-rw-r--r--lib/dialyzer/src/dialyzer.app.src1
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl69
-rw-r--r--lib/dialyzer/src/dialyzer_callgraph.erl109
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl57
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl5
-rw-r--r--lib/dialyzer/src/dialyzer_coordinator.erl19
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl2
-rw-r--r--lib/dialyzer/src/dialyzer_race_data_server.erl134
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl13
-rw-r--r--lib/dialyzer/src/dialyzer_worker.erl56
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return2
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/simple4
-rw-r--r--lib/dialyzer/test/plt_SUITE.erl58
-rw-r--r--lib/dialyzer/test/r9c_SUITE_data/results/mnesia2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/app_call2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/maps12
-rw-r--r--lib/diameter/doc/src/diameter.xml22
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl3
-rw-r--r--lib/edoc/doc/overview.edoc7
-rw-r--r--lib/edoc/src/edoc.erl2
-rw-r--r--lib/erl_docgen/src/docgen_otp_specs.erl4
-rw-r--r--lib/hipe/cerl/cerl_to_icode.erl8
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl2
-rw-r--r--lib/hipe/cerl/erl_types.erl15
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl51
-rw-r--r--lib/hipe/icode/hipe_icode_primops.erl37
-rw-r--r--lib/hipe/icode/hipe_icode_range.erl6
-rw-r--r--lib/hipe/rtl/hipe_rtl_arith.inc15
-rw-r--r--lib/hipe/rtl/hipe_rtl_arith_32.erl3
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary.erl144
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_construct.erl196
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_match.erl151
-rw-r--r--lib/hipe/rtl/hipe_tagscheme.erl23
-rw-r--r--lib/hipe/test/Makefile4
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_arith.erl72
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl102
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bifs.erl257
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bignums.erl143
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_boolean.erl47
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl138
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl463
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_comparisons.erl157
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_exceptions.erl465
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_floats.erl180
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_fun.erl124
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_guards.erl164
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_inline_function.erl73
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_inline_module.erl31
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl326
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl153
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_lists.erl61
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_module_info.erl32
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl46
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_random.erl238
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_receive.erl56
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_records.erl28
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl65
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_switches.erl52
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl39
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_tuples.erl177
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_add.erl10
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_construct.erl161
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_split.erl10
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_utf.erl344
-rw-r--r--lib/hipe/test/hipe_testsuite_driver.erl16
-rw-r--r--lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl28
-rw-r--r--lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl21
-rw-r--r--lib/inets/doc/src/notes.xml18
-rw-r--r--lib/inets/src/http_client/httpc.erl7
-rw-r--r--lib/inets/src/http_client/httpc_request.erl3
-rw-r--r--lib/inets/src/http_lib/http_uri.erl8
-rw-r--r--lib/inets/src/http_server/httpd.erl18
-rw-r--r--lib/inets/src/http_server/httpd_conf.erl34
-rw-r--r--lib/inets/src/http_server/httpd_request.erl5
-rw-r--r--lib/inets/src/http_server/httpd_script_env.erl2
-rw-r--r--lib/inets/src/http_server/httpd_util.erl29
-rw-r--r--lib/inets/src/http_server/mod_actions.erl20
-rw-r--r--lib/inets/src/http_server/mod_alias.erl70
-rw-r--r--lib/inets/src/http_server/mod_auth.erl40
-rw-r--r--lib/inets/src/http_server/mod_auth_plain.erl14
-rw-r--r--lib/inets/src/http_server/mod_browser.erl21
-rw-r--r--lib/inets/src/http_server/mod_cgi.erl2
-rw-r--r--lib/inets/src/http_server/mod_dir.erl11
-rw-r--r--lib/inets/src/http_server/mod_disk_log.erl25
-rw-r--r--lib/inets/src/http_server/mod_esi.erl40
-rw-r--r--lib/inets/src/http_server/mod_htaccess.erl35
-rw-r--r--lib/inets/src/http_server/mod_security.erl8
-rw-r--r--lib/inets/src/inets_app/Makefile1
-rw-r--r--lib/inets/src/inets_app/inets.app.src1
-rw-r--r--lib/inets/src/inets_app/inets_regexp.erl414
-rw-r--r--lib/inets/src/tftp/tftp_engine.erl4
-rw-r--r--lib/inets/src/tftp/tftp_lib.erl4
-rw-r--r--lib/inets/test/httpc_SUITE.erl23
-rw-r--r--lib/inets/test/httpd_1_1.erl42
-rw-r--r--lib/inets/test/httpd_poll.erl6
-rw-r--r--lib/inets/test/httpd_test_lib.erl10
-rw-r--r--lib/inets/test/httpd_time_test.erl22
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/kernel/doc/src/code.xml61
-rw-r--r--lib/kernel/doc/src/os.xml25
-rw-r--r--lib/kernel/doc/src/seq_trace.xml29
-rw-r--r--lib/kernel/src/code.erl85
-rw-r--r--lib/kernel/src/code_server.erl199
-rw-r--r--lib/kernel/src/kernel.app.src2
-rw-r--r--lib/kernel/src/kernel.erl8
-rw-r--r--lib/kernel/src/os.erl16
-rw-r--r--lib/kernel/src/seq_trace.erl14
-rw-r--r--lib/kernel/test/code_SUITE.erl25
-rw-r--r--lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl5
-rw-r--r--lib/kernel/test/os_SUITE.erl46
-rw-r--r--lib/kernel/test/seq_trace_SUITE.erl166
-rw-r--r--lib/runtime_tools/doc/src/Makefile2
-rw-r--r--lib/runtime_tools/doc/src/msacc.xml305
-rw-r--r--lib/runtime_tools/doc/src/ref_man.xml1
-rw-r--r--lib/runtime_tools/doc/src/specs.xml1
-rw-r--r--lib/runtime_tools/src/Makefile4
-rw-r--r--lib/runtime_tools/src/dbg.erl4
-rw-r--r--lib/runtime_tools/src/msacc.erl355
-rw-r--r--lib/runtime_tools/src/runtime_tools.app.src3
-rw-r--r--lib/runtime_tools/test/Makefile3
-rw-r--r--lib/runtime_tools/test/msacc_SUITE.erl132
-rw-r--r--lib/sasl/doc/src/overload.xml6
-rw-r--r--lib/sasl/doc/src/sasl_app.xml6
-rw-r--r--lib/sasl/src/overload.erl2
-rw-r--r--lib/sasl/src/release_handler_1.erl67
-rw-r--r--lib/snmp/src/agent/snmp_view_based_acm_mib.erl2
-rw-r--r--lib/snmp/src/agent/snmpa_acm.erl4
-rw-r--r--lib/snmp/src/app/snmp.appup.src67
-rw-r--r--lib/ssl/src/ssl.appup.src6
-rw-r--r--lib/ssl/src/ssl_tls_dist_proxy.erl40
-rw-r--r--lib/ssl/src/tls_connection.erl2
-rw-r--r--lib/ssl/test/ssl_dist_SUITE.erl91
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl6
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/dets.xml31
-rw-r--r--lib/stdlib/doc/src/ets.xml41
-rw-r--r--lib/stdlib/src/beam_lib.erl9
-rw-r--r--lib/stdlib/src/dets.erl46
-rw-r--r--lib/stdlib/src/edlin.erl1
-rw-r--r--lib/stdlib/src/ets.erl2
-rw-r--r--lib/stdlib/src/file_sorter.erl22
-rw-r--r--lib/stdlib/src/otp_internal.erl3
-rw-r--r--lib/stdlib/src/qlc.erl14
-rw-r--r--lib/stdlib/src/stdlib.app.src2
-rw-r--r--lib/stdlib/test/dets_SUITE.erl77
-rw-r--r--lib/stdlib/test/ets_SUITE.erl35
-rw-r--r--lib/tools/src/cover.erl2
-rw-r--r--lib/tools/test/cover_SUITE.erl42
-rw-r--r--lib/typer/src/typer.erl12
-rw-r--r--otp_versions.table2
-rw-r--r--system/doc/reference_manual/typespec.xml2
234 files changed, 10909 insertions, 2640 deletions
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, &amp;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 c3e2ed61e9..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
@@ -4642,6 +4653,17 @@ os_prompt% </pre>
The content of <c><anno>GCInfo</anno></c> can be changed without
prior notice.</p>
</item>
+ <tag><c>{garbage_collection_info, <anno>GCInfo</anno>}</c></tag>
+ <item>
+ <p><c><anno>GCInfo</anno></c> is a list containing miscellaneous
+ detailed information about garbage collection for this process.
+ The content of <c><anno>GCInfo</anno></c> can be changed without
+ prior notice.
+ See <seealso marker="#gc_start">gc_start</seealso> in
+ <seealso marker="#trace/3">erlang:trace/3</seealso> for details about
+ what each item means.
+ </p>
+ </item>
<tag><c>{group_leader, <anno>GroupLeader</anno>}</c></tag>
<item>
<p><c><anno>GroupLeader</anno></c> is group leader for the I/O of
@@ -5848,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>
@@ -5865,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>
@@ -5881,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>
@@ -5901,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>
@@ -5916,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>
@@ -5987,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>
@@ -6005,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>
@@ -6024,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
@@ -6258,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
@@ -6272,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
@@ -6289,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>
@@ -6327,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>
@@ -6445,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>
@@ -6455,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>
@@ -6480,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
@@ -7843,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
@@ -7863,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>
@@ -8222,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
@@ -8230,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.
@@ -8276,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 ae7f405cce..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
@@ -258,6 +260,7 @@ atom functions
atom function_clause
atom garbage_collecting
atom garbage_collection
+atom garbage_collection_info
atom gc_end
atom gc_start
atom Ge='>='
@@ -268,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
@@ -359,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
@@ -372,6 +377,7 @@ atom monitor
atom monitor_nodes
atom monitors
atom monotonic
+atom monotonic_timestamp
atom more
atom multi_scheduling
atom multiline
@@ -556,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 4d7b00b032..d4fb36acc3 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/bif.c b/erts/emulator/beam/bif.c
index 34611ad6ab..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))
@@ -4415,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))
@@ -4744,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/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 5544712e8d..b53b662a59 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))
@@ -1917,7 +1917,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;
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_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 e69908bbef..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)
@@ -592,7 +593,8 @@ static Eterm pi_args[] = {
am_min_bin_vheap_size,
am_current_location,
am_current_stacktrace,
- am_message_queue_data
+ am_message_queue_data,
+ am_garbage_collection_info
};
#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm)))
@@ -641,6 +643,7 @@ pi_arg2ix(Eterm arg)
case am_current_location: return 29;
case am_current_stacktrace: return 30;
case am_message_queue_data: return 31;
+ case am_garbage_collection_info: return 32;
default: return -1;
}
}
@@ -1398,6 +1401,32 @@ process_info_aux(Process *BIF_P,
break;
}
+ case am_garbage_collection_info: {
+ Uint sz = 0, actual_sz = 0;
+
+ if (rp == BIF_P) {
+ sz += ERTS_PROCESS_GC_INFO_MAX_SIZE;
+ } else {
+ erts_process_gc_info(rp, &sz, NULL);
+ sz += 3;
+ }
+
+ hp = HAlloc(BIF_P, sz);
+ res = erts_process_gc_info(rp, &actual_sz, &hp);
+
+ /* We may have some extra space, fill with 0 tuples */
+ if (actual_sz <= sz - 3) {
+ for (; actual_sz < sz - 3; hp++, actual_sz++)
+ hp[0] = make_arityval(0);
+ } else {
+ for (; actual_sz < sz; hp++, actual_sz++)
+ hp[0] = make_arityval(0);
+ hp = HAlloc(BIF_P, 3);
+ }
+
+ break;
+ }
+
case am_group_leader: {
int sz = NC_HEAP_SIZE(rp->group_leader);
hp = HAlloc(BIF_P, 3 + sz);
@@ -3232,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);
@@ -4368,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 0f86b9a25c..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.
@@ -729,9 +736,7 @@ erts_garbage_collect_hibernate(Process* p)
*/
erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
ErtsGcQuickSanityCheck(p);
- ASSERT(p->mbuf == NULL);
ASSERT(p->stop == p->hend); /* Stack must be empty. */
- ASSERT(!p->abandoned_heap);
/*
* Do it.
@@ -2947,6 +2952,57 @@ erts_gc_info_request(Process *c_p)
return ref;
}
+Eterm
+erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp)
+{
+ ERTS_DECL_AM(bin_vheap_size);
+ ERTS_DECL_AM(bin_vheap_block_size);
+ ERTS_DECL_AM(bin_old_vheap_size);
+ ERTS_DECL_AM(bin_old_vheap_block_size);
+ Eterm tags[] = {
+ /* If you increase the number of elements here, make sure to update
+ any call sites as they may have stack allocations that depend
+ on the number of elements here. */
+ am_old_heap_block_size,
+ am_heap_block_size,
+ am_mbuf_size,
+ am_recent_size,
+ am_stack_size,
+ am_old_heap_size,
+ am_heap_size,
+ AM_bin_vheap_size,
+ AM_bin_vheap_block_size,
+ AM_bin_old_vheap_size,
+ AM_bin_old_vheap_block_size
+ };
+ UWord values[] = {
+ OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
+ HEAP_SIZE(p),
+ MBUF_SIZE(p),
+ HIGH_WATER(p) - HEAP_START(p),
+ STACK_START(p) - p->stop,
+ OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0,
+ HEAP_TOP(p) - HEAP_START(p),
+ MSO(p).overhead,
+ BIN_VHEAP_SZ(p),
+ BIN_OLD_VHEAP(p),
+ BIN_OLD_VHEAP_SZ(p)
+ };
+
+ Eterm res = THE_NON_VALUE;
+
+ ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags));
+ ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS);
+
+ res = erts_bld_atom_uword_2tup_list(hpp,
+ sizep,
+ sizeof(values)/sizeof(*values),
+ tags,
+ values);
+
+ return res;
+}
+
#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
static int
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index d603866cbf..2cedd9361f 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -132,6 +132,11 @@ typedef struct {
Uint64 garbage_cols;
} ErtsGCInfo;
+#define ERTS_PROCESS_GC_INFO_MAX_TERMS (11) /* number of elements in process_gc_info*/
+#define ERTS_PROCESS_GC_INFO_MAX_SIZE \
+ (ERTS_PROCESS_GC_INFO_MAX_TERMS * (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE))
+Eterm erts_process_gc_info(struct process*, Uint *, Eterm **);
+
void erts_gc_info(ErtsGCInfo *gcip);
void erts_init_gc(void);
int erts_garbage_collect_nobump(struct process*, int, Eterm*, int);
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 42aca726bf..520b504fcb 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -394,6 +394,7 @@ erl_init(int ncpu,
#endif
packet_parser_init();
erl_nif_init();
+ erts_msacc_init();
}
static Eterm
@@ -1193,6 +1194,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 +2222,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
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_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..b057ec7770 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;
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..8e1ebe795c 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));
@@ -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))
@@ -7925,6 +7957,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 +9237,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 +9343,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);
@@ -9467,7 +9505,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 +9520,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 +9529,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))
@@ -9567,9 +9609,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);
/*
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index b50fa5a10f..59e63780f0 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"
@@ -1284,6 +1287,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 +1319,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_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, &micro_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 b774ba97af..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);
@@ -2140,11 +2292,6 @@ void save_calls(Process *p, Export *e)
void
trace_gc(Process *p, Eterm what)
{
- ERTS_DECL_AM(bin_vheap_size);
- ERTS_DECL_AM(bin_vheap_block_size);
- ERTS_DECL_AM(bin_old_vheap_size);
- ERTS_DECL_AM(bin_old_vheap_block_size);
-
ErlHeapFragment *bp = NULL;
ErlOffHeap *off_heap;
ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; /* Initialized
@@ -2155,43 +2302,10 @@ trace_gc(Process *p, Eterm what)
Eterm msg = NIL;
Uint size;
- Eterm tags[] = {
- am_old_heap_block_size,
- am_heap_block_size,
- am_mbuf_size,
- am_recent_size,
- am_stack_size,
- am_old_heap_size,
- am_heap_size,
- AM_bin_vheap_size,
- AM_bin_vheap_block_size,
- AM_bin_old_vheap_size,
- AM_bin_old_vheap_block_size
- };
-
- UWord values[] = {
- OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
- HEAP_SIZE(p),
- MBUF_SIZE(p),
- HIGH_WATER(p) - HEAP_START(p),
- STACK_START(p) - p->stop,
- OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0,
- HEAP_TOP(p) - HEAP_START(p),
- MSO(p).overhead,
- BIN_VHEAP_SZ(p),
- BIN_OLD_VHEAP(p),
- BIN_OLD_VHEAP_SZ(p)
- };
#define LOCAL_HEAP_SIZE \
- (sizeof(values)/sizeof(*values)) * \
- (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) + \
- 5/*4-tuple */ + TS_HEAP_WORDS
+ (ERTS_PROCESS_GC_INFO_MAX_SIZE) + \
+ 5/*4-tuple */ + ERTS_TRACE_PATCH_TS_MAX_SIZE
DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
-#ifdef DEBUG
- Eterm* limit;
-#endif
-
- ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm));
UseTmpHeap(LOCAL_HEAP_SIZE,p);
@@ -2199,12 +2313,9 @@ trace_gc(Process *p, Eterm what)
hp = local_heap;
#ifdef DEBUG
size = 0;
- (void) erts_bld_atom_uword_2tup_list(NULL,
- &size,
- sizeof(values)/sizeof(*values),
- tags,
- values);
- size += 5/*4-tuple*/ + TS_SIZE(p);
+ (void) erts_process_gc_info(p, &size, NULL);
+
+ size += 5/*4-tuple*/ + PATCH_TS_SIZE(p);
#endif
} else {
ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
@@ -2214,40 +2325,30 @@ trace_gc(Process *p, Eterm what)
ERTS_TRACE_FLAGS(p));
size = 0;
- (void) erts_bld_atom_uword_2tup_list(NULL,
- &size,
- sizeof(values)/sizeof(*values),
- tags,
- values);
- size += 5/*4-tuple*/ + TS_SIZE(p);
+ (void) erts_process_gc_info(p, &size, NULL);
+
+ 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_bld_atom_uword_2tup_list(&hp,
- NULL,
- sizeof(values)/sizeof(*values),
- tags,
- values);
+ msg = erts_process_gc_info(p, NULL, &hp);
msg = TUPLE4(hp, am_trace, p->common.id, what, msg);
hp += 5;
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
@@ -2571,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;
@@ -2603,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);
@@ -2677,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);
@@ -2686,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);
@@ -2702,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),
@@ -2715,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);
@@ -2741,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);
@@ -2749,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);
@@ -2765,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),
@@ -2778,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);
@@ -2808,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);
@@ -2831,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));
@@ -2853,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
@@ -2871,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);
}
@@ -2884,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);
@@ -2898,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;
@@ -2909,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);
@@ -2926,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) {
@@ -2948,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);
@@ -2963,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..e8a7573e86 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1448,6 +1448,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..e77b4b2dc8 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))
@@ -772,6 +783,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/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index a82abc3e9f..c5c780dce5 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -1526,10 +1526,10 @@ static void invoke_writev(void *data) {
* with errno.
*/
errno = EINVAL;
- if (! (status =
- erts_gzwrite((ErtsGzFile)d->fd,
- iov[i].iov_base,
- iov[i].iov_len)) == iov[i].iov_len) {
+ status = erts_gzwrite((ErtsGzFile)d->fd,
+ iov[i].iov_base,
+ iov[i].iov_len) == iov[i].iov_len;
+ if (! status) {
d->errInfo.posix_errno =
d->errInfo.os_errno = errno; /* XXX Correct? */
break;
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/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
index 46eccc6568..00da48b107 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -39,6 +39,11 @@
#ifdef HAVE_SYS_UIO_H
#include <sys/types.h>
#include <sys/uio.h>
+#if defined(HAVE_SENDFILE) && (defined(__FreeBSD__) || defined(__DragonFly__))
+/* Need to define __BSD_VISIBLE in order to expose prototype of sendfile */
+#define __BSD_VISIBLE 1
+#include <sys/socket.h>
+#endif
#endif
#if defined(HAVE_SENDFILE) && (defined(__linux__) || (defined(__sun) && defined(__SVR4)))
#include <sys/sendfile.h>
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/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/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index 97aa5e573e..bfd1e78bf0 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -41,6 +41,7 @@
process_info_2_list/1, process_info_lock_reschedule/1,
process_info_lock_reschedule2/1,
process_info_lock_reschedule3/1,
+ process_info_garbage_collection/1,
bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1,
process_status_exiting/1,
otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1,
@@ -75,7 +76,9 @@ all() ->
process_info_other_dist_msg, process_info_2_list,
process_info_lock_reschedule,
process_info_lock_reschedule2,
- process_info_lock_reschedule3, process_status_exiting,
+ process_info_lock_reschedule3,
+ process_info_garbage_collection,
+ process_status_exiting,
bump_reductions, low_prio, yield, yield2, otp_4725,
bad_register, garbage_collect, process_info_messages,
process_flag_badarg, process_flag_heap_size,
@@ -932,6 +935,48 @@ start_spawner() ->
stop_spawner() ->
ok.
+%% Tests erlang:process_info(Pid, garbage_collection_info)
+process_info_garbage_collection(_Config) ->
+ Parent = self(),
+ Pid = spawn_link(
+ fun() ->
+ receive go -> ok end,
+ (fun F(0) ->
+ Parent ! deep,
+ receive ok -> ok end,
+ [];
+ F(N) ->
+ timer:sleep(1),
+ [lists:seq(1,100) | F(N-1)]
+ end)(1000),
+ Parent ! shallow,
+ receive done -> ok end
+ end),
+ {garbage_collection_info, Before} =
+ erlang:process_info(Pid, garbage_collection_info),
+ Pid ! go, receive deep -> ok end,
+ {_, Deep} = erlang:process_info(Pid, garbage_collection_info),
+ Pid ! ok, receive shallow -> ok end,
+ {_, After} = erlang:process_info(Pid, garbage_collection_info),
+ Pid ! done,
+
+ %% Do some general checks to see if everything seems to be roughly correct
+ ct:log("Before: ~p",[Before]),
+ ct:log("Deep: ~p",[Deep]),
+ ct:log("After: ~p",[After]),
+
+ %% Check stack_size
+ true = proplists:get_value(stack_size, Before) < proplists:get_value(stack_size, Deep),
+ true = proplists:get_value(stack_size, After) < proplists:get_value(stack_size, Deep),
+
+ %% Check used heap size
+ true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before)
+ < proplists:get_value(heap_size, Deep) + proplists:get_value(old_heap_size, Deep),
+ true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before)
+ < proplists:get_value(heap_size, After) + proplists:get_value(old_heap_size, After),
+
+ ok.
+
%% Tests erlang:bump_reductions/1.
bump_reductions(Config) when is_list(Config) ->
erlang:garbage_collect(),
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/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
index f6057b45d4..2a54c10273 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index b6e38e4b5b..f1e48b3282 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam
index 227d96d4c8..3d73b0cb1b 100644
--- a/erts/preloaded/ebin/erts_code_purger.beam
+++ b/erts/preloaded/ebin/erts_code_purger.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index d3d990519d..24fa68506b 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index b6d1df7bbc..2f66b5f970 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam
index 328520844d..057fe79054 100644
--- a/erts/preloaded/ebin/otp_ring0.beam
+++ b/erts/preloaded/ebin/otp_ring0.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam
index 8d6c1927fd..33f5de7d3f 100644
--- a/erts/preloaded/ebin/prim_eval.beam
+++ b/erts/preloaded/ebin/prim_eval.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index 1221c513db..b96927b72b 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam
index fa617f1f51..767a48d781 100644
--- a/erts/preloaded/ebin/prim_inet.beam
+++ b/erts/preloaded/ebin/prim_inet.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam
index 83e1e49974..2bc85bbcbf 100644
--- a/erts/preloaded/ebin/prim_zip.beam
+++ b/erts/preloaded/ebin/prim_zip.beam
Binary files differ
diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam
index 8f654e3abf..0b4afc0a39 100644
--- a/erts/preloaded/ebin/zlib.beam
+++ b/erts/preloaded/ebin/zlib.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 40d5aedd24..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;
@@ -2051,6 +2063,7 @@ process_flag(_Flag, _Value) ->
dictionary |
error_handler |
garbage_collection |
+ garbage_collection_info |
group_leader |
heap_size |
initial_call |
@@ -2091,6 +2104,7 @@ process_flag(_Flag, _Value) ->
{dictionary, Dictionary :: [{Key :: term(), Value :: term()}]} |
{error_handler, Module :: module()} |
{garbage_collection, GCInfo :: [{atom(),non_neg_integer()}]} |
+ {garbage_collection_info, GCInfo :: [{atom(),non_neg_integer()}]} |
{group_leader, GroupLeader :: pid()} |
{heap_size, Size :: non_neg_integer()} |
{initial_call, mfa()} |
@@ -2160,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) ->
@@ -2201,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(),
@@ -2255,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_internal.erl b/erts/preloaded/src/erts_internal.erl
index 84dedab930..a15355bb10 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -45,10 +45,13 @@
-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]).
+-export([await_microstate_accounting_modifications/3,
+ gather_microstate_accounting_result/2]).
+
%% Auto import name clash
-export([check_process_code/2]).
@@ -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/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 58bb18e34a..b86be95cab 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -27,7 +27,7 @@
-module(cerl_trees).
-export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2,
- map/2, mapfold/3, size/1, variables/1]).
+ map/2, mapfold/3, mapfold/4, size/1, variables/1]).
-import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3,
ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4,
@@ -340,136 +340,162 @@ fold_pairs(_, S, []) ->
%% starting with the given value <code>Initial</code>, while doing a
%% post-order traversal of the tree, much like <code>fold/3</code>.
%%
+%% This is the same as mapfold/4, with an identity function as the
+%% pre-operation.
+%%
%% @see map/2
%% @see fold/3
+%% @see mapfold/4
-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}),
term(), cerl:cerl()) -> {cerl:cerl(), term()}.
mapfold(F, S0, T) ->
+ mapfold(fun(T0, A) -> {T0, A} end, F, S0, T).
+
+
+%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) ->
+%% {cerl(), term()}
+%%
+%% Pre = Post = (cerl(), term()) -> {cerl(), term()}
+%%
+%% @doc Does a combined map/fold operation on the nodes of the
+%% tree. It begins by calling <code>Pre</code> on the tree, using the
+%% <code>Initial</code> value. It then deconstructs the top node of
+%% the returned tree and recurses on the children, using the returned
+%% value as the new initial and carrying the returned values from one
+%% call to the next. Finally it reassembles the top node from the
+%% children, calls <code>Post</code> on it and returns the result.
+
+-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}),
+ fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}),
+ term(), cerl:cerl()) -> {cerl:cerl(), term()}.
+
+mapfold(Pre, Post, S00, T0) ->
+ {T, S0} = Pre(T0, S00),
case type(T) of
literal ->
case concrete(T) of
[_ | _] ->
- {T1, S1} = mapfold(F, S0, cons_hd(T)),
- {T2, S2} = mapfold(F, S1, cons_tl(T)),
- F(update_c_cons(T, T1, T2), S2);
+ {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)),
+ {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)),
+ Post(update_c_cons(T, T1, T2), S2);
V when tuple_size(V) > 0 ->
- {Ts, S1} = mapfold_list(F, S0, tuple_es(T)),
- F(update_c_tuple(T, Ts), S1);
+ {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)),
+ Post(update_c_tuple(T, Ts), S1);
_ ->
- F(T, S0)
+ Post(T, S0)
end;
var ->
- F(T, S0);
+ Post(T, S0);
values ->
- {Ts, S1} = mapfold_list(F, S0, values_es(T)),
- F(update_c_values(T, Ts), S1);
+ {Ts, S1} = mapfold_list(Pre, Post, S0, values_es(T)),
+ Post(update_c_values(T, Ts), S1);
cons ->
- {T1, S1} = mapfold(F, S0, cons_hd(T)),
- {T2, S2} = mapfold(F, S1, cons_tl(T)),
- F(update_c_cons_skel(T, T1, T2), S2);
+ {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)),
+ {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)),
+ Post(update_c_cons_skel(T, T1, T2), S2);
tuple ->
- {Ts, S1} = mapfold_list(F, S0, tuple_es(T)),
- F(update_c_tuple_skel(T, Ts), S1);
+ {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)),
+ Post(update_c_tuple_skel(T, Ts), S1);
map ->
- {M , S1} = mapfold(F, S0, map_arg(T)),
- {Ts, S2} = mapfold_list(F, S1, map_es(T)),
- F(update_c_map(T, M, Ts), S2);
+ {M , S1} = mapfold(Pre, Post, S0, map_arg(T)),
+ {Ts, S2} = mapfold_list(Pre, Post, S1, map_es(T)),
+ Post(update_c_map(T, M, Ts), S2);
map_pair ->
- {Op, S1} = mapfold(F, S0, map_pair_op(T)),
- {Key, S2} = mapfold(F, S1, map_pair_key(T)),
- {Val, S3} = mapfold(F, S2, map_pair_val(T)),
- F(update_c_map_pair(T,Op,Key,Val), S3);
+ {Op, S1} = mapfold(Pre, Post, S0, map_pair_op(T)),
+ {Key, S2} = mapfold(Pre, Post, S1, map_pair_key(T)),
+ {Val, S3} = mapfold(Pre, Post, S2, map_pair_val(T)),
+ Post(update_c_map_pair(T,Op,Key,Val), S3);
'let' ->
- {Vs, S1} = mapfold_list(F, S0, let_vars(T)),
- {A, S2} = mapfold(F, S1, let_arg(T)),
- {B, S3} = mapfold(F, S2, let_body(T)),
- F(update_c_let(T, Vs, A, B), S3);
+ {Vs, S1} = mapfold_list(Pre, Post, S0, let_vars(T)),
+ {A, S2} = mapfold(Pre, Post, S1, let_arg(T)),
+ {B, S3} = mapfold(Pre, Post, S2, let_body(T)),
+ Post(update_c_let(T, Vs, A, B), S3);
seq ->
- {A, S1} = mapfold(F, S0, seq_arg(T)),
- {B, S2} = mapfold(F, S1, seq_body(T)),
- F(update_c_seq(T, A, B), S2);
+ {A, S1} = mapfold(Pre, Post, S0, seq_arg(T)),
+ {B, S2} = mapfold(Pre, Post, S1, seq_body(T)),
+ Post(update_c_seq(T, A, B), S2);
apply ->
- {E, S1} = mapfold(F, S0, apply_op(T)),
- {As, S2} = mapfold_list(F, S1, apply_args(T)),
- F(update_c_apply(T, E, As), S2);
+ {E, S1} = mapfold(Pre, Post, S0, apply_op(T)),
+ {As, S2} = mapfold_list(Pre, Post, S1, apply_args(T)),
+ Post(update_c_apply(T, E, As), S2);
call ->
- {M, S1} = mapfold(F, S0, call_module(T)),
- {N, S2} = mapfold(F, S1, call_name(T)),
- {As, S3} = mapfold_list(F, S2, call_args(T)),
- F(update_c_call(T, M, N, As), S3);
+ {M, S1} = mapfold(Pre, Post, S0, call_module(T)),
+ {N, S2} = mapfold(Pre, Post, S1, call_name(T)),
+ {As, S3} = mapfold_list(Pre, Post, S2, call_args(T)),
+ Post(update_c_call(T, M, N, As), S3);
primop ->
- {N, S1} = mapfold(F, S0, primop_name(T)),
- {As, S2} = mapfold_list(F, S1, primop_args(T)),
- F(update_c_primop(T, N, As), S2);
+ {N, S1} = mapfold(Pre, Post, S0, primop_name(T)),
+ {As, S2} = mapfold_list(Pre, Post, S1, primop_args(T)),
+ Post(update_c_primop(T, N, As), S2);
'case' ->
- {A, S1} = mapfold(F, S0, case_arg(T)),
- {Cs, S2} = mapfold_list(F, S1, case_clauses(T)),
- F(update_c_case(T, A, Cs), S2);
+ {A, S1} = mapfold(Pre, Post, S0, case_arg(T)),
+ {Cs, S2} = mapfold_list(Pre, Post, S1, case_clauses(T)),
+ Post(update_c_case(T, A, Cs), S2);
clause ->
- {Ps, S1} = mapfold_list(F, S0, clause_pats(T)),
- {G, S2} = mapfold(F, S1, clause_guard(T)),
- {B, S3} = mapfold(F, S2, clause_body(T)),
- F(update_c_clause(T, Ps, G, B), S3);
+ {Ps, S1} = mapfold_list(Pre, Post, S0, clause_pats(T)),
+ {G, S2} = mapfold(Pre, Post, S1, clause_guard(T)),
+ {B, S3} = mapfold(Pre, Post, S2, clause_body(T)),
+ Post(update_c_clause(T, Ps, G, B), S3);
alias ->
- {V, S1} = mapfold(F, S0, alias_var(T)),
- {P, S2} = mapfold(F, S1, alias_pat(T)),
- F(update_c_alias(T, V, P), S2);
+ {V, S1} = mapfold(Pre, Post, S0, alias_var(T)),
+ {P, S2} = mapfold(Pre, Post, S1, alias_pat(T)),
+ Post(update_c_alias(T, V, P), S2);
'fun' ->
- {Vs, S1} = mapfold_list(F, S0, fun_vars(T)),
- {B, S2} = mapfold(F, S1, fun_body(T)),
- F(update_c_fun(T, Vs, B), S2);
+ {Vs, S1} = mapfold_list(Pre, Post, S0, fun_vars(T)),
+ {B, S2} = mapfold(Pre, Post, S1, fun_body(T)),
+ Post(update_c_fun(T, Vs, B), S2);
'receive' ->
- {Cs, S1} = mapfold_list(F, S0, receive_clauses(T)),
- {E, S2} = mapfold(F, S1, receive_timeout(T)),
- {A, S3} = mapfold(F, S2, receive_action(T)),
- F(update_c_receive(T, Cs, E, A), S3);
+ {Cs, S1} = mapfold_list(Pre, Post, S0, receive_clauses(T)),
+ {E, S2} = mapfold(Pre, Post, S1, receive_timeout(T)),
+ {A, S3} = mapfold(Pre, Post, S2, receive_action(T)),
+ Post(update_c_receive(T, Cs, E, A), S3);
'try' ->
- {E, S1} = mapfold(F, S0, try_arg(T)),
- {Vs, S2} = mapfold_list(F, S1, try_vars(T)),
- {B, S3} = mapfold(F, S2, try_body(T)),
- {Evs, S4} = mapfold_list(F, S3, try_evars(T)),
- {H, S5} = mapfold(F, S4, try_handler(T)),
- F(update_c_try(T, E, Vs, B, Evs, H), S5);
+ {E, S1} = mapfold(Pre, Post, S0, try_arg(T)),
+ {Vs, S2} = mapfold_list(Pre, Post, S1, try_vars(T)),
+ {B, S3} = mapfold(Pre, Post, S2, try_body(T)),
+ {Evs, S4} = mapfold_list(Pre, Post, S3, try_evars(T)),
+ {H, S5} = mapfold(Pre, Post, S4, try_handler(T)),
+ Post(update_c_try(T, E, Vs, B, Evs, H), S5);
'catch' ->
- {B, S1} = mapfold(F, S0, catch_body(T)),
- F(update_c_catch(T, B), S1);
+ {B, S1} = mapfold(Pre, Post, S0, catch_body(T)),
+ Post(update_c_catch(T, B), S1);
binary ->
- {Ds, S1} = mapfold_list(F, S0, binary_segments(T)),
- F(update_c_binary(T, Ds), S1);
+ {Ds, S1} = mapfold_list(Pre, Post, S0, binary_segments(T)),
+ Post(update_c_binary(T, Ds), S1);
bitstr ->
- {Val, S1} = mapfold(F, S0, bitstr_val(T)),
- {Size, S2} = mapfold(F, S1, bitstr_size(T)),
- {Unit, S3} = mapfold(F, S2, bitstr_unit(T)),
- {Type, S4} = mapfold(F, S3, bitstr_type(T)),
- {Flags, S5} = mapfold(F, S4, bitstr_flags(T)),
- F(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5);
+ {Val, S1} = mapfold(Pre, Post, S0, bitstr_val(T)),
+ {Size, S2} = mapfold(Pre, Post, S1, bitstr_size(T)),
+ {Unit, S3} = mapfold(Pre, Post, S2, bitstr_unit(T)),
+ {Type, S4} = mapfold(Pre, Post, S3, bitstr_type(T)),
+ {Flags, S5} = mapfold(Pre, Post, S4, bitstr_flags(T)),
+ Post(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5);
letrec ->
- {Ds, S1} = mapfold_pairs(F, S0, letrec_defs(T)),
- {B, S2} = mapfold(F, S1, letrec_body(T)),
- F(update_c_letrec(T, Ds, B), S2);
+ {Ds, S1} = mapfold_pairs(Pre, Post, S0, letrec_defs(T)),
+ {B, S2} = mapfold(Pre, Post, S1, letrec_body(T)),
+ Post(update_c_letrec(T, Ds, B), S2);
module ->
- {N, S1} = mapfold(F, S0, module_name(T)),
- {Es, S2} = mapfold_list(F, S1, module_exports(T)),
- {As, S3} = mapfold_pairs(F, S2, module_attrs(T)),
- {Ds, S4} = mapfold_pairs(F, S3, module_defs(T)),
- F(update_c_module(T, N, Es, As, Ds), S4)
+ {N, S1} = mapfold(Pre, Post, S0, module_name(T)),
+ {Es, S2} = mapfold_list(Pre, Post, S1, module_exports(T)),
+ {As, S3} = mapfold_pairs(Pre, Post, S2, module_attrs(T)),
+ {Ds, S4} = mapfold_pairs(Pre, Post, S3, module_defs(T)),
+ Post(update_c_module(T, N, Es, As, Ds), S4)
end.
-mapfold_list(F, S0, [T | Ts]) ->
- {T1, S1} = mapfold(F, S0, T),
- {Ts1, S2} = mapfold_list(F, S1, Ts),
+mapfold_list(Pre, Post, S0, [T | Ts]) ->
+ {T1, S1} = mapfold(Pre, Post, S0, T),
+ {Ts1, S2} = mapfold_list(Pre, Post, S1, Ts),
{[T1 | Ts1], S2};
-mapfold_list(_, S, []) ->
+mapfold_list(_, _, S, []) ->
{[], S}.
-mapfold_pairs(F, S0, [{T1, T2} | Ps]) ->
- {T3, S1} = mapfold(F, S0, T1),
- {T4, S2} = mapfold(F, S1, T2),
- {Ps1, S3} = mapfold_pairs(F, S2, Ps),
+mapfold_pairs(Pre, Post, S0, [{T1, T2} | Ps]) ->
+ {T3, S1} = mapfold(Pre, Post, S0, T1),
+ {T4, S2} = mapfold(Pre, Post, S1, T2),
+ {Ps1, S3} = mapfold_pairs(Pre, Post, S2, Ps),
{[{T3, T4} | Ps1], S3};
-mapfold_pairs(_, S, []) ->
+mapfold_pairs(_, _, S, []) ->
{[], S}.
@@ -640,8 +666,8 @@ vars_in_list([], _, A) ->
vars_in_defs(Ds, S) ->
vars_in_defs(Ds, S, []).
-vars_in_defs([{_, F} | Ds], S, A) ->
- vars_in_defs(Ds, S, ordsets:union(variables(F, S), A));
+vars_in_defs([{_, Post} | Ds], S, A) ->
+ vars_in_defs(Ds, S, ordsets:union(variables(Post, S), A));
vars_in_defs([], _, A) ->
A.
@@ -703,13 +729,14 @@ label(T, N, Env) ->
%% Constant literals are not labeled.
{T, N};
var ->
- case dict:find(var_name(T), Env) of
- {ok, L} ->
- {As, _} = label_ann(T, L),
- N1 = N;
- error ->
- {As, N1} = label_ann(T, N)
- end,
+ {As, N1} =
+ case dict:find(var_name(T), Env) of
+ {ok, L} ->
+ {A, _} = label_ann(T, L),
+ {A, N};
+ error ->
+ label_ann(T, N)
+ end,
{set_ann(T, As), N1};
values ->
{Ts, N1} = label_list(values_es(T), N, Env),
diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml
index 3fd34241b2..619db125b1 100644
--- a/lib/dialyzer/doc/src/dialyzer.xml
+++ b/lib/dialyzer/doc/src/dialyzer.xml
@@ -254,7 +254,7 @@
analysis that finds data races performs intra-procedural data flow analysis
and can sometimes explode in time. Enable it at your own risk.
</item>
-i <tag><c><![CDATA[-Wunderspecs]]></c>***</tag>
+ <tag><c><![CDATA[-Wunderspecs]]></c>***</tag>
<item>Warn about underspecified functions
(the -spec is strictly more allowing than the success typing).</item>
<tag><c><![CDATA[-Wunknown]]></c>***</tag>
diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile
index 770af2140f..fd75cd5cd8 100644
--- a/lib/dialyzer/src/Makefile
+++ b/lib/dialyzer/src/Makefile
@@ -61,6 +61,7 @@ MODULES = \
dialyzer_gui_wx \
dialyzer_options \
dialyzer_plt \
+ dialyzer_race_data_server \
dialyzer_races \
dialyzer_succ_typings \
dialyzer_timing \
@@ -140,6 +141,7 @@ $(EBIN)/dialyzer_explanation.beam: dialyzer.hrl
$(EBIN)/dialyzer_gui_wx.beam: dialyzer.hrl dialyzer_gui_wx.hrl
$(EBIN)/dialyzer_options.beam: dialyzer.hrl
$(EBIN)/dialyzer_plt.beam: dialyzer.hrl
+$(EBIN)/dialyzer_race_data_server.beam: dialyzer.hrl
$(EBIN)/dialyzer_races.beam: dialyzer.hrl
$(EBIN)/dialyzer_succ_typings.beam: dialyzer.hrl
$(EBIN)/dialyzer_typesig.beam: dialyzer.hrl
diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src
index 7794cb46c6..003d7f2ba4 100644
--- a/lib/dialyzer/src/dialyzer.app.src
+++ b/lib/dialyzer/src/dialyzer.app.src
@@ -37,6 +37,7 @@
dialyzer_gui_wx,
dialyzer_options,
dialyzer_plt,
+ dialyzer_race_data_server,
dialyzer_races,
dialyzer_succ_typings,
dialyzer_typesig,
diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
index 826ac51775..50fc1d8471 100644
--- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2015. 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.
@@ -31,14 +31,17 @@
-export([start/3]).
+%%% Export for dialyzer_coordinator...
-export([compile_init_result/0,
- add_to_result/4,
- start_compilation/2,
+ add_to_result/4]).
+%%% ... and export for dialyzer_worker.
+-export([start_compilation/2,
continue_compilation/2]).
-export_type([compile_init_data/0,
- one_file_result/0,
- compile_result/0]).
+ one_file_mid_error/0,
+ one_file_result_ok/0,
+ compile_result/0]).
-include("dialyzer.hrl").
@@ -93,31 +96,19 @@ loop(#server_state{parent = Parent} = State,
send_log(Parent, LogMsg),
loop(State, Analysis, ExtCalls);
{AnalPid, warnings, Warnings} ->
- case Warnings of
- [] -> ok;
- SendWarnings ->
- send_warnings(Parent, SendWarnings)
- end,
+ send_warnings(Parent, Warnings),
loop(State, Analysis, ExtCalls);
{AnalPid, cserver, CServer, Plt} ->
send_codeserver_plt(Parent, CServer, Plt),
loop(State, Analysis, ExtCalls);
{AnalPid, done, Plt, DocPlt} ->
- case ExtCalls =:= none of
- true ->
- send_analysis_done(Parent, Plt, DocPlt);
- false ->
- send_ext_calls(Parent, ExtCalls),
- send_analysis_done(Parent, Plt, DocPlt)
- 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);
@@ -165,8 +156,7 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1),
TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0),
TmpCServer2 =
- dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes,
- TmpCServer1),
+ dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
?timing(State#analysis_state.timing_server, "remote",
begin
TmpCServer3 =
@@ -259,6 +249,10 @@ compile_and_store(Files, #analysis_state{codeserver = CServer,
{T1, _} = statistics(wall_clock),
Callgraph = dialyzer_callgraph:new(),
CompileInit = make_compile_init(State, Callgraph),
+ %% Spawn a worker per file - where each worker calls
+ %% start_compilation on its file, asks next label to coordinator and
+ %% calls continue_compilation - and let coordinator aggregate
+ %% results using (compile_init_result and) add_to_result.
{{Failed, Modules}, NextLabel} =
?timing(Timing, "compile", _C1,
dialyzer_coordinator:parallel_job(compile, Files,
@@ -290,16 +284,18 @@ compile_and_store(Files, #analysis_state{codeserver = CServer,
send_log(Parent, Msg2),
{Callgraph, CServer2}.
--type compile_init_data() :: #compile_init{}.
--type error_reason() :: string().
--type compile_result() :: {[{file:filename(), error_reason()}],
- [module()]}. %%opaque
--type one_file_result() :: {error, error_reason()} |
- {ok, [dialyzer_callgraph:callgraph_edge()],
- [mfa_or_funlbl()], module()}. %%opaque
--type compile_mid_data() :: {module(), cerl:cerl(),
- dialyzer_callgraph:callgraph(),
- dialyzer_codeserver:codeserver()}.
+-opaque compile_init_data() :: #compile_init{}.
+-type error_reason() :: string().
+-opaque compile_result() :: {[{file:filename(), error_reason()}],
+ [module()]}.
+-type one_file_mid_error() :: {error, error_reason()}.
+-opaque one_file_result_ok() :: {ok, [dialyzer_callgraph:callgraph_edge()],
+ [mfa_or_funlbl()], module()}.
+-type one_file_result() :: one_file_mid_error() |
+ one_file_result_ok().
+-type compile_mid_data() :: {module(), cerl:cerl(),
+ dialyzer_callgraph:callgraph(),
+ dialyzer_codeserver:codeserver()}.
-spec compile_init_result() -> compile_result().
@@ -440,7 +436,8 @@ store_core(Mod, Core, Callgraph, CServer) ->
CoreSize = cerl_trees:size(CoreTree),
{ok, CoreSize, {Mod, CoreTree, Callgraph, CServer}}.
--spec continue_compilation(integer(), compile_mid_data()) -> one_file_result().
+-spec continue_compilation(integer(), compile_mid_data()) ->
+ one_file_result_ok().
continue_compilation(NextLabel, {Mod, CoreTree, Callgraph, CServer}) ->
{LabeledTree, _NewNextLabel} = cerl_trees:label(CoreTree, NextLabel),
@@ -572,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.
@@ -580,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_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl
index ede29b42bc..50abb22009 100644
--- a/lib/dialyzer/src/dialyzer_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_callgraph.erl
@@ -113,16 +113,11 @@
calls :: ets:tid()
| 'undefined', % race
race_detection = false :: boolean(),
- race_data_server = new_race_data_server() :: pid()}).
-
--record(race_data_state, {race_code = dict:new() :: dict:dict(),
- public_tables = [] :: [label()],
- named_tables = [] :: [string()],
- beh_api_calls = [] :: [{mfa(), mfa()}]}).
+ race_data_server = dialyzer_race_data_server:new() :: pid()}).
%% Exported Types
--type callgraph() :: #callgraph{}.
+-opaque callgraph() :: #callgraph{}.
-type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}.
@@ -616,45 +611,30 @@ digraph_reaching_subgraph(Funs, DG) ->
renew_race_info(#callgraph{race_data_server = RaceDataServer} = CG,
RaceCode, PublicTables, NamedTables) ->
- ok = race_data_server_cast(
+ ok = dialyzer_race_data_server:cast(
{renew_race_info, {RaceCode, PublicTables, NamedTables}},
RaceDataServer),
CG.
-renew_race_info({RaceCode, PublicTables, NamedTables},
- #race_data_state{} = State) ->
- State#race_data_state{race_code = RaceCode,
- public_tables = PublicTables,
- named_tables = NamedTables}.
-
-spec renew_race_code(dialyzer_races:races(), callgraph()) -> callgraph().
renew_race_code(Races, #callgraph{race_data_server = RaceDataServer} = CG) ->
Fun = dialyzer_races:get_curr_fun(Races),
FunArgs = dialyzer_races:get_curr_fun_args(Races),
Code = lists:reverse(dialyzer_races:get_race_list(Races)),
- ok = race_data_server_cast(
+ ok = dialyzer_race_data_server:cast(
{renew_race_code, {Fun, FunArgs, Code}},
RaceDataServer),
CG.
-renew_race_code_handler({Fun, FunArgs, Code},
- #race_data_state{race_code = RaceCode} = State) ->
- State#race_data_state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}.
-
-spec renew_race_public_tables(label(), callgraph()) -> callgraph().
renew_race_public_tables(VarLabel,
#callgraph{race_data_server = RaceDataServer} = CG) ->
ok =
- race_data_server_cast({renew_race_public_tables, VarLabel}, RaceDataServer),
+ dialyzer_race_data_server:cast({renew_race_public_tables, VarLabel}, RaceDataServer),
CG.
-renew_race_public_tables_handler(VarLabel,
- #race_data_state{public_tables = PT}
- = State) ->
- State#race_data_state{public_tables = ordsets:add_element(VarLabel, PT)}.
-
-spec cleanup(callgraph()) -> callgraph().
cleanup(#callgraph{digraph = Digraph,
@@ -664,18 +644,18 @@ cleanup(#callgraph{digraph = Digraph,
#callgraph{digraph = Digraph,
name_map = NameMap,
rev_name_map = RevNameMap,
- race_data_server = race_data_server_call(dup, RaceDataServer)}.
+ race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}.
-spec duplicate(callgraph()) -> callgraph().
duplicate(#callgraph{race_data_server = RaceDataServer} = Callgraph) ->
Callgraph#callgraph{
- race_data_server = race_data_server_call(dup, RaceDataServer)}.
+ race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}.
-spec dispose_race_server(callgraph()) -> ok.
dispose_race_server(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_cast(stop, RaceDataServer).
+ dialyzer_race_data_server:stop(RaceDataServer).
-spec get_digraph(callgraph()) -> digraph:graph().
@@ -685,17 +665,17 @@ get_digraph(#callgraph{digraph = Digraph}) ->
-spec get_named_tables(callgraph()) -> [string()].
get_named_tables(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_call(get_named_tables, RaceDataServer).
+ dialyzer_race_data_server:call(get_named_tables, RaceDataServer).
-spec get_public_tables(callgraph()) -> [label()].
get_public_tables(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_call(get_public_tables, RaceDataServer).
+ dialyzer_race_data_server:call(get_public_tables, RaceDataServer).
-spec get_race_code(callgraph()) -> dict:dict().
get_race_code(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_call(get_race_code, RaceDataServer).
+ dialyzer_race_data_server:call(get_race_code, RaceDataServer).
-spec get_race_detection(callgraph()) -> boolean().
@@ -705,12 +685,12 @@ get_race_detection(#callgraph{race_detection = RD}) ->
-spec get_behaviour_api_calls(callgraph()) -> [{mfa(), mfa()}].
get_behaviour_api_calls(#callgraph{race_data_server = RaceDataServer}) ->
- race_data_server_call(get_behaviour_api_calls, RaceDataServer).
+ dialyzer_race_data_server:call(get_behaviour_api_calls, RaceDataServer).
-spec race_code_new(callgraph()) -> callgraph().
race_code_new(#callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast(race_code_new, RaceDataServer),
+ ok = dialyzer_race_data_server:cast(race_code_new, RaceDataServer),
CG.
-spec put_digraph(digraph:graph(), callgraph()) -> callgraph().
@@ -721,7 +701,7 @@ put_digraph(Digraph, Callgraph) ->
-spec put_race_code(dict:dict(), callgraph()) -> callgraph().
put_race_code(RaceCode, #callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast({put_race_code, RaceCode}, RaceDataServer),
+ ok = dialyzer_race_data_server:cast({put_race_code, RaceCode}, RaceDataServer),
CG.
-spec put_race_detection(boolean(), callgraph()) -> callgraph().
@@ -733,78 +713,23 @@ put_race_detection(RaceDetection, Callgraph) ->
put_named_tables(NamedTables,
#callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast({put_named_tables, NamedTables}, RaceDataServer),
+ ok = dialyzer_race_data_server:cast({put_named_tables, NamedTables}, RaceDataServer),
CG.
-spec put_public_tables([label()], callgraph()) -> callgraph().
put_public_tables(PublicTables,
#callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast({put_public_tables, PublicTables}, RaceDataServer),
+ ok = dialyzer_race_data_server:cast({put_public_tables, PublicTables}, RaceDataServer),
CG.
-spec put_behaviour_api_calls([{mfa(), mfa()}], callgraph()) -> callgraph().
put_behaviour_api_calls(Calls,
#callgraph{race_data_server = RaceDataServer} = CG) ->
- ok = race_data_server_cast({put_behaviour_api_calls, Calls}, RaceDataServer),
+ ok = dialyzer_race_data_server:cast({put_behaviour_api_calls, Calls}, RaceDataServer),
CG.
-
-new_race_data_server() ->
- spawn_link(fun() -> race_data_server_loop(#race_data_state{}) end).
-
-race_data_server_loop(State) ->
- receive
- {call, From, Ref, Query} ->
- Reply = race_data_server_handle_call(Query, State),
- From ! {Ref, Reply},
- race_data_server_loop(State);
- {cast, stop} ->
- ok;
- {cast, Message} ->
- NewState = race_data_server_handle_cast(Message, State),
- race_data_server_loop(NewState)
- end.
-
-race_data_server_call(Query, Server) ->
- Ref = make_ref(),
- Server ! {call, self(), Ref, Query},
- receive
- {Ref, Reply} -> Reply
- end.
-
-race_data_server_cast(Message, Server) ->
- Server ! {cast, Message},
- ok.
-
-race_data_server_handle_cast(race_code_new, State) ->
- State#race_data_state{race_code = dict:new()};
-race_data_server_handle_cast({Tag, Data}, State) ->
- case Tag of
- renew_race_info -> renew_race_info(Data, State);
- renew_race_code -> renew_race_code_handler(Data, State);
- renew_race_public_tables -> renew_race_public_tables_handler(Data, State);
- put_race_code -> State#race_data_state{race_code = Data};
- put_public_tables -> State#race_data_state{public_tables = Data};
- put_named_tables -> State#race_data_state{named_tables = Data};
- put_behaviour_api_calls -> State#race_data_state{beh_api_calls = Data}
- end.
-
-race_data_server_handle_call(Query,
- #race_data_state{race_code = RaceCode,
- public_tables = PublicTables,
- named_tables = NamedTables,
- beh_api_calls = BehApiCalls}
- = State) ->
- case Query of
- dup -> spawn_link(fun() -> race_data_server_loop(State) end);
- get_race_code -> RaceCode;
- get_public_tables -> PublicTables;
- get_named_tables -> NamedTables;
- get_behaviour_api_calls -> BehApiCalls
- end.
-
%%=============================================================================
%% Utilities for 'dot'
%%=============================================================================
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_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 83b3ef72f2..e03e4d5bb4 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
@@ -167,8 +167,7 @@ process_contract_remote_types(CodeServer) ->
dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict,
CodeServer).
--type opaques() :: [erl_types:erl_type()] | 'universe'.
--type opaques_fun() :: fun((module()) -> opaques()).
+-type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]).
-type fun_types() :: dict:dict(label(), erl_types:type_table()).
diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl
index 3290161ca1..87cbd25b30 100644
--- a/lib/dialyzer/src/dialyzer_coordinator.erl
+++ b/lib/dialyzer/src/dialyzer_coordinator.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2012. 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.
@@ -29,8 +29,8 @@
%%% Export for dialyzer main process
-export([parallel_job/4]).
-%%% Exports for all possible workers
--export([wait_activation/0, job_done/3]).
+%%% Export for all possible workers
+-export([job_done/3]).
%%% Exports for the typesig and dataflow analysis workers
-export([sccs_to_pids/2, request_activation/1]).
@@ -46,7 +46,7 @@
-type regulator() :: pid().
-type scc_to_pid() :: ets:tid() | 'unused'.
--type coordinator() :: {collector(), regulator(), scc_to_pid()}. %%opaque
+-opaque coordinator() :: {collector(), regulator(), scc_to_pid()}.
-type timing() :: dialyzer_timing:timing_server().
-type scc() :: [mfa_or_funlbl()].
@@ -75,8 +75,9 @@
-type result() :: compile_result() | typesig_result() |
dataflow_result() | warnings_result().
--type job_result() :: dialyzer_analysis_callgraph:one_file_result() |
- typesig_result() | dataflow_result() | warnings_result().
+-type job_result() :: dialyzer_analysis_callgraph:one_file_mid_error() |
+ dialyzer_analysis_callgraph:one_file_result_ok() |
+ typesig_result() | dataflow_result() | warnings_result().
-record(state, {mode :: mode(),
active = 0 :: integer(),
@@ -119,7 +120,7 @@ spawn_jobs(Mode, Jobs, InitData, Timing) ->
Pid = dialyzer_worker:launch(Mode, Job, InitData, Coordinator),
case TypesigOrDataflow of
true -> true = ets:insert(SCCtoPID, {Job, Pid}), ok;
- false -> request_activation(Regulator, Pid)
+ false -> ok
end,
Count + 1
end,
@@ -218,10 +219,6 @@ request_activation({_Collector, Regulator, _SCCtoPID}) ->
Regulator ! {req, self()},
wait_activation().
-request_activation(Regulator, Pid) ->
- Regulator ! {req, Pid},
- ok.
-
spawn_regulator() ->
InitTickets = dialyzer_utils:parallelism(),
spawn_link(fun() -> regulator_loop(InitTickets, queue:new()) end).
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/src/dialyzer_race_data_server.erl b/lib/dialyzer/src/dialyzer_race_data_server.erl
new file mode 100644
index 0000000000..3600491809
--- /dev/null
+++ b/lib/dialyzer/src/dialyzer_race_data_server.erl
@@ -0,0 +1,134 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-----------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% 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.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File : dialyzer_race_data_server.erl
+%%% Author : Tobias Lindahl <[email protected]>
+%%% Description :
+%%%
+%%% Created : 18 Sep 2015 by Luca Favatella <[email protected]>
+%%%-------------------------------------------------------------------
+-module(dialyzer_race_data_server).
+
+-export([new/0,
+ duplicate/1,
+ stop/1,
+ call/2,
+ cast/2]).
+
+-include("dialyzer.hrl").
+
+%%----------------------------------------------------------------------
+
+-record(state, {race_code = dict:new() :: dict:dict(),
+ public_tables = [] :: [label()],
+ named_tables = [] :: [string()],
+ beh_api_calls = [] :: [{mfa(), mfa()}]}).
+
+%%----------------------------------------------------------------------
+
+-spec new() -> pid().
+
+new() ->
+ spawn_link(fun() -> loop(#state{}) end).
+
+-spec duplicate(pid()) -> pid().
+
+duplicate(Server) ->
+ call(dup, Server).
+
+-spec stop(pid()) -> ok.
+
+stop(Server) ->
+ cast(stop, Server).
+
+-spec call(atom(), pid()) -> term().
+
+call(Query, Server) ->
+ Ref = make_ref(),
+ Server ! {call, self(), Ref, Query},
+ receive
+ {Ref, Reply} -> Reply
+ end.
+
+-spec cast(atom() | {atom(), term()}, pid()) -> ok.
+
+cast(Message, Server) ->
+ Server ! {cast, Message},
+ ok.
+
+%%----------------------------------------------------------------------
+
+loop(State) ->
+ receive
+ {call, From, Ref, Query} ->
+ Reply = handle_call(Query, State),
+ From ! {Ref, Reply},
+ loop(State);
+ {cast, stop} ->
+ ok;
+ {cast, Message} ->
+ NewState = handle_cast(Message, State),
+ loop(NewState)
+ end.
+
+handle_cast(race_code_new, State) ->
+ State#state{race_code = dict:new()};
+handle_cast({Tag, Data}, State) ->
+ case Tag of
+ renew_race_info -> renew_race_info_handler(Data, State);
+ renew_race_code -> renew_race_code_handler(Data, State);
+ renew_race_public_tables -> renew_race_public_tables_handler(Data, State);
+ put_race_code -> State#state{race_code = Data};
+ put_public_tables -> State#state{public_tables = Data};
+ put_named_tables -> State#state{named_tables = Data};
+ put_behaviour_api_calls -> State#state{beh_api_calls = Data}
+ end.
+
+handle_call(Query,
+ #state{race_code = RaceCode,
+ public_tables = PublicTables,
+ named_tables = NamedTables,
+ beh_api_calls = BehApiCalls}
+ = State) ->
+ case Query of
+ dup -> spawn_link(fun() -> loop(State) end);
+ get_race_code -> RaceCode;
+ get_public_tables -> PublicTables;
+ get_named_tables -> NamedTables;
+ get_behaviour_api_calls -> BehApiCalls
+ end.
+
+%%----------------------------------------------------------------------
+
+renew_race_info_handler({RaceCode, PublicTables, NamedTables},
+ #state{} = State) ->
+ State#state{race_code = RaceCode,
+ public_tables = PublicTables,
+ named_tables = NamedTables}.
+
+renew_race_code_handler({Fun, FunArgs, Code},
+ #state{race_code = RaceCode} = State) ->
+ State#state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}.
+
+renew_race_public_tables_handler(VarLabel,
+ #state{public_tables = PT} = State) ->
+ State#state{public_tables = ordsets:add_element(VarLabel, PT)}.
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 557e10eed7..5fc1c0e691 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2015. 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.
@@ -297,8 +297,8 @@ get_record_fields([], _RecDict, Acc) ->
%% The field types are cached. Used during analysis when handling records.
process_record_remote_types(CServer) ->
TempRecords = dialyzer_codeserver:get_temp_records(CServer),
- TempExpTypes = dialyzer_codeserver:get_temp_exported_types(CServer),
- TempRecords1 = process_opaque_types0(TempRecords, TempExpTypes),
+ ExpTypes = dialyzer_codeserver:get_exported_types(CServer),
+ TempRecords1 = process_opaque_types0(TempRecords, ExpTypes),
ModuleFun =
fun(Module, Record) ->
RecordFun =
@@ -310,7 +310,7 @@ process_record_remote_types(CServer) ->
Site = {record, {Module, Name, Arity}},
[{FieldName, Field,
erl_types:t_from_form(Field,
- TempExpTypes,
+ ExpTypes,
Site,
TempRecords1)}
|| {FieldName, Field, _} <- Fields]
@@ -323,9 +323,8 @@ process_record_remote_types(CServer) ->
dict:map(RecordFun, Record)
end,
NewRecords = dict:map(ModuleFun, TempRecords1),
- ok = check_record_fields(NewRecords, TempExpTypes),
- CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer),
- dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1).
+ ok = check_record_fields(NewRecords, ExpTypes),
+ dialyzer_codeserver:finalize_records(NewRecords, CServer).
%% erl_types:t_from_form() substitutes the declaration of opaque types
%% for the expanded type in some cases. To make sure the initial type,
diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl
index 979e3a621d..b9ab27c11d 100644
--- a/lib/dialyzer/src/dialyzer_worker.erl
+++ b/lib/dialyzer/src/dialyzer_worker.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2012. 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.
@@ -21,16 +21,15 @@
-module(dialyzer_worker).
--export([launch/4, sequential/4]).
+-export([launch/4]).
-export_type([worker/0]).
--type worker() :: pid(). %%opaque
+-opaque worker() :: pid().
-type mode() :: dialyzer_coordinator:mode().
-type coordinator() :: dialyzer_coordinator:coordinator().
-type init_data() :: dialyzer_coordinator:init_data().
--type result() :: dialyzer_coordinator:result().
-type job() :: dialyzer_coordinator:job().
-record(state, {
@@ -60,16 +59,21 @@ launch(Mode, Job, InitData, Coordinator) ->
job = Job,
init_data = InitData,
coordinator = Coordinator},
- InitState =
- case Mode of
- X when X =:= 'typesig'; X =:= 'dataflow' -> initializing;
- X when X =:= 'compile'; X =:= 'warnings' -> running
- end,
- spawn_link(fun() -> loop(InitState, State) end).
+ spawn_link(fun() -> init(State) end).
%%--------------------------------------------------------------------
-loop(updating, State) ->
+init(#state{job = SCC, mode = Mode, init_data = InitData} = State) when
+ Mode =:= 'typesig'; Mode =:= 'dataflow' ->
+ DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData),
+ ?debug("Deps ~p: ~p\n",[SCC, DependsOn]),
+ loop(updating, State#state{depends_on = DependsOn});
+init(#state{mode = Mode} = State) when
+ Mode =:= 'compile'; Mode =:= 'warnings' ->
+ loop(running, State).
+
+loop(updating, #state{mode = Mode} = State) when
+ Mode =:= 'typesig'; Mode =:= 'dataflow' ->
?debug("Update: ~p\n",[State#state.job]),
NextStatus =
case waits_more_success_typings(State) of
@@ -77,16 +81,13 @@ loop(updating, State) ->
false -> running
end,
loop(NextStatus, State);
-loop(initializing, #state{job = SCC, init_data = InitData} = State) ->
- DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData),
- ?debug("Deps ~p: ~p\n",[State#state.job, DependsOn]),
- loop(updating, State#state{depends_on = DependsOn});
-loop(waiting, State) ->
+loop(waiting, #state{mode = Mode} = State) when
+ Mode =:= 'typesig'; Mode =:= 'dataflow' ->
?debug("Wait: ~p\n",[State#state.job]),
NewState = wait_for_success_typings(State),
loop(updating, NewState);
loop(running, #state{mode = 'compile'} = State) ->
- dialyzer_coordinator:wait_activation(),
+ dialyzer_coordinator:request_activation(State#state.coordinator),
?debug("Compile: ~s\n",[State#state.job]),
Result =
case start_compilation(State) of
@@ -98,7 +99,7 @@ loop(running, #state{mode = 'compile'} = State) ->
end,
report_to_coordinator(Result, State);
loop(running, #state{mode = 'warnings'} = State) ->
- dialyzer_coordinator:wait_activation(),
+ dialyzer_coordinator:request_activation(State#state.coordinator),
?debug("Warning: ~s\n",[State#state.job]),
Result = collect_warnings(State),
report_to_coordinator(Result, State);
@@ -170,22 +171,3 @@ continue_compilation(Label, Data) ->
collect_warnings(#state{job = Job, init_data = InitData}) ->
dialyzer_succ_typings:collect_warnings(Job, InitData).
-
-%%------------------------------------------------------------------------------
-
--type extra() :: label() | 'unused'.
-
--spec sequential(mode(), job(), init_data(), extra()) -> result().
-
-sequential('compile', Job, InitData, Extra) ->
- case dialyzer_analysis_callgraph:start_compilation(Job, InitData) of
- {ok, EstimatedSize, Data} ->
- {EstimatedSize, continue_compilation(Extra, Data)};
- {error, _Reason} = Error -> {0, Error}
- end;
-sequential('typesig', Job, InitData, _Extra) ->
- dialyzer_succ_typings:find_succ_types_for_scc(Job, InitData);
-sequential('dataflow', Job, InitData, _Extra) ->
- dialyzer_succ_typings:refine_one_module(Job, InitData);
-sequential('warnings', Job, InitData, _Extra) ->
- dialyzer_succ_typings:collect_warnings(Job, InitData).
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..16180a7435 100644
--- a/lib/dialyzer/test/plt_SUITE.erl
+++ b/lib/dialyzer/test/plt_SUITE.erl
@@ -7,12 +7,15 @@
-include("dialyzer_test_constants.hrl").
-export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1,
+ local_fun_same_as_callback/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, run_succ_typings,
+ local_fun_same_as_callback].
build_plt(Config) ->
OutDir = ?config(priv_dir, Config),
@@ -158,6 +161,59 @@ 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.
+
+
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/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/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 61b7fd1337..5cb29c80e3 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -467,7 +467,7 @@ Matches only those peers whose Origin-Host has the
specified value, or all peers if the atom <c>any</c>.</p>
</item>
-<tag><c>{realm, any|&dict_DiameterIdentity;</c></tag>
+<tag><c>{realm, any|&dict_DiameterIdentity;}</c></tag>
<item>
<p>
Matches only those peers whose Origin-Realm has the
@@ -500,18 +500,22 @@ Matches only those peers matched by each filter in the specified list.</p>
<item>
<p>
Matches only those peers matched by at least one filter in the
-specified list.</p>
+specified list.
+The resulting list will be in match order, peers matching the
+first filter of the list sorting before those matched by the second,
+and so on.</p>
+</item>
+<tag><c>{first, [&peer_filter;]}</c></tag>
+<item>
<p>
-The resulting peer list will be in match order, peers matching the
-first filter of the list sorting before those matched by the second,
-and so on.
-For example, the following filter causes peers matching both the host
-and realm filters to be presented before those matching only the realm
-filter.</p>
+Like <c>any</c>, but stops at the first filter for which there are
+matches, which can be much more efficient when there are many peers.
+For example, the following filter causes only peers best matching
+both the host and realm filters to be presented.</p>
<pre>
-{any, [{all, [host, realm]}, realm]}
+{first, [{all, [host, realm]}, realm]}
</pre>
</item>
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 7e316c03f1..967a0bf591 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -725,7 +725,8 @@ send_any_2(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Host', [?HOST(SN, "unknown.org")]}],
?answer_message(?UNABLE_TO_DELIVER)
- = call(Config, Req, [{filter, {any, [host, realm]}}]).
+ = call(Config, Req, [{filter, {first, [{all, [host, realm]},
+ realm]}}]).
%% Send with a conjunctive filter.
send_all_1(Config) ->
diff --git a/lib/edoc/doc/overview.edoc b/lib/edoc/doc/overview.edoc
index 3639bb43a5..d2bba9d744 100644
--- a/lib/edoc/doc/overview.edoc
+++ b/lib/edoc/doc/overview.edoc
@@ -755,7 +755,7 @@ following escape sequences may be used: <dl>
=== Function specifications ===
-<note>Although the syntax described in the following can still be used
+Note that although the syntax described in the following can still be used
for specifying functions we recommend that Erlang specifications as
described in <seealso marker="doc/reference_manual:typespec"> Types
and Function Specification</seealso> should be added to the source
@@ -764,7 +764,6 @@ marker="dialyzer:dialyzer">Dialyzer</seealso>'s can be utilized in the
process of keeping the documentation consistent and up-to-date.
Erlang specifications will be used unless there is also a function
specification (a `@spec' tag followed by a type) with the same name.
-</note>
The following grammar describes the form of the specifications following
a `@spec' tag. A '`?'' suffix implies that the element is optional.
@@ -973,12 +972,12 @@ contain any annotations at all.
=== Type definitions ===
-<note>Although the syntax described in the following can still be used
+Note that although the syntax described in the following can still be used
for specifying types we recommend that Erlang types as described in
<seealso marker="doc/reference_manual:typespec"> Types and Function
Specification</seealso> should be added to the source code instead.
Erlang types will be used unless there is a type alias with the same
-name.</note>
+name.
The following grammar (see above for auxiliary definitions) describes
the form of the definitions that may follow a `@type' tag:
diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl
index 90f1fc3071..d2494b69fe 100644
--- a/lib/edoc/src/edoc.erl
+++ b/lib/edoc/src/edoc.erl
@@ -555,7 +555,6 @@ read_source(Name) ->
%% <dd>Specifies a list of pre-defined Erlang preprocessor (`epp')
%% macro definitions, used if the `preprocess' option is turned on.
%% The default value is the empty list.</dd>
-%% </dl>
%% <dt>{@type {report_missing_types, boolean()@}}
%% </dt>
%% <dd>If the value is `true', warnings are issued for missing types.
@@ -563,6 +562,7 @@ read_source(Name) ->
%% `no_report_missing_types' is an alias for
%% `{report_missing_types, false}'.
%% </dd>
+%% </dl>
%%
%% @see get_doc/2
%% @see //syntax_tools/erl_syntax
diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl
index 37baa7c2f9..e154323f07 100644
--- a/lib/erl_docgen/src/docgen_otp_specs.erl
+++ b/lib/erl_docgen/src/docgen_otp_specs.erl
@@ -729,5 +729,9 @@ annos_type([E=#xmlElement{name = typevar}]) ->
annos_elem(E);
annos_type([#xmlElement{name = paren, content = Es}]) ->
annos(get_elem(type, Es));
+annos_type([#xmlElement{name = map, content = Es}]) ->
+ lists:flatmap(fun(E) -> annos_type([E]) end, Es);
+annos_type([#xmlElement{name = map_field, content = Es}]) ->
+ lists:flatmap(fun annos_elem/1, get_elem(type,Es));
annos_type(_) ->
[].
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 622c235638..e36643e090 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -137,7 +137,7 @@ type(M, F, A) ->
type(M, F, A, Xs) ->
type(M, F, A, Xs, 'universe').
--type opaques() :: 'universe' | [erl_types:erl_type()].
+-type opaques() :: erl_types:opaques().
-type arg_types() :: [erl_types:erl_type()].
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 69654088d5..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,
@@ -225,7 +224,7 @@
-export([t_is_identifier/1]).
-endif.
--export_type([erl_type/0, type_table/0, var_table/0]).
+-export_type([erl_type/0, opaques/0, type_table/0, var_table/0]).
%%-define(DEBUG, true).
@@ -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() ->
@@ -2425,8 +2419,7 @@ t_inf(T1, T2) ->
t_inf(T1, T2, 'universe').
%% 'match' should be used from t_find_unknown_opaque() only
--type t_inf_opaques() :: 'universe'
- | [erl_type()] | {'match', [erl_type() | 'universe']}.
+-type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}.
-spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type().
@@ -3604,7 +3597,7 @@ t_is_instance(ConcreteType, Type) ->
t_unopaque(T) ->
t_unopaque(T, 'universe').
--spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type().
+-spec t_unopaque(erl_type(), opaques()) -> erl_type().
t_unopaque(?opaque(_) = T, Opaques) ->
case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of
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 51213b71d1..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).
@@ -333,32 +334,50 @@ float_get_c_code(Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) ->
get_c_code(Func, Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) ->
SizeReg = hipe_rtl:mk_new_reg_gcsafe(),
FlagsReg = hipe_rtl:mk_new_reg_gcsafe(),
+ RetReg = hipe_rtl:mk_new_reg_gcsafe(),
MatchBuf = hipe_rtl:mk_new_reg(),
RetLabel = hipe_rtl:mk_new_label(),
+ OkLabel = hipe_rtl:mk_new_label(),
NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()),
[hipe_rtl:mk_move(SizeReg, Size),
hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)),
hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms),
- hipe_rtl_arch:call_bif([Dst1], Func, [SizeReg, FlagsReg, MatchBuf],
+ hipe_rtl_arch:call_bif([RetReg], Func, [SizeReg, FlagsReg, MatchBuf],
hipe_rtl:label_name(RetLabel), FalseLblName),
RetLabel,
- hipe_rtl:mk_branch(Dst1, eq, NonVal, FalseLblName, TrueLblName, 0.01)].
+ hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName,
+ hipe_rtl:label_name(OkLabel), 0.01),
+ OkLabel,
+ hipe_rtl:mk_move(Dst1, RetReg),
+ hipe_rtl:mk_goto(TrueLblName)].
utf8_get_c_code(Dst, Ms, TrueLblName, FalseLblName) ->
+ RetReg = hipe_rtl:mk_new_reg_gcsafe(),
+ OkLabel = hipe_rtl:mk_new_label(),
MatchBuf = hipe_rtl:mk_new_reg(),
NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()),
[hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms),
- hipe_rtl_arch:call_bif([Dst], bs_get_utf8, [MatchBuf], [], []),
- hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)].
+ hipe_rtl_arch:call_bif([RetReg], bs_get_utf8, [MatchBuf], [], []),
+ hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName,
+ hipe_rtl:label_name(OkLabel), 0.01),
+ OkLabel,
+ hipe_rtl:mk_move(Dst, RetReg),
+ hipe_rtl:mk_goto(TrueLblName)].
utf16_get_c_code(Flags, Dst, Ms, TrueLblName, FalseLblName) ->
+ RetReg = hipe_rtl:mk_new_reg_gcsafe(),
+ OkLabel = hipe_rtl:mk_new_label(),
MatchBuf = hipe_rtl:mk_new_reg(),
NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()),
FlagsReg = hipe_rtl:mk_new_reg_gcsafe(),
[hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms),
hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)),
- hipe_rtl_arch:call_bif([Dst], bs_get_utf16, [MatchBuf, FlagsReg], [], []),
- hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)].
+ hipe_rtl_arch:call_bif([RetReg], bs_get_utf16, [MatchBuf, FlagsReg], [], []),
+ hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName,
+ hipe_rtl:label_name(OkLabel), 0.01),
+ OkLabel,
+ hipe_rtl:mk_move(Dst, RetReg),
+ hipe_rtl:mk_goto(TrueLblName)].
validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName) ->
MatchBuf = hipe_rtl:mk_new_reg(),
@@ -817,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],
@@ -865,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),
@@ -926,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),
@@ -955,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),
@@ -1072,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 ->
@@ -1084,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)]
@@ -1100,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/Makefile b/lib/hipe/test/Makefile
index 009f503abb..d781e4f9be 100644
--- a/lib/hipe/test/Makefile
+++ b/lib/hipe/test/Makefile
@@ -10,8 +10,10 @@ MODULES= \
# .erl files for these modules are automatically generated
GEN_MODULES= \
+ basic_SUITE \
bs_SUITE \
- maps_SUITE
+ maps_SUITE \
+ sanity_SUITE
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl
new file mode 100644
index 0000000000..28e99be053
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl
@@ -0,0 +1,72 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%---------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests cases for compilation of arithmetic.
+%%%---------------------------------------------------------------------
+-module(basic_arith).
+
+-export([test/0]).
+
+test() ->
+ ok = test_rem(),
+ ok = test_bit_ops(),
+ ok = test_uplus(),
+ ok = test_bsl_errors(),
+ ok.
+
+%%----------------------------------------------------------------------
+%% Tests the remainder operator.
+
+test_rem() ->
+ 2 = ret_rem(42, 20),
+ -2 = ret_rem(-42, 20),
+ -2 = ret_rem(-42, -20),
+ {'EXIT', {badarith, _}} = ret_rem(3.14, 2),
+ {'EXIT', {badarith, _}} = ret_rem(42, 3.14),
+ ok.
+
+ret_rem(X, Y) ->
+ catch X rem Y.
+
+%%----------------------------------------------------------------------
+%%
+
+test_bit_ops() ->
+ 2 = bbb(11, 2, 16#3ff),
+ ok.
+
+bbb(X, Y, Z) ->
+ ((1 bsl X) bor Y) band Z.
+
+%%----------------------------------------------------------------------
+%% Tests unary plus: it used to be the identity function but not anymore
+
+test_uplus() ->
+ badarith = try uplus(gazonk) catch error:Err -> Err end,
+ 42 = uplus(42),
+ ok.
+
+uplus(X) -> +(X).
+
+%%----------------------------------------------------------------------
+%% The first part of this test triggered a bug in the emulator as one
+%% of the arguments to bsl is not an integer.
+%%
+%% The second part triggered a compilation crash since an arithmetic
+%% expression resulting in a 'system_limit' exception was statically
+%% evaluated and an arithmetic result was expected.
+
+test_bsl_errors() ->
+ {'EXIT', {'badarith', _}} = (catch (t1(0, pad, 0))),
+ badarith = try t2(0, pad, 0) catch error:Err1 -> Err1 end,
+ system_limit = try (id(1) bsl 100000000) catch error:Err2 -> Err2 end,
+ ok.
+
+t1(_, X, _) ->
+ (1 bsl X) + 1.
+
+t2(_, X, _) ->
+ (X bsl 1) + 1.
+
+id(I) -> I.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl
new file mode 100644
index 0000000000..6fafea3b09
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl
@@ -0,0 +1,102 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests for correct translation of various BEAM instructions.
+%%%-------------------------------------------------------------------
+-module(basic_beam_instrs).
+
+-export([test/0]).
+
+test() ->
+ ok = test_make_fun(),
+ ok = test_switch_val(),
+ ok = test_put_literal(),
+ ok = test_set_tuple_element(),
+ ok = test_unguarded_unsafe_element(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests whether the translation of make_fun works.
+
+test_make_fun() ->
+ {F, G} = double_the_fun(),
+ ok = F(),
+ {ok, 42} = G(42),
+ FV1 = {ok, free_var1},
+ FV2 = {also, {free, var2}},
+ {FV1, {ok, [bv]}, FV2} = contains_fun(FV1, ignored, FV2),
+ ok.
+
+double_the_fun() ->
+ {fun () -> ok end, fun (V) -> {ok, V} end}.
+
+contains_fun(X, _IGNORED_ARG, Y) ->
+ calls_fun(fun(Term) -> {X, Term, Y} end).
+
+calls_fun(F) ->
+ F({ok, [bv]}).
+
+%%--------------------------------------------------------------------
+%% Tests whether the translation of switch_val works.
+
+test_switch_val() ->
+ 'A' = sv(a),
+ 'B' = sv(b),
+ 'C' = sv(c),
+ foo = sv(d),
+ ok.
+
+sv(a) -> 'A';
+sv(b) -> 'B';
+sv(c) -> 'C';
+sv(_) -> foo.
+
+%%--------------------------------------------------------------------
+%% Tests correct handling of literals (statically constant terms)
+
+-define(QUADRUPLE, {a,b,c,42}).
+-define(DEEP_LIST, [42,[42,[42]]]).
+
+test_put_literal() ->
+ ?QUADRUPLE = mk_literal_quadruple(),
+ ?DEEP_LIST = mk_literal_deep_list(),
+ ok.
+
+mk_literal_quadruple() ->
+ ?QUADRUPLE.
+
+mk_literal_deep_list() ->
+ ?DEEP_LIST.
+
+%%--------------------------------------------------------------------
+%% Tests whether the translation of set_tuple_element works.
+
+-record(rec, {f1, f2, f3, f4, f5}).
+
+test_set_tuple_element() ->
+ F2 = [a,b,c], F4 = {a,b},
+ State0 = init_rec(F2, F4),
+ State1 = simple_set(State0, 42),
+ #rec{f1 = foo, f2 = F2, f3 = 42, f4 = F4, f5 = 42.0} = odd_set(State1, 21),
+ ok.
+
+init_rec(F2, F4) ->
+ #rec{f1 = bar, f2 = F2, f3 = 10, f4 = F4, f5 = 3.14}.
+
+simple_set(State, Val) -> %% f3 = Val is the one used in set_element;
+ State#rec{f3 = Val, f5 = Val*2}. %% this checks the case of variable
+
+odd_set(State, Val) -> %% f3 = foo is the one used in set_element;
+ State#rec{f1 = foo, f5 = Val*2.0}. %% this checks the case of constant
+
+%%--------------------------------------------------------------------
+%% Tests the handling of unguarded unsafe_element operations that BEAM
+%% can sometimes construct on records (when it has enough context).
+
+test_unguarded_unsafe_element() ->
+ {badrecord, rec} = try unguarded_unsafe_element(42) catch error:E -> E end,
+ ok.
+
+unguarded_unsafe_element(X) ->
+ X#rec{f1 = X#rec.f3}.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl
new file mode 100644
index 0000000000..e7ee2f3678
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl
@@ -0,0 +1,257 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests for handling of BIFs in guards and body calls.
+%%%-------------------------------------------------------------------
+-module(basic_bifs).
+
+-export([test/0]).
+
+-define(BIG, 1398479237498374913984792374983749).
+
+test() ->
+ ok = test_abs(),
+ ok = test_binary_part(),
+ ok = test_element(),
+ ok = test_float(),
+ ok = test_float_to_list(),
+ ok = test_integer_to_list(),
+ ok = test_list_to_float(),
+ ok = test_list_to_integer(),
+ ok = test_round(),
+ ok = test_trunc(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_abs() ->
+ t_abs(5.5, 0.0, -100.0, 5, 0, -100, ?BIG).
+
+t_abs(F1, F2, F3, I1, I2, I3, BigNum) ->
+ %% Floats.
+ 5.5 = abs(F1),
+ 0.0 = abs(F2),
+ 100.0 = abs(F3),
+ %% Integers.
+ 5 = abs(I1),
+ 0 = abs(I2),
+ 100 = abs(I3),
+ %% Bignums.
+ BigNum = abs(BigNum),
+ BigNum = abs(-BigNum),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Checks that 2-ary and 3-ary BIFs can be compiled to native code.
+
+test_binary_part() ->
+ Bin = <<1,2,3,4,5,6,7,8,9,10>>,
+ BinPart = bp3(Bin),
+ <<7,8>> = bp2(BinPart),
+ ok.
+
+bp2(Bin) ->
+ binary_part(Bin, {1, 2}).
+
+bp3(Bin) ->
+ binary_part(Bin, byte_size(Bin), -5).
+
+%%--------------------------------------------------------------------
+
+test_element() ->
+ true = elem({a, b}),
+ false = elem({a, c}),
+ other = elem(gazonk),
+ ok.
+
+elem(T) when element(1, T) == a -> element(2, T) == b;
+elem(_) -> other.
+
+%%--------------------------------------------------------------------
+
+test_float() ->
+ t_float(0, 42, -100, 2.5, 0.0, -100.42, ?BIG, -?BIG).
+
+t_float(I1, I2, I3, F1, F2, F3, B1, B2) ->
+ 0.0 = float(I1),
+ 2.5 = float(F1),
+ 0.0 = float(F2),
+ -100.42 = float(F3),
+ 42.0 = float(I2),
+ -100.0 = float(I3),
+ %% Bignums.
+ 1398479237498374913984792374983749.0 = float(B1),
+ -1398479237498374913984792374983749.0 = float(B2),
+ %% Extremly big bignums.
+ Big = list_to_integer(duplicate(2000, $1)),
+ {'EXIT', _} = (catch float(Big)),
+ %% Invalid types and lists.
+ {'EXIT', _} = (catch my_list_to_integer(atom)),
+ {'EXIT', _} = (catch my_list_to_integer(123)),
+ {'EXIT', _} = (catch my_list_to_integer([$1, [$2]])),
+ {'EXIT', _} = (catch my_list_to_integer("1.2")),
+ {'EXIT', _} = (catch my_list_to_integer("a")),
+ {'EXIT', _} = (catch my_list_to_integer("")),
+ ok.
+
+my_list_to_integer(X) ->
+ list_to_integer(X).
+
+%%--------------------------------------------------------------------
+
+test_float_to_list() ->
+ test_ftl("0.0e+0", 0.0),
+ test_ftl("2.5e+1", 25.0),
+ test_ftl("2.5e+0", 2.5),
+ test_ftl("2.5e-1", 0.25),
+ test_ftl("-3.5e+17", -350.0e15),
+ ok.
+
+test_ftl(Expect, Float) ->
+ %% No \n on the next line -- we want the line number from t_float_to_list.
+ Expect = remove_zeros(lists:reverse(float_to_list(Float)), []).
+
+%% Removes any non-significant zeros in a floating point number.
+%% Example: 2.500000e+01 -> 2.5e+1
+
+remove_zeros([$+, $e|Rest], [$0, X|Result]) ->
+ remove_zeros([$+, $e|Rest], [X|Result]);
+remove_zeros([$-, $e|Rest], [$0, X|Result]) ->
+ remove_zeros([$-, $e|Rest], [X|Result]);
+remove_zeros([$0, $.|Rest], [$e|Result]) ->
+ remove_zeros(Rest, [$., $0, $e|Result]);
+remove_zeros([$0|Rest], [$e|Result]) ->
+ remove_zeros(Rest, [$e|Result]);
+remove_zeros([Char|Rest], Result) ->
+ remove_zeros(Rest, [Char|Result]);
+remove_zeros([], Result) ->
+ Result.
+
+%%--------------------------------------------------------------------
+
+test_integer_to_list() ->
+ t_integer_to_list(0, 42, 32768, 268435455, 123456932798748738738).
+
+t_integer_to_list(I1, I2, I3, I4, BIG) ->
+ "0" = integer_to_list(I1),
+ "42" = integer_to_list(I2),
+ "-42" = integer_to_list(-I2),
+ "-42" = integer_to_list(-I2),
+ "32768" = integer_to_list(I3),
+ "268435455" = integer_to_list(I4),
+ "-268435455" = integer_to_list(-I4),
+ "123456932798748738738" = integer_to_list(BIG),
+ BigList = duplicate(2000, $1),
+ Big = list_to_integer(BigList),
+ BigList = integer_to_list(Big),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_list_to_float() ->
+ ok = t_list_to_float_safe(),
+ ok = t_list_to_float_risky().
+
+t_list_to_float_safe() ->
+ 0.0 = my_list_to_float("0.0"),
+ 0.0 = my_list_to_float("-0.0"),
+ 0.5 = my_list_to_float("0.5"),
+ -0.5 = my_list_to_float("-0.5"),
+ 100.0 = my_list_to_float("1.0e2"),
+ 127.5 = my_list_to_float("127.5"),
+ -199.5 = my_list_to_float("-199.5"),
+ {'EXIT', _} = (catch my_list_to_float("0")),
+ {'EXIT', _} = (catch my_list_to_float("0..0")),
+ {'EXIT', _} = (catch my_list_to_float("0e12")),
+ {'EXIT', _} = (catch my_list_to_float("--0.0")),
+ ok.
+
+my_list_to_float(X) ->
+ list_to_float(X).
+
+%% This might crash the emulator. (Used to crash Erlang 4.4.1 on Unix.)
+
+t_list_to_float_risky() ->
+ Many_Ones = duplicate(25000, $1),
+ ok = case list_to_float("2." ++ Many_Ones) of
+ F when is_float(F), 0.0 < F, F =< 3.14 -> ok
+ end,
+ {'EXIT', _} = (catch list_to_float("2" ++ Many_Ones)),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_list_to_integer() ->
+ ok = t_list_to_integer_small("0", "00", "-0", "1", "-1", "42", "-12",
+ "32768", "268435455", "-268435455"),
+ ok = t_list_to_integer_bignum("123456932798748738738666"),
+ ok.
+
+t_list_to_integer_small(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10) ->
+ 0 = list_to_integer(S1),
+ 0 = list_to_integer(S2),
+ 0 = list_to_integer(S3),
+ 1 = list_to_integer(S4),
+ -1 = list_to_integer(S5),
+ 42 = list_to_integer(S6),
+ -12 = list_to_integer(S7),
+ 32768 = list_to_integer(S8),
+ 268435455 = list_to_integer(S9),
+ -268435455 = list_to_integer(S10),
+ ok.
+
+t_list_to_integer_bignum(S) ->
+ 123456932798748738738666 = list_to_integer(S),
+ case list_to_integer(duplicate(2000, $1)) of
+ I when is_integer(I), I > 123456932798748738738666 -> ok
+ end.
+
+%%--------------------------------------------------------------------
+
+test_round() ->
+ ok = t_round_small(0.0, 0.4, 0.5, -0.4, -0.5, 255.3, 255.6, -1033.3, -1033.6),
+ ok = t_round_big(4294967296.1, 4294967296.9),
+ ok.
+
+t_round_small(F1, F2, F3, F4, F5, F6, F7, F8, F9) ->
+ 0 = round(F1),
+ 0 = round(F2),
+ 1 = round(F3),
+ 0 = round(F4),
+ -1 = round(F5),
+ 255 = round(F6),
+ 256 = round(F7),
+ -1033 = round(F8),
+ -1034 = round(F9),
+ ok.
+
+t_round_big(B1, B2) ->
+ 4294967296 = round(B1),
+ 4294967297 = round(B2),
+ -4294967296 = round(-B1),
+ -4294967297 = round(-B2),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_trunc() ->
+ t_trunc(0.0, 5.3333, -10.978987, 4294967305.7).
+
+t_trunc(F1, F2, F3, B) ->
+ 0 = trunc(F1),
+ 5 = trunc(F2),
+ -10 = trunc(F3),
+ %% Bignums.
+ 4294967305 = trunc(B),
+ -4294967305 = trunc(-B),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Auxiliary functions below
+
+duplicate(N, X) when is_integer(N), N >= 0 ->
+ duplicate(N, X, []).
+
+duplicate(0, _, L) -> L;
+duplicate(N, X, L) -> duplicate(N-1, X, [X|L]).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl
new file mode 100644
index 0000000000..e3b523b3f5
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl
@@ -0,0 +1,143 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that test bignum arithmetic and matching.
+%%%-------------------------------------------------------------------
+-module(basic_bignums).
+
+-export([test/0, test_bsl/0]).
+
+test() ->
+ ok = test_ops(),
+ ok = test_big_fac(),
+ ok = test_int_overfl_32(),
+ ok = test_int_overfl_64(),
+ ok = test_int_overfl_32_guard(),
+ ok = test_int_overfl_64_guard(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Define some constants for the tests of arithmetic operators
+
+-define(X, 68719476736).
+-define(Y, 98765432101234).
+-define(Z, 4722366482869645213696).
+-define(W, 339254531512339254531512).
+
+-define(B1, 4398046511104).
+-define(B5, 1645504557321206042154969182557350504982735865633579863348609024).
+-define(B17, 86182066610968551542636378241108028056376767329454880514019834315878107616003372189510312530372009184902888961739623919010110377987011442493486117202360415845666384627768436296772219009176743399772868636439042064384).
+
+%%--------------------------------------------------------------------
+
+test_ops() ->
+ ok = test_mult(),
+ ok = test_div(),
+ ok = test_round(),
+ ok = test_trunc(),
+ ok = test_bsl(),
+ ok.
+
+test_mult() ->
+ ?Z = mult(?X, ?X),
+ ok.
+
+mult(X, Y) -> X * Y.
+
+test_div() ->
+ 4 = div_f(339254531512, ?X),
+ 0 = div_f(?Y, ?Y+1),
+ 64 = div_f(?B1, ?X),
+ ?X = div_f(?Z, ?X),
+ 1073741824 = div_f(?Z, ?B1),
+ ok.
+
+div_f(X, Y) -> X div Y.
+
+test_round() ->
+ 0 = round_f(?Z, ?W),
+ 1 = round_f(?Y, ?Y),
+ 71 = round_f(?W, ?Z),
+ 1437 = round_f(?Y, ?X),
+ 47813960 = round_f(?Z, ?Y),
+ 4936803183406 = round_f(?W, ?X),
+ ok.
+
+trunc_f(X, Y) -> round(X/Y).
+
+test_trunc() ->
+ 0 = trunc_f(?Z, ?W),
+ 1 = trunc_f(?Y, ?Y),
+ 72 = trunc_f(?W, ?Z),
+ 1437 = trunc_f(?Y, ?X),
+ 47813961 = trunc_f(?Z, ?Y),
+ 4936803183407 = trunc_f(?W, ?X),
+ ok.
+
+round_f(X, Y) -> trunc(X/Y).
+
+test_bsl() ->
+ ?B1 = bsl_f(1, 42),
+ ?B5 = n(5, fun erlang:'bsl'/2, 1, 42), % use the operator
+ ?B17 = n(17, fun bsl_f/2, 1, 42), % use the local function
+ ok.
+
+bsl_f(X, Y) -> X bsl Y.
+
+%% applies a binary function N times
+n(1, F, X, Y) -> F(X, Y);
+n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y).
+
+%%--------------------------------------------------------------------
+
+-define(FAC42, 1405006117752879898543142606244511569936384000000000).
+
+test_big_fac() ->
+ ?FAC42 = fac(42),
+ ok.
+
+fac(0) -> 1;
+fac(N) -> N * fac(N-1).
+
+%%--------------------------------------------------------------------
+%% Tests for correct handling of integer overflow
+
+test_int_overfl_32() ->
+ 16#7FFFFFF = add(16#7FFFFFF, 0),
+ 16#8000000 = add(16#8000000, 0),
+ 16#8000001 = add(16#8000000, 1),
+ case add(16#7FFFFFF, 1) of
+ 16#8000000 -> ok;
+ -16#7FFFFFF -> error
+ end.
+
+test_int_overfl_64() ->
+ 16#7FFFFFFFFFFFFFF = add(16#7FFFFFFFFFFFFFF, 0),
+ 16#800000000000000 = add(16#800000000000000, 0),
+ 16#800000000000001 = add(16#800000000000000, 1),
+ case add(16#7FFFFFFFFFFFFFF, 1) of
+ 16#800000000000000 -> ok;
+ -16#7FFFFFFFFFFFFFF -> error
+ end.
+
+add(X, Y) -> X + Y.
+
+%%--------------------------------------------------------------------
+%% Tests for correct handling of integer overflow in guards
+
+test_int_overfl_32_guard() ->
+ ok = overfl_in_guard(16#7ffffff, 0),
+ ok = overfl_in_guard(16#7ffffff, 16#7ffffff),
+ ok.
+
+test_int_overfl_64_guard() ->
+ ok = overfl_in_guard(16#7ffffffffffffff, 0),
+ ok = overfl_in_guard(16#7ffffffffffffff, 16#7ffffffffffffff),
+ ok.
+
+overfl_in_guard(X, Y) ->
+ case ok of
+ V when X+Y > 12 -> V;
+ _ -> bad
+ end.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_boolean.erl b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl
new file mode 100644
index 0000000000..e4a91ef5af
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl
@@ -0,0 +1,47 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests for correct translation of booleans and their primitives.
+%%%-------------------------------------------------------------------
+-module(basic_boolean).
+
+-export([test/0]).
+
+test() ->
+ ok = test_boolean_ops(false, true),
+ ok = test_orelse_redundant(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_boolean_ops(F, T) ->
+ true = T and T,
+ false = T and F,
+ false = F and T,
+ false = F and F,
+ true = T or T,
+ true = T or F,
+ true = F or T,
+ false = F or F,
+ true = T andalso T,
+ false = T andalso F,
+ false = F andalso T,
+ false = F andalso F,
+ true = T orelse T,
+ true = T orelse F,
+ true = F orelse T,
+ false = F orelse F,
+ ok.
+
+%%--------------------------------------------------------------------
+%% Redundant test in BEAM code will generate type warning.
+
+test_orelse_redundant() ->
+ true = test_orelse(true, true, true),
+ ok.
+
+test_orelse(A, B, C) ->
+ A andalso B orelse C.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl
new file mode 100644
index 0000000000..964b0f423a
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl
@@ -0,0 +1,138 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that exhibited bugs in the BEAM compiler.
+%%%-------------------------------------------------------------------
+-module(basic_bugs_beam).
+
+-export([test/0]).
+
+%% the following is needed for the test_weird_message
+-export([loop/1]).
+%% the following are needed for the test_catch_bug
+-behaviour(gen_server).
+-export([start_link/1]).
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+test() ->
+ ok = test_fp_basic_blocks(),
+ ok = test_weird_message(),
+ ok = test_catch_bug(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Test which shows that BEAM's splitting of basic blocks should take
+%% into account that arithmetic operations implemented as BIFs can
+%% also cause exceptions and thus calls to BIFs should end basic blocks.
+%%
+%% Investigated and fixed in the beginning of April 2004.
+%%--------------------------------------------------------------------
+
+test_fp_basic_blocks() ->
+ ok = t1(),
+ ok = t2().
+
+t1() ->
+ X = (catch bad_arith1(2.0, 1.7)),
+ case X of
+ {'EXIT', {badarith, _}} ->
+ ok;
+ _ ->
+ error
+ end.
+
+bad_arith1(X, Y) when is_float(X) ->
+ X1 = X * 1.7e+308,
+ X2 = X1 + 1.0,
+ Y1 = Y * 2,
+ {X2, Y1}.
+
+%% Similarly, it is not kosher to have anything that can fail inside
+%% the fp block since it will throw the exception before the fp
+%% exception and we will get the same problems.
+
+t2() ->
+ case catch bad_arith2(2.0, []) of
+ {'EXIT', {badarith, _}} ->
+ ok;
+ _ ->
+ error
+ end.
+
+bad_arith2(X, Y) when is_float(X) ->
+ X1 = X * 1.7e+308,
+ Y1 = element(1, Y),
+ {X1 + 1.0, Y1}.
+
+%%--------------------------------------------------------------------
+%% Sending 'test' to this process should return 'ok'. But:
+%%
+%% 1> MOD:test().
+%% Weird: received true
+%% timeout
+%%
+%% Surprisingly, the message has been bound to the value of 'ena'
+%% in the record! The problem was visible in the .S file.
+%%--------------------------------------------------------------------
+
+-record(state, {ena = true}).
+
+test_weird_message() ->
+ P = spawn_link(?MODULE, loop, [#state{}]),
+ P ! {msg, self()},
+ receive
+ What -> What
+ after 42 -> timeout
+ end.
+
+loop(S) ->
+ receive
+ _ when S#state.ena == false ->
+ io:format("Weird: ena is false\n");
+ % loop(S);
+ {msg, Pid} ->
+ Pid ! ok;
+ % loop(S);
+ Other ->
+ io:format("Weird: received ~p\n", [Other])
+ % loop(S)
+ end.
+
+%%--------------------------------------------------------------------
+%% This was posted on the Erlang mailing list as a question:
+%%
+%% Given the module below and the function call
+%% "catch_bug:start_link(foo)."
+%% from the Erlang shell, why does Erlang crash with "Catch not found"?
+%%
+%% The BEAM compiler was generating wrong code for this case;
+%% this was fixed in R9C-0. Native code generation was OK.
+%%--------------------------------------------------------------------
+
+test_catch_bug() ->
+ ignore = start_link(foo),
+ ok.
+
+start_link(Param) ->
+ gen_server:start_link(?MODULE, Param, []).
+
+init(Param) ->
+ process_flag(trap_exit, true),
+ (catch begin
+ dummy(Param),
+ (catch exit(bar))
+ end
+ ),
+ ignore.
+
+dummy(_) -> ok.
+
+%% gen_server callbacks below
+handle_call(_Call, _From, State) -> {noreply, State}.
+handle_cast(_Msg, State) -> {noreply, State}.
+handle_info(_Msg, State) -> {noreply, State}.
+terminate(_Reason, _State) -> ok.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
+
diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
new file mode 100644
index 0000000000..caa0e71d0b
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl
@@ -0,0 +1,463 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%----------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that exhibited bugs in the HiPE compiler.
+%%%----------------------------------------------------------------------
+-module(basic_bugs_hipe).
+
+-export([test/0]).
+
+test() ->
+ ok = test_ets_bifs(),
+ ok = test_szar_bug(),
+ ok = test_bit_shift(),
+ ok = test_match_big_list(),
+ ok = test_unsafe_bsl(),
+ ok = test_unsafe_bsr(),
+ ok = test_R12B5_seg_fault(),
+ ok = test_switch_neg_int(),
+ ok = test_icode_range_anal(),
+ ok.
+
+%%-----------------------------------------------------------------------
+%% From: Bjorn Gustavsson
+%%
+%% This code, if HiPE compiled, crashed like this (on SPARC)
+%%
+%% (gdb) where
+%% #0 fullsweep_heap (p=0x2c60dc, new_sz=610, objv=0xffbee8b4, nobj=3)
+%% at beam/ggc.c:1060
+%% #1 0x7ff24 in erts_garbage_collect (p=0x2c60dc, need=2, objv=0x1128fc, ...)
+%% at beam/ggc.c:1648
+%% #2 0xab6fc in hipe_mode_switch (p=0x2c60dc, cmd=704512, reg=0x1128fc)
+%% at hipe/hipe_mode_switch.c:180
+%% #3 0x8e27c in process_main () at beam/beam_emu.c:3314
+%% #4 0x31338 in erl_start (argc=9, argv=0xffbeed5c) at beam/erl_init.c:936
+%% #5 0x2d9f4 in main (argc=9, argv=0xffbeed5c) at sys/unix/erl_main.c:28
+%%
+%% A guess at what could be the problem: From R8, many ets BIFs trap
+%% to other ets BIFs with a *different* arity (i.e. they have more or
+%% less arguments). I have probably forgotten to mention that subtle
+%% change.
+%%-----------------------------------------------------------------------
+
+test_ets_bifs() ->
+ Seed = {1032, 15890, 22716},
+ put(random_seed, Seed),
+ do_random_test().
+
+do_random_test() ->
+ OrdSet = ets:new(xxx, [ordered_set]),
+ Set = ets:new(xxx, []),
+ do_n_times(fun() ->
+ Key = create_random_string(25),
+ Value = create_random_tuple(25),
+ ets:insert(OrdSet, {Key, Value}),
+ ets:insert(Set, {Key, Value})
+ end, 5000),
+ %% io:format("~nData inserted~n"),
+ do_n_times(fun() ->
+ I = random:uniform(25),
+ Key = create_random_string(I) ++ '_',
+ L1 = ets_match_object(OrdSet, {Key, '_'}),
+ L2 = lists:sort(ets_match_object(Set, {Key, '_'})),
+ case L1 == L2 of
+ false ->
+ %% io:format("~p != ~p~n", [L1, L2]),
+ exit({not_eq, L1, L2});
+ true ->
+ ok
+ end
+ end, 2000),
+ %% io:format("~nData matched~n"),
+ ets:match_delete(OrdSet, '_'),
+ ets:match_delete(Set, '_'),
+ ok.
+
+create_random_string(0) ->
+ [];
+create_random_string(OfLength) ->
+ C = case random:uniform(2) of
+ 1 -> (random:uniform($Z - $A + 1) - 1) + $A;
+ _ -> (random:uniform($z - $a + 1) - 1) + $a
+ end,
+ [C | create_random_string(OfLength - 1)].
+
+create_random_tuple(OfLength) ->
+ list_to_tuple([list_to_atom([X]) || X <- create_random_string(OfLength)]).
+
+ets_match_object(Tab,Expr) ->
+ case random:uniform(2) of
+ 1 -> ets:match_object(Tab,Expr);
+ _ -> match_object_chunked(Tab,Expr)
+ end.
+
+match_object_chunked(Tab,Expr) ->
+ match_object_chunked_collect(ets:match_object(Tab, Expr,
+ random:uniform(1999) + 1)).
+
+match_object_chunked_collect('$end_of_table') ->
+ [];
+match_object_chunked_collect({Results, Continuation}) ->
+ Results ++ match_object_chunked_collect(ets:match_object(Continuation)).
+
+do_n_times(_, 0) ->
+ ok;
+do_n_times(Fun, N) ->
+ Fun(),
+ case N rem 1000 of
+ 0 -> ok; %% WAS: io:format(".");
+ _ -> ok
+ end,
+ do_n_times(Fun, N - 1).
+
+%%-----------------------------------------------------------------------
+%% From: Jozsef Berces (PR/ECZ)
+%% Date: Feb 19, 2004
+%%
+%% Program which was added to the testsuite as a result of another bug
+%% report involving tuples as funs. Thanks God, these are no longer
+%% supported, but the following is a good test for testing calling
+%% native code funs from BEAM code (lists:map, lists:filter, ...).
+%%-----------------------------------------------------------------------
+
+test_szar_bug() ->
+ ["A","B","C"] = smartconcat([], "H'A, H'B, H'C"),
+ ok.
+
+smartconcat(B, L) ->
+ LL = tokenize(L, $,),
+ NewlineDel = fun (X) -> killcontrol(X) end,
+ StripFun = fun (X) -> string:strip(X) end,
+ LL2 = lists:map(NewlineDel, lists:map(StripFun, LL)),
+ EmptyDel = fun(X) ->
+ case string:len(X) of
+ 0 -> false;
+ _ -> true
+ end
+ end,
+ LL3 = lists:filter(EmptyDel, LL2),
+ HexFormat = fun(X, Acc) ->
+ case string:str(X, "H'") of
+ 1 ->
+ case checkhex(string:substr(X, 3)) of
+ {ok, Y} ->
+ {Y, Acc};
+ _ ->
+ {X, Acc + 1}
+ end;
+ _ ->
+ {X, Acc + 1}
+ end
+ end,
+ {LL4,_Ret} = lists:mapfoldl(HexFormat, 0, LL3),
+ lists:append(B, lists:sublist(LL4, lists:max([0, 25 - length(B)]))).
+
+checkhex(L) ->
+ checkhex(L, "").
+
+checkhex([H | T], N) when H >= $0, H =< $9 ->
+ checkhex(T, [H | N]);
+checkhex([H | T], N) when H >= $A, H =< $F ->
+ checkhex(T, [H | N]);
+checkhex([H | T], N) when H =< 32 ->
+ checkhex(T, N);
+checkhex([_ | _], _) ->
+ {error, ""};
+checkhex([], N) ->
+ {ok, lists:reverse(N)}.
+
+killcontrol([C | S]) when C < 32 ->
+ killcontrol(S);
+killcontrol([C | S]) ->
+ [C | killcontrol(S)];
+killcontrol([]) ->
+ [].
+
+tokenize(L, C) ->
+ tokenize(L, C, [], []).
+
+tokenize([C | T], C, A, B) ->
+ case A of
+ [] ->
+ tokenize(T, C, [], B);
+ _ ->
+ tokenize(T, C, [], [lists:reverse(A) | B])
+ end;
+tokenize([H | T], C, A, B) ->
+ tokenize(T, C, [H | A], B);
+tokenize(_, _, [], B) ->
+ lists:reverse(B);
+tokenize(_, _, A, B) ->
+ lists:reverse([lists:reverse(A) | B]).
+
+%%-----------------------------------------------------------------------
+%% From: Niclas Pehrsson
+%% Date: Apr 20, 2006
+%%
+%% We found something weird with the bit shifting in HiPE. It seems
+%% that bsr in some cases shifts the bits in the wrong way...
+%%
+%% Fixed about 10 mins afterwards; was a bug in constant propagation.
+%%-----------------------------------------------------------------------
+
+test_bit_shift() ->
+ 1 = plain_shift(), % 1
+ 6 = length_list_plus(), % 6
+ 0 = shift_length_list(), % 0
+ 1 = shift_length_list_plus(), % 1
+ 1 = shift_length_list_plus2(), % 1
+ 24 = shift_length_list_plus_bsl(), % 24
+ 1 = shift_fun(), % 1
+ %% {1, 6, 0, 1, 1, 24, 1} = {A, B, C, D, E, F, G},
+ ok.
+
+plain_shift() ->
+ 6 bsr 2.
+
+length_list() ->
+ length([0,0]).
+
+length_list_plus() ->
+ length([0,0]) + 4.
+
+shift_length_list() ->
+ length([0,0]) bsr 2.
+
+shift_length_list_plus() ->
+ (length([0,0]) + 4) bsr 2.
+
+shift_length_list_plus_bsl() ->
+ (length([0,0]) + 4) bsl 2.
+
+shift_length_list_plus2() ->
+ N = length([0,0]) + 4,
+ N bsr 2.
+
+shift_fun() ->
+ (length_list() + 4) bsr 2.
+
+%%-----------------------------------------------------------------------
+%% From: Igor Goryachev
+%% Date: June 15, 2006
+%%
+%% I have experienced a different behaviour and possibly a weird result
+%% while playing with matching a big list on x86 and x86_64 machines.
+%%-----------------------------------------------------------------------
+
+-define(BIG_LIST,
+ ["uid", "nickname", "n_family", "n_given", "email_pref",
+ "tel_home_number", "tel_cellular_number", "adr_home_country",
+ "adr_home_locality", "adr_home_region", "url", "gender", "bday",
+ "constitution", "height", "weight", "hair", "routine", "smoke",
+ "maritalstatus", "children", "independence", "school_number",
+ "school_locality", "school_title", "school_period", "org_orgname",
+ "title", "adr_work_locality", "photo_type", "photo_binval"]).
+
+test_match_big_list() ->
+ case create_tuple_with_big_const_list() of
+ {selected, ?BIG_LIST, _} -> ok;
+ _ -> weird
+ end.
+
+create_tuple_with_big_const_list() ->
+ {selected, ?BIG_LIST, [{"test"}]}.
+
+%%-----------------------------------------------------------------------
+%% In October 2006 the HiPE compiler acquired more type-driven
+%% optimisations of arithmetic operations. One of these, the
+%% transformation of bsl to a pure fixnum bsl fixnum -> fixnum version
+%% (unsafe_bsl), was incorrectly performed even when the result
+%% wouldn't be a fixnum. The error occurred for all backends, but the
+%% only place known to break was hipe_arm:imm_to_am1/2. Some
+%% immediates got broken on ARM, causing segmentation faults in
+%% compiler_tests when HiPE recompiled itself.
+%%-----------------------------------------------------------------------
+
+test_unsafe_bsl() ->
+ ok = bsl_check(bsl_test_cases()).
+
+bsl_test_cases() ->
+ [{16#FF, {16#FF, 0}},
+ {16#F000000F, {16#FF, 2}}].
+
+bsl_check([]) -> ok;
+bsl_check([{X, Y}|Rest]) ->
+ case imm_to_am1(X) of
+ Y -> bsl_check(Rest);
+ _ -> 'hipe_broke_bsl'
+ end.
+
+imm_to_am1(Imm) ->
+ imm_to_am1(Imm band 16#FFFFFFFF, 16).
+imm_to_am1(Imm, RotCnt) ->
+ if Imm >= 0, Imm =< 255 -> {Imm, RotCnt band 15};
+ true ->
+ NewRotCnt = RotCnt - 1,
+ if NewRotCnt =:= 0 -> []; % full circle, no joy
+ true ->
+ NewImm = (Imm bsr 2) bor ((Imm band 3) bsl 30),
+ imm_to_am1(NewImm, NewRotCnt)
+ end
+ end.
+
+%%-----------------------------------------------------------------------
+%% Another transformation, namely that of bsr to a pure fixnum bsr
+%% fixnum -> fixnum version (unsafe_bsr), failed to check for shifts
+%% larger than the number of bits in fixnums. Such shifts should
+%% return zero, but instead they became plain machine-level shift
+%% instructions. Machines often only consider the low-order bits of
+%% the shift count, so machine-level shifts larger than the word size
+%% do not match the Erlang semantics.
+%%-----------------------------------------------------------------------
+
+test_unsafe_bsr() ->
+ ok = bsr_check(bsr_test_cases()).
+
+bsr_test_cases() ->
+ [{16#FF, 4, 16#0F},
+ {16#FF, 64, 0}].
+
+bsr_check([]) -> ok;
+bsr_check([{X, Y, Z}|Rest]) ->
+ case do_bsr(X, Y) of
+ Z -> bsr_check(Rest);
+ _ -> 'hipe_broke_bsr'
+ end.
+
+do_bsr(X, Y) ->
+ (X band 16#FFFF) bsr (Y band 16#FFFF).
+
+%%-----------------------------------------------------------------------
+%% From: Sergey S, mid January 2009.
+%%
+%% While I was playing with +native option, I run into a bug in HiPE
+%% which leads to segmentation fault using +native and Erlang R12B-5.
+%%
+%% Eshell V5.6.5
+%% 1> crash:test().
+%% # Some message to be printed here each loop iteration
+%% Segmentation fault
+%%
+%% Diagnosed and fixed by Mikael Pettersson (22 Jan 2009):
+%%
+%% I've analysed the recently posted HiPE bug report on erlang-bugs
+%% <http://www.erlang.org/pipermail/erlang-bugs/2009-January/001162.html>.
+%% The segfault is caused by memory corruption, which in turn is caused
+%% by RTL removing an update of the HP (heap pointer) register due to
+%% what looks like broken liveness information.
+%%-----------------------------------------------------------------------
+
+test_R12B5_seg_fault() ->
+ _ = spawn(fun() -> init() end),
+ ok.
+
+init() ->
+ repeat(5, fun() -> void end),
+ receive after infinity -> ok end.
+
+repeat(0, _) ->
+ ok;
+repeat(N, Fun) ->
+ %% io:format("# Some message to be printed here each loop iteration\n"),
+ Fun(),
+ repeat(N - 1, Fun).
+
+%%-----------------------------------------------------------------------
+%% From: Jon Meredith
+%% Date: July 9, 2009
+%%
+%% Binary search key tables are sorted by the loader based on the
+%% runtime representations of the keys as unsigned words. However,
+%% the code generated for the binary search used signed comparisons.
+%% That worked for atoms and non-negative fixnums, but not for
+%% negative fixnums. Fixed by Mikael Pettersson July 10, 2009.
+%%-----------------------------------------------------------------------
+
+test_switch_neg_int() ->
+ ok = f(-80, 8).
+
+f(10, -1) -> ok;
+f(X, Y) ->
+ Y = g(X),
+ f(X + 10, Y - 1).
+
+g(X) -> % g(0) should be 0 but became -1
+ case X of
+ 0 -> 0;
+ -10 -> 1;
+ -20 -> 2;
+ -30 -> 3;
+ -40 -> 4;
+ -50 -> 5;
+ -60 -> 6;
+ -70 -> 7;
+ -80 -> 8;
+ _ -> -1
+ end.
+
+%%-----------------------------------------------------------------------
+%% From: Paul Guyot
+%% Date: Jan 31, 2011
+%%
+%% There is a bug in HiPE compilation with the comparison of floats
+%% with integers. This bug happens in functions f/1 and g/2 below.
+%% BEAM will evaluate f_eq(42) and f_eq(42.0) to true, while HiPE
+%% will evaluate them to false.
+%%
+%% The culprit was the Icode range analysis which was buggy. (On the
+%% other hand, HiPE properly evaluated these calls to true if passed
+%% the option 'no_icode_range'.) Fixed by Kostis Sagonas.
+%% --------------------------------------------------------------------
+
+test_icode_range_anal() ->
+ true = f_eq(42),
+ true = f_eq(42.0),
+ false = f_ne(42),
+ false = f_ne(42.0),
+ false = f_eq_ex(42),
+ false = f_eq_ex(42.0),
+ true = f_ne_ex(42),
+ true = f_ne_ex(42.0),
+ false = f_gt(42),
+ false = f_gt(42.0),
+ true = f_le(42),
+ true = f_le(42.0),
+ zero_test = g(0, test),
+ zero_test = g(0.0, test),
+ non_zero_test = g(42, test),
+ other = g(42, other),
+ ok.
+
+f_eq(X) ->
+ Y = X / 2,
+ Y == 21.
+
+f_ne(X) ->
+ Y = X / 2,
+ Y /= 21.
+
+f_eq_ex(X) ->
+ Y = X / 2,
+ Y =:= 21.
+
+f_ne_ex(X) ->
+ Y = X / 2,
+ Y =/= 21.
+
+f_gt(X) ->
+ Y = X / 2,
+ Y > 21.
+
+f_le(X) ->
+ Y = X / 2,
+ Y =< 21.
+
+g(X, Z) ->
+ Y = X / 2,
+ case Z of
+ test when Y == 0 -> zero_test;
+ test -> non_zero_test;
+ other -> other
+ end.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl
new file mode 100644
index 0000000000..8dab2cab1f
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl
@@ -0,0 +1,157 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests for correct execution of comparison operators.
+%%%-------------------------------------------------------------------
+-module(basic_comparisons).
+
+-export([test/0]).
+
+test() ->
+ Ns = [0, 0.0, 42, 42.0, gazonk],
+ T1F4 = [true, false, false, false, false],
+ T2F3 = [true, true, false, false, false],
+ F1T4 = [false, true, true, true, true],
+ F2T3 = [false, false, true, true, true],
+ %% tests for calls
+ T1F4 = [eq_exact_call(0, N) || N <- Ns],
+ F1T4 = [ne_exact_call(0, N) || N <- Ns],
+ T2F3 = [eq_call(0, N) || N <- Ns],
+ F2T3 = [ne_call(0, N) || N <- Ns],
+ %% tests for guards
+ T1F4 = [eq_exact_guard(0, N) || N <- Ns],
+ F1T4 = [ne_exact_guard(0, N) || N <- Ns],
+ T2F3 = [eq_guard(0, N) || N <- Ns],
+ F2T3 = [ne_guard(0, N) || N <- Ns],
+ %% some more tests
+ ok = test_against_zero(),
+ ok = test_against_other_terms(),
+ ok = test_sofs_func(),
+ ok.
+
+test_against_zero() ->
+ Xs = [0, 1, 0.0],
+ [true, false, false] = [is_zero_int(X) || X <- Xs],
+ [true, false, true] = [is_zero_num(X) || X <- Xs],
+ [false, true, true] = [is_nonzero_int(X) || X <- Xs],
+ [false, true, false] = [is_nonzero_num(X) || X <- Xs],
+ ok.
+
+test_against_other_terms() ->
+ TTT = {true, true, true},
+ FFF = {false, false, false},
+ TTT = {is_foo_exact(foo), is_foo_term1(foo), is_foo_term2(foo)},
+ FFF = {is_foo_exact(bar), is_foo_term1(bar), is_foo_term2(bar)},
+ FFF = {is_nonfoo_exact(foo), is_nonfoo_term1(foo), is_nonfoo_term2(foo)},
+ TTT = {is_nonfoo_exact(bar), is_nonfoo_term1(bar), is_nonfoo_term2(bar)},
+ Tup = {a, {42}, [c]},
+ TTT = {is_tuple_skel(Tup), is_tuple_exact(Tup), is_tuple_term(Tup)},
+ BNi = <<42>>,
+ TTT = {is_bin_exact(BNi), is_bin_term1(BNi), is_bin_term2(BNi)},
+ BNf = <<42/float>>,
+ FFF = {is_bin_exact(BNf), is_bin_term1(BNf), is_bin_term2(BNf)},
+ ok.
+
+test_sofs_func() ->
+ L = [0, 0.0],
+ ok = sofs_func(L, L, L).
+
+%%--------------------------------------------------------------------
+%% Test for comparison operators used in body calls
+
+eq_exact_call(X, Y) -> X =:= Y.
+
+ne_exact_call(X, Y) -> X =/= Y.
+
+eq_call(X, Y) -> X == Y.
+
+ne_call(X, Y) -> X /= Y.
+
+%%--------------------------------------------------------------------
+%% Tests for comparison operators used as guards
+
+eq_exact_guard(X, Y) when X =:= Y -> true;
+eq_exact_guard(_, _) -> false.
+
+ne_exact_guard(X, Y) when X =/= Y -> true;
+ne_exact_guard(_, _) -> false.
+
+eq_guard(X, Y) when X == Y -> true;
+eq_guard(_, _) -> false.
+
+ne_guard(X, Y) when X /= Y -> true;
+ne_guard(_, _) -> false.
+
+%%--------------------------------------------------------------------
+
+is_zero_int(N) when N =:= 0 -> true;
+is_zero_int(_) -> false.
+
+is_nonzero_int(N) when N =/= 0 -> true;
+is_nonzero_int(_) -> false.
+
+is_zero_num(N) when N == 0 -> true;
+is_zero_num(_) -> false.
+
+is_nonzero_num(N) when N /= 0 -> true;
+is_nonzero_num(_) -> false.
+
+%%--------------------------------------------------------------------
+%% There should not really be any difference in the generated code
+%% for the following three functions.
+
+is_foo_exact(A) when A =:= foo -> true;
+is_foo_exact(_) -> false.
+
+is_foo_term1(A) when A == foo -> true;
+is_foo_term1(_) -> false.
+
+is_foo_term2(A) when foo == A -> true;
+is_foo_term2(_) -> false.
+
+%%--------------------------------------------------------------------
+%% Same for these cases
+
+is_nonfoo_exact(A) when A =/= foo -> true;
+is_nonfoo_exact(_) -> false.
+
+is_nonfoo_term1(A) when A /= foo -> true;
+is_nonfoo_term1(_) -> false.
+
+is_nonfoo_term2(A) when foo /= A -> true;
+is_nonfoo_term2(_) -> false.
+
+%%--------------------------------------------------------------------
+
+is_tuple_skel({A,{B},[C]}) when is_atom(A), is_integer(B), is_atom(C) -> true;
+is_tuple_skel(T) when is_tuple(T) -> false.
+
+is_tuple_exact(T) when T =:= {a,{42},[c]} -> true;
+is_tuple_exact(T) when is_tuple(T) -> false.
+
+is_tuple_term(T) when T == {a,{42.0},[c]} -> true;
+is_tuple_term(T) when is_tuple(T) -> false.
+
+%%--------------------------------------------------------------------
+%% But for binaries the treatment has to be different, due to the need
+%% for construction of the binary in the guard.
+
+is_bin_exact(B) when B =:= <<42>> -> true;
+is_bin_exact(_) -> false.
+
+is_bin_term1(B) when B == <<42>> -> true;
+is_bin_term1(_) -> false.
+
+is_bin_term2(B) when <<42>> == B -> true;
+is_bin_term2(_) -> false.
+
+%%--------------------------------------------------------------------
+%% a test from sofs.erl which failed at some point
+
+sofs_func([X | Ts], X0, L) when X /= X0 ->
+ sofs_func(Ts, X, L);
+sofs_func([X | _Ts], X0, _L) when X == X0 ->
+ ok;
+sofs_func([], _X0, L) ->
+ L.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
new file mode 100644
index 0000000000..229a0516dc
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
@@ -0,0 +1,465 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that raise exceptions and catch them.
+%%%-------------------------------------------------------------------
+-module(basic_exceptions).
+
+-export([test/0, test_catches/0]).
+
+%% functions used as arguments to spawn/3
+-export([bad_guy/2]).
+
+test() ->
+ ok = test_catch_exit(42),
+ ok = test_catch_throw(42),
+ ok = test_catch_element(),
+ ok = test_catch_crash(),
+ ok = test_catch_empty(),
+ ok = test_catch_merge(),
+ ok = test_catches_merged(),
+ ok = test_pending_errors(),
+ ok = test_bad_fun_call(),
+ ok = test_guard_bif(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Written in 2001 by Erik Johansson.
+
+test_catches() ->
+ ExitBar = {'EXIT', bar},
+ L1 = [ExitBar, ok, ExitBar, {ok, ExitBar}],
+ L1 = [t1(), t2(), t3(), t4()],
+ badarith = (catch element(1, element(2, t5(a, b)))),
+ L2 = [42, ExitBar, ExitBar, {no_exception, ok}],
+ L2 = [t5(21, 21), t6(), t7(), t8()],
+ ok.
+
+t1() ->
+ catch foo().
+
+t2() ->
+ V = (catch ok()),
+ s(),
+ V.
+
+t3() ->
+ V = (catch foo()),
+ V.
+
+t4() ->
+ V1 = ok(),
+ V2 = (catch foo()),
+ {V1, V2}.
+
+t5(A, B) ->
+ catch A + B.
+
+t6() ->
+ catch {no_exception, ok(), foo()}.
+
+t7() ->
+ catch {no_exception, foo(), ok()}.
+
+t8() ->
+ catch {no_exception, ok()}.
+
+foo() ->
+ s(),
+ exit(bar).
+
+ok() -> s(), ok.
+
+s() -> nada.
+
+%%--------------------------------------------------------------------
+
+test_catch_exit(N) ->
+ {'EXIT', N} = (catch exit(N)),
+ {'EXIT', 42} = (catch exit(42)),
+ 42 = try exit(N) catch exit:R1 -> R1 end,
+ 42 = try exit(42) catch exit:R2 -> R2 end,
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_catch_throw(N) ->
+ N = (catch throw(N)),
+ 42 = (catch throw(42)),
+ 42 = try throw(N) catch throw:R1 -> R1 end,
+ 42 = try throw(42) catch throw:R2 -> R2 end,
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_catch_element() ->
+ 'EXIT' = test_catch_element([]),
+ 'EXIT' = test_catch_element(42),
+ ok.
+
+test_catch_element(N) ->
+ element(1, catch element(N, {1,2,3,4,5,6,7,8,9,10,11})).
+
+%%--------------------------------------------------------------------
+
+-define(try_match(E),
+ catch ?MODULE:non_existing(),
+ {'EXIT', {{badmatch, nomatch}, _}} = (catch E = no_match())).
+
+test_catch_crash() ->
+ ?try_match(a),
+ ?try_match(42),
+ ?try_match({a, b, c}),
+ ?try_match([]),
+ ?try_match(1.0),
+ ok.
+
+no_match() -> nomatch.
+
+%% small_test() ->
+%% catch ?MODULE:non_existing(),
+%% io:format("Before\n",[]),
+%% hipe_bifs:show_nstack(self()),
+%% io:format("After\n",[]),
+%% garbage_collect().
+
+%%--------------------------------------------------------------------
+%% Tests whether the HiPE compiler optimizes catches in a way that
+%% does not result in an infinite loop.
+%%--------------------------------------------------------------------
+
+test_catch_empty() ->
+ badmatch().
+
+badmatch() ->
+ Big = ret_big(),
+ Float = ret_float(),
+ catch a = Big,
+ catch b = Float,
+ ok = case Big of Big -> ok end,
+ ok = case Float of Float -> ok end,
+ ok.
+
+ret_big() ->
+ 329847987298478924982978248748729829487298292982972978239874.
+
+ret_float() ->
+ 3.1415927.
+
+%%--------------------------------------------------------------------
+%% Test that shows how BEAM can merge catch-end blocks that belong to
+%% different catch-start instructions. Written by Richard Carlsson.
+%%--------------------------------------------------------------------
+
+test_catch_merge() ->
+ merge(get(whatever)).
+
+merge(foo=X) ->
+ catch f(X),
+ catch g(X);
+merge(X) ->
+ catch f(X),
+ catch g(X).
+
+f(_) -> ok.
+
+g(_) -> ok.
+
+%%--------------------------------------------------------------------
+%% Written by Tobias Lindahl.
+
+test_catches_merged() ->
+ {'EXIT', _} = merged_catches(foo),
+ {'EXIT', {badarith, _}} = merged_catches(bar),
+ {'EXIT', _} = merged_catches(baz),
+ ok.
+
+merged_catches(X) ->
+ case X of
+ foo -> catch fail1(0);
+ bar -> catch {catch(1 = X), fail2(0)};
+ baz -> catch fail3(0)
+ end.
+
+fail1(X) -> 1/X.
+
+fail2(X) -> 1/X.
+
+fail3(X) -> 1/X.
+
+%%--------------------------------------------------------------------
+%% Taken from exception_SUITE.erl
+%%--------------------------------------------------------------------
+
+test_pending_errors() ->
+ error_logger:tty(false), % disable printouts of error reports
+ pending_errors().
+
+%% Test various exceptions, in the presence of a previous error
+%% suppressed in a guard.
+pending_errors() ->
+ pending(e_badmatch, {badmatch, b}),
+ pending(x, function_clause),
+ pending(e_case, {case_clause, xxx}),
+ pending(e_if, if_clause),
+ %% pending(e_badarith, badarith),
+ %% pending(e_undef, undef),
+ pending(e_timeoutval, timeout_value),
+ %% pending(e_badarg, badarg),
+ %% pending(e_badarg_spawn, badarg),
+ ok.
+
+bad_guy(pe_badarith, Other) when Other+1 =:= 0 -> % badarith (suppressed)
+ ok;
+bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed)
+ ok;
+bad_guy(_, e_case) ->
+ case xxx() of
+ ok -> ok
+ end; % case_clause
+bad_guy(_, e_if) ->
+ B = b(),
+ if
+ a == B -> ok
+ end; % if_clause
+%% bad_guy(_, e_badarith) ->
+%% 1+b; % badarith
+bad_guy(_, e_undef) ->
+ non_existing_module:foo(); % undef
+bad_guy(_, e_timeoutval) ->
+ receive
+ after gazonk -> ok % timeout_value
+ end;
+bad_guy(_, e_badarg) ->
+ node(xxx); % badarg
+bad_guy(_, e_badarg_spawn) ->
+ spawn({}, {}, {}); % badarg
+bad_guy(_, e_badmatch) ->
+ a = b(). % badmatch
+
+xxx() -> xxx.
+
+b() -> b.
+
+pending(Arg, Expected) ->
+ pending(pe_badarith, Arg, Expected),
+ pending(pe_badarg, Arg, Expected).
+
+pending(First, Second, Expected) ->
+ pending_catched(First, Second, Expected),
+ pending_exit_message([First, Second], Expected).
+
+pending_catched(First, Second, Expected) ->
+ %% ok = io:format("Catching bad_guy(~p, ~p)\n", [First, Second]),
+ case catch bad_guy(First, Second) of
+ {'EXIT', Reason} ->
+ pending(Reason, bad_guy, [First, Second], Expected);
+ Other ->
+ exit({not_exit, Other})
+ end.
+
+pending_exit_message(Args, Expected) ->
+ %% ok = io:format("Trapping exits from spawn_link(~p, ~p, ~p)\n",
+ %% [?MODULE, bad_guy, Args]),
+ process_flag(trap_exit, true),
+ Pid = spawn_link(?MODULE, bad_guy, Args),
+ receive
+ {'EXIT', Pid, Reason} ->
+ pending(Reason, bad_guy, Args, Expected);
+ Other ->
+ exit({unexpected_message, Other})
+ after 10000 ->
+ exit(timeout)
+ end,
+ process_flag(trap_exit, false).
+
+%% pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]},
+%% Func, Args, _Code)
+%% when atom(Bif), list(BifArgs), length(Args) =:= Arity ->
+%% ok;
+pending({badarg,Trace}, _, _, _) when is_list(Trace) ->
+ ok;
+%% pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) ->
+%% ok;
+pending({undef,Trace}, _, _, _) when is_list(Trace) ->
+ ok;
+%% pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) ->
+%% ok;
+pending({function_clause,Trace}, _, _, _) when is_list(Trace) ->
+ ok;
+%% pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code)
+%% when length(Args) =:= Arity ->
+%% ok;
+pending({Code,Trace}, _, _, Code) when is_list(Trace) ->
+ ok;
+pending(Reason, _Function, _Args, _Code) ->
+ exit({bad_exit_reason, Reason}).
+
+%%--------------------------------------------------------------------
+%% Taken from fun_SUITE.erl
+%%
+%% Checks correct exception throwing when calling a bad fun.
+%%--------------------------------------------------------------------
+
+test_bad_fun_call() ->
+ ok = bad_call_fc(42),
+ ok = bad_call_fc(xx),
+ ok = bad_call_fc({}),
+ ok = bad_call_fc({1}),
+ ok = bad_call_fc({1,2,3}),
+ ok = bad_call_fc({1,2,3}),
+ ok = bad_call_fc({1,2,3,4}),
+ ok = bad_call_fc({1,2,3,4,5,6}),
+ ok = bad_call_fc({1,2,3,4,5}),
+ ok = bad_call_fc({1,2}),
+ ok.
+
+bad_call_fc(Fun) ->
+ Args = [some, stupid, args],
+ Res = (catch Fun(Fun(Args))),
+ case Res of
+ {'EXIT', {{badfun, Fun} ,_Where}} ->
+ ok; %% = io:format("~p(~p) -> ~p\n", [Fun, Args, Res]);
+ Other ->
+ io:format("~p(~p) -> ~p\n", [Fun, Args, Res]),
+ exit({bad_result, Other})
+ end.
+
+%%--------------------------------------------------------------------
+%% Taken from guard_SUITE.erl
+%%
+%% Tests correct handling of exceptions by calling guard BIFs with
+%% nasty (but legal arguments).
+%%--------------------------------------------------------------------
+
+test_guard_bif() ->
+ Big = -237849247829874297658726487367328971246284736473821617265433,
+ Float = 387924.874,
+
+ %% Succeding use of guard bifs.
+
+ try_gbif('abs/1', Big, -Big),
+ try_gbif('float/1', Big, float(Big)),
+ try_gbif('trunc/1', Float, 387924.0),
+ try_gbif('round/1', Float, 387925.0),
+ try_gbif('length/1', [], 0),
+
+ try_gbif('length/1', [a], 1),
+ try_gbif('length/1', [a, b], 2),
+ try_gbif('length/1', lists:seq(0, 31), 32),
+
+ try_gbif('hd/1', [a], a),
+ try_gbif('hd/1', [a, b], a),
+
+ try_gbif('tl/1', [a], []),
+ try_gbif('tl/1', [a, b], [b]),
+ try_gbif('tl/1', [a, b, c], [b, c]),
+
+ try_gbif('size/1', {}, 0),
+ try_gbif('size/1', {a}, 1),
+ try_gbif('size/1', {a, b}, 2),
+ try_gbif('size/1', {a, b, c}, 3),
+ try_gbif('size/1', list_to_binary([]), 0),
+ try_gbif('size/1', list_to_binary([1]), 1),
+ try_gbif('size/1', list_to_binary([1, 2]), 2),
+ try_gbif('size/1', list_to_binary([1, 2, 3]), 3),
+
+ try_gbif('element/2', {x}, {1, x}),
+ try_gbif('element/2', {x, y}, {1, x}),
+ try_gbif('element/2', {x, y}, {2, y}),
+
+ try_gbif('self/0', 0, self()),
+ try_gbif('node/0', 0, node()),
+ try_gbif('node/1', self(), node()),
+
+ %% Failing use of guard bifs.
+
+ try_fail_gbif('abs/1', Big, 1),
+ try_fail_gbif('abs/1', [], 1),
+
+ try_fail_gbif('float/1', Big, 42),
+ try_fail_gbif('float/1', [], 42),
+
+ try_fail_gbif('trunc/1', Float, 0.0),
+ try_fail_gbif('trunc/1', [], 0.0),
+
+ try_fail_gbif('round/1', Float, 1.0),
+ try_fail_gbif('round/1', [], a),
+
+ try_fail_gbif('length/1', [], 1),
+ try_fail_gbif('length/1', [a], 0),
+ try_fail_gbif('length/1', a, 0),
+ try_fail_gbif('length/1', {a}, 0),
+
+ try_fail_gbif('hd/1', [], 0),
+ try_fail_gbif('hd/1', [a], x),
+ try_fail_gbif('hd/1', x, x),
+
+ try_fail_gbif('tl/1', [], 0),
+ try_fail_gbif('tl/1', [a], x),
+ try_fail_gbif('tl/1', x, x),
+
+ try_fail_gbif('size/1', {}, 1),
+ try_fail_gbif('size/1', [], 0),
+ try_fail_gbif('size/1', [a], 1),
+ try_fail_gbif('size/1', fun() -> 1 end, 0),
+ try_fail_gbif('size/1', fun() -> 1 end, 1),
+
+ try_fail_gbif('element/2', {}, {1, x}),
+ try_fail_gbif('element/2', {x}, {1, y}),
+ try_fail_gbif('element/2', [], {1, z}),
+
+ try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")),
+ try_fail_gbif('node/0', 0, xxxx),
+ try_fail_gbif('node/1', self(), xxx),
+ try_fail_gbif('node/1', yyy, xxx),
+ ok.
+
+try_gbif(Id, X, Y) ->
+ case guard_bif(Id, X, Y) of
+ {Id, X, Y} ->
+ %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id, X, Y]);
+ ok;
+ Other ->
+ ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
+ [Id, X, Y, Other]),
+ exit({bad_result,try_gbif})
+ end.
+
+try_fail_gbif(Id, X, Y) ->
+ case catch guard_bif(Id, X, Y) of
+ %% {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} ->
+ {'EXIT', {function_clause,_}} -> % in HiPE, a trace is not generated
+ %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id,X,Y]);
+ ok;
+ Other ->
+ ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
+ [Id, X, Y, Other]),
+ exit({bad_result,try_fail_gbif})
+ end.
+
+guard_bif('abs/1', X, Y) when abs(X) == Y ->
+ {'abs/1', X, Y};
+guard_bif('float/1', X, Y) when float(X) == Y ->
+ {'float/1', X, Y};
+guard_bif('trunc/1', X, Y) when trunc(X) == Y ->
+ {'trunc/1', X, Y};
+guard_bif('round/1', X, Y) when round(X) == Y ->
+ {'round/1', X, Y};
+guard_bif('length/1', X, Y) when length(X) == Y ->
+ {'length/1', X, Y};
+guard_bif('hd/1', X, Y) when hd(X) == Y ->
+ {'hd/1', X, Y};
+guard_bif('tl/1', X, Y) when tl(X) == Y ->
+ {'tl/1', X, Y};
+guard_bif('size/1', X, Y) when size(X) == Y ->
+ {'size/1', X, Y};
+guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected ->
+ {'element/2', X, {Pos, Expected}};
+guard_bif('self/0', X, Y) when self() == Y ->
+ {'self/0', X, Y};
+guard_bif('node/0', X, Y) when node() == Y ->
+ {'node/0', X, Y};
+guard_bif('node/1', X, Y) when node(X) == Y ->
+ {'node/1', X, Y}.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl
new file mode 100644
index 0000000000..eec175075a
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl
@@ -0,0 +1,180 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that manipulate floating point numbers.
+%%%-------------------------------------------------------------------
+-module(basic_floats).
+
+-export([test/0]).
+-export([test_fmt_double_fpe_leak/0]). % suppress the unused warning
+
+test() ->
+ ok = test_arith_ops(),
+ ok = test_fp_ebb(),
+ ok = test_fp_phi(),
+ ok = test_big_bad_float(),
+ ok = test_catch_bad_fp_arith(),
+ ok = test_catch_fp_conv(),
+ ok = test_fp_with_fp_exceptions(),
+ %% ok = test_fmt_double_fpe_leak(), % this requires printing
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_arith_ops() ->
+ E = 2.5617,
+ 5.703200000000001 = add(E),
+ 0.5798000000000001 = sub(E),
+ 8.047580550000001 = mult(E),
+ -6.023e23 = negate(6.023e23),
+ ok.
+
+add(X) ->
+ 3.1415 + X.
+
+sub(X) ->
+ 3.1415 - X.
+
+mult(X) ->
+ 3.1415 * X.
+
+%% tests the translation of the fnegate BEAM instruction.
+negate(X) ->
+ - (X + 0.0).
+
+%%--------------------------------------------------------------------
+%% Test the construction of overlapping extended basic blocks where
+%% BEAM has constructed one and hipe_icode_fp constructs the other.
+%%--------------------------------------------------------------------
+
+test_fp_ebb() ->
+ 1.0 = foo(2 * math:pi()),
+ 1.0 = bar(2 * math:pi()),
+ ok.
+
+foo(X) ->
+ X / (2 * math:pi()).
+
+bar(X) ->
+ F = float_two(),
+ case F < 3.0 of
+ true -> (X * F) / ((2 * F) * math:pi());
+ false -> weird
+ end.
+
+float_two() ->
+ 2.0.
+
+%%--------------------------------------------------------------------
+
+test_fp_phi() ->
+ 10 = fp_phi(10, 100),
+ undefined = fp_phi(1.1e302, 0.000000001),
+ ok.
+
+fp_phi(A, B) ->
+ case catch A / B of
+ {'EXIT', _Reason} -> undefined;
+ _ -> round(100 * (A / B))
+ end.
+
+%%--------------------------------------------------------------------
+
+-define(BS, "93904329458954829589425849258998492384932849328493284932849328493284932389248329432932483294832949245827588578423578435783475834758375837580745807304258924584295924588459834958349589348589345934859384958349583945893458934859438593485995348594385943859438593458934589345938594385934859483958348934589435894859485943859438594594385938459438595034950439504395043950495043593485943758.0").
+
+test_big_bad_float() ->
+ ok = try f2l(?BS) catch error:badarg -> ok end,
+ ok = case catch f2l(?BS) of {'EXIT', {badarg, _}} -> ok end,
+ ok.
+
+f2l(F) ->
+ float_to_list(list_to_float(F)).
+
+%%--------------------------------------------------------------------
+%% Tests catching of floating point bad arithmetic.
+
+test_catch_bad_fp_arith() ->
+ 5.7 = f(2.56),
+ {'EXIT', {badarith, _}} = bad_arith(9.9),
+ ok.
+
+f(F) when is_float(F) -> F + 3.14.
+
+bad_arith(F) when is_float(F) ->
+ catch F * 1.70000e+308.
+
+%%--------------------------------------------------------------------
+%% Tests proper catching of exceptions due to illegal convertion of
+%% bignums to floating point numbers.
+
+test_catch_fp_conv() ->
+ F = 1.7e308, %% F is a number very close to a maximum float.
+ ok = big_arith(F),
+ ok = big_const_float(F),
+ ok.
+
+big_arith(F) ->
+ I = trunc(F),
+ {'EXIT', {badarith, _}} = big_int_arith(I),
+ ok.
+
+big_int_arith(I) when is_integer(I) ->
+ catch(3.0 + 2*I).
+
+big_const_float(F) ->
+ I = trunc(F),
+ badarith = try (1/(2*I)) catch error:Err -> Err end,
+ _ = 2/I,
+ {'EXIT', _} = (catch 4/(2*I)),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Forces floating point exceptions and tests that subsequent, legal,
+%% operations are calculated correctly.
+
+test_fp_with_fp_exceptions() ->
+ 0.0 = math:log(1.0),
+ badarith = try math:log(float_minus_one()) catch error:E1 -> E1 end,
+ 0.0 = math:log(1.0),
+ badarith = try math:log(float_zero()) catch error:E2 -> E2 end,
+ 0.0 = math:log(1.0),
+ %% An old-fashioned exception here just so as to test this case also
+ {'EXIT', _} = (catch fp_mult(3.23e133, 3.57e257)),
+ 0.0 = math:log(1.0),
+ badarith = try fp_div(5.0, 0.0) catch error:E3 -> E3 end,
+ 0.0 = math:log(1.0),
+ ok.
+
+fp_mult(X, Y) -> X * Y.
+
+fp_div(X, Y) -> X / Y.
+
+%% The following two function definitions appear here just to shut
+%% off 'expression will fail with a badarg' warnings from the compiler
+
+float_zero() -> 0.0.
+
+float_minus_one() -> -1.0.
+
+%%--------------------------------------------------------------------
+%% Test that erl_printf_format.c:fmt_double() does not leak pending FP
+%% exceptions to subsequent code. This used to break x87 FP code on
+%% 32-bit x86. Based on a problem report from Richard Carlsson.
+
+test_fmt_double_fpe_leak() ->
+ test_fmt_double_fpe_leak(float_zero(), int_two()),
+ ok.
+
+%% We need the specific sequence of erlang:display/1 on a float that
+%% triggers faulting ops in fmt_double() followed by a simple FP BIF.
+%% We also need to repeat this at least three times.
+test_fmt_double_fpe_leak(X, Y) ->
+ erlang:display(X), _ = math:log10(Y),
+ erlang:display(X), _ = math:log10(Y),
+ erlang:display(X), _ = math:log10(Y),
+ erlang:display(X), _ = math:log10(Y),
+ erlang:display(X),
+ math:log10(Y).
+
+int_two() -> 2.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_fun.erl b/lib/hipe/test/basic_SUITE_data/basic_fun.erl
new file mode 100644
index 0000000000..18ba7fdb3f
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_fun.erl
@@ -0,0 +1,124 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests for correct handling of funs.
+%%%-------------------------------------------------------------------
+-module(basic_fun).
+
+-export([test/0]).
+
+-export([dummy_foo/4, add1/1, test_fun03/0]).
+
+test() ->
+ ok = test_calls(),
+ ok = test_is_function(),
+ ok = test_is_function2(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests function and fun calls.
+
+test_calls() ->
+ ok = test_apply_call(?MODULE, dummy_foo),
+ ok = test_fun_call(fun dummy_foo/4),
+ ok = test_fun_call(fun ?MODULE:dummy_foo/4),
+ ok.
+
+test_apply_call(M, F) ->
+ M:F(bar, 42, foo, 17).
+
+test_fun_call(Fun) ->
+ Fun(bar, 42, foo, 17).
+
+dummy_foo(_, _, foo, _) -> ok.
+
+%%--------------------------------------------------------------------
+%% Tests handling of funs out of exported functions and 2-tuple funs.
+
+test_fun03() ->
+ MFPair = add1_as_2tuple(),
+ 4712 = do_call(add1_as_export(), 4711),
+ {badfun, MFPair} = try do_call(MFPair, 88) catch error:Err -> Err end,
+ true = do_guard(add1_as_export()),
+ false = do_guard(MFPair), % 2-tuples do not satisfy is_function/1
+ ok.
+
+do_call(F, X) -> F(X).
+
+do_guard(F) when is_function(F) -> true;
+do_guard(_) -> false.
+
+add1_as_export() -> fun ?MODULE:add1/1.
+
+add1_as_2tuple() -> {?MODULE, add1}.
+
+add1(X) -> X+1.
+
+%%--------------------------------------------------------------------
+%% Tests the is_function guard and BIF.
+
+test_is_function() ->
+ Fun = fun (X, foo) -> dummy_foo(X, mnesia_lib, foo, [X]) end,
+ ok = test_when_guard(Fun),
+ ok = test_if_guard(Fun),
+ ok.
+
+test_when_guard(X) when is_function(X) -> ok.
+
+test_if_guard(X) ->
+ if is_function(X) -> ok;
+ true -> weird
+ end.
+
+%%--------------------------------------------------------------------
+%% Tests the is_function2 guard and BIF.
+
+test_is_function2() ->
+ ok = test_guard(),
+ ok = test_guard2(),
+ ok = test_call(),
+ ok.
+
+test_guard() ->
+ zero_fun = test_f2(fun () -> ok end),
+ unary_fun = test_f2(fun(X) -> X end),
+ binary_fun = test_f2(fun (X, Y) -> {X, Y} end),
+ no_fun = test_f2(gazonk),
+ ok.
+
+test_f2(Fun) when is_function(Fun, 0) ->
+ zero_fun;
+test_f2(Fun) when is_function(Fun, 1) ->
+ unary_fun;
+test_f2(Fun) when is_function(Fun, 2) ->
+ binary_fun;
+test_f2(_) ->
+ no_fun.
+
+test_guard2() ->
+ zero_fun = test_f2_n(fun () -> ok end, 0),
+ unary_fun = test_f2_n(fun (X) -> X end, 1),
+ binary_fun = test_f2_n(fun (X, Y) -> {X, Y} end, 2),
+ no_fun = test_f2_n(gazonk, 0),
+ ok.
+
+test_f2_n(F, N) when is_function(F, N) ->
+ case N of
+ 0 -> zero_fun;
+ 1 -> unary_fun;
+ 2 -> binary_fun
+ end;
+test_f2_n(_, _) ->
+ no_fun.
+
+test_call() ->
+ true = test_fn2(fun (X, Y) -> {X,Y} end, 2),
+ false = test_fn2(fun (X, Y) -> {X,Y} end, 3),
+ false = test_fn2(gazonk, 2),
+ {'EXIT', {badarg, _TR1}} = (catch test_fn2(gazonk, gazonk)),
+ {'EXIT', {badarg, _TR2}} = (catch test_fn2(fun (X, Y) -> {X, Y} end, gazonk)),
+ ok.
+
+test_fn2(F, N) ->
+ is_function(F, N).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl
new file mode 100644
index 0000000000..81eeed7c3b
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl
@@ -0,0 +1,164 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests for correct handling of guards and guard BIFs.
+%%%-------------------------------------------------------------------
+-module(basic_guards).
+
+-export([test/0]).
+%% Prevent the inlining of the following functions
+-export([bad_arith/0, bad_tuple/0, is_strange_guard/0]).
+
+test() ->
+ ok = guard0(4.2),
+ ok = guard1([foo]),
+ ok = test_guard2(),
+ ok = test_guard3(),
+ ok = test_guard4(),
+ ok = test_is_boolean(),
+ ok = test_bad_guards(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+guard0(X) when X /= 0, is_float(X) ->
+ ok.
+
+guard1(X) when is_atom(X) orelse is_float(X) ->
+ error1;
+guard1(X) when is_reference(hd(X)) ->
+ error2;
+guard1(X) when is_integer(hd(X)) ->
+ error3;
+guard1(X) when hd(X) == foo ->
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_guard2() ->
+ ok1 = guard2(true),
+ not_boolean = guard2(42),
+ ok2 = guard2(false),
+ ok.
+
+guard2(X) when X -> % gets transformed to: is_boolean(X), X =:= true
+ ok1;
+guard2(X) when X =:= false ->
+ ok2;
+guard2(_) ->
+ not_boolean.
+
+%%--------------------------------------------------------------------
+
+-define(is_foo(X), (is_atom(X) or (is_tuple(X) and (element(1, X) =:= 'foo')))).
+
+test_guard3() ->
+ no = f('foo'),
+ yes = f({'foo', 42}),
+ no = f(42),
+ ok.
+
+f(X) when ?is_foo(X) -> yes;
+f(_) -> no.
+
+%%--------------------------------------------------------------------
+
+-define(EXT_REF, <<131,114,0,3,100,0,19,114,101,102,95,116,101,115,116,95,98,117,103,64,103,111,114,98,97,103,2,0,0,0,125,0,0,0,0,0,0,0,0>>).
+
+test_guard4() ->
+ yes = is_ref(make_ref()),
+ no = is_ref(gazonk),
+ yes = is_ref(an_external_ref(?EXT_REF)),
+ ok.
+
+is_ref(Ref) when is_reference(Ref) -> yes;
+is_ref(_Ref) -> no.
+
+an_external_ref(Bin) ->
+ binary_to_term(Bin).
+
+%%--------------------------------------------------------------------
+
+test_is_boolean() ->
+ ok = is_boolean_in_if(),
+ ok = is_boolean_in_guard().
+
+is_boolean_in_if() ->
+ ok1 = tif(true),
+ ok2 = tif(false),
+ not_bool = tif(other),
+ ok.
+
+is_boolean_in_guard() ->
+ ok = tg(true),
+ ok = tg(false),
+ not_bool = tg(other),
+ ok.
+
+tif(V) ->
+ Yes = yes(), %% just to prevent the optimizer removing this
+ if
+ %% the following line generates an is_boolean instruction
+ V, Yes == yes ->
+ %% while the following one does not (?!)
+ %% Yes == yes, V ->
+ ok1;
+ not(not(not(V))) ->
+ ok2;
+ V ->
+ ok3;
+ true ->
+ not_bool
+ end.
+
+tg(V) when is_boolean(V) ->
+ ok;
+tg(_) ->
+ not_bool.
+
+yes() -> yes.
+
+%%--------------------------------------------------------------------
+%% original test by Bjorn G
+
+test_bad_guards() ->
+ ok = bad_arith(),
+ ok = bad_tuple(),
+ ok = is_strange_guard(),
+ ok.
+
+bad_arith() ->
+ 13 = bad_arith1(1, 12),
+ 42 = bad_arith1(1, infinity),
+ 42 = bad_arith1(infinity, 1),
+ 42 = bad_arith2(infinity, 1),
+ 42 = bad_arith3(inf),
+ 42 = bad_arith4(infinity, 1),
+ ok.
+
+bad_arith1(T1, T2) when (T1 + T2) < 17 -> T1 + T2;
+bad_arith1(_, _) -> 42.
+
+bad_arith2(T1, T2) when (T1 * T2) < 17 -> T1 * T2;
+bad_arith2(_, _) -> 42.
+
+bad_arith3(T) when (bnot T) < 17 -> T;
+bad_arith3(_) -> 42.
+
+bad_arith4(T1, T2) when (T1 bsr T2) < 10 -> T1 bsr T2;
+bad_arith4(_, _) -> 42.
+
+bad_tuple() ->
+ error = bad_tuple1(a),
+ error = bad_tuple1({a, b}),
+ x = bad_tuple1({x, b}),
+ y = bad_tuple1({a, b, y}),
+ ok.
+
+bad_tuple1(T) when element(1, T) =:= x -> x;
+bad_tuple1(T) when element(3, T) =:= y -> y;
+bad_tuple1(_) -> error.
+
+is_strange_guard() when is_tuple({1, bar, length([1, 2, 3, 4]), self()}) -> ok;
+is_strange_guard() -> error.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl
new file mode 100644
index 0000000000..4c08064670
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl
@@ -0,0 +1,73 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that depend on the compiler inliner being turned on.
+%%%-------------------------------------------------------------------
+-module(basic_inline_function).
+
+-export([test/0]).
+
+-compile({inline, [{to_objects, 3}]}).
+
+test() ->
+ ok = test_inline_match(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_inline_match() ->
+ bad_object = test1(a, {binary, foo, set}, c),
+ bad_object = test2(a, {binary, foo, set}, c),
+ bad_object = test3(a, {binary, foo, set}, c),
+ ok.
+
+%% Inlined
+test1(KeysObjs, C, Ts) ->
+ case catch to_objects(KeysObjs, C, Ts) of
+ {'EXIT', _} ->
+ bad_object;
+ ok ->
+ ok
+ end.
+
+%% "Inlined" by hand
+test2(KeysObjs, C, _Ts) ->
+ case catch (case C of
+ {binary, _, set} ->
+ <<_ObjSz0:32, _T/binary>> = KeysObjs;
+ _ -> ok
+ end) of
+ {'EXIT', _} ->
+ bad_object;
+ ok ->
+ ok
+ end.
+
+%% Not inlined
+test3(KeysObjs, C, Ts) ->
+ case catch fto_objects(KeysObjs, C, Ts) of
+ {'EXIT', _} ->
+ bad_object;
+ ok ->
+ ok
+ end.
+
+%% Inlined.
+to_objects(Bin, {binary, _, set}, _Ts) ->
+ <<_ObjSz0:32, _T/binary>> = Bin,
+ ok;
+to_objects(<<_ObjSz0:32, _T/binary>> ,_, _) ->
+ ok;
+to_objects(_Bin, _, _Ts) ->
+ ok.
+
+%% Not Inlined.
+fto_objects(Bin, {binary, _, set}, _Ts) ->
+ <<_ObjSz0:32, _T/binary>> = Bin,
+ ok;
+fto_objects(<<_ObjSz0:32, _T/binary>> ,_,_) ->
+ ok;
+fto_objects(_Bin, _, _Ts) ->
+ ok.
+
diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl
new file mode 100644
index 0000000000..306c6a39ce
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl
@@ -0,0 +1,31 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that depend on the compiler inliner being turned on.
+%%%-------------------------------------------------------------------
+-module(basic_inline_module).
+
+-export([test/0]).
+
+-compile([inline]). %% necessary for these tests
+
+test() ->
+ ok = test_case_end_atom(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests whether the translation of a case_end instruction works even
+%% when an exception (no matching case pattern) is to be raised.
+
+test_case_end_atom() ->
+ {'EXIT',{{case_clause,some_atom},_Trace}} = (catch test_case_stm_inlining()),
+ ok.
+
+test_case_stm_inlining() ->
+ case some_atom() of
+ another_atom -> strange_result
+ end.
+
+some_atom() ->
+ some_atom.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl
new file mode 100644
index 0000000000..73367c5c45
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl
@@ -0,0 +1,326 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples, mostly taken from the mailing list, that
+%%% crashed the BEAM compiler or gave an internal error at some point.
+%%%-------------------------------------------------------------------
+-module(basic_issues_beam).
+
+-export([test/0]).
+
+test() ->
+ ok = test_crash_R10_hinde(),
+ ok = test_error_R10_mander(),
+ ok = test_error_R11_bjorklund(),
+ ok = test_error_R11_rath(),
+ ok = test_error_R12_empty_bin_rec(),
+ ok = test_bug_R12_cornish(),
+ ok = test_crash_R12_morris(),
+ ok = test_error_R13_almeida(),
+ ok = test_error_R13B01_fisher(),
+ ok = test_error_R13B01_sawatari(),
+ ok = test_error_R13B01_whongo(),
+ ok = test_error_R16B03_norell(),
+ ok = test_error_try_wings(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Fisher R10 compiler crash
+%%--------------------------------------------------------------------
+
+-record(r, {a, b, c}).
+
+test_crash_R10_hinde() ->
+ rec_R10_hinde(#r{}).
+
+rec_R10_hinde(As) ->
+ case As of
+ A when A#r.b == ""; A#r.b == undefined -> ok;
+ _ -> error
+ end.
+
+%%--------------------------------------------------------------------
+%% From: Peter-Henry Mander
+%% Date: 27 Jan, 2005
+%%
+%% I managed to isolate a non-critical BEAM compilation error
+%% (internal error in v3_codegen) when compiling the following code:
+%%--------------------------------------------------------------------
+
+test_error_R10_mander() ->
+ try just_compile_me_R10() catch _:_ -> ok end.
+
+just_compile_me_R10() ->
+ URI_Before =
+ {absoluteURI,
+ {scheme, fun() -> nil end},
+ {hier_part,
+ {net_path,
+ {srvr,
+ {userinfo, nil},
+ fun() -> nil end},
+ nil},
+ {port, nil}}},
+ {absoluteURI,
+ {scheme, _},
+ {hier_part,
+ {net_path,
+ {srvr,
+ {userinfo, nil},
+ _HostportBefore},
+ nil},
+ {port, nil}}} = URI_Before,
+ %% ... some funky code ommitted, not relevant ...
+ {absoluteURI,
+ {scheme, _},
+ {hier_part,
+ {net_path,
+ {srvr,
+ {userinfo, nil},
+ HostportAfter},
+ nil},
+ {port, nil}}} = URI_Before,
+ %% NOTE: I intended to write URI_After instead of URI_Before
+ %% but the accident revealed that when you add the line below,
+ %% it causes internal error in v3_codegen on compilation
+ {hostport, {hostname, "HostName"}, {port, nil}} = HostportAfter,
+ ok.
+
+%%--------------------------------------------------------------------
+%% From: Martin Bjorklund
+%% Date: Aug 16, 2006
+%%
+%% I found this compiler bug in R10B-10 and R11B-0.
+%%
+%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 18
+%% ./bjorklund_R11compiler_bug.erl:none: internal error in beam_clean;
+%% crash reason: {{case_clause,{'EXIT',{undefined_label,18}}},
+%% [{compile,'-select_passes/2-anonymous-2-',2},
+%% {compile,'-internal_comp/4-anonymous-1-',2},
+%% {compile,fold_comp,3},
+%% {compile,internal_comp,4},
+%% {compile,internal,3}]}
+%%--------------------------------------------------------------------
+
+test_error_R11_bjorklund() ->
+ just_compile_me_R11_bjorklund().
+
+just_compile_me_R11_bjorklund() ->
+ G = fun() -> ok end,
+ try
+ G() %% fun() -> ok end
+ after
+ fun({A, B}) -> A + B end
+ end.
+
+%%--------------------------------------------------------------------
+%% From: Tim Rath
+%% Date: Sep 13, 2006
+%% Subject: Compiler bug not quite fixed
+%%
+%%
+%% I saw a compiler bug posted to the list by Martin Bjorklund that
+%% appeared to be exactly the problem I'm seeing, and then noticed
+%% that this was fixed in R11B-1. Unfortunately, though R11B-1 appears
+%% to fix the code submitted by Martin, it does not fix my case.
+%%
+%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 13
+%% ./rath_R11compiler_bug.erl:none: internal error in beam_clean;
+%% crash reason: {{case_clause,{'EXIT',{undefined_label,13}}},
+%% [{compile,'-select_passes/2-anonymous-2-',2},
+%% {compile,'-internal_comp/4-anonymous-1-',2},
+%% {compile,fold_comp,3},
+%% {compile,internal_comp,4},
+%% {compile,internal,3}]}
+%%--------------------------------------------------------------------
+
+test_error_R11_rath() ->
+ just_compile_me_R11_rath().
+
+just_compile_me_R11_rath() ->
+ A = {6},
+ try
+ io:fwrite("")
+ after
+ fun () ->
+ fun () -> {_} = A end
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Program that crashed the R12B-0 compiler: internal error in v3_codegen
+%%----------------------------------------------------------------------
+
+-record(rec, {a = <<>> :: binary(), b = 42 :: integer()}).
+
+test_error_R12_empty_bin_rec() ->
+ 42 = test_empty_bin_rec(#rec{}),
+ ok.
+
+test_empty_bin_rec(R) ->
+ #rec{a = <<>>} = R,
+ R#rec.b.
+
+%%----------------------------------------------------------------------
+%% From: Simon Cornish
+%% Date: Jan 13, 2008
+%%
+%% The attached Erlang code demonstrates an R12B-0 bug with funs.
+%% Compile and evaluate the two die/1 calls for two different failure modes.
+%% It seems to me that the live register check for call_fun is off by one.
+%%----------------------------------------------------------------------
+
+-record(b, {c}).
+
+test_bug_R12_cornish() ->
+ {a2, a} = die(a),
+ {a2, {b, c}} = die({b, c}),
+ ok.
+
+die(A) ->
+ F = fun() -> {ok, A} end,
+ if A#b.c =:= [] -> one;
+ true ->
+ case F() of
+ {ok, A2} -> {a2, A2};
+ _ -> three
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% From: Hunter Morris
+%% Date: Nov 20, 2008
+%%
+%% The following code (tested with R12B-4 or R12B-5, vanilla compiler
+%% options) produces a compiler crash. It's nonsensical, and I realise
+%% that andalso can be quite evil, but it's a crash nonetheless.
+%%----------------------------------------------------------------------
+
+test_crash_R12_morris() ->
+ foo(42).
+
+foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% From: Paulo Sergio Almeida
+%% Date: May 20, 2009
+%%
+%% The following code when compiled under R13B gives a compiler error.
+%% Function loop/1 refers to undefined label 6
+%% ./almeida_R13compiler_bug.erl:none: internal error in beam_peep;
+%% crash reason: {{case_clause,{'EXIT',{undefined_label,6}}},
+%% [{compile,'-select_passes/2-anonymous-2-',2},
+%% {compile,'-internal_comp/4-anonymous-1-',2},
+%%--------------------------------------------------------------------
+
+test_error_R13_almeida() ->
+ self() ! {backup, 42, false},
+ loop([]).
+
+loop(Tids) ->
+ receive
+ {backup, Tid, Dumping} ->
+ case Dumping of
+ false -> ok;
+ _ -> receive {logged, Tab, Tid} -> put({log, Tab}, Tid) end
+ end,
+ collect(Tid, Tids, [])
+ end.
+
+collect(_, _, _) -> ok.
+
+%%--------------------------------------------------------------------
+%% Fisher R13B01 compiler error
+%%--------------------------------------------------------------------
+
+test_error_R13B01_fisher() ->
+ perform_select({foo, "42"}).
+
+perform_select({Type, Keyval}) ->
+ try
+ if is_atom(Type) andalso length(Keyval) > 0 -> ok;
+ true -> ok
+ end
+ catch
+ _:_ -> fail
+ end.
+
+%%--------------------------------------------------------------------
+%% From: Mikage Sawatari
+%% Date: Jun 12, 2009
+%%
+%% I have the following compilation problem on Erlang R13B01.
+%% Compiler reports "Internal consistency check failed".
+%%--------------------------------------------------------------------
+
+test_error_R13B01_sawatari() ->
+ test_sawatari([1, null, 3], <<1, 2, 3>>).
+
+test_sawatari([], _Bin) -> ok;
+test_sawatari([H|T], Bin) ->
+ _ = case H of
+ null -> <<Bin/binary>>;
+ _ -> ok
+ end,
+ test_sawatari(T, Bin).
+
+%%--------------------------------------------------------------------
+
+test_error_R13B01_whongo() ->
+ S = "gazonk",
+ S = orgno_alphanum(S),
+ ok.
+
+orgno_alphanum(Cs) ->
+ [C || C <- Cs, ((C >= $0) andalso (C =< $9))
+ orelse ((C >= $a) andalso (C =< $z))
+ orelse ((C >= $A) andalso (C =< $Z))].
+
+%%--------------------------------------------------------------------
+%% I'm getting an Internal Consistency Check error when attempting to
+%% build Wings3D on Mac OS X 10.4.2 (Erlang OTP R10B-6):
+%%
+%% erlc -pa /ebin +warn_unused_vars -I/include -I ../e3d -W +debug_info
+%% '-Dwings_version="0.98.31"' -pa ../ebin -o../ebin wings_color.erl
+%% wings_color: function internal_rgb_to_hsv/3+97:
+%% Internal consistency check failed - please report this bug.
+%% Instruction: {test,is_eq_exact,{f,80},[{x,0},{atom,error}]}
+%% Error: {unsafe_instruction,{float_error_state,cleared}}:
+%%
+%% The problem is the interaction of the 'try' construct with the
+%% handling of FP exceptions.
+%%--------------------------------------------------------------------
+
+test_error_try_wings() ->
+ %% a call with a possible FP exception
+ {199.99999999999997, 0.045454545454545456, 44} = rgb_to_hsv(42, 43, 44),
+ ok.
+
+rgb_to_hsv(R, G, B) ->
+ Max = lists:max([R, G, B]),
+ Min = lists:min([R, G, B]),
+ V = Max,
+ {Hue, Sat} = try
+ {if Min == B -> (G-Min)/(R+G-2.0*Min);
+ Min == R -> (1.0+(B-Min)/(B+G-2.0*Min));
+ Min == G -> (2.0+(R-Min)/(B+R-2.0*Min))
+ end * 120, (Max-Min)/Max}
+ catch
+ error:badarith -> {undefined, 0.0}
+ end,
+ {Hue, Sat, V}.
+
+%%--------------------------------------------------------------------
+%% From: Ulf Norell
+%% Date: Feb 28, 2014
+%%
+%% This caused an internal error in v3_codegen
+%%--------------------------------------------------------------------
+
+test_error_R16B03_norell() ->
+ test_error_R16B03_norell(#r{}, gazonk).
+
+test_error_R16B03_norell(Rec, Tag) ->
+ is_record(Rec, Tag, 3) orelse ok.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
new file mode 100644
index 0000000000..e71045bfe2
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl
@@ -0,0 +1,153 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that exhibited crashes in the HiPE compiler.
+%%%-------------------------------------------------------------------
+-module(basic_issues_hipe).
+
+-export([test/0]).
+
+%% functions that need to be exported so that they are retained.
+-export([auth/4]).
+
+test() ->
+ ok = test_dominance_trees(),
+ ok = test_merged_const(),
+ ok = test_var_pair(),
+ ok = test_bif_fails(),
+ ok = test_find_catches(),
+ ok = test_heap_allocate_trim(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% This is taken from a file sent to us by Martin Bjorklund @ Nortel
+%% on 14th November 2004. The problem was in the SSA unconvert pass.
+%%
+%% No tests here; we simply check that the HiPE compiler does not go
+%% into an infinite loop when compiling strange functions like this.
+%%--------------------------------------------------------------------
+
+auth(_, A, B, C) ->
+ auth(A, B, C, []).
+
+%%--------------------------------------------------------------------
+%% Exposed a crash in the generation of dominance trees used in SSA.
+%%--------------------------------------------------------------------
+
+-record(state, {f}).
+
+test_dominance_trees() ->
+ {ok, true} = doit(true, #state{f = true}),
+ ok.
+
+doit(Foo, S) ->
+ Fee = case Foo of
+ Bar when Bar == S#state.f; Bar == [] -> true;
+ _ -> false
+ end,
+ {ok, Fee}.
+
+%%--------------------------------------------------------------------
+%% Checks that the merging of constants in the constant table uses the
+%% appropriate comparison function for this.
+%%--------------------------------------------------------------------
+
+test_merged_const() ->
+ Const1 = {'', 1.0000},
+ Const2 = {'', 1},
+ match(Const1, Const2).
+
+match(A, A) ->
+ error;
+match(_A, _B) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% Checks that the HiPE compiler does not get confused by constant
+%% data structures similar to the internal compiler data structures.
+%%--------------------------------------------------------------------
+
+test_var_pair() ->
+ ok = var_pair([gazonk]).
+
+var_pair([_|_]) ->
+ var_pair({var, some_atom});
+var_pair(_) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% This module was causing the HiPE compiler to crash in January 2007.
+%% The culprit was an "optimization" of the BEAM compiler: postponing
+%% the save of x variables when BIFs cannot fail. This was fixed on
+%% February 1st, by making the HiPE compiler use the same functions
+%% as the BEAM compiler for deciding whether a BIF fails.
+%%--------------------------------------------------------------------
+
+test_bif_fails() ->
+ [42] = bif_fails_in_catch([42]),
+ true = bif_fails_in_try([42]),
+ ok.
+
+bif_fails_in_catch(X) ->
+ case catch get(gazonk) of
+ _ -> X
+ end.
+
+bif_fails_in_try(X) ->
+ try
+ true = X =/= []
+ catch
+ _ -> nil(X)
+ end.
+
+nil(_) -> [].
+
+%%--------------------------------------------------------------------
+%% Test that resulted in a native code compiler crash in the code of
+%% hipe_icode_exceptions:find_catches/1 when compiling find_catches/2.
+%%--------------------------------------------------------------------
+
+test_find_catches() ->
+ 42 = find_catches(a, false),
+ ok.
+
+find_catches(X, Y) ->
+ case X of
+ a when Y =:= true ->
+ catch id(X),
+ X;
+ b when Y =:= true ->
+ catch id(X),
+ X;
+ a ->
+ catch id(X),
+ 42;
+ b ->
+ catch id(X),
+ 42
+ end.
+
+id(X) -> X.
+
+%%--------------------------------------------------------------------
+%% Date: Dec 28, 2007
+%%
+%% This is a test adapted from the file sent to the Erlang mailing
+%% list by Eranga Udesh. The file did not compile because of problems
+%% with the heap_allocate instruction and stack trimming.
+%%--------------------------------------------------------------------
+
+test_heap_allocate_trim() ->
+ {abandon, 42} = get_next_retry(a, 42),
+ ok.
+
+get_next_retry(Error, Count) ->
+ case catch pair(retry_scheme, {Error, Count}) of
+ _ ->
+ case pair(Error, Count) of
+ _ -> {abandon, Count}
+ end
+ end.
+
+pair(A, B) -> {A, B}.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_lists.erl b/lib/hipe/test/basic_SUITE_data/basic_lists.erl
new file mode 100644
index 0000000000..264a7f86f6
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_lists.erl
@@ -0,0 +1,61 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that manipulate and pattern match against lists
+%%% (perhaps by calling functions from the 'lists' module).
+%%%-------------------------------------------------------------------
+-module(basic_lists).
+
+-export([test/0]).
+
+test() ->
+ ok = test_length(),
+ ok = test_lists_key(),
+ ok = test_lists_and_strings(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_length() ->
+ Len = 42,
+ Lst = mklist(Len, []),
+ Len = iterate(100, Lst),
+ ok.
+
+mklist(0, L) -> L;
+mklist(X, L) -> mklist(X-1, [X|L]).
+
+iterate(0, L) -> len(L, 0);
+iterate(X, L) -> len(L, 0), iterate(X-1, L).
+
+len([_|X], L) -> len(X, L+1);
+len([], L) -> L.
+
+%%--------------------------------------------------------------------
+
+test_lists_key() ->
+ First = {x, 42.0},
+ Second = {y, -77},
+ Third = {z, [a, b, c], {5.0}},
+ List = [First, Second, Third],
+ {value, First} = key_search_find(42, 2, List),
+ ok.
+
+key_search_find(Key, Pos, List) ->
+ case lists:keyfind(Key, Pos, List) of
+ false ->
+ false = lists:keysearch(Key, Pos, List);
+ Tuple when is_tuple(Tuple) ->
+ {value, Tuple} = lists:keysearch(Key, Pos, List)
+ end.
+
+%%--------------------------------------------------------------------
+
+test_lists_and_strings() ->
+ LL = ["H'A", " H'B", " H'C"],
+ LL2 = lists:map(fun string:strip/1, LL),
+ HexFormat = fun(X, Acc) -> {string:substr(X, 3), Acc} end,
+ {LL3,_Ret} = lists:mapfoldl(HexFormat, 0, LL2),
+ ["A", "B", "C"] = lists:sublist(LL3, 42),
+ ok.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_module_info.erl b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl
new file mode 100644
index 0000000000..cab48b10ba
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl
@@ -0,0 +1,32 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%% Date: Oct 25, 2003
+%%%
+%%% Tests whether calling module_info from the same module works.
+%%% This seems trivial, but the problem is that the module_info/[0,1]
+%%% functions that the BEAM file contains used to be dummy functions
+%%% containing crap. So, these functions could not be used for
+%%% compilation to native code and the functions that the BEAM loader
+%%% generates should have been used instead. This was a HiPE bug
+%%% reported by Dan Wallin.
+%%%-------------------------------------------------------------------
+-module(basic_module_info).
+
+-export([test/0]).
+
+test() ->
+ L = test_local_mi0_call(),
+ E = test_remote_mi1_call(),
+ {3, 3} = {L, E},
+ ok.
+
+test_local_mi0_call() ->
+ ModInfo = module_info(),
+ %% io:format("ok, ModInfo=~w\n", [ModInfo]),
+ {exports, FunList} = lists:keyfind(exports, 1, ModInfo),
+ length(FunList).
+
+test_remote_mi1_call() ->
+ FunList = ?MODULE:module_info(exports),
+ length(FunList).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl
new file mode 100644
index 0000000000..93240354a7
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl
@@ -0,0 +1,46 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that test pattern matching against terms of
+%%% various types.
+%%%-------------------------------------------------------------------
+-module(basic_pattern_match).
+
+-export([test/0]).
+
+test() ->
+ ok = test_hello_world(),
+ ok = test_list_plus_plus_match(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Trivial test to test pattern matching compilation with atoms, the
+%% correct handling of all sorts of alphanumeric types in Erlang, and
+%% conversions between them.
+
+test_hello_world() ->
+ String = gimme(string),
+ String = atom_to_list(gimme(atom)),
+ String = binary_to_list(gimme(binary)),
+ true = (list_to_atom(String) =:= gimme(atom)),
+ true = (list_to_binary(String) =:= gimme(binary)),
+ ok.
+
+gimme(string) ->
+ "hello world";
+gimme(atom) ->
+ 'hello world';
+gimme(binary) ->
+ <<"hello world">>.
+
+%%--------------------------------------------------------------------
+%% Makes sure that pattern matching expressions involving ++ work OK.
+%% The third expression caused a problem in the Erlang shell of R11B-5.
+%% It worked OK in both interpreted and compiled code.
+
+test_list_plus_plus_match() ->
+ ok = (fun("X" ++ _) -> ok end)("X"),
+ ok = (fun([$X | _]) -> ok end)("X"),
+ ok = (fun([$X] ++ _) -> ok end)("X"),
+ ok.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_random.erl b/lib/hipe/test/basic_SUITE_data/basic_random.erl
new file mode 100644
index 0000000000..783947bd31
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_random.erl
@@ -0,0 +1,238 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% A test for list handling created using the 'random' module.
+%%%-------------------------------------------------------------------
+-module(basic_random).
+
+-export([test/0]).
+
+%% It can be used as a benchmark by playing with the following defines
+-define(N, 1000).
+-define(Iter, 500).
+
+test() ->
+ ok = random(?N).
+
+random(N) ->
+ random(N, ?Iter).
+
+random(N, Iter) ->
+ random:seed(1, 2, 3),
+ t(ranlist(N, [], N*100), Iter).
+
+ranlist(0, L, _N) -> L;
+ranlist(N, L, N0) -> ranlist(N-1, [random:uniform(N0)+300 | L], N0).
+
+t(_, 0) -> ok;
+t(L, Iter) ->
+ %% io:format("Sort starting~n"),
+ sort(L),
+ t(L, Iter-1).
+
+sort([X, Y | L]) when X =< Y ->
+ split_1(X, Y, L, [], []);
+sort([X, Y | L]) ->
+ split_2(X, Y, L, [], []);
+sort(L) ->
+ L.
+
+%% Ascending.
+split_1(X, Y, [Z | L], R, Rs) when Z >= Y ->
+ split_1(Y, Z, L, [X | R], Rs);
+split_1(X, Y, [Z | L], R, Rs) when Z >= X ->
+ split_1(Z, Y, L, [X | R], Rs);
+split_1(X, Y, [Z | L], [], Rs) ->
+ split_1(X, Y, L, [Z], Rs);
+split_1(X, Y, [Z | L], R, Rs) ->
+ split_1_1(X, Y, L, R, Rs, Z);
+split_1(X, Y, [], R, Rs) ->
+ rmergel([[Y, X | R] | Rs], []).
+
+%% One out-of-order element, S.
+split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= Y ->
+ split_1_1(Y, Z, L, [X | R], Rs, S);
+split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= X ->
+ split_1_1(Z, Y, L, [X | R], Rs, S);
+split_1_1(X, Y, [Z | L], R, Rs, S) when S =< Z ->
+ split_1(S, Z, L, [], [[Y, X | R] | Rs]);
+split_1_1(X, Y, [Z | L], R, Rs, S) ->
+ split_1(Z, S, L, [], [[Y, X | R] | Rs]);
+split_1_1(X, Y, [], R, Rs, S) ->
+ rmergel([[S], [Y, X | R] | Rs], []).
+
+%% Descending.
+split_2(X, Y, [Z | L], R, Rs) when Z =< Y ->
+ split_2(Y, Z, L, [X | R], Rs);
+split_2(X, Y, [Z | L], R, Rs) when Z =< X ->
+ split_2(Z, Y, L, [X | R], Rs);
+split_2(X, Y, [Z | L], [], Rs) ->
+ split_2(X, Y, L, [Z], Rs);
+split_2(X, Y, [Z | L], R, Rs) ->
+ split_2_1(X, Y, L, R, Rs, Z);
+split_2(X, Y, [], R, Rs) ->
+ mergel([[Y, X | R] | Rs], []).
+
+split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< Y ->
+ split_2_1(Y, Z, L, [X | R], Rs, S);
+split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< X ->
+ split_2_1(Z, Y, L, [X | R], Rs, S);
+split_2_1(X, Y, [Z | L], R, Rs, S) when S > Z ->
+ split_2(S, Z, L, [], [[Y, X | R] | Rs]);
+split_2_1(X, Y, [Z | L], R, Rs, S) ->
+ split_2(Z, S, L, [], [[Y, X | R] | Rs]);
+split_2_1(X, Y, [], R, Rs, S) ->
+ mergel([[S], [Y, X | R] | Rs], []).
+
+mergel([[] | L], Acc) ->
+ mergel(L, Acc);
+mergel([A, [H2 | T2], [H3 | T3] | L], Acc) ->
+ mergel(L, [merge3_1(A, [], H2, T2, H3, T3) | Acc]);
+mergel([A, [H | T]], Acc) ->
+ rmergel([merge2_1(A, H, T, []) | Acc], []);
+mergel([L], []) ->
+ L;
+mergel([L], Acc) ->
+ rmergel([lists:reverse(L, []) | Acc], []);
+mergel([], []) ->
+ [];
+mergel([], Acc) ->
+ rmergel(Acc, []);
+mergel([A, [] | L], Acc) ->
+ mergel([A | L], Acc);
+mergel([A, B, [] | L], Acc) ->
+ mergel([A, B | L], Acc).
+
+rmergel([A, [H2 | T2], [H3 | T3] | L], Acc) ->
+ rmergel(L, [rmerge3_1(A, [], H2, T2, H3, T3) | Acc]);
+rmergel([A, [H | T]], Acc) ->
+ mergel([rmerge2_1(A, H, T, []) | Acc], []);
+rmergel([L], Acc) ->
+ mergel([lists:reverse(L, []) | Acc], []);
+rmergel([], Acc) ->
+ mergel(Acc, []).
+
+%% Take L1 apart.
+merge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 =< H2 ->
+ merge3_12(T1, H1, H2, T2, H3, T3, M);
+merge3_1([H1 | T1], M, H2, T2, H3, T3) ->
+ merge3_21(T1, H1, H2, T2, H3, T3, M);
+merge3_1(_nil, M, H2, T2, H3, T3) when H2 =< H3 ->
+ merge2_1(T2, H3, T3, [H2 | M]);
+merge3_1(_nil, M, H2, T2, H3, T3) ->
+ merge2_1(T3, H2, T2, [H3 | M]).
+
+%% Take L2 apart.
+merge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 =< H2 ->
+ merge3_12(T1, H1, H2, T2, H3, T3, M);
+merge3_2(T1, H1, M, [H2 | T2], H3, T3) ->
+ merge3_21(T1, H1, H2, T2, H3, T3, M);
+merge3_2(T1, H1, M, _nil, H3, T3) when H1 =< H3 ->
+ merge2_1(T1, H3, T3, [H1 | M]);
+merge3_2(T1, H1, M, _nil, H3, T3) ->
+ merge2_1(T3, H1, T1, [H3 | M]).
+
+%% H1 <= H2. Inlined.
+merge3_12(T1, H1, H2, T2, H3, T3, M) when H3 < H1 ->
+ merge3_12_3(T1, H1, H2, T2, [H3 | M], T3);
+merge3_12(T1, H1, H2, T2, H3, T3, M) ->
+ merge3_1(T1, [H1 | M], H2, T2, H3, T3).
+
+%% H1 <= H2, take L3 apart.
+merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H1 ->
+ merge3_12_3(T1, H1, H2, T2, [H3 | M], T3);
+merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) ->
+ merge3_1(T1, [H1 | M], H2, T2, H3, T3);
+merge3_12_3(T1, H1, H2, T2, M, _nil) ->
+ merge2_1(T1, H2, T2, [H1 | M]).
+
+%% H1 > H2. Inlined.
+merge3_21(T1, H1, H2, T2, H3, T3, M) when H3 < H2 ->
+ merge3_21_3(T1, H1, H2, T2, [H3 | M], T3);
+merge3_21(T1, H1, H2, T2, H3, T3, M) ->
+ merge3_2(T1, H1, [H2 | M], T2, H3, T3).
+
+%% H1 > H2, take L3 apart.
+merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H2 ->
+ merge3_21_3(T1, H1, H2, T2, [H3 | M], T3);
+merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) ->
+ merge3_2(T1, H1, [H2 | M], T2, H3, T3);
+merge3_21_3(T1, H1, H2, T2, M, _nil) ->
+ merge2_1(T2, H1, T1, [H2 | M]).
+
+%% Take L1 apart.
+rmerge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 > H2 ->
+ rmerge3_12(T1, H1, H2, T2, H3, T3, M);
+rmerge3_1([H1 | T1], M, H2, T2, H3, T3) ->
+ rmerge3_21(T1, H1, H2, T2, H3, T3, M);
+rmerge3_1(_nil, M, H2, T2, H3, T3) when H2 > H3 ->
+ rmerge2_1(T2, H3, T3, [H2 | M]);
+rmerge3_1(_nil, M, H2, T2, H3, T3) ->
+ rmerge2_1(T3, H2, T2, [H3 | M]).
+
+%% Take L2 apart.
+rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 > H2 ->
+ rmerge3_12(T1, H1, H2, T2, H3, T3, M);
+rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) ->
+ rmerge3_21(T1, H1, H2, T2, H3, T3, M);
+rmerge3_2(T1, H1, M, _nil, H3, T3) when H1 > H3 ->
+ rmerge2_1(T1, H3, T3, [H1 | M]);
+rmerge3_2(T1, H1, M, _nil, H3, T3) ->
+ rmerge2_1(T3, H1, T1, [H3 | M]).
+
+%% H1 > H2. Inlined.
+rmerge3_12(T1, H1, H2, T2, H3, T3, M) when H3 >= H1 ->
+ rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3);
+rmerge3_12(T1, H1, H2, T2, H3, T3, M) ->
+ rmerge3_1(T1, [H1 | M], H2, T2, H3, T3).
+
+%% H1 > H2, take L3 apart.
+rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H1 ->
+ rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3);
+rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) ->
+ rmerge3_1(T1, [H1 | M], H2, T2, H3, T3);
+rmerge3_12_3(T1, H1, H2, T2, M, _nil) ->
+ rmerge2_1(T1, H2, T2, [H1 | M]).
+
+%% H1 =< H2. Inlined.
+rmerge3_21(T1, H1, H2, T2, H3, T3, M) when H3 >= H2 ->
+ rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3);
+rmerge3_21(T1, H1, H2, T2, H3, T3, M) ->
+ rmerge3_2(T1, H1, [H2 | M], T2, H3, T3).
+
+%% H1 =< H2, take L3 apart.
+rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H2 ->
+ rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3);
+rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) ->
+ rmerge3_2(T1, H1, [H2 | M], T2, H3, T3);
+rmerge3_21_3(T1, H1, H2, T2, M, _nil) ->
+ rmerge2_1(T2, H1, T1, [H2 | M]).
+
+merge2_1([H1 | T1], H2, T2, M) when H2 < H1 ->
+ merge2_2(T1, H1, T2, [H2 | M]);
+merge2_1([H1 | T1], H2, T2, M) ->
+ merge2_1(T1, H2, T2, [H1 | M]);
+merge2_1(_nil, H2, T2, M) ->
+ lists:reverse(T2, [H2 | M]).
+
+merge2_2(T1, H1, [H2 | T2], M) when H1 < H2 ->
+ merge2_1(T1, H2, T2, [H1 | M]);
+merge2_2(T1, H1, [H2 | T2], M) ->
+ merge2_2(T1, H1, T2, [H2 | M]);
+merge2_2(T1, H1, _nil, M) ->
+ lists:reverse(T1, [H1 | M]).
+
+rmerge2_1([H1 | T1], H2, T2, M) when H2 >= H1 ->
+ rmerge2_2(T1, H1, T2, [H2 | M]);
+rmerge2_1([H1 | T1], H2, T2, M) ->
+ rmerge2_1(T1, H2, T2, [H1 | M]);
+rmerge2_1(_nil, H2, T2, M) ->
+ lists:reverse(T2, [H2 | M]).
+
+rmerge2_2(T1, H1, [H2 | T2], M) when H1 >= H2 ->
+ rmerge2_1(T1, H2, T2, [H1 | M]);
+rmerge2_2(T1, H1, [H2 | T2], M) ->
+ rmerge2_2(T1, H1, T2, [H2 | M]);
+rmerge2_2(T1, H1, _nil, M) ->
+ lists:reverse(T1, [H1 | M]).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl
new file mode 100644
index 0000000000..5f865d7b7a
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl
@@ -0,0 +1,56 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains code examples that test correct handling of receives.
+%%%-------------------------------------------------------------------
+-module(basic_receive).
+
+-export([test/0]).
+
+test() ->
+ ok = test_wait_timeout(),
+ ok = test_double_timeout(),
+ ok = test_reschedule(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_wait_timeout() ->
+ receive after 42 -> ok end.
+
+%%--------------------------------------------------------------------
+
+test_double_timeout() ->
+ self() ! foo,
+ self() ! another_foo,
+ receive
+ non_existent -> weird
+ after 0 -> timeout
+ end,
+ receive
+ foo -> ok
+ after 1000 -> timeout
+ end.
+
+%%--------------------------------------------------------------------
+%% Check that RESCHEDULE returns from BIFs work.
+
+test_reschedule() ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ First = self(),
+ Second = spawn(fun() -> doit(First) end),
+ receive
+ Second -> ok
+ end,
+ receive
+ after 42 -> ok
+ end,
+ erts_debug:set_internal_state(hipe_test_reschedule_resume, Second),
+ ok.
+
+doit(First) ->
+ First ! self(),
+ erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1).
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_records.erl b/lib/hipe/test/basic_SUITE_data/basic_records.erl
new file mode 100644
index 0000000000..cbb451196c
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_records.erl
@@ -0,0 +1,28 @@
+%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that manipulate and pattern match against records.
+%%%-------------------------------------------------------------------
+-module(basic_records).
+
+-export([test/0]).
+
+test() ->
+ ok = test_rec1(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+-record(r, {ra}).
+-record(s, {sa, sb, sc, sd}).
+
+test_rec1() ->
+ R = #r{},
+ S = #s{},
+ S1 = S#s{sc=R, sd=1},
+ R1 = S1#s.sc,
+ undefined = R1#r.ra,
+ ok.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl
new file mode 100644
index 0000000000..0f94320a33
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl
@@ -0,0 +1,65 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests the strength reduction component of the HiPE compiler.
+%%%-------------------------------------------------------------------
+-module(basic_strength_reduce).
+
+-export([test/0]).
+%% These functions are exported so as to not remove them by inlining
+-export([crash_0/1, crash_1/1, crash_2/1, crash_3/1, bug_div_2N/1]).
+
+test() ->
+ ok = test_strength_reduce1(),
+ ok.
+
+%%--------------------------------------------------------------------
+
+test_strength_reduce1() ->
+ ok = crash_0(0),
+ ok = crash_1(42),
+ ok = crash_2(42),
+ ok = crash_3(42),
+ 5 = 42 bsr 3 = bug_div_2N(42),
+ -6 = -42 bsr 3 = bug_div_2N(-42) - 1,
+ ok.
+
+%% This is a crash report by Peter Wang (10 July 2007) triggering an
+%% R11B-5 crash: strength reduction could not handle calls with no
+%% destination
+crash_0(A) ->
+ case A of
+ 0 ->
+ A div 8,
+ ok
+ end.
+
+%% The above was simplified to the following which showed another
+%% crash, this time on RTL
+crash_1(A) when is_integer(A), A >= 0 ->
+ A div 8,
+ ok.
+
+%% A similar crash like the first one, but in a different place in the
+%% code, was triggered by the following code
+crash_2(A) when is_integer(A), A >= 0 ->
+ A div 1,
+ ok.
+
+%% A crash similar to the first one happened in the following code
+crash_3(A) ->
+ case A of
+ 42 ->
+ A * 0,
+ ok
+ end.
+
+%% Strength reduction for div/2 and rem/2 with a power of 2
+%% should be performed only for non-negative integers
+bug_div_2N(X) when is_integer(X), X >= 0 ->
+ X div 8;
+bug_div_2N(X) when is_integer(X), X < 0 ->
+ X div 8.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_switches.erl b/lib/hipe/test/basic_SUITE_data/basic_switches.erl
new file mode 100644
index 0000000000..0a7ae5b8b7
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_switches.erl
@@ -0,0 +1,52 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests for pattern matching switches.
+%%%-------------------------------------------------------------------
+-module(basic_switches).
+
+-export([test/0]).
+
+test() ->
+ ok = test_switch_mix(),
+ ok.
+
+%%---------------------------------------------------------------------
+
+-define(BIG1, 21323233222132323322).
+-define(BIG2, 4242424242424242424242424242424242).
+
+test_switch_mix() ->
+ small1 = t(42),
+ small2 = t(17),
+ big1 = t(?BIG1),
+ big2 = t(?BIG2),
+ atom = t(foo),
+ pid = t(self()),
+ float = t(4.2),
+ ok.
+
+t(V) ->
+ S = self(),
+ case V of
+ 42 -> small1;
+ 17 -> small2;
+ ?BIG1 -> big1;
+ ?BIG2 -> big2;
+ 1 -> no;
+ 2 -> no;
+ 3 -> no;
+ 4 -> no;
+ 5 -> no;
+ 6 -> no;
+ 7 -> no;
+ 8 -> no;
+ foo -> atom;
+ 9 -> no;
+ 4.2 -> float;
+ S -> pid;
+ _ -> no
+ end.
+
+%%---------------------------------------------------------------------
diff --git a/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl
new file mode 100644
index 0000000000..0124f13df6
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl
@@ -0,0 +1,39 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that check that tail recursion optimization occurs.
+%%%-------------------------------------------------------------------
+-module(basic_tail_rec).
+
+-export([test/0]).
+-export([app0/2]). %% used in an apply/3 call
+
+test() ->
+ ok = test_app_tail(),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Written by Mikael Pettersson: check that apply is tail recursive.
+
+%% Increased the following quantity from 20 to 30 so that the test
+%% remains valid even with the naive register allocator. - Kostis
+-define(SIZE_INCREASE, 30).
+
+test_app_tail() ->
+ Inc = start(400),
+ %% io:format("Inc ~w\n", [Inc]),
+ case Inc > ?SIZE_INCREASE of
+ true ->
+ {error, "apply/3 is not tail recursive in native code"};
+ false ->
+ ok
+ end.
+
+start(N) ->
+ app0(N, hipe_bifs:nstack_used_size()).
+
+app0(0, Size0) ->
+ hipe_bifs:nstack_used_size() - Size0;
+app0(N, Size) ->
+ apply(?MODULE, app0, [N-1, Size]).
diff --git a/lib/hipe/test/basic_SUITE_data/basic_tuples.erl b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl
new file mode 100644
index 0000000000..94c187e364
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl
@@ -0,0 +1,177 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%-------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Contains tests that manipulate and pattern match against tuples.
+%%%-------------------------------------------------------------------
+-module(basic_tuples).
+
+-export([test/0]).
+
+test() ->
+ Num = 4711,
+ ok = test_match({}, {1}, {1,2}, {1,2,3}, {1,2,3,4}, {1,2,3,4,5},
+ {1,2,3,4,5,6}, {1,2,3,4,5,6,7}, {1,2,3,4,5,6,7,8}),
+ ok = test_size({}, {a}, {{a},{b}}, {a,{b},c}),
+ ok = test_element({}, {a}, {a,b}, Num),
+ ok = test_setelement({}, {1}, {1,2}, 3, [1,2]),
+ ok = test_tuple_to_list({}, {a}, {a,b}, {a,b,c}, {a,b,c,d}, Num),
+ ok = test_list_to_tuple([], [a], [a,b], [a,b,c], [a,b,c,d], Num),
+ ok = test_tuple_with_case(),
+ ok = test_tuple_in_guard({a, b}, {a, b, c}),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests matching of tuples
+
+test_match(T0, T1, T2, T3, T4, T5, T6, T7, T8) ->
+ {} = T0,
+ {1} = T1,
+ {1, 2} = T2,
+ {1, 2, 3} = T3,
+ {1, 2, 3, 4} = T4,
+ {1, 2, 3, 4, 5} = T5,
+ {1, 2, 3, 4, 5, 6} = T6,
+ T6 = {1, 2, 3, 4, 5, 6},
+ T7 = {1, 2, 3, 4, 5, 6, 7},
+ {1, 2, 3, 4, 5, 6, 7, 8} = T8,
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests the size/1 and tuple_size/1 BIFs.
+
+test_size(T0, T1, T2, T3) ->
+ [0, 1, 2, 3] = [size(T) || T <- [T0, T1, T2, T3]],
+ [0, 1, 2, 3] = [tuple_size(T) || T <- [T0, T1, T2, T3]],
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests element/2.
+
+test_element(T0, T1, T2, N) ->
+ a = element(1, T1),
+ a = element(1, T2),
+ %% indirect calls to element/2
+ List = lists:seq(1, N),
+ Tuple = list_to_tuple(List),
+ ok = get_elements(List, Tuple, 1),
+ %% some cases that throw exceptions
+ {'EXIT', _} = (catch my_element(0, T2)),
+ {'EXIT', _} = (catch my_element(3, T2)),
+ {'EXIT', _} = (catch my_element(1, T0)),
+ {'EXIT', _} = (catch my_element(1, List)),
+ {'EXIT', _} = (catch my_element(1, N)),
+ {'EXIT', _} = (catch my_element(1.5, T2)),
+ ok.
+
+my_element(Pos, Term) ->
+ element(Pos, Term).
+
+get_elements([Element|Rest], Tuple, Pos) ->
+ Element = element(Pos, Tuple),
+ get_elements(Rest, Tuple, Pos + 1);
+get_elements([], _Tuple, _Pos) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% Tests set_element/3.
+
+test_setelement(T0, T1, Pair, Three, L) ->
+ {x} = setelement(1, T1, x),
+ {x, 2} = setelement(1, Pair, x),
+ {1, x} = setelement(2, Pair, x),
+ %% indirect calls to setelement/3
+ Tuple = list_to_tuple(lists:duplicate(2048, x)),
+ NewTuple = set_all_elements(Tuple, 1),
+ NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)),
+ %% the following cases were rewritten to use the Three
+ %% variable in this weird way so as to silence the compiler
+ {'EXIT', _} = (catch setelement(Three - Three, Pair, x)),
+ {'EXIT', _} = (catch setelement(Three, Pair, x)),
+ {'EXIT', _} = (catch setelement(Three div Three, T0, x)),
+ {'EXIT', _} = (catch setelement(Three div Three, L, x)),
+ {'EXIT', _} = (catch setelement(Three / 2, Pair, x)),
+ ok.
+
+set_all_elements(Tuple, Pos) when Pos =< tuple_size(Tuple) ->
+ set_all_elements(setelement(Pos, Tuple, Pos+7), Pos+1);
+set_all_elements(Tuple, Pos) when Pos > tuple_size(Tuple) ->
+ Tuple.
+
+%%--------------------------------------------------------------------
+%% Tests tuple_to_list/1.
+
+test_tuple_to_list(T0, T1, T2, T3, T4, Size) ->
+ [] = tuple_to_list(T0),
+ [a] = tuple_to_list(T1),
+ [a, b] = tuple_to_list(T2),
+ [a, b, c] = tuple_to_list(T3),
+ [a, b, c, d] = tuple_to_list(T4),
+ [a, b, c, d] = tuple_to_list(T4),
+ %% test a big tuple
+ List = lists:seq(1, Size),
+ Tuple = list_to_tuple(List),
+ Size = tuple_size(Tuple),
+ List = tuple_to_list(Tuple),
+ %% some cases that should result in errors
+ {'EXIT', _} = (catch my_tuple_to_list(element(2, T3))),
+ {'EXIT', _} = (catch my_tuple_to_list(Size)),
+ ok.
+
+my_tuple_to_list(X) ->
+ tuple_to_list(X).
+
+%%--------------------------------------------------------------------
+%% Tests list_to_tuple/1.
+
+test_list_to_tuple(L0, L1, L2, L3, L4, Size) ->
+ {} = list_to_tuple(L0),
+ {a} = list_to_tuple(L1),
+ {a, b} = list_to_tuple(L2),
+ {a, b, c} = list_to_tuple(L3),
+ {a, b, c, d} = list_to_tuple(L4),
+ {a, b, c, d, e} = list_to_tuple(L4++[e]),
+ %% test list_to_tuple with a big list
+ Tuple = list_to_tuple(lists:seq(1, Size)),
+ Size = tuple_size(Tuple),
+ %% some cases that should result in errors
+ {'EXIT', _} = (catch my_list_to_tuple({a,b})),
+ {'EXIT', _} = (catch my_list_to_tuple([hd(L1)|hd(L2)])),
+ ok.
+
+my_list_to_tuple(X) ->
+ list_to_tuple(X).
+
+%%--------------------------------------------------------------------
+%% Tests that a case nested inside a tuple is ok.
+%% (This was known to crash earlier versions of BEAM.)
+
+test_tuple_with_case() ->
+ {reply, true} = tuple_with_case(),
+ ok.
+
+tuple_with_case() ->
+ %% The following comments apply to the BEAM compiler.
+ void(), % Reset var count.
+ {reply, % Compiler will choose {x,1} for tuple.
+ case void() of % Call will reset var count.
+ {'EXIT', Reason} -> % Case will return in {x,1} (first free),
+ {error, Reason}; % but the tuple will be build in {x,1},
+ _ -> % so case value is lost and a circular
+ true % data element is built.
+ end}.
+
+void() -> ok.
+
+%%--------------------------------------------------------------------
+%% Test to build a tuple in a guard.
+
+test_tuple_in_guard(T2, T3) ->
+ %% T2 = {a, b}; T3 = {a, b, c}
+ ok = if T2 == {element(1, T3), element(2, T3)} -> ok;
+ true -> other
+ end,
+ ok = if T3 == {element(1, T3), element(2, T3), element(3, T3)} -> ok;
+ true -> other
+ end,
+ ok.
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/hipe/test/bs_SUITE_data/bs_split.erl b/lib/hipe/test/bs_SUITE_data/bs_split.erl
index 2e52308a77..617543f789 100644
--- a/lib/hipe/test/bs_SUITE_data/bs_split.erl
+++ b/lib/hipe/test/bs_SUITE_data/bs_split.erl
@@ -26,13 +26,13 @@ bs1(L, B, Pos, Sz1, Sz2) ->
<<B1:Sz1/binary, B2:Sz2/binary>> = B,
bs2(L, B, Pos, B1, B2).
-bs2(L, B, Pos, B1, B2)->
+bs2(L, B, Pos, B1, B2) ->
B1 = list_to_binary(lists:sublist(L, 1, Pos)),
bs3(L, B, Pos, B2).
bs3(L, B, Pos, B2) ->
B2 = list_to_binary(lists:nthtail(Pos, L)),
- byte_split(L, B, Pos-1).
+ byte_split(L, B, Pos - 1).
%%--------------------------------------------------------------------
@@ -56,14 +56,14 @@ bit_split_binary2(_Action, _Bin, [], _Bef) -> ok.
bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft ->
Action(Bin, List, Bef, (Aft-Bef) div 8 * 8),
- bit_split_binary3(Action, Bin, List, Bef, Aft-8);
+ bit_split_binary3(Action, Bin, List, Bef, Aft - 8);
bit_split_binary3(_, _, _, _, _) -> ok.
make_bin_from_list(_List, 0) ->
mkbin([]);
make_bin_from_list(List, N) ->
list_to_binary([make_int(List, 8, 0),
- make_bin_from_list(lists:nthtail(8, List), N-8)]).
+ make_bin_from_list(lists:nthtail(8, List), N - 8)]).
make_int(_List, 0, Acc) -> Acc;
make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H).
@@ -101,5 +101,5 @@ z_split(B, N) ->
<<_:N/binary>> ->
[B];
_ ->
- z_split(B, N+1)
+ z_split(B, N + 1)
end.
diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl
index f50ae08964..24526f574d 100644
--- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl
+++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl
@@ -1,18 +1,356 @@
%% -*- erlang-indent-level: 2 -*-
%%-------------------------------------------------------------------
-%% Purpose: test support for UTF datatypes in binaries - INCOMPLETE
+%% Purpose: test support for UTF datatypes in binaries
+%%
+%% Most of it taken from emulator/test/bs_utf_SUITE.erl
%%-------------------------------------------------------------------
-module(bs_utf).
-export([test/0]).
+-include_lib("test_server/include/test_server.hrl").
+
test() ->
+ ok = utf8_cm65(),
+ ok = utf8_roundtrip(),
+ ok = utf16_roundtrip(),
+ ok = utf32_roundtrip(),
+ %% The following were problematic for the LLVM backend
+ ok = utf8_illegal_sequences(),
+ ok = utf16_illegal_sequences(),
+ ok = utf32_illegal_sequences(),
+ ok.
+
+%%-------------------------------------------------------------------
+%% A test with construction and matching
+
+utf8_cm65() ->
<<65>> = b65utf8(),
ok = m(<<65>>).
+b65utf8() ->
+ <<65/utf8>>.
+
m(<<65/utf8>>) ->
ok.
-b65utf8() ->
- <<65/utf8>>.
+%%-------------------------------------------------------------------
+
+utf8_roundtrip() ->
+ ok = utf8_roundtrip(0, 16#D7FF),
+ ok = utf8_roundtrip(16#E000, 16#10FFFF),
+ ok.
+
+utf8_roundtrip(First, Last) when First =< Last ->
+ Bin = int_to_utf8(First),
+ Bin = id(<<First/utf8>>),
+ Bin = id(<<(id(<<>>))/binary,First/utf8>>),
+ Unaligned = id(<<3:2,First/utf8>>),
+ <<_:2,Bin/binary>> = Unaligned,
+ <<First/utf8>> = Bin,
+ <<First/utf8>> = make_unaligned(Bin),
+ utf8_roundtrip(First+1, Last);
+utf8_roundtrip(_, _) ->
+ ok.
+
+%%-------------------------------------------------------------------
+
+utf16_roundtrip() ->
+ Big = fun utf16_big_roundtrip/1,
+ Little = fun utf16_little_roundtrip/1,
+ PidRefs = [spawn_monitor(fun() -> do_utf16_roundtrip(Fun) end) ||
+ Fun <- [Big,Little]],
+ [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end ||
+ {Pid, Ref} <- PidRefs],
+ ok.
+
+do_utf16_roundtrip(Fun) ->
+ do_utf16_roundtrip(0, 16#D7FF, Fun),
+ do_utf16_roundtrip(16#E000, 16#10FFFF, Fun).
+
+do_utf16_roundtrip(First, Last, Fun) when First =< Last ->
+ Fun(First),
+ do_utf16_roundtrip(First+1, Last, Fun);
+do_utf16_roundtrip(_, _, _) -> ok.
+
+utf16_big_roundtrip(Char) ->
+ Bin = id(<<Char/utf16>>),
+ Bin = id(<<(id(<<>>))/binary,Char/utf16>>),
+ Unaligned = id(<<3:2,Char/utf16>>),
+ <<_:2,Bin/binary>> = Unaligned,
+ <<Char/utf16>> = Bin,
+ <<Char/utf16>> = make_unaligned(Bin),
+ ok.
+
+utf16_little_roundtrip(Char) ->
+ Bin = id(<<Char/little-utf16>>),
+ Bin = id(<<(id(<<>>))/binary,Char/little-utf16>>),
+ Unaligned = id(<<3:2,Char/little-utf16>>),
+ <<_:2,Bin/binary>> = Unaligned,
+ <<Char/little-utf16>> = Bin,
+ <<Char/little-utf16>> = make_unaligned(Bin),
+ ok.
+
+%%-------------------------------------------------------------------
+
+utf32_roundtrip() ->
+ Big = fun utf32_big_roundtrip/1,
+ Little = fun utf32_little_roundtrip/1,
+ PidRefs = [spawn_monitor(fun() -> do_utf32_roundtrip(Fun) end) ||
+ Fun <- [Big,Little]],
+ [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end ||
+ {Pid, Ref} <- PidRefs],
+ ok.
+
+do_utf32_roundtrip(Fun) ->
+ do_utf32_roundtrip(0, 16#D7FF, Fun),
+ do_utf32_roundtrip(16#E000, 16#10FFFF, Fun).
+
+do_utf32_roundtrip(First, Last, Fun) when First =< Last ->
+ Fun(First),
+ do_utf32_roundtrip(First+1, Last, Fun);
+do_utf32_roundtrip(_, _, _) -> ok.
+
+utf32_big_roundtrip(Char) ->
+ Bin = id(<<Char/utf32>>),
+ Bin = id(<<(id(<<>>))/binary,Char/utf32>>),
+ Unaligned = id(<<3:2,Char/utf32>>),
+ <<_:2,Bin/binary>> = Unaligned,
+ <<Char/utf32>> = Bin,
+ <<Char/utf32>> = make_unaligned(Bin),
+ ok.
+
+utf32_little_roundtrip(Char) ->
+ Bin = id(<<Char/little-utf32>>),
+ Bin = id(<<(id(<<>>))/binary,Char/little-utf32>>),
+ Unaligned = id(<<3:2,Char/little-utf32>>),
+ <<_:2,Bin/binary>> = Unaligned,
+ <<Char/little-utf32>> = Bin,
+ <<Char/little-utf32>> = make_unaligned(Bin),
+ ok.
+
+%%-------------------------------------------------------------------
+
+utf8_illegal_sequences() ->
+ fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large.
+ fail_range(16#D800, 16#DFFF), % Reserved for UTF-16.
+
+ %% Illegal first character.
+ [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)],
+
+ %% Short sequences.
+ short_sequences(16#80, 16#10FFFF),
+
+ %% Overlong sequences. (Using more bytes than necessary
+ %% is not allowed.)
+ overlong(0, 127, 2),
+ overlong(128, 16#7FF, 3),
+ overlong(16#800, 16#FFFF, 4),
+ ok.
+
+fail_range(Char, End) when Char =< End ->
+ {'EXIT', _} = (catch <<Char/utf8>>),
+ Bin = int_to_utf8(Char),
+ fail(Bin),
+ fail_range(Char+1, End);
+fail_range(_, _) -> ok.
+
+short_sequences(Char, End) ->
+ Step = (End - Char) div erlang:system_info(schedulers) + 1,
+ PidRefs = short_sequences_1(Char, Step, End),
+ [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end ||
+ {Pid, Ref} <- PidRefs],
+ ok.
+
+short_sequences_1(Char, Step, End) when Char =< End ->
+ CharEnd = lists:min([Char+Step-1,End]),
+ [spawn_monitor(fun() ->
+ %% io:format("~p - ~p\n", [Char, CharEnd]),
+ do_short_sequences(Char, CharEnd)
+ end)|short_sequences_1(Char+Step, Step, End)];
+short_sequences_1(_, _, _) -> [].
+
+do_short_sequences(Char, End) when Char =< End ->
+ short_sequence(Char),
+ do_short_sequences(Char+1, End);
+do_short_sequences(_, _) -> ok.
+
+short_sequence(I) ->
+ case int_to_utf8(I) of
+ <<S0:3/binary,_:8>> ->
+ <<S1:2/binary,R1:8>> = S0,
+ <<S2:1/binary,_:8>> = S1,
+ fail(S0),
+ fail(S1),
+ fail(S2),
+ fail(<<S2/binary,16#7F,R1,R1>>),
+ fail(<<S1/binary,16#7F,R1>>),
+ fail(<<S0/binary,16#7F>>);
+ <<S0:2/binary,_:8>> ->
+ <<S1:1/binary,R1:8>> = S0,
+ fail(S0),
+ fail(S1),
+ fail(<<S0/binary,16#7F>>),
+ fail(<<S1/binary,16#7F>>),
+ fail(<<S1/binary,16#7F,R1>>);
+ <<S:1/binary,_:8>> ->
+ fail(S),
+ fail(<<S/binary,16#7F>>)
+ end.
+
+overlong(Char, Last, NumBytes) when Char =< Last ->
+ overlong(Char, NumBytes),
+ overlong(Char+1, Last, NumBytes);
+overlong(_, _, _) -> ok.
+
+overlong(Char, NumBytes) when NumBytes < 5 ->
+ case int_to_utf8(Char, NumBytes) of
+ <<Char/utf8>>=Bin ->
+ ?t:fail({illegal_encoding_accepted,Bin,Char});
+ <<OtherChar/utf8>>=Bin ->
+ ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar});
+ _ -> ok
+ end,
+ overlong(Char, NumBytes+1);
+overlong(_, _) -> ok.
+
+fail(Bin) ->
+ fail_1(Bin),
+ fail_1(make_unaligned(Bin)).
+
+fail_1(<<Char/utf8>> = Bin) ->
+ ?t:fail({illegal_encoding_accepted, Bin, Char});
+fail_1(_) -> ok.
+
+%%-------------------------------------------------------------------
+
+utf16_illegal_sequences() ->
+ utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large.
+ utf16_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16.
+ lonely_hi_surrogate(16#D800, 16#DFFF),
+ leading_lo_surrogate(16#DC00, 16#DFFF),
+ ok.
+
+utf16_fail_range(Char, End) when Char =< End ->
+ {'EXIT', _} = (catch <<Char/big-utf16>>),
+ {'EXIT', _} = (catch <<Char/little-utf16>>),
+ utf16_fail_range(Char+1, End);
+utf16_fail_range(_, _) -> ok.
+
+lonely_hi_surrogate(Char, End) when Char =< End ->
+ BinBig = <<Char:16/big>>,
+ BinLittle = <<Char:16/little>>,
+ case {BinBig,BinLittle} of
+ {<<Bad/big-utf16>>,_} ->
+ ?t:fail({lonely_hi_surrogate_accepted,Bad});
+ {_,<<Bad/little-utf16>>} ->
+ ?t:fail({lonely_hi_surrogate_accepted,Bad});
+ {_,_} ->
+ ok
+ end,
+ lonely_hi_surrogate(Char+1, End);
+lonely_hi_surrogate(_, _) -> ok.
+
+leading_lo_surrogate(Char, End) when Char =< End ->
+ leading_lo_surrogate(Char, 16#D800, 16#DFFF),
+ leading_lo_surrogate(Char+1, End);
+leading_lo_surrogate(_, _) -> ok.
+
+leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End ->
+ BinBig = <<HiSurr:16/big,LoSurr:16/big>>,
+ BinLittle = <<HiSurr:16/little,LoSurr:16/little>>,
+ case {BinBig,BinLittle} of
+ {<<Bad/big-utf16,_/bits>>,_} ->
+ ?t:fail({leading_lo_surrogate_accepted,Bad});
+ {_,<<Bad/little-utf16,_/bits>>} ->
+ ?t:fail({leading_lo_surrogate_accepted,Bad});
+ {_,_} ->
+ ok
+ end,
+ leading_lo_surrogate(HiSurr, LoSurr+1, End);
+leading_lo_surrogate(_, _, _) -> ok.
+
+%%-------------------------------------------------------------------
+
+utf32_illegal_sequences() ->
+ utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large.
+ utf32_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16.
+ utf32_fail_range(-100, -1),
+ ok.
+
+utf32_fail_range(Char, End) when Char =< End ->
+ {'EXIT', _} = (catch <<Char/big-utf32>>),
+ {'EXIT', _} = (catch <<Char/little-utf32>>),
+ case {<<Char:32>>,<<Char:32/little>>} of
+ {<<Unexpected/utf32>>,_} ->
+ ?t:fail(Unexpected);
+ {_,<<Unexpected/little-utf32>>} ->
+ ?t:fail(Unexpected);
+ {_,_} -> ok
+ end,
+ utf32_fail_range(Char+1, End);
+utf32_fail_range(_, _) -> ok.
+
+%%-------------------------------------------------------------------
+%% This function intentionally allows construction of UTF-8 sequence
+%% in illegal ranges.
+
+int_to_utf8(I) when I =< 16#7F ->
+ <<I>>;
+int_to_utf8(I) when I =< 16#7FF ->
+ B2 = I,
+ B1 = (I bsr 6),
+ <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>;
+int_to_utf8(I) when I =< 16#FFFF ->
+ B3 = I,
+ B2 = (I bsr 6),
+ B1 = (I bsr 12),
+ <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>;
+int_to_utf8(I) when I =< 16#3FFFFF ->
+ B4 = I,
+ B3 = (I bsr 6),
+ B2 = (I bsr 12),
+ B1 = (I bsr 18),
+ <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>;
+int_to_utf8(I) when I =< 16#3FFFFFF ->
+ B5 = I,
+ B4 = (I bsr 6),
+ B3 = (I bsr 12),
+ B2 = (I bsr 18),
+ B1 = (I bsr 24),
+ <<1:1,1:1,1:1,1:1,1:1,0:1,B1:2,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6,
+ 1:1,0:1,B5:6>>.
+
+%% int_to_utf8(I, NumberOfBytes) -> Binary.
+%% This function can be used to construct overlong sequences.
+int_to_utf8(I, 1) ->
+ <<I>>;
+int_to_utf8(I, 2) ->
+ B2 = I,
+ B1 = (I bsr 6),
+ <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>;
+int_to_utf8(I, 3) ->
+ B3 = I,
+ B2 = (I bsr 6),
+ B1 = (I bsr 12),
+ <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>;
+int_to_utf8(I, 4) ->
+ B4 = I,
+ B3 = (I bsr 6),
+ B2 = (I bsr 12),
+ B1 = (I bsr 18),
+ <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>.
+
+%%-------------------------------------------------------------------
+
+make_unaligned(Bin0) when is_binary(Bin0) ->
+ Bin1 = <<0:3,Bin0/binary,31:5>>,
+ Sz = byte_size(Bin0),
+ <<0:3,Bin:Sz/binary,31:5>> = id(Bin1),
+ Bin.
+
+%%-------------------------------------------------------------------
+%% Just to prevent compiler optimizations
+
+id(X) -> X.
diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl
index 5f05a716bc..9f5d7421b4 100644
--- a/lib/hipe/test/hipe_testsuite_driver.erl
+++ b/lib/hipe/test/hipe_testsuite_driver.erl
@@ -176,7 +176,8 @@ run(TestCase, Dir, _OutDir) ->
HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end,
{ok, TestCase} = hipe:c(TestCase, HiPEOpts),
ok = TestCase:test(),
- case is_llvm_opt_available() of
+ ToLLVM = try TestCase:to_llvm() catch error:undef -> true end,
+ case ToLLVM andalso hipe:llvm_support_available() of
true ->
{ok, TestCase} = hipe:c(TestCase, [to_llvm|HiPEOpts]),
ok = TestCase:test();
@@ -186,16 +187,3 @@ run(TestCase, Dir, _OutDir) ->
%% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end,
%% [filename:join(OutDir, D) || D <- DataFiles])
%% end.
-
-
-%% This function, which is supposed to check whether the right LLVM
-%% infrastructure is available, should be probably written in a better
-%% and more portable way and moved to the hipe application.
-
-is_llvm_opt_available() ->
- OptStr = os:cmd("opt -version"),
- SubStr = "LLVM version ", N = length(SubStr),
- case string:str(OptStr, SubStr) of
- 0 -> false;
- S -> P = S + N, string:sub_string(OptStr, P, P + 2) >= "3.4"
- end.
diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl
new file mode 100644
index 0000000000..9f0830574f
--- /dev/null
+++ b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl
@@ -0,0 +1,28 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%----------------------------------------------------------------------
+%%% Author: Kostis Sagonas
+%%%
+%%% Tests that when the native code compilation times out or gets killed
+%%% for some other reason, the parent process does not also get killed.
+%%%
+%%% Problem discovered by Bjorn G. on 1/12/2003 and fixed by Kostis.
+%%%----------------------------------------------------------------------
+
+-module(sanity_comp_timeout).
+
+-export([test/0, to_llvm/0]).
+
+test() ->
+ ok = write_dummy_mod(),
+ error_logger:tty(false), % disable printouts of error reports
+ Self = self(), % get the parent process
+ c:c(dummy_mod, [native, {hipe, [{timeout, 1}]}]), % This will kill the process
+ Self = self(), % make sure the parent process stays the same
+ ok.
+
+to_llvm() -> false.
+
+write_dummy_mod() ->
+ Prog = <<"-module(dummy_mod).\n-export([test/0]).\ntest() -> ok.\n">>,
+ ok = file:write_file("dummy_mod.erl", Prog).
+
diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl
new file mode 100644
index 0000000000..87e746042e
--- /dev/null
+++ b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl
@@ -0,0 +1,21 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%----------------------------------------------------------------------
+%%% Author: Per Gustafsson
+%%%
+%%% Checks that HiPE's concurrent compilation does not leave any zombie
+%%% processes around after compilation has finished.
+%%%
+%%% This was a bug reported on erlang-bugs (Oct 25, 2007).
+%%%----------------------------------------------------------------------
+
+-module(sanity_no_zombies).
+
+-export([test/0, to_llvm/0]).
+
+test() ->
+ L = length(processes()),
+ hipe:c(?MODULE, [concurrent_comp]), % force concurrent compilation
+ L = length(processes()),
+ ok.
+
+to_llvm() -> false.
diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index c98ec1a9dc..44e1ea9abe 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -33,7 +33,23 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 6.1</title>
+ <section><title>Inets 6.1.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ mod_alias now traverses all aliases picking the longest
+ match and not the first match.</p>
+ <p>
+ Own Id: OTP-13248</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 6.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
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_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl
index 6fe8c1776d..9940136f5a 100644
--- a/lib/inets/src/http_lib/http_uri.erl
+++ b/lib/inets/src/http_lib/http_uri.erl
@@ -196,10 +196,10 @@ parse_host_port(_Scheme, DefaultPort, HostPort, _Opts) ->
{Host, int_port(Port)}.
split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) ->
- case inets_regexp:first_match(UriPart, SplitChar) of
- {match, Match, _} ->
- {string:substr(UriPart, 1, Match - SkipLeft),
- string:substr(UriPart, Match + SkipRight, length(UriPart))};
+ case re:run(UriPart, SplitChar, [{capture, first}]) of
+ {match, [{Match, _}]} ->
+ {string:substr(UriPart, 1, Match + 1 - SkipLeft),
+ string:substr(UriPart, Match + 1 + SkipRight, length(UriPart))};
nomatch ->
NoMatchResult
end.
diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl
index cf02c0e072..e6377b4882 100644
--- a/lib/inets/src/http_server/httpd.erl
+++ b/lib/inets/src/http_server/httpd.erl
@@ -43,7 +43,7 @@
%%%========================================================================
parse_query(String) ->
- {ok, SplitString} = inets_regexp:split(String,"[&;]"),
+ SplitString = re:split(String,"[&;]", [{return, list}]),
foreach(SplitString).
reload_config(Config = [Value| _], Mode) when is_tuple(Value) ->
@@ -239,14 +239,14 @@ unblock(Addr, Port, Profile) when is_integer(Port) ->
foreach([]) ->
[];
foreach([KeyValue|Rest]) ->
- {ok, Plus2Space, _} = inets_regexp:gsub(KeyValue,"[\+]"," "),
- case inets_regexp:split(Plus2Space,"=") of
- {ok,[Key|Value]} ->
- [{http_uri:decode(Key),
- http_uri:decode(lists:flatten(Value))}|foreach(Rest)];
- {ok,_} ->
- foreach(Rest)
- end.
+ Plus2Space = re:replace(KeyValue,"[\+]"," ", [{return,list}, global]),
+ case re:split(Plus2Space,"=", [{return, list}]) of
+ [Key|Value] ->
+ [{http_uri:decode(Key),
+ http_uri:decode(lists:flatten(Value))}|foreach(Rest)];
+ _ ->
+ foreach(Rest)
+ end.
make_name(Addr, Port, Profile) ->
diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl
index 62e8a95b19..a7783bc1e9 100644
--- a/lib/inets/src/http_server/httpd_conf.erl
+++ b/lib/inets/src/http_server/httpd_conf.erl
@@ -232,7 +232,7 @@ load("KeepAliveTimeout " ++ Timeout, []) ->
end;
load("Modules " ++ Modules, []) ->
- {ok, ModuleList} = inets_regexp:split(Modules," "),
+ ModuleList = re:split(Modules," ", [{return, list}]),
{ok, [], {modules,[list_to_atom(X) || X <- ModuleList]}};
load("ServerAdmin " ++ ServerAdmin, []) ->
@@ -879,7 +879,7 @@ bootstrap([]) ->
bootstrap([Line|Config]) ->
case Line of
"Modules " ++ Modules ->
- {ok, ModuleList} = inets_regexp:split(Modules," "),
+ ModuleList = re:split(Modules," ", [{return, list}]),
TheMods = [list_to_atom(X) || X <- ModuleList],
case verify_modules(TheMods) of
ok ->
@@ -1004,7 +1004,7 @@ read_config_file(Stream, SoFar) ->
%% Ignore commented lines for efficiency later ..
read_config_file(Stream, SoFar);
Line ->
- {ok, NewLine, _}=inets_regexp:sub(clean(Line),"[\t\r\f ]"," "),
+ NewLine = re:replace(clean(Line),"[\t\r\f ]"," ", [{return,list}]),
case NewLine of
[] ->
%% Also ignore empty lines ..
@@ -1031,12 +1031,12 @@ parse_mime_types(Stream, MimeTypesList, "") ->
parse_mime_types(Stream, MimeTypesList, [$#|_]) ->
parse_mime_types(Stream, MimeTypesList);
parse_mime_types(Stream, MimeTypesList, Line) ->
- case inets_regexp:split(Line, " ") of
- {ok, [NewMimeType|Suffixes]} ->
+ case re:split(Line, " ", [{return, list}]) of
+ [NewMimeType|Suffixes] ->
parse_mime_types(Stream,
lists:append(suffixes(NewMimeType,Suffixes),
MimeTypesList));
- {ok, _} ->
+ _ ->
{error, ?NICE(Line)}
end.
@@ -1207,9 +1207,8 @@ error_report(Where,M,F,Error) ->
error_logger:error_report([{?MODULE, Where},
{apply, {M, F, []}}, Error]).
white_space_clean(String) ->
- {ok,CleanedString,_} =
- inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""),
- CleanedString.
+ re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","",
+ [{return,list}, global]).
%%%=========================================================================
@@ -1246,22 +1245,23 @@ is_file(_Type,_Access,FileInfo,_File) ->
{error,FileInfo}.
make_integer(String) ->
- case inets_regexp:match(string:strip(String),"[0-9]+") of
- {match, _, _} ->
+ case re:run(string:strip(String),"[0-9]+", [{capture, none}]) of
+ match ->
{ok, list_to_integer(string:strip(String))};
nomatch ->
{error, nomatch}
end.
clean(String) ->
- {ok,CleanedString,_} =
- inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""),
- CleanedString.
+ re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","",
+ [{return,list}, global]).
custom_clean(String,MoreBefore,MoreAfter) ->
- {ok,CleanedString,_} = inets_regexp:gsub(String,"^[ \t\n\r\f"++MoreBefore++
- "]*|[ \t\n\r\f"++MoreAfter++"]*\$",""),
- CleanedString.
+ re:replace(String,
+ "^[ \t\n\r\f"++MoreBefore++
+ "]*|[ \t\n\r\f"++MoreAfter++"]*\$","",
+ [{return,list}, global]).
+
check_enum(_Enum,[]) ->
{error, not_valid};
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/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl
index 21b22f4420..232bf96bd4 100644
--- a/lib/inets/src/http_server/httpd_script_env.erl
+++ b/lib/inets/src/http_server/httpd_script_env.erl
@@ -104,7 +104,7 @@ create_http_header_elements(ScriptType, [{Name, [Value | _] = Values } |
create_http_header_elements(ScriptType, [{Name, Value} | Headers], Acc)
when is_list(Value) ->
- {ok, NewName, _} = inets_regexp:gsub(Name,"-","_"),
+ NewName = re:replace(Name,"-","_", [{return,list}, global]),
Element = http_env_element(ScriptType, NewName, Value),
create_http_header_elements(ScriptType, Headers, [Element | Acc]).
diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl
index ab43f0b378..6dd6db6a0c 100644
--- a/lib/inets/src/http_server/httpd_util.erl
+++ b/lib/inets/src/http_server/httpd_util.erl
@@ -420,11 +420,11 @@ flatlength([],L) ->
%% split_path
split_path(Path) ->
- case inets_regexp:match(Path,"[\?].*\$") of
+ case re:run(Path,"[\?].*\$", [{capture, first}]) of
%% A QUERY_STRING exists!
- {match,Start,Length} ->
- {http_uri:decode(string:substr(Path,1,Start-1)),
- string:substr(Path,Start,Length)};
+ {match,[{Start,Length}]} ->
+ {http_uri:decode(string:substr(Path,1,Start)),
+ string:substr(Path,Start+1,Length)};
%% A possible PATH_INFO exists!
nomatch ->
split_path(Path,[])
@@ -522,25 +522,8 @@ remove_ws(Rest) ->
%% split
-split(String,RegExp,Limit) ->
- case inets_regexp:parse(RegExp) of
- {error,Reason} ->
- {error,Reason};
- {ok,_} ->
- {ok,do_split(String,RegExp,Limit)}
- end.
-
-do_split(String, _RegExp, 1) ->
- [String];
-
-do_split(String,RegExp,Limit) ->
- case inets_regexp:first_match(String,RegExp) of
- {match,Start,Length} ->
- [string:substr(String,1,Start-1)|
- do_split(lists:nthtail(Start+Length-1,String),RegExp,Limit-1)];
- nomatch ->
- [String]
- end.
+split(String,RegExp,N) ->
+ {ok, re:split(String, RegExp, [{parts, N}, {return, list}])}.
%% make_name/2, make_name/3
%% Prefix -> string()
diff --git a/lib/inets/src/http_server/mod_actions.erl b/lib/inets/src/http_server/mod_actions.erl
index d879328876..154fde294e 100644
--- a/lib/inets/src/http_server/mod_actions.erl
+++ b/lib/inets/src/http_server/mod_actions.erl
@@ -81,18 +81,18 @@ script(RequestURI, Method, [_ | Rest]) ->
%% load
load("Action "++ Action, []) ->
- case inets_regexp:split(Action, " ") of
- {ok,[MimeType, CGIScript]} ->
- {ok,[],{action, {MimeType, CGIScript}}};
- {ok,_} ->
- {error,?NICE(string:strip(Action)++" is an invalid Action")}
+ case re:split(Action, " ", [{return, list}]) of
+ [MimeType, CGIScript] ->
+ {ok,[],{action, {MimeType, CGIScript}}};
+ _ ->
+ {error,?NICE(string:strip(Action)++" is an invalid Action")}
end;
load("Script " ++ Script,[]) ->
- case inets_regexp:split(Script, " ") of
- {ok,[Method, CGIScript]} ->
- {ok,[],{script, {Method, CGIScript}}};
- {ok,_} ->
- {error,?NICE(string:strip(Script)++" is an invalid Script")}
+ case re:split(Script, " ", [{return, list}]) of
+ [Method, CGIScript] ->
+ {ok,[],{script, {Method, CGIScript}}};
+ _ ->
+ {error,?NICE(string:strip(Script)++" is an invalid Script")}
end.
store({action, {MimeType, CGIScript}} = Conf, _) when is_list(MimeType),
diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl
index 8dd4871821..727f6e0ce3 100644
--- a/lib/inets/src/http_server/mod_alias.erl
+++ b/lib/inets/src/http_server/mod_alias.erl
@@ -113,32 +113,52 @@ real_name(ConfigDB, RequestURI, []) ->
httpd_util:split_path(default_index(ConfigDB, RealName)),
{ShortPath, Path, AfterPath};
-real_name(ConfigDB, RequestURI, [{MP,Replacement}|Rest])
+real_name(ConfigDB, RequestURI, [{MP,Replacement}| _] = Aliases)
when element(1, MP) =:= re_pattern ->
- case re:run(RequestURI, MP, [{capture,[]}]) of
- match ->
+ case longest_match(Aliases, RequestURI) of
+ {match, {MP, Replacement}} ->
NewURI = re:replace(RequestURI, MP, Replacement, [{return,list}]),
{ShortPath,_} = httpd_util:split_path(NewURI),
{Path,AfterPath} =
httpd_util:split_path(default_index(ConfigDB, NewURI)),
{ShortPath, Path, AfterPath};
nomatch ->
- real_name(ConfigDB, RequestURI, Rest)
+ real_name(ConfigDB, RequestURI, [])
end;
-real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) ->
- case inets_regexp:match(RequestURI, "^" ++ FakeName) of
- {match, _, _} ->
- {ok, ActualName, _} = inets_regexp:sub(RequestURI,
- "^" ++ FakeName, RealName),
+real_name(ConfigDB, RequestURI, [{_,_}|_] = Aliases) ->
+ case longest_match(Aliases, RequestURI) of
+ {match, {FakeName, RealName}} ->
+ ActualName = re:replace(RequestURI,
+ "^" ++ FakeName, RealName, [{return,list}]),
{ShortPath, _AfterPath} = httpd_util:split_path(ActualName),
{Path, AfterPath} =
- httpd_util:split_path(default_index(ConfigDB, ActualName)),
+ httpd_util:split_path(default_index(ConfigDB, ActualName)),
{ShortPath, Path, AfterPath};
- nomatch ->
- real_name(ConfigDB, RequestURI, Rest)
+ nomatch ->
+ real_name(ConfigDB, RequestURI, [])
end.
+longest_match(Aliases, RequestURI) ->
+ longest_match(Aliases, RequestURI, _LongestNo = 0, _LongestAlias = undefined).
+
+longest_match([{FakeName, RealName} | Rest], RequestURI, LongestNo, LongestAlias) ->
+ case re:run(RequestURI, "^" ++ FakeName, [{capture, first}]) of
+ {match, [{_, Length}]} ->
+ if
+ Length > LongestNo ->
+ longest_match(Rest, RequestURI, Length, {FakeName, RealName});
+ true ->
+ longest_match(Rest, RequestURI, LongestNo, LongestAlias)
+ end;
+ nomatch ->
+ longest_match(Rest, RequestURI, LongestNo, LongestAlias)
+ end;
+longest_match([], _RequestURI, 0, _LongestAlias) ->
+ nomatch;
+longest_match([], _RequestURI, _LongestNo, LongestAlias) ->
+ {match, LongestAlias}.
+
%% real_script_name
real_script_name(_ConfigDB, _RequestURI, []) ->
@@ -146,7 +166,7 @@ real_script_name(_ConfigDB, _RequestURI, []) ->
real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest])
when element(1, MP) =:= re_pattern ->
- case re:run(RequestURI, MP, [{capture,[]}]) of
+ case re:run(RequestURI, MP, [{capture, none}]) of
match ->
ActualName =
re:replace(RequestURI, MP, Replacement, [{return,list}]),
@@ -156,10 +176,10 @@ real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest])
end;
real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) ->
- case inets_regexp:match(RequestURI, "^" ++ FakeName) of
- {match,_,_} ->
- {ok, ActualName, _} =
- inets_regexp:sub(RequestURI, "^" ++ FakeName, RealName),
+ case re:run(RequestURI, "^" ++ FakeName, [{capture, none}]) of
+ match ->
+ ActualName =
+ re:replace(RequestURI, "^" ++ FakeName, RealName, [{return,list}]),
httpd_util:split_script_path(default_index(ConfigDB, ActualName));
nomatch ->
real_script_name(ConfigDB, RequestURI, Rest)
@@ -206,26 +226,26 @@ path(Data, ConfigDB, RequestURI) ->
%% load
load("DirectoryIndex " ++ DirectoryIndex, []) ->
- {ok, DirectoryIndexes} = inets_regexp:split(DirectoryIndex," "),
+ DirectoryIndexes = re:split(DirectoryIndex," ", [{return, list}]),
{ok,[], {directory_index, DirectoryIndexes}};
load("Alias " ++ Alias, []) ->
- case inets_regexp:split(Alias," ") of
- {ok, [FakeName, RealName]} ->
+ case re:split(Alias," ", [{return, list}]) of
+ [FakeName, RealName] ->
{ok,[],{alias,{FakeName,RealName}}};
- {ok, _} ->
+ _ ->
{error,?NICE(string:strip(Alias)++" is an invalid Alias")}
end;
load("ReWrite " ++ Rule, Acc) ->
load_re_write(Rule, Acc, "ReWrite", re_write);
load("ScriptAlias " ++ ScriptAlias, []) ->
- case inets_regexp:split(ScriptAlias, " ") of
- {ok, [FakeName, RealName]} ->
+ case re:split(ScriptAlias, " ", [{return, list}]) of
+ [FakeName, RealName] ->
%% Make sure the path always has a trailing slash..
RealName1 = filename:join(filename:split(RealName)),
{ok, [], {script_alias, {FakeName, RealName1++"/"}}};
- {ok, _} ->
+ _ ->
{error, ?NICE(string:strip(ScriptAlias)++
- " is an invalid ScriptAlias")}
+ " is an invalid ScriptAlias")}
end;
load("ScriptReWrite " ++ Rule, Acc) ->
load_re_write(Rule, Acc, "ScriptReWrite", script_re_write).
diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl
index 6195e1c69f..b03629cabe 100644
--- a/lib/inets/src/http_server/mod_auth.erl
+++ b/lib/inets/src/http_server/mod_auth.erl
@@ -168,38 +168,38 @@ load("AuthDBType " ++ Type,
end;
load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) ->
- case inets_regexp:split(Require," ") of
- {ok,["user"|Users]} ->
+ case re:split(Require," ", [{return, list}]) of
+ ["user" | Users] ->
{ok,[{directory, {Directory,
- [{require_user,Users}|DirData]}} | Rest]};
- {ok,["group"|Groups]} ->
+ [{require_user,Users}|DirData]}} | Rest]};
+ ["group"|Groups] ->
{ok,[{directory, {Directory,
- [{require_group,Groups}|DirData]}} | Rest]};
- {ok,_} ->
+ [{require_group,Groups}|DirData]}} | Rest]};
+ _ ->
{error,?NICE(string:strip(Require) ++" is an invalid require")}
end;
load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) ->
- case inets_regexp:split(Allow," ") of
- {ok,["from","all"]} ->
+ case re:split(Allow," ", [{return, list}]) of
+ ["from","all"] ->
{ok,[{directory, {Directory,
[{allow_from,all}|DirData]}} | Rest]};
- {ok,["from"|Hosts]} ->
+ ["from"|Hosts] ->
{ok,[{directory, {Directory,
[{allow_from,Hosts}|DirData]}} | Rest]};
- {ok,_} ->
+ _ ->
{error,?NICE(string:strip(Allow) ++" is an invalid allow")}
end;
load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) ->
- case inets_regexp:split(Deny," ") of
- {ok, ["from", "all"]} ->
+ case re:split(Deny," ", [{return, list}]) of
+ ["from", "all"] ->
{ok,[{{directory, Directory,
[{deny_from, all}|DirData]}} | Rest]};
- {ok, ["from"|Hosts]} ->
+ ["from"|Hosts] ->
{ok,[{{directory, Directory,
[{deny_from, Hosts}|DirData]}} | Rest]};
- {ok, _} ->
+ _ ->
{error,?NICE(string:strip(Deny) ++" is an invalid deny")}
end;
@@ -561,12 +561,12 @@ secret_path(_Path, [], to_be_found) ->
secret_path(_Path, [], Directory) ->
{yes, Directory};
secret_path(Path, [[NewDirectory] | Rest], Directory) ->
- case inets_regexp:match(Path, NewDirectory) of
- {match, _, _} when Directory =:= to_be_found ->
+ case re:run(Path, NewDirectory, [{capture, first}]) of
+ {match, _} when Directory =:= to_be_found ->
secret_path(Path, Rest, NewDirectory);
- {match, _, Length} when Length > length(Directory)->
+ {match, [{_, Length}]} when Length > length(Directory)->
secret_path(Path, Rest,NewDirectory);
- {match, _, _Length} ->
+ {match, _} ->
secret_path(Path, Rest, Directory);
nomatch ->
secret_path(Path, Rest, Directory)
@@ -588,8 +588,8 @@ validate_addr(_RemoteAddr, none) -> % When called from 'deny'
validate_addr(_RemoteAddr, []) ->
false;
validate_addr(RemoteAddr, [HostRegExp | Rest]) ->
- case inets_regexp:match(RemoteAddr, HostRegExp) of
- {match,_,_} ->
+ case re:run(RemoteAddr, HostRegExp, [{capture, none}]) of
+ match ->
true;
nomatch ->
validate_addr(RemoteAddr,Rest)
diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl
index e85d3b8776..1a3120e03c 100644
--- a/lib/inets/src/http_server/mod_auth_plain.erl
+++ b/lib/inets/src/http_server/mod_auth_plain.erl
@@ -244,11 +244,11 @@ parse_group(Stream, GroupList, "") ->
parse_group(Stream, GroupList, [$#|_]) ->
parse_group(Stream, GroupList);
parse_group(Stream, GroupList, Line) ->
- case inets_regexp:split(Line, ":") of
- {ok, [Group,Users]} ->
- {ok, UserList} = inets_regexp:split(Users," "),
+ case re:split(Line, ":", [{return, list}]) of
+ [Group,Users] ->
+ UserList = re:split(Users," ", [{return, list}]),
parse_group(Stream, [{Group,UserList}|GroupList]);
- {ok, _} ->
+ _ ->
{error, ?NICE(Line)}
end.
@@ -278,10 +278,10 @@ parse_passwd(Stream, PasswdList, "") ->
parse_passwd(Stream, PasswdList, [$#|_]) ->
parse_passwd(Stream, PasswdList);
parse_passwd(Stream, PasswdList, Line) ->
- case inets_regexp:split(Line,":") of
- {ok, [User,Password]} ->
+ case re:split(Line,":", [{return, list}]) of
+ [User,Password] ->
parse_passwd(Stream, [{User,Password, []}|PasswdList]);
- {ok,_} ->
+ _ ->
{error, ?NICE(Line)}
end.
diff --git a/lib/inets/src/http_server/mod_browser.erl b/lib/inets/src/http_server/mod_browser.erl
index ca643ab728..e3c41793ae 100644
--- a/lib/inets/src/http_server/mod_browser.erl
+++ b/lib/inets/src/http_server/mod_browser.erl
@@ -98,9 +98,9 @@ getBrowser1(Info) ->
getBrowser(AgentString) ->
LAgentString = http_util:to_lower(AgentString),
- case inets_regexp:first_match(LAgentString,"^[^ ]*") of
- {match,Start,Length} ->
- Browser = lists:sublist(LAgentString,Start,Length),
+ case re:run(LAgentString,"^[^ ]*", [{capture, first}]) of
+ {match,[{Start,Length}]} ->
+ Browser = lists:sublist(LAgentString,Start+1,Length),
case browserType(Browser) of
{mozilla,Vsn} ->
{getMozilla(LAgentString,
@@ -164,8 +164,8 @@ operativeSystem(OpString,[{RetVal,RegExps}|Rest]) ->
controlOperativeSystem(_OpString,[]) ->
false;
controlOperativeSystem(OpString,[Regexp|Regexps]) ->
- case inets_regexp:match(OpString,Regexp) of
- {match,_,_} ->
+ case re:run(OpString,Regexp, [{capture, none}]) of
+ match ->
true;
nomatch ->
controlOperativeSystem(OpString,Regexps)
@@ -182,18 +182,19 @@ controlOperativeSystem(OpString,[Regexp|Regexps]) ->
getMozilla(_AgentString,[],Default) ->
Default;
getMozilla(AgentString,[{Agent,AgentRegExp}|Rest],Default) ->
- case inets_regexp:match(AgentString,AgentRegExp) of
- {match,_,_} ->
+ case re:run(AgentString,AgentRegExp, [{capture, none}]) of
+ match ->
{Agent,getMozVersion(AgentString,AgentRegExp)};
nomatch ->
getMozilla(AgentString,Rest,Default)
end.
getMozVersion(AgentString, AgentRegExp) ->
- case inets_regexp:match(AgentString,AgentRegExp++"[0-9\.\ \/]*") of
- {match,Start,Length} when length(AgentRegExp) < Length ->
+ case re:run(AgentString,AgentRegExp++"[0-9\.\ \/]*",
+ [{capture, first}]) of
+ {match, [{Start,Length}]} when length(AgentRegExp) < Length ->
%% Ok we got the number split it out
- RealStart = Start+length(AgentRegExp),
+ RealStart = Start+1+length(AgentRegExp),
RealLength = Length-length(AgentRegExp),
VsnString = string:substr(AgentString,RealStart,RealLength),
%% case string:strip(VsnString,both,$\ ) of
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_dir.erl b/lib/inets/src/http_server/mod_dir.erl
index 9d848ac013..2d8f27af3c 100644
--- a/lib/inets/src/http_server/mod_dir.erl
+++ b/lib/inets/src/http_server/mod_dir.erl
@@ -125,12 +125,13 @@ header(Path,RequestURI) ->
RequestURI ++ "</H1>\n<PRE><IMG SRC=\"" ++ icon(blank) ++
"\" ALT=" "> Name Last modified "
"Size Description <HR>\n",
- case inets_regexp:sub(RequestURI,"[^/]*\$","") of
- {ok,"/",_} ->
+ case re:replace(RequestURI,"[^/]*\$","", [{return,list}]) of
+ "/" ->
Header;
- {ok,ParentRequestURI,_} ->
- {ok,ParentPath,_} =
- inets_regexp:sub(string:strip(Path,right,$/),"[^/]*\$",""),
+ ParentRequestURI ->
+ ParentPath =
+ re:replace(string:strip(Path,right,$/),"[^/]*\$","",
+ [{return,list}]),
Header++format(ParentPath,ParentRequestURI)
end.
diff --git a/lib/inets/src/http_server/mod_disk_log.erl b/lib/inets/src/http_server/mod_disk_log.erl
index a0ff929a34..5e395a2118 100644
--- a/lib/inets/src/http_server/mod_disk_log.erl
+++ b/lib/inets/src/http_server/mod_disk_log.erl
@@ -138,8 +138,8 @@ do(Info) ->
%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
%%-------------------------------------------------------------------------
load("TransferDiskLogSize " ++ TransferDiskLogSize, []) ->
- case inets_regexp:split(TransferDiskLogSize," ") of
- {ok,[MaxBytes,MaxFiles]} ->
+ try re:split(TransferDiskLogSize, " ", [{return, list}]) of
+ [MaxBytes, MaxFiles] ->
case make_integer(MaxBytes) of
{ok,MaxBytesInteger} ->
case make_integer(MaxFiles) of
@@ -151,17 +151,20 @@ load("TransferDiskLogSize " ++ TransferDiskLogSize, []) ->
?NICE(string:strip(TransferDiskLogSize)++
" is an invalid TransferDiskLogSize")}
end;
- {error,_} ->
+ _ ->
{error,?NICE(string:strip(TransferDiskLogSize)++
- " is an invalid TransferDiskLogSize")}
+ " is an invalid TransferDiskLogSize")}
end
+ catch _:_ ->
+ {error,?NICE(string:strip(TransferDiskLogSize) ++
+ " is an invalid TransferDiskLogSize")}
end;
load("TransferDiskLog " ++ TransferDiskLog,[]) ->
{ok,[],{transfer_disk_log,string:strip(TransferDiskLog)}};
load("ErrorDiskLogSize " ++ ErrorDiskLogSize, []) ->
- case inets_regexp:split(ErrorDiskLogSize," ") of
- {ok,[MaxBytes,MaxFiles]} ->
+ try re:split(ErrorDiskLogSize," ", [{return, list}]) of
+ [MaxBytes,MaxFiles] ->
case make_integer(MaxBytes) of
{ok,MaxBytesInteger} ->
case make_integer(MaxFiles) of
@@ -176,13 +179,16 @@ load("ErrorDiskLogSize " ++ ErrorDiskLogSize, []) ->
{error,?NICE(string:strip(ErrorDiskLogSize)++
" is an invalid ErrorDiskLogSize")}
end
+ catch _:_ ->
+ {error,?NICE(string:strip(ErrorDiskLogSize) ++
+ " is an invalid TransferDiskLogSize")}
end;
load("ErrorDiskLog " ++ ErrorDiskLog, []) ->
{ok, [], {error_disk_log, string:strip(ErrorDiskLog)}};
load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) ->
- case inets_regexp:split(SecurityDiskLogSize, " ") of
- {ok, [MaxBytes, MaxFiles]} ->
+ try re:split(SecurityDiskLogSize, " ", [{return, list}]) of
+ [MaxBytes, MaxFiles] ->
case make_integer(MaxBytes) of
{ok, MaxBytesInteger} ->
case make_integer(MaxFiles) of
@@ -198,6 +204,9 @@ load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) ->
{error, ?NICE(string:strip(SecurityDiskLogSize) ++
" is an invalid SecurityDiskLogSize")}
end
+ catch _:_ ->
+ {error,?NICE(string:strip(SecurityDiskLogSize) ++
+ " is an invalid SecurityDiskLogSize")}
end;
load("SecurityDiskLog " ++ SecurityDiskLog, []) ->
{ok, [], {security_disk_log, string:strip(SecurityDiskLog)}};
diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl
index 1923411449..2978ac9095 100644
--- a/lib/inets/src/http_server/mod_esi.erl
+++ b/lib/inets/src/http_server/mod_esi.erl
@@ -96,26 +96,27 @@ do(ModData) ->
%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
%%-------------------------------------------------------------------------
load("ErlScriptAlias " ++ ErlScriptAlias, []) ->
- case inets_regexp:split(ErlScriptAlias," ") of
- {ok, [ErlName | StrModules]} ->
+ try re:split(ErlScriptAlias," ", [{return, list}]) of
+ [ErlName | StrModules] ->
Modules = lists:map(fun(Str) ->
list_to_atom(string:strip(Str))
end, StrModules),
- {ok, [], {erl_script_alias, {ErlName, Modules}}};
- {ok, _} ->
+ {ok, [], {erl_script_alias, {ErlName, Modules}}}
+ catch _:_ ->
{error, ?NICE(string:strip(ErlScriptAlias) ++
- " is an invalid ErlScriptAlias")}
+ " is an invalid ErlScriptAlias")}
end;
load("EvalScriptAlias " ++ EvalScriptAlias, []) ->
- case inets_regexp:split(EvalScriptAlias, " ") of
- {ok, [EvalName | StrModules]} ->
+ try re:split(EvalScriptAlias, " ", [{return, list}]) of
+ [EvalName | StrModules] ->
Modules = lists:map(fun(Str) ->
list_to_atom(string:strip(Str))
end, StrModules),
- {ok, [], {eval_script_alias, {EvalName, Modules}}};
- {ok, _} ->
+ {ok, [], {eval_script_alias, {EvalName, Modules}}}
+ catch
+ _:_ ->
{error, ?NICE(string:strip(EvalScriptAlias) ++
- " is an invalid EvalScriptAlias")}
+ " is an invalid EvalScriptAlias")}
end;
load("ErlScriptTimeout " ++ Timeout, [])->
case catch list_to_integer(string:strip(Timeout)) of
@@ -224,8 +225,8 @@ match_esi_script(_, [], _) ->
no_match;
match_esi_script(RequestURI, [{Alias,Modules} | Rest], AliasType) ->
AliasMatchStr = alias_match_str(Alias, AliasType),
- case inets_regexp:first_match(RequestURI, AliasMatchStr) of
- {match, 1, Length} ->
+ case re:run(RequestURI, AliasMatchStr, [{capture, first}]) of
+ {match, [{0, Length}]} ->
{string:substr(RequestURI, Length + 1), Modules};
nomatch ->
match_esi_script(RequestURI, Rest, AliasType)
@@ -281,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}]),
@@ -584,9 +594,9 @@ generate_webpage(ESIBody) ->
is_authorized(_ESIBody, [all]) ->
true;
is_authorized(ESIBody, Modules) ->
- case inets_regexp:match(ESIBody, "^[^\:(%3A)]*") of
- {match, Start, Length} ->
- lists:member(list_to_atom(string:substr(ESIBody, Start, Length)),
+ case re:run(ESIBody, "^[^\:(%3A)]*", [{capture, first}]) of
+ {match, [{Start, Length}]} ->
+ lists:member(list_to_atom(string:substr(ESIBody, Start+1, Length)),
Modules);
nomatch ->
false
diff --git a/lib/inets/src/http_server/mod_htaccess.erl b/lib/inets/src/http_server/mod_htaccess.erl
index c6ae20ced7..f229c96f2d 100644
--- a/lib/inets/src/http_server/mod_htaccess.erl
+++ b/lib/inets/src/http_server/mod_htaccess.erl
@@ -327,9 +327,9 @@ memberNetwork(Networks,UserNetwork,IfTrue,IfFalse)->
%ipadresses or subnet addresses.
memberNetwork(Networks,UserNetwork)->
case lists:filter(fun(Net)->
- case inets_regexp:match(UserNetwork,
- formatRegexp(Net)) of
- {match,1,_}->
+ case re:run(UserNetwork,
+ formatRegexp(Net), [{capture, first}]) of
+ {match,[{0,_}]}->
true;
_NotSubNet ->
false
@@ -638,13 +638,8 @@ getHtAccessFileNames(Info)->
%HtAccessFileNames=["accessfileName1",..."AccessFileName2"]
%----------------------------------------------------------------------
getData(Path,Info,HtAccessFileNames)->
- case inets_regexp:split(Path,"/") of
- {error,Error}->
- {error,Error};
- {ok,SplittedPath}->
- getData2(HtAccessFileNames,SplittedPath,Info)
- end.
-
+ SplittedPath = re:split(Path, "/", [{return, list}]),
+ getData2(HtAccessFileNames,SplittedPath,Info).
%----------------------------------------------------------------------
%Add to together the data in the Splittedpath up to the path
@@ -942,20 +937,16 @@ getAuthorizationType(AuthType)->
%Returns a list of the specified methods to limit or the atom all
%----------------------------------------------------------------------
getLimits(Limits)->
- case inets_regexp:split(Limits,">")of
- {ok,[_NoEndOnLimit]}->
+ case re:split(Limits,">", [{return, list}])of
+ [_NoEndOnLimit]->
error;
- {ok, [Methods | _Crap]}->
- case inets_regexp:split(Methods," ") of
- {ok,[]}->
+ [Methods | _Crap]->
+ case re:split(Methods," ", [{return, list}]) of
+ [[]]->
all;
- {ok,SplittedMethods}->
- SplittedMethods;
- {error, _Error}->
- error
- end;
- {error,_Error}->
- error
+ SplittedMethods ->
+ SplittedMethods
+ end
end.
diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl
index 20f87619c1..1f936d598a 100644
--- a/lib/inets/src/http_server/mod_security.erl
+++ b/lib/inets/src/http_server/mod_security.erl
@@ -273,12 +273,12 @@ secret_path(_Path, [], to_be_found) ->
secret_path(_Path, [], Dir) ->
{yes, Dir};
secret_path(Path, [[NewDir]|Rest], Dir) ->
- case inets_regexp:match(Path, NewDir) of
- {match, _, _} when Dir =:= to_be_found ->
+ case re:run(Path, NewDir, [{capture, first}]) of
+ {match, _} when Dir =:= to_be_found ->
secret_path(Path, Rest, NewDir);
- {match, _, Length} when Length > length(Dir) ->
+ {match, [{_, Length}]} when Length > length(Dir) ->
secret_path(Path, Rest, NewDir);
- {match, _, _} ->
+ {match, _} ->
secret_path(Path, Rest, Dir);
nomatch ->
secret_path(Path, Rest, Dir)
diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile
index 82cda6aaf0..0a4b625b6a 100644
--- a/lib/inets/src/inets_app/Makefile
+++ b/lib/inets/src/inets_app/Makefile
@@ -47,7 +47,6 @@ MODULES = \
inets_service \
inets_app \
inets_sup \
- inets_regexp \
inets_trace \
inets_lib \
inets_time_compat
diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src
index 883ba84e8e..2f213794a3 100644
--- a/lib/inets/src/inets_app/inets.app.src
+++ b/lib/inets/src/inets_app/inets.app.src
@@ -26,7 +26,6 @@
inets_sup,
inets_app,
inets_service,
- inets_regexp,
inets_trace,
inets_lib,
inets_time_compat,
diff --git a/lib/inets/src/inets_app/inets_regexp.erl b/lib/inets/src/inets_app/inets_regexp.erl
deleted file mode 100644
index fc1608bc5a..0000000000
--- a/lib/inets/src/inets_app/inets_regexp.erl
+++ /dev/null
@@ -1,414 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 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(inets_regexp).
-
--export([parse/1, match/2, first_match/2, split/2, sub/3, gsub/3]).
-
-
-%%%=========================================================================
-%%% API
-%%%=========================================================================
-
-%% parse(RegExp) -> {ok, RE} | {error, E}.
-%% Parse the regexp described in the string RegExp.
-
-parse(S) ->
- case (catch reg(S)) of
- {R, []} ->
- {ok, R};
- {_R, [C|_]} ->
- {error, {illegal, [C]}};
- {error, E} ->
- {error, E}
- end.
-
-
-%% Find the longest match of RegExp in String.
-
-match(S, RegExp) when is_list(RegExp) ->
- case parse(RegExp) of
- {ok,RE} -> match(S, RE);
- {error,E} -> {error,E}
- end;
-match(S, RE) ->
- case match(RE, S, 1, 0, -1) of
- {Start,Len} when Len >= 0 ->
- {match, Start, Len};
- {_Start,_Len} ->
- nomatch
- end.
-
-%% Find the first match of RegExp in String.
-
-first_match(S, RegExp) when is_list(RegExp) ->
- case parse(RegExp) of
- {ok, RE} ->
- first_match(S, RE);
- {error, E} ->
- {error, E}
- end;
-first_match(S, RE) ->
- case first_match(RE, S, 1) of
- {Start,Len} when Len >= 0 ->
- {match, Start,Len};
- nomatch ->
- nomatch
- end.
-
-first_match(RE, S, St) when S =/= [] ->
- case re_apply(S, St, RE) of
- {match, P, _Rest} ->
- {St, P-St};
- nomatch ->
- first_match(RE, tl(S), St+1)
- end;
-first_match(_RE, [], _St) ->
- nomatch.
-
-
-match(RE, S, St, Pos, L) ->
- case first_match(RE, S, St) of
- {St1, L1} ->
- Nst = St1 + 1,
- if L1 > L ->
- match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1);
- true ->
- match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L)
- end;
- nomatch ->
- {Pos, L}
- end.
-
-
-%% Split a string into substrings where the RegExp describes the
-%% field seperator. The RegExp " " is specially treated.
-
-split(String, " ") -> %This is really special
- {ok, RE} = parse("[ \t]+"),
- case split_apply(String, RE, true) of
- [[]|Ss] ->
- {ok,Ss};
- Ss ->
- {ok,Ss}
- end;
-split(String, RegExp) when is_list(RegExp) ->
- case parse(RegExp) of
- {ok, RE} ->
- {ok, split_apply(String, RE, false)};
- {error, E} ->
- {error,E}
- end;
-split(String, RE) ->
- {ok, split_apply(String, RE, false)}.
-
-
-%% Substitute the first match of the regular expression RegExp
-%% with the string Replace in String. Accept pre-parsed regular
-%% expressions.
-
-sub(String, RegExp, Rep) when is_list(RegExp) ->
- case parse(RegExp) of
- {ok, RE} ->
- sub(String, RE, Rep);
- {error, E} ->
- {error, E}
- end;
-sub(String, RE, Rep) ->
- Ss = sub_match(String, RE, 1),
- {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}.
-
-
-%% Substitute every match of the regular expression RegExp with
-%% the string New in String. Accept pre-parsed regular expressions.
-
-gsub(String, RegExp, Rep) when is_list(RegExp) ->
- case parse(RegExp) of
- {ok, RE} ->
- gsub(String, RE, Rep);
- {error, E} ->
- {error, E}
- end;
-gsub(String, RE, Rep) ->
- Ss = matches(String, RE, 1),
- {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}.
-
-
-%%%========================================================================
-%%% Internal functions
-%%%========================================================================
-
-%% This is the regular expression grammar used. It is equivalent to the
-%% one used in AWK, except that we allow ^ $ to be used anywhere and fail
-%% in the matching.
-%%
-%% reg -> reg1 : '$1'.
-%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}.
-%% reg1 -> reg2 : '$1'.
-%% reg2 -> reg2 reg3 : {concat,'$1','$2'}.
-%% reg2 -> reg3 : '$1'.
-%% reg3 -> reg3 "*" : {kclosure,'$1'}.
-%% reg3 -> reg3 "+" : {pclosure,'$1'}.
-%% reg3 -> reg3 "?" : {optional,'$1'}.
-%% reg3 -> reg4 : '$1'.
-%% reg4 -> "(" reg ")" : '$2'.
-%% reg4 -> "\\" char : '$2'.
-%% reg4 -> "^" : bos.
-%% reg4 -> "$" : eos.
-%% reg4 -> "." : char.
-%% reg4 -> "[" class "]" : {char_class,char_class('$2')}
-%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')}
-%% reg4 -> "\"" chars "\"" : char_string('$2')
-%% reg4 -> char : '$1'.
-%% reg4 -> empty : epsilon.
-%% The grammar of the current regular expressions. The actual parser
-%% is a recursive descent implementation of the grammar.
-
-reg(S) -> reg1(S).
-
-%% reg1 -> reg2 reg1'
-%% reg1' -> "|" reg2
-%% reg1' -> empty
-
-reg1(S0) ->
- {L,S1} = reg2(S0),
- reg1p(S1, L).
-
-reg1p([$||S0], L) ->
- {R,S1} = reg2(S0),
- reg1p(S1, {'or',L,R});
-reg1p(S, L) -> {L,S}.
-
-%% reg2 -> reg3 reg2'
-%% reg2' -> reg3
-%% reg2' -> empty
-
-reg2(S0) ->
- {L,S1} = reg3(S0),
- reg2p(S1, L).
-
-reg2p([C|S0], L) when (C =/= $|) andalso (C =/= $)) ->
- {R,S1} = reg3([C|S0]),
- reg2p(S1, {concat,L,R});
-reg2p(S, L) -> {L,S}.
-
-%% reg3 -> reg4 reg3'
-%% reg3' -> "*" reg3'
-%% reg3' -> "+" reg3'
-%% reg3' -> "?" reg3'
-%% reg3' -> empty
-
-reg3(S0) ->
- {L,S1} = reg4(S0),
- reg3p(S1, L).
-
-reg3p([$*|S], L) -> reg3p(S, {kclosure,L});
-reg3p([$+|S], L) -> reg3p(S, {pclosure,L});
-reg3p([$?|S], L) -> reg3p(S, {optional,L});
-reg3p(S, L) -> {L,S}.
-
-reg4([$(|S0]) ->
- case reg(S0) of
- {R,[$)|S1]} -> {R,S1};
- {_R,_S} -> throw({error,{unterminated,"("}})
- end;
-reg4([$\\,O1,O2,O3|S])
- when ((O1 >= $0) andalso
- (O1 =< $7) andalso
- (O2 >= $0) andalso
- (O2 =< $7) andalso
- (O3 >= $0) andalso
- (O3 =< $7)) ->
- {(O1*8 + O2)*8 + O3 - 73*$0,S};
-reg4([$\\,C|S]) ->
- {escape_char(C),S};
-reg4([$\\]) ->
- throw({error, {unterminated,"\\"}});
-reg4([$^|S]) ->
- {bos,S};
-reg4([$$|S]) ->
- {eos,S};
-reg4([$.|S]) ->
- {{comp_class,"\n"},S};
-reg4("[^" ++ S0) ->
- case char_class(S0) of
- {Cc,[$]|S1]} -> {{comp_class,Cc},S1};
- {_Cc,_S} -> throw({error,{unterminated,"["}})
- end;
-reg4([$[|S0]) ->
- case char_class(S0) of
- {Cc,[$]|S1]} -> {{char_class,Cc},S1};
- {_Cc,_S1} -> throw({error,{unterminated,"["}})
- end;
-reg4([C|S])
- when (C =/= $*) andalso (C =/= $+) andalso (C =/= $?) andalso (C =/= $]) ->
- {C, S};
-reg4([C|_S]) ->
- throw({error,{illegal,[C]}});
-reg4([]) ->
- {epsilon,[]}.
-
-escape_char($n) -> $\n; %\n = LF
-escape_char($r) -> $\r; %\r = CR
-escape_char($t) -> $\t; %\t = TAB
-escape_char($v) -> $\v; %\v = VT
-escape_char($b) -> $\b; %\b = BS
-escape_char($f) -> $\f; %\f = FF
-escape_char($e) -> $\e; %\e = ESC
-escape_char($s) -> $\s; %\s = SPACE
-escape_char($d) -> $\d; %\d = DEL
-escape_char(C) -> C.
-
-char_class([$]|S]) -> char_class(S, [$]]);
-char_class(S) -> char_class(S, []).
-
-char($\\, [O1,O2,O3|S]) when
- O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 ->
- {(O1*8 + O2)*8 + O3 - 73*$0,S};
-char($\\, [C|S]) -> {escape_char(C),S};
-char(C, S) -> {C,S}.
-
-char_class([C1|S0], Cc) when C1 =/= $] ->
- case char(C1, S0) of
- {Cf,[$-,C2|S1]} when C2 =/= $] ->
- case char(C2, S1) of
- {Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]);
- {Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}})
- end;
- {C,S1} -> char_class(S1, [C|Cc])
- end;
-char_class(S, Cc) -> {Cc,S}.
-
-
-%% re_apply(String, StartPos, RegExp) -> re_app_res().
-%%
-%% Apply the (parse of the) regular expression RegExp to String. If
-%% there is a match return the position of the remaining string and
-%% the string if else return 'nomatch'. BestMatch specifies if we want
-%% the longest match, or just a match.
-%%
-%% StartPos should be the real start position as it is used to decide
-%% if we ae at the beginning of the string.
-%%
-%% Pass two functions to re_apply_or so it can decide, on the basis
-%% of BestMatch, whether to just any take any match or try both to
-%% find the longest. This is slower but saves duplicatng code.
-
-re_apply(S, St, RE) -> re_apply(RE, [], S, St).
-
-re_apply(epsilon, More, S, P) -> %This always matches
- re_apply_more(More, S, P);
-re_apply({'or',RE1,RE2}, More, S, P) ->
- re_apply_or(re_apply(RE1, More, S, P),
- re_apply(RE2, More, S, P));
-re_apply({concat,RE1,RE2}, More, S0, P) ->
- re_apply(RE1, [RE2|More], S0, P);
-re_apply({kclosure,CE}, More, S, P) ->
- %% Be careful with the recursion, explicitly do one call before
- %% looping.
- re_apply_or(re_apply_more(More, S, P),
- re_apply(CE, [{kclosure,CE}|More], S, P));
-re_apply({pclosure,CE}, More, S, P) ->
- re_apply(CE, [{kclosure,CE}|More], S, P);
-re_apply({optional,CE}, More, S, P) ->
- re_apply_or(re_apply_more(More, S, P),
- re_apply(CE, More, S, P));
-re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1);
-re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P);
-re_apply(eos, More, [], P) -> re_apply_more(More, [], P);
-re_apply({char_class,Cc}, More, [C|S], P) ->
- case in_char_class(C, Cc) of
- true -> re_apply_more(More, S, P+1);
- false -> nomatch
- end;
-re_apply({comp_class,Cc}, More, [C|S], P) ->
- case in_char_class(C, Cc) of
- true -> nomatch;
- false -> re_apply_more(More, S, P+1)
- end;
-re_apply(C, More, [C|S], P) when is_integer(C) ->
- re_apply_more(More, S, P+1);
-re_apply(_RE, _More, _S, _P) -> nomatch.
-
-%% re_apply_more([RegExp], String, Length) -> re_app_res().
-
-re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P);
-re_apply_more([], S, P) -> {match,P,S}.
-
-%% in_char_class(Char, Class) -> bool().
-
-in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true;
-in_char_class(C, [C|_Cc]) -> true;
-in_char_class(C, [_|Cc]) -> in_char_class(C, Cc);
-in_char_class(_C, []) -> false.
-
-%% re_apply_or(Match1, Match2) -> re_app_res().
-%% If we want the best match then choose the longest match, else just
-%% choose one by trying sequentially.
-
-re_apply_or({match,P1,S1}, {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1};
-re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2};
-re_apply_or(nomatch, R2) -> R2;
-re_apply_or(R1, nomatch) -> R1.
-
-
-matches(S, RE, St) ->
- case first_match(RE, S, St) of
- {St1,0} ->
- [{St1,0}|matches(string:substr(S, St1+2-St), RE, St1+1)];
- {St1,L1} ->
- [{St1,L1}|matches(string:substr(S, St1+L1+1-St), RE, St1+L1)];
- nomatch ->
- []
- end.
-
-sub_match(S, RE, St) ->
- case first_match(RE, S, St) of
- {St1,L1} -> [{St1,L1}];
- nomatch -> []
- end.
-
-sub_repl([{St,L}|Ss], Rep, S, Pos) ->
- Rs = sub_repl(Ss, Rep, S, St+L),
- string:substr(S, Pos, St-Pos) ++
- sub_repl(Rep, string:substr(S, St, L), Rs);
-sub_repl([], _Rep, S, Pos) ->
- string:substr(S, Pos).
-
-sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest);
-sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)];
-sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)];
-sub_repl([], _M, Rest) -> Rest.
-
-split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []).
-
-split_apply([], _P, _RE, true, []) ->
- [];
-split_apply([], _P, _RE, _T, Sub) ->
- [lists:reverse(Sub)];
-split_apply(S, P, RE, T, Sub) ->
- case re_apply(S, P, RE) of
- {match,P,_Rest} ->
- split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]);
- {match,P1,Rest} ->
- [lists:reverse(Sub)|split_apply(Rest, P1, RE, T, [])];
- nomatch ->
- split_apply(tl(S), P+1, RE, T, [hd(S)|Sub])
- end.
diff --git a/lib/inets/src/tftp/tftp_engine.erl b/lib/inets/src/tftp/tftp_engine.erl
index 282a97e720..79203fd1a4 100644
--- a/lib/inets/src/tftp/tftp_engine.erl
+++ b/lib/inets/src/tftp/tftp_engine.erl
@@ -1154,8 +1154,8 @@ match_callback(Filename, Callbacks) ->
end.
do_match_callback(Filename, [C | Tail]) when is_record(C, callback) ->
- case catch inets_regexp:match(Filename, C#callback.internal) of
- {match, _, _} ->
+ case catch re:run(Filename, C#callback.internal, [{capture, none}]) of
+ match ->
{ok, C};
nomatch ->
do_match_callback(Filename, Tail);
diff --git a/lib/inets/src/tftp/tftp_lib.erl b/lib/inets/src/tftp/tftp_lib.erl
index 71327f8023..01dea97d07 100644
--- a/lib/inets/src/tftp/tftp_lib.erl
+++ b/lib/inets/src/tftp/tftp_lib.erl
@@ -184,7 +184,7 @@ do_parse_config([{Key, Val} | Tail], Config) when is_record(Config, config) ->
callback ->
case Val of
{RegExp, Mod, State} when is_list(RegExp), is_atom(Mod) ->
- case inets_regexp:parse(RegExp) of
+ case re:compile(RegExp) of
{ok, Internal} ->
Callback = #callback{regexp = RegExp,
internal = Internal,
@@ -253,7 +253,7 @@ do_parse_config(Options, Config) when is_record(Config, config) ->
add_default_callbacks(Callbacks) ->
RegExp = "",
- {ok, Internal} = inets_regexp:parse(RegExp),
+ {ok, Internal} = re:compile(RegExp),
File = #callback{regexp = RegExp,
internal = Internal,
module = tftp_file,
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/inets/test/httpd_1_1.erl b/lib/inets/test/httpd_1_1.erl
index db6def9d17..d3a1e3672a 100644
--- a/lib/inets/test/httpd_1_1.erl
+++ b/lib/inets/test/httpd_1_1.erl
@@ -370,18 +370,18 @@ validateRangeRequest2(Socket, Head, Body, ValidBody, BodySize)
validateMultiPartRangeRequest(Body, ValidBody, Boundary)->
- case inets_regexp:split(Body,"--"++Boundary++"--") of
+ case re:split(Body,"--"++Boundary++"--", [{return, list}]) of
%%Last is the epilogue and must be ignored
- {ok,[First | _Last]}->
+ [First | _Last]->
%%First is now the actuall http request body.
- case inets_regexp:split(First, "--" ++ Boundary) of
+ case re:split(First, "--" ++ Boundary, [{return, list}]) of
%%Parts is now a list of ranges and the heads for each range
%%Gues we try to split out the body
- {ok,Parts}->
+ Parts->
case lists:flatten(lists:map(fun splitRange/1,Parts)) of
ValidBody->
ok;
- ParsedBody->
+ ParsedBody->
error = ParsedBody
end
end;
@@ -391,8 +391,8 @@ validateMultiPartRangeRequest(Body, ValidBody, Boundary)->
splitRange(Part)->
- case inets_regexp:split(Part, "\r\n\r\n") of
- {ok,[_, Body]} ->
+ case re:split(Part, "\r\n\r\n", [{return, list}]) of
+ [_, Body] ->
string:substr(Body, 1, length(Body) - 2);
_ ->
[]
@@ -412,13 +412,13 @@ getRangeSize(Head)->
{multiPart, BoundaryString}->
{multiPart, BoundaryString};
_X1 ->
- case inets_regexp:match(Head, ?CONTENT_RANGE "bytes=.*\r\n") of
- {match, Start, Lenght} ->
+ case re:run(Head, ?CONTENT_RANGE "bytes=.*\r\n", [{capture, first}]) of
+ {match, [{Start, Lenght}]} ->
%% Get the range data remove the fieldname and the
%% end of line.
- RangeInfo = string:substr(Head, Start + 20,
- Lenght - (20 - 2)),
- rangeSize(RangeInfo);
+ RangeInfo = string:substr(Head, Start + 1 + 20,
+ Lenght - (20 +2)),
+ rangeSize(string:strip(RangeInfo));
_X2 ->
error
end
@@ -454,10 +454,10 @@ num(_CharVal, false) ->
true.
controlMimeType(Head)->
- case inets_regexp:match(Head,?CONTENT_TYPE "multipart/byteranges.*\r\n") of
- {match,Start,Length}->
+ case re:run(Head,?CONTENT_TYPE "multipart/byteranges.*\r\n", [{capture, first}]) of
+ {match, [{Start,Length}]}->
FieldNameLen = length(?CONTENT_TYPE "multipart/byteranges"),
- case clearBoundary(string:substr(Head, Start + FieldNameLen,
+ case clearBoundary(string:substr(Head, Start + 1 + FieldNameLen,
Length - (FieldNameLen+2))) of
error ->
error;
@@ -471,10 +471,10 @@ controlMimeType(Head)->
end.
clearBoundary(Boundary)->
- case inets_regexp:match(Boundary, "boundary=.*\$") of
- {match, Start1, Length1}->
+ case re:run(Boundary, "boundary=.*\$", [{capture, first}]) of
+ {match, [{Start1, Length1}]}->
BoundLen = length("boundary="),
- string:substr(Boundary, Start1 + BoundLen, Length1 - BoundLen);
+ string:substr(Boundary, Start1 + 1 + BoundLen, Length1 - BoundLen);
_ ->
error
end.
@@ -489,12 +489,12 @@ end_of_header(HeaderPart) ->
end.
get_body_size(Head) ->
- case inets_regexp:match(Head,?CONTENT_LENGTH ".*\r\n") of
- {match, Start, Length} ->
+ case re:run(Head,?CONTENT_LENGTH ".*\r\n", [{capture, first}]) of
+ {match, [{Start, Length}]} ->
%% 15 is length of Content-Length,
%% 17 Is length of Content-Length and \r\
S = list_to_integer(
- string:strip(string:substr(Head, Start + 15, Length-17))),
+ string:strip(string:substr(Head, Start +1 + 15, Length-17))),
S;
_->
0
diff --git a/lib/inets/test/httpd_poll.erl b/lib/inets/test/httpd_poll.erl
index aca7b70376..4a570fb512 100644
--- a/lib/inets/test/httpd_poll.erl
+++ b/lib/inets/test/httpd_poll.erl
@@ -259,11 +259,11 @@ validate(ExpStatusCode,Socket,Response) ->
vtrace("validate -> Entry with ~p bytes response",[Sz]),
Size = trash_the_rest(Socket,Sz),
close(Socket),
- case inets_regexp:split(Response," ") of
- {ok,["HTTP/1.0",ExpStatusCode|_]} ->
+ case re:split(Response," ", [{return, list}]) of
+ ["HTTP/1.0",ExpStatusCode|_] ->
vlog("response (~p bytes) was ok",[Size]),
ok;
- {ok,["HTTP/1.0",StatusCode|_]} ->
+ ["HTTP/1.0",StatusCode|_] ->
verror("unexpected response status received: ~s => ~s",
[StatusCode,status_to_message(StatusCode)]),
log("unexpected result to GET of '~s': ~s => ~s",
diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl
index c58966ce10..71e201f826 100644
--- a/lib/inets/test/httpd_test_lib.erl
+++ b/lib/inets/test/httpd_test_lib.erl
@@ -96,10 +96,10 @@ verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, Ti
try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of
{ok, Socket} ->
ok = inets_test_lib:send(SocketType, Socket, RequestStr),
- State = case inets_regexp:match(RequestStr, "printenv") of
+ State = case re:run(RequestStr, "printenv", [{capture, none}]) of
nomatch ->
#state{};
- _ ->
+ match ->
#state{print = true}
end,
@@ -317,10 +317,10 @@ do_validate(Header, [_Unknown | Rest], N, P) ->
do_validate(Header, Rest, N, P).
is_expect(RequestStr) ->
- case inets_regexp:match(RequestStr, "xpect:100-continue") of
- {match, _, _}->
+ case re:run(RequestStr, "xpect:100-continue", [{capture, none}]) of
+ match->
true;
- _ ->
+ nomatch ->
false
end.
diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl
index 7c0acb5a99..1b4d74b28e 100644
--- a/lib/inets/test/httpd_time_test.erl
+++ b/lib/inets/test/httpd_time_test.erl
@@ -386,31 +386,31 @@ validate(ExpStatusCode, _SocketType, _Socket, Response) ->
%% Sz = sz(Response),
%% trash_the_rest(Socket, Sz),
%% inets_test_lib:close(SocketType, Socket),
- case inets_regexp:split(Response," ") of
- {ok, ["HTTP/1.0", ExpStatusCode|_]} ->
+ case re:split(Response," ", [{return, list}]) of
+ ["HTTP/1.0", ExpStatusCode|_] ->
ok;
- {ok, ["HTTP/1.0", StatusCode|_]} ->
+ ["HTTP/1.0", StatusCode|_] ->
error_msg("Unexpected status code: ~p (~s). "
"Expected status code: ~p (~s)",
[StatusCode, status_to_message(StatusCode),
ExpStatusCode, status_to_message(ExpStatusCode)]),
exit({unexpected_response_code, StatusCode, ExpStatusCode});
- {ok, ["HTTP/1.1", ExpStatusCode|_]} ->
+ ["HTTP/1.1", ExpStatusCode|_] ->
ok;
- {ok, ["HTTP/1.1", StatusCode|_]} ->
+ ["HTTP/1.1", StatusCode|_] ->
error_msg("Unexpected status code: ~p (~s). "
"Expected status code: ~p (~s)",
[StatusCode, status_to_message(StatusCode),
ExpStatusCode, status_to_message(ExpStatusCode)]),
exit({unexpected_response_code, StatusCode, ExpStatusCode});
- {ok, Unexpected} ->
- error_msg("Unexpected response split: ~p (~s)",
- [Unexpected, Response]),
- exit({unexpected_response, Unexpected, Response});
- {error, Reason} ->
+ {error, Reason} ->
error_msg("Failed processing response: ~p (~s)",
[Reason, Response]),
- exit({failed_response_processing, Reason, Response})
+ exit({failed_response_processing, Reason, Response});
+ Unexpected ->
+ error_msg("Unexpected response split: ~p (~s)",
+ [Unexpected, Response]),
+ exit({unexpected_response, Unexpected, Response})
end.
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index 2717f5b110..ee5f41aaec 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 6.1
+INETS_VSN = 6.1.1
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
index acc39145e2..d4c9a48901 100644
--- a/lib/kernel/doc/src/code.xml
+++ b/lib/kernel/doc/src/code.xml
@@ -263,6 +263,46 @@
was given to <c>set_path/1</c>).</p>
</section>
+ <section>
+ <marker id="error_reasons"></marker>
+ <title>Error Reasons for Code-Loading Functions</title>
+
+ <p>Functions that load code (such as <c>load_file/1</c>) will
+ return <c>{error,Reason}</c> if the load operation fails.
+ Here follows a description of the common reasons.</p>
+
+ <taglist>
+ <tag><c>badfile</c></tag>
+ <item>
+ <p>The object code has an incorrect format or the module
+ name in the object code is not the expected module name.</p>
+ </item>
+
+ <tag><c>nofile</c></tag>
+ <item>
+ <p>No file with object code was found.</p>
+ </item>
+
+ <tag><c>not_purged</c></tag>
+ <item>
+ <p>The object code could not be loaded because an old version
+ of the code already existed.</p>
+ </item>
+
+ <tag><c>on_load_failure</c></tag>
+ <item>
+ <p>The module has an
+ <seealso marker="doc/reference_manual:code_loading#on_load">-on_load function</seealso>
+ that failed when it was called.</p>
+ </item>
+
+ <tag><c>sticky_directory</c></tag>
+ <item>
+ <p>The object code resides in a sticky directory.</p>
+ </item>
+
+ </taglist>
+ </section>
<datatypes>
<datatype>
<name name="load_ret"/>
@@ -387,12 +427,8 @@
be used to load object code with a module name that is
different from the file name.</p>
<p>Returns <c>{module, <anno>Module</anno>}</c> if successful, or
- <c>{error, nofile}</c> if no object code is found, or
- <c>{error, sticky_directory}</c> if the object code resides in
- a sticky directory. Also if the loading fails, an error tuple is
- returned. See
- <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso>
- for possible values of <c><anno>What</anno></c>.</p>
+ <c>{error, Reason}</c> if loading fails.
+ See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of the possible error reasons.</p>
</desc>
</func>
<func>
@@ -404,7 +440,7 @@
<desc>
<p>Does the same as <c>load_file(<anno>Module</anno>)</c>, but
<c><anno>Filename</anno></c> is either an absolute file name, or a
- relative file name. The code path is not searched. It returns
+ relative file name. The code path is not searched. It returns
a value in the same way as
<seealso marker="#load_file/1">load_file/1</seealso>. Note
that <c><anno>Filename</anno></c> should not contain the extension (for
@@ -420,7 +456,8 @@
<seealso marker="#load_file/1">load_file/1</seealso>,
unless the module is already loaded.
In embedded mode, however, it does not load a module which is not
- already loaded, but returns <c>{error, embedded}</c> instead.</p>
+ already loaded, but returns <c>{error, embedded}</c> instead.
+ See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of other possible error reasons.</p>
</desc>
</func>
<func>
@@ -437,12 +474,8 @@
comes. Accordingly, <c><anno>Filename</anno></c> is not opened and read by
the code server.</p>
<p>Returns <c>{module, <anno>Module</anno>}</c> if successful, or
- <c>{error, sticky_directory}</c> if the object code resides in
- a sticky directory, or <c>{error, badarg}</c> if any argument
- is invalid. Also if the loading fails, an error tuple is
- returned. See
- <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso>
- for possible values of <c><anno>What</anno></c>.</p>
+ <c>{error, Reason}</c> if loading fails.
+ See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of the possible error reasons.</p>
</desc>
</func>
<func>
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/code.erl b/lib/kernel/src/code.erl
index ae28c97b47..59e226df43 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -60,7 +60,7 @@
del_path/1,
replace_path/2,
rehash/0,
- start_link/0, start_link/1,
+ start_link/0,
which/1,
where_is_file/1,
where_is_file/2,
@@ -79,10 +79,9 @@
%%----------------------------------------------------------------------------
-type load_error_rsn() :: 'badfile'
- | 'native_code'
| 'nofile'
| 'not_purged'
- | 'on_load'
+ | 'on_load_failure'
| 'sticky_directory'.
-type load_ret() :: {'error', What :: load_error_rsn()}
| {'module', Module :: module()}.
@@ -137,14 +136,16 @@ load_file(Mod) when is_atom(Mod) ->
-spec ensure_loaded(Module) -> {module, Module} | {error, What} when
Module :: module(),
- What :: embedded | badfile | native_code | nofile | on_load.
+ What :: embedded | badfile | nofile | on_load_failure.
ensure_loaded(Mod) when is_atom(Mod) ->
call({ensure_loaded,Mod}).
%% XXX File as an atom is allowed only for backwards compatibility.
-spec load_abs(Filename) -> load_ret() when
Filename :: file:filename().
-load_abs(File) when is_list(File); is_atom(File) -> call({load_abs,File,[]}).
+load_abs(File) when is_list(File); is_atom(File) ->
+ Mod = list_to_atom(filename:basename(File)),
+ call({load_abs,File,Mod}).
%% XXX Filename is also an atom(), e.g. 'cover_compiled'
-spec load_abs(Filename :: loaded_filename(), Module :: module()) -> load_ret().
@@ -305,15 +306,11 @@ get_mode() -> call(get_mode).
%%-----------------------------------------------------------------
call(Req) ->
- code_server:call(code_server, Req).
+ code_server:call(Req).
-spec start_link() -> {'ok', pid()} | {'error', 'crash'}.
start_link() ->
- start_link([stick]).
-
--spec start_link(Flags :: [atom()]) -> {'ok', pid()} | {'error', 'crash'}.
-start_link(Flags) ->
- do_start(Flags).
+ do_start().
%%-----------------------------------------------------------------
%% In the init phase, code must not use any modules not yet loaded,
@@ -325,36 +322,21 @@ start_link(Flags) ->
%% us, so the module is loaded.
%%-----------------------------------------------------------------
-do_start(Flags) ->
+do_start() ->
maybe_warn_for_cache(),
load_code_server_prerequisites(),
- Mode = get_mode(Flags),
- case init:get_argument(root) of
- {ok,[[Root0]]} ->
- Root = filename:join([Root0]), % Normalize. Use filename
- case code_server:start_link([Root,Mode]) of
- {ok,_Pid} = Ok2 ->
- if
- Mode =:= interactive ->
- case lists:member(stick, Flags) of
- true -> do_stick_dirs();
- _ -> ok
- end;
- true ->
- ok
- end,
- %% Quietly load native code for all modules loaded so far
- Architecture = erlang:system_info(hipe_architecture),
- load_native_code_for_all_loaded(Architecture),
- Ok2;
- Other ->
- Other
- end;
- Other ->
- error_logger:error_msg("Can not start code server ~w ~n", [Other]),
- {error, crash}
- end.
+ {ok,[[Root0]]} = init:get_argument(root),
+ Mode = start_get_mode(),
+ Root = filename:join([Root0]), % Normalize.
+ Res = code_server:start_link([Root,Mode]),
+
+ maybe_stick_dirs(Mode),
+
+ %% Quietly load native code for all modules loaded so far.
+ Architecture = erlang:system_info(hipe_architecture),
+ load_native_code_for_all_loaded(Architecture),
+ Res.
%% Make sure that all modules that the code_server process calls
%% (directly or indirectly) are loaded. Otherwise the code_server
@@ -374,6 +356,16 @@ load_code_server_prerequisites() ->
_ = [M = M:module_info(module) || M <- Needed],
ok.
+maybe_stick_dirs(interactive) ->
+ case init:get_argument(nostick) of
+ {ok,[[]]} ->
+ ok;
+ _ ->
+ do_stick_dirs()
+ end;
+maybe_stick_dirs(_) ->
+ ok.
+
do_stick_dirs() ->
do_s(compiler),
do_s(stdlib),
@@ -391,19 +383,12 @@ do_s(Lib) ->
ok
end.
-get_mode(Flags) ->
- case lists:member(embedded, Flags) of
- true ->
+start_get_mode() ->
+ case init:get_argument(mode) of
+ {ok,[["embedded"]]} ->
embedded;
- _Otherwise ->
- case init:get_argument(mode) of
- {ok,[["embedded"]]} ->
- embedded;
- {ok,[["minimal"]]} ->
- minimal;
- _Else ->
- interactive
- end
+ _ ->
+ interactive
end.
%% Find out which version of a particular module we would
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 1a42cc0e9f..b52def8777 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -22,9 +22,7 @@
%% This file holds the server part of the code_server.
-export([start_link/1,
- call/2,
- system_continue/3,
- system_terminate/4,
+ call/1,
system_code_change/4,
error_msg/2, info_msg/2
]).
@@ -35,15 +33,18 @@
-define(ANY_NATIVE_CODE_LOADED, any_native_code_loaded).
--record(state, {supervisor,
- root,
- path,
- moddb,
- namedb,
- mode = interactive,
- on_load = []}).
+-type on_load_item() :: {reference(),module(),file:name_all(),[pid()]}.
+
+-record(state, {supervisor :: pid(),
+ root :: file:name_all(),
+ path :: [file:name_all()],
+ moddb :: ets:tab(),
+ namedb :: ets:tab(),
+ mode = interactive :: 'interactive' | 'embedded',
+ on_load = [] :: [on_load_item()]}).
-type state() :: #state{}.
+-spec start_link([term()]) -> {'ok', pid()}.
start_link(Args) ->
Ref = make_ref(),
Parent = self(),
@@ -58,7 +59,7 @@ start_link(Args) ->
%% Init the code_server process.
%% -----------------------------------------------------------
-init(Ref, Parent, [Root,Mode0]) ->
+init(Ref, Parent, [Root,Mode]) ->
register(?MODULE, self()),
process_flag(trap_exit, true),
@@ -69,12 +70,6 @@ init(Ref, Parent, [Root,Mode0]) ->
end, erlang:pre_loaded()),
ets:insert(Db, init:fetch_loaded()),
- Mode =
- case Mode0 of
- minimal -> interactive;
- _ -> Mode0
- end,
-
IPath =
case Mode of
interactive ->
@@ -88,7 +83,8 @@ init(Ref, Parent, [Root,Mode0]) ->
end,
Path = add_loader_path(IPath, Mode),
- State = #state{root = Root,
+ State = #state{supervisor = Parent,
+ root = Root,
path = Path,
moddb = Db,
namedb = init_namedb(Path),
@@ -97,7 +93,7 @@ init(Ref, Parent, [Root,Mode0]) ->
put(?ANY_NATIVE_CODE_LOADED, false),
Parent ! {Ref,{ok,self()}},
- loop(State#state{supervisor = Parent}).
+ loop(State).
get_user_lib_dirs() ->
case os:getenv("ERL_LIBS") of
@@ -133,8 +129,9 @@ split_paths([C|T], S, Path, Paths) ->
split_paths([], _S, Path, Paths) ->
lists:reverse(Paths, [lists:reverse(Path)]).
-call(Name, Req) ->
- Name ! {code_call, self(), Req},
+-spec call(term()) -> term().
+call(Req) ->
+ ?MODULE ! {code_call, self(), Req},
receive
{?MODULE, Reply} ->
Reply
@@ -246,13 +243,8 @@ handle_call({dir,Dir}, {_From,_Tag}, S) ->
Resp = do_dir(Root,Dir,S#state.namedb),
{reply,Resp,S};
-handle_call({load_file,Mod}, Caller, St) ->
- case modp(Mod) of
- false ->
- {reply,{error,badarg},St};
- true ->
- load_file(Mod, Caller, St)
- end;
+handle_call({load_file,Mod}, Caller, St) when is_atom(Mod) ->
+ load_file(Mod, Caller, St);
handle_call({add_path,Where,Dir0}, {_From,_Tag},
#state{namedb=Namedb,path=Path0}=S) ->
@@ -283,7 +275,7 @@ handle_call(get_path, {_From,_Tag}, S) ->
{reply,S#state.path,S};
%% Messages to load, delete and purge modules/files.
-handle_call({load_abs,File,Mod}, Caller, S) ->
+handle_call({load_abs,File,Mod}, Caller, S) when is_atom(Mod) ->
case modp(File) of
false ->
{reply,{error,badarg},S};
@@ -291,7 +283,7 @@ handle_call({load_abs,File,Mod}, Caller, S) ->
load_abs(File, Mod, Caller, S)
end;
-handle_call({load_binary,Mod,File,Bin}, Caller, S) ->
+handle_call({load_binary,Mod,File,Bin}, Caller, S) when is_atom(Mod) ->
do_load_binary(Mod, File, Bin, Caller, S);
handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) ->
@@ -307,59 +299,44 @@ handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) ->
Status = hipe_result_to_status(Result),
{reply,Status,S};
-handle_call({ensure_loaded,Mod0}, Caller, St0) ->
- Fun = fun (M, St) ->
- case erlang:module_loaded(M) of
- true ->
- {reply,{module,M},St};
- false when St#state.mode =:= interactive ->
- load_file(M, Caller, St);
- false ->
- {reply,{error,embedded},St}
- end
- end,
- do_mod_call(Fun, Mod0, {error,badarg}, St0);
-
-handle_call({delete,Mod0}, {_From,_Tag}, S) ->
- Fun = fun (M, St) ->
- case catch erlang:delete_module(M) of
- true ->
- ets:delete(St#state.moddb, M),
- {reply,true,St};
- _ ->
- {reply,false,St}
- end
- end,
- do_mod_call(Fun, Mod0, false, S);
+handle_call({ensure_loaded,Mod}, Caller, St) when is_atom(Mod) ->
+ case erlang:module_loaded(Mod) of
+ true ->
+ {reply,{module,Mod},St};
+ false when St#state.mode =:= interactive ->
+ load_file(Mod, Caller, St);
+ false ->
+ {reply,{error,embedded},St}
+ end;
+
+handle_call({delete,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ case catch erlang:delete_module(Mod) of
+ true ->
+ ets:delete(St#state.moddb, Mod),
+ {reply,true,St};
+ _ ->
+ {reply,false,St}
+ end;
-handle_call({purge,Mod0}, {_From,_Tag}, St0) ->
- do_mod_call(fun (M, St) ->
- {reply,do_purge(M),St}
- end, Mod0, false, St0);
+handle_call({purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ {reply,do_purge(Mod),St};
-handle_call({soft_purge,Mod0}, {_From,_Tag}, St0) ->
- do_mod_call(fun (M, St) ->
- {reply,do_soft_purge(M),St}
- end, Mod0, true, St0);
+handle_call({soft_purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ {reply,do_soft_purge(Mod),St};
-handle_call({is_loaded,Mod0}, {_From,_Tag}, St0) ->
- do_mod_call(fun (M, St) ->
- {reply,is_loaded(M, St#state.moddb),St}
- end, Mod0, false, St0);
+handle_call({is_loaded,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ {reply,is_loaded(Mod, St#state.moddb),St};
handle_call(all_loaded, {_From,_Tag}, S) ->
Db = S#state.moddb,
{reply,all_loaded(Db),S};
-handle_call({get_object_code,Mod0}, {_From,_Tag}, St0) ->
- Fun = fun(M, St) ->
- Path = St#state.path,
- case mod_to_bin(Path, atom_to_list(M)) of
- {_,Bin,FName} -> {reply,{M,Bin,FName},St};
- Error -> {reply,Error,St}
- end
- end,
- do_mod_call(Fun, Mod0, error, St0);
+handle_call({get_object_code,Mod}, {_From,_Tag}, St) when is_atom(Mod) ->
+ Path = St#state.path,
+ case mod_to_bin(Path, Mod) of
+ {_,Bin,FName} -> {reply,{Mod,Bin,FName},St};
+ Error -> {reply,Error,St}
+ end;
handle_call({is_sticky, Mod}, {_From,_Tag}, S) ->
Db = S#state.moddb,
@@ -383,17 +360,6 @@ handle_call(Other,{_From,_Tag}, S) ->
error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]),
{noreply,S}.
-do_mod_call(Action, Module, _Error, St) when is_atom(Module) ->
- Action(Module, St);
-do_mod_call(Action, Module, Error, St) ->
- try list_to_atom(Module) of
- Atom when is_atom(Atom) ->
- Action(Atom, St)
- catch
- error:badarg ->
- {reply,Error,St}
- end.
-
%% --------------------------------------------------------------
%% Path handling functions.
%% --------------------------------------------------------------
@@ -1091,9 +1057,9 @@ add_paths(_,_,Path,_) ->
{ok,Path}.
do_load_binary(Module, File, Binary, Caller, St) ->
- case modp(Module) andalso modp(File) andalso is_binary(Binary) of
+ case modp(File) andalso is_binary(Binary) of
true ->
- case erlang:module_loaded(to_atom(Module)) of
+ case erlang:module_loaded(Module) of
true -> do_purge(Module);
false -> ok
end,
@@ -1106,15 +1072,10 @@ modp(Atom) when is_atom(Atom) -> true;
modp(List) when is_list(List) -> int_list(List);
modp(_) -> false.
-load_abs(File, Mod0, Caller, St) ->
+load_abs(File, Mod, Caller, St) ->
Ext = objfile_extension(),
FileName0 = lists:concat([File, Ext]),
FileName = absname(FileName0),
- Mod = if Mod0 =:= [] ->
- list_to_atom(filename:basename(FileName0, Ext));
- true ->
- Mod0
- end,
case erl_prim_loader:get_file(FileName) of
{ok,Bin,_} ->
try_load_module(FileName, Mod, Bin, Caller, St);
@@ -1123,10 +1084,9 @@ load_abs(File, Mod0, Caller, St) ->
end.
try_load_module(File, Mod, Bin, {From,_}=Caller, St0) ->
- M = to_atom(Mod),
- case pending_on_load(M, From, St0) of
+ case pending_on_load(Mod, From, St0) of
no ->
- try_load_module_1(File, M, Bin, Caller, St0);
+ try_load_module_1(File, Mod, Bin, Caller, St0);
{yes,St} ->
{noreply,St}
end.
@@ -1145,9 +1105,10 @@ try_load_module_2(File, Mod, Bin, Caller, undefined, St) ->
try_load_module_3(File, Mod, Bin, Caller, undefined, St);
try_load_module_2(File, Mod, Bin, Caller, Architecture,
#state{moddb=Db}=St) ->
- case catch load_native_code(Mod, Bin, Architecture) of
+ case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of
{module,Mod} = Module ->
- ets:insert(Db, {Mod,File}),
+ put(?ANY_NATIVE_CODE_LOADED, true),
+ ets:insert(Db, {Mod,File}),
{reply,Module,St};
no_native ->
try_load_module_3(File, Mod, Bin, Caller, Architecture, St);
@@ -1170,26 +1131,6 @@ try_load_module_3(File, Mod, Bin, Caller, Architecture,
{reply,Error,St}
end.
-load_native_code(Mod, Bin, Architecture) ->
- %% During bootstrapping of Open Source Erlang, we don't have any hipe
- %% loader modules, but the Erlang emulator might be hipe enabled.
- %% Therefore we must test for that the loader modules are available
- %% before trying to to load native code.
- case erlang:module_loaded(hipe_unified_loader) of
- false ->
- no_native;
- true ->
- Result = hipe_unified_loader:load_native_code(Mod, Bin,
- Architecture),
- case Result of
- {module,_} ->
- put(?ANY_NATIVE_CODE_LOADED, true);
- _ ->
- ok
- end,
- Result
- end.
-
hipe_result_to_status(Result) ->
case Result of
{module,_} ->
@@ -1212,8 +1153,7 @@ int_list([H|T]) when is_integer(H) -> int_list(T);
int_list([_|_]) -> false;
int_list([]) -> true.
-load_file(Mod0, {From,_}=Caller, St0) ->
- Mod = to_atom(Mod0),
+load_file(Mod, {From,_}=Caller, St0) ->
case pending_on_load(Mod, From, St0) of
no -> load_file_1(Mod, Caller, St0);
{yes,St} -> {noreply,St}
@@ -1224,11 +1164,11 @@ load_file_1(Mod, Caller, #state{path=Path}=St) ->
error ->
{reply,{error,nofile},St};
{Mod,Binary,File} ->
- try_load_module(File, Mod, Binary, Caller, St)
+ try_load_module_1(File, Mod, Binary, Caller, St)
end.
mod_to_bin([Dir|Tail], Mod) ->
- File = filename:append(Dir, to_list(Mod) ++ objfile_extension()),
+ File = filename:append(Dir, atom_to_list(Mod) ++ objfile_extension()),
case erl_prim_loader:get_file(File) of
error ->
mod_to_bin(Tail, Mod);
@@ -1288,13 +1228,11 @@ is_loaded(M, Db) ->
[] -> false
end.
-do_purge(Mod0) ->
- Mod = to_atom(Mod0),
+do_purge(Mod) ->
{_WasOld, DidKill} = erts_code_purger:purge(Mod),
DidKill.
-do_soft_purge(Mod0) ->
- Mod = to_atom(Mod0),
+do_soft_purge(Mod) ->
erts_code_purger:soft_purge(Mod).
@@ -1392,13 +1330,13 @@ strip_mod_info([{{sticky,_},_}|T], Acc) -> strip_mod_info(T, Acc);
strip_mod_info([H|T], Acc) -> strip_mod_info(T, [H|Acc]);
strip_mod_info([], Acc) -> Acc.
-% error_msg(Format) ->
-% error_msg(Format,[]).
+-spec error_msg(io:format(), [term()]) -> 'ok'.
error_msg(Format, Args) ->
Msg = {notify,{error, group_leader(), {self(), Format, Args}}},
error_logger ! Msg,
ok.
+-spec info_msg(io:format(), [term()]) -> 'ok'.
info_msg(Format, Args) ->
Msg = {notify,{info_msg, group_leader(), {self(), Format, Args}}},
error_logger ! Msg,
@@ -1412,6 +1350,3 @@ archive_extension() ->
to_list(X) when is_list(X) -> X;
to_list(X) when is_atom(X) -> atom_to_list(X).
-
-to_atom(X) when is_atom(X) -> X;
-to_atom(X) when is_list(X) -> list_to_atom(X).
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/kernel.erl b/lib/kernel/src/kernel.erl
index 5f33f25a0d..40544da6c3 100644
--- a/lib/kernel/src/kernel.erl
+++ b/lib/kernel/src/kernel.erl
@@ -98,7 +98,7 @@ init([]) ->
{kernel_config, start_link, []},
permanent, 2000, worker, [kernel_config]},
Code = {code_server,
- {code, start_link, get_code_args()},
+ {code, start_link, []},
permanent, 2000, worker, [code]},
File = {file_server_2,
{file_server, start_link, []},
@@ -158,12 +158,6 @@ init(safe) ->
{ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}.
-get_code_args() ->
- case init:get_argument(nostick) of
- {ok, [[]]} -> [[nostick]];
- _ -> []
- end.
-
start_dist_ac() ->
Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}],
case application:get_env(kernel, start_dist_ac) of
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/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 772a1e6b14..2a8468942c 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -321,6 +321,7 @@ load_abs(Config) when is_list(Config) ->
{error, nofile} = code:load_abs(TestDir ++ "/duuuumy_mod"),
{error, badfile} = code:load_abs(TestDir ++ "/code_a_test"),
{'EXIT', _} = (catch code:load_abs({})),
+ {'EXIT', _} = (catch code:load_abs("Non-latin-имя-файла")),
{module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"),
code:stick_dir(TestDir),
{error, sticky_directory} = code:load_abs(TestDir ++ "/code_b_test"),
@@ -850,18 +851,7 @@ check_funs({'$M_EXPR','$F_EXPR',1},
{code_server,start_link,1}]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',1},
[{lists,filter,2},
- {code_server,try_archive_subdirs,3},
- {code_server,all_archive_subdirs,1},
- {code_server,archive_subdirs,1},
- {code_server,insert_name,3},
- {code_server,replace_name,2},
- {code_server,update,2},
- {code_server,maybe_update,2},
- {code_server,do_add,4},
- {code_server,add_path,4},
- {code_server,handle_call,3},
- {code_server,loop,1},
- {code_server,system_continue,3}]) -> 0;
+ {code_server,try_archive_subdirs,3}|_]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',_},
[{erlang,apply,2},
{erlang,spawn_link,1},
@@ -1449,6 +1439,17 @@ on_load_errors(Config) when is_list(Config) ->
ok
end,
+ %% Make sure that the code loading functions return the correct
+ %% error code.
+ Simple = simple_on_load_error,
+ SimpleList = atom_to_list(Simple),
+ {error,on_load_failure} = code:load_file(Simple),
+ {error,on_load_failure} = code:ensure_loaded(Simple),
+ {ok,SimpleCode} = file:read_file("simple_on_load_error.beam"),
+ {error,on_load_failure} = code:load_binary(Simple, "", SimpleCode),
+ {error,on_load_failure} = code:load_abs(SimpleList),
+ {error,on_load_failure} = code:load_abs(SimpleList, Simple),
+
ok.
do_on_load_error(ReturnValue) ->
diff --git a/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl b/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl
new file mode 100644
index 0000000000..603c282257
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl
@@ -0,0 +1,5 @@
+-module(simple_on_load_error).
+-on_load(on_load/0).
+
+on_load() ->
+ nope.
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/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 d2a7d734c1..22b531e6ee 100644
--- a/lib/runtime_tools/src/dbg.erl
+++ b/lib/runtime_tools/src/dbg.erl
@@ -1269,7 +1269,7 @@ gen_reader(follow_file, Filename) ->
%% Opens a file and returns a reader (lazy list).
gen_reader_file(ReadFun, Filename) ->
- case file:open(Filename, [read, raw, binary]) of
+ case file:open(Filename, [read, raw, binary, read_ahead]) of
{ok, File} ->
mk_reader(ReadFun, File);
Error ->
@@ -1294,7 +1294,7 @@ mk_reader(ReadFun, Source) ->
mk_reader_wrap([]) ->
[];
mk_reader_wrap([Hd | _] = WrapFiles) ->
- case file:open(wrap_name(Hd), [read, raw, binary]) of
+ case file:open(wrap_name(Hd), [read, raw, binary, read_ahead]) of
{ok, File} ->
mk_reader_wrap(WrapFiles, File);
Error ->
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/doc/src/overload.xml b/lib/sasl/doc/src/overload.xml
index 5c3d00afeb..2f19cd9088 100644
--- a/lib/sasl/doc/src/overload.xml
+++ b/lib/sasl/doc/src/overload.xml
@@ -35,6 +35,12 @@
<module>overload</module>
<modulesummary>An Overload Regulation Process</modulesummary>
<description>
+ <warning>
+ <p>
+ All functions in this module are deprecated and will be
+ removed in a future release.
+ </p>
+ </warning>
<p><c>overload</c> is a process that indirectly regulates the CPU
usage in the system. The idea is that a main application calls
function
diff --git a/lib/sasl/doc/src/sasl_app.xml b/lib/sasl/doc/src/sasl_app.xml
index 8d79251c7e..bcd446a868 100644
--- a/lib/sasl/doc/src/sasl_app.xml
+++ b/lib/sasl/doc/src/sasl_app.xml
@@ -34,7 +34,7 @@
<p>The <c>SASL</c> application provides the following services:</p>
<list type="bulleted">
<item><c>alarm_handler</c></item>
- <item><c>overload</c></item>
+ <item><c>overload</c> (deprecated)</item>
<item><c>rb</c></item>
<item><c>release_handler</c></item>
<item><c>systools</c></item>
@@ -145,11 +145,15 @@
<p>Specifies the maximum intensity
for <seealso marker="overload"><c>overload</c></seealso>. Default
is <c>0.8</c>.</p>
+ <p>Note that the <c>overload</c> module is deprected and
+ will be removed in a future release.</p>
</item>
<tag><c><![CDATA[overload_weight = float() > 0 ]]></c></tag>
<item>
<p>Specifies the <seealso marker="overload"><c>overload</c></seealso>
weight. Default is <c>0.1</c>.</p>
+ <p>Note that the <c>overload</c> module is deprected and
+ will be removed in a future release.</p>
</item>
<tag><c><![CDATA[start_prg = string() ]]></c></tag>
<item>
diff --git a/lib/sasl/src/overload.erl b/lib/sasl/src/overload.erl
index 61b925d219..bc8ab7d5e4 100644
--- a/lib/sasl/src/overload.erl
+++ b/lib/sasl/src/overload.erl
@@ -19,6 +19,8 @@
%%
-module(overload).
+-deprecated(module).
+
-export([start_link/0, request/0, set_config_data/2,
get_overload_info/0]).
diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl
index 536ac924d4..5e9a35ab4c 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) ->
diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl
index 586b7c7171..9e6aa74d45 100644
--- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl
+++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl
@@ -34,6 +34,8 @@
%% Internal exports
-export([check_vacm/1]).
+%%
+-export([emask2imask/1]).
-include("snmp_types.hrl").
diff --git a/lib/snmp/src/agent/snmpa_acm.erl b/lib/snmp/src/agent/snmpa_acm.erl
index 7327575846..0264c6a992 100644
--- a/lib/snmp/src/agent/snmpa_acm.erl
+++ b/lib/snmp/src/agent/snmpa_acm.erl
@@ -280,7 +280,7 @@ validate_mib_view(Oid, MibView) ->
end.
get_largest_family([{SubTree, Mask, Type} | T], Oid, Res) ->
- case check_mask(Oid, SubTree, Mask) of
+ case check_mask(Oid, SubTree, snmp_view_based_acm_mib:emask2imask(Mask)) of
true -> get_largest_family(T, Oid, add_res(length(SubTree), SubTree,
Type, Res));
false -> get_largest_family(T, Oid, Res)
@@ -345,7 +345,7 @@ validate_all_mib_view([], _MibView) ->
%% intelligent.
%%-----------------------------------------------------------------
is_definitely_not_in_mib_view(Oid, [{SubTree, Mask,?view_included}|T]) ->
- case check_maybe_mask(Oid, SubTree, Mask) of
+ case check_maybe_mask(Oid, SubTree, snmp_view_based_acm_mib:emask2imask(Mask)) of
true -> false;
false -> is_definitely_not_in_mib_view(Oid, T)
end;
diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src
index 77418f920f..ca61782639 100644
--- a/lib/snmp/src/app/snmp.appup.src
+++ b/lib/snmp/src/app/snmp.appup.src
@@ -1,71 +1,24 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% 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%
-%%
-
-
+%% -*- erlang -*-
{"%VSN%",
%% ----- U p g r a d e -------------------------------------------------------
-
%% Instruction examples:
%% {restart_application, snmp}
%% {load_module, snmp_pdus, soft_purge, soft_purge, []}
%% {update, snmpa_local_db, soft, soft_purge, soft_purge, []}
%% {add_module, snmpm_net_if_mt}
[
- {"5.2", [{load_module, snmp_conf, soft_purge, soft_purge, []}]},
- {"5.1.2", [ % Only runtime dependencies change
- ]},
- {"5.1.1", [{restart_application, snmp}]},
- {"5.1", [ % Only compiler changes
- ]},
- {"5.0", [{restart_application, snmp}]},
- {"4.25.1", [{restart_application, snmp}]},
- {"4.25.0.1", [{restart_application, snmp}]},
- {"4.25.0.0.1", [{restart_application, snmp}]},
- {"4.25", [{restart_application, snmp}]},
- {"4.24.2", [{restart_application, snmp}]},
- {"4.24.1", [{restart_application, snmp}]},
- {"4.24", [{restart_application, snmp}]}
- ],
-
+ {<<"5\\..*">>, [{restart_application, snmp}]},
+ {<<"4\\..*">>, [{restart_application, snmp}]}
+ ],
+
%% ------D o w n g r a d e ---------------------------------------------------
-
%% Instruction examples:
%% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}}
-
+
[
- {"5.2", [{load_module, snmp_conf, soft_purge, soft_purge, []}]},
- {"5.1.2", [ % Only runtime dependencies change
- ]},
- {"5.1.1", [{restart_application, snmp}]},
- {"5.1", [ % Only compiler changes
- ]},
- {"5.0", [{restart_application, snmp}]},
- {"4.25.1", [{restart_application, snmp}]},
- {"4.25.0.1", [{restart_application, snmp}]},
- {"4.25.0.0.1", [{restart_application, snmp}]},
- {"4.25", [{restart_application, snmp}]},
- {"4.24.2", [{restart_application, snmp}]},
- {"4.24.1", [{restart_application, snmp}]},
- {"4.24", [{restart_application, snmp}]}
- ]
-
-}.
+ {<<"5\\..*">>, [{restart_application, snmp}]},
+ {<<"4\\..*">>, [{restart_application, snmp}]}
+ ]
+}.
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index 11728128c4..057906bcb3 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,6 +1,9 @@
%% -*- erlang -*-
{"%VSN%",
[
+ {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []},
+ {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []}
+ ]},
{<<"7\\..*">>, [{restart_application, ssl}]},
{<<"6\\..*">>, [{restart_application, ssl}]},
{<<"5\\..*">>, [{restart_application, ssl}]},
@@ -8,6 +11,9 @@
{<<"3\\..*">>, [{restart_application, ssl}]}
],
[
+ {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []},
+ {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []}
+ ]},
{<<"7\\..*">>, [{restart_application, ssl}]},
{<<"6\\..*">>, [{restart_application, ssl}]},
{<<"5\\..*">>, [{restart_application, ssl}]},
diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl
index 3edd352891..1e6c6e726a 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
%%====================================================================
@@ -196,6 +204,7 @@ accept_loop(Proxy, world = Type, Listen, Extra) ->
case gen_tcp:accept(Listen) of
{ok, Socket} ->
Opts = get_ssl_options(server),
+ wait_for_code_server(),
case ssl:ssl_accept(Socket, Opts) of
{ok, SslSocket} ->
PairHandler =
@@ -217,6 +226,35 @@ accept_loop(Proxy, world = Type, Listen, Extra) ->
end,
accept_loop(Proxy, Type, Listen, Extra).
+wait_for_code_server() ->
+ %% This is an ugly hack. Upgrading a socket to TLS requires the
+ %% crypto module to be loaded. Loading the crypto module triggers
+ %% its on_load function, which calls code:priv_dir/1 to find the
+ %% directory where its NIF library is. However, distribution is
+ %% started earlier than the code server, so the code server is not
+ %% necessarily started yet, and code:priv_dir/1 might fail because
+ %% of that, if we receive an incoming connection on the
+ %% distribution port early enough.
+ %%
+ %% If the on_load function of a module fails, the module is
+ %% unloaded, and the function call that triggered loading it fails
+ %% with 'undef', which is rather confusing.
+ %%
+ %% Thus, the ssl_tls_dist_proxy process will terminate, and be
+ %% restarted by ssl_dist_sup. However, it won't have any memory
+ %% of being asked by net_kernel to listen for incoming
+ %% connections. Hence, the node will believe that it's open for
+ %% distribution, but it actually isn't.
+ %%
+ %% So let's avoid that by waiting for the code server to start.
+ case whereis(code_server) of
+ undefined ->
+ timer:sleep(10),
+ wait_for_code_server();
+ Pid when is_pid(Pid) ->
+ ok
+ end.
+
try_connect(Port) ->
case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}, nodelay()]) of
R = {ok, _S} ->
@@ -227,7 +265,7 @@ 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}]),
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index b2b85eaf8d..c3f0206d25 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -764,6 +764,8 @@ handle_tls_handshake(Handle, StateName,
case Handle(Packet, FsmReturn) of
{next_state, NextStateName, State, _Timeout} ->
handle_tls_handshake(Handle, NextStateName, State);
+ {next_state, NextStateName, State} ->
+ handle_tls_handshake(Handle, NextStateName, State);
{stop, _,_} = Stop ->
Stop
end;
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_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index bcdefb5fca..ecf6c4d6b8 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -1445,7 +1445,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba
Exe = "openssl",
Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version),
- "-cert", CertFile, "-key" ++ KeyFile],
+ "-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
ssl_test_lib:wait_for_openssl_server(Port),
@@ -1480,7 +1480,7 @@ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callba
Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
Exe = "openssl",
- Args = ["s_client", "-alpn", "http/1.0,spdy/2" "-msg" "-port",
+ Args = ["s_client", "-alpn", "http/1.0,spdy/2", "-msg", "-port",
integer_to_list(Port), ssl_test_lib:version_flag(Version),
"-host", "localhost"],
@@ -1512,7 +1512,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca
Exe = "openssl",
Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-nextprotoneg",
"spdy/3", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version),
- "-cert" ++ CertFile ++ "-key" ++ KeyFile],
+ "-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index aa1af21990..9f79a7fb34 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 7.2
+SSL_VSN = 7.2.1
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/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 7036316242..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) ->
@@ -1291,7 +1291,15 @@ init(Parent, Server) ->
open_file_loop(#head{parent = Parent, server = Server}).
open_file_loop(Head) ->
- open_file_loop(Head, 0).
+ %% The Dets server pretends the file is open before
+ %% internal_open() has been called, which means that unless the
+ %% internal_open message is applied first, other processes can
+ %% find the pid by calling dets_server:get_pid() and do things
+ %% before Head has been initialized properly.
+ receive
+ ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) ->
+ do_apply_op(Op, From, Head, 0)
+ end.
open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error ->
open_file_loop2(Head, N);
@@ -1966,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} ->
@@ -2093,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, []} ->
@@ -3277,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/edlin.erl b/lib/stdlib/src/edlin.erl
index 19444c0502..0e9c457de2 100644
--- a/lib/stdlib/src/edlin.erl
+++ b/lib/stdlib/src/edlin.erl
@@ -465,7 +465,6 @@ word_char(C) when C >= $a, C =< $z -> true;
word_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true;
word_char(C) when C >= $0, C =< $9 -> true;
word_char(C) when C =:= $_ -> true;
-word_char(C) when C =:= $. -> true; % accept dot-separated names
word_char(_) -> false.
%% over_white(Chars, InitialStack, InitialCount) ->
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..aed857aa77 100644
--- a/lib/stdlib/src/file_sorter.erl
+++ b/lib/stdlib/src/file_sorter.erl
@@ -305,7 +305,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 +323,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 +408,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 +424,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 +1307,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 +1330,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 +1355,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 +1375,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 +1584,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 +1596,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/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 960c70f255..bc70c296da 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -647,6 +647,9 @@ obsolete_1(random, _, _) ->
obsolete_1(code, rehash, 0) ->
{deprecated, "deprecated because the code path cache feature has been removed"};
+obsolete_1(overload, _, _) ->
+ {deprecated, "deprecated; will be removed in OTP 19"};
+
obsolete_1(_, _, _) ->
no.
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index 3ba3a88038..24e64efee7 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -808,21 +808,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 +885,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/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/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl
index e061e16e4c..ad8829c471 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -53,7 +53,8 @@
simultaneous_open/1, insert_new/1, repair_continuation/1,
otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1,
otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1,
- otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1]).
+ otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1,
+ otp_13260/1]).
-export([dets_dirty_loop/0]).
@@ -111,7 +112,7 @@ all() ->
insert_new, repair_continuation, otp_5487, otp_6206,
otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898,
otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709,
- otp_13229
+ otp_13229, otp_13260
].
groups() ->
@@ -1877,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, '_')),
@@ -4001,6 +4026,54 @@ otp_13229(_Config) ->
ok
end.
+otp_13260(doc) ->
+ ["OTP-13260. Race when opening a table."];
+otp_13260(Config) ->
+ [ok] = lists:usort([otp_13260_1(Config) || _ <- lists:seq(1, 3)]),
+ ok.
+
+otp_13260_1(Config) ->
+ Tab = otp_13260,
+ File = filename(Tab, Config),
+ N = 20,
+ P = self(),
+ Pids = [spawn_link(fun() -> counter(P, Tab, File) end) ||
+ _ <- lists:seq(1, N)],
+ Rs = rec(Pids),
+ true = lists:all(fun(R) -> is_integer(R) end, Rs),
+ wait_for_close(Tab).
+
+rec([]) ->
+ [];
+rec([Pid | Pids]) ->
+ receive {Pid, R} ->
+ [R | rec(Pids)]
+ end.
+
+%% One may have to run the test several times to trigger the bug.
+counter(P, Tab, File) ->
+ Key = key,
+ N = case catch dets:update_counter(Tab, Key, 1) of
+ {'EXIT', _} ->
+ {ok, Tab} = dets:open_file(Tab, [{file, File}]),
+ ok = dets:insert(Tab, {Key, 1}),
+ dets:update_counter(Tab, Key, 1);
+ N1 when is_integer(N1) ->
+ N1;
+ DetsBug ->
+ DetsBug
+ end,
+ P ! {self(), N}.
+
+wait_for_close(Tab) ->
+ case dets:info(Tab, owner) of
+ undefined ->
+ ok;
+ _ ->
+ timer:sleep(100),
+ wait_for_close(Tab)
+ end.
+
%%
%% Parts common to several test cases
%%
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/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/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl
index 483ea9774e..8264747a3b 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
- ?line [{{t,1},1},
- {{t,2},2},
+ %% The template cannot have a counter since it is not allowed to
+ %% be a block.
+ ?line [% {{t,1},1},
+ %% {{t,2},2},
{{t,3},1},
{{t,4},1},
{{t,5},0},
@@ -1556,8 +1559,8 @@ comprehension_8188(Cf) ->
{{t,12},3},
{{t,13},2},
{{t,14},2}] =
- analyse_expr(<<"<< \n" % 1
- " << (X*2) >> || \n" % 2
+ analyse_expr(<<"<< \n" % 1 (now: 0)
+ " << (X*2) >> || \n" % 2 (now: 0)
" <<X>> <= << (case two() of\n"
" 2 -> 1;\n" % 1
" _ -> 2\n" % 0
@@ -1571,8 +1574,8 @@ comprehension_8188(Cf) ->
" true >>.\n" % 2
"two() -> 2">>, Cf),
- ?line [{{t,1},1},
- {{t,2},4},
+ ?line [% {{t,1},1},
+ %% {{t,2},4},
{{t,4},1},
{{t,6},1},
{{t,7},0},
@@ -1580,8 +1583,8 @@ comprehension_8188(Cf) ->
{{t,11},2},
{{t,12},4},
{{t,13},1}] =
- analyse_expr(<<"<< \n" % 1
- " << (2)\n" % 4
+ analyse_expr(<<"<< \n" % 1 (now: 0)
+ " << (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/typer/src/typer.erl b/lib/typer/src/typer.erl
index 562530c868..5c82750a21 100644
--- a/lib/typer/src/typer.erl
+++ b/lib/typer/src/typer.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2015. 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.
@@ -137,11 +137,14 @@ extract(#analysis{macros = Macros,
NewCodeServer =
try
NewRecords = dialyzer_codeserver:get_temp_records(CodeServer1),
+ NewExpTypes = dialyzer_codeserver:get_temp_exported_types(CodeServer1),
+ case sets:size(NewExpTypes) of 0 -> ok end,
OldRecords = dialyzer_plt:get_types(TrustPLT), % XXX change to the PLT?
MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords),
CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1),
- CodeServer3 = dialyzer_utils:process_record_remote_types(CodeServer2),
- dialyzer_contracts:process_contract_remote_types(CodeServer3)
+ CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2),
+ CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3),
+ dialyzer_contracts:process_contract_remote_types(CodeServer4)
catch
throw:{error, ErrorMsg} ->
compile_error(ErrorMsg)
@@ -845,8 +848,7 @@ collect_info(Analysis) ->
%% io:format("Merged Records ~p",[MergedRecords]),
TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer),
TmpCServer2 =
- dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes,
- TmpCServer1),
+ dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2),
dialyzer_contracts:process_contract_remote_types(TmpCServer3)
catch
diff --git a/otp_versions.table b/otp_versions.table
index 9680aafae7..50f1839b05 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,3 +1,4 @@
+OTP-18.2.3 : inets-6.1.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 :
OTP-18.2.2 : ssh-4.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 :
OTP-18.2.1 : erts-7.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 :
OTP-18.2 : asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 crypto-3.6.2 dialyzer-2.8.2 diameter-1.11.1 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2 eunit-2.2.12 hipe-3.14 inets-6.1 jinterface-1.6.1 kernel-4.1.1 observer-2.1.1 parsetools-2.1.1 public_key-1.1 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 wx-1.6 xmerl-1.3.9 # cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 debugger-4.1.1 edoc-0.7.17 eldap-1.2 et-1.5.1 gs-1.6 ic-4.4 megaco-3.18 mnesia-4.13.2 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 percept-0.8.11 reltool-0.7 syntax_tools-1.7 webtool-0.9 :
@@ -11,6 +12,7 @@ OTP-18.0.3 : erts-7.0.3 # asn1-4.0 common_test-1.11 compiler-6.0 cosEvent-2.2 co
OTP-18.0.2 : erts-7.0.2 runtime_tools-1.9.1 # asn1-4.0 common_test-1.11 compiler-6.0 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6 debugger-4.1 dialyzer-2.8 diameter-1.10 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 et-1.5.1 eunit-2.2.10 gs-1.6 hipe-3.12 ic-4.4 inets-6.0 jinterface-1.6 kernel-4.0 megaco-3.18 mnesia-4.13 observer-2.1 odbc-2.11 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0 reltool-0.7 sasl-2.5 snmp-5.2 ssh-4.0 ssl-7.0 stdlib-2.5 syntax_tools-1.7 test_server-3.9 tools-2.8 typer-0.9.9 webtool-0.9 wx-1.4 xmerl-1.3.8 :
OTP-18.0.1 : erts-7.0.1 # asn1-4.0 common_test-1.11 compiler-6.0 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6 debugger-4.1 dialyzer-2.8 diameter-1.10 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 et-1.5.1 eunit-2.2.10 gs-1.6 hipe-3.12 ic-4.4 inets-6.0 jinterface-1.6 kernel-4.0 megaco-3.18 mnesia-4.13 observer-2.1 odbc-2.11 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0 reltool-0.7 runtime_tools-1.9 sasl-2.5 snmp-5.2 ssh-4.0 ssl-7.0 stdlib-2.5 syntax_tools-1.7 test_server-3.9 tools-2.8 typer-0.9.9 webtool-0.9 wx-1.4 xmerl-1.3.8 :
OTP-18.0 : asn1-4.0 common_test-1.11 compiler-6.0 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6 debugger-4.1 dialyzer-2.8 diameter-1.10 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 erts-7.0 et-1.5.1 eunit-2.2.10 gs-1.6 hipe-3.12 ic-4.4 inets-6.0 jinterface-1.6 kernel-4.0 megaco-3.18 mnesia-4.13 observer-2.1 odbc-2.11 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0 reltool-0.7 runtime_tools-1.9 sasl-2.5 snmp-5.2 ssh-4.0 ssl-7.0 stdlib-2.5 syntax_tools-1.7 test_server-3.9 tools-2.8 typer-0.9.9 webtool-0.9 wx-1.4 xmerl-1.3.8 # :
+OTP-17.5.6.8 : diameter-1.9.2.3 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3.1 dialyzer-2.7.4 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1.5 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2.0.1 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 :
OTP-17.5.6.7 : diameter-1.9.2.2 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3.1 dialyzer-2.7.4 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1.5 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2.0.1 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 :
OTP-17.5.6.6 : erts-6.4.1.5 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3.1 dialyzer-2.7.4 diameter-1.9.2.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2.0.1 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 :
OTP-17.5.6.5 : erts-6.4.1.4 kernel-3.2.0.1 ssl-6.0.1.1 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3.1 dialyzer-2.7.4 diameter-1.9.2.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 :
diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml
index a238e3135a..8915302088 100644
--- a/system/doc/reference_manual/typespec.xml
+++ b/system/doc/reference_manual/typespec.xml
@@ -69,7 +69,7 @@
<p>
For integers and atoms, it is allowed for singleton types; for example,
the integers
- <c>-1</c> and <c>42</c>, or the atoms <c>'foo'</c> and <c>'bar'</c>).
+ <c>-1</c> and <c>42</c>, or the atoms <c>'foo'</c> and <c>'bar'</c>.
All other types are built using unions of either predefined
types or singleton types. In a type union between a type and one